[comp.emacs] view.el for Gnu Emacs

gudeman@arizona.edu (David Gudeman) (07/08/87)

I recently saw a request for a view mode that doesn't have the
obnoxious (my own adjective) feature of disabling all of the standard
keybindings.  I have never used the view mode that comes with Gnu for
this very reason, so I decided to go ahead and write a new version of
it.  This is probably not very similar to the standard view, since I
don't care for the standard one, and don't remember it very well
anyway.  I started out to make it look like more(1), but decided that
there was too much garbage there.

This view is as much like a minor mode as possible, and allows you to
reverse the changes with the e command.  It also makes it easy to
specify `other window' by using a prefix arg.  I also included a
function that can be put in find-file-hooks to call view-mode
automatically when the file is read only (see the last line).  I think
the only thing needed to make this run on Gnu v17, is the way the mode
line is handled.  Caveat: I usually use a package a couple of months
before posting it, but since there was a request, I'm posting this
with only minor testing.

;; Written by David Gudeman (gudeman@arizona.edu)
;; Gnu Emacs v18 only.
(provide 'view)

(defvar view-search-string ""
  "Last string searched for with view-search functions.")

(defvar view-search-arg 1
  "Arg to last view search.")

(defvar view-previous-values nil
  "Values of buffer variables before view-mode was called.  It's a list
of local-keymap, mode-line-buffer-identification, and buffer-read-only
in that order.")

(defvar view-mode-map nil)
(if view-mode-map nil
  (setq view-mode-map (make-keymap))
  (let ((i ?0))
    (while (<= i ?9)
      (define-key view-mode-map (char-to-string i) 'digit-argument)
      (setq i (1+ i))))
  (define-key view-mode-map "-" 'negative-argument)
  (define-key view-mode-map " " 'scroll-up)
  (define-key view-mode-map "\C-?" 'scroll-down)
  (define-key view-mode-map "n" 'scroll-up)
  (define-key view-mode-map "p" 'scroll-down)
  (define-key view-mode-map "\C-m" 'scroll-lines-up)
  (define-key view-mode-map "f" 'scroll-lines-up)
  (define-key view-mode-map "b" 'scroll-lines-down)
  (define-key view-mode-map "e" 'edit-view-buffer)
  (define-key view-mode-map "=" 'what-line)
  (define-key view-mode-map "?" 'describe-view-mode)
  (define-key view-mode-map "h" 'describe-view-mode)
  (define-key view-mode-map "s" 'view-repeat-search)
  (define-key view-mode-map "/" 'view-search-forward)
  (define-key view-mode-map "\\" 'view-search-backward)
  (define-key view-mode-map "q" 'view-quit)
  (define-key view-mode-map "x" 'kill-buffer))

(defun view-file (file &optional p)
  "Find FILE, enter view mode.  With prefix arg use other window."
  (interactive "fView File: \nP")
  (if p (find-file-other-window file)
    (find-file file))
  (view-mode))

(defun view-buffer (buf &optional p)
  "Switch to BUF, enter view mode.  With prefix arg use other window."
  (interactive "bView Buffer: \nP")
  (if p (switch-to-buffer-other-window buf)
    (switch-to-buffer buf))
  (view-mode))

(defun view-mode (&optional p)
  "Mode for viewing text.  With prefix arg, cleanup backspaces first.
This mode changes as little of the current mode as possible, and what it
does change can be restored by the e command.  Commands are:
\\<view-mode-map>
0..9	prefix args
-	prefix minus
SPC	scroll-up
DEL	scroll-down
RET	scroll prefix-arg lines forward, default 1
\\[scroll-lines-down]	scroll prefix-arg lines backward, default 1.
\\[what-line]	print line number
\\[describe-view-mode]	print this help message
\\[view-search-forward]	regexp search, uses previous string if you just hit RET
\\[view-search-backward]	as above but searches backward
\\[view-repeat-search]	repeat last search
\\[edit-view-buffer]	switch back to editing mode for buffer
\\[view-quit]	bury the current buffer and switch to a new one
\\[kill-buffer]	kill-buffer"
  (interactive "P")
  (make-local-variable 'view-previous-values)
  (or view-previous-values
      (setq view-previous-values
	    (list (current-local-map)
		  (assoc 'mode-line-buffer-identification
			 (buffer-local-variables))
		  buffer-read-only)))
  (use-local-map view-mode-map)
  (if p (cleanup-backspaces))
  (setq mode-line-buffer-identification (list "View: %17b")
	buffer-read-only t))

(defun cleanup-backspaces ()
  "Cleanup backspace constructions.
_^H and ^H_ sequences are deleted.  x^Hx sequences are turned into x for all
characters x.  ^^H| and |^H^ sequences are turned into ^.  +^Ho and o^H+ are
turned into (+)."
  (interactive)
  (save-excursion
    (goto-char (point-min))
    (while (= (following-char) ?\C-h)
      (delete-char 1))
    (while (search-forward "\C-h" nil t)
      (forward-char -2)
      (cond ((looking-at "_\C-h\\|\\(.\\)\C-h\\1\\||\C-h\\^")
	     (delete-char 2))
	    ((looking-at ".\C-h_\\|\\^\C-h|")
	     (forward-char 1)
	     (delete-char 2))
	    ((looking-at "+\C-ho\\|o\C-h+")
	     (delete-char 3)
	     (insert "(+)"))
	    (t (forward-char 2))))))

(defun scroll-lines-up (p)
  "Scroll up prefix-arg lines, default 1."
  (interactive "p")
  (scroll-up p))

(defun scroll-lines-down (p)
  "Scroll down prefix-arg lines, default 1."
  (interactive "p")
  (scroll-up (- p)))

(defun edit-view-buffer ()
  "Return to buffer's previous mode, and make buffer modifiable."
  (interactive)
  (let ((map (nth 0 view-previous-values))
	(buf-id (nth 1 view-previous-values))
	(buf-r/o (nth 2 view-previous-values))
	(buf-mod (buffer-modified-p)))
    (use-local-map map)
    (if buf-id (setq mode-line-buffer-identification buf-id)
      (kill-local-variable 'mode-line-buffer-identification))
    (setq buffer-read-only buf-r/o)
    (kill-local-variable 'view-previous-values)
    (set-buffer-modified-p buf-mod)))	; hack to update the mode line

(defun describe-view-mode ()
  (interactive)
  (let ((mode-name "View")
	(major-mode 'view-mode))
    (describe-mode)))

(defun view-search-forward (s p)
  "Search forward for REGEXP.  If regexp is empty, use last search string.
With prefix ARG, search forward that many occurrences."
  (interactive "sView search: \np")
  (unwind-protect
      (re-search-forward
       (if (string= "" s) view-search-string s) nil nil p)
    (setq view-search-arg p)
    (or (string= "" s)
	(setq view-search-string s))))

(defun view-search-backward (s p)
  "Search backward for REGEXP.  If regexp is empty, use last search string.
With prefix ARG, search forward that many occurrences."
  (interactive "sView search backward: \np")
  (view-search-forward s (- p)))

(defun view-repeat-search (p)
  "Repeat last view search command.  If a prefix arg is given, use that
instead of the previous arg, if the prefix is just a -, then take the
negative of the last prefix arg."
  (interactive "P")
  (view-search-forward
   view-search-string
   (cond ((null p) view-search-arg)
	 ((eq p '-) (- view-search-arg))
	 (t (prefix-numeric-value p)))))

(defun view-quit ()
  "Switch to another buffer and bury this one."
  (interactive)
  (bury-buffer (current-buffer))
  (switch-to-buffer nil))

(defun auto-view-mode ()
  "If the current buffer is read-only, call view-mode.  This is meant to be
added to find-file-hooks."
  (if buffer-read-only (view-mode)))
;; (setq find-file-hooks (cons 'auto-view-mode find-file-hooks))