home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #1 / NN_1993_1.iso / spool / alt / lucidem / help / 855 < prev    next >
Encoding:
Text File  |  1993-01-07  |  29.7 KB  |  890 lines

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