Annotation of 43BSD/contrib/emacs/lisp/view.el, revision 1.1.1.1

1.1       root        1: ;; View: Tour files, buffers without editing.
                      2: ;; Copyright (C) 1985 Richard M. Stallman and K. Shane Hartman
                      3: 
                      4: ;; This file is part of GNU Emacs.
                      5: 
                      6: ;; GNU Emacs is distributed in the hope that it will be useful,
                      7: ;; but WITHOUT ANY WARRANTY.  No author or distributor
                      8: ;; accepts responsibility to anyone for the consequences of using it
                      9: ;; or for whether it serves any particular purpose or works at all,
                     10: ;; unless he says so in writing.  Refer to the GNU Emacs General Public
                     11: ;; License for full details.
                     12: 
                     13: ;; Everyone is granted permission to copy, modify and redistribute
                     14: ;; GNU Emacs, but only under the conditions described in the
                     15: ;; GNU Emacs General Public License.   A copy of this license is
                     16: ;; supposed to have been given to you along with GNU Emacs so you
                     17: ;; can know your rights and responsibilities.  It should be in a
                     18: ;; file named COPYING.  Among other things, the copyright notice
                     19: ;; and this notice must be preserved on all copies.
                     20: 
                     21: 
                     22: (provide 'view)
                     23: 
                     24: (defvar view-mode-map nil)
                     25: (if view-mode-map
                     26:     nil
                     27:   (setq view-mode-map (make-keymap))
                     28:   (fillarray view-mode-map 'View-undefined)
                     29:   (define-key view-mode-map "\C-c" 'exit-recursive-edit)
                     30:   (define-key view-mode-map "\C-z" 'suspend-emacs)
                     31:   (define-key view-mode-map "q" 'exit-recursive-edit)
                     32:   (define-key view-mode-map "-" 'negative-argument)
                     33:   (define-key view-mode-map "0" 'digit-argument)
                     34:   (define-key view-mode-map "1" 'digit-argument)
                     35:   (define-key view-mode-map "2" 'digit-argument)
                     36:   (define-key view-mode-map "3" 'digit-argument)
                     37:   (define-key view-mode-map "4" 'digit-argument)
                     38:   (define-key view-mode-map "5" 'digit-argument)
                     39:   (define-key view-mode-map "6" 'digit-argument)
                     40:   (define-key view-mode-map "7" 'digit-argument)
                     41:   (define-key view-mode-map "8" 'digit-argument)
                     42:   (define-key view-mode-map "9" 'digit-argument)
                     43:   (define-key view-mode-map "\C-u" 'universal-argument)
                     44:   (define-key view-mode-map "\e" nil)
                     45:   (define-key view-mode-map "\C-x" 'Control-X-prefix)
                     46:   (define-key view-mode-map "\e-" 'negative-argument)
                     47:   (define-key view-mode-map "\e0" 'digit-argument)
                     48:   (define-key view-mode-map "\e1" 'digit-argument)
                     49:   (define-key view-mode-map "\e2" 'digit-argument)
                     50:   (define-key view-mode-map "\e3" 'digit-argument)
                     51:   (define-key view-mode-map "\e4" 'digit-argument)
                     52:   (define-key view-mode-map "\e5" 'digit-argument)
                     53:   (define-key view-mode-map "\e6" 'digit-argument)
                     54:   (define-key view-mode-map "\e7" 'digit-argument)
                     55:   (define-key view-mode-map "\e8" 'digit-argument)
                     56:   (define-key view-mode-map "\e9" 'digit-argument)
                     57:   (define-key view-mode-map "<" 'beginning-of-buffer)
                     58:   (define-key view-mode-map ">" 'end-of-buffer)
                     59:   (define-key view-mode-map "\ev" 'View-scroll-lines-backward)
                     60:   (define-key view-mode-map "\C-v" 'View-scroll-lines-forward)
                     61:   (define-key view-mode-map " " 'View-scroll-lines-forward)
                     62:   (define-key view-mode-map "\177" 'View-scroll-lines-backward)
                     63:   (define-key view-mode-map "\n" 'View-scroll-one-more-line)
                     64:   (define-key view-mode-map "\r" 'View-scroll-one-more-line)
                     65:   (define-key view-mode-map "\C-l" 'recenter)
                     66:   (define-key view-mode-map "z" 'View-scroll-lines-forward-set-scroll-size)
                     67:   (define-key view-mode-map "g" 'View-goto-line)
                     68:   (define-key view-mode-map "=" 'what-line)
                     69:   (define-key view-mode-map "." 'set-mark-command)
                     70:   (define-key view-mode-map "\C-@" 'set-mark-command)
                     71:   (define-key view-mode-map "'" 'View-back-to-mark)
                     72:   (define-key view-mode-map "@" 'View-back-to-mark)  
                     73:   (define-key view-mode-map "x" 'exchange-point-and-mark)
                     74:   (define-key view-mode-map "h" 'View-give-help)
                     75:   (define-key view-mode-map "?" 'Helper-describe-bindings)
                     76:   (define-key view-mode-map "\C-h" 'Helper-help)
                     77:   (define-key view-mode-map "\C-n" 'next-line)
                     78:   (define-key view-mode-map "\C-p" 'previous-line)
                     79:   (define-key view-mode-map "\C-s" 'isearch-forward)
                     80:   (define-key view-mode-map "\C-r" 'isearch-backward)
                     81:   (define-key view-mode-map "s" 'isearch-forward)
                     82:   (define-key view-mode-map "r" 'isearch-backward)
                     83:   (define-key view-mode-map "/" 'View-search-regexp-forward)
                     84:   (define-key view-mode-map "\\" 'View-search-regexp-backward)
                     85:   ;; This conflicts with the standard binding of isearch-regexp-forward
                     86:   (define-key view-mode-map "\e\C-s" 'View-search-regexp-forward)
                     87:   (define-key view-mode-map "\e\C-r" 'View-search-regexp-backward)  
                     88:   (define-key view-mode-map "n" 'View-search-last-regexp-forward)
                     89:   (define-key view-mode-map "p" 'View-search-last-regexp-backward)
                     90:   )
                     91: 
                     92: 
                     93: (defun view-file (file-name)
                     94:   "View FILE in View mode, returning to previous buffer when done.
                     95: The usual Emacs commands are not available; instead,
                     96: a special set of commands (mostly letters and punctuation)
                     97: are defined for moving around in the buffer.
                     98: Space scrolls forward, Delete scrolls backward.
                     99: For list of all View commands, type ? or h while viewing.
                    100: 
                    101: Calls the value of  view-hook  if that is non-nil."
                    102:   (interactive "fView file: ")
                    103:   (view-mode (prog1 (current-buffer)
                    104:               (switch-to-buffer (find-file-noselect file-name) t))))
                    105: 
                    106: (defun view-buffer (buffer-name)
                    107:   "View BUFFER in View mode, returning to previous buffer when done.
                    108: The usual Emacs commands are not available; instead,
                    109: a special set of commands (mostly letters and punctuation)
                    110: are defined for moving around in the buffer.
                    111: Space scrolls forward, Delete scrolls backward.
                    112: For list of all View commands, type ? or h while viewing.
                    113: 
                    114: Calls the value of  view-hook  if that is non-nil."
                    115:   (interactive "bView buffer: ")
                    116:   (view-mode (prog1 (current-buffer) (switch-to-buffer buffer-name))))
                    117: 
                    118: (defun view-mode (&optional view-return-to-buffer)
                    119:   "Major mode for viewing text but not editing it.
                    120: Letters do not insert themselves.  Instead these commands are provided.
                    121: Most commands take prefix arguments.  Commands dealing with lines
                    122: default to \"scroll size\" lines (initially size of window).
                    123: Search commands default to a repeat count of one.
                    124: M-< or <       move to beginning of buffer.
                    125: M-> or >       move to end of buffer.
                    126: C-v or Space   scroll forward lines.
                    127: M-v or DEL     scroll backward lines.
                    128: CR or LF       scroll forward one line (backward with prefix argument).
                    129: z              like Space except set number of lines for further
                    130:                   scrolling commands to scroll by.
                    131: C-u and Digits provide prefix arguments.  `-' denotes negative argument.
                    132: =              prints the current line number.
                    133: g              goes to line given by prefix argument.
                    134: / or M-C-s     searches forward for regular expression
                    135: \\ or M-C-r    searches backward for regular expression.
                    136: n              searches forward for last regular expression.
                    137: p              searches backward for last regular expression.
                    138: C-@ or .       set the mark.
                    139: x              exchanges point and mark.
                    140: C-s or s       do forward incremental search.
                    141: C-r or r       do reverse incremental search.
                    142: @ or '         return to mark and pops mark ring.
                    143:                  Mark ring is pushed at start of every
                    144:                  successful search and when jump to line to occurs.
                    145:                  The mark is set on jump to buffer start or end.
                    146: ? or h         provide help message (list of commands).
                    147: C-h            provides help (list of commands or description of a command).
                    148: C-n            moves down lines vertically.
                    149: C-p            moves upward lines vertically.
                    150: C-l            recenters the screen.
                    151: q or C-c       exit view-mode and return to previous buffer.
                    152: 
                    153: Entry to this mode calls the value of  view-hook  if non-nil.
                    154: \\{view-mode-map}"
                    155:   (interactive)
                    156:   (let* ((view-buffer-window (selected-window))
                    157:         (view-scroll-size (1- (window-height view-buffer-window))))
                    158:     (unwind-protect
                    159:        (let ((buffer-read-only t)
                    160:              (mode-line-format (if (buffer-file-name)
                    161:                                    "--Viewing %f  %M  ----%p--%-"
                    162:                                  "--Viewing %b  %M  ----%p--%-"))
                    163:              (mode-name "View"))
                    164:          (beginning-of-line)
                    165:          (catch 'view-mode-exit (view-mode-command-loop)))
                    166:       (if view-return-to-buffer
                    167:          (switch-to-buffer view-return-to-buffer)))))
                    168: 
                    169: (defun view-helpful-message ()
                    170:   (message
                    171:    (if (and (eq (key-binding "\C-h") 'Helper-help)
                    172:            (eq (key-binding "?") 'Helper-describe-bindings)
                    173:            (eq (key-binding "\C-c") 'exit-recursive-edit))
                    174:        "Type C-h for help, ? for commands, C-c to quit"
                    175:      (substitute-command-keys
                    176:       "Type \\[Helper-help] for help, \\[Helper-describe-bindings] for commands, \\[exit-recursive-edit] to quit."))))
                    177: 
                    178: (defun View-undefined ()
                    179:   (interactive)
                    180:   (ding)
                    181:   (view-helpful-message))
                    182: 
                    183: (defun view-window-size () (1- (window-height view-buffer-window)))
                    184: 
                    185: (defun view-scroll-size () (min (view-window-size) view-scroll-size))
                    186: 
                    187: (defvar view-hook nil
                    188:   "If non-nil, its value is called when viewing buffer or file.")
                    189: 
                    190: (defun view-mode-command-loop ()
                    191:   (push-mark)
                    192:   (let ((old-local-map (current-local-map))
                    193:        (mark-ring)
                    194: ;      (view-last-command)
                    195: ;      (view-last-command-entry)
                    196: ;      (view-last-command-argument)
                    197:        (view-last-regexp)
                    198:        (Helper-mode-name "View")
                    199:        (Helper-major-mode 'view-mode)
                    200:        (Helper-return-blurb
                    201:         (format "continue viewing %s"
                    202:                 (if (buffer-file-name)
                    203:                     (file-name-nondirectory (buffer-file-name))
                    204:                   (buffer-name))))
                    205:        (goal-column 0))
                    206:     (unwind-protect
                    207:        (progn
                    208:          (use-local-map view-mode-map)
                    209:          (run-hooks 'view-hook)
                    210:          (view-helpful-message)
                    211:          (recursive-edit))
                    212:       (use-local-map old-local-map)))
                    213:   (pop-mark))
                    214: 
                    215: ;(defun view-last-command (&optional who what)
                    216: ;  (setq view-last-command-entry this-command)
                    217: ;  (setq view-last-command who)
                    218: ;  (setq view-last-command-argument what))
                    219: 
                    220: ;(defun View-repeat-last-command ()
                    221: ;  "Repeat last command issued in View mode."
                    222: ;  (interactive)
                    223: ;  (if (and view-last-command
                    224: ;         (eq view-last-command-entry last-command))
                    225: ;      (funcall view-last-command view-last-command-argument))
                    226: ;  (setq this-command view-last-command-entry))
                    227: 
                    228: (defun View-goto-line (&optional line)
                    229:   "Move to LINE in View mode.
                    230: Display is centered at LINE.  Sets mark at starting position and pushes
                    231: mark ring."
                    232:   (interactive "p")
                    233:   (push-mark)
                    234:   (goto-line (or line 1))
                    235:   (recenter (/ (view-window-size) 2)))
                    236: 
                    237: (defun View-scroll-lines-forward (&optional lines)
                    238:   "Scroll forward in View mode.
                    239: No arg means whole window full, or number of lines set by \\[View-scroll-lines-forward-set-scroll-size].
                    240: Arg is number of lines to scroll."
                    241:   (interactive "P")
                    242:   (setq lines
                    243:        (if lines (prefix-numeric-value lines)
                    244:          (view-scroll-size)))
                    245: ; (view-last-command 'View-scroll-lines-forward lines)
                    246:   (if (>= lines (view-window-size))
                    247:       (scroll-up nil)
                    248:     (if (>= (- lines) (view-window-size))
                    249:        (scroll-down nil)
                    250:       (scroll-up lines)))
                    251:   (cond ((pos-visible-in-window-p (point-max))
                    252:         (goto-char (point-max))
                    253:         (recenter -1)
                    254:         (message (substitute-command-keys
                    255:                "End.  Type \\[exit-recursive-edit] to quit viewing."))))
                    256:   (move-to-window-line -1)
                    257:   (beginning-of-line))
                    258: 
                    259: (defun View-scroll-lines-forward-set-scroll-size (&optional lines)
                    260:   "Scroll forward LINES lines in View mode, setting the \"scroll size\".
                    261: This is the number of lines which \\[View-scroll-lines-forward] and \\[View-scroll-lines-backward] scroll by default.
                    262: The absolute value of LINES is used, so this command can be used to scroll
                    263: backwards (but \"scroll size\" is always positive).  If LINES is greater than
                    264: window height or omitted, then window height is assumed.  If LINES is less
                    265: than window height then scrolling context is provided from previous screen."
                    266:   (interactive "P")
                    267:   (if (not lines)
                    268:       (setq view-scroll-size (view-window-size))
                    269:     (setq lines (prefix-numeric-value lines))
                    270:     (setq view-scroll-size
                    271:          (min (if (> lines 0) lines (- lines)) (view-window-size))))
                    272:   (View-scroll-lines-forward lines))
                    273: 
                    274: (defun View-scroll-one-more-line (&optional arg)
                    275:   "Scroll one more line up in View mode.
                    276: With ARG scroll one line down."
                    277:   (interactive "P")
                    278:   (View-scroll-lines-forward (if (not arg) 1 -1)))
                    279: 
                    280: (defun View-scroll-lines-backward (&optional lines)
                    281:   "Scroll backward in View mode.
                    282: No arg means whole window full, or number of lines set by \\[View-scroll-lines-forward-set-scroll-size].
                    283: Arg is number of lines to scroll."
                    284:   (interactive "P")
                    285:   (View-scroll-lines-forward (if lines
                    286:                                 (- (prefix-numeric-value lines))
                    287:                               (- (view-scroll-size)))))
                    288:   
                    289: (defun View-search-regexp-forward (times regexp)
                    290:   "Search forward for NTH occurrence of REGEXP in View mode.
                    291: Displays line found at center of window.  REGEXP is remembered for
                    292: searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward].  Sets mark at starting position and pushes mark ring."
                    293:   (interactive "p\nsSearch forward (regexp): ")
                    294:   (if (> (length regexp) 0)
                    295:       (progn
                    296:        ;(view-last-command 'View-search-last-regexp-forward times)
                    297:        (view-search times regexp))))
                    298: 
                    299: (defun View-search-regexp-backward (times regexp)
                    300:   "Search backward from window start for NTH instance of REGEXP in View mode.
                    301: Displays line found at center of window.  REGEXP is remembered for
                    302: searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward].  Sets mark at starting position and pushes mark ring."
                    303:   (interactive "p\nsSearch backward (regexp): ")
                    304:   (View-search-regexp-forward (- times) regexp))
                    305: 
                    306: (defun View-search-last-regexp-forward (times)
                    307:   "Search forward from window end for NTH instance of last regexp in View mode.
                    308: Displays line found at center of window.  Sets mark at starting position
                    309: and pushes mark ring."
                    310:   (interactive "p")
                    311:   (View-search-regexp-forward times view-last-regexp))
                    312: 
                    313: (defun View-search-last-regexp-backward (times)
                    314:   "Search backward from window start for NTH instance of last regexp in View mode.
                    315: Displays line found at center of window.  Sets mark at starting position and
                    316: pushes mark ring."
                    317:   (interactive "p")
                    318:   (View-search-regexp-backward times view-last-regexp))
                    319: 
                    320: (defun View-back-to-mark (&optional ignore)
                    321:   "Return to last mark set in View mode, else beginning of file.
                    322: Displays line at center of window.  Pops mark ring so successive
                    323: invocations return to earlier marks."
                    324:   (interactive)
                    325:   (goto-char (or (mark) (point-min)))
                    326:   (pop-mark)
                    327:   (recenter (/ (view-window-size) 2)))
                    328:             
                    329: (defun view-search (times regexp)
                    330:   (setq view-last-regexp regexp)
                    331:   (let (where)
                    332:     (save-excursion
                    333:       (move-to-window-line (if (< times 0) 0 -1))
                    334:       (if (re-search-forward regexp nil t times)
                    335:          (setq where (point))))
                    336:     (if where
                    337:        (progn
                    338:          (push-mark)
                    339:          (goto-char where)
                    340:          (beginning-of-line)
                    341:          (recenter (/ (view-window-size) 2)))
                    342:       (message "Can't find occurrence %d of %s" times regexp)
                    343:       (sit-for 4))))
                    344: 

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.