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