|
|
1.1 ! root 1: ;; View: Peruse file or buffer without editing. ! 2: ;; Copyright (C) 1985 Free Software Foundation, Inc. ! 3: ;; Principal author K. Shane Hartman ! 4: ! 5: ;; This file is part of GNU Emacs. ! 6: ! 7: ;; GNU Emacs is distributed in the hope that it will be useful, ! 8: ;; but WITHOUT ANY WARRANTY. No author or distributor ! 9: ;; accepts responsibility to anyone for the consequences of using it ! 10: ;; or for whether it serves any particular purpose or works at all, ! 11: ;; unless he says so in writing. Refer to the GNU Emacs General Public ! 12: ;; License for full details. ! 13: ! 14: ;; Everyone is granted permission to copy, modify and redistribute ! 15: ;; GNU Emacs, but only under the conditions described in the ! 16: ;; GNU Emacs General Public License. A copy of this license is ! 17: ;; supposed to have been given to you along with GNU Emacs so you ! 18: ;; can know your rights and responsibilities. It should be in a ! 19: ;; file named COPYING. Among other things, the copyright notice ! 20: ;; and this notice must be preserved on all copies. ! 21: ! 22: ! 23: (provide 'view) ! 24: ! 25: (defvar view-mode-map nil) ! 26: (if view-mode-map ! 27: nil ! 28: (setq view-mode-map (make-keymap)) ! 29: (fillarray view-mode-map 'View-undefined) ! 30: (define-key view-mode-map "\C-c" 'exit-recursive-edit) ! 31: (define-key view-mode-map "\C-z" 'suspend-emacs) ! 32: (define-key view-mode-map "q" 'exit-recursive-edit) ! 33: (define-key view-mode-map "-" 'negative-argument) ! 34: (define-key view-mode-map "0" 'digit-argument) ! 35: (define-key view-mode-map "1" 'digit-argument) ! 36: (define-key view-mode-map "2" 'digit-argument) ! 37: (define-key view-mode-map "3" 'digit-argument) ! 38: (define-key view-mode-map "4" 'digit-argument) ! 39: (define-key view-mode-map "5" 'digit-argument) ! 40: (define-key view-mode-map "6" 'digit-argument) ! 41: (define-key view-mode-map "7" 'digit-argument) ! 42: (define-key view-mode-map "8" 'digit-argument) ! 43: (define-key view-mode-map "9" 'digit-argument) ! 44: (define-key view-mode-map "\C-u" 'universal-argument) ! 45: (define-key view-mode-map "\e" nil) ! 46: (define-key view-mode-map "\C-x" 'Control-X-prefix) ! 47: (define-key view-mode-map "\e-" 'negative-argument) ! 48: (define-key view-mode-map "\e0" 'digit-argument) ! 49: (define-key view-mode-map "\e1" 'digit-argument) ! 50: (define-key view-mode-map "\e2" 'digit-argument) ! 51: (define-key view-mode-map "\e3" 'digit-argument) ! 52: (define-key view-mode-map "\e4" 'digit-argument) ! 53: (define-key view-mode-map "\e5" 'digit-argument) ! 54: (define-key view-mode-map "\e6" 'digit-argument) ! 55: (define-key view-mode-map "\e7" 'digit-argument) ! 56: (define-key view-mode-map "\e8" 'digit-argument) ! 57: (define-key view-mode-map "\e9" 'digit-argument) ! 58: (define-key view-mode-map "<" 'beginning-of-buffer) ! 59: (define-key view-mode-map ">" 'end-of-buffer) ! 60: (define-key view-mode-map "\ev" 'View-scroll-lines-backward) ! 61: (define-key view-mode-map "\C-v" 'View-scroll-lines-forward) ! 62: (define-key view-mode-map " " 'View-scroll-lines-forward) ! 63: (define-key view-mode-map "\177" 'View-scroll-lines-backward) ! 64: (define-key view-mode-map "\n" 'View-scroll-one-more-line) ! 65: (define-key view-mode-map "\r" 'View-scroll-one-more-line) ! 66: (define-key view-mode-map "\C-l" 'recenter) ! 67: (define-key view-mode-map "z" 'View-scroll-lines-forward-set-scroll-size) ! 68: (define-key view-mode-map "g" 'View-goto-line) ! 69: (define-key view-mode-map "=" 'what-line) ! 70: (define-key view-mode-map "." 'set-mark-command) ! 71: (define-key view-mode-map "\C-@" 'set-mark-command) ! 72: (define-key view-mode-map "'" 'View-back-to-mark) ! 73: (define-key view-mode-map "@" 'View-back-to-mark) ! 74: (define-key view-mode-map "x" 'exchange-point-and-mark) ! 75: (define-key view-mode-map "h" 'Helper-describe-bindings) ! 76: (define-key view-mode-map "?" 'Helper-describe-bindings) ! 77: (define-key view-mode-map "\C-h" 'Helper-help) ! 78: (define-key view-mode-map "\C-n" 'next-line) ! 79: (define-key view-mode-map "\C-p" 'previous-line) ! 80: (define-key view-mode-map "\C-s" 'isearch-forward) ! 81: (define-key view-mode-map "\C-r" 'isearch-backward) ! 82: (define-key view-mode-map "s" 'isearch-forward) ! 83: (define-key view-mode-map "r" 'isearch-backward) ! 84: (define-key view-mode-map "/" 'View-search-regexp-forward) ! 85: (define-key view-mode-map "\\" 'View-search-regexp-backward) ! 86: ;; This conflicts with the standard binding of isearch-regexp-forward ! 87: (define-key view-mode-map "\e\C-s" 'View-search-regexp-forward) ! 88: (define-key view-mode-map "\e\C-r" 'View-search-regexp-backward) ! 89: (define-key view-mode-map "n" 'View-search-last-regexp-forward) ! 90: (define-key view-mode-map "p" 'View-search-last-regexp-backward) ! 91: ) ! 92: ! 93: ! 94: (defun view-file (file-name) ! 95: "View FILE in View mode, returning to previous buffer when done. ! 96: The usual Emacs commands are not available; instead, ! 97: a special set of commands (mostly letters and punctuation) ! 98: are defined for moving around in the buffer. ! 99: Space scrolls forward, Delete scrolls backward. ! 100: For list of all View commands, type ? or h while viewing. ! 101: ! 102: Calls the value of view-hook if that is non-nil." ! 103: (interactive "fView file: ") ! 104: (let ((had-a-buf (get-file-buffer file-name)) ! 105: (buf-to-view nil)) ! 106: (unwind-protect ! 107: (view-mode (prog1 (current-buffer) ! 108: (switch-to-buffer ! 109: (setq buf-to-view (find-file-noselect file-name)) t))) ! 110: (and (not had-a-buf) buf-to-view (not (buffer-modified-p buf-to-view)) ! 111: (kill-buffer buf-to-view))))) ! 112: ! 113: (defun view-buffer (buffer-name) ! 114: "View BUFFER in View mode, returning to previous buffer when done. ! 115: The usual Emacs commands are not available; instead, ! 116: a special set of commands (mostly letters and punctuation) ! 117: are defined for moving around in the buffer. ! 118: Space scrolls forward, Delete scrolls backward. ! 119: For list of all View commands, type ? or h while viewing. ! 120: ! 121: Calls the value of view-hook if that is non-nil." ! 122: (interactive "bView buffer: ") ! 123: (view-mode (prog1 (current-buffer) (switch-to-buffer buffer-name)))) ! 124: ! 125: (defun view-mode (&optional view-return-to-buffer) ! 126: "Major mode for viewing text but not editing it. ! 127: Letters do not insert themselves. Instead these commands are provided. ! 128: Most commands take prefix arguments. Commands dealing with lines ! 129: default to \"scroll size\" lines (initially size of window). ! 130: Search commands default to a repeat count of one. ! 131: M-< or < move to beginning of buffer. ! 132: M-> or > move to end of buffer. ! 133: C-v or Space scroll forward lines. ! 134: M-v or DEL scroll backward lines. ! 135: CR or LF scroll forward one line (backward with prefix argument). ! 136: z like Space except set number of lines for further ! 137: scrolling commands to scroll by. ! 138: C-u and Digits provide prefix arguments. `-' denotes negative argument. ! 139: = prints the current line number. ! 140: g goes to line given by prefix argument. ! 141: / or M-C-s searches forward for regular expression ! 142: \\ or M-C-r searches backward for regular expression. ! 143: n searches forward for last regular expression. ! 144: p searches backward for last regular expression. ! 145: C-@ or . set the mark. ! 146: x exchanges point and mark. ! 147: C-s or s do forward incremental search. ! 148: C-r or r do reverse incremental search. ! 149: @ or ' return to mark and pops mark ring. ! 150: Mark ring is pushed at start of every ! 151: successful search and when jump to line to occurs. ! 152: The mark is set on jump to buffer start or end. ! 153: ? or h provide help message (list of commands). ! 154: C-h provides help (list of commands or description of a command). ! 155: C-n moves down lines vertically. ! 156: C-p moves upward lines vertically. ! 157: C-l recenters the screen. ! 158: q or C-c exit view-mode and return to previous buffer. ! 159: ! 160: Entry to this mode calls the value of view-hook if non-nil. ! 161: \\{view-mode-map}" ! 162: ; Not interactive because dangerous things happen ! 163: ; if you call it without passing a buffer as argument ! 164: ; and they are not easy to fix. ! 165: ; (interactive) ! 166: (let* ((view-buffer-window (selected-window)) ! 167: (view-scroll-size nil)) ! 168: (unwind-protect ! 169: (let ((buffer-read-only t) ! 170: (mode-line-buffer-identification ! 171: (list ! 172: (if (buffer-file-name) ! 173: "Viewing %f" ! 174: "Viewing %b"))) ! 175: (mode-name "View")) ! 176: (beginning-of-line) ! 177: (catch 'view-mode-exit (view-mode-command-loop))) ! 178: (if view-return-to-buffer ! 179: (switch-to-buffer view-return-to-buffer))))) ! 180: ! 181: (defun view-helpful-message () ! 182: (message ! 183: (if (and (eq (key-binding "\C-h") 'Helper-help) ! 184: (eq (key-binding "?") 'Helper-describe-bindings) ! 185: (eq (key-binding "\C-c") 'exit-recursive-edit)) ! 186: "Type C-h for help, ? for commands, C-c to quit" ! 187: (substitute-command-keys ! 188: "Type \\[Helper-help] for help, \\[Helper-describe-bindings] for commands, \\[exit-recursive-edit] to quit.")))) ! 189: ! 190: (defun View-undefined () ! 191: (interactive) ! 192: (ding) ! 193: (view-helpful-message)) ! 194: ! 195: (defun view-window-size () (1- (window-height view-buffer-window))) ! 196: ! 197: (defun view-scroll-size () ! 198: (min (view-window-size) (or view-scroll-size (view-window-size)))) ! 199: ! 200: (defvar view-hook nil ! 201: "If non-nil, its value is called when viewing buffer or file.") ! 202: ! 203: (defun view-mode-command-loop () ! 204: (push-mark) ! 205: (let ((old-local-map (current-local-map)) ! 206: (mark-ring) ! 207: ; (view-last-command) ! 208: ; (view-last-command-entry) ! 209: ; (view-last-command-argument) ! 210: (view-last-regexp) ! 211: (Helper-return-blurb ! 212: (format "continue viewing %s" ! 213: (if (buffer-file-name) ! 214: (file-name-nondirectory (buffer-file-name)) ! 215: (buffer-name)))) ! 216: (goal-column 0) ! 217: (view-buffer (buffer-name))) ! 218: (unwind-protect ! 219: (progn ! 220: (use-local-map view-mode-map) ! 221: (run-hooks 'view-hook) ! 222: (view-helpful-message) ! 223: (recursive-edit)) ! 224: (save-excursion ! 225: (set-buffer view-buffer) ! 226: (use-local-map old-local-map)))) ! 227: (pop-mark)) ! 228: ! 229: ;(defun view-last-command (&optional who what) ! 230: ; (setq view-last-command-entry this-command) ! 231: ; (setq view-last-command who) ! 232: ; (setq view-last-command-argument what)) ! 233: ! 234: ;(defun View-repeat-last-command () ! 235: ; "Repeat last command issued in View mode." ! 236: ; (interactive) ! 237: ; (if (and view-last-command ! 238: ; (eq view-last-command-entry last-command)) ! 239: ; (funcall view-last-command view-last-command-argument)) ! 240: ; (setq this-command view-last-command-entry)) ! 241: ! 242: (defun View-goto-line (&optional line) ! 243: "Move to LINE in View mode. ! 244: Display is centered at LINE. Sets mark at starting position and pushes ! 245: mark ring." ! 246: (interactive "p") ! 247: (push-mark) ! 248: (goto-line (or line 1)) ! 249: (recenter (/ (view-window-size) 2))) ! 250: ! 251: (defun View-scroll-lines-forward (&optional lines) ! 252: "Scroll forward in View mode, or exit if end of text is visible. ! 253: No arg means whole window full, or number of lines set by \\[View-scroll-lines-forward-set-scroll-size]. ! 254: Arg is number of lines to scroll." ! 255: (interactive "P") ! 256: (if (pos-visible-in-window-p (point-max)) ! 257: (exit-recursive-edit)) ! 258: (setq lines ! 259: (if lines (prefix-numeric-value lines) ! 260: (view-scroll-size))) ! 261: ; (view-last-command 'View-scroll-lines-forward lines) ! 262: (if (>= lines (view-window-size)) ! 263: (scroll-up nil) ! 264: (if (>= (- lines) (view-window-size)) ! 265: (scroll-down nil) ! 266: (scroll-up lines))) ! 267: (cond ((pos-visible-in-window-p (point-max)) ! 268: (goto-char (point-max)) ! 269: (recenter -1) ! 270: (message (substitute-command-keys ! 271: "End. Type \\[exit-recursive-edit] to quit viewing.")))) ! 272: (move-to-window-line -1) ! 273: (beginning-of-line)) ! 274: ! 275: (defun View-scroll-lines-forward-set-scroll-size (&optional lines) ! 276: "Scroll forward LINES lines in View mode, setting the \"scroll size\". ! 277: This is the number of lines which \\[View-scroll-lines-forward] and \\[View-scroll-lines-backward] scroll by default. ! 278: The absolute value of LINES is used, so this command can be used to scroll ! 279: backwards (but \"scroll size\" is always positive). If LINES is greater than ! 280: window height or omitted, then window height is assumed. If LINES is less ! 281: than window height then scrolling context is provided from previous screen." ! 282: (interactive "P") ! 283: (if (not lines) ! 284: (setq view-scroll-size (view-window-size)) ! 285: (setq lines (prefix-numeric-value lines)) ! 286: (setq view-scroll-size ! 287: (min (if (> lines 0) lines (- lines)) (view-window-size)))) ! 288: (View-scroll-lines-forward lines)) ! 289: ! 290: (defun View-scroll-one-more-line (&optional arg) ! 291: "Scroll one more line up in View mode. ! 292: With ARG scroll one line down." ! 293: (interactive "P") ! 294: (View-scroll-lines-forward (if (not arg) 1 -1))) ! 295: ! 296: (defun View-scroll-lines-backward (&optional lines) ! 297: "Scroll backward in View mode. ! 298: No arg means whole window full, or number of lines set by \\[View-scroll-lines-forward-set-scroll-size]. ! 299: Arg is number of lines to scroll." ! 300: (interactive "P") ! 301: (View-scroll-lines-forward (if lines ! 302: (- (prefix-numeric-value lines)) ! 303: (- (view-scroll-size))))) ! 304: ! 305: (defun View-search-regexp-forward (times regexp) ! 306: "Search forward for NTH occurrence of REGEXP in View mode. ! 307: Displays line found at center of window. REGEXP is remembered for ! 308: searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward]. Sets mark at starting position and pushes mark ring." ! 309: (interactive "p\nsSearch forward (regexp): ") ! 310: (if (> (length regexp) 0) ! 311: (progn ! 312: ;(view-last-command 'View-search-last-regexp-forward times) ! 313: (view-search times regexp)))) ! 314: ! 315: (defun View-search-regexp-backward (times regexp) ! 316: "Search backward from window start for NTH instance of REGEXP in View mode. ! 317: Displays line found at center of window. REGEXP is remembered for ! 318: searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward]. Sets mark at starting position and pushes mark ring." ! 319: (interactive "p\nsSearch backward (regexp): ") ! 320: (View-search-regexp-forward (- times) regexp)) ! 321: ! 322: (defun View-search-last-regexp-forward (times) ! 323: "Search forward from window end for NTH instance of last regexp in View mode. ! 324: Displays line found at center of window. Sets mark at starting position ! 325: and pushes mark ring." ! 326: (interactive "p") ! 327: (View-search-regexp-forward times view-last-regexp)) ! 328: ! 329: (defun View-search-last-regexp-backward (times) ! 330: "Search backward from window start for NTH instance of last regexp in View mode. ! 331: Displays line found at center of window. Sets mark at starting position and ! 332: pushes mark ring." ! 333: (interactive "p") ! 334: (View-search-regexp-backward times view-last-regexp)) ! 335: ! 336: (defun View-back-to-mark (&optional ignore) ! 337: "Return to last mark set in View mode, else beginning of file. ! 338: Displays line at center of window. Pops mark ring so successive ! 339: invocations return to earlier marks." ! 340: (interactive) ! 341: (goto-char (or (mark) (point-min))) ! 342: (pop-mark) ! 343: (recenter (/ (view-window-size) 2))) ! 344: ! 345: (defun view-search (times regexp) ! 346: (setq view-last-regexp regexp) ! 347: (let (where) ! 348: (save-excursion ! 349: (move-to-window-line (if (< times 0) 0 -1)) ! 350: (if (re-search-forward regexp nil t times) ! 351: (setq where (point)))) ! 352: (if where ! 353: (progn ! 354: (push-mark) ! 355: (goto-char where) ! 356: (beginning-of-line) ! 357: (recenter (/ (view-window-size) 2))) ! 358: (message "Can't find occurrence %d of %s" times regexp) ! 359: (sit-for 4)))) ! 360:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.