|
|
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.