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