|
0
|
1 ;;; man.el --- browse UNIX manual pages
|
|
74
|
2 ;; Keywords: help
|
|
0
|
3
|
|
181
|
4 ;; Copyright (C) 1985, 1993, 1994, 1996, 1997 Free Software Foundation, Inc.
|
|
74
|
5 ;;
|
|
0
|
6 ;; This file is part of XEmacs.
|
|
|
7
|
|
|
8 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
9 ;; under the terms of the GNU General Public License as published by
|
|
|
10 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
11 ;; any later version.
|
|
|
12
|
|
|
13 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
16 ;; General Public License for more details.
|
|
|
17
|
|
|
18 ;; You should have received a copy of the GNU General Public License
|
|
72
|
19 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
74
|
20 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
0
|
21
|
|
74
|
22 ;; This file defines "manual-entry", and the remaining definitions all
|
|
|
23 ;; begin with "Manual-". This makes the autocompletion on "M-x man" work.
|
|
100
|
24 ;;
|
|
|
25 ;; Eviscerated 26-Jun-96 by Jamie Zawinski <jwz@netscape.com>.
|
|
|
26 ;; All that stuff about looking at $MANPATH and building up lists of
|
|
|
27 ;; directories was bullshit. Now we just invoke "man" and format the
|
|
|
28 ;; output, end of story.
|
|
74
|
29 ;;
|
|
100
|
30 ;; [ older changelog entries removed, since they're all about code that
|
|
|
31 ;; I've deleted. ]
|
|
0
|
32
|
|
120
|
33 (defgroup man nil
|
|
189
|
34 "Browse Unix manual pages"
|
|
120
|
35 :group 'help)
|
|
70
|
36
|
|
120
|
37 (defcustom Manual-program "man" "\
|
|
|
38 *Name of the program to invoke in order to format the source man pages."
|
|
|
39 :type 'string
|
|
|
40 :group 'man)
|
|
|
41
|
|
|
42 (defcustom Manual-buffer-view-mode t "\
|
|
74
|
43 *Whether manual buffers should be placed in view-mode.
|
|
|
44 nil means leave the buffer in fundamental-mode in another window.
|
|
|
45 t means use `view-buffer' to display the man page in the current window.
|
|
120
|
46 Any other value means use `view-buffer-other-window'."
|
|
189
|
47 :type '(radio (const :tag "Fundamental-mode other window" nil)
|
|
|
48 (const :tag "View-mode current window" t)
|
|
|
49 (sexp :format "%t\n" :tag "View-mode other window" other))
|
|
120
|
50 :group 'man)
|
|
70
|
51
|
|
120
|
52 (defcustom Manual-mode-hook nil
|
|
|
53 "Function or functions run on entry to Manual-mode."
|
|
|
54 :type 'hook
|
|
|
55 :group 'man)
|
|
0
|
56
|
|
74
|
57 (defvar Manual-page-history nil "\
|
|
|
58 A list of names of previously visited man page buffers.")
|
|
70
|
59
|
|
173
|
60 (defvar Manual-page-minibuffer-history nil "\
|
|
|
61 Minibuffer completion history for `manual-entry'.")
|
|
70
|
62
|
|
74
|
63 ;; New variables.
|
|
70
|
64
|
|
144
|
65 (defcustom Manual-snip-subchapter
|
|
|
66 (not (string-match "solaris" system-configuration))
|
|
|
67 "*Should man look in chapter 3 for ctime(3c)?
|
|
|
68 This is relavent for Solaris and, perhaps, other systems which have
|
|
|
69 `man -s 3' not find things in chapter 3c, or other such sub-chapters"
|
|
|
70 :type 'boolean
|
|
|
71 :group 'man)
|
|
|
72
|
|
183
|
73 (defcustom Manual-buffers-have-stars nil
|
|
|
74 "*When T, manual page buffers are always named like *man*.
|
|
|
75 Otherwise, they are not if `buffers-menu-submenus-for-groups-p' is T,
|
|
|
76 so that Manual-mode buffers will have their own submenu."
|
|
|
77 :type 'boolean
|
|
|
78 :group 'man)
|
|
|
79
|
|
193
|
80 (defcustom Manual-buffers-have-prefix t
|
|
|
81 "*When non-nil, manual page buffers are named with a prefix of `man '.
|
|
|
82 Otherwise, their titles do not have this prefix."
|
|
|
83 :type 'boolean
|
|
|
84 :group 'man)
|
|
|
85
|
|
189
|
86 ;;Here is information on RosettaMan, from Neal.Becker@comsat.com (Neal Becker):
|
|
|
87
|
|
|
88 ;;RosettaMan is a filter for UNIX manual pages. It takes as input man
|
|
|
89 ;;pages formatted for a variety of UNIX flavors (not [tn]roff source)
|
|
|
90 ;;and produces as output a variety of file formats. Currently
|
|
|
91 ;;RosettaMan accepts man pages as formatted by the following flavors of
|
|
|
92 ;;UNIX: Hewlett-Packard HP-UX, AT&T System V, SunOS, Sun Solaris, OSF/1,
|
|
|
93 ;;DEC Ultrix, SGI IRIX, Linux, SCO; and produces output for the following
|
|
|
94 ;;formats: printable ASCII only (stripping page headers and footers),
|
|
|
95 ;;section and subsection headers only, TkMan, [tn]roff, Ensemble, RTF,
|
|
|
96 ;;SGML (soon--I finally found a DTD), HTML, MIME, LaTeX, LaTeX 2e, Perl 5's pod.
|
|
|
97
|
|
|
98 ;;RosettaMan improves on other man page filters in several ways: (1) its
|
|
|
99 ;;analysis recognizes the structural pieces of man pages, enabling high
|
|
|
100 ;;quality output, (2) its modular structure permits easy augmentation of
|
|
|
101 ;;output formats, (3) it accepts man pages formatted with the varient
|
|
|
102 ;;macros of many different flavors of UNIX, and (4) it doesn't require
|
|
|
103 ;;modification or cooperation with any other program.
|
|
|
104
|
|
|
105 ;;RosettaMan is a rewrite of TkMan's man page filter, called bs2tk. (If
|
|
|
106 ;;you haven't heard about TkMan, a hypertext man page browser, you
|
|
|
107 ;;should grab it via anonymous ftp from ftp.cs.berkeley.edu:
|
|
|
108 ;;/ucb/people/phelps/tkman.tar.Z.) Whereas bs2tk generated output only for
|
|
|
109 ;;TkMan, RosettaMan generalizes the process so that the analysis can be
|
|
|
110 ;;leveraged to new output formats. A single analysis engine recognizes
|
|
|
111 ;;section heads, subsection heads, body text, lists, references to other
|
|
|
112 ;;man pages, boldface, italics, bold italics, special characters (like
|
|
|
113 ;;bullets), tables (to a degree) and strips out page headers and
|
|
|
114 ;;footers. The engine sends signals to the selected output functions so
|
|
|
115 ;;that an enhancement in the engine improves the quality of output of
|
|
|
116 ;;all of them. Output format functions are easy to add, and thus far
|
|
|
117 ;;average about about 75 lines of C code each.
|
|
|
118
|
|
|
119
|
|
|
120
|
|
|
121 ;;*** NOTES ON CURRENT VERSION ***
|
|
|
122
|
|
|
123 ;;Help! I'm looking for people to help with the following projects.
|
|
|
124 ;;\(1) Better RTF output format. The current one works, but could be
|
|
|
125 ;;made better. (2) Roff macros that produce text that is easily
|
|
|
126 ;;parsable. RosettaMan handles a great variety, but some things, like
|
|
|
127 ;;H-P's tables, are intractable. If you write an output format or
|
|
|
128 ;;otherwise improve RosettaMan, please send in your code so that I may
|
|
|
129 ;;share the wealth in future releases.
|
|
|
130
|
|
|
131 ;;This version can try to identify tables (turn this on with the -T
|
|
|
132 ;;switch) by looking for lines with a large amount of interword spacing,
|
|
|
133 ;;reasoning that this is space between columns of a table. This
|
|
|
134 ;;heuristic doesn't always work and sometimes misidentifies ordinary
|
|
|
135 ;;text as tables. In general I think it is impossible to perfectly
|
|
|
136 ;;identify tables from nroff formatted text. However, I do think the
|
|
|
137 ;;heuristics can be tuned, so if you have a collection of manual pages
|
|
|
138 ;;with unrecognized tables, send me the lot, in formatted form (i.e.,
|
|
|
139 ;;after formatting with nroff -man), and uuencode them to preserve the
|
|
|
140 ;;control characters. Better, if you can think of heuristics that
|
|
|
141 ;;distinguish tables from ordinary text, I'd like to hear them.
|
|
|
142
|
|
|
143 ;;Notes for HTML consumers: This filter does real (heuristic)
|
|
|
144 ;;parsing--no <PRE>! Man page references are turned into hypertext links.
|
|
|
145
|
|
120
|
146 (defcustom Manual-use-rosetta-man (not (null (locate-file "rman" exec-path))) "\
|
|
76
|
147 If non-nil, use RosettaMan (rman) to filter man pages.
|
|
|
148 This makes man-page cleanup virtually instantaneous, instead of
|
|
189
|
149 potentially taking a long time."
|
|
120
|
150 :type 'boolean
|
|
|
151 :group 'man)
|
|
76
|
152
|
|
120
|
153 (defface man-italic '((t (:italic t)))
|
|
|
154 "Manual italics face"
|
|
|
155 :group 'man)
|
|
10
|
156
|
|
120
|
157 (defface man-bold '((t (:bold t)))
|
|
|
158 "Manual bold face"
|
|
|
159 :group 'man)
|
|
0
|
160
|
|
120
|
161 (defface man-heading '((t (:bold t)))
|
|
|
162 "Manual headings face"
|
|
|
163 :group 'man)
|
|
0
|
164
|
|
120
|
165 (defface man-xref '((t (:underline t)))
|
|
|
166 "Manual xrefs face"
|
|
|
167 :group 'man)
|
|
|
168
|
|
74
|
169
|
|
100
|
170 (defvar Manual-mode-map
|
|
|
171 (let ((m (make-sparse-keymap)))
|
|
|
172 (set-keymap-name m 'Manual-mode-map)
|
|
|
173 (define-key m "l" 'Manual-last-page)
|
|
|
174 (define-key m 'button2 'Manual-follow-xref)
|
|
|
175 (define-key m 'button3 'Manual-popup-menu)
|
|
|
176 m))
|
|
0
|
177
|
|
|
178 ;;;###autoload
|
|
74
|
179 (defun manual-entry (topic &optional arg silent)
|
|
100
|
180 "Display the Unix manual entry (or entries) for TOPIC."
|
|
74
|
181 (interactive
|
|
173
|
182 (list (let* ((fmh "-A-Za-z0-9_.:")
|
|
74
|
183 (default (save-excursion
|
|
|
184 (buffer-substring
|
|
|
185 (progn
|
|
|
186 (re-search-backward "\\sw" nil t)
|
|
|
187 (skip-chars-backward fmh) (point))
|
|
|
188 (progn (skip-chars-forward fmh) (point)))))
|
|
|
189 (thing (read-string
|
|
|
190 (if (equal default "") "Manual entry: "
|
|
173
|
191 (concat "Manual entry: (default " default ") "))
|
|
|
192 nil 'Manual-page-minibuffer-history)))
|
|
74
|
193 (if (equal thing "") default thing))
|
|
|
194 (prefix-numeric-value current-prefix-arg)))
|
|
|
195 (or arg (setq arg 1))
|
|
100
|
196 (let (section apropos-mode)
|
|
74
|
197 (let ((case-fold-search nil))
|
|
|
198 (if (and (null section)
|
|
100
|
199 (string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'"
|
|
|
200 topic))
|
|
181
|
201 (setq section (match-string 2 topic)
|
|
|
202 topic (match-string 1 topic))
|
|
74
|
203 (if (string-match "\\`[ \t]*-k[ \t]+\\([^ \t]+\\)\\'" topic)
|
|
|
204 (setq section "-k"
|
|
181
|
205 topic (match-string 1 topic)))))
|
|
100
|
206
|
|
144
|
207 (when Manual-snip-subchapter
|
|
|
208 ;; jwz: turn section "3x11" and "3n" into "3".
|
|
|
209 (if (and section (string-match "\\`\\([0-9]+\\)[^0-9]" section))
|
|
181
|
210 (setq section (match-string 1 section))))
|
|
|
211
|
|
74
|
212 (if (equal section "-k")
|
|
100
|
213 (setq apropos-mode t))
|
|
74
|
214
|
|
181
|
215 (let ((bufname (flet
|
|
|
216 ((maybe-star ()
|
|
183
|
217 (if (or Manual-buffers-have-stars
|
|
|
218 (not buffers-menu-submenus-for-groups-p))
|
|
|
219 "*"
|
|
|
220 "")))
|
|
181
|
221 (if apropos-mode
|
|
|
222 (concat (maybe-star) "man apropos " topic (maybe-star))
|
|
|
223 (concat (maybe-star)
|
|
193
|
224 (if Manual-buffers-have-prefix
|
|
|
225 "man ")
|
|
181
|
226 topic
|
|
|
227 (if section (concat "(" section ")") "")
|
|
|
228 (maybe-star)))))
|
|
100
|
229 (temp-buffer-show-function
|
|
|
230 (cond ((eq 't Manual-buffer-view-mode)
|
|
|
231 'view-buffer)
|
|
|
232 ((eq 'nil Manual-buffer-view-mode)
|
|
|
233 temp-buffer-show-function)
|
|
|
234 (t
|
|
|
235 'view-buffer-other-window))))
|
|
74
|
236
|
|
100
|
237 (cond ((get-buffer bufname)
|
|
|
238 ;; reselect an old man page buffer if it exists already.
|
|
|
239 (save-excursion
|
|
|
240 (set-buffer (get-buffer bufname))
|
|
|
241 (Manual-mode))
|
|
|
242 (if temp-buffer-show-function
|
|
|
243 (funcall temp-buffer-show-function (get-buffer bufname))
|
|
|
244 (display-buffer bufname)))
|
|
|
245 (t
|
|
|
246 (with-output-to-temp-buffer bufname
|
|
|
247 (buffer-disable-undo standard-output)
|
|
|
248 (save-excursion
|
|
|
249 (set-buffer standard-output)
|
|
|
250 (setq buffer-read-only nil)
|
|
|
251 (erase-buffer)
|
|
74
|
252
|
|
100
|
253 (let ((args (list topic))
|
|
|
254 args-string)
|
|
|
255 (if section
|
|
|
256 (setq args
|
|
|
257 (if (eq system-type 'usg-unix-v)
|
|
|
258 (cons "-s" (cons section args))
|
|
|
259 (cons section args))))
|
|
|
260 (setq args-string
|
|
|
261 (mapconcat 'identity (cons Manual-program args) " "))
|
|
|
262 (if (string-match "\\`\\([^ \t/]*/\\)+" args-string)
|
|
|
263 (setq args-string
|
|
|
264 (substring args-string (match-end 0))))
|
|
74
|
265
|
|
100
|
266 (message "%s (running...)" args-string)
|
|
149
|
267 (apply 'call-process Manual-program nil '(t nil) nil args)
|
|
70
|
268
|
|
100
|
269 (if (< (buffer-size) 200)
|
|
|
270 (progn
|
|
163
|
271 (kill-buffer (current-buffer))
|
|
|
272 (error "%s not found" args-string)))
|
|
74
|
273
|
|
100
|
274 (message "%s (cleaning...)" args-string)
|
|
|
275 (Manual-nuke-nroff-bs apropos-mode)
|
|
181
|
276 (message "%s (done.)" args-string))
|
|
100
|
277 (set-buffer-modified-p nil)
|
|
181
|
278 (Manual-mode)))))
|
|
183
|
279 (let ((page (if section
|
|
|
280 (concat topic "(" section ")")
|
|
|
281 topic)))
|
|
181
|
282 (setq Manual-page-history
|
|
|
283 (cons (buffer-name)
|
|
|
284 (delete (buffer-name) Manual-page-history))
|
|
|
285 Manual-page-minibuffer-history
|
|
|
286 (cons page (delete page Manual-page-minibuffer-history))))))
|
|
|
287
|
|
100
|
288 (message nil)
|
|
|
289 t)
|
|
74
|
290
|
|
|
291 (defun Manual-mode ()
|
|
|
292 (kill-all-local-variables)
|
|
|
293 (setq buffer-read-only t)
|
|
|
294 (use-local-map Manual-mode-map)
|
|
|
295 (setq major-mode 'Manual-mode
|
|
|
296 mode-name "Manual")
|
|
|
297 ;; man pages with long lines are buggy!
|
|
|
298 ;; This looks slightly better if they only
|
|
|
299 ;; overran by a couple of chars.
|
|
|
300 (setq truncate-lines t)
|
|
|
301 ;; turn off horizontal scrollbars in this buffer
|
|
104
|
302 (when (featurep 'scrollbar)
|
|
|
303 (set-specifier scrollbar-height (cons (current-buffer) 0)))
|
|
181
|
304 (make-local-hook 'kill-buffer-hook)
|
|
|
305 (add-hook 'kill-buffer-hook #'(lambda ()
|
|
|
306 (setq Manual-page-history
|
|
|
307 (delete (buffer-name)
|
|
|
308 Manual-page-history)))
|
|
|
309 nil t)
|
|
74
|
310 (run-hooks 'Manual-mode-hook))
|
|
|
311
|
|
|
312 (defun Manual-last-page ()
|
|
|
313 (interactive)
|
|
181
|
314 (if Manual-page-history
|
|
|
315 (let ((page (pop Manual-page-history)))
|
|
|
316 (if page
|
|
|
317 (progn
|
|
|
318 (get-buffer page)
|
|
|
319 (cons Manual-page-history page)
|
|
|
320 (switch-to-buffer page))))
|
|
|
321 (error "No manual page buffers found. Use `M-x manual-entry'")))
|
|
74
|
322
|
|
|
323
|
|
|
324 (defmacro Manual-delete-char (n)
|
|
|
325 ;; in v19, delete-char is compiled as a function call, but delete-region
|
|
|
326 ;; is byte-coded, so it's much faster. (We were spending 40% of our time
|
|
|
327 ;; in delete-char alone.)
|
|
|
328 (list 'delete-region '(point) (list '+ '(point) n)))
|
|
|
329
|
|
|
330 ;; Hint: BS stands form more things than "back space"
|
|
|
331 (defun Manual-nuke-nroff-bs (&optional apropos-mode)
|
|
|
332 (interactive "*")
|
|
76
|
333 (if Manual-use-rosetta-man
|
|
|
334 (call-process-region (point-min) (point-max) "rman" t t nil)
|
|
|
335 ;;
|
|
|
336 ;; turn underlining into italics
|
|
|
337 ;;
|
|
|
338 (goto-char (point-min))
|
|
|
339 (while (search-forward "_\b" nil t)
|
|
100
|
340 ;; searching for underscore-backspace and then comparing the
|
|
|
341 ;; following chars until the sequence ends turns out to be much
|
|
|
342 ;; faster than searching for a regexp which matches the whole
|
|
|
343 ;; sequence.
|
|
76
|
344 (let ((s (match-beginning 0)))
|
|
|
345 (goto-char s)
|
|
|
346 (while (and (= (following-char) ?_)
|
|
|
347 (= (char-after (1+ (point))) ?\b))
|
|
|
348 (Manual-delete-char 2)
|
|
|
349 (forward-char 1))
|
|
|
350 (set-extent-face (make-extent s (point)) 'man-italic)))
|
|
|
351 ;;
|
|
|
352 ;; turn overstriking into bold
|
|
|
353 ;;
|
|
|
354 (goto-char (point-min))
|
|
|
355 (while (re-search-forward "\\([^\n]\\)\\(\b\\1\\)" nil t)
|
|
|
356 ;; Surprisingly, searching for the above regexp is faster than searching
|
|
|
357 ;; for a backspace and then comparing the preceding and following chars,
|
|
|
358 ;; I presume because there are many false matches, meaning more funcalls
|
|
|
359 ;; to re-search-forward.
|
|
|
360 (let ((s (match-beginning 0)))
|
|
|
361 (goto-char s)
|
|
|
362 ;; Some systems (SGI) overstrike multiple times, eg, "M\bM\bM\bM".
|
|
|
363 (while (looking-at "\\([^\n]\\)\\(\b\\1\\)+")
|
|
|
364 (delete-region (+ (point) 1) (match-end 0))
|
|
|
365 (forward-char 1))
|
|
|
366 (set-extent-face (make-extent s (point)) 'man-bold)))
|
|
|
367 ;;
|
|
|
368 ;; hack bullets: o^H+ --> +
|
|
|
369 (goto-char (point-min))
|
|
|
370 (while (search-forward "\b" nil t)
|
|
|
371 (Manual-delete-char -2))
|
|
70
|
372
|
|
76
|
373 (if (> (buffer-size) 100) ; minor kludge
|
|
|
374 (Manual-nuke-nroff-bs-footers))
|
|
|
375 ) ;; not Manual-use-rosetta-man
|
|
74
|
376 ;;
|
|
|
377 ;; turn subsection header lines into bold
|
|
|
378 ;;
|
|
|
379 (goto-char (point-min))
|
|
|
380 (if apropos-mode
|
|
|
381 (while (re-search-forward "[a-zA-Z0-9] ([0-9]" nil t)
|
|
|
382 (forward-char -2)
|
|
|
383 (delete-backward-char 1))
|
|
70
|
384
|
|
74
|
385 ;; (while (re-search-forward "^[^ \t\n]" nil t)
|
|
|
386 ;; (set-extent-face (make-extent (match-beginning 0)
|
|
|
387 ;; (progn (end-of-line) (point)))
|
|
|
388 ;; 'man-heading))
|
|
72
|
389
|
|
74
|
390 ;; boldface the first line
|
|
|
391 (if (looking-at "[^ \t\n].*$")
|
|
|
392 (set-extent-face (make-extent (match-beginning 0) (match-end 0))
|
|
|
393 'man-bold))
|
|
70
|
394
|
|
74
|
395 ;; boldface subsequent title lines
|
|
|
396 ;; Regexp to match section headers changed to match a non-indented
|
|
|
397 ;; line preceded by a blank line and followed by an indented line.
|
|
|
398 ;; This seems to work ok for manual pages but gives better results
|
|
|
399 ;; with other nroff'd files
|
|
|
400 (while (re-search-forward "\n\n\\([^ \t\n].*\\)\n[ \t]+[^ \t\n]" nil t)
|
|
|
401 (goto-char (match-end 1))
|
|
|
402 (set-extent-face (make-extent (match-beginning 1) (match-end 1))
|
|
|
403 'man-heading)
|
|
|
404 (forward-line 1))
|
|
|
405 )
|
|
70
|
406
|
|
76
|
407 (if Manual-use-rosetta-man
|
|
|
408 nil
|
|
|
409 ;; Zap ESC7, ESC8, and ESC9
|
|
|
410 ;; This is for Sun man pages like "man 1 csh"
|
|
|
411 (goto-char (point-min))
|
|
|
412 (while (re-search-forward "\e[789]" nil t)
|
|
|
413 (replace-match "")))
|
|
100
|
414
|
|
74
|
415 ;; Nuke blanks lines at start.
|
|
|
416 ;; (goto-char (point-min))
|
|
|
417 ;; (skip-chars-forward "\n")
|
|
|
418 ;; (delete-region (point-min) (point))
|
|
|
419
|
|
|
420 (Manual-mouseify-xrefs)
|
|
|
421 )
|
|
|
422
|
|
|
423 (fset 'nuke-nroff-bs 'Manual-nuke-nroff-bs) ; use old name
|
|
|
424
|
|
70
|
425
|
|
74
|
426 (defun Manual-nuke-nroff-bs-footers ()
|
|
181
|
427 "For info see comments in packages/man.el"
|
|
74
|
428 ;; Nuke headers and footers.
|
|
|
429 ;;
|
|
|
430 ;; nroff assumes pages are 66 lines high. We assume that, and that the
|
|
|
431 ;; first and last line on each page is expendible. There is no way to
|
|
|
432 ;; tell the difference between a page break in the middle of a paragraph
|
|
|
433 ;; and a page break between paragraphs (the amount of extra whitespace
|
|
|
434 ;; that nroff inserts is the same in both cases) so this might strip out
|
|
|
435 ;; a blank line were one should remain. I think that's better than
|
|
|
436 ;; leaving in a blank line where there shouldn't be one. (Need I say
|
|
|
437 ;; it: FMH.)
|
|
|
438 ;;
|
|
|
439 ;; Note that if nroff spits out error messages, pages will be more than
|
|
|
440 ;; 66 lines high, and we'll lose badly. That's ok because standard
|
|
|
441 ;; nroff doesn't do any diagnostics, and the "gnroff" wrapper for groff
|
|
|
442 ;; turns off error messages for compatibility. (At least, it's supposed
|
|
|
443 ;; to.)
|
|
|
444 ;;
|
|
|
445 (goto-char (point-min))
|
|
|
446 ;; first lose the status output
|
|
|
447 (let ((case-fold-search t))
|
|
|
448 (if (and (not (looking-at "[^\n]*warning"))
|
|
|
449 (looking-at "Reformatting.*\n"))
|
|
|
450 (delete-region (match-beginning 0) (match-end 0))))
|
|
72
|
451
|
|
74
|
452 ;; kludge around a groff bug where it won't keep quiet about some
|
|
|
453 ;; warnings even with -Wall or -Ww.
|
|
|
454 (cond ((looking-at "grotty:")
|
|
|
455 (while (looking-at "grotty:")
|
|
|
456 (delete-region (point) (progn (forward-line 1) (point))))
|
|
|
457 (if (looking-at " *done\n")
|
|
|
458 (delete-region (point) (match-end 0)))))
|
|
70
|
459
|
|
74
|
460 (let ((pages '())
|
|
|
461 p)
|
|
|
462 ;; collect the page boundary markers before we start deleting, to make
|
|
|
463 ;; it easier to strip things out without changing the page sizes.
|
|
|
464 (while (not (eobp))
|
|
|
465 (forward-line 66)
|
|
|
466 (setq pages (cons (point-marker) pages)))
|
|
|
467 (setq pages (nreverse pages))
|
|
|
468 (while pages
|
|
|
469 (goto-char (car pages))
|
|
|
470 (set-marker (car pages) nil)
|
|
|
471 ;;
|
|
|
472 ;; The lines are: 3 blank; footer; 6 blank; header; 3 blank.
|
|
|
473 ;; We're in between the previous footer and the following header,
|
|
|
474 ;;
|
|
|
475 ;; First lose 3 blank lines, the header, and then 3 more.
|
|
|
476 ;;
|
|
|
477 (setq p (point))
|
|
|
478 (skip-chars-forward "\n")
|
|
|
479 (delete-region p (point))
|
|
|
480 (and (looking-at "[^\n]+\n\n?\n?\n?")
|
|
|
481 (delete-region (match-beginning 0) (match-end 0)))
|
|
|
482 ;;
|
|
|
483 ;; Next lose the footer, and the 3 blank lines after, and before it.
|
|
|
484 ;; But don't lose the last footer of the manual entry; that contains
|
|
|
485 ;; the "last change" date, so it's not completely uninteresting.
|
|
|
486 ;; (Actually lose all blank lines before it; sh(1) needs this.)
|
|
|
487 ;;
|
|
|
488 (skip-chars-backward "\n")
|
|
|
489 (beginning-of-line)
|
|
|
490 (if (null (cdr pages))
|
|
|
491 nil
|
|
|
492 (and (looking-at "[^\n]+\n\n?\n?\n?")
|
|
|
493 (delete-region (match-beginning 0) (match-end 0))))
|
|
|
494 (setq p (point))
|
|
|
495 (skip-chars-backward "\n")
|
|
|
496 (if (> (- p (point)) 4)
|
|
|
497 (delete-region (+ 2 (point)) p)
|
|
|
498 (delete-region (1+ (point)) p))
|
|
|
499 ; (and (looking-at "\n\n?\n?")
|
|
|
500 ; (delete-region (match-beginning 0) (match-end 0)))
|
|
72
|
501
|
|
74
|
502 (setq pages (cdr pages)))
|
|
|
503 ;;
|
|
|
504 ;; Now nuke the extra blank lines at the beginning and end.
|
|
72
|
505 (goto-char (point-min))
|
|
74
|
506 (if (looking-at "\n+")
|
|
|
507 (delete-region (match-beginning 0) (match-end 0)))
|
|
|
508 (forward-line 1)
|
|
|
509 (if (looking-at "\n\n+")
|
|
|
510 (delete-region (1+ (match-beginning 0)) (match-end 0)))
|
|
|
511 (goto-char (point-max))
|
|
|
512 (skip-chars-backward "\n")
|
|
|
513 (delete-region (point) (point-max))
|
|
|
514 (beginning-of-line)
|
|
|
515 (forward-char -1)
|
|
|
516 (setq p (point))
|
|
|
517 (skip-chars-backward "\n")
|
|
|
518 (if (= ?\n (following-char)) (forward-char 1))
|
|
|
519 (if (> (point) (1+ p))
|
|
|
520 (delete-region (point) p))
|
|
72
|
521 ))
|
|
|
522
|
|
74
|
523 (defun Manual-mouseify-xrefs ()
|
|
|
524 (goto-char (point-min))
|
|
183
|
525 ;; skip the top line of manual pages, but not apropos listings.
|
|
|
526 (unless apropos-mode (forward-line 1))
|
|
74
|
527 (let ((case-fold-search nil)
|
|
181
|
528 s e name splitp extent)
|
|
74
|
529 ;; possibly it would be faster to rewrite this expression to search for
|
|
|
530 ;; a less common sequence first (like "([0-9]") and then back up to see
|
|
|
531 ;; if it's really a match. This function is 15% of the total time, 13%
|
|
|
532 ;; of which is this call to re-search-forward.
|
|
173
|
533 (while (re-search-forward "[a-zA-Z_][-a-zA-Z0-9_.:]*([0-9][a-zA-Z0-9]*)"
|
|
74
|
534 nil t)
|
|
|
535 (setq s (match-beginning 0)
|
|
|
536 e (match-end 0)
|
|
181
|
537 name (buffer-substring s e)
|
|
|
538 splitp nil)
|
|
|
539
|
|
74
|
540 (goto-char s)
|
|
181
|
541 ;; if this is a hyphenated xref, we're on the second line, 1st char now.
|
|
|
542 (when (progn
|
|
|
543 (beginning-of-line)
|
|
|
544 (and (looking-at (concat "^[ \t]+" (regexp-quote name)))
|
|
|
545 (progn
|
|
|
546 (backward-char 1)
|
|
|
547 (or (equal (char-before) ?-)
|
|
|
548 (equal (char-before) ?\255)))
|
|
|
549 (setq s (progn
|
|
|
550 (skip-chars-backward "-\255_a-zA-Z0-9")
|
|
|
551 (point))
|
|
|
552 name (buffer-substring s e))))
|
|
|
553 (setq splitp t)
|
|
|
554 ;; delete the spaces and dash from `name'
|
|
|
555 (let (i)
|
|
|
556 (while (setq i (string-match "[-\255 \n\t]+" name i))
|
|
|
557 (setq name (concat (substring name 0 i)
|
|
|
558 (substring name (match-end 0)))
|
|
|
559 i (1+ i)))))
|
|
|
560
|
|
74
|
561 ;; if there are upper case letters in the section, downcase them.
|
|
|
562 (if (string-match "(.*[A-Z]+.*)$" name)
|
|
|
563 (setq name (concat (substring name 0 (match-beginning 0))
|
|
|
564 (downcase (substring name (match-beginning 0))))))
|
|
181
|
565
|
|
|
566 ;; if the xref was hyphenated, don't highlight the indention spaces.
|
|
|
567 (if splitp
|
|
|
568 (progn
|
|
|
569 (setq extent (make-extent s (progn (goto-char s) (end-of-line) (point))))
|
|
|
570 (set-extent-property extent 'man (list 'Manual-follow-xref name))
|
|
|
571 (set-extent-property extent 'highlight t)
|
|
|
572 (set-extent-face extent 'man-xref)
|
|
|
573 (goto-char e)
|
|
|
574 (skip-chars-backward "-_a-zA-Z0-9()")
|
|
|
575 (setq extent (make-extent (point) e)))
|
|
|
576 (setq extent (make-extent s e)))
|
|
74
|
577 (set-extent-property extent 'man (list 'Manual-follow-xref name))
|
|
|
578 (set-extent-property extent 'highlight t)
|
|
|
579 (set-extent-face extent 'man-xref)
|
|
|
580 (goto-char e))))
|
|
72
|
581
|
|
74
|
582 (defun Manual-follow-xref (&optional name-or-event)
|
|
|
583 "Invoke `manual-entry' on the cross-reference under the mouse.
|
|
|
584 When invoked noninteractively, the arg may be an xref string to parse instead."
|
|
|
585 (interactive "e")
|
|
|
586 (if (eventp name-or-event)
|
|
|
587 (let* ((p (event-point name-or-event))
|
|
|
588 (extent (and p (extent-at p
|
|
|
589 (event-buffer name-or-event)
|
|
|
590 'highlight)))
|
|
|
591 (data (and extent (extent-property extent 'man))))
|
|
|
592 (if (eq (car-safe data) 'Manual-follow-xref)
|
|
|
593 (eval data)
|
|
|
594 (error "no manual cross-reference there.")))
|
|
100
|
595 (or (manual-entry name-or-event)
|
|
|
596 ;; If that didn't work, maybe it's in a different section than the
|
|
|
597 ;; man page writer expected. For example, man pages tend assume
|
|
|
598 ;; that all user programs are in section 1, but X tends to generate
|
|
|
599 ;; makefiles that put things in section "n" instead...
|
|
|
600 (and (string-match "[ \t]*([^)]+)\\'" name-or-event)
|
|
|
601 (progn
|
|
|
602 (message "No entries found for %s; checking other sections..."
|
|
|
603 name-or-event)
|
|
|
604 (manual-entry
|
|
|
605 (substring name-or-event 0 (match-beginning 0))
|
|
|
606 nil t))))))
|
|
72
|
607
|
|
74
|
608 (defun Manual-popup-menu (&optional event)
|
|
|
609 "Pops up a menu of cross-references in this manual page.
|
|
|
610 If there is a cross-reference under the mouse button which invoked this
|
|
|
611 command, it will be the first item on the menu. Otherwise, they are
|
|
|
612 on the menu in the order in which they appear in the buffer."
|
|
|
613 (interactive "e")
|
|
|
614 (let ((buffer (current-buffer))
|
|
|
615 (sep "---")
|
|
|
616 xref items)
|
|
|
617 (cond (event
|
|
|
618 (setq buffer (event-buffer event))
|
|
|
619 (let* ((p (event-point event))
|
|
|
620 (extent (and p (extent-at p buffer 'highlight)))
|
|
|
621 (data (and extent (extent-property extent 'man))))
|
|
|
622 (if (eq (car-safe data) 'Manual-follow-xref)
|
|
|
623 (setq xref (nth 1 data))))))
|
|
|
624 (if xref (setq items (list sep xref)))
|
|
|
625 (map-extents #'(lambda (extent ignore)
|
|
|
626 (let ((data (extent-property extent 'man)))
|
|
|
627 (if (and (eq (car-safe data) 'Manual-follow-xref)
|
|
|
628 (not (member (nth 1 data) items)))
|
|
|
629 (setq items (cons (nth 1 data) items)))
|
|
|
630 nil))
|
|
|
631 buffer)
|
|
|
632 (if (eq sep (car items)) (setq items (cdr items)))
|
|
181
|
633 (let ((popup-menu-titles t))
|
|
|
634 (and (null items) (setq popup-menu-titles nil))
|
|
74
|
635 (popup-menu
|
|
|
636 (cons "Manual Entry"
|
|
|
637 (mapcar #'(lambda (item)
|
|
|
638 (if (eq item sep)
|
|
|
639 item
|
|
181
|
640 (vector item
|
|
74
|
641 (list 'Manual-follow-xref item) t)))
|
|
|
642 (nreverse items)))))))
|
|
70
|
643
|
|
74
|
644 (defun pager-cleanup-hook ()
|
|
|
645 "cleanup man page if called via $PAGER"
|
|
|
646 (let ((buf-name (or buffer-file-name (buffer-name))))
|
|
100
|
647 (if (or (string-match "^/tmp/man[0-9]+" buf-name)
|
|
|
648 (string-match ".*/man/\\(man\\|cat\\)[1-9a-z]/" buf-name))
|
|
74
|
649 (let (buffer manpage)
|
|
|
650 (require 'man)
|
|
|
651 (goto-char (point-min))
|
|
|
652 (setq buffer-read-only nil)
|
|
|
653 (Manual-nuke-nroff-bs)
|
|
|
654 (goto-char (point-min))
|
|
|
655 (if (re-search-forward "[^ \t]")
|
|
|
656 (goto-char (- (point) 1)))
|
|
|
657 (if (looking-at "\\([a-zA-Z0-9]+\\)[ \t]*(")
|
|
100
|
658 (setq manpage (buffer-substring (match-beginning 1)
|
|
|
659 (match-end 1)))
|
|
74
|
660 (setq manpage "???"))
|
|
181
|
661 (flet
|
|
|
662 ((maybe-star ()
|
|
183
|
663 (if (or Manual-buffers-have-stars
|
|
|
664 (not buffers-menu-submenus-for-groups-p))
|
|
|
665 "*"
|
|
|
666 "")))
|
|
181
|
667 (setq buffer
|
|
|
668 (rename-buffer
|
|
|
669 (generate-new-buffer-name (concat (maybe-star)
|
|
|
670 manpage
|
|
|
671 (maybe-star))))))
|
|
74
|
672 (setq buffer-file-name nil)
|
|
|
673 (goto-char (point-min))
|
|
|
674 (insert (format "%s\n" buf-name))
|
|
|
675 (goto-char (point-min))
|
|
|
676 (buffer-disable-undo buffer)
|
|
|
677 (set-buffer-modified-p nil)
|
|
|
678 (Manual-mode)
|
|
|
679 ))))
|
|
4
|
680
|
|
74
|
681 (add-hook 'server-visit-hook 'pager-cleanup-hook)
|
|
72
|
682 (provide 'man)
|
