[comp.emacs] view/less mode for Gnu Emacs

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

I got a lot of requests for this mode, so I'm posting it rather than
trying to mail it to everyone.  This is a replacement for view-mode
that looks a lot like less.  It also acts like a minor mode, and
doesn't rebind any keys that it doesn't have to.  This library works
for v17 and v18, but under v17 there is a minor bug: the documentation
for view-mode doesn't list the local key bindings if it is called with
'C-hfview-mode'.  The help key in view-mode (h) still lists them
correctly.  If you don't have v17 anymore, you can get rid of the
macro v17/v18 and manually fix up the two places it is used.

I'm sending this to rms for possible inclusion in the distribution,
but I strongly suspect that if it appears it will be "less-mode"
rather than a replacement for view-mode.

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

;; Mods by Bengt Martensson, to closely resemble less
;; LastEditDate "Thu Jul 23 13:23:24 1987"

;; July 87, Gudeman again: added v17/v18 stuff and prefix for "q"

(provide 'view)

(defmacro v17/v18 (v17 &rest v18)
  "if this is Gnu Emacs version 17, evaluate only the first expression,
otherwise evaluate all except the first expression."
  (if (string-match "Emacs 17" (emacs-version)) v17
    (cons 'progn v18)))

(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-default-lines 10		; BM
  "Default value for the ""d"" and ""u"" commands in view-mode")

(defvar view-mode-map nil)		; Keybinding changed, BM
(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 "f" 'scroll-up)
  (define-key view-mode-map "\C-?" 'scroll-down)
  (define-key view-mode-map "b" 'scroll-down)
  (define-key view-mode-map "\C-m" 'scroll-lines-up)
  (define-key view-mode-map "e" 'scroll-lines-up)
  (define-key view-mode-map "j" 'scroll-lines-up)
  (define-key view-mode-map "y" 'scroll-lines-down)
  (define-key view-mode-map "k" 'scroll-lines-down)
  (define-key view-mode-map "d" 'scroll-some-lines-up)
  (define-key view-mode-map "u" 'scroll-some-lines-down)
  (define-key view-mode-map "r" 'recenter)
  (define-key view-mode-map "t" 'toggle-truncate-lines)
  (define-key view-mode-map "v" 'edit-view-buffer)
  (define-key view-mode-map "N" 'view-buffer)
  (define-key view-mode-map "E" 'view-file)
  (define-key view-mode-map "P" 'view-buffer)
  (define-key view-mode-map "!" 'shell-command)
  (define-key view-mode-map "|" 'shell-command-on-region)
  (define-key view-mode-map "=" 'what-line)
  (define-key view-mode-map "?" 'view-search-backward)
  (define-key view-mode-map "h" 'describe-view-mode)
  (define-key view-mode-map "s" 'view-repeat-search)
  (define-key view-mode-map "n" 'view-repeat-search)
  (define-key view-mode-map "/" 'view-search-forward)
  (define-key view-mode-map "\\" 'view-search-backward)
  (define-key view-mode-map "g" 'view-goto-line)
  (define-key view-mode-map "G" 'view-Goto-line)
  (define-key view-mode-map "%" 'view-goto-percent)
  (define-key view-mode-map "p" 'view-goto-percent)
  (define-key view-mode-map "m" 'point-to-register)
  (define-key view-mode-map "'" 'register-to-point)
  (define-key view-mode-map "C" 'view-cleanup-backspaces)
  (define-key view-mode-map "q" 'view-quit))

(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.  Only the local keybindings, and buffer-read-only
are changed by view-mode.  These changes can be undone 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.
\\[scroll-lines-up]	scroll prefix-arg lines forward, default 1.
\\[scroll-some-lines-down]	scroll prefix-arg lines backward, default 10.
\\[scroll-some-lines-up]	scroll prefix-arg lines forward, default 10.
\\[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
\\[toggle-truncate-lines]	toggle truncate-lines
\\[view-file]	view-file
\\[view-buffer]	view-buffer
\\[view-cleanup-backspaces]	cleanup backspace constructions
\\[edit-view-buffer]	switch back to editing mode for buffer
\\[view-quit]	bury the current buffer and switch to a new one, with a prefix
	kill the current buffer.

If invoked with the optional (prefix) arg non-nil, view-mode cleans up
backspace constructions."

  (interactive "P")
  (make-local-variable 'view-previous-values)
  (make-local-variable 'view-default-lines)
  (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))
  (v17/v18
   (set-minor-mode 'view-mode "View" t)	; fix for v 17, BM
   (setq mode-line-buffer-identification (list "View: %17b")))
  (setq 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 toggle-truncate-lines ()		; BM
  "Toggles the values of truncate-lines."
  (interactive)
  (setq truncate-lines (not truncate-lines))
  (recenter))

(defun view-cleanup-backspaces ()
  "Execute cleanup-backspaces even if the buffer is read only."
  (interactive)
  (let (buffer-read-only) (cleanup-backspaces)))

(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 scroll-some-lines-down (&optional N) ; BM
  "Scroll down prefix-arg lines, default 10, or last argument."
  (interactive "p")
  (if (> N 1) (setq view-default-lines N))
  (scroll-down view-default-lines))

(defun scroll-some-lines-up (&optional N) ; BM
  "Scroll up prefix-arg lines, default 10, or last argument."
  (interactive "p")
  (if (> N 1) (setq view-default-lines N))
  (scroll-up view-default-lines))

(defun view-goto-line (&optional N)	; BM
  "Goto line prefix, default 1."
  (interactive "p")
  (goto-line N))

(defun view-Goto-line (&optional N)	; BM
  "Goto line prefix, default last line."
  (interactive "p")
  (if (> N 1) (goto-line N)
    (progn
      (end-of-buffer)
      (recenter -1))))

(defun view-goto-percent (&optional p)	; BM
  "Sets mark and goes to a position PERCENT percent of the file."
  (interactive "p")
  (set-mark-command nil)
  (goto-char (+ (point-min) (/ (* p (- (point-max) (point-min))) 100)))
  (beginning-of-line))

(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)
    (v17/v18
     (set-minor-mode 'view-mode "View" nil) ; BM
     (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 (&optional p)
  "Switch to another buffer and bury this one.  With a prefix arg, kill the
current buffer."
  (interactive "P")
  (if p (kill-buffer (current-buffer))
    (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)))

;; to make auto-view-mode work automatically, add this to your .emacs file
;; (setq find-file-hooks (cons 'auto-view-mode find-file-hooks))

gwr@linus.UUCP (Gordon W. Ross) (08/22/87)

Though I found David Gudeman's version of view-mode (works like the
unix progam "less") to be welcome improvement over the standard
view-mode, I decided it needed a small improvement.

I use it to view formatted man pages (in /usr/man/cat[1-9]) and like
being able to remove the backspace constructions, but find it annoying
to be asked wether I want to save the man page buffer whenever I do a
save.  I don't even have write permission there.  Therefore, what
follows is a modified version of view-cleanup-backspaces which leaves
the buffer modified flag in whatever state it was in when this
function was called.  

Many thanks to David Gudeman for this very useful goodie (which he
posted to this newsgroup on 27 Jul 87).

(defun view-cleanup-backspaces ()
  "Execute cleanup-backspaces even if the buffer is read only.
Leave buffer-modified-p as it was upon entry to this function."
  (interactive)
  (let ((buffer-read-only)(buf-mod (buffer-modified-p)))
    (cleanup-backspaces)
    (set-buffer-modified-p buf-mod)
))
-- 
    Gordon W. Ross              ARPA: linus!gwr@MITRE-BEDFORD
    The MITRE Corporation       UUCP: decvax!linus!gwr
    Bedford, MA  01730		Phone: (617) 271-3205