git.chise.org Git - chise/xemacs-chise.git.1/blob - lisp/view-less.el

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