diff lisp/modes/view.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/modes/view.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,457 @@
+;;; view.el --- peruse file or buffer without editing.
+
+;; Copyright (C) 1985, 1989, 1994, 1995 Free Software Foundation, Inc.
+
+;; Author: K. Shane Hartman
+;; Keywords: wp unix
+;; Maintainer: FSF
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; 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.
+
+;;; Synched up with: FSF 19.30.
+
+;;; Commentary:
+
+;; This package provides the `view' minor mode documented in the Emacs
+;; user's manual.
+
+;; XEmacs: We don't autoload this because we use `view-less' instead.
+;; #### I junked the old version and replaced it with FSF's latest version.
+;; Perhaps something needs integrating into view-less.
+
+;;; Code:
+
+(defvar view-highlight-face 'highlight
+   "*The extent 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-extent nil
+  "Extent 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-extent)
+
+(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 'view-mode-map))
+  (suppress-keymap view-mode-map)
+  (define-key view-mode-map "q" 'view-exit)
+  (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 "\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 "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 "'" '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" '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 "\\" 'View-search-regexp-backward)
+  ;; This conflicts with the standard binding of isearch-regexp-forward
+  (define-key view-mode-map "\e\C-s" 'View-search-regexp-forward)
+  (define-key view-mode-map "\e\C-r" 'View-search-regexp-backward)  
+  (define-key view-mode-map "n" 'View-search-last-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)))
+
+
+(defun view-file (file-name)
+  "View FILE in View mode, returning to previous buffer when done.
+The usual Emacs commands are not available; instead,
+a special set of commands (mostly letters and punctuation)
+are defined for moving around in the buffer.
+Space scrolls forward, Delete scrolls backward.
+For list of all View commands, type ? or h while viewing.
+
+This command runs the normal hook `view-mode-hook'."
+  (interactive "fView file: ")
+  (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-enter old-buf
+		     (and (not had-a-buf) (not (buffer-modified-p buf-to-view))
+			  'kill-buffer))))
+
+(defun view-file-other-window (file-name)
+  "View FILE in View mode in other window.
+Return to previous buffer when done.
+The usual Emacs commands are not available; instead,
+a special set of commands (mostly letters and punctuation)
+are defined for moving around in the buffer.
+Space scrolls forward, Delete scrolls backward.
+For list of all View commands, type ? or h while viewing.
+
+This command runs the normal hook `view-mode-hook'."
+  (interactive "fView file: ")
+  (let ((old-arrangement (current-window-configuration))
+	(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-enter old-arrangement
+		     (and (not had-a-buf) (not (buffer-modified-p buf-to-view))
+			  'kill-buffer))))
+
+(defun view-buffer (buffer-name)
+  "View BUFFER in View mode, returning to previous buffer when done.
+The usual Emacs commands are not available; instead,
+a special set of commands (mostly letters and punctuation)
+are defined for moving around in the buffer.
+Space scrolls forward, Delete scrolls backward.
+For list of all View commands, type ? or h while viewing.
+
+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-enter old-buf nil)))
+
+(defun view-buffer-other-window (buffer-name not-return)
+  "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)
+are defined for moving around in the buffer.
+Space scrolls forward, Delete scrolls backward.
+For list of all View commands, type ? or h while viewing.
+
+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-enter return-to)))
+
+(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.
+M-v or DEL	scroll backward lines.
+CR or LF	scroll forward one line (backward with prefix argument).
+z		like Space except set number of lines for further
+		   scrolling commands to scroll by.
+C-u and Digits	provide prefix arguments.  `-' denotes negative argument.
+=		prints the current line number.
+g		goes to line given by prefix argument.
+/ or M-C-s	searches forward for regular expression
+\\ or M-C-r	searches backward for regular expression.
+n		searches forward for last regular expression.
+p		searches backward for last regular expression.
+C-@ or .	set the mark.
+x		exchanges point and mark.
+C-s or s	do forward incremental search.
+C-r or r	do reverse incremental search.
+@ or '		return to mark and pops mark ring.
+		  Mark ring is pushed at start of every
+		  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).
+\\[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		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.
+
+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)
+  (setq view-old-buffer-read-only buffer-read-only)
+  (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 view-mode t)
+  (setq Helper-return-blurb
+	(format "continue viewing %s"
+		(if (buffer-file-name)
+		    (file-name-nondirectory (buffer-file-name))
+		    (buffer-name))))
+
+  (setq view-exit-action action)
+  (setq view-return-here prev-buffer)
+  (setq view-exit-position (point-marker))
+
+  (beginning-of-line)
+  (setq goal-column nil)
+
+  (run-hooks 'view-mode-hook)
+  (message
+     (substitute-command-keys
+      "Type \\[help-command] for help, \\[describe-mode] for commands, \\[view-exit] to quit.")))
+
+(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 view-mode nil)
+  (and view-extent (delete-extent view-extent))
+  (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-mode-hook nil
+  "Normal hook run when starting to view a buffer or file.")
+
+;(defun view-last-command (&optional who what)
+;  (setq view-last-command-entry this-command)
+;  (setq view-last-command who)
+;  (setq view-last-command-argument what))
+
+;(defun View-repeat-last-command ()
+;  "Repeat last command issued in View mode."
+;  (interactive)
+;  (if (and view-last-command
+;	   (eq view-last-command-entry last-command))
+;      (funcall view-last-command view-last-command-argument))
+;  (setq this-command view-last-command-entry))
+
+(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 line)
+  (recenter (/ (view-window-size) 2)))
+
+(defun View-scroll-lines-forward (&optional lines)
+  "Scroll forward in View mode, or exit if end of text is visible.
+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.
+	   (> lines 0)
+	   view-mode-auto-exit)
+      (view-exit)
+    ;; (view-last-command 'View-scroll-lines-forward lines)
+    (if (>= lines (view-window-size))
+	(scroll-up nil)
+      (if (>= (- lines) (view-window-size))
+	  (scroll-down nil)
+	(scroll-up lines)))
+    (cond ((pos-visible-in-window-p (point-max))
+	   (goto-char (point-max))
+	   (message (substitute-command-keys
+		     "End.  Type \\[view-exit] to quit viewing."))))
+    (move-to-window-line -1)
+    (beginning-of-line)))
+
+(defun View-scroll-lines-forward-set-scroll-size (&optional lines)
+  "Scroll forward LINES lines in View mode, setting the \"scroll size\".
+This is the number of lines which \\[View-scroll-lines-forward] and \\[View-scroll-lines-backward] scroll by default.
+The absolute value of LINES is used, so this command can be used to scroll
+backwards (but \"scroll size\" is always positive).  If LINES is greater than
+window height or omitted, then window height is assumed.  If LINES is less
+than window height then scrolling context is provided from previous screen."
+  (interactive "P")
+  (if (not lines)
+      (setq view-scroll-size (view-window-size))
+    (setq lines (prefix-numeric-value lines))
+    (setq view-scroll-size
+	  (min (if (> lines 0) lines (- lines)) (view-window-size))))
+  (View-scroll-lines-forward lines))
+
+(defun View-scroll-one-more-line (&optional arg)
+  "Scroll one more line up in View mode.
+With ARG scroll one line down."
+  (interactive "P")
+  (View-scroll-lines-forward (if (not arg) 1 -1)))
+
+(defun View-scroll-lines-backward (&optional lines)
+  "Scroll backward in View mode.
+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")
+  (View-scroll-lines-forward (if lines
+				 (- (prefix-numeric-value lines))
+			       (- (view-scroll-size)))))
+  
+(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.
+
+The variable `view-highlight-face' controls the face that is used
+for highlighting the match that is found."
+  (interactive "p\nsSearch forward (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.
+
+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)
+			      (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.
+
+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.
+
+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))
+
+(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 t) (point-min)))
+  (pop-mark)
+  (recenter (/ (view-window-size) 2)))
+	     
+(defun view-search (times regexp)
+  (setq view-last-regexp regexp)
+  (let (where)
+    (save-excursion
+      (move-to-window-line (if (< times 0) 0 -1))
+      (if (re-search-forward regexp nil t times)
+	  (setq where (point))))
+    (if where
+	(progn
+	  (push-mark)
+	  (goto-char where)
+	  (if view-extent
+	      (set-extent-endpoints view-extent (match-beginning 0)
+				    (match-end 0))
+	    (setq view-extent
+		  (make-extent (match-beginning 0) (match-end 0))))
+	  (set-extent-face view-extent view-highlight-face)
+	  (beginning-of-line)
+	  (recenter (/ (view-window-size) 2)))
+      (message "Can't find occurrence %d of %s" times regexp)
+      (sit-for 4))))
+
+
+(provide 'view)
+
+;;; view.el ends here