Mercurial > emacs
comparison lisp/view.el @ 44:a25bf36b0410
Initial revision
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Wed, 17 Jan 1990 16:51:47 +0000 |
parents | |
children | 7e4c7ef44243 |
comparison
equal
deleted
inserted
replaced
43:3e1aeff0200f | 44:a25bf36b0410 |
---|---|
1 ;; View: Peruse file or buffer without editing. | |
2 ;; Copyright (C) 1985, 1989 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" 'view-exit) | |
30 (define-key view-mode-map "\C-z" 'suspend-emacs) | |
31 (define-key view-mode-map "q" 'view-exit) | |
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" 'next-line) | |
78 (define-key view-mode-map "\C-p" '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 ((old-buf (current-buffer)) | |
104 (had-a-buf (get-file-buffer file-name)) | |
105 (buf-to-view (find-file-noselect file-name))) | |
106 (switch-to-buffer buf-to-view t) | |
107 (view-mode old-buf | |
108 (and (not had-a-buf) (not (buffer-modified-p buf-to-view)) | |
109 'kill-buffer)))) | |
110 | |
111 (defun view-buffer (buffer-name) | |
112 "View BUFFER in View mode, returning to previous buffer when done. | |
113 The usual Emacs commands are not available; instead, | |
114 a special set of commands (mostly letters and punctuation) | |
115 are defined for moving around in the buffer. | |
116 Space scrolls forward, Delete scrolls backward. | |
117 For list of all View commands, type ? or h while viewing. | |
118 | |
119 Calls the value of view-hook if that is non-nil." | |
120 (interactive "bView buffer: ") | |
121 (let ((old-buf (current-buffer))) | |
122 (switch-to-buffer buffer-name t) | |
123 (view-mode old-buf nil))) | |
124 | |
125 (defun view-mode (&optional prev-buffer action) | |
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 (make-local-variable 'view-old-mode-line-buffer-identification) | |
167 (setq view-old-mode-line-buffer-identification | |
168 mode-line-buffer-identification) | |
169 (make-local-variable 'view-old-buffer-read-only) | |
170 (setq view-old-buffer-read-only buffer-read-only) | |
171 (make-local-variable 'view-old-mode-name) | |
172 (setq view-old-mode-name mode-name) | |
173 (make-local-variable 'view-old-major-mode) | |
174 (setq view-old-major-mode major-mode) | |
175 (make-local-variable 'view-old-local-map) | |
176 (setq view-old-local-map (current-local-map)) | |
177 (make-local-variable 'view-old-Helper-return-blurb) | |
178 (setq view-old-Helper-return-blurb | |
179 (and (boundp 'Helper-return-blurb) Helper-return-blurb)) | |
180 | |
181 (setq buffer-read-only t) | |
182 (setq mode-line-buffer-identification | |
183 (list | |
184 (if (buffer-file-name) | |
185 "Viewing %f" | |
186 "Viewing %b"))) | |
187 (setq mode-name "View") | |
188 (setq major-mode 'view-mode) | |
189 (setq Helper-return-blurb | |
190 (format "continue viewing %s" | |
191 (if (buffer-file-name) | |
192 (file-name-nondirectory (buffer-file-name)) | |
193 (buffer-name)))) | |
194 | |
195 (make-local-variable 'view-exit-action) | |
196 (setq view-exit-action action) | |
197 (make-local-variable 'view-prev-buffer) | |
198 (setq view-prev-buffer prev-buffer) | |
199 (make-local-variable 'view-exit-position) | |
200 (setq view-exit-position (point-marker)) | |
201 | |
202 (make-local-variable 'view-scroll-size) | |
203 (setq view-scroll-size nil) | |
204 (make-local-variable 'view-last-regexp) | |
205 (setq view-last-regexp nil) | |
206 | |
207 (beginning-of-line) | |
208 (setq goal-column nil) | |
209 | |
210 (use-local-map view-mode-map) | |
211 (run-hooks 'view-hook) | |
212 (view-helpful-message)) | |
213 | |
214 (defun view-exit () | |
215 "Exit from view-mode. | |
216 If you viewed an existing buffer, that buffer returns to its previous mode. | |
217 If you viewed a file that was not present in Emacs, its buffer is killed." | |
218 (interactive) | |
219 (setq mode-line-buffer-identification | |
220 view-old-mode-line-buffer-identification) | |
221 (setq major-mode view-old-major-mode) | |
222 (setq mode-name view-old-mode-name) | |
223 (use-local-map (current-local-map)) | |
224 (setq buffer-read-only view-old-buffer-read-only) | |
225 | |
226 (goto-char view-exit-position) | |
227 (set-marker view-exit-position nil) | |
228 | |
229 ;; Now do something to the buffer that we were viewing | |
230 ;; (such as kill it). | |
231 (let ((viewed-buffer (current-buffer)) | |
232 (action view-exit-action)) | |
233 (switch-to-buffer view-prev-buffer) | |
234 (if action (funcall action viewed-buffer)))) | |
235 | |
236 (defun view-helpful-message () | |
237 (message | |
238 (if (and (eq (key-binding "\C-h") 'Helper-help) | |
239 (eq (key-binding "?") 'Helper-describe-bindings) | |
240 (eq (key-binding "\C-c") 'view-exit)) | |
241 "Type C-h for help, ? for commands, C-c to quit" | |
242 (substitute-command-keys | |
243 "Type \\[Helper-help] for help, \\[Helper-describe-bindings] for commands, \\[exit-recursive-edit] to quit.")))) | |
244 | |
245 (defun View-undefined () | |
246 (interactive) | |
247 (ding) | |
248 (view-helpful-message)) | |
249 | |
250 (defun view-window-size () (1- (window-height))) | |
251 | |
252 (defun view-scroll-size () | |
253 (min (view-window-size) (or view-scroll-size (view-window-size)))) | |
254 | |
255 (defvar view-hook nil | |
256 "If non-nil, its value is called when viewing buffer or file.") | |
257 | |
258 ;(defun view-last-command (&optional who what) | |
259 ; (setq view-last-command-entry this-command) | |
260 ; (setq view-last-command who) | |
261 ; (setq view-last-command-argument what)) | |
262 | |
263 ;(defun View-repeat-last-command () | |
264 ; "Repeat last command issued in View mode." | |
265 ; (interactive) | |
266 ; (if (and view-last-command | |
267 ; (eq view-last-command-entry last-command)) | |
268 ; (funcall view-last-command view-last-command-argument)) | |
269 ; (setq this-command view-last-command-entry)) | |
270 | |
271 (defun View-goto-line (&optional line) | |
272 "Move to LINE in View mode. | |
273 Display is centered at LINE. Sets mark at starting position and pushes | |
274 mark ring." | |
275 (interactive "p") | |
276 (push-mark) | |
277 (goto-line (or line 1)) | |
278 (recenter (/ (view-window-size) 2))) | |
279 | |
280 (defun View-scroll-lines-forward (&optional lines) | |
281 "Scroll forward in View mode, or exit if end of text is visible. | |
282 No arg means whole window full, or number of lines set by \\[View-scroll-lines-forward-set-scroll-size]. | |
283 Arg is number of lines to scroll." | |
284 (interactive "P") | |
285 (if (pos-visible-in-window-p (point-max)) | |
286 (exit-recursive-edit)) | |
287 (setq lines | |
288 (if lines (prefix-numeric-value lines) | |
289 (view-scroll-size))) | |
290 ; (view-last-command 'View-scroll-lines-forward lines) | |
291 (if (>= lines (view-window-size)) | |
292 (scroll-up nil) | |
293 (if (>= (- lines) (view-window-size)) | |
294 (scroll-down nil) | |
295 (scroll-up lines))) | |
296 (cond ((pos-visible-in-window-p (point-max)) | |
297 (goto-char (point-max)) | |
298 (recenter -1) | |
299 (message (substitute-command-keys | |
300 "End. Type \\[exit-recursive-edit] to quit viewing.")))) | |
301 (move-to-window-line -1) | |
302 (beginning-of-line)) | |
303 | |
304 (defun View-scroll-lines-forward-set-scroll-size (&optional lines) | |
305 "Scroll forward LINES lines in View mode, setting the \"scroll size\". | |
306 This is the number of lines which \\[View-scroll-lines-forward] and \\[View-scroll-lines-backward] scroll by default. | |
307 The absolute value of LINES is used, so this command can be used to scroll | |
308 backwards (but \"scroll size\" is always positive). If LINES is greater than | |
309 window height or omitted, then window height is assumed. If LINES is less | |
310 than window height then scrolling context is provided from previous screen." | |
311 (interactive "P") | |
312 (if (not lines) | |
313 (setq view-scroll-size (view-window-size)) | |
314 (setq lines (prefix-numeric-value lines)) | |
315 (setq view-scroll-size | |
316 (min (if (> lines 0) lines (- lines)) (view-window-size)))) | |
317 (View-scroll-lines-forward lines)) | |
318 | |
319 (defun View-scroll-one-more-line (&optional arg) | |
320 "Scroll one more line up in View mode. | |
321 With ARG scroll one line down." | |
322 (interactive "P") | |
323 (View-scroll-lines-forward (if (not arg) 1 -1))) | |
324 | |
325 (defun View-scroll-lines-backward (&optional lines) | |
326 "Scroll backward in View mode. | |
327 No arg means whole window full, or number of lines set by \\[View-scroll-lines-forward-set-scroll-size]. | |
328 Arg is number of lines to scroll." | |
329 (interactive "P") | |
330 (View-scroll-lines-forward (if lines | |
331 (- (prefix-numeric-value lines)) | |
332 (- (view-scroll-size))))) | |
333 | |
334 (defun View-search-regexp-forward (times regexp) | |
335 "Search forward for NTH occurrence of REGEXP in View mode. | |
336 Displays line found at center of window. REGEXP is remembered for | |
337 searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward]. Sets mark at starting position and pushes mark ring." | |
338 (interactive "p\nsSearch forward (regexp): ") | |
339 (if (> (length regexp) 0) | |
340 (progn | |
341 ;(view-last-command 'View-search-last-regexp-forward times) | |
342 (view-search times regexp)))) | |
343 | |
344 (defun View-search-regexp-backward (times regexp) | |
345 "Search backward from window start for NTH instance of REGEXP in View mode. | |
346 Displays line found at center of window. REGEXP is remembered for | |
347 searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward]. Sets mark at starting position and pushes mark ring." | |
348 (interactive "p\nsSearch backward (regexp): ") | |
349 (View-search-regexp-forward (- times) regexp)) | |
350 | |
351 (defun View-search-last-regexp-forward (times) | |
352 "Search forward from window end for NTH instance of last regexp in View mode. | |
353 Displays line found at center of window. Sets mark at starting position | |
354 and pushes mark ring." | |
355 (interactive "p") | |
356 (View-search-regexp-forward times view-last-regexp)) | |
357 | |
358 (defun View-search-last-regexp-backward (times) | |
359 "Search backward from window start for NTH instance of last regexp in View mode. | |
360 Displays line found at center of window. Sets mark at starting position and | |
361 pushes mark ring." | |
362 (interactive "p") | |
363 (View-search-regexp-backward times view-last-regexp)) | |
364 | |
365 (defun View-back-to-mark (&optional ignore) | |
366 "Return to last mark set in View mode, else beginning of file. | |
367 Displays line at center of window. Pops mark ring so successive | |
368 invocations return to earlier marks." | |
369 (interactive) | |
370 (goto-char (or (mark) (point-min))) | |
371 (pop-mark) | |
372 (recenter (/ (view-window-size) 2))) | |
373 | |
374 (defun view-search (times regexp) | |
375 (setq view-last-regexp regexp) | |
376 (let (where) | |
377 (save-excursion | |
378 (move-to-window-line (if (< times 0) 0 -1)) | |
379 (if (re-search-forward regexp nil t times) | |
380 (setq where (point)))) | |
381 (if where | |
382 (progn | |
383 (push-mark) | |
384 (goto-char where) | |
385 (beginning-of-line) | |
386 (recenter (/ (view-window-size) 2))) | |
387 (message "Can't find occurrence %d of %s" times regexp) | |
388 (sit-for 4)))) | |
389 |