Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!uunet!seismo!husc6!hao!noao!arizona!gudeman
From: gudeman@arizona.edu (David Gudeman)
Newsgroups: comp.emacs
Subject: view/less mode for Gnu Emacs
Message-ID: <1835@megaron.arizona.edu>
Date: Mon, 27-Jul-87 14:17:47 EDT
Article-I.D.: megaron.1835
Posted: Mon Jul 27 14:17:47 1987
Date-Received: Wed, 29-Jul-87 01:47:36 EDT
Organization: U of Arizona CS Dept, Tucson
Lines: 287

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:
\\
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))