home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / superman / superman.el < prev    next >
Encoding:
Text File  |  1992-05-13  |  26.8 KB  |  764 lines
  1. ;; -*- Mode: Emacs-Lisp -*-
  2. ;; File:        superman.el
  3. ;; Description:     Background manual page formatter & mode
  4. ;; Author:        Barry A. Warsaw <bwarsaw@cen.com>
  5. ;; Last Modified:    31-Jul-1991
  6. ;; Version:        1.0
  7. ;;
  8. ;; LCD Archive Entry:
  9. ;; superman|Barry A. Warsaw|bwarsaw@cen.com
  10. ;; |Background Un*x manual page formatter and mode
  11. ;; |17-Jul-1991|1.0|
  12.  
  13. ;; ========== Standard Disclaimer ==========
  14. ;; This file is not part of the GNU Emacs distribution (yet).
  15.  
  16. ;; This file is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY.  No author or distributor accepts
  18. ;; responsibility to anyone for the consequences of using it or for
  19. ;; whether it serves any particular purpose or works at all, unless he
  20. ;; says so in writing.  Refer to the GNU Emacs General Public License
  21. ;; for full details. You should consider this code to be covered under
  22. ;; the terms of the GPL.
  23.  
  24. ;; Everyone is granted permission to copy, modify and redistribute
  25. ;; this file, but only under the conditions described in the GNU Emacs
  26. ;; General Public License.  A copy of this license is supposed to have
  27. ;; been given to you along with GNU Emacs so you can know your rights
  28. ;; and responsibilities.  It should be in a file named COPYING.  Among
  29. ;; other things, the copyright notice and this notice must be
  30. ;; preserved on all copies.
  31.  
  32. ;; ========== Credits and History ========== 
  33. ;; In mid 1991, several people posted some interesting improvements to
  34. ;; man.el from the standard emacs 18.57 distribution.  I liked many of
  35. ;; these, but wanted everthing in one single package, so I decided
  36. ;; to encorporate them into a single manual browsing mode.  While
  37. ;; much of the code here has been rewritten, and some features added,
  38. ;; these folks deserve lots of credit for providing the initial
  39. ;; excellent packages on which this one is based.
  40.  
  41. ;; Nick Duffek <duffek@chaos.cs.brandeis.edu>, posted a very nice
  42. ;; improvement which retrieved and cleaned the manpages in a
  43. ;; background process, and which correctly deciphered such options as
  44. ;; man -k.
  45.  
  46. ;; Eric Rose <erose@jessica.stanford.edu>, submitted manual.el which
  47. ;; provided a very nice manual browsing mode.
  48.  
  49. ;; ========== Features ==========
  50. ;; + Runs "man" in the background and pipes the results through a
  51. ;;   series of sed and awk scripts so that all retrieving and cleaning
  52. ;;   is done in the background. The cleaning commands are configurable.
  53. ;; + Syntax is the same as Un*x man
  54. ;; + Functionality is the same as Un*x man, including "man -k" and
  55. ;;   "man <section>, etc.
  56. ;; + Provides a manual browsing mode with keybindings for traversing
  57. ;;   the sections of a manpage, following references in the SEE ALSO
  58. ;;   section, and more.
  59. ;; + Multiple manpages created with the same man command are put into
  60. ;;   a narrowed buffer circular list.
  61.  
  62.  
  63. (require 'sc-alist)
  64. (provide 'superman)
  65.  
  66. ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
  67. ;; user variables
  68.  
  69. (defvar sm-notify 'friendly
  70.   "*Selects the behavior when manpage is ready.
  71. This variable may have one of the following values:
  72.  
  73. 'bully      -- make the manpage the current buffer and only window
  74. 'aggressive -- make the manpage the current buffer in the other window
  75. 'friendly   -- display manpage in other window but don't make current
  76. 'polite     -- don't display manpage, but prints message when ready (beeps)
  77. 'quiet      -- like 'polite, but don't beep
  78. 'meek       -- make no indication that manpage is ready
  79.  
  80. Any other value of sm-notify is equivalent to 'meek.")
  81.  
  82. (defvar sm-reuse-okay-p t
  83.   "*Reuse a manpage buffer if possible.
  84. When t, and a manpage buffer already exists with the same invocation,
  85. superman just indicates the manpage is ready according to the value of
  86. sm-notify. When nil, it always fires off a background process, putting
  87. the results in a uniquely named buffer.")
  88.  
  89. (defvar sm-overload-p t
  90.   "*Overload standard manual-entry command.
  91. When t, the function manual-entry is fset to superman's manual page
  92. function. Otherwise you have to invoke superman via sm-manual-entry.")
  93.  
  94. (defvar sm-downcase-section-letters-p t
  95.   "*Letters in sections are converted to lower case.
  96. Some Un*x man commands can't handle uppercase letters in sections, for
  97. example \"man 2V chmod\", but they are often displayed in the manpage
  98. with the upper case letter. When this variable is t, the section
  99. letter (e.g., \"2V\") is converted to lowercase (e.g., \"2v\") before
  100. being sent to the man background process.")
  101.  
  102. (defvar sm-circular-pages-p t
  103.   "*If t, the manpage list is treated as circular for traversal.")
  104.  
  105. (defvar sm-auto-section-alist
  106.   '((c-mode . ("2" "3"))
  107.     (c++-mode . ("2" "3"))
  108.     (shell-mode . ("1" "8"))
  109.     (cmushell-mode . ("1" "8"))
  110.     (text-mode . "1")
  111.     )
  112.   "*Association list of major modes and their default section numbers.
  113. List is of the form: (MAJOR-MODE . [SECTION | (SECTION*)]). If current
  114. major mode is not in list, then the default is to check for manpages
  115. in all sections.")
  116.  
  117. (defvar sm-section-translations-alist
  118.   '(("3C++" . "3")
  119.     ("1-UCB" . ""))
  120.   "*Association list of bogus sections to real section numbers.
  121. Some manpages (e.g. the Sun C++ 2.1 manpages) have section numbers in
  122. their references which Un*x man(1) does not recognize.  This
  123. assocation list is used to translate those sections, when found, to
  124. the associated section number.")
  125.  
  126. (defvar sm-filter-list
  127.   '(("sed "
  128.      ("-e 's/.\010//g'"
  129.       "-e '/[Nn]o such file or directory/d'"
  130.       "-e '/Reformatting page.  Wait... done/d'"
  131.       "-e '/^\\([A-Z][A-Z.]*([0-9A-Za-z][-0-9A-Za-z+]*)\\).*\\1$/d'"
  132.       "-e '/^[ \\t]*Hewlett-Packard Company[ \\t]*- [0-9]* -.*$/d'"
  133.       "-e '/^[ \\t]*Hewlett-Packard[ \\t]*- [0-9]* -.*$/d'"
  134.       "-e '/^ *Page [0-9]*.*(printed [0-9\\/]*)$/d'"
  135.       "-e '/^Printed [0-9].*[0-9]$/d'"
  136.       "-e '/^Sun Microsystems.*Last change:/d'"
  137.       "-e '/^Sun Release [0-9].*[0-9]$/d'"
  138.       "-e '/^\\n$/D'"
  139.       ))
  140.     ("awk '"
  141.      ("BEGIN { blankline=0; anonblank=0; }"
  142.       "/^$/ { if (anonblank==0) next; }"
  143.       "{ anonblank=1; }"
  144.       "/^$/ { blankline++; next; }"
  145.       "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }"
  146.       "'"
  147.       ))
  148.      )
  149.   "*Manpage cleaning filter command phrases.
  150. This variable contains an association list of the following form:
  151.  
  152. '((command-string (phrase-string*))*)
  153.  
  154. Each phrase-string is concatenated onto the command-string to form a
  155. command filter. The (standard) output (and standard error) of the Un*x
  156. man command is piped through each command filter in the order the
  157. commands appear in the association list. The final output is placed in
  158. the manpage buffer.")
  159.  
  160. (defvar sm-mode-line-format
  161.   '("" mode-line-modified
  162.        mode-line-buffer-identification "   "
  163.        global-mode-string
  164.        sm-page-mode-string
  165.        "    %[(" mode-name minor-mode-alist mode-line-process ")%]----"
  166.        (-3 . "%p") "-%-")
  167.   "*Mode line format for manual mode buffer.")
  168.  
  169. (defvar sm-mode-map nil
  170.   "*Keymap for sm-manual-mode.")
  171.  
  172. (defvar sm-mode-hooks nil
  173.   "*Hooks for sm-manual-mode.")
  174.  
  175. (defvar sm-section-regexp "[0-9][a-zA-Z+]*"
  176.   "*Regular expression describing a manpage section within parentheses.")
  177.  
  178. (defvar sm-heading-regexp "^[A-Z]"
  179.   "*Regular expression describing a manpage heading entry.")
  180.  
  181. (defvar sm-see-also-regexp "SEE ALSO"
  182.   "*Regular expression for SEE ALSO heading (or your equivalent).
  183. This regexp should not start with a `^' character.")
  184.  
  185. (defvar sm-first-heading-regexp "^NAME$\\|^No manual entry for .*$"
  186.   "*Regular expression describing first heading on a manpage.
  187. This regular expression should start with a `^' character.")
  188.  
  189. (defvar sm-reference-regexp "[-a-zA-Z0-9_.]+\\(([0-9][a-zA-Z+]*)\\)?"
  190.   "*Regular expression describing a reference in the SEE ALSO section.")
  191.  
  192.  
  193. ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  194. ;; end user variables
  195.  
  196. (defconst sm-version-number "1.0"
  197.   "Superman's version number.")
  198.  
  199.  
  200. ;; other variables and keymap initializations
  201. (make-variable-buffer-local 'sm-sections-alist)
  202. (make-variable-buffer-local 'sm-refpages-alist)
  203. (make-variable-buffer-local 'sm-page-list)
  204. (make-variable-buffer-local 'sm-current-page)
  205. (make-variable-buffer-local 'sm-page-mode-string)
  206.  
  207. (setq-default sm-sections-alist nil)
  208. (setq-default sm-refpages-alist nil)
  209. (setq-default sm-page-list nil)
  210. (setq-default sm-current-page 0)
  211. (setq-default sm-page-mode-string "1 (of 1)")
  212.  
  213. (if sm-mode-map
  214.     nil
  215.   (setq sm-mode-map (make-keymap))
  216.   (suppress-keymap sm-mode-map)
  217.   (define-key sm-mode-map " "    'scroll-up)
  218.   (define-key sm-mode-map "\177" 'scroll-down)
  219.   (define-key sm-mode-map "n"    'sm-next-section)
  220.   (define-key sm-mode-map "p"    'sm-previous-section)
  221.   (define-key sm-mode-map "\en"  'sm-next-manpage)
  222.   (define-key sm-mode-map "\ep"  'sm-previous-manpage)
  223.   (define-key sm-mode-map ","    'beginning-of-buffer)
  224.   (define-key sm-mode-map "."    'end-of-buffer)
  225.   (define-key sm-mode-map "r"    'sm-follow-manual-reference)
  226.   (define-key sm-mode-map "t"    'toggle-truncate-lines)
  227.   (define-key sm-mode-map "g"    'sm-goto-section)
  228.   (define-key sm-mode-map "s"    'sm-goto-see-also-section)
  229.   (define-key sm-mode-map "q"    'sm-quit)
  230.   (define-key sm-mode-map "m"    'sm-manual-entry)
  231.   (define-key sm-mode-map "v"    'sm-version)
  232.   (define-key sm-mode-map "?"    'describe-mode)
  233.   )
  234.  
  235.  
  236. ;; ======================================================================
  237. ;; utilities
  238.  
  239. (defun sm-page-mode-string ()
  240.   "Formats part of the mode line for manual mode."
  241.   (format "%d (of %d)" sm-current-page (length sm-page-list)))
  242.  
  243. (defun sm-delete-trailing-newline (str)
  244.   (if (string= (substring str (1- (length str))) "\n")
  245.       (substring str 0 (1- (length str)))
  246.     str))
  247.  
  248. (defun sm-build-man-command ()
  249.   "Builds the entire background manpage and cleaning command."
  250.   (let ((command "man %s 2>&1 | ")
  251.     (flist sm-filter-list))
  252.     (while flist
  253.       (let ((pcom (car (car flist)))
  254.         (pargs (car (cdr (car flist)))))
  255.     (setq flist (cdr flist))
  256.     (if (or (not (stringp pcom))
  257.         (not (listp pargs)))
  258.         (error "malformed sm-filter-list."))
  259.     (setq command (concat command pcom
  260.                   (mapconcat '(lambda (phrase) phrase)
  261.                      pargs " "))))
  262.       (if flist
  263.       (setq command (concat command " | " ))))
  264.     command))
  265.  
  266. (defun sm-downcase (man-args)
  267.   "Downcases section letters in MAN-ARGS."
  268.   (let ((newargs "")
  269.     (s 0)
  270.     mstart mend
  271.     (len (length man-args)))
  272.     (while (and (< s len)
  273.         (setq mstart (string-match sm-section-regexp man-args s)))
  274.       (setq mend (match-end 0)
  275.         newargs (concat newargs (substring man-args s mstart)))
  276.       (setq newargs (concat newargs (downcase
  277.                      (substring man-args mstart mend)))
  278.         s mend))
  279.     (concat newargs (substring man-args s len))))
  280.  
  281. (defun sm-translate-references (ref)
  282.   "Translates REF from \"chmod(2V)\" to \"2v chmod\" style."
  283.   (if (string-match (concat "(" sm-section-regexp ")$") ref)
  284.       (let* ((word (progn (string-match "(" ref)
  285.               (substring ref 0 (1- (match-end 0)))))
  286.          (section-re (concat "(\\(" sm-section-regexp "\\))"))
  287.          (section (if (string-match section-re ref)
  288.               (substring ref (match-beginning 1) (match-end 1))
  289.             ""))
  290.          (slist sm-section-translations-alist)
  291.          )
  292.     (if sm-downcase-section-letters-p
  293.         (setq section (sm-downcase section)))
  294.     (while slist
  295.       (let ((s1 (car (car slist)))
  296.         (s2 (cdr (car slist))))
  297.         (setq slist (cdr slist))
  298.         (if sm-downcase-section-letters-p
  299.         (setq s1 (sm-downcase s1)))
  300.         (if (not (string= s1 section)) nil
  301.           (setq section (if sm-downcase-section-letters-p
  302.                 (sm-downcase s2)
  303.                   s2)
  304.             slist nil))))
  305.     (concat section " " word))
  306.     ref))
  307.  
  308. (defun sm-linepos (&optional position col-p)
  309.   "Return the character position at various line/buffer positions.
  310. Preserves the state of point, mark, etc. Optional POSITION can be one
  311. of the following symbols:
  312.      bol == beginning of line
  313.      boi == beginning of indentation
  314.      eol == end of line [default]
  315.      bob == beginning of buffer
  316.      eob == end of buffer
  317.  
  318. Optional COL-P non-nil returns current-column instead of character position."
  319.   (let ((tpnt (point))
  320.     rval)
  321.     (cond
  322.      ((eq position 'bol) (beginning-of-line))
  323.      ((eq position 'boi) (back-to-indentation))
  324.      ((eq position 'bob) (goto-char (point-min)))
  325.      ((eq position 'eob) (goto-char (point-max)))
  326.      (t (end-of-line)))
  327.     (setq rval (if col-p (current-column) (point)))
  328.     (goto-char tpnt)
  329.     rval))
  330.  
  331.  
  332. ;; ======================================================================
  333. ;; default man entry and get word under point
  334.  
  335. (defun sm-default-man-args (manword)
  336.   "Build the default man args from MANWORD and major-mode."
  337.   (let ((mode major-mode)
  338.     (slist sm-auto-section-alist))
  339.     (while (and slist
  340.         (not (eq (car (car slist)) mode)))
  341.       (setq slist (cdr slist)))
  342.     (if (not slist)
  343.     manword
  344.       (let ((sections (cdr (car slist))))
  345.     (if (not (listp sections))
  346.         (concat sections " " manword)
  347.       (let ((manarg ""))
  348.         (while sections
  349.           (setq manarg (concat manarg " " (car sections) " " manword))
  350.           (setq sections (cdr sections)))
  351.         manarg)
  352.       )))))
  353.  
  354. (defun sm-default-man-entry ()
  355.   "Make a guess at a default manual entry.
  356. This guess is based on the text surrounding the cursor, and the
  357. default section number is selected from sm-auto-section-alist."
  358.   (let ((default-section nil)
  359.     default-title)
  360.     (save-excursion
  361.       
  362.       ;; Default man entry title is any word the cursor is on,
  363.       ;; or if cursor not on a word, then nearest preceding
  364.       ;; word.
  365.       (and (not (looking-at "[a-zA-Z_]"))
  366.        (skip-chars-backward "^a-zA-Z_"))
  367.       (skip-chars-backward "(a-zA-Z_0-9")
  368.       (and (looking-at "(") (forward-char 1))
  369.       (setq default-title
  370.         (buffer-substring
  371.          (point)
  372.          (progn (skip-chars-forward "a-zA-Z0-9_") (point))))
  373.       
  374.       ;; If looking at something like ioctl(2) or brc(1M), include
  375.       ;; section number in default-entry
  376.       (if (looking-at "[ \t]*([ \t]*[0-9][a-zA-Z]?[ \t]*)")
  377.       (progn (skip-chars-forward "^0-9")
  378.          (setq default-section
  379.                (buffer-substring
  380.             (point)
  381.             (progn
  382.               (skip-chars-forward "0-9a-zA-Z")
  383.               (point)))))
  384.     
  385.     ;; Otherwise, assume section number to be 2 if we're
  386.     ;; in C code
  387.     (and (eq major-mode 'c-mode)
  388.          (setq default-section "2")))
  389.       (if default-section
  390.       (format "%s %s" default-section default-title)
  391.     default-title))))
  392.      
  393.  
  394. ;; ======================================================================
  395. ;; top level command and background process sentinel
  396.  
  397. (defun sm-manual-entry (arg)
  398.   "Get a Un*x manual page and put it in a buffer.
  399. This command is the top-level command in the superman package. It runs
  400. a Un*x command to retrieve and clean a manpage in the background and
  401. places the results in a sm-manual-mode (manpage browsing) buffer. See
  402. variable sm-notify for what happens when the buffer is ready.
  403. Universal argument ARG, is passed to sm-getpage-in-background."
  404.   (interactive "P")
  405.   (let* ((default-entry (sm-default-man-entry))
  406.      (man-args
  407.       (read-string (format "%sman "
  408.             (if (string= default-entry "") ""
  409.               (format "(default: man %s) "
  410.                   default-entry))))))
  411.     (and (string= man-args "")
  412.      (if (string= default-entry "")
  413.          (error "No man args given.")
  414.        (setq man-args default-entry)))
  415.     (if sm-downcase-section-letters-p
  416.     (setq man-args (sm-downcase man-args)))
  417.     (sm-getpage-in-background man-args (consp arg))
  418.     ))
  419.  
  420. (defun sm-getpage-in-background (man-args &optional override-reuse-p)
  421.   "Uses MAN-ARGS to build and fire off the manpage and cleaning command.
  422. Optional OVERRIDE-REUSE-P, when supplied non-nil forces superman to
  423. start a background process even if a buffer already exists and
  424. sm-reuse-okay-p is non-nil."
  425.   (let* ((bufname (concat "*man " man-args "*"))
  426.      (buffer  (get-buffer bufname)))
  427.     (if (and sm-reuse-okay-p
  428.          (not override-reuse-p)
  429.          buffer)
  430.     (sm-notify-when-ready buffer)
  431.       (message "Invoking man %s in background..." man-args)
  432.       (setq buffer (generate-new-buffer bufname))
  433.       (set-process-sentinel
  434.        (start-process "man" buffer "sh" "-c"
  435.               (format (sm-build-man-command) man-args))
  436.        'sm-bgproc-sentinel))
  437.     ))
  438.  
  439. (defun sm-notify-when-ready (man-buffer)
  440.   "Notify the user when MAN-BUFFER is ready.
  441. See the variable sm-notify for the different notification behaviors."
  442.   (cond
  443.    ((eq sm-notify 'bully)
  444.     (pop-to-buffer man-buffer)
  445.     (delete-other-windows-quietly))
  446.    ((eq sm-notify 'aggressive)
  447.     (pop-to-buffer man-buffer))
  448.    ((eq sm-notify 'friendly)
  449.     (display-buffer man-buffer 'not-this-window))
  450.    ((eq sm-notify 'polite)
  451.     (beep)
  452.     (message "Manual buffer %s is ready." (buffer-name man-buffer)))
  453.    ((eq sm-notify 'quiet)
  454.     (message "Manual buffer %s is ready." (buffer-name man-buffer)))
  455.    ((or (eq sm-notify 'meek)
  456.     t)
  457.     (message ""))
  458.    ))
  459.  
  460. (defun sm-bgproc-sentinel (process msg)
  461.   "Manpage background process sentinel."
  462.   (let ((man-buffer (process-buffer process))
  463.     (delete-buff nil)
  464.     (err-mess nil))
  465.     (if (null (buffer-name man-buffer)) ;; deleted buffer
  466.     (set-process-buffer process nil)
  467.       (save-excursion
  468.     (set-buffer man-buffer)
  469.     (goto-char (point-min))
  470.     (cond ((or (looking-at "No \\(manual \\)*entry for")
  471.            (looking-at "[^\n]*: nothing appropriate$"))
  472.            (setq err-mess (buffer-substring (point) (sm-linepos 'eol))
  473.              delete-buff t)
  474.            )
  475.           ((not (and (eq (process-status process) 'exit)
  476.              (= (process-exit-status process) 0)))
  477.            (setq err-mess
  478.              (concat (buffer-name man-buffer)
  479.                  ": process "
  480.                  (let ((eos (1- (length msg))))
  481.                    (if (= (aref msg eos) ?\n)
  482.                    (substring msg 0 eos) msg))))
  483.            (goto-char (point-max))
  484.            (insert (format "\nprocess %s" msg))
  485.            )))
  486.       (if delete-buff
  487.       (kill-buffer man-buffer)
  488.     (save-window-excursion
  489.       (save-excursion
  490.         (set-buffer man-buffer)
  491.         (sm-manual-mode)
  492.         (set-buffer-modified-p nil)))
  493.     (sm-notify-when-ready man-buffer))
  494.  
  495.       (if err-mess
  496.       (error err-mess))
  497.       )))
  498.  
  499.  
  500. ;; ======================================================================
  501. ;; set up manual mode in buffer and build alists
  502.  
  503. (defun sm-manual-mode ()
  504.   "SUPERMAN 1.0: A mode for browsing Un*x manual pages.
  505.  
  506. The following superman commands are available in the buffer. Try
  507. \"\\[describe-key] <key> RET\" for more information:
  508.  
  509. \\[sm-manual-entry]       Prompt to retrieve a new manpage.
  510. \\[sm-follow-manual-reference]       Retrieve reference in SEE ALSO section.
  511. \\[sm-next-manpage]   Jump to next manpage in circular list.
  512. \\[sm-previous-manpage]   Jump to previous manpage in circular list.
  513. \\[sm-next-section]       Jump to next manpage section.
  514. \\[sm-previous-section]       Jump to previous manpage section.
  515. \\[sm-goto-section]       Go to a manpage section.
  516. \\[sm-goto-see-also-section]       Jumps to the SEE ALSO manpage section.
  517. \\[sm-quit]       Deletes the manpage, its buffer, and window.
  518. \\[sm-version]       Prints superman's version number.
  519. \\[describe-mode]       Prints this help text.
  520.  
  521. The following variables may be of some use. Try
  522. \"\\[describe-variable] <variable-name> RET\" for more information:
  523.  
  524. sm-notify                      What happens when manpage formatting is done.
  525. sm-reuse-okay-p                Okay to reuse already formatted buffer?
  526. sm-overload-p                  Fset manual-entry command to sm-manual-entry?
  527. sm-downcase-section-letters-p  Force section letters to lower case?
  528. sm-circular-pages-p            Multiple manpage list treated as circular?
  529. sm-auto-section-alist          List of major modes and their section numbers.
  530. sm-section-translations-alist  List of section numbers and their Un*x equiv.
  531. sm-filter-list                 Background manpage filter command.
  532. sm-mode-line-format            Mode line format for sm-manual-mode buffers.
  533. sm-mode-map                    Keymap bindings for sm-manual-mode buffers.
  534. sm-mode-hooks                  Hooks for sm-manual-mode.
  535. sm-section-regexp              Regexp describing manpage section letters.
  536. sm-heading-regexp              Regexp describing section headers.
  537. sm-see-also-regexp             Regexp for SEE ALSO section (or your equiv).
  538. sm-first-heading-regexp        Regexp for first heading on a manpage.
  539. sm-reference-regexp            Regexp matching a references in SEE ALSO.
  540. sm-version-number              Superman version number.
  541.  
  542. The following key bindings are currently in effect in the buffer:
  543. \\{sm-mode-map}"
  544.   (interactive)
  545.   (setq major-mode 'sm-manual-mode
  546.     mode-name "Manual"
  547.     buffer-auto-save-file-name nil
  548.     mode-line-format sm-mode-line-format
  549.     truncate-lines t
  550.     buffer-read-only t)
  551.   (buffer-flush-undo (current-buffer))
  552.   (auto-fill-mode -1)
  553.   (use-local-map sm-mode-map)
  554.   (goto-char (point-min))
  555.   (sm-build-page-list)
  556.   (sm-goto-page 1))
  557.  
  558. (defun sm-build-section-alist ()
  559.   "Build the association list of manpage sections."
  560.   (setq sm-sections-alist nil)
  561.   (goto-char (point-min))
  562.   (while (re-search-forward sm-heading-regexp (point-max) t)
  563.     (aput 'sm-sections-alist
  564.       (buffer-substring (sm-linepos 'bol) (sm-linepos)))
  565.     (forward-line 1)
  566.     ))
  567.  
  568. (defun sm-build-references-alist ()
  569.   "Build the association list of references (in the SEE ALSO section)."
  570.   (setq sm-refpages-alist nil)
  571.   (save-excursion
  572.     (if (sm-find-section sm-see-also-regexp)
  573.     (let ((start (progn (forward-line 1) (point)))
  574.           (end (progn
  575.              (sm-next-section 1)
  576.              (point)))
  577.           hyphenated
  578.           (runningpoint -1))
  579.       (narrow-to-region start end)
  580.       (goto-char (point-min))
  581.       (back-to-indentation)
  582.       (while (and (not (eobp)) (/= (point) runningpoint))
  583.         (setq runningpoint (point))
  584.         (let* ((bow (point))
  585.            (eow (re-search-forward sm-reference-regexp end t))
  586.            (word (buffer-substring bow (match-end 0)))
  587.            (len (1- (length word))))
  588.           (if (not eow) nil
  589.         (if hyphenated
  590.             (setq word (concat hyphenated word)
  591.               hyphenated nil))
  592.         (if (= (aref word len) ?-)
  593.             (setq hyphenated (substring word 0 len))
  594.           (aput 'sm-refpages-alist word))))
  595.         (skip-chars-forward " \t\n,"))
  596.       ))))
  597.  
  598. (defun sm-build-page-list ()
  599.   "Build the list of separate manpages in the buffer."
  600.   (setq sm-page-list nil)
  601.   (save-excursion
  602.     (let ((page-start (sm-linepos 'bob))
  603.       (page-end (sm-linepos 'eob))
  604.       (regexp sm-first-heading-regexp))
  605.       (goto-char (point-min))
  606.       (re-search-forward regexp (point-max) t)
  607.       (while (not (eobp))
  608.     (if (re-search-forward regexp (point-max) t)
  609.         (progn
  610.           (setq page-end (sm-linepos 'bol))
  611.           (end-of-line))
  612.       (goto-char (point-max))
  613.       (setq page-end (point)))
  614.     (setq sm-page-list (append sm-page-list
  615.                    (list (cons page-start page-end)))
  616.           page-start page-end)
  617.     ))))  
  618.  
  619.  
  620. ;; ======================================================================
  621. ;; sm-manual-mode commands
  622.  
  623. (defun sm-next-section (n)
  624.   "Move point to Nth next section (default 1)."
  625.   (interactive "p")
  626.   (if (looking-at sm-heading-regexp)
  627.       (forward-line 1))
  628.   (if (re-search-forward sm-heading-regexp (point-max) t n)
  629.       (beginning-of-line)
  630.     (goto-char (point-max))))
  631.  
  632. (defun sm-previous-section (n)
  633.   "Move point to Nth previous section (default 1)."
  634.   (interactive "p")
  635.   (if (looking-at sm-heading-regexp)
  636.       (forward-line -1))
  637.   (if (re-search-backward sm-heading-regexp (point-min) t n)
  638.       (beginning-of-line)
  639.     (goto-char (point-min))))
  640.  
  641. (defun sm-find-section (section)
  642.   "Move point to SECTION if it exists, otherwise don't move point.
  643. Returns t if section is found, nil otherwise."
  644.   (let ((curpos (point)))
  645.     (goto-char (point-min))
  646.     (if (re-search-forward (concat "^" section) (point-max) t)
  647.     (progn (beginning-of-line) t)
  648.       (goto-char curpos)
  649.       nil)
  650.     ))
  651.  
  652. (defun sm-goto-section ()
  653.   "Query for section to move point to."
  654.   (interactive)
  655.   (aput 'sm-sections-alist
  656.     (let* ((default (aheadsym sm-sections-alist))
  657.            (completion-ignore-case t)
  658.            chosen
  659.            (prompt (concat "Go to section: (default " default ") ")))
  660.       (setq chosen (completing-read prompt sm-sections-alist))
  661.       (if (or (not chosen)
  662.           (string= chosen ""))
  663.           default
  664.         chosen)))
  665.   (sm-find-section (aheadsym sm-sections-alist)))
  666.  
  667. (defun sm-goto-see-also-section ()
  668.   "Move point the the \"SEE ALSO\" section.
  669. Actually the section moved to is described by sm-see-also-regexp."
  670.   (interactive)
  671.   (if (not (sm-find-section sm-see-also-regexp))
  672.       (error (concat "No " sm-see-also-regexp
  673.              " section found in current manpage."))))
  674.  
  675. (defun sm-follow-manual-reference (arg)
  676.   "Get one of the manpages referred to in the \"SEE ALSO\" section.
  677. Queries you for the page to retrieve. Of course it does this in the
  678. background. Universal argument ARG is passed to sm-getpage-in-background."
  679.   (interactive "P")
  680.   (if (not sm-refpages-alist)
  681.       (error (concat "No references found in current manpage."))
  682.     (aput 'sm-refpages-alist
  683.       (let* ((default (aheadsym sm-refpages-alist))
  684.          chosen
  685.          (prompt (concat "Refer to: (default " default ") ")))
  686.         (setq chosen (completing-read prompt sm-refpages-alist nil t))
  687.         (if (or (not chosen)
  688.             (string= chosen ""))
  689.         default
  690.           chosen)))
  691.     (sm-getpage-in-background
  692.      (sm-translate-references (aheadsym sm-refpages-alist))
  693.      (consp arg))))
  694.  
  695. (defun sm-quit ()
  696.   "Kill the buffer containing the manpage."
  697.   (interactive)
  698.   (let ((buff (current-buffer)))
  699.     (delete-windows-on buff)
  700.     (kill-buffer buff)))
  701.  
  702. (defun sm-goto-page (page)
  703.   "Go to the manual page on page PAGE."
  704.   (interactive
  705.    (if (not sm-page-list)
  706.        (error "You're looking at the only manpage in the buffer.")
  707.      (format "nGo to manpage [1-%d]: " (length sm-page-list))))
  708.   (if (or (< page 1)
  709.       (> page (length sm-page-list)))
  710.       (error "No manpage %d found" page))
  711.   (let* ((page-range (nth (1- page) sm-page-list))
  712.      (page-start (car page-range))
  713.      (page-end (cdr page-range)))
  714.     (setq sm-current-page page
  715.       sm-page-mode-string (sm-page-mode-string))
  716.     (widen)
  717.     (goto-char page-start)
  718.     (narrow-to-region page-start page-end)
  719.     (sm-build-section-alist)
  720.     (sm-build-references-alist)
  721.     (widen)
  722.     (narrow-to-region page-start page-end)
  723.     (goto-char (point-min))))
  724.  
  725.  
  726. (defun sm-next-manpage ()
  727.   "Find the next manpage entry in the buffer."
  728.   (interactive)
  729.   (if (= (length sm-page-list) 1)
  730.       (error "This is the only manpage in the buffer."))
  731.   (if (< sm-current-page (length sm-page-list))
  732.       (sm-goto-page (1+ sm-current-page))
  733.     (if sm-circular-pages-p
  734.     (sm-goto-page 1)
  735.       (error "You're looking at the last manpage in the buffer."))))
  736.  
  737. (defun sm-previous-manpage ()
  738.   "Find the previous manpage entry in the buffer."
  739.   (interactive)
  740.   (if (= (length sm-page-list) 1)
  741.       (error "This is the only manpage in the buffer."))
  742.   (if (> sm-current-page 1)
  743.       (sm-goto-page (1- sm-current-page))
  744.     (if sm-circular-pages-p
  745.     (sm-goto-page (length sm-page-list))
  746.       (error "You're looking at the first manpage in the buffer."))))
  747.  
  748. (defun sm-version (arg)
  749.   "Show superman's version.
  750. Universal argument (\\[universal-argument]) ARG inserts version
  751. information in the current buffer instead of printing the message in
  752. the echo area."
  753.   (interactive "P")
  754.   (if (consp arg)
  755.       (insert "Using Superman version " sm-version-number ".")
  756.     (message "Using Superman version %s." sm-version-number)))
  757.  
  758. ;; ======================================================================
  759. ;; overloading
  760.  
  761. (if (and sm-overload-p
  762.      (fboundp 'manual-entry))
  763.     (fset 'manual-entry (symbol-function 'sm-manual-entry)))
  764.