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