home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / epoch / tek-epoch-stuff / tek-man.el < prev    next >
Encoding:
Text File  |  1991-11-20  |  28.2 KB  |  862 lines
  1. ;*****************************************************************************
  2. ;
  3. ; Filename:    tek-man.el
  4. ;
  5. ; This file is not part of the GNU Emacs distribution (yet).
  6. ;
  7. ; Copyright (C) 1991 Free Software Foundation, Inc.
  8. ;
  9. ; GNU Emacs is free software; you can redistribute it and/or modify
  10. ; it under the terms of the GNU General Public License as published by
  11. ; the Free Software Foundation; either version 1, or (at your option)
  12. ; any later version.
  13.  
  14. ; GNU Emacs is distributed in the hope that it will be useful,
  15. ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ; GNU General Public License for more details.
  18.  
  19. ; You should have received a copy of the GNU General Public License
  20. ; along with GNU Emacs; see the file COPYING.  If not, write to
  21. ; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22. ;
  23. ; Author:        Originally based on code by Eric Rose
  24. ;            <erose@jessica.stanford.edu>, who started with the
  25. ;            standard distribution and modified it.
  26. ;
  27. ; This version by:    Ken Wood, <kwood@austek.oz.au>
  28. ; Organisation:        Austek Microsystems Pty Ltd, Australia.
  29. ;
  30. ; Description:    Enhanced manual browser. Invoke with "M-x man".
  31. ;
  32. ;    Numerous changes from the distribution version:
  33. ;
  34. ;    - runs "man" in background mode, so you can keep editing while your
  35. ;    man page is prepared.
  36. ;
  37. ;    - renames man page buffers using the manual topic, thus supports
  38. ;    multiple man pages open at once.
  39. ;
  40. ;    - man buffers have their own major mode with special keybindings.
  41. ;    Type ? in a man buffer for details.
  42. ;
  43. ;    - provides highlighting and mouse support under epoch. Type ? for a
  44. ;    list of the mouse bindings.
  45. ;
  46. ;    Still needs: support for "man -k".
  47. ;
  48. ;*****************************************************************************
  49.  
  50. ; $Id: tek-man.el,v 1.7 1991/11/21 02:56:07 kwood Exp $
  51.  
  52. (require 'epoch-running)
  53. (provide 'tek-man)
  54. (provide 'manual)
  55.  
  56. (defconst manual-delete-reformatting-message t
  57.   "*t says delete the \"Reformatting entry.  Wait...\" junk at the
  58. beginning of the manual-entry buffer.")
  59.  
  60. ; Manual Variables
  61.  
  62. (defvar manual-non-entry-regexp "[^A-Za-z0-9()_]"
  63.   "\
  64. Regexp matching characters that are not part of a manual entry names
  65. such as 'emacs(1)'.")
  66.  
  67. (defvar manual-entry-name-regexp "[a-zA-Z][a-zA-Z0-9._-]+\([0-9A-Z]+\)"
  68.   "\
  69. Regexp which matches manual entry names, such as 'emacs(1)'.")
  70.  
  71. (defvar manual-help-buffer-name "*Help*"
  72.   "Name of help buffer for manual-mode.")
  73.  
  74.  
  75. ; Put all the epoch stuff inside a test, in order to get it to compile under
  76. ; emacs.
  77. (if running-epoch
  78.     (progn
  79.  
  80.       (require 'tek-style-utils)
  81.       
  82.       ;
  83.       ; Following section sets up some attributes for highlighting.
  84.       ;
  85.       
  86.       (defvar tek-manual-seealso-foreground "purple"
  87.     "\
  88. Foreground color used to highlight the 'See Also' section of manual
  89. pages if no value is defined in the X11 resources and the display
  90. device supports color.")
  91.  
  92.       (defvar tek-manual-seealso-styleorattribute
  93.     ; If the display supports multiple colors and a default color
  94.     ; is specified, define the style to use a different color.
  95.     (if (and (> (number-of-colors) 2) tek-manual-seealso-foreground)
  96.         (tek-build-style "manual-seealso" nil nil
  97.                  tek-manual-seealso-foreground (background)
  98.                  (background) (foreground))
  99.       ; Otherwise, define the style to use a different font.
  100.       (tek-build-style "manual-seealso" nil (or tek-bold-fixed-font
  101.                             tek-italic-bold-fixed-font
  102.                             tek-italic-fixed-font)
  103.                (foreground) (background)
  104.                (background) (foreground)))
  105.     "\
  106. Style or attribute used to display characters in the See Also section
  107. of man pages.")
  108.       
  109.       (defvar tek-manual-usersupplied-foreground "red3"
  110.     "\
  111. Foreground color used to highlight the user-supplied sections of
  112. manual pages if no value is defined in the X11 resources and the
  113. display device supports color.")
  114.       
  115.       (defvar tek-manual-usersupplied-styleorattribute
  116.     ; If the display supports multiple colors and a default color
  117.     ; is specified, define the style to use a different color.
  118.     (if (and (> (number-of-colors) 2) tek-manual-seealso-foreground)
  119.         (if tek-italic-fixed-font
  120.         ; Define the style to use a non-bold italic font in a different
  121.         ; color.
  122.         (tek-build-style "manual-usersupplied" nil
  123.                  tek-italic-fixed-font
  124.                  tek-manual-usersupplied-foreground
  125.                  (background) (background) (foreground))
  126.           (tek-build-style "manual-usersupplied" nil nil
  127.                    tek-manual-usersupplied-foreground
  128.                    (background) (background) (foreground)
  129.                    tek-manual-usersupplied-foreground))
  130.       (if tek-italic-bold-fixed-font
  131.           (tek-build-style "manual-usersupplied" nil
  132.                    tek-italic-bold-fixed-font
  133.                    (foreground) (background)
  134.                    (background) (foreground))
  135.         (tek-build-style "manual-usersupplied" nil
  136.                  (or tek-bold-fixed-font
  137.                  tek-italic-fixed-font)
  138.                  (foreground) (background)
  139.                  (background) (foreground) (foreground))))
  140.       "\
  141. Style or attribute used to display characters in user supplied sections
  142. of man pages.")
  143.     
  144.       (defvar tek-manual-heading-styleorattribute
  145.       ; Define the style to use a different font.
  146.     (tek-build-style "manual-heading" nil (or tek-bold-fixed-font
  147.                           tek-italic-bold-fixed-font
  148.                           tek-italic-fixed-font)
  149.              (foreground) (background)
  150.              (background) (foreground))
  151.     "\
  152. Style or attribute used to display characters in heading sections
  153. of man pages.")
  154.  
  155.       
  156.       ; Select V3 or V4 button behaviour
  157.       (if tek-highlight-use-attributes
  158.       (progn
  159.         ; Do things the old way - using attributes.
  160.  
  161.         (defvar tek-manual-seealso-style
  162.           tek-manual-seealso-styleorattribute
  163.           "\
  164. Style used for displaying 'See Also' sections in man pages when attributes are
  165. used to mark buttons.")
  166.  
  167.         ; Modify the variable used with add-button to be an attribute
  168.         (setq tek-manual-seealso-styleorattribute (reserve-attribute))
  169.  
  170.         ; Bind the see also style to the see also attribute.
  171.         (set-attribute-style tek-manual-seealso-styleorattribute
  172.                  tek-manual-seealso-style)
  173.       
  174.         (defvar tek-manual-usersupplied-style
  175.           tek-manual-usersupplied-styleorattribute
  176.           "\
  177. Style used for displaying user-supplied sections in man pages when
  178. attributes are used to mark buttons.")
  179.  
  180.         ; Modify the variable used with add-button to be an attribute
  181.         (setq tek-manual-usersupplied-styleorattribute (reserve-attribute))
  182.       
  183.         ; Bind the user supplied style to the user supplied attribute.
  184.         (set-attribute-style tek-manual-usersupplied-styleorattribute
  185.                  tek-manual-usersupplied-style)
  186.       
  187.         (defvar tek-manual-heading-style
  188.           tek-manual-heading-styleorattribute
  189.           "\
  190. Style used for displaying heading sections in man pages when attributes are
  191. used to mark buttons.")
  192.  
  193.         ; Modify the variable used with add-button to be an attribute
  194.         (setq tek-manual-heading-styleorattribute (reserve-attribute))
  195.  
  196.         ; Bind the heading style to the heading attribute.
  197.         (set-attribute-style tek-manual-heading-styleorattribute
  198.                  tek-manual-heading-style)
  199.         ))
  200.       
  201.  
  202.       ; Function to highlight SEE ALSO entries.
  203.       (defun manual-highlight-seealso ()
  204.     "Highlight all 'SEE ALSO' entries of man pages under epoch"
  205.     (save-excursion
  206.       (goto-char (point-min))
  207.       (let ((case-fold-search nil)
  208.         (seealso-endpoint (point-max)))
  209.         ; Find each SEE ALSO section
  210.         (while (re-search-forward "^\\s-*SEE ALSO.*\n" nil t)
  211.           ; Assume the SEE ALSO section is terminated by one or more
  212.           ; blank lines - find the end of the section.
  213.           (save-excursion
  214.         (if (re-search-forward "\n\n" (point-max) t)
  215.             (setq seealso-endpoint (match-end 0))))
  216.           ; Find & highlight each entry in the SEE ALSO section.
  217.           (while (re-search-forward manual-entry-name-regexp
  218.                     seealso-endpoint t)
  219.         (add-button (match-beginning 0) (match-end 0)
  220.                 tek-manual-seealso-styleorattribute nil
  221.                 (current-buffer)))))))
  222.  
  223.  
  224.       ; Mouse map to be used in manual buffers.
  225.       (defvar manual-mouse-map (create-mouse-map mouse::global-map)
  226.     "Mousemap for manual buffers.")
  227.  
  228.       ; Bind the mouse buttons to useful functions.
  229.       
  230.       (define-mouse manual-mouse-map mouse-left mouse-down
  231.     'manual-mouse-scroll-up)
  232.       (define-mouse manual-mouse-map mouse-middle mouse-down
  233.     'manual-mouse-select-item)
  234.       (define-mouse manual-mouse-map mouse-right mouse-down
  235.     'manual-mouse-scroll-down)
  236.  
  237.       ; Functions for mouse bindings.
  238.       
  239.       (defun manual-mouse-select-item (mouse-data)
  240.     "Select the manual entry specified at the mouse cursor."
  241.     (let ((orig-window (selected-window)))
  242.       ;(select-window (nth 2 mouse-data))
  243.       (mouse::set-point mouse-data)
  244.       (manual-find-entry-at-point)
  245.       (select-window orig-window)))
  246.       
  247.       (defun manual-mouse-scroll-up (mouse-data)
  248.     (let ((orig-window (selected-window)))
  249.       (select-window (nth 2 mouse-data))
  250.       (scroll-up nil)
  251.       (select-window orig-window)))
  252.  
  253.       (defun manual-mouse-scroll-down (mouse-data)
  254.     (let ((orig-window (selected-window)))
  255.       (select-window (nth 2 mouse-data))
  256.       (scroll-down nil)
  257.       (select-window orig-window)))
  258.  
  259.  
  260.       )) ; end: running-epoch test
  261.  
  262.  
  263. ; Manual doco
  264.  
  265. (defun manual-mode-summary ()
  266.   "Display a brief summary of all manual mode commands"
  267.   (interactive)
  268.   (save-window-excursion
  269.     ; Jump into the help buffer and prepare it for display
  270.     (switch-to-buffer manual-help-buffer-name)
  271.     (erase-buffer)
  272.     (insert (documentation 'manual-mode))
  273.     (goto-char (point-min))
  274.     ; Now, wait until the user has scrolled to the end of the help screen
  275.     ; and then pressed space once more.
  276.     (let (ch flag)
  277.       (while (progn (setq flag (not (pos-visible-in-window-p (point-max))))
  278.             (message (if flag "Type Space to see more"
  279.                    "Type Space to return to manual"))
  280.             (if (/= ?\  (setq ch (read-char)))
  281.             (progn (setq unread-command-char ch) nil)
  282.               flag))
  283.     (scroll-up)))
  284.     ; Bury the buffer so the user is unlikely to see it outside of
  285.     ; manual mode.
  286.     (bury-buffer manual-help-buffer-name)))
  287.  
  288. ;
  289. ;  Manual keymap
  290. ;
  291. (defvar manual-mode-map (make-keymap)
  292.   "Keymap used in manual page buffers.")
  293.  
  294. (suppress-keymap manual-mode-map)
  295. (define-key manual-mode-map " " 'scroll-up)
  296. (define-key manual-mode-map "\177" 'scroll-down)
  297. (define-key manual-mode-map "n" 'manual-forward-line)
  298. (define-key manual-mode-map "p" 'manual-backward-line)
  299. (define-key manual-mode-map "\en" 'manual-next-section)
  300. (define-key manual-mode-map "\ep" 'manual-previous-section)
  301. (define-key manual-mode-map "\C-n" 'manual-forward-line)
  302. (define-key manual-mode-map "\C-p" 'manual-backward-line)
  303. (define-key manual-mode-map "m" 'man)
  304. (define-key manual-mode-map "a" 'manual-apropos)
  305. (define-key manual-mode-map "g" 'manual-find-entry-at-point)
  306. (define-key manual-mode-map "s" 'manual-see-also)
  307. (define-key manual-mode-map "\C-a" 'beginning-of-line)
  308. (define-key manual-mode-map "\C-e" 'end-of-line)
  309. (define-key manual-mode-map "\ea" 'backward-sentence)
  310. (define-key manual-mode-map "\ee" 'forward-sentence)
  311. (define-key manual-mode-map "\C-b" 'backward-char)
  312. (define-key manual-mode-map "\C-f" 'forward-char)
  313. (define-key manual-mode-map "b" 'manual-backward-word)
  314. (define-key manual-mode-map "f" 'manual-forward-word)
  315. (define-key manual-mode-map "\eb" 'backward-word)
  316. (define-key manual-mode-map "\ef" 'forward-word)
  317. (define-key manual-mode-map "<" 'beginning-of-buffer)
  318. (define-key manual-mode-map "." 'beginning-of-buffer)
  319. (define-key manual-mode-map ">" 'end-of-buffer)
  320. (define-key manual-mode-map "\e<" 'beginning-of-buffer)
  321. (define-key manual-mode-map "\e>" 'end-of-buffer)
  322. (define-key manual-mode-map "?" 'manual-mode-summary)
  323. (define-key manual-mode-map "t" 'toggle-truncate-lines)
  324. (define-key manual-mode-map "q" 'manual-quit)
  325.  
  326.  
  327. ; Stub for typing "man"
  328. (defun man (word)
  329.   (interactive "sTopic: ")
  330.   (manual-get-entry word))
  331.  
  332. ; Create an alias for the man function to maintain backward compatibility.
  333. (fset 'manual-entry (symbol-function 'man))
  334.  
  335.  
  336. ; Tries to find the man page for the entry near point.
  337. (defun manual-find-entry-at-point ()
  338.   (interactive)
  339.   (let ((lookup-entry (manual-find-entry-name)))
  340.     (if lookup-entry
  341.     (manual-get-entry lookup-entry))))
  342.  
  343. ; Find another manual entry, either from the text at point or by prompting
  344. ; the user
  345. (defun manual-find-new-entry ()
  346.   (interactive)
  347.   (let ((lookup-entry (manual-find-entry-name)))
  348.     (if lookup-entry
  349.     (manual-get-entry lookup-entry)
  350.       (call-interactively 'man))))
  351.  
  352.  
  353. ; Manual mode
  354. (defun manual-mode ()
  355.   "\
  356. Manual Mode is used to browse through manual pages.  Normal editing
  357. commands are turned off, and these can be used instead:
  358.  
  359. .    Move to the top of the current man page.
  360. SPC    Scroll down one page.
  361. DEL    Scroll up one page.
  362. n,C-n    Move down one line.
  363. p,C-p    Move up one line.
  364. M-n    Move to next section of the current page.
  365. M-p    Move to previous section of the current page.
  366. >    Move to end of man page.
  367. <    Move to beginning of man page.
  368. m    Prompt for and look up a manual entry. Format is TOPIC(SECTION)
  369.     or TOPIC.
  370. g       Gets the man page on the topic entered at the prompt.  Same format
  371.     as above: TOPIC(SECTION).
  372. s    Jump to the 'SEE ALSO' section.
  373. C-a    Beginning of line.
  374. C-e    End of line.
  375. M-a    Previous sentence.
  376. M-e    Next sentence.
  377. f,M-f    Move forward one word.
  378. b,M-b   Move backwards one word.
  379. t       Toggle the line truncation.
  380. mouse-left     scroll-up
  381. mouse-middle   man-select-button
  382. mouse-right    scroll-down
  383. ?    This help screen.
  384. q    Quit."
  385.   (interactive)
  386.   (setq major-mode 'manual-mode)
  387.   (setq mode-name "Manual")
  388.   (setq buffer-auto-save-file-name nil)
  389.   (setq truncate-lines t)
  390.   ; Use the appropriate local key & mouse bindings in this buffer.
  391.   (use-local-map manual-mode-map)
  392.   (if running-epoch
  393.       (use-local-mouse-map manual-mouse-map))
  394.   (message "Type ? for a list of commands"))
  395.  
  396.  
  397. ; Does the work
  398. (defun manual-get-entry (entry)
  399.   "Display the Unix manual entry for ENTRY.
  400. ENTRY is either the title of the entry, or has the form TITLE(SECTION)
  401. where SECTION is the desired section of the manual, as in `tty(4)'."
  402.   (string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*\\((.+)\\)?[ \t]*\\'" entry)
  403.   ; Calculate the section and topic from the arg.
  404.   (let* (
  405.      (manual-topic (if (match-beginning 1)
  406.                (substring entry
  407.                       (match-beginning 1) (match-end 1))))
  408.      (temp-match-string (if (match-beginning 2)
  409.                 (substring entry
  410.                        (match-beginning 2) (match-end 2))))
  411.      (manual-section (if temp-match-string
  412.                  (and (string-match "(\\(.+\\))"
  413.                         temp-match-string)
  414.                   (substring temp-match-string
  415.                          (match-beginning 1)
  416.                          (match-end 1)))))
  417.     )
  418.     ; First, must be sure we have a valid topic to look up.
  419.     (if (not manual-topic)
  420.     ; Do nothing
  421.     nil
  422.       (let* ((manual-buffer-name (concat "*Manual-" manual-topic "*"))
  423.          (manual-buffer (get-buffer manual-buffer-name)))
  424.     (if manual-buffer
  425.         ; Buffer for specified manual entry already exists - just
  426.         ; need to display it.
  427.         (display-buffer manual-buffer)
  428.       ; Otherwise, need to look it up
  429.       (progn
  430.         ; First, create the buffer
  431.         (setq manual-buffer (get-buffer-create manual-buffer-name))
  432.         ; Do all following edits in manual buffer
  433.         (set-buffer manual-buffer)
  434.         ; Turn off undo log.
  435.         (buffer-flush-undo manual-buffer)
  436.         ; Let the user know what we're up to
  437.         (message "Looking for formatted entry for %s%s..."
  438.              manual-topic
  439.              (if manual-section (concat "(" manual-section ")") ""))
  440.         ; Next section inserts the raw "man" output into the
  441.         ; buffer. First, look for an already formatted file.
  442.         (let ((dirlist manual-formatted-dirlist)
  443.           (currentdir nil)
  444.           (completions nil)
  445.           (case-fold-search nil)
  446.           (return-value nil)
  447.           formatted-name)
  448.           ; Try the dir-prefix to start with
  449.           (setq return-value
  450.             (and manual-section
  451.              ; First, with the section appended to the
  452.              ; formatted directory.
  453.              (or (file-exists-p
  454.                   (setq formatted-name
  455.                     (concat manual-formatted-dir-prefix
  456.                         (substring manual-section 0 1)
  457.                         "/" manual-topic "."
  458.                         manual-section)))
  459.                  ; Next, without the section appended
  460.                  (file-exists-p
  461.                   (setq formatted-name
  462.                     (concat manual-formatted-dir-prefix
  463.                         manual-section "/"
  464.                         manual-topic "."
  465.                         manual-section))))))
  466.           ; If that fails, then try looking through the formatted
  467.           ; dirlist for the file of interest.
  468.           (while (and (not return-value) dirlist)
  469.         (progn
  470.           ; Try the current formatted directory, with a good
  471.           ; guess at the formatted file name.
  472.           (setq currentdir (car dirlist))
  473.           (setq formatted-name
  474.             (concat currentdir "/" manual-topic "."
  475.                 (or manual-section
  476.                     (substring currentdir
  477.                            (1+ (or (string-match
  478.                             "\\.[^./]*$"
  479.                             currentdir)
  480.                                -2))))))
  481.           (setq return-value (file-exists-p formatted-name))
  482.           (setq dirlist (cdr dirlist))))
  483.           ; Otherwise, try looking for the completions in each
  484.           ; formatted directory.
  485.           (setq dirlist manual-formatted-dirlist)
  486.           (while (and (not return-value) dirlist)
  487.         (progn
  488.           (setq currentdir (car dirlist))
  489.           ; Set up an error handler for file-name-all-completions
  490.           (condition-case ()
  491.               (progn
  492.             ; Get the list of completions
  493.             (setq completions (file-name-all-completions
  494.                        (concat manual-topic "."
  495.                            (or manual-section ""))
  496.                        currentdir))
  497.             ; Loop through the completions until we find a file
  498.             ; that exists.
  499.             (while (and completions
  500.                     (setq formatted-name
  501.                       (concat currentdir "/"
  502.                           (car completions)))
  503.                     (not (setq return-value
  504.                            (file-exists-p
  505.                         formatted-name))))
  506.               (setq completions (cdr completions))))
  507.             ; Error handler quietly does nothing.
  508.             (file-error nil))
  509.           (setq dirlist (cdr dirlist))))
  510.           ; Now, check that we can read the formatted file. If not,
  511.           ; need to delete it and run man anyway.
  512.           (if (and return-value
  513.                (not (file-readable-p formatted-name)))
  514.           (progn
  515.             (delete-file formatted-name)
  516.             (setq return-value nil)))
  517.           ; If the formatted file exists and is readable, then insert it.
  518.           (if return-value
  519.           (progn
  520.             (manual-insert-file formatted-name)
  521.             (manual-clean-and-show-buffer manual-topic))
  522.         ; Else, invoke man
  523.         (let ((manual-process nil))
  524.           (message "No formatted entry, invoking man %s%s in background..."
  525.                (if manual-section
  526.                    (concat manual-section " ")
  527.                  "")
  528.                manual-topic)
  529.           (if manual-section
  530.               (setq manual-process
  531.                 (start-process (concat "manbg-" manual-topic
  532.                            manual-section)
  533.                        manual-buffer
  534.                        "sh" "-c"
  535.                        (format "%s - %s %s"
  536.                            manual-program
  537.                            manual-section
  538.                            manual-topic)))
  539.             (setq manual-process
  540.               (start-process (concat "manbg-" manual-topic)
  541.                      manual-buffer
  542.                      "sh" "-c"
  543.                      (format "%s - %s"
  544.                          manual-program
  545.                          manual-topic))))
  546.           ; Set up a sentinel to watch for "man" exiting.
  547.           (set-process-sentinel manual-process 'manual-sentinel)
  548.           ; Bury the buffer to try & prevent the user
  549.           ; stumbling across it.
  550.           (bury-buffer manual-buffer))
  551.         ))))))))
  552.  
  553.     
  554. (defun manual-sentinel (process msg)
  555.   "\
  556. Waits for the asynchronous man process to exit & cleans up the
  557. resulting output."
  558.   (let* ((manual-buffer (process-buffer process))
  559.      (manual-buffer-name  (buffer-name manual-buffer))
  560.      (delete-buff nil)
  561.      (err-mess nil)
  562.      (initial-match-data (match-data)))
  563.     (if (null manual-buffer)
  564.     ; man output buffer has been deleted - flag an error and set the
  565.     ; processes buffer to nil
  566.     (progn
  567.       (error "Manual output buffer deleted")
  568.       (set-process-buffer process nil))
  569.       (progn
  570.     (set-buffer manual-buffer)
  571.     (goto-char (point-min))
  572.     (cond
  573.      ; Check to see if the man page wasn't found.
  574.      ((or (looking-at "No \\(manual \\)*entry for")
  575.           (looking-at "[^\n]*: nothing appropriate$"))
  576.       ; Print an error message and delete the buffer.
  577.       (setq err-mess
  578.         (buffer-substring (point) (progn (end-of-line) (point))))
  579.       (setq delete-buff t))
  580.      ; Check to see if the process haven't exited yet, or exited with
  581.      ; a non-zero exit status.
  582.      ((not (and (eq (process-status process) 'exit)
  583.             (= (process-exit-status process) 0)))
  584.       ; Flag an error
  585.       (setq err-mess (format "%s: process %s" manual-buffer-name
  586.                  (manual-delete-trailing-newline msg)))
  587.       ; An insert some debug info into the buffer.
  588.       (goto-char (point-max))
  589.       (insert (format "\nprocess %s" msg)))
  590.      ; Otherwise, must have exited normally - just delete the reformatting
  591.      ; message if appropriate
  592.      (t (and manual-delete-reformatting-message
  593.          (looking-at "Reformatting ")
  594.          (delete-region (point)
  595.                 (progn (forward-line 1) (point))))))
  596.     ; Remove the buffer if appropriate
  597.     (if delete-buff
  598.         (kill-buffer manual-buffer)
  599.       ; Otherwise, clean it up & display it.
  600.       (let ((manual-topic nil))
  601.         (if (string-match "\\*Manual-\\(.+\\)\\*" manual-buffer-name)
  602.         (setq manual-topic
  603.               (substring manual-buffer-name
  604.                  (match-beginning 1) (match-end 1)))
  605.           (setq manual-topic ""))
  606.         (manual-clean-and-show-buffer manual-topic)))
  607.     ; Print any accumulated message
  608.     (if err-mess
  609.         (error err-mess)
  610.       (message ""))))
  611.     ; Restore any previous match data on exit.
  612.     (store-match-data initial-match-data)))
  613.        
  614.  
  615.  
  616. (defun manual-delete-trailing-newline (str)
  617.   (if (string= (substring str (1- (length str))) "\n")
  618.       (substring str 0 (1- (length str)))
  619.     str))
  620.  
  621.  
  622.  
  623. ; Hint: BS stands for more things than "back space"
  624. (defun manual-clean-and-show-buffer (manual-topic)
  625.   "\
  626. Works on the current buffer. First turns underlining & overstriking by
  627. means of backspace characters into something sensible: highlighting if
  628. we are running epoch, plain text otherwise.
  629.  
  630. Next, remove cruddy headers & whitespace.
  631.  
  632. Finally, set the buffer mode & display it."
  633.   (message "Cleaning manual entry for %s..." manual-topic)
  634.   (if buffer-read-only
  635.       (toggle-read-only))
  636.   (if running-epoch
  637.       ;
  638.       ; Do highlighting
  639.       ;
  640.       (progn
  641.     ;
  642.     ; First, change _ chars to be "underlined" - helps simplify
  643.     ; button placement algorithm later.
  644.     ;
  645.     (goto-char (point-min))
  646.     (replace-regexp "\\(_\b.\\)\\([_ -]\\)\\(_\b.\\)" "\\1_\b\\2\\3")
  647.     ;
  648.     ; First nuke overstriking by same character.
  649.     ;
  650.     (goto-char (point-min))
  651.     ; Find the start of a section of overstriking - ignore
  652.     ; underlined underscores for now.
  653.     (while (re-search-forward "\\([^_\n]\\)\\(\b\\1\\)+" nil t)
  654.       ; Kill backspace character & overstrike characters
  655.       (replace-match "\\1")
  656.       (let ((button-begin (1- (point)))
  657.         (button-end (point))
  658.         (bolded-char nil))
  659.         ; Search through the rest of the overstrike characters.
  660.         (while (and (= (char-after (1+ (point))) ?\b)
  661.             (= (char-after (point)) (char-after (+ 2 (point)))))
  662.           (progn
  663.         ; Record the character which is being overstruck
  664.         (setq bolded-char (char-after (point)))
  665.         ; Extend the button to include the new character
  666.         (forward-char 1)
  667.         (setq button-end (point))
  668.         ; Delete the first overstriking
  669.         (delete-char 2)
  670.         ; Delete all the later overstrikings by the same character
  671.         (while (= (char-after (point)) ?\b)
  672.           (delete-char 2))))
  673.         ; Add the button around the specified region
  674.         (add-button button-begin button-end
  675.             tek-manual-heading-styleorattribute nil)))
  676.     ;
  677.     ; Now, nuke underlining.
  678.     ;
  679.     (goto-char (point-min))
  680.     ; Find the start of a section of underlining
  681.     (while (search-forward "_\b" nil t)
  682.       (let ((button-begin nil)
  683.         (button-end nil))
  684.         ; Kill underlining characters
  685.         (delete-char -2)
  686.         ; Start a button around just this one character.
  687.         (setq button-begin (point))
  688.         (setq button-end (1+ button-begin))
  689.         ; Remove the rest of the backspaces in this section & extend the
  690.         ; button to just after the last one.
  691.         (while (and (= (char-after (1+ (point))) ?_)
  692.             (not (forward-char 3))
  693.             (= (preceding-char) ?\b))
  694.           (progn
  695.         (delete-char -2)
  696.         (setq button-end (1+ (point)))))
  697.         ; Insert the button
  698.         (add-button button-begin button-end
  699.             tek-manual-usersupplied-styleorattribute nil)))
  700.     ; Finally, highlight any SEE ALSO sections
  701.     (manual-highlight-seealso)
  702.     ))
  703.   ; Now, purge any overstruck characters. If we're running epoch,
  704.   ; most of them will already have been taken care of. Otherwise,
  705.   ; nuke the lot of them.
  706.   ;
  707.   ; Underlining first
  708.   (goto-char (point-min))
  709.   (replace-regexp "_\b\\(.\\)" "\\1")
  710.   ; Overstriking next
  711.   (goto-char (point-min))
  712.   (replace-regexp "\\(.\\)\\(\b\\1\\)+" "\\1")
  713.   ; General overstriking last
  714.   (replace-regexp ".\b\\(.\\)" "\\1")
  715.   ;
  716.   ; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)"
  717.   (goto-char (point-min))
  718.   (replace-regexp "^\\s-*\\([A-Za-z][-_A-Za-z0-9]*([0-9A-Z]+)\\).*\\1$" "")
  719.   ; Nuke headers: "MORE(1)"
  720.   (goto-char (point-min))
  721.   (replace-regexp "^\\s-*[A-Za-z][-_A-Za-z0-9]*([0-9A-Z]+)\\s-*$" "")
  722.   ; Nuke footers: "Printed 12/3/85    27 April 1981    1"
  723.   ;    Sun appear to be on drugz:
  724.   ;     "Sun Release 3.0B  Last change: 1 February 1985     1"
  725.   ;    HP are even worse!
  726.   ;     "     Hewlett-Packard   -1- (printed 12/31/99)"  FMHWA12ID!!
  727.   ;    System V (well WICATs anyway):
  728.   ;     "Page 1              (printed 7/24/85)"
  729.   ;    Who is administering PCP to these corporate bozos?
  730.   (goto-char (point-min))
  731.   (replace-regexp
  732.    (cond ((eq system-type 'hpux)
  733.       "^[ \t]*Hewlett-Packard\\(\\| Company\\)[ \t]*- [0-9]* -.*$")
  734.      ((eq system-type 'usg-unix-v)
  735.       "^ *Page [0-9]*.*(printed [0-9/]*)$")
  736.      (t
  737.       "^\\(Printed\\|Sun Release\\) [0-9].*[0-9]$"))
  738.    "")
  739.   ; Crunch blank lines
  740.   (goto-char (point-min))
  741.   (replace-regexp "\n\n\n+" "\n\n")
  742.   ; Kill first few blank lines in the buffer
  743.   (goto-char (point-min))
  744.   (if (re-search-forward "\\`\n+" nil t)
  745.       (replace-match ""))
  746.   ; Finally, make the buffer read only & unmodified.
  747.   (toggle-read-only)
  748.   (set-buffer-modified-p nil)
  749.   ; Set the buffer mode & key bindings
  750.   (manual-mode)
  751.   ; Show the buffer in some window
  752.   (display-buffer (current-buffer))
  753.   )
  754.  
  755.  
  756. (defun manual-insert-file (name)
  757.   ; Insert manual file (unpacked as necessary) into buffer
  758.   (if (equal (substring name -2) ".Z")
  759.       (call-process "zcat" nil t nil name)
  760.     (if (equal (substring name -2) ".z")
  761.     (call-process "pcat" nil t nil name)
  762.       (insert-file-contents name))))
  763.  
  764.  
  765. ; Added by erose
  766. ;
  767. (defun manual-forward-line (n)
  768.   (interactive "p")
  769.   (forward-line n))
  770.  
  771. (defun manual-backward-line (n)
  772.   (interactive "p")
  773.   (forward-line (- n)))
  774.  
  775. (defun manual-forward-word (n)
  776.   (interactive "p")
  777.   (forward-char 1)
  778.   (forward-word n)
  779.   (forward-char -1))
  780.  
  781. (defun manual-backward-word (n)
  782.   (interactive "p")
  783.   (backward-word n))
  784.  
  785. ;  Searches for next "Section"
  786. (defun manual-next-section ()
  787.   (interactive)
  788.   (beginning-of-line)
  789.   (forward-line)
  790.   (while (not (or (looking-at "[A-Z]")
  791.           (eobp)))
  792.     (forward-line 1)))
  793.  
  794. (defun manual-previous-section ()
  795.   (interactive)
  796.   (beginning-of-line)
  797.   (forward-line -1)
  798.   (while (not (or (looking-at "[A-Z]")
  799.           (bobp)))
  800.     (forward-line -1)))
  801.  
  802.  
  803. ; Finds a word near point that can be a manual reference.  Returns nil
  804. ; if it can't figure it out.
  805. (defun manual-find-entry-name ()
  806.   "\
  807. Returns the word near point that should correspond to a manual
  808. reference. The variable 'manual-non-entry-regexp' controls what is not
  809. part of a manual reference."
  810.   (let ((entry-beginning-bound nil)
  811.     (entry-end-bound nil)
  812.     (entry-beginning nil)
  813.     (entry-end nil))
  814.     (save-excursion
  815.       ; Now, do a bit of searching to see if there is really a manual entry
  816.       ; near point.
  817.       ; Don't really care if we are at the beginning or end of the buffer,
  818.       ; just let these points limit the search.
  819.       (if (and (if (re-search-forward manual-non-entry-regexp nil t)
  820.            (setq entry-end-bound (match-beginning 0))
  821.          (setq entry-end-bound (point-max)))
  822.            (or (backward-char 1) t)
  823.            (or (re-search-backward manual-non-entry-regexp nil t) t)
  824.            (re-search-forward manual-entry-name-regexp
  825.                   entry-end-bound t))
  826.       ; If we made it to here, then we have found a manual entry -
  827.       ; so return it.
  828.       (buffer-substring (match-beginning 0) (match-end 0))
  829.     ; Otherwise, no entry name here so return nil.
  830.     nil))))
  831.  
  832.  
  833. (defun manual-see-also ()
  834.   (interactive)
  835.   (let ((opoint (point))
  836.     (case-fold-search nil))
  837.     (goto-char (point-min))
  838.     (if (not (re-search-forward "^\\s-*SEE ALSO" nil t))
  839.     (progn
  840.       (goto-char opoint)
  841.       (message "No 'SEE ALSO' section on this manpage.")))))
  842.     
  843. (defun toggle-truncate-lines ()
  844.   (interactive)
  845.   (setq truncate-lines (not truncate-lines))
  846.   (recenter))
  847.  
  848. (defvar manual-keep-all-buffers nil
  849.   "If t keep the manual buffer even though the user has typed q")
  850.  
  851. (defun manual-quit ()
  852.   (interactive)
  853.   (if manual-keep-all-buffers
  854.       (bury-buffer (current-buffer))
  855.     (kill-buffer (current-buffer))))
  856.  
  857. (defun manual-apropos ()
  858.   "\
  859. Not yet implemented.
  860.  
  861. man -k %s | pr -h Apropos")
  862.