Mercurial > hg > xemacs-beta
annotate lisp/view-less.el @ 5750:66d2f63df75f
Correct some spelling and formatting in behavior.el.
Mentioned in tracker issue 826, the third thing mentioned there (the file
name at the bottom of the file) had already been fixed.
lisp/ChangeLog addition:
2013-08-05 Aidan Kehoe <kehoea@parhasard.net>
* behavior.el:
(override-behavior):
Correct some spelling and formatting here, thank you Steven
Mitchell in tracker issue 826.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 05 Aug 2013 10:05:32 +0100 |
parents | b3b28406da8c |
children |
rev | line source |
---|---|
428 | 1 ;;; view-less.el --- Minor mode for browsing files with keybindings like `less' |
2 | |
3 ;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp. | |
4 | |
5 ;; Author: Jonathan Stigelman <stig@hackvan.com> | |
6 ;; Maintainer: XEmacs Development Team | |
7 ;; Keywords: wp, unix | |
8 | |
9 ;; This file is part of XEmacs. | |
444 | 10 ;; |
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5235
diff
changeset
|
11 ;; XEmacs is free software: you can redistribute it and/or modify it |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5235
diff
changeset
|
12 ;; under the terms of the GNU General Public License as published by the |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5235
diff
changeset
|
13 ;; Free Software Foundation, either version 3 of the License, or (at your |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5235
diff
changeset
|
14 ;; option) any later version. |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5235
diff
changeset
|
15 |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5235
diff
changeset
|
16 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5235
diff
changeset
|
17 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5235
diff
changeset
|
18 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5235
diff
changeset
|
19 ;; for more details. |
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5235
diff
changeset
|
20 |
428 | 21 ;; You should have received a copy of the GNU General Public License |
5404
91b3aa59f49b
Convert lisp/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents:
5235
diff
changeset
|
22 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
428 | 23 |
24 ;;; Synched up with: Not in FSF. | |
25 | |
26 ;;; Commentary: | |
27 | |
28 ;; This mode is for browsing files without changing them. Keybindings | |
29 ;; similar to those used by the less(1) program are used. | |
30 ;; | |
31 ;; Originally written for v18 by David Gudeman (gudeman@arizona.edu) | |
32 ;; Mods by Bengt Martensson, to closely resemble less (July 1987) | |
33 ;; | |
444 | 34 ;; If you would like all write-protected files to be visited in view-mode, |
428 | 35 ;; then add the following to your .emacs file: |
36 ;; | |
37 ;; (add-hook 'find-file-hooks 'auto-view-mode) | |
38 | |
39 ;;; Code: | |
40 | |
5527
b3b28406da8c
Add a custom group that applies to view-mode-line-string.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5404
diff
changeset
|
41 (defgroup view nil |
b3b28406da8c
Add a custom group that applies to view-mode-line-string.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5404
diff
changeset
|
42 "Peruse file or buffer without editing." |
b3b28406da8c
Add a custom group that applies to view-mode-line-string.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5404
diff
changeset
|
43 :link '(function-link view-mode) |
b3b28406da8c
Add a custom group that applies to view-mode-line-string.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5404
diff
changeset
|
44 :group 'wp) |
b3b28406da8c
Add a custom group that applies to view-mode-line-string.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5404
diff
changeset
|
45 |
428 | 46 (defvar view-search-string "" |
47 "Last string searched for with view-search functions.") | |
48 | |
49 (defvar view-search-arg 1 | |
50 "Argument to last view search.") | |
51 | |
52 (defvar view-default-lines 10 | |
53 "Default value for the \"d\" and \"u\" commands in view-mode") | |
54 | |
1333 | 55 ;;;###autoload |
428 | 56 (defvar view-minor-mode nil |
57 "Non-nil when view-mode is active. Call `view-mode' to toggle.") | |
58 (make-variable-buffer-local 'view-minor-mode) | |
59 | |
60 ;;;###autoload | |
61 (defvar view-minor-mode-map | |
62 (let ((map (make-keymap))) | |
63 (set-keymap-name map 'view-minor-mode-map) | |
64 (suppress-keymap map) | |
65 (define-key map "-" 'negative-argument) | |
66 (define-key map " " 'scroll-up) | |
67 (define-key map "f" 'scroll-up) | |
68 (define-key map "b" 'scroll-down) | |
69 (define-key map 'backspace 'scroll-down) | |
70 (define-key map 'delete 'scroll-down) | |
71 (define-key map "\r" 'view-scroll-lines-up) | |
72 (define-key map "\n" 'view-scroll-lines-up) | |
73 (define-key map "e" 'view-scroll-lines-up) | |
74 (define-key map "j" 'view-scroll-lines-up) | |
75 (define-key map "y" 'view-scroll-lines-down) | |
76 (define-key map "k" 'view-scroll-lines-down) | |
77 (define-key map "d" 'view-scroll-some-lines-up) | |
78 (define-key map "u" 'view-scroll-some-lines-down) | |
79 (define-key map "r" 'recenter) | |
80 (define-key map "t" 'toggle-truncate-lines) | |
81 (define-key map "N" 'view-buffer) | |
82 (define-key map "E" 'view-file) | |
83 (define-key map "P" 'view-buffer) | |
84 (define-key map "!" 'shell-command) | |
85 (define-key map "|" 'shell-command-on-region) | |
86 (define-key map "=" 'what-line) | |
87 (define-key map "?" 'view-search-backward) | |
88 (define-key map "h" 'view-mode-describe) | |
89 (define-key map "s" 'view-repeat-search) | |
90 (define-key map "n" 'view-repeat-search) | |
91 (define-key map "/" 'view-search-forward) | |
92 (define-key map "\\" 'view-search-backward) | |
93 (define-key map "g" 'view-goto-line) | |
94 (define-key map "G" 'view-last-windowful) | |
95 (define-key map "%" 'view-goto-percent) | |
96 (define-key map "p" 'view-goto-percent) | |
97 (define-key map "m" 'point-to-register) | |
98 (define-key map "'" 'register-to-point) | |
99 (define-key map "C" 'view-cleanup-backspaces) | |
100 (define-key map "\C-c\C-c" 'view-quit) | |
101 ;; #### - should this use substitute-command-keys? | |
102 (define-key map "\C-x\C-q" 'view-quit-toggle-ro) | |
103 (define-key map "q" 'view-quit) | |
104 map | |
105 )) | |
106 | |
695 | 107 ;;;###autoload |
108 (defcustom view-mode-line-string " View" | |
109 "*String to display in the modeline when View mode is active. | |
110 Set this to nil if you don't want a modeline indicator." | |
111 :type '(choice string | |
112 (const :tag "none" nil))) | |
113 | |
114 (add-minor-mode 'view-minor-mode | |
115 'view-mode-line-string | |
116 view-minor-mode-map) | |
428 | 117 |
118 ;;;###autoload | |
119 (defvar view-mode-map | |
120 (let ((map (copy-keymap view-minor-mode-map))) | |
121 (set-keymap-name map 'view-mode-map) | |
122 map)) | |
123 | |
124 ;;;###autoload | |
444 | 125 (defun view-file (filename &optional other-window-p) |
126 "Find FILENAME, enter view mode. With prefix arg OTHER-WINDOW-P, use other window." | |
428 | 127 (interactive "fView File: \nP") |
444 | 128 (let ((old-p (get-file-buffer filename)) |
428 | 129 (obuf (current-buffer))) |
444 | 130 (if other-window-p |
131 (find-file-other-window filename) | |
132 (find-file filename)) | |
133 (view-mode (if other-window-p nil obuf) | |
428 | 134 (if old-p nil 'kill-buffer)) |
135 nil)) | |
136 | |
137 ;;;###autoload | |
444 | 138 (defun view-buffer (buffer &optional other-window-p) |
139 "Switch to BUFFER, enter view mode. With prefix arg use other window." | |
428 | 140 (interactive "bView Buffer: \nP") |
141 (let ((obuf (current-buffer))) | |
444 | 142 (if other-window-p |
143 (switch-to-buffer-other-window buffer) | |
144 (switch-to-buffer buffer)) | |
145 (view-mode (if other-window-p nil obuf) | |
146 (if other-window-p nil 'bury-buffer)))) | |
428 | 147 |
148 ;;;###autoload | |
444 | 149 (defun view-file-other-window (filename) |
150 "Find FILENAME in other window, and enter view mode." | |
428 | 151 (interactive "fView File: ") |
444 | 152 (view-file filename t)) |
428 | 153 |
154 ;;;###autoload | |
155 (defun view-buffer-other-window (buffer) | |
156 "Switch to BUFFER in another window, and enter view mode." | |
157 (interactive "bView Buffer: ") | |
158 (view-buffer buffer t)) | |
159 | |
160 (defun view-brief-help () | |
161 (message | |
162 (substitute-command-keys | |
163 "\\<view-minor-mode-map>\\[scroll-up] = page forward; \\[scroll-down] = page back; \ | |
164 \\[view-mode-describe] = help; \\[view-quit] = quit."))) | |
165 | |
166 (defvar view-major-mode) | |
167 (defvar view-exit-position) | |
168 (defvar view-prev-buffer) | |
169 (defvar view-exit-action) | |
170 (defvar view-old-buffer-read-only) | |
171 | |
172 ;;;###autoload | |
173 (defun view-minor-mode (&optional prev-buffer exit-action) | |
174 "Minor mode for viewing text, with bindings like `less'. | |
175 Commands are: | |
176 \\<view-minor-mode-map> | |
177 0..9 prefix args | |
178 - prefix minus | |
179 \\[scroll-up] page forward | |
180 \\[scroll-down] page back | |
181 \\[view-scroll-lines-up] scroll prefix-arg lines forward, default 1. | |
182 \\[view-scroll-lines-down] scroll prefix-arg lines backward, default 1. | |
183 \\[view-scroll-some-lines-down] scroll prefix-arg lines backward, default 10. | |
184 \\[view-scroll-some-lines-up] scroll prefix-arg lines forward, default 10. | |
185 \\[what-line] print line number | |
186 \\[view-mode-describe] print this help message | |
187 \\[view-search-forward] regexp search, uses previous string if you just hit RET | |
188 \\[view-search-backward] as above but searches backward | |
189 \\[view-repeat-search] repeat last search | |
190 \\[view-goto-line] goto line prefix-arg, default 1 | |
191 \\[view-last-windowful] goto line prefix-arg, default last line | |
192 \\[view-goto-percent] goto a position by percentage | |
193 \\[toggle-truncate-lines] toggle truncate-lines | |
194 \\[view-file] view another file | |
195 \\[view-buffer] view another buffer | |
196 \\[view-cleanup-backspaces] cleanup backspace constructions | |
197 \\[shell-command] execute a shell command | |
198 \\[shell-command-on-region]\ | |
199 execute a shell command with the region as input | |
200 \\[view-quit] exit view-mode, and bury the current buffer. | |
201 | |
202 If invoked with the optional (prefix) arg non-nil, view-mode cleans up | |
203 backspace constructions. | |
204 | |
205 More precisely: | |
206 \\{view-minor-mode-map}" | |
207 (interactive) | |
208 | |
209 (make-local-variable 'view-default-lines) | |
210 (set (make-local-variable 'view-exit-position) (point)) | |
211 (set (make-local-variable 'view-prev-buffer) prev-buffer) | |
212 (set (make-local-variable 'view-exit-action) exit-action) | |
213 (set (make-local-variable 'view-old-buffer-read-only) buffer-read-only) | |
214 (add-hook (make-local-variable 'change-major-mode-hook) | |
215 'view-fixup-read-only) | |
216 (setq view-minor-mode t | |
217 buffer-read-only t) | |
218 (view-brief-help)) | |
219 | |
220 ;;;###autoload | |
221 (defun view-mode (&optional prev-buffer exit-action clean-bs) | |
222 "View the current buffer using view-minor-mode. This exists to be 99.9% | |
223 compatible with the implementations of `view-mode' in view.el and older | |
224 versions of view-less.el." | |
225 (interactive (list nil 'bury-buffer current-prefix-arg)) | |
226 ;; #### - The first two arguments provide compatibility with view.el (and | |
227 ;; thus FSFmacs), while the third argument as a prefix argument maintains | |
228 ;; interactive compatibility with older versions of view-less. --Stig | |
229 (if clean-bs (cleanup-backspaces)) | |
230 (view-minor-mode prev-buffer exit-action)) | |
231 | |
232 ;;;###autoload | |
233 (defun view-major-mode (&optional prev-buffer exit-action clean-bs) | |
234 "View the current buffer using view-mode, as a major mode. | |
235 This function has a nonstandard name because `view-mode' is wrongly | |
236 named but is like this for compatibility reasons." | |
237 ;; #### - The first two arguments provide compatibility with view.el (and | |
238 ;; thus FSFmacs), while the third argument as a prefix argument maintains | |
239 ;; interactive compatibility with older versions of view-less. --Stig | |
240 (interactive (list nil 'bury-buffer current-prefix-arg)) | |
241 (kill-all-local-variables) | |
242 (use-local-map view-mode-map) | |
243 (setq major-mode 'view-mode) | |
244 (set (make-local-variable 'view-exit-position) (point)) | |
245 (set (make-local-variable 'view-prev-buffer) prev-buffer) | |
246 (set (make-local-variable 'view-exit-action) exit-action) | |
247 (set (make-local-variable 'view-old-buffer-read-only) buffer-read-only) | |
248 (set (make-local-variable 'view-major-mode) t) | |
249 (setq buffer-read-only t) | |
250 (if clean-bs (cleanup-backspaces)) | |
251 (run-hooks 'view-mode-hook)) | |
252 | |
253 ;;;###autoload | |
254 (defun auto-view-mode () | |
255 "If the file of the current buffer is not writable, call view-mode. | |
256 This is meant to be added to `find-file-hooks'." | |
257 (or (file-writable-p buffer-file-name) | |
258 (view-minor-mode))) | |
259 | |
260 (defun view-fixup-read-only () | |
261 ;; doing M-x normal mode should NOT leave the buffer read-only | |
262 (and (boundp 'view-old-buffer-read-only) | |
263 (progn (setq buffer-read-only view-old-buffer-read-only) | |
264 (kill-local-variable 'view-old-buffer-read-only)))) | |
265 | |
266 (defun view-quit-toggle-ro () | |
267 "Exit view mode and execute the global binding of the key that invoked this | |
268 command. Normally, this will toggle the state of `buffer-read-only', perhaps | |
269 invoking some version-control mechanism." | |
444 | 270 (interactive) |
428 | 271 (setq view-exit-position nil) |
272 ;; Kludge so this works as advertised. Stig, why can't you write | |
273 ;; bug-free code??? | |
274 (let ((buffer-read-only buffer-read-only)) | |
275 (view-quit t)) | |
276 ;; no longer in view-minor-mode, so the keymap has changed... | |
277 (call-interactively (key-binding (this-command-keys)))) | |
278 | |
279 (defun view-quit (&optional no-exit-action) | |
280 "Exit view mode. With prefix argument, keep the current buffer selected." | |
281 (interactive "P") | |
282 (view-fixup-read-only) | |
283 (setq view-minor-mode nil) | |
284 (if view-exit-position (goto-char view-exit-position)) | |
285 (if (and (boundp 'view-major-mode) view-major-mode) | |
286 (fundamental-mode) | |
287 (let ((pbuf view-prev-buffer) | |
288 (exitact view-exit-action)) | |
289 (if no-exit-action | |
290 nil | |
291 (if exitact (funcall exitact (current-buffer))) | |
292 (if pbuf (switch-to-buffer pbuf)))))) | |
293 | |
294 ;; #### - similar to what's in man.el and this ought to be written in C anyway... --Stig | |
295 (defun cleanup-backspaces () | |
296 "Cleanup backspace constructions. | |
297 _^H and ^H_ sequences are deleted. x^Hx sequences are turned into x for all | |
298 characters x. ^^H| and |^H^ sequences are turned into ^. +^Ho and o^H+ are | |
299 turned into (+)." | |
300 (interactive) | |
301 (save-excursion | |
302 (goto-char (point-min)) | |
303 (while (= (following-char) ?\C-h) | |
304 (delete-char 1)) | |
305 (while (search-forward "\C-h" nil t) | |
446 | 306 (backward-char 2) |
428 | 307 (cond ((looking-at "_\C-h\\|\\(.\\)\C-h\\1\\||\C-h\\^") |
308 (delete-char 2)) | |
309 ((looking-at ".\C-h_\\|\\^\C-h|") | |
310 (forward-char 1) | |
311 (delete-char 2)) | |
312 ((looking-at "+\C-ho\\|o\C-h+") | |
313 (delete-char 3) | |
314 (insert "(+)")) | |
315 ((looking-at "|\C-h-") | |
316 (delete-char 3) | |
317 (insert "*")) | |
318 (t (forward-char 2)))))) | |
319 | |
320 (defun view-cleanup-backspaces () | |
321 "Cleanup backspaces and if buffer is currently unmodified, don't flag it | |
322 as a modified buffer. This works even if the buffer is read-only." | |
323 (interactive) | |
324 (let ((buffer-read-only) | |
325 (buf-mod (buffer-modified-p))) | |
326 (cleanup-backspaces) | |
327 ;; #### - THIS IS PROBABLY A REALLY DANGEROUS THING TO DO IN A MINOR MODE!! | |
328 (set-buffer-modified-p buf-mod))) | |
329 | |
330 ;;;###autoload | |
331 (defun toggle-truncate-lines (&optional p) | |
332 "Toggles the values of truncate-lines. | |
333 Positive prefix arg sets, negative disables." | |
334 (interactive "P") | |
335 (setq truncate-lines (if p | |
336 (> (prefix-numeric-value p) 0) | |
337 (not truncate-lines))) | |
338 (recenter)) | |
339 | |
340 (defun view-scroll-lines-up (p) | |
341 "Scroll up prefix-arg lines, default 1." | |
342 (interactive "p") | |
343 (scroll-up p)) | |
344 | |
345 (defun view-scroll-lines-down (p) | |
346 "Scroll down prefix-arg lines, default 1." | |
347 (interactive "p") | |
348 (scroll-up (- p))) | |
349 | |
350 (defun view-scroll-some-lines-down (&optional n) | |
351 "Scroll down prefix-arg lines, default 10, or last argument." | |
352 (interactive "p") | |
353 (if (> n 1) (setq view-default-lines n)) | |
354 (scroll-down view-default-lines)) | |
355 | |
356 (defun view-scroll-some-lines-up (&optional n) | |
357 "Scroll up prefix-arg lines, default 10, or last argument." | |
358 (interactive "p") | |
359 (if (> n 1) (setq view-default-lines n)) | |
360 (scroll-up view-default-lines)) | |
361 | |
362 (defun view-goto-line (&optional n) | |
363 "Goto prefix arg line N. N = 1 by default.." | |
364 (interactive "p") | |
365 (goto-line n)) | |
366 | |
367 (defun view-last-windowful (&optional n) | |
368 "Goto prefix arg line N or the first line of the last windowful in buffer." | |
369 (interactive "p") | |
370 (if current-prefix-arg | |
371 (goto-line n) | |
372 (end-of-buffer) | |
373 (recenter -1) | |
374 (move-to-window-line 0))) | |
375 | |
376 (defun view-goto-percent (&optional percent) | |
377 "Set mark and go to a position PERCENT way into the current buffer." | |
378 (interactive "p") | |
379 (set-mark-command nil) | |
380 (goto-char (+ (point-min) (/ (* percent (- (point-max) (point-min))) 100))) | |
381 (beginning-of-line)) | |
382 | |
383 (defun view-mode-describe () | |
384 (interactive) | |
385 (let ((mode-name "View") | |
386 (major-mode 'view-mode)) | |
387 (describe-mode))) | |
388 | |
389 (defun view-search-forward (s p) | |
390 "Search forward for REGEXP. If regexp is empty, use last search string. | |
391 With prefix ARG, search forward that many occurrences." | |
392 (interactive "sView search: \np") | |
393 (unwind-protect | |
444 | 394 (re-search-forward |
428 | 395 (if (string-equal "" s) view-search-string s) nil nil p) |
396 (setq view-search-arg p) | |
397 (or (string-equal "" s) | |
398 (setq view-search-string s)))) | |
399 | |
400 (defun view-search-backward (s p) | |
401 "Search backward for REGEXP. If regexp is empty, use last search string. | |
402 With prefix ARG, search forward that many occurrences." | |
403 (interactive "sView search backward: \np") | |
404 (view-search-forward s (- p))) | |
405 | |
406 (defun view-repeat-search (p) | |
407 "Repeat last view search command. If a prefix arg is given, use that | |
408 instead of the previous arg, if the prefix is just a -, then take the | |
409 negative of the last prefix arg." | |
410 (interactive "P") | |
411 (view-search-forward | |
412 view-search-string | |
413 (cond ((null p) view-search-arg) | |
414 ((eq p '-) (- view-search-arg)) | |
415 (t (prefix-numeric-value p))))) | |
416 | |
417 (provide 'view) | |
418 (provide 'view-less) | |
419 | |
420 ;;; view-less.el ends here |