home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / modes / xmr / man.el < prev    next >
Encoding:
Text File  |  1992-03-29  |  13.0 KB  |  413 lines
  1. ;;; -*- Mode: Emacs-Lisp -*-
  2.  
  3. ;;; File:        manual.el
  4. ;;; Description:    Manual page formatter
  5. ;;; Author:        Eric Rose <erose@jessica.stanford.edu>
  6. ;;; Last Modified:    4 Apr 1991
  7. ;;; Version:        1.0
  8.  
  9. ;;; This file is not part of the GNU Emacs distribution (yet).
  10.  
  11. ;; This file is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  13. ;; accepts responsibility to anyone for the consequences of using it
  14. ;; or for whether it serves any particular purpose or works at all,
  15. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  16. ;; License for full details.
  17.  
  18. ;; Everyone is granted permission to copy, modify and redistribute
  19. ;; this file, but only under the conditions described in the
  20. ;; GNU Emacs General Public License.   A copy of this license is
  21. ;; supposed to have been given to you along with GNU Emacs so you
  22. ;; can know your rights and responsibilities.  It should be in a
  23. ;; file named COPYING.  Among other things, the copyright notice
  24. ;; and this notice must be preserved on all copies.
  25.  
  26. ;; This file is a modification of man.el, in the standard distribution.
  27. ;; Most of the code is taken from it, however, various improvements have
  28. ;; been made, such as a larger number of preset headers to delete,
  29. ;; as well as the ability to follow words and man page references.
  30. ;;
  31. ;; Manual browsing under emacs.  To use, type "M-x man".  You will be
  32. ;; prompted for an entry.  To get a man page on a
  33. ;; word pointed to by the cursor, type "m", or if there is no word it
  34. ;; will query the user for a topic.  This is useful for following manual
  35. ;; reference, and by typing "s", you can jump immediately to the "SEE ALSO"
  36. ;; section.  See the help for more info.
  37. ;;
  38. ;;  Need to add:
  39. ;;    Keep a list of man pages read, so that one can back up.
  40. ;;    Support for man -k.
  41. ;;
  42. ;; To autoload:
  43. ;; (autoload 'man "manual" "Improved Manual Browsing" t)
  44.  
  45. ;;;
  46. ;;; 12/19/91 isy
  47. ;;;   - modified so that the manual page buffer is "popped" up instead of
  48. ;;;     replacing the currently viewed window
  49. ;;;
  50.  
  51. (provide 'manual)
  52.  
  53. ;; Manual Variables
  54.  
  55. (defvar manual-non-word-regexp "[^A-Za-z0-9()_]")
  56. (defvar manual-buffer-name "*Manual Entry*")
  57. (defvar manual-temp-buffer "*Manual Input*")
  58. ;;
  59. ;;  Manual keymap
  60. ;;
  61.  
  62. (defconst manual-mode-map nil)
  63. (if manual-mode-map
  64.     nil
  65.   (setq manual-mode-map (make-keymap))
  66.   (suppress-keymap manual-mode-map)
  67.   (define-key manual-mode-map " " 'scroll-up)
  68.   (define-key manual-mode-map "\177" 'scroll-down)
  69.   (define-key manual-mode-map "n" 'manual-forward-line)
  70.   (define-key manual-mode-map "p" 'manual-backward-line)
  71.   (define-key manual-mode-map "\en" 'manual-next-section)
  72.   (define-key manual-mode-map "\ep" 'manual-previous-section)
  73.   (define-key manual-mode-map "\C-n" 'manual-forward-line)
  74.   (define-key manual-mode-map "\C-p" 'manual-backward-line)
  75.   (define-key manual-mode-map "m" 'manual-open-word)
  76.   (define-key manual-mode-map "a" 'manual-appropos)
  77.   (define-key manual-mode-map "g" 'manual-get-word)
  78.   (define-key manual-mode-map "s" 'manual-see-also)
  79.   (define-key manual-mode-map "\C-a" 'beginning-of-line)
  80.   (define-key manual-mode-map "\C-e" 'end-of-line)
  81.   (define-key manual-mode-map "\ea" 'backward-sentence)
  82.   (define-key manual-mode-map "\ee" 'forward-sentence)
  83.   (define-key manual-mode-map "\C-b" 'backward-char)
  84.   (define-key manual-mode-map "\C-f" 'forward-char)
  85.   (define-key manual-mode-map "b" 'manual-backward-word)
  86.   (define-key manual-mode-map "f" 'manual-forward-word)
  87.   (define-key manual-mode-map "\eb" 'backward-word)
  88.   (define-key manual-mode-map "\ef" 'forward-word)
  89.   (define-key manual-mode-map "<" 'beginning-of-buffer)
  90.   (define-key manual-mode-map "." 'beginning-of-buffer)
  91.   (define-key manual-mode-map ">" 'end-of-buffer)
  92.   (define-key manual-mode-map "\e<" 'beginning-of-buffer)
  93.   (define-key manual-mode-map "\e>" 'end-of-buffer)
  94.   (define-key manual-mode-map "?" 'describe-mode)
  95.   (define-key manual-mode-map "t" 'toggle-truncate-lines)
  96.   (define-key manual-mode-map "q" 'manual-quit))
  97.  
  98. ;; Stub for typing "man"
  99. (defun man (word)
  100.   "Displays a man page."
  101.   (interactive "sTopic: ")
  102.   (if (get-manual-entry word)
  103.       (save-excursion
  104.     (set-buffer (get-buffer-create manual-buffer-name))
  105.     (setq buffer-read-only nil)
  106.     (set-buffer manual-temp-buffer)
  107.     (copy-to-buffer manual-buffer-name (point-min) (point-max))))
  108.   (manual-mode))
  109.  
  110. ;; Manual mode
  111. (defun manual-mode ()
  112.   "Manual Mode is used to browse through manual pages.  Normal editing commands
  113. are turned off, and these can be used instead:
  114.  
  115. .    Move to the top of the current man page.
  116. SPC    Scroll down one page.
  117. DEL    Scroll up one page.
  118. n,C-n    Move down one line.
  119. p,C-p    Move up one line.
  120. M-n    Move to next section of the current page.
  121. M-p    Move to previous section of the current page.
  122. >    Move to end of man page.
  123. <    Move to beginning of man page.
  124. m    Get man page on the word the cursor is on.  If the cursor is not
  125.         pointing to any text, type in TOPIC(SECTION) or TOPIC at the prompt.
  126. g       Gets the man page on the topic entered at the prompt.  Same format
  127.         as above: TOPIC(SECTION).
  128. s    Jump to the 'SEE ALSO' section.
  129. C-a    Beginning of line.
  130. C-e    End of line.
  131. M-a    Previous sentence.
  132. M-e    Next sentence.
  133. f,M-f    Move forward one word.
  134. b,M-b   Move backwards one word.
  135. t       Toggle the line truncation.
  136. ?    This help screen."
  137.   (interactive)
  138.   (save-excursion             ; 12/19/91 isy
  139.     (switch-to-buffer manual-buffer-name)
  140.     (setq major-mode 'manual-mode)
  141.     (setq mode-name "Manual")
  142.     (setq buffer-auto-save-file-name nil)
  143.     (setq truncate-lines t)
  144.     (use-local-map manual-mode-map)
  145.     (setq buffer-read-only t)
  146.     ;;(delete-other-windows)         ; 12/19/91 isy
  147.     )
  148.   (let ((pop-up-windows t))
  149.     (display-buffer manual-buffer-name)) ; 12/19/91 isy
  150.   (message "Type ? for a list of commands"))
  151.  
  152. ;;
  153. ;; Does the work
  154. (defun get-manual-entry (topic)
  155.   "Display the Unix manual entry for TOPIC.
  156. TOPIC is either the title of the entry, or has the form TITLE(SECTION)
  157. where SECTION is the desired section of the manual, as in `tty(4)'."
  158.   (let ((section nil))
  159.     (if (null topic) nil)
  160.     (if (and (null section)
  161.          (string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic))
  162.     (setq section (substring topic (match-beginning 2)
  163.                  (match-end 2))
  164.           topic (substring topic (match-beginning 1)
  165.                    (match-end 1))))
  166.     (with-output-to-temp-buffer manual-temp-buffer
  167.       (buffer-flush-undo standard-output)
  168.       (save-excursion
  169.     (set-buffer standard-output)
  170.     (message "Looking for formatted entry for %s%s..."
  171.          topic (if section (concat "(" section ")") ""))
  172.     (let ((dirlist manual-formatted-dirlist)
  173.           (case-fold-search nil)
  174.           name)
  175.       (if (and section (or (file-exists-p
  176.                 (setq name (concat manual-formatted-dir-prefix
  177.                            (substring section 0 1)
  178.                            "/"
  179.                            topic "." section)))
  180.                    (file-exists-p
  181.                 (setq name (concat manual-formatted-dir-prefix
  182.                            section
  183.                            "/"
  184.                            topic "." section)))))
  185.           (insert-manual-file name)
  186.         (while dirlist
  187.           (let* ((dir (car dirlist))
  188.              (name1 (concat dir "/" topic "."
  189.                     (or section
  190.                     (substring
  191.                      dir
  192.                      (1+ (or (string-match "\\.[^./]*$" dir)
  193.                          -2))))))
  194.              completions)
  195.         (if (file-exists-p name1)
  196.             (insert-manual-file name1)
  197.           (condition-case ()
  198.               (progn
  199.             (setq completions (file-name-all-completions
  200.                        (concat topic "." (or section ""))
  201.                        dir))
  202.             (while completions
  203.               (insert-manual-file (concat dir "/" (car completions)))
  204.               (setq completions (cdr completions))))
  205.             (file-error nil)))
  206.         (goto-char (point-max)))
  207.           (setq dirlist (cdr dirlist)))))
  208.     
  209.     (if (= (buffer-size) 0)
  210.         (progn
  211.           (message "No formatted entry, invoking man %s%s..."
  212.                (if section (concat section " ") "") topic)
  213.           (if section
  214.           (call-process manual-program nil t nil section topic)
  215.             (call-process manual-program nil t nil topic))
  216.           (if (< (buffer-size) 80)
  217.           (progn
  218.             (goto-char (point-min))
  219.             (end-of-line)
  220.             (error (buffer-substring 1 (point)))
  221.             nil))))
  222.     
  223.     (message "Cleaning manual entry for %s..." topic)
  224.     (nuke-nroff-bs)
  225.     (set-buffer-modified-p nil)
  226.     (message ""))))
  227.   t)
  228.  
  229. ;; Hint: BS stands form more things than "back space"
  230. (defun nuke-nroff-bs ()
  231.   (interactive "*")
  232.   ;; Nuke underlining and overstriking (only by the same letter)
  233.   (goto-char (point-min))
  234.   (while (search-forward "\b" nil t)
  235.     (let* ((preceding (char-after (- (point) 2)))
  236.        (following (following-char)))
  237.       (cond ((= preceding following)
  238.          ;; x\bx
  239.          (delete-char -2))
  240.         ((= preceding ?\_)
  241.          ;; _\b
  242.          (delete-char -2))
  243.         ((= following ?\_)
  244.          ;; \b_
  245.          (delete-region (1- (point)) (1+ (point))))
  246.         ((= following ?\+)
  247.          ;; \b+
  248.          (delete-region (1- (point)) (1+ (point)))))))
  249.  
  250.   ;; Nuke blanks lines at start.
  251.   (goto-char (point-min))
  252.   (skip-chars-forward "\n")
  253.   (delete-region (point-min) (point))
  254.  
  255.   ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)"
  256.   (goto-char (point-min))
  257.   (forward-line 1)
  258.   (while (re-search-forward "^ *\\([A-Za-z][-_A-Za-z0-9]*([0-9A-Z]+)\\).*\\1$" nil t)
  259.     (replace-match ""))
  260.   
  261.   ;; Nuke footers: "Printed 12/3/85    27 April 1981    1"
  262.   ;;    Sun appear to be on drugz:
  263.   ;;     "Sun Release 3.0B  Last change: 1 February 1985     1"
  264.   ;;    HP are even worse!
  265.   ;;     "     Hewlett-Packard   -1- (printed 12/31/99)"  FMHWA12ID!!
  266.   ;;    System V (well WICATs anyway):
  267.   ;;     "Page 1              (printed 7/24/85)"
  268.   ;;    Who is administering PCP to these corporate bozos?
  269.   (goto-char (point-min))
  270.   (while (re-search-forward
  271.        (cond ((eq system-type 'hpux)
  272.           "^[ \t]*Hewlett-Packard\\(\\| Company\\)[ \t]*- [0-9]* -.*$")
  273.          ((eq system-type 'usg-unix-v)
  274.           "^ *Page [0-9]*.*(printed [0-9/]*)$")
  275.          (t
  276.           "^\\(Printed\\|Sun Release\\) [0-9].*[0-9]$"))
  277.        nil t)
  278.     (replace-match ""))
  279.  
  280.   ;; Crunch blank lines
  281.   (goto-char (point-min))
  282.   (while (re-search-forward "\n\n\n\n*" nil t)
  283.     (replace-match "\n\n")))
  284.  
  285.  
  286. (defun insert-manual-file (name)
  287.   ;; Insert manual file (unpacked as necessary) into buffer
  288.   (if (equal (substring name -2) ".Z")
  289.       (call-process "zcat" nil t nil name)
  290.     (if (equal (substring name -2) ".z")
  291.     (call-process "pcat" nil t nil name)
  292.       (insert-file-contents name))))
  293. ;
  294. ; Added by erose
  295. ;
  296. (defun manual-forward-line (n)
  297.   (interactive "p")
  298.   (forward-line n))
  299.  
  300. (defun manual-backward-line (n)
  301.   (interactive "p")
  302.   (forward-line (- n)))
  303.  
  304. (defun manual-forward-word (n)
  305.   (interactive "p")
  306.   (forward-char 1)
  307.   (forward-word n)
  308.   (forward-char -1))
  309.  
  310. (defun manual-backward-word (n)
  311.   (interactive "p")
  312.   (backward-word n))
  313.  
  314. ;  Searches for next "Section"
  315. (defun manual-next-section ()
  316.   (interactive)
  317.   (beginning-of-line)
  318.   (forward-line)
  319.   (while (not (or (looking-at "[A-Z]")
  320.           (eobp)))
  321.     (forward-line 1)))
  322.  
  323. (defun manual-previous-section ()
  324.   (interactive)
  325.   (beginning-of-line)
  326.   (forward-line -1)
  327.   (while (not (or (looking-at "[A-Z]")
  328.           (bobp)))
  329.     (forward-line -1)))
  330.  
  331. ;  Queries for the man page, same as manual-open-word below other than that.
  332. (defun manual-get-word ()
  333.   (interactive)
  334.   (let ((word))
  335.     (save-excursion
  336.       (if (not (setq word (call-interactively 'manual-get-topic)))
  337.       nil)
  338.       (if (get-manual-entry word)
  339.       (save-excursion
  340.         (setq buffer-read-only nil)
  341.         (set-buffer manual-temp-buffer)
  342.         (copy-to-buffer manual-buffer-name (point-min) (point-max)))))
  343.     (setq buffer-read-only t)
  344.     (delete-other-windows)
  345.     (message "%s" word)))
  346.  
  347. ;  Tries to find the man page for this word
  348. (defun manual-open-word ()
  349.   (interactive)
  350.   (let ((word))
  351.     (save-excursion
  352.       (if (not (manual-mark-word))
  353.       (if (not (setq word (call-interactively 'manual-get-topic)))
  354.           nil)
  355.     (setq word (buffer-substring (region-beginning) (region-end))))
  356.       (if (get-manual-entry word)
  357.       (save-excursion
  358.         (setq buffer-read-only nil)
  359.         (set-buffer manual-temp-buffer)
  360.         (copy-to-buffer manual-buffer-name (point-min) (point-max)))))
  361.     (setq buffer-read-only t)
  362.     (delete-other-windows)
  363.     (message "%s" word)))
  364. ;
  365. (defun manual-get-topic (topic)
  366.   (interactive "sManual entry (topic): ")
  367.   topic)
  368. ;
  369. ;  Marks a word that can be a manual reference.  Returns nil if it can't
  370. ;  figure it out.
  371. ;
  372. (defun manual-mark-word ()
  373.   "Marks a word that should correspond to a manual refernce.
  374. The variable 'manual-non-word-regexp' controls what is not part of a manual
  375. refernce."
  376.   (interactive)
  377.   (if (looking-at manual-non-word-regexp)
  378.       nil
  379.     (if (not (re-search-forward manual-non-word-regexp nil t))
  380.     nil
  381.       (forward-char -1)
  382.       (push-mark nil nil)
  383.       (if (not (re-search-backward manual-non-word-regexp nil t))
  384.       nil
  385.     (forward-char 1)
  386.     t))))
  387.     
  388. ;
  389. (defun manual-see-also ()
  390.   (interactive)
  391.   (let ((opoint (point))
  392.     (case case-fold-search))
  393.     (goto-char (point-min))
  394.     (setq case-fold-search nil)
  395.     (if (not (search-forward "SEE ALSO" nil t))
  396.     (progn
  397.       (goto-char opoint)
  398.       (message "No 'SEE ALSO' section on this manpage.")))
  399.     (setq case-fold-search case)))
  400.     
  401. ;
  402. (defun toggle-truncate-lines ()
  403.   (interactive)
  404.   (setq truncate-lines (not truncate-lines))
  405.   (recenter))
  406.  
  407. ;
  408. (defun manual-quit ()
  409.   (interactive)
  410.   (let ((obuf (current-buffer)))
  411.     (switch-to-buffer (other-buffer))
  412.     (bury-buffer obuf)))
  413.