Load cus-start.
[bpt/emacs.git] / lisp / view.el
index 0a3ff20..bbc168b 100644 (file)
@@ -1,6 +1,6 @@
 ;;; view.el --- peruse file or buffer without editing.
 
-;; Copyright (C) 1985, 1989 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1989, 1994, 1995 Free Software Foundation, Inc.
 
 ;; Author: K. Shane Hartman
 ;; Maintainer: FSF
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
-;; This package provides the `view' major mode documented in the Emacs
+;; This package provides the `view' minor mode documented in the Emacs
 ;; user's manual.
 
 ;;; Code:
 
+;;;###autoload
+(defvar view-highlight-face 'highlight
+   "*The overlay face used for highlighting the match found by View mode search.")
+
+(defvar view-mode nil "Non-nil if View mode is enabled.")
+(make-variable-buffer-local 'view-mode)
+
+(defvar view-mode-auto-exit nil
+  "Non-nil means scrolling past the end of buffer exits View mode.
+Some commands, such as \\[view-file], set this to t locally;
+the only way to override that is to set it to nil using `view-mode-hook'.")
+
+(make-variable-buffer-local 'view-mode-auto-exit)
+
+(defvar view-old-buffer-read-only nil)
+(make-variable-buffer-local 'view-old-buffer-read-only)
+(defvar view-old-Helper-return-blurb)
+(make-variable-buffer-local 'view-old-Helper-return-blurb)
+
+(defvar view-scroll-size nil)
+(make-variable-buffer-local 'view-scroll-size)
+
+(defvar view-last-regexp nil)
+(make-variable-buffer-local 'view-last-regexp)
+
+(defvar view-exit-action nil)
+(make-variable-buffer-local 'view-exit-action)
+(defvar view-return-here nil)
+(make-variable-buffer-local 'view-return-here)
+(defvar view-exit-position nil)
+(make-variable-buffer-local 'view-exit-position)
+
+(defvar view-overlay nil
+  "Overlay used to display where a search operation found its match.
+This is local in each buffer, once it is used.")
+(make-variable-buffer-local 'view-overlay)
+
+(or (assq 'view-mode minor-mode-alist)
+    (setq minor-mode-alist
+         (cons '(view-mode " View") minor-mode-alist)))
+
 (defvar view-mode-map nil)
 (if view-mode-map
     nil
   (setq view-mode-map (make-keymap))
-  (fillarray (nth 1 view-mode-map) 'View-undefined)
-  (define-key view-mode-map "\C-c" 'view-exit)
+  ;; We used to call suppress-keymap here, but that isn't good in a minor mode.
+  ;; Self-inserting characters will beep anyway, since the buffer is read-only,
+  ;; and we should not interfere with letters that serve as useful commands.
   (define-key view-mode-map "q" 'view-exit)
-  (define-key view-mode-map "-" 'negative-argument)
-  (define-key view-mode-map "0" 'digit-argument)
-  (define-key view-mode-map "1" 'digit-argument)
-  (define-key view-mode-map "2" 'digit-argument)
-  (define-key view-mode-map "3" 'digit-argument)
-  (define-key view-mode-map "4" 'digit-argument)
-  (define-key view-mode-map "5" 'digit-argument)
-  (define-key view-mode-map "6" 'digit-argument)
-  (define-key view-mode-map "7" 'digit-argument)
-  (define-key view-mode-map "8" 'digit-argument)
-  (define-key view-mode-map "9" 'digit-argument)
-  (define-key view-mode-map "\C-u" 'universal-argument)
-  (define-key view-mode-map "\e" nil)
-  (define-key view-mode-map "\C-x" 'Control-X-prefix)
-  (define-key view-mode-map "\e-" 'negative-argument)
-  (define-key view-mode-map "\e0" 'digit-argument)
-  (define-key view-mode-map "\e1" 'digit-argument)
-  (define-key view-mode-map "\e2" 'digit-argument)
-  (define-key view-mode-map "\e3" 'digit-argument)
-  (define-key view-mode-map "\e4" 'digit-argument)
-  (define-key view-mode-map "\e5" 'digit-argument)
-  (define-key view-mode-map "\e6" 'digit-argument)
-  (define-key view-mode-map "\e7" 'digit-argument)
-  (define-key view-mode-map "\e8" 'digit-argument)
-  (define-key view-mode-map "\e9" 'digit-argument)
   (define-key view-mode-map "<" 'beginning-of-buffer)
   (define-key view-mode-map ">" 'end-of-buffer)
   (define-key view-mode-map "\ev" 'View-scroll-lines-backward)
   (define-key view-mode-map "\C-v" 'View-scroll-lines-forward)
   (define-key view-mode-map " " 'View-scroll-lines-forward)
-  (define-key view-mode-map "\177" 'View-scroll-lines-backward)
+  (define-key view-mode-map "\C-?" 'View-scroll-lines-backward)
   (define-key view-mode-map "\n" 'View-scroll-one-more-line)
   (define-key view-mode-map "\r" 'View-scroll-one-more-line)
-  (define-key view-mode-map "\C-l" 'recenter)
   (define-key view-mode-map "z" 'View-scroll-lines-forward-set-scroll-size)
   (define-key view-mode-map "g" 'View-goto-line)
   (define-key view-mode-map "=" 'what-line)
   (define-key view-mode-map "." 'set-mark-command)
-  (define-key view-mode-map "\C-@" 'set-mark-command)
   (define-key view-mode-map "'" 'View-back-to-mark)
   (define-key view-mode-map "@" 'View-back-to-mark)  
   (define-key view-mode-map "x" 'exchange-point-and-mark)
-  (define-key view-mode-map "h" 'Helper-describe-bindings)
-  (define-key view-mode-map "?" 'Helper-describe-bindings)
-  (define-key view-mode-map (char-to-string help-char) 'Helper-help)
-  (define-key view-mode-map "\C-n" 'next-line)
-  (define-key view-mode-map "\C-p" 'previous-line)
-  (define-key view-mode-map "\C-s" 'isearch-forward)
-  (define-key view-mode-map "\C-r" 'isearch-backward)
+  (define-key view-mode-map "h" 'describe-mode)
+  (define-key view-mode-map "?" 'describe-mode)
   (define-key view-mode-map "s" 'isearch-forward)
   (define-key view-mode-map "r" 'isearch-backward)
   (define-key view-mode-map "/" 'View-search-regexp-forward)
   (define-key view-mode-map "p" 'View-search-last-regexp-backward)
   )
 
+(or (assq 'view-mode minor-mode-map-alist)
+    (setq minor-mode-map-alist
+         (cons (cons 'view-mode view-mode-map) minor-mode-map-alist)))
+
 
 ;;;###autoload
 (defun view-file (file-name)
@@ -110,10 +125,12 @@ This command runs the normal hook `view-mode-hook'."
   (let ((old-buf (current-buffer))
        (had-a-buf (get-file-buffer file-name))
        (buf-to-view (find-file-noselect file-name)))
-    (switch-to-buffer buf-to-view t)
-    (view-mode old-buf
-              (and (not had-a-buf) (not (buffer-modified-p buf-to-view))
-                   'kill-buffer))))
+    ;; This used to pass t as second argument,
+    ;; but then the buffer did not show up in the Buffers menu.
+    (switch-to-buffer buf-to-view had-a-buf)
+    (view-mode-enter old-buf
+                    (and (not had-a-buf) (not (buffer-modified-p buf-to-view))
+                         'kill-buffer))))
 
 ;;;###autoload
 (defun view-file-other-window (file-name)
@@ -131,9 +148,9 @@ This command runs the normal hook `view-mode-hook'."
        (had-a-buf (get-file-buffer file-name))
        (buf-to-view (find-file-noselect file-name)))
     (switch-to-buffer-other-window buf-to-view)
-    (view-mode old-arrangement
-              (and (not had-a-buf) (not (buffer-modified-p buf-to-view))
-                   'kill-buffer))))
+    (view-mode-enter old-arrangement
+                    (and (not had-a-buf) (not (buffer-modified-p buf-to-view))
+                         'kill-buffer))))
 
 ;;;###autoload
 (defun view-buffer (buffer-name)
@@ -148,13 +165,12 @@ This command runs the normal hook `view-mode-hook'."
   (interactive "bView buffer: ")
   (let ((old-buf (current-buffer)))
     (switch-to-buffer buffer-name t)
-    (view-mode old-buf nil)))
+    (view-mode-enter old-buf nil)))
 
 ;;;###autoload
 (defun view-buffer-other-window (buffer-name not-return)
-  "View BUFFER in View mode in another window,
-returning to original buffer when done *only* if 
-prefix argument NOT-RETURN is nil (which is the default).
+  "View BUFFER in View mode in another window.
+Return to previous buffer when done, unless NOT-RETURN is non-nil.
 
 The usual Emacs commands are not available in View mode; instead,
 a special set of commands (mostly letters and punctuation)
@@ -166,15 +182,24 @@ This command runs the normal hook `view-mode-hook'."
   (interactive "bView buffer:\nP")
   (let ((return-to (and not-return (current-window-configuration))))
     (switch-to-buffer-other-window buffer-name)
-    (view-mode return-to)))
+    (view-mode-enter return-to)))
 
 ;;;###autoload
-(defun view-mode (&optional prev-buffer action)
-  "Major mode for viewing text but not editing it.
+(defun view-mode (&optional arg)
+  "Toggle View mode.
+With a prefix argument, turn View mode on if the argument is >= zero
+and off if it is not.
+
+If you use this function to turn on View mode, then subsequently
+\"exiting\" View mode does nothing except turn View mode off.  The
+other way to turn View mode on is by calling `view-mode-enter';
+that is what Lisp programs usually use.
+
 Letters do not insert themselves.  Instead these commands are provided.
 Most commands take prefix arguments.  Commands dealing with lines
 default to \"scroll size\" lines (initially size of window).
 Search commands default to a repeat count of one.
+
 M-< or <       move to beginning of buffer.
 M-> or >       move to end of buffer.
 C-v or Space   scroll forward lines.
@@ -198,112 +223,88 @@ C-r or r do reverse incremental search.
                  successful search and when jump to line to occurs.
                  The mark is set on jump to buffer start or end.
 ? or h         provide help message (list of commands).
-\\[Helper-help]                provides help (list of commands or description of a command).
+\\[help-command]               provides help (list of commands or description of a command).
 C-n            moves down lines vertically.
 C-p            moves upward lines vertically.
 C-l            recenters the screen.
-q or C-c       exit view-mode and return to previous buffer.
+q              exit view-mode and return to previous buffer."
+  (interactive "P")
+  (setq view-mode
+       (if (null arg)
+           (not view-mode)
+         (> (prefix-numeric-value arg) 0)))
+  (force-mode-line-update))
+
+(defun view-mode-enter (&optional prev-buffer action)
+  "Enter View mode, a Minor mode for viewing text but not editing it.
+See the function `view-mode' for more details.
 
-Entry to this mode runs the normal hook `view-mode-hook'.
+This function runs the normal hook `view-mode-hook'.
 
 \\{view-mode-map}"
 ;  Not interactive because dangerous things happen
 ;  if you call it without passing a buffer as argument
 ;  and they are not easy to fix.
 ;  (interactive)
-  (make-local-variable 'view-old-mode-line-buffer-identification)
-  (setq view-old-mode-line-buffer-identification
-       mode-line-buffer-identification)
-  (make-local-variable 'view-old-buffer-read-only)
   (setq view-old-buffer-read-only buffer-read-only)
-  (make-local-variable 'view-old-mode-name)
-  (setq view-old-mode-name mode-name)
-  (make-local-variable 'view-old-major-mode)
-  (setq view-old-major-mode major-mode)
-  (make-local-variable 'view-old-local-map)
-  (setq view-old-local-map (current-local-map))
-  (make-local-variable 'view-old-Helper-return-blurb)
   (setq view-old-Helper-return-blurb
        (and (boundp 'Helper-return-blurb) Helper-return-blurb))
 
+  ;; Enable view-exit to make use of the data we just saved
+  ;; and to perform the exit action.
+  (setq view-mode-auto-exit t)
+
   (setq buffer-read-only t)
-  (setq mode-line-buffer-identification
-       (list
-        (if (buffer-file-name)
-            "Viewing %f"
-          "Viewing %b")))
-  (setq mode-name "View")
-  (setq major-mode 'view-mode)
+  (setq view-mode t)
   (setq Helper-return-blurb
        (format "continue viewing %s"
                (if (buffer-file-name)
                    (file-name-nondirectory (buffer-file-name))
                    (buffer-name))))
 
-  (make-local-variable 'view-exit-action)
   (setq view-exit-action action)
-  (make-local-variable 'view-return-here)
   (setq view-return-here prev-buffer)
-  (make-local-variable 'view-exit-position)
   (setq view-exit-position (point-marker))
 
-  (make-local-variable 'view-scroll-size)
-  (setq view-scroll-size nil)
-  (make-local-variable 'view-last-regexp)
-  (setq view-last-regexp nil)
-
   (beginning-of-line)
   (setq goal-column nil)
 
-  (use-local-map view-mode-map)
-  (run-hooks 'view-hook 'view-mode-hook)
-  (view-helpful-message))
-
+  (run-hooks 'view-mode-hook)
+  (message "%s"
+     (substitute-command-keys
+      "Type \\[help-command] for help, \\[describe-mode] for commands, \\[view-exit] to quit.")))
 \f
 (defun view-exit ()
   "Exit from view-mode.
 If you viewed an existing buffer, that buffer returns to its previous mode.
 If you viewed a file that was not present in Emacs, its buffer is killed."
   (interactive)
-  (setq mode-line-buffer-identification
-       view-old-mode-line-buffer-identification)
-  (setq major-mode view-old-major-mode)
-  (setq mode-name view-old-mode-name)
-  (use-local-map view-old-local-map)
-  (setq buffer-read-only view-old-buffer-read-only)
-
-  (goto-char view-exit-position)
-  (set-marker view-exit-position nil)
-
-  ;; Now do something to the buffer that we were viewing
-  ;; (such as kill it).
-  (let ((viewed-buffer (current-buffer))
-       (action view-exit-action))
-    (cond
-     ((bufferp view-return-here)
-      (switch-to-buffer view-return-here))
-     ((window-configuration-p view-return-here)
-      (set-window-configuration view-return-here)))
-    (if action (funcall action viewed-buffer))))
-
-(defun view-helpful-message ()
-  (message
-     (substitute-command-keys
-      "Type \\[Helper-help] for help, \\[Helper-describe-bindings] for commands, \\[view-exit] to quit.")))
-
-(defun View-undefined ()
-  (interactive)
-  (ding)
-  (view-helpful-message))
+  (setq view-mode nil)
+  (and view-overlay (delete-overlay view-overlay))
+  (force-mode-line-update)
+  (cond (view-mode-auto-exit
+        (setq buffer-read-only view-old-buffer-read-only)
+        (setq view-mode-auto-exit nil)
+
+        (goto-char view-exit-position)
+        (set-marker view-exit-position nil)
+
+        ;; Now do something to the buffer that we were viewing
+        ;; (such as kill it).
+        (let ((viewed-buffer (current-buffer))
+              (action view-exit-action))
+          (cond
+           ((bufferp view-return-here)
+            (switch-to-buffer view-return-here))
+           ((window-configuration-p view-return-here)
+            (set-window-configuration view-return-here)))
+          (if action (funcall action viewed-buffer))))))
 
 (defun view-window-size () (1- (window-height)))
 
 (defun view-scroll-size ()
   (min (view-window-size) (or view-scroll-size (view-window-size))))
 
-(defvar view-hook nil
-  "Normal hook run when starting to view a buffer or file.")
-
 (defvar view-mode-hook nil
   "Normal hook run when starting to view a buffer or file.")
 
@@ -320,13 +321,13 @@ If you viewed a file that was not present in Emacs, its buffer is killed."
 ;      (funcall view-last-command view-last-command-argument))
 ;  (setq this-command view-last-command-entry))
 
-(defun View-goto-line (&optional line)
+(defun View-goto-line (line)
   "Move to line LINE in View mode.
 Display is centered at LINE.  Sets mark at starting position and pushes
 mark ring."
   (interactive "p")
   (push-mark)
-  (goto-line (or line 1))
+  (goto-line line)
   (recenter (/ (view-window-size) 2)))
 
 (defun View-scroll-lines-forward (&optional lines)
@@ -334,14 +335,14 @@ mark ring."
 No arg means whole window full, or number of lines set by \\[View-scroll-lines-forward-set-scroll-size].
 Arg is number of lines to scroll."
   (interactive "P")
+  (setq lines
+       (if lines (prefix-numeric-value lines)
+         (view-scroll-size)))
   (if (and (pos-visible-in-window-p (point-max))
           ;; Allow scrolling backward at the end of the buffer.
-          (or (null lines)
-              (> lines 0)))
+          (> lines 0)
+          view-mode-auto-exit)
       (view-exit)
-    (setq lines
-         (if lines (prefix-numeric-value lines)
-           (view-scroll-size)))
     ;; (view-last-command 'View-scroll-lines-forward lines)
     (if (>= lines (view-window-size))
        (scroll-up nil)
@@ -350,8 +351,8 @@ Arg is number of lines to scroll."
        (scroll-up lines)))
     (cond ((pos-visible-in-window-p (point-max))
           (goto-char (point-max))
-          (recenter -1)
-          (message (substitute-command-keys
+          (message "%s"
+                   (substitute-command-keys
                     "End.  Type \\[view-exit] to quit viewing."))))
     (move-to-window-line -1)
     (beginning-of-line)))
@@ -389,40 +390,55 @@ Arg is number of lines to scroll."
 (defun View-search-regexp-forward (n regexp)
   "Search forward for Nth occurrence of REGEXP.
 Displays line found at center of window.  REGEXP is remembered for
-searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward].  Sets mark at starting position and pushes mark ring."
+searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward].  Sets mark at starting position and pushes mark ring.
+
+The variable `view-highlight-face' controls the face that is used
+for highlighting the match that is found."
   (interactive "p\nsSearch forward (regexp): ")
-  (if (> (length regexp) 0)
-      (progn
-       ;(view-last-command 'View-search-last-regexp-forward n)
-       (view-search n regexp))))
+;;;(view-last-command 'View-search-last-regexp-forward n)
+  (view-search n (if (equal regexp "") view-last-regexp regexp)))
 
 (defun View-search-regexp-backward (n regexp)
   "Search backward from window start for Nth instance of REGEXP.
 Displays line found at center of window.  REGEXP is remembered for
-searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward].  Sets mark at starting position and pushes mark ring."
+searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward].  Sets mark at starting position and pushes mark ring.
+
+The variable `view-highlight-face' controls the face that is used
+for highlighting the match that is found."
   (interactive "p\nsSearch backward (regexp): ")
-  (View-search-regexp-forward (- n) regexp))
+  (View-search-regexp-forward (- n)
+                             (if (equal regexp "") view-last-regexp regexp)))
 
 (defun View-search-last-regexp-forward (n)
   "Search forward from window end for Nth instance of last regexp.
 Displays line found at center of window.  Sets mark at starting position
-and pushes mark ring."
+and pushes mark ring.
+
+The variable `view-highlight-face' controls the face that is used
+for highlighting the match that is found."
   (interactive "p")
-  (View-search-regexp-forward n view-last-regexp))
+  (if view-last-regexp
+      (View-search-regexp-forward n view-last-regexp)
+    (error "No previous View-mode search")))
 
 (defun View-search-last-regexp-backward (n)
   "Search backward from window start for Nth instance of last regexp.
 Displays line found at center of window.  Sets mark at starting position and
-pushes mark ring."
+pushes mark ring.
+
+The variable `view-highlight-face' controls the face that is used
+for highlighting the match that is found."
   (interactive "p")
-  (View-search-regexp-backward n view-last-regexp))
+  (if view-last-regexp
+      (View-search-regexp-backward n view-last-regexp)
+    (error "No previous View-mode search")))
 
 (defun View-back-to-mark (&optional ignore)
   "Return to last mark set in View mode, else beginning of file.
 Displays line at center of window.  Pops mark ring so successive
 invocations return to earlier marks."
   (interactive)
-  (goto-char (or (mark) (point-min)))
+  (goto-char (or (mark t) (point-min)))
   (pop-mark)
   (recenter (/ (view-window-size) 2)))
             
@@ -437,6 +453,11 @@ invocations return to earlier marks."
        (progn
          (push-mark)
          (goto-char where)
+         (if view-overlay
+             (move-overlay view-overlay (match-beginning 0) (match-end 0))
+           (setq view-overlay
+                 (make-overlay (match-beginning 0) (match-end 0))))
+         (overlay-put view-overlay 'face view-highlight-face)
          (beginning-of-line)
          (recenter (/ (view-window-size) 2)))
       (message "Can't find occurrence %d of %s" times regexp)