home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / modes / view-less.el < prev    next >
Encoding:
Text File  |  1993-02-17  |  9.8 KB  |  285 lines
  1. ;;; This is a replacement for view-mode
  2. ;;; that looks a lot like less.  It also acts like a minor mode, and
  3. ;;; doesn't rebind any keys that it doesn't have to.  
  4.  
  5. ;; Written by David Gudeman (gudeman@arizona.edu)
  6. ;; Gnu Emacs v18 only.
  7.  
  8. ;; Mods by Bengt Martensson, to closely resemble less
  9. ;; LastEditDate "Thu Jul 23 13:23:24 1987"
  10.  
  11. ;; July 87, Gudeman again: added prefix for "q",
  12.  
  13. ;; to make auto-view-mode work automatically when you read a
  14. ;; write-protected file, add the following to your .emacs file.
  15. ;;(or (member 'auto-view-mode find-file-hooks)
  16. ;;    (setq find-file-hooks (cons 'auto-view-mode find-file-hooks)))
  17.  
  18. (provide 'view)
  19.  
  20. (defvar view-search-string ""
  21.   "Last string searched for with view-search functions.")
  22.  
  23. (defvar view-search-arg 1
  24.   "Arg to last view search.")
  25.  
  26. (defvar view-default-lines 10
  27.   "Default value for the \"d\" and \"u\" commands in view-mode")
  28.  
  29. (defvar view-kill-on-exit nil)
  30.  
  31. (defvar view-mode-map nil)
  32. (if view-mode-map
  33.     nil
  34.   (setq view-mode-map (make-keymap))
  35.   (set-keymap-name view-mode-map 'view-mode-map)
  36.   (suppress-keymap view-mode-map)
  37.   (define-key view-mode-map "-" 'negative-argument)
  38.   (define-key view-mode-map " " 'scroll-up)
  39.   (define-key view-mode-map "f" 'scroll-up)
  40.   (define-key view-mode-map "\177" 'scroll-down)
  41.   (define-key view-mode-map "b" 'scroll-down)
  42.   (define-key view-mode-map 'backspace 'scroll-down)
  43.   (define-key view-mode-map "\r" 'view-scroll-lines-up)
  44.   (define-key view-mode-map "\n" 'view-scroll-lines-up)
  45.   (define-key view-mode-map "e" 'view-scroll-lines-up)
  46.   (define-key view-mode-map "j" 'view-scroll-lines-up)
  47.   (define-key view-mode-map "y" 'view-scroll-lines-down)
  48.   (define-key view-mode-map "k" 'view-scroll-lines-down)
  49.   (define-key view-mode-map "d" 'view-scroll-some-lines-up)
  50.   (define-key view-mode-map "u" 'view-scroll-some-lines-down)
  51.   (define-key view-mode-map "r" 'recenter)
  52.   (define-key view-mode-map "t" 'toggle-truncate-lines)
  53.   (define-key view-mode-map "N" 'view-buffer)
  54.   (define-key view-mode-map "E" 'view-file)
  55.   (define-key view-mode-map "P" 'view-buffer)
  56.   (define-key view-mode-map "!" 'shell-command)
  57.   (define-key view-mode-map "|" 'shell-command-on-region)
  58.   (define-key view-mode-map "=" 'what-line)
  59.   (define-key view-mode-map "?" 'view-search-backward)
  60.   (define-key view-mode-map "h" 'view-mode-describe)
  61.   (define-key view-mode-map "s" 'view-repeat-search)
  62.   (define-key view-mode-map "n" 'view-repeat-search)
  63.   (define-key view-mode-map "/" 'view-search-forward)
  64.   (define-key view-mode-map "\\" 'view-search-backward)
  65.   (define-key view-mode-map "g" 'view-goto-line)
  66.   (define-key view-mode-map "G" 'view-Goto-line)
  67.   (define-key view-mode-map "%" 'view-goto-percent)
  68.   (define-key view-mode-map "p" 'view-goto-percent)
  69.   (define-key view-mode-map "m" 'point-to-register)
  70.   (define-key view-mode-map "'" 'register-to-point)
  71.   (define-key view-mode-map "C" 'view-cleanup-backspaces)
  72.   (define-key view-mode-map "q" 'view-quit))
  73.  
  74. (defun view-file (file &optional p)
  75.   "Find FILE, enter view mode.  With prefix arg use other window."
  76.   (interactive "fView File: \nP")
  77.   (let ((new-p (null (get-file-buffer file))))
  78.     (if p
  79.     (find-file-other-window file)
  80.       (find-file file))
  81.     (view-mode)
  82.     (set (make-local-variable 'view-kill-on-exit) new-p)
  83.     (view-brief-help)
  84.     nil))
  85.  
  86. (defun view-buffer (buf &optional p)
  87.   "Switch to BUF, enter view mode.  With prefix arg use other window."
  88.   (interactive "bView Buffer: \nP")
  89.   (if p
  90.       (switch-to-buffer-other-window buf)
  91.     (switch-to-buffer buf))
  92.   (view-mode)
  93.   (view-brief-help))
  94.  
  95. (defun view-brief-help ()
  96.   (message
  97.    (substitute-command-keys
  98.     "\\[scroll-up] = page forward;\\[scroll-down] = page back;\
  99.  \\[view-mode-describe] = help; \\[view-quit] = quit.")))
  100.  
  101. (defun view-mode (&optional p)
  102.   "Mode for viewing text, with bindings like `less'.
  103. Commands are:
  104. \\<view-mode-map>
  105. 0..9    prefix args
  106. -    prefix minus
  107. \\[scroll-up]    page forward
  108. \\[scroll-down]    page back
  109. \\[view-scroll-lines-up]    scroll prefix-arg lines forward, default 1.
  110. \\[view-scroll-lines-down]    scroll prefix-arg lines backward, default 1.
  111. \\[view-scroll-some-lines-down]    scroll prefix-arg lines backward, default 10.
  112. \\[view-scroll-some-lines-up]    scroll prefix-arg lines forward, default 10.
  113. \\[what-line]    print line number
  114. \\[view-mode-describe]    print this help message
  115. \\[view-search-forward]    regexp search, uses previous string if you just hit RET
  116. \\[view-search-backward]    as above but searches backward
  117. \\[view-repeat-search]    repeat last search
  118. \\[view-goto-line]    goto line prefix-arg, default 1
  119. \\[view-Goto-line]    goto line prefix-arg, default last line
  120. \\[view-goto-percent]    goto a position by percentage
  121. \\[toggle-truncate-lines]    toggle truncate-lines
  122. \\[view-file]    view another file
  123. \\[view-buffer]    view another buffer
  124. \\[view-cleanup-backspaces]    cleanup backspace constructions
  125. \\[shell-command]    execute a shell command
  126. \\[shell-command-on-region]\
  127.     execute a shell command with the region as input
  128. \\[view-quit]    exit view-mode, and bury the current buffer.
  129.  
  130. If invoked with the optional (prefix) arg non-nil, view-mode cleans up
  131. backspace constructions.
  132.  
  133. More precisely:
  134. \\{view-mode-map}"
  135.   (interactive "P")
  136. ;;  (kill-all-local-variables) ; No, this is very bad.  Don't reset mode.
  137.   (make-local-variable 'view-default-lines)
  138.   (set (make-local-variable 'view-kill-on-exit) nil)
  139.   ;; this lets the prevailing local map be accessible too.
  140.   (let ((map (copy-keymap view-mode-map)))
  141.     (set-keymap-parent map (current-local-map))
  142.     (use-local-map map))
  143.   (setq mode-name "View")
  144.   (setq major-mode 'view-mode)
  145.   (if p (cleanup-backspaces))
  146.   (setq mode-line-buffer-identification (list "View: %17b"))
  147.   (setq buffer-read-only t))
  148.  
  149. (defun cleanup-backspaces ()
  150.   "Cleanup backspace constructions.
  151. _^H and ^H_ sequences are deleted.  x^Hx sequences are turned into x for all
  152. characters x.  ^^H| and |^H^ sequences are turned into ^.  +^Ho and o^H+ are
  153. turned into (+)."
  154.   (interactive)
  155.   (save-excursion
  156.     (goto-char (point-min))
  157.     (while (= (following-char) ?\C-h)
  158.       (delete-char 1))
  159.     (while (search-forward "\C-h" nil t)
  160.       (forward-char -2)
  161.       (cond ((looking-at "_\C-h\\|\\(.\\)\C-h\\1\\||\C-h\\^")
  162.          (delete-char 2))
  163.         ((looking-at ".\C-h_\\|\\^\C-h|")
  164.          (forward-char 1)
  165.          (delete-char 2))
  166.         ((looking-at "+\C-ho\\|o\C-h+")
  167.          (delete-char 3)
  168.          (insert "(+)"))
  169.         ((looking-at "|\C-h-")
  170.          (delete-char 3)
  171.          (insert "*"))
  172.         (t (forward-char 2))))))
  173.  
  174. (defun toggle-truncate-lines (&optional p)
  175.   "Toggles the values of truncate-lines."
  176.   (interactive "P")
  177.   (setq truncate-lines
  178.     (cond ((null p) (not truncate-lines))
  179.           ((= 0 (prefix-numeric-value p)) nil)
  180.           (t t)))
  181.   (recenter))
  182.  
  183. (defun view-cleanup-backspaces ()
  184.   "Cleanup backspaces and if buffer is currently unmodified, don't flag it
  185. as a modified buffer.  This works even if the buffer is read-only."
  186.   (interactive)
  187.   (let ((buffer-read-only)(buf-mod (buffer-modified-p)))
  188.     (cleanup-backspaces)
  189.     (set-buffer-modified-p buf-mod)))
  190.  
  191. (defun view-scroll-lines-up (p)
  192.   "Scroll up prefix-arg lines, default 1."
  193.   (interactive "p")
  194.   (scroll-up p))
  195.  
  196. (defun view-scroll-lines-down (p)
  197.   "Scroll down prefix-arg lines, default 1."
  198.   (interactive "p")
  199.   (scroll-up (- p)))
  200.  
  201. (defun view-scroll-some-lines-down (&optional n)
  202.   "Scroll down prefix-arg lines, default 10, or last argument."
  203.   (interactive "p")
  204.   (if (> n 1) (setq view-default-lines n))
  205.   (scroll-down view-default-lines))
  206.  
  207. (defun view-scroll-some-lines-up (&optional n)
  208.   "Scroll up prefix-arg lines, default 10, or last argument."
  209.   (interactive "p")
  210.   (if (> n 1) (setq view-default-lines n))
  211.   (scroll-up view-default-lines))
  212.  
  213. (defun view-goto-line (&optional n)
  214.   "Goto line prefix, default 1."
  215.   (interactive "p")
  216.   (goto-line n))
  217.  
  218. (defun view-Goto-line (&optional n)
  219.   "Goto line prefix, default last line."
  220.   (interactive "p")
  221.   (if current-prefix-arg (goto-line n)
  222.     (end-of-buffer)
  223.     (recenter -1)
  224.     (move-to-window-line 0)))
  225.  
  226. (defun view-goto-percent (&optional p)
  227.   "Sets mark and goes to a position PERCENT percent of the file."
  228.   (interactive "p")
  229.   (set-mark-command nil)
  230.   (goto-char (+ (point-min) (/ (* p (- (point-max) (point-min))) 100)))
  231.   (beginning-of-line))
  232.  
  233. (defun view-mode-describe ()
  234.   (interactive)
  235.   (let ((mode-name "View")
  236.     (major-mode 'view-mode))
  237.     (describe-mode)))
  238.  
  239. (defun view-search-forward (s p)
  240.   "Search forward for REGEXP.  If regexp is empty, use last search string.
  241. With prefix ARG, search forward that many occurrences."
  242.   (interactive "sView search: \np")
  243.   (unwind-protect
  244.       (word-search-forward
  245.        (if (string= "" s) view-search-string s) nil nil p)
  246.     (setq view-search-arg p)
  247.     (or (string= "" s)
  248.     (setq view-search-string s))))
  249.  
  250. (defun view-search-backward (s p)
  251.   "Search backward for REGEXP.  If regexp is empty, use last search string.
  252. With prefix ARG, search forward that many occurrences."
  253.   (interactive "sView search backward: \np")
  254.   (view-search-forward s (- p)))
  255.  
  256. (defun view-repeat-search (p)
  257.   "Repeat last view search command.  If a prefix arg is given, use that
  258. instead of the previous arg, if the prefix is just a -, then take the
  259. negative of the last prefix arg."
  260.   (interactive "P")
  261.   (view-search-forward
  262.    view-search-string
  263.    (cond ((null p) view-search-arg)
  264.      ((eq p '-) (- view-search-arg))
  265.      (t (prefix-numeric-value p)))))
  266.  
  267. (defun view-quit (&optional p)
  268.   "Switch to another buffer and bury this one.
  269. If the buffer being viewed had not been in a buffer already, it is killed.
  270. With a prefix arg, it will be buried instead of killed."
  271.   (interactive "P")
  272.   (let ((b (current-buffer)))
  273.     (if (and view-kill-on-exit (not p))
  274.     (kill-buffer b)
  275.       (kill-all-local-variables)
  276.       (normal-mode)
  277.       (switch-to-buffer (other-buffer b))
  278.       (bury-buffer b))))
  279.  
  280. (defun auto-view-mode ()
  281.   "If the file of the current buffer is not writable, call view-mode.
  282.   This is meant to be added to find-file-hooks."
  283.   (if (and buffer-file-name
  284.        (not (file-writable-p buffer-file-name))) (view-mode)))
  285.