(rmail-retry-failure): Bind inhibit-read-only.
[bpt/emacs.git] / lisp / view.el
index 5eaff50..0823cc1 100644 (file)
@@ -1,6 +1,6 @@
 ;;; view.el --- peruse file or buffer without editing.
 
-;; Copyright (C) 1985, 1989, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1989, 1994, 1995 Free Software Foundation, Inc.
 
 ;; Author: K. Shane Hartman
 ;; Maintainer: FSF
 
 ;;; 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.")
+(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)
+  (suppress-keymap view-mode-map)
   (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 +119,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)))
+    ;; 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 old-buf
-              (and (not had-a-buf) (not (buffer-modified-p buf-to-view))
-                   'kill-buffer))))
+    (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)
@@ -130,12 +141,10 @@ This command runs the normal hook `view-mode-hook'."
   (let ((old-arrangement (current-window-configuration))
        (had-a-buf (get-file-buffer file-name))
        (buf-to-view (find-file-noselect file-name)))
-    ;; This used to pass t as second argument,
-    ;; but then the buffer did not show up in the Buffers menu.
-    (switch-to-buffer-other-window)
-    (view-mode old-arrangement
-              (and (not had-a-buf) (not (buffer-modified-p buf-to-view))
-                   'kill-buffer))))
+    (switch-to-buffer-other-window buf-to-view)
+    (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)
@@ -150,13 +159,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)
@@ -168,15 +176,21 @@ 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.
+If you use this function to turn on View mode,
+\"exiting\" View mode does nothing except turn View mode off.
+The other way to turn View mode on is by calling
+`view-mode-enter'.
+
 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.
@@ -200,112 +214,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
+     (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.")
 
@@ -322,13 +312,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)
@@ -336,14 +326,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)
@@ -352,7 +342,6 @@ 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
                     "End.  Type \\[view-exit] to quit viewing."))))
     (move-to-window-line -1)
@@ -391,31 +380,42 @@ 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))
 
 (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))
 
@@ -424,7 +424,7 @@ pushes mark ring."
 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)))
             
@@ -439,6 +439,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)