|
0
|
1 ;;; man.el --- browse UNIX manual pages
|
|
74
|
2 ;; Keywords: help
|
|
0
|
3
|
|
74
|
4 ;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc.
|
|
|
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 ;; Mostly rewritten by Alan K. Stebbens <aks@hub.ucsb.edu> 11-apr-90.
|
|
|
23 ;;
|
|
|
24 ;; o Match multiple man pages using TOPIC as a simple pattern
|
|
|
25 ;; o Search unformatted pages, even when formatted matches are found
|
|
|
26 ;; o Query the user as to which pages are desired
|
|
|
27 ;; o Use of the prefix arg to toggle/bypass the above features
|
|
|
28 ;; o Buffers named by the first topic in the buffer
|
|
|
29 ;; o Automatic uncompress for compressed man pages (.Z, .z, and .gz)
|
|
|
30 ;; o View the resulting buffer using M-x view mode
|
|
|
31 ;;
|
|
|
32 ;; Modified 16-mar-91 by Jamie Zawinski <jwz@lucid.com> to default the
|
|
|
33 ;; manual topic to the symbol at point, just like find-tag does.
|
|
|
34 ;;
|
|
|
35 ;; Modified 22-mar-93 by jwz to use multiple fonts and follow xrefs with mouse.
|
|
|
36 ;;
|
|
|
37 ;; Modified 16-apr-93 by Dave Gillespie <daveg@synaptics.com> to make
|
|
|
38 ;; apropos work nicely; work correctly when bold or italic is unavailable;
|
|
|
39 ;; reuse old buffer if topic is re-selected (in Manual-topic-buffer mode).
|
|
|
40 ;;
|
|
|
41 ;; Modified 4-apr-94 by jwz: merged in Tibor Polgar's code for manpath.conf.
|
|
|
42 ;;
|
|
|
43 ;; Modified 19-apr-94 by Tibor Polgar <tlp00@spg.amdahl.com> to add support for
|
|
|
44 ;; $PAGER variable to be emacsclient and properly process man pages (assuming
|
|
|
45 ;; the man pages were built by man in /tmp. also fixed bug with man list being
|
|
|
46 ;; backwards.
|
|
|
47 ;;
|
|
|
48 ;; Modified 23-aug-94 by Tibor Polgar <tlp00@spg.amdahl.com> to add support for
|
|
|
49 ;; displaying only one instance of a man page (Manual-unique-man-sections-only)
|
|
|
50 ;; Fixed some more man page ordering bugs, bug with Manual-query-multiple-pages.
|
|
|
51 ;;
|
|
|
52 ;; Modified 29-nov-94 by Ben Wing <wing@spg.amdahl.com>: small fixes
|
|
|
53 ;; that should hopefully make things work under HPUX and IRIX.;
|
|
|
54 ;;
|
|
|
55 ;; Modified 15-jul-95 by Dale Atems <atems@physics.wayne.edu>:
|
|
|
56 ;; some extensive rewriting to make things work right (more or less)
|
|
|
57 ;; under IRIX.
|
|
|
58 ;;
|
|
|
59 ;; This file defines "manual-entry", and the remaining definitions all
|
|
|
60 ;; begin with "Manual-". This makes the autocompletion on "M-x man" work.
|
|
|
61 ;;
|
|
|
62 ;; Variables of interest:
|
|
|
63 ;;
|
|
|
64 ;; Manual-program
|
|
|
65 ;; Manual-topic-buffer
|
|
|
66 ;; Manual-buffer-view-mode
|
|
|
67 ;; Manual-directory-list
|
|
|
68 ;; Manual-formatted-directory-list
|
|
|
69 ;; Manual-match-topic-exactly
|
|
|
70 ;; Manual-query-multiple-pages
|
|
|
71 ;; Manual-page-history
|
|
|
72 ;; Manual-subdirectory-list
|
|
|
73 ;; Manual-man-page-section-ids
|
|
|
74 ;; Manual-formatted-page-prefix
|
|
|
75 ;; Manual-unformatted-page-prefix
|
|
|
76 ;; Manual-use-full-section-ids
|
|
0
|
77
|
|
74
|
78 (defvar Manual-program "man" "\
|
|
|
79 *Name of the program to invoke in order to format the source man pages.")
|
|
70
|
80
|
|
74
|
81 (defvar Manual-section-switch (if (eq system-type 'usg-unix-v) "-s" nil)
|
|
|
82 "SysV needs this to work right.")
|
|
0
|
83
|
|
74
|
84 (defvar Manual-topic-buffer t "\
|
|
|
85 *Non-nil means \\[Manual-entry] should output the manual entry for TOPIC into
|
|
|
86 a buffer named *man TOPIC*, otherwise, it should name the buffer
|
|
|
87 *Manual Entry*.")
|
|
70
|
88
|
|
74
|
89 (defvar Manual-buffer-view-mode t "\
|
|
|
90 *Whether manual buffers should be placed in view-mode.
|
|
|
91 nil means leave the buffer in fundamental-mode in another window.
|
|
|
92 t means use `view-buffer' to display the man page in the current window.
|
|
|
93 Any other value means use `view-buffer-other-window'.")
|
|
70
|
94
|
|
74
|
95 (defvar Manual-match-topic-exactly t "\
|
|
|
96 *Non-nil means that \\[manual-entry] will match the given TOPIC exactly, rather
|
|
|
97 apply it as a pattern. When this is nil, and \"Manual-query-multiple-pages\"
|
|
|
98 is non-nil, then \\[manual-entry] will query you for all matching TOPICs.
|
|
|
99 This variable only has affect on the preformatted man pages (the \"cat\" files),
|
|
|
100 since the \"man\" command always does exact topic matches.")
|
|
0
|
101
|
|
74
|
102 (defvar Manual-query-multiple-pages nil "\
|
|
|
103 *Non-nil means that \\[manual-entry] will query the user about multiple man
|
|
|
104 pages which match the given topic. The query is done using the function
|
|
|
105 \"y-or-n-p\". If this variable is nil, all man pages with topics matching the
|
|
|
106 topic given to \\[manual-entry] will be inserted into the temporary buffer.
|
|
|
107 See the variable \"Manual-match-topic-exactly\" to control the matching.")
|
|
70
|
108
|
|
74
|
109 (defvar Manual-unique-man-sections-only nil
|
|
|
110 "*Only present one man page per section. This variable is useful if the same or
|
|
|
111 up/down level man pages for the same entry are present in mulitple man paths.
|
|
|
112 When set to t, only the first entry found in a section is displayed, the others
|
|
|
113 are ignored without any messages or warnings. Note that duplicates can occur if
|
|
|
114 the system has both formatted and unformatted version of the same page.")
|
|
0
|
115
|
|
74
|
116 (defvar Manual-mode-hook nil
|
|
|
117 "Function or functions run on entry to Manual-mode.")
|
|
0
|
118
|
|
74
|
119 (defvar Manual-directory-list nil "\
|
|
|
120 *A list of directories used with the \"man\" command, where each directory
|
|
|
121 contains a set of \"man?\" and \"cat?\" subdirectories. If this variable is nil,
|
|
|
122 it is initialized by \\[Manual-directory-list-init].")
|
|
70
|
123
|
|
74
|
124 (defvar Manual-formatted-directory-list nil "\
|
|
|
125 A list of directories containing formatted man pages. Initialized by
|
|
|
126 \\[Manual-directory-list-init].")
|
|
70
|
127
|
|
74
|
128 (defvar Manual-unformatted-directory-list nil "\
|
|
|
129 A list of directories containing the unformatted (source) man pages.
|
|
|
130 Initialized by \\[Manual-directory-list-init].")
|
|
70
|
131
|
|
74
|
132 (defvar Manual-page-history nil "\
|
|
|
133 A list of names of previously visited man page buffers.")
|
|
70
|
134
|
|
74
|
135 (defvar Manual-manpath-config-file "/usr/lib/manpath.config"
|
|
|
136 "*Location of the manpath.config file, if any.")
|
|
72
|
137
|
|
74
|
138 (defvar Manual-apropos-switch "-k"
|
|
|
139 "*Man apropos switch")
|
|
70
|
140
|
|
74
|
141 ;; New variables.
|
|
70
|
142
|
|
74
|
143 (defvar Manual-subdirectory-list nil "\
|
|
|
144 A list of all the subdirectories in which man pages may be found.
|
|
|
145 Iniialized by Manual-directory-list-init.")
|
|
10
|
146
|
|
74
|
147 ;; This is for SGI systems; don't know what it should be otherwise.
|
|
|
148 (defvar Manual-man-page-section-ids "1nl6823457poD" "\
|
|
|
149 String containing all suffix characters for \"cat\" and \"man\"
|
|
|
150 that identify valid sections of the Un*x manual.")
|
|
10
|
151
|
|
74
|
152 (defvar Manual-formatted-page-prefix "cat" "\
|
|
|
153 Prefix for directories where formatted man pages are to be found.
|
|
|
154 Defaults to \"cat\".")
|
|
10
|
155
|
|
74
|
156 (defvar Manual-unformatted-page-prefix "man" "\
|
|
|
157 Prefix for directories where unformatted man pages are to be found.
|
|
|
158 Defaults to \"man\".")
|
|
10
|
159
|
|
74
|
160 (defvar Manual-leaf-signature "" "\
|
|
|
161 Regexp for identifying \"leaf\" subdirectories in the search path.
|
|
|
162 If empty, initialized by Manual-directory-list-init.")
|
|
|
163
|
|
|
164 (defvar Manual-use-full-section-ids t "\
|
|
|
165 If non-nil, pass full section ids to Manual-program, otherwise pass
|
|
|
166 only the first character. Defaults to 't'.")
|
|
10
|
167
|
|
74
|
168 (defvar Manual-use-subdirectory-list (eq system-type 'irix) "\
|
|
|
169 This makes manual-entry work correctly on SGI machines but it
|
|
|
170 imposes a large startup cost which is why it is not simply on by
|
|
|
171 default on all systems.")
|
|
|
172
|
|
76
|
173 (defvar Manual-use-rosetta-man (not (null (locate-file "rman" exec-path))) "\
|
|
|
174 If non-nil, use RosettaMan (rman) to filter man pages.
|
|
|
175 This makes man-page cleanup virtually instantaneous, instead of
|
|
|
176 potentially taking a long time.
|
|
|
177
|
|
|
178 Here is information on RosettaMan, from Neal.Becker@comsat.com (Neal Becker):
|
|
|
179
|
|
|
180 RosettaMan is a filter for UNIX manual pages. It takes as input man
|
|
|
181 pages formatted for a variety of UNIX flavors (not [tn]roff source)
|
|
|
182 and produces as output a variety of file formats. Currently
|
|
|
183 RosettaMan accepts man pages as formatted by the following flavors of
|
|
|
184 UNIX: Hewlett-Packard HP-UX, AT&T System V, SunOS, Sun Solaris, OSF/1,
|
|
|
185 DEC Ultrix, SGI IRIX, Linux, SCO; and produces output for the following
|
|
|
186 formats: printable ASCII only (stripping page headers and footers),
|
|
|
187 section and subsection headers only, TkMan, [tn]roff, Ensemble, RTF,
|
|
|
188 SGML (soon--I finally found a DTD), HTML, MIME, LaTeX, LaTeX 2e, Perl 5's pod.
|
|
|
189
|
|
|
190 RosettaMan improves on other man page filters in several ways: (1) its
|
|
|
191 analysis recognizes the structural pieces of man pages, enabling high
|
|
|
192 quality output, (2) its modular structure permits easy augmentation of
|
|
|
193 output formats, (3) it accepts man pages formatted with the varient
|
|
|
194 macros of many different flavors of UNIX, and (4) it doesn't require
|
|
|
195 modification or cooperation with any other program.
|
|
|
196
|
|
|
197 RosettaMan is a rewrite of TkMan's man page filter, called bs2tk. (If
|
|
|
198 you haven't heard about TkMan, a hypertext man page browser, you
|
|
|
199 should grab it via anonymous ftp from ftp.cs.berkeley.edu:
|
|
|
200 /ucb/people/phelps/tkman.tar.Z.) Whereas bs2tk generated output only for
|
|
|
201 TkMan, RosettaMan generalizes the process so that the analysis can be
|
|
|
202 leveraged to new output formats. A single analysis engine recognizes
|
|
|
203 section heads, subsection heads, body text, lists, references to other
|
|
|
204 man pages, boldface, italics, bold italics, special characters (like
|
|
|
205 bullets), tables (to a degree) and strips out page headers and
|
|
|
206 footers. The engine sends signals to the selected output functions so
|
|
|
207 that an enhancement in the engine improves the quality of output of
|
|
|
208 all of them. Output format functions are easy to add, and thus far
|
|
|
209 average about about 75 lines of C code each.
|
|
|
210
|
|
|
211
|
|
|
212
|
|
|
213 *** NOTES ON CURRENT VERSION ***
|
|
|
214
|
|
|
215 Help! I'm looking for people to help with the following projects.
|
|
|
216 \(1) Better RTF output format. The current one works, but could be
|
|
|
217 made better. (2) Roff macros that produce text that is easily
|
|
|
218 parsable. RosettaMan handles a great variety, but some things, like
|
|
|
219 H-P's tables, are intractable. If you write an output format or
|
|
|
220 otherwise improve RosettaMan, please send in your code so that I may
|
|
|
221 share the wealth in future releases.
|
|
|
222
|
|
|
223 This version can try to identify tables (turn this on with the -T
|
|
|
224 switch) by looking for lines with a large amount of interword spacing,
|
|
|
225 reasoning that this is space between columns of a table. This
|
|
|
226 heuristic doesn't always work and sometimes misidentifies ordinary
|
|
|
227 text as tables. In general I think it is impossible to perfectly
|
|
|
228 identify tables from nroff formatted text. However, I do think the
|
|
|
229 heuristics can be tuned, so if you have a collection of manual pages
|
|
|
230 with unrecognized tables, send me the lot, in formatted form (i.e.,
|
|
|
231 after formatting with nroff -man), and uuencode them to preserve the
|
|
|
232 control characters. Better, if you can think of heuristics that
|
|
|
233 distinguish tables from ordinary text, I'd like to hear them.
|
|
|
234
|
|
|
235
|
|
|
236 Notes for HTML consumers: This filter does real (heuristic)
|
|
|
237 parsing--no <PRE>! Man page references are turned into hypertext links.")
|
|
|
238
|
|
74
|
239 (make-face 'man-italic)
|
|
|
240 (or (face-differs-from-default-p 'man-italic)
|
|
|
241 (copy-face 'italic 'man-italic))
|
|
|
242 ;; XEmacs (from Darrell Kindred): underlining is annoying due to
|
|
|
243 ;; large blank spaces in this face.
|
|
|
244 ;; (or (face-differs-from-default-p 'man-italic)
|
|
|
245 ;; (set-face-underline-p 'man-italic t))
|
|
10
|
246
|
|
74
|
247 (make-face 'man-bold)
|
|
|
248 (or (face-differs-from-default-p 'man-bold)
|
|
|
249 (copy-face 'bold 'man-bold))
|
|
|
250 (or (face-differs-from-default-p 'man-bold)
|
|
|
251 (copy-face 'man-italic 'man-bold))
|
|
0
|
252
|
|
74
|
253 (make-face 'man-heading)
|
|
|
254 (or (face-differs-from-default-p 'man-heading)
|
|
|
255 (copy-face 'man-bold 'man-heading))
|
|
0
|
256
|
|
74
|
257 (make-face 'man-xref)
|
|
|
258 (or (face-differs-from-default-p 'man-xref)
|
|
|
259 (set-face-underline-p 'man-xref t))
|
|
|
260
|
|
|
261 ;; Manual-directory-list-init
|
|
|
262 ;; Initialize the directory lists.
|
|
8
|
263
|
|
74
|
264 (defun Manual-directory-list-init (&optional arg)
|
|
|
265 "Initialize the Manual-directory-list variable from $MANPATH
|
|
|
266 if it is not already set, or if a prefix argument is provided."
|
|
|
267 (interactive "P")
|
|
|
268 (if arg (setq Manual-directory-list nil))
|
|
|
269 (if (null Manual-directory-list)
|
|
|
270 (let ((manpath (getenv "MANPATH"))
|
|
|
271 (global (Manual-manpath-config-contents))
|
|
|
272 (dirlist nil)
|
|
|
273 dir)
|
|
|
274 (cond ((and manpath global)
|
|
|
275 (setq manpath (concat manpath ":" global)))
|
|
|
276 (global
|
|
|
277 (setq manpath global))
|
|
|
278 ((not manpath)
|
|
|
279 ;; XEmacs - (bpw/stig) Unix-specifix hack for lusers w/ no manpath
|
|
|
280 (setq manpath "/usr/local/man:/usr/share/man:/usr/contrib/man:/usr/X11/man:/usr/man:/usr/catman")))
|
|
|
281 ;; Make sure that any changes we've made internally are seen by man.
|
|
|
282 (setenv "MANPATH" manpath)
|
|
|
283 (while (string-match "\\`:*\\([^:]+\\)" manpath)
|
|
|
284 (setq dir (substring manpath (match-beginning 1) (match-end 1)))
|
|
|
285 (and (not (member dir dirlist))
|
|
|
286 (setq dirlist (cons dir dirlist)))
|
|
|
287 (setq manpath (substring manpath (match-end 0))))
|
|
|
288 (setq dirlist (nreverse dirlist))
|
|
|
289 (setq Manual-directory-list dirlist)
|
|
|
290 (setq Manual-subdirectory-list nil)
|
|
|
291 (setq Manual-formatted-directory-list nil)
|
|
|
292 (setq Manual-unformatted-directory-list nil)))
|
|
|
293 (if (string-equal Manual-leaf-signature "")
|
|
|
294 (setq Manual-leaf-signature
|
|
|
295 (concat "/\\("
|
|
|
296 Manual-formatted-page-prefix
|
|
|
297 "\\|" Manual-unformatted-page-prefix
|
|
|
298 "\\)"
|
|
|
299 "[" Manual-man-page-section-ids
|
|
|
300 "].?/.")))
|
|
|
301 (if Manual-use-subdirectory-list
|
|
|
302 (progn
|
|
|
303 (if (null Manual-subdirectory-list)
|
|
|
304 (setq Manual-subdirectory-list
|
|
|
305 (Manual-all-subdirectories Manual-directory-list
|
|
|
306 Manual-leaf-signature nil)))
|
|
|
307 (if (null Manual-formatted-directory-list)
|
|
|
308 (setq Manual-formatted-directory-list
|
|
|
309 (Manual-filter-subdirectories Manual-subdirectory-list
|
|
|
310 Manual-formatted-page-prefix)))
|
|
|
311 (if (null Manual-unformatted-directory-list)
|
|
|
312 (setq Manual-unformatted-directory-list
|
|
|
313 (Manual-filter-subdirectories Manual-subdirectory-list
|
|
|
314 Manual-unformatted-page-prefix))))
|
|
|
315 (if (null Manual-formatted-directory-list)
|
|
|
316 (setq Manual-formatted-directory-list
|
|
|
317 (Manual-select-subdirectories Manual-directory-list
|
|
|
318 Manual-formatted-page-prefix)))
|
|
|
319 (if (null Manual-unformatted-directory-list)
|
|
|
320 (setq Manual-unformatted-directory-list
|
|
|
321 (Manual-select-subdirectories Manual-directory-list
|
|
|
322 Manual-unformatted-page-prefix)))))
|
|
70
|
323
|
|
|
324
|
|
74
|
325 (defun Manual-manpath-config-contents ()
|
|
|
326 "Parse the `Manual-manpath-config-file' file, if any.
|
|
|
327 Returns a string like in $MANPATH."
|
|
|
328 (if (and Manual-manpath-config-file
|
|
|
329 (file-readable-p Manual-manpath-config-file))
|
|
|
330 (let ((buf (get-buffer-create " *Manual-config*"))
|
|
|
331 path)
|
|
|
332 (set-buffer buf)
|
|
|
333 (buffer-disable-undo buf)
|
|
|
334 (erase-buffer)
|
|
|
335 (insert-file-contents Manual-manpath-config-file)
|
|
|
336 (while (re-search-forward "^\\(MANDATORY_MANPATH\\|MANPATH_MAP\\)"
|
|
|
337 nil t)
|
|
|
338 (and (re-search-forward "\\(/[^ \t\n]+\\)[ \t]*$")
|
|
|
339 (setq path (concat path (buffer-substring (match-beginning 1)
|
|
|
340 (match-end 1))
|
|
|
341 ":"))))
|
|
|
342 (kill-buffer buf)
|
|
|
343 path)))
|
|
|
344 ;;
|
|
|
345 ;; manual-entry -- The "main" user function
|
|
|
346 ;;
|
|
0
|
347
|
|
|
348 ;;;###autoload
|
|
74
|
349 (defun manual-entry (topic &optional arg silent)
|
|
|
350 "Display the Unix manual entry (or entries) for TOPIC.
|
|
|
351 If prefix arg is given, modify the search according to the value:
|
|
|
352 2 = complement default exact matching of the TOPIC name;
|
|
|
353 exact matching default is specified by `Manual-match-topic-exactly'
|
|
|
354 3 = force a search of the unformatted man directories
|
|
|
355 4 = both 2 and 3
|
|
|
356 The manual entries are searched according to the variable
|
|
|
357 Manual-directory-list, which should be a list of directories. If
|
|
|
358 Manual-directory-list is nil, \\[Manual-directory-list-init] is
|
|
|
359 invoked to create this list from the MANPATH environment variable.
|
|
|
360 See the variable Manual-topic-buffer which controls how the buffer
|
|
|
361 is named. See also the variables Manual-match-topic-exactly,
|
|
|
362 Manual-query-multiple-pages, and Manual-buffer-view-mode."
|
|
|
363 (interactive
|
|
|
364 (list (let* ((fmh "-A-Za-z0-9_.")
|
|
|
365 (default (save-excursion
|
|
|
366 (buffer-substring
|
|
|
367 (progn
|
|
|
368 (re-search-backward "\\sw" nil t)
|
|
|
369 (skip-chars-backward fmh) (point))
|
|
|
370 (progn (skip-chars-forward fmh) (point)))))
|
|
|
371 (thing (read-string
|
|
|
372 (if (equal default "") "Manual entry: "
|
|
|
373 (concat "Manual entry: (default " default ") ")))))
|
|
|
374 (if (equal thing "") default thing))
|
|
|
375 (prefix-numeric-value current-prefix-arg)))
|
|
|
376 ;;(interactive "sManual entry (topic): \np")
|
|
|
377 (or arg (setq arg 1))
|
|
|
378 (Manual-directory-list-init nil)
|
|
|
379 (let ((exact (if (or (= arg 2) (= arg 4))
|
|
|
380 (not Manual-match-topic-exactly)
|
|
|
381 Manual-match-topic-exactly))
|
|
|
382 (force (if (>= arg 3)
|
|
|
383 t
|
|
|
384 nil))
|
|
|
385 section fmtlist manlist apropos-mode)
|
|
|
386 (let ((case-fold-search nil))
|
|
|
387 (if (and (null section)
|
|
|
388 (string-match
|
|
|
389 "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic))
|
|
|
390 (setq section (substring topic (match-beginning 2)
|
|
|
391 (match-end 2))
|
|
|
392 topic (substring topic (match-beginning 1)
|
|
|
393 (match-end 1)))
|
|
|
394 (if (string-match "\\`[ \t]*-k[ \t]+\\([^ \t]+\\)\\'" topic)
|
|
|
395 (setq section "-k"
|
|
|
396 topic (substring topic (match-beginning 1))))))
|
|
|
397 (if (equal section "-k")
|
|
|
398 (setq apropos-mode t)
|
|
|
399 (or silent
|
|
|
400 (message "Looking for formatted entry for %s%s..."
|
|
|
401 topic (if section (concat "(" section ")") "")))
|
|
|
402 (setq fmtlist (Manual-select-man-pages
|
|
|
403 Manual-formatted-directory-list
|
|
|
404 topic section exact '()))
|
|
|
405 (if (or force (not section) (null fmtlist))
|
|
|
406 (progn
|
|
|
407 (or silent
|
|
|
408 (message "%sooking for unformatted entry for %s%s..."
|
|
|
409 (if fmtlist "L" "No formatted entry, l")
|
|
|
410 topic (if section (concat "(" section ")") "")))
|
|
|
411 (setq manlist (Manual-select-man-pages
|
|
|
412 Manual-unformatted-directory-list
|
|
|
413 topic section exact (if force '() fmtlist))))))
|
|
|
414
|
|
|
415 ;; Delete duplicate man pages (a file of the same name in multiple
|
|
|
416 ;; directories.)
|
|
|
417 (or nil ;force
|
|
|
418 (let ((rest (append fmtlist manlist)))
|
|
|
419 (while rest
|
|
|
420 (let ((rest2 (cdr rest)))
|
|
|
421 (while rest2
|
|
|
422 (if (equal (file-name-nondirectory (car rest))
|
|
|
423 (file-name-nondirectory (car rest2)))
|
|
|
424 (setq fmtlist (delq (car rest2) fmtlist)
|
|
|
425 manlist (delq (car rest2) manlist)))
|
|
|
426 (setq rest2 (cdr rest2))))
|
|
|
427 (setq rest (cdr rest)))))
|
|
|
428
|
|
|
429 (if (not (or fmtlist manlist apropos-mode))
|
|
|
430 (progn
|
|
|
431 (message "No entries found for %s%s" topic
|
|
|
432 (if section (concat "(" section ")") ""))
|
|
|
433 nil)
|
|
|
434 (let ((bufname (cond ((not Manual-topic-buffer)
|
|
|
435 ;; What's the point of retaining this?
|
|
|
436 (if apropos-mode
|
|
|
437 "*Manual Apropos*"
|
|
|
438 "*Manual Entry*"))
|
|
|
439 (apropos-mode
|
|
|
440 (concat "*man apropos " topic "*"))
|
|
|
441 (t
|
|
|
442 (concat "*man "
|
|
|
443 (cond (exact
|
|
|
444 (if section
|
|
|
445 (concat topic "." section)
|
|
|
446 topic))
|
|
|
447 ((or (cdr fmtlist) (cdr manlist)
|
|
|
448 (and fmtlist manlist))
|
|
|
449 ;; more than one entry found
|
|
|
450 (concat topic "..."))
|
|
|
451 (t
|
|
|
452 (file-name-nondirectory
|
|
|
453 (car (or fmtlist manlist)))))
|
|
|
454 "*"))))
|
|
|
455 (temp-buffer-show-function
|
|
|
456 (cond ((eq 't Manual-buffer-view-mode) 'view-buffer)
|
|
|
457 ((eq 'nil Manual-buffer-view-mode)
|
|
|
458 temp-buffer-show-function)
|
|
|
459 (t 'view-buffer-other-window))))
|
|
|
460
|
|
|
461 (if apropos-mode
|
|
|
462 (setq manlist (list (format "%s.%s" topic section))))
|
|
|
463
|
|
|
464 (cond
|
|
|
465 ((and Manual-topic-buffer (get-buffer bufname))
|
|
|
466 ;; reselect an old man page buffer if it exists already.
|
|
|
467 (save-excursion
|
|
|
468 (set-buffer (get-buffer bufname))
|
|
|
469 (Manual-mode))
|
|
|
470 (if temp-buffer-show-function
|
|
|
471 (funcall temp-buffer-show-function (get-buffer bufname))
|
|
|
472 (display-buffer bufname)))
|
|
|
473 (t
|
|
|
474 (with-output-to-temp-buffer bufname
|
|
|
475 (buffer-disable-undo standard-output)
|
|
|
476 (save-excursion
|
|
|
477 (set-buffer standard-output)
|
|
|
478 (setq buffer-read-only nil)
|
|
|
479 (erase-buffer)
|
|
|
480 (Manual-insert-pages fmtlist manlist apropos-mode)
|
|
|
481 (set-buffer-modified-p nil)
|
|
|
482 (Manual-mode)
|
|
|
483 ))))
|
|
|
484 (setq Manual-page-history
|
|
|
485 (cons (buffer-name)
|
|
|
486 (delete (buffer-name) Manual-page-history)))
|
|
|
487 (message nil)
|
|
|
488 t))))
|
|
|
489
|
|
|
490 (defun Manpage-apropos (topic &optional arg silent)
|
|
|
491 "Apropos on Unix manual pages for TOPIC.
|
|
|
492 It calls the function `manual-entry'. Look at this function for
|
|
|
493 further description. Look also at the variable `Manual-apropos-switch',
|
|
|
494 if this function doesn't work on your system."
|
|
8
|
495 (interactive
|
|
74
|
496 (list (let* ((fmh "-A-Za-z0-9_.")
|
|
|
497 (default (save-excursion
|
|
|
498 (buffer-substring
|
|
|
499 (progn
|
|
|
500 (re-search-backward "\\sw" nil t)
|
|
|
501 (skip-chars-backward fmh) (point))
|
|
|
502 (progn (skip-chars-forward fmh) (point)))))
|
|
|
503 (thing (read-string
|
|
|
504 (if (equal default "") "Manual entry: "
|
|
|
505 (concat "Manual entry: (default " default ") ")))))
|
|
|
506 (if (equal thing "") default thing))
|
|
|
507 (prefix-numeric-value current-prefix-arg)))
|
|
|
508 (manual-entry (concat Manual-apropos-switch " " topic) arg silent))
|
|
|
509
|
|
|
510 (defun Manual-insert-pages (fmtlist manlist apropos-mode)
|
|
|
511 (let ((sep (make-string 65 ?-))
|
|
|
512 name start end topic section)
|
|
|
513 (while fmtlist ; insert any formatted files
|
|
|
514 (setq name (car fmtlist))
|
|
|
515 (goto-char (point-max))
|
|
|
516 (setq start (point))
|
|
|
517 ;; In case the file can't be read or uncompressed or
|
|
|
518 ;; something like that.
|
|
|
519 (condition-case ()
|
|
|
520 (Manual-insert-man-file name)
|
|
|
521 (file-error nil))
|
|
|
522 (goto-char (point-max))
|
|
|
523 (setq end (point))
|
|
|
524 (save-excursion
|
|
|
525 (save-restriction
|
|
|
526 (message "Cleaning manual entry for %s..."
|
|
|
527 (file-name-nondirectory name))
|
|
|
528 (narrow-to-region start end)
|
|
|
529 (Manual-nuke-nroff-bs)
|
|
|
530 (goto-char (point-min))
|
|
|
531 (insert "File: " name "\n")
|
|
|
532 (goto-char (point-max))
|
|
|
533 ))
|
|
|
534 (if (or (cdr fmtlist) manlist)
|
|
|
535 (insert "\n\n" sep "\n"))
|
|
|
536 (setq fmtlist (cdr fmtlist)))
|
|
70
|
537
|
|
74
|
538 (while manlist ; process any unformatted files
|
|
|
539 (setq name (car manlist))
|
|
|
540 (or (string-match "\\([^/]+\\)\\.\\([^./]+\\)\\(\\.gz\\'\\)" name)
|
|
|
541 (string-match "\\([^/]+\\)\\.\\([^./]+\\)\\'" name))
|
|
|
542 (setq topic (substring name (match-beginning 1) (match-end 1)))
|
|
|
543 (setq section (substring name (match-beginning 2) (match-end 2)))
|
|
|
544 ;; This won't work under IRIX, because SGI man accepts only the
|
|
|
545 ;; "main" (one-character) section id, not full section ids
|
|
|
546 ;; like 1M, 3X, etc. Put (setq Manual-use-full-section-ids nil)
|
|
|
547 ;; in your .emacs to work around this problem.
|
|
|
548 (if (not (or Manual-use-full-section-ids (string-equal section "")))
|
|
|
549 (setq section (substring section 0 1)))
|
|
|
550 (message "Invoking man %s%s %s..."
|
|
|
551 (if Manual-section-switch
|
|
|
552 (concat Manual-section-switch " ")
|
|
|
553 "")
|
|
|
554 section topic)
|
|
|
555 (setq start (point))
|
|
|
556 (Manual-run-formatter name topic section)
|
|
|
557 (setq end (point))
|
|
|
558 (save-excursion
|
|
|
559 (save-restriction
|
|
|
560 (message "Cleaning manual entry for %s(%s)..." topic section)
|
|
|
561 (narrow-to-region start end)
|
|
|
562 (Manual-nuke-nroff-bs apropos-mode)
|
|
|
563 (goto-char (point-min))
|
|
|
564 (insert "File: " name "\n")
|
|
|
565 (goto-char (point-max))
|
|
|
566 ))
|
|
|
567 (if (cdr manlist)
|
|
|
568 (insert "\n\n" sep "\n"))
|
|
|
569 (setq manlist (cdr manlist))))
|
|
|
570 (if (< (buffer-size) 200)
|
|
|
571 (progn
|
|
|
572 (goto-char (point-min))
|
|
|
573 (if (looking-at "^File: ")
|
|
|
574 (forward-line 1))
|
|
|
575 (error (buffer-substring (point) (progn (end-of-line) (point))))))
|
|
|
576 nil)
|
|
|
577
|
|
80
|
578 (defvar Manual-entry-switches '("-s")
|
|
|
579 "Switches for `manual-entry' including switch for section (at the end).")
|
|
|
580 (defvar Manual-apropos-switches nil
|
|
|
581 "Additional switches for `Manpage-apropos' excluding switch `-k'.")
|
|
|
582
|
|
74
|
583 (defun Manual-run-formatter (name topic section)
|
|
|
584 (cond ((string-match "roff\\'" Manual-program)
|
|
|
585 ;; kludge kludge
|
|
|
586 (call-process Manual-program nil t nil "-Tman" "-man" name))
|
|
|
587 (t
|
|
80
|
588 (apply 'call-process Manual-program nil t nil
|
|
|
589 (append (if apropos-mode
|
|
|
590 Manual-apropos-switches
|
|
|
591 Manual-entry-switches)
|
|
|
592 (list section topic))))))
|
|
8
|
593
|
|
74
|
594 (defvar Manual-mode-map
|
|
|
595 (let ((m (make-sparse-keymap)))
|
|
|
596 (set-keymap-name m 'Manual-mode-map)
|
|
|
597 (define-key m "l" 'Manual-last-page)
|
|
|
598 (define-key m 'button2 'Manual-follow-xref)
|
|
|
599 (define-key m 'button3 'Manual-popup-menu)
|
|
|
600 m))
|
|
|
601
|
|
|
602 (defun Manual-mode ()
|
|
|
603 (kill-all-local-variables)
|
|
|
604 (setq buffer-read-only t)
|
|
|
605 (use-local-map Manual-mode-map)
|
|
|
606 (setq major-mode 'Manual-mode
|
|
|
607 mode-name "Manual")
|
|
|
608 ;; man pages with long lines are buggy!
|
|
|
609 ;; This looks slightly better if they only
|
|
|
610 ;; overran by a couple of chars.
|
|
|
611 (setq truncate-lines t)
|
|
|
612 ;; turn off horizontal scrollbars in this buffer
|
|
82
|
613 (when (featurep 'scrollbar)
|
|
|
614 (set-specifier scrollbar-height (cons (current-buffer) 0)))
|
|
74
|
615 (run-hooks 'Manual-mode-hook))
|
|
|
616
|
|
|
617 (defun Manual-last-page ()
|
|
|
618 (interactive)
|
|
|
619 (while (or (not (get-buffer (car (or Manual-page-history
|
|
|
620 (error "No more history.")))))
|
|
|
621 (eq (get-buffer (car Manual-page-history)) (current-buffer)))
|
|
|
622 (setq Manual-page-history (cdr Manual-page-history)))
|
|
|
623 (switch-to-buffer (car Manual-page-history)))
|
|
|
624
|
|
|
625
|
|
|
626 ;; Manual-select-subdirectories
|
|
|
627 ;; Given a DIRLIST and a SUBDIR name, return all subdirectories of the former which
|
|
|
628 ;; match the latter.
|
|
|
629
|
|
|
630 (defun Manual-select-subdirectories (dirlist subdir)
|
|
|
631 (let ((dirs '())
|
|
|
632 (case-fold-search nil)
|
|
|
633 (match (concat "\\`" (regexp-quote subdir)))
|
|
|
634 d)
|
|
|
635 (while dirlist
|
|
|
636 (setq d (car dirlist) dirlist (cdr dirlist))
|
|
|
637 (if (file-directory-p d)
|
|
|
638 (let ((files (directory-files d t match nil 'dirs-only))
|
|
|
639 (dir-temp '()))
|
|
|
640 (while files
|
|
|
641 (if (file-executable-p (car files))
|
|
|
642 (setq dir-temp (cons (file-name-as-directory (car files))
|
|
|
643 dir-temp)))
|
|
|
644 (setq files (cdr files)))
|
|
|
645 (and dir-temp
|
|
|
646 (setq dirs (append dirs (nreverse dir-temp)))))))
|
|
|
647 dirs))
|
|
70
|
648
|
|
|
649
|
|
74
|
650 ;; Manual-filter-subdirectories
|
|
|
651 ;; Given a DIRLIST and a SUBDIR name, return all members of the former
|
|
|
652 ;; which match the latter.
|
|
|
653
|
|
|
654 (defun Manual-filter-subdirectories (dirlist subdir)
|
|
|
655 (let ((match (concat
|
|
|
656 "/"
|
|
|
657 (regexp-quote subdir)
|
|
|
658 "[" Manual-man-page-section-ids "]"))
|
|
|
659 slist dir)
|
|
|
660 (while dirlist
|
|
|
661 (setq dir (car dirlist) dirlist (cdr dirlist))
|
|
|
662 (if (and (file-executable-p dir) (string-match match dir))
|
|
|
663 (setq slist (cons dir slist))))
|
|
|
664 (nreverse slist)))
|
|
|
665
|
|
|
666
|
|
|
667 (defun Manual-all-subdirectories (dirlist leaf-signature dirs &optional silent) "\
|
|
|
668 Given a DIRLIST, return a backward-sorted list of all subdirectories
|
|
|
669 thereof, prepended to DIRS if non-nil. This function calls itself
|
|
|
670 recursively until subdirectories matching LEAF-SIGNATURE are reached,
|
|
|
671 or the hierarchy has been thoroughly searched. This code is a modified
|
|
|
672 version of a function written by Tim Bradshaw (tfb@ed.ac.uk)."
|
|
|
673 (Manual-all-subdirectories-noloop dirlist leaf-signature dirs nil silent))
|
|
|
674
|
|
|
675 (defun Manual-all-subdirectories-noloop (dirlist leaf-signature dirs been &optional silent) "\
|
|
|
676 Does the job of manual-all-subdirectories and keeps track of where it
|
|
|
677 has been to avoid loops."
|
|
|
678 (let (dir)
|
|
|
679 (while dirlist
|
|
|
680 (setq dir (car dirlist) dirlist (cdr dirlist))
|
|
|
681 (if (file-directory-p dir)
|
|
|
682 (let ((dir-temp (cons (file-name-as-directory dir) dirs)))
|
|
|
683 ;; Without feedback the user might wonder about the delay!
|
|
|
684 (or silent (message
|
|
|
685 "Building list of search directories... %s"
|
|
|
686 (car dir-temp)))
|
|
|
687 (if (member (file-truename dir) been)
|
|
|
688 () ; Ignore. We have been here before
|
|
|
689 (setq been (cons (file-truename dir) been))
|
|
|
690 (setq dirs
|
|
|
691 (if (string-match leaf-signature dir)
|
|
|
692 dir-temp
|
|
|
693 (Manual-all-subdirectories-noloop
|
|
|
694 (directory-files dir t "[^.]$" nil 'dirs-only)
|
|
|
695 leaf-signature dir-temp been silent))))))))
|
|
|
696 dirs)
|
|
|
697
|
|
|
698
|
|
|
699 (defvar Manual-bogus-file-pattern "\\.\\(lpr\\|ps\\|PS\\)\\'"
|
|
|
700 "Some systems have files in the man/man*/ directories which aren't man pages.
|
|
|
701 This pattern is used to prune those files.")
|
|
|
702
|
|
|
703 ;; Manual-select-man-pages
|
|
|
704 ;;
|
|
|
705 ;; Given a DIRLIST, discover all filenames which complete given the TOPIC
|
|
|
706 ;; and SECTION.
|
|
|
707
|
|
|
708 ;; ## Note: BSD man looks for .../man1/foo.1 and .../man1/$MACHINE/foo.1
|
|
|
709
|
|
|
710 ;; ## Fixed for SGI IRIX 5.x on Sat Jul 15 1995 by Dale Atems
|
|
|
711 ;; (atems@physics.wayne.edu).
|
|
|
712
|
|
|
713 (defun Manual-select-man-pages (dirlist topic section exact shadow)
|
|
|
714 (let ((case-fold-search nil))
|
|
|
715 (and section
|
|
|
716 (let ((l '())
|
|
|
717 ;;(match (concat (substring section 0 1) "/?\\'"))
|
|
|
718 ;; ^^^
|
|
|
719 ;; We'll lose any pages inside subdirectories of the "standard"
|
|
|
720 ;; ones if we insist on this! The following regexp should
|
|
|
721 ;; match any directory ending with the full section id or
|
|
|
722 ;; its first character, or any direct subdirectory thereof:
|
|
|
723 (match (concat "\\("
|
|
|
724 (regexp-quote section)
|
|
|
725 "\\|"
|
|
|
726 (substring section 0 1)
|
|
|
727 "\\)/?"))
|
|
|
728 d)
|
|
|
729 (while dirlist
|
|
|
730 (setq d (car dirlist) dirlist (cdr dirlist))
|
|
|
731 (if (string-match match d)
|
|
|
732 (setq l (cons d l))))
|
|
|
733 (setq dirlist l)))
|
|
|
734 (if shadow
|
|
|
735 (setq shadow (concat "/\\("
|
|
|
736 (mapconcat #'(lambda (n)
|
|
|
737 (regexp-quote
|
|
|
738 (file-name-nondirectory n)))
|
|
|
739 shadow
|
|
|
740 "\\|")
|
|
|
741 "\\)\\'")))
|
|
|
742 (let ((manlist '())
|
|
|
743 (match (concat "\\`"
|
|
|
744 (regexp-quote topic)
|
|
|
745 ;; **Note: on IRIX the preformatted pages
|
|
|
746 ;; are packed, so they end with ".z". This
|
|
|
747 ;; way you miss them if you specify a
|
|
|
748 ;; section. I don't see any point to it here
|
|
|
749 ;; even on BSD systems since we're looking
|
|
|
750 ;; one level down already, but I can't test
|
|
|
751 ;; this. More thought needed (???)
|
|
8
|
752
|
|
74
|
753 (cond ((and section
|
|
|
754 (not Manual-use-subdirectory-list))
|
|
|
755 (concat "\\." (regexp-quote section)))
|
|
|
756 (exact
|
|
|
757 ;; If Manual-match-topic-exactly is
|
|
|
758 ;; set, then we must make sure the
|
|
|
759 ;; completions are exact, except for
|
|
|
760 ;; trailing weird characters after
|
|
|
761 ;; the section.
|
|
|
762 "\\.")
|
|
|
763 (t
|
|
|
764 ""))))
|
|
|
765 dir)
|
|
|
766 (while dirlist
|
|
|
767 (setq dir (car dirlist) dirlist (cdr dirlist))
|
|
|
768 (if (not (file-directory-p dir))
|
|
|
769 (progn
|
|
|
770 (message "warning: %s is not a directory" dir)
|
|
|
771 ;;(sit-for 1)
|
|
|
772 )
|
|
|
773 (let ((files (directory-files dir t match nil t))
|
|
|
774 f)
|
|
|
775 (while files
|
|
|
776 (setq f (car files) files (cdr files))
|
|
|
777 (cond ((string-match Manual-bogus-file-pattern f)
|
|
|
778 ;(message "Bogus fule %s" f) (sit-for 2)
|
|
|
779 )
|
|
|
780 ((and shadow (string-match shadow f))
|
|
|
781 ;(message "Shadowed %s" f) (sit-for 2)
|
|
|
782 )
|
|
|
783 ((not (file-readable-p f))
|
|
|
784 ;(message "Losing with %s" f) (sit-for 2)
|
|
|
785 )
|
|
|
786 (t
|
|
|
787 (setq manlist (cons f manlist))))))))
|
|
|
788 (setq manlist (nreverse manlist))
|
|
|
789 (and Manual-unique-man-sections-only
|
|
|
790 (setq manlist (Manual-clean-to-unique-pages-only manlist)))
|
|
|
791 (if (and manlist Manual-query-multiple-pages)
|
|
|
792 (apply #'append
|
|
|
793 (mapcar #'(lambda (page)
|
|
|
794 (and page
|
|
|
795 (y-or-n-p (format "Read %s? " page))
|
|
|
796 (list page)))
|
|
|
797 manlist))
|
|
|
798 manlist))))
|
|
8
|
799
|
|
74
|
800 (defun Manual-clean-to-unique-pages-only (manlist)
|
|
|
801 "Prune the current list of pages down to a unique set."
|
|
|
802 (let (page-name unique-pages)
|
|
|
803 (apply 'append
|
|
|
804 (mapcar '(lambda (page)
|
|
|
805 (cond (page
|
|
|
806 (and (string-match ".*/\\(.*\\)" page)
|
|
|
807 (setq page-name (substring page (match-beginning 1)
|
|
|
808 (match-end 1)))
|
|
|
809 ;; try to clip off .Z, .gz suffixes
|
|
|
810 (and (string-match "\\(.*\\)\\.\\(.+\\)\\.\\(.+\\)"
|
|
|
811 page-name)
|
|
|
812 (setq page-name
|
|
|
813 (substring page-name (match-beginning 1)
|
|
|
814 (match-end 2)))))
|
|
|
815 ;; add Manual-unique-pages if it isn't there
|
|
|
816 ;; and return file
|
|
|
817 (if (and unique-pages
|
|
|
818 page-name
|
|
|
819 (string-match (concat "\\b" page-name "\\b")
|
|
|
820 unique-pages))
|
|
|
821 nil
|
|
|
822 (setq unique-pages (concat unique-pages
|
|
|
823 page-name
|
|
|
824 " "))
|
|
|
825 (list page)))))
|
|
|
826 manlist))))
|
|
|
827
|
|
|
828
|
|
|
829
|
|
|
830 (defun Manual-insert-man-file (name)
|
|
|
831 ;; Insert manual file (unpacked as necessary) into buffer
|
|
|
832 (cond ((equal (substring name -3) ".gz")
|
|
|
833 (call-process "gunzip" nil t nil "--stdout" name))
|
|
|
834 ((or (equal (substring name -2) ".Z")
|
|
|
835 ;; HPUX uses directory names that end in .Z and compressed
|
|
|
836 ;; files that don't. How gratuitously random.
|
|
|
837 (let ((case-fold-search nil))
|
|
|
838 (string-match "\\.Z/" name)))
|
|
|
839 (call-process "zcat" name t nil)) ;; XEmacs change for HPUX
|
|
|
840 ((equal (substring name -2) ".z")
|
|
|
841 (call-process "pcat" nil t nil name))
|
|
|
842 (t
|
|
|
843 (insert-file-contents name))))
|
|
|
844
|
|
|
845 (defmacro Manual-delete-char (n)
|
|
|
846 ;; in v19, delete-char is compiled as a function call, but delete-region
|
|
|
847 ;; is byte-coded, so it's much faster. (We were spending 40% of our time
|
|
|
848 ;; in delete-char alone.)
|
|
|
849 (list 'delete-region '(point) (list '+ '(point) n)))
|
|
|
850
|
|
|
851 ;; Hint: BS stands form more things than "back space"
|
|
|
852 (defun Manual-nuke-nroff-bs (&optional apropos-mode)
|
|
|
853 (interactive "*")
|
|
76
|
854 (if Manual-use-rosetta-man
|
|
|
855 (call-process-region (point-min) (point-max) "rman" t t nil)
|
|
|
856 ;;
|
|
|
857 ;; turn underlining into italics
|
|
|
858 ;;
|
|
|
859 (goto-char (point-min))
|
|
|
860 (while (search-forward "_\b" nil t)
|
|
|
861 ;; searching for underscore-backspace and then comparing the following
|
|
|
862 ;; chars until the sequence ends turns out to be much faster than searching
|
|
|
863 ;; for a regexp which matches the whole sequence.
|
|
|
864 (let ((s (match-beginning 0)))
|
|
|
865 (goto-char s)
|
|
|
866 (while (and (= (following-char) ?_)
|
|
|
867 (= (char-after (1+ (point))) ?\b))
|
|
|
868 (Manual-delete-char 2)
|
|
|
869 (forward-char 1))
|
|
|
870 (set-extent-face (make-extent s (point)) 'man-italic)))
|
|
|
871 ;;
|
|
|
872 ;; turn overstriking into bold
|
|
|
873 ;;
|
|
|
874 (goto-char (point-min))
|
|
|
875 (while (re-search-forward "\\([^\n]\\)\\(\b\\1\\)" nil t)
|
|
|
876 ;; Surprisingly, searching for the above regexp is faster than searching
|
|
|
877 ;; for a backspace and then comparing the preceding and following chars,
|
|
|
878 ;; I presume because there are many false matches, meaning more funcalls
|
|
|
879 ;; to re-search-forward.
|
|
|
880 (let ((s (match-beginning 0)))
|
|
|
881 (goto-char s)
|
|
|
882 ;; Some systems (SGI) overstrike multiple times, eg, "M\bM\bM\bM".
|
|
|
883 (while (looking-at "\\([^\n]\\)\\(\b\\1\\)+")
|
|
|
884 (delete-region (+ (point) 1) (match-end 0))
|
|
|
885 (forward-char 1))
|
|
|
886 (set-extent-face (make-extent s (point)) 'man-bold)))
|
|
|
887 ;;
|
|
|
888 ;; hack bullets: o^H+ --> +
|
|
|
889 (goto-char (point-min))
|
|
|
890 (while (search-forward "\b" nil t)
|
|
|
891 (Manual-delete-char -2))
|
|
70
|
892
|
|
76
|
893 (if (> (buffer-size) 100) ; minor kludge
|
|
|
894 (Manual-nuke-nroff-bs-footers))
|
|
|
895 ) ;; not Manual-use-rosetta-man
|
|
74
|
896 ;;
|
|
|
897 ;; turn subsection header lines into bold
|
|
|
898 ;;
|
|
|
899 (goto-char (point-min))
|
|
|
900 (if apropos-mode
|
|
|
901 (while (re-search-forward "[a-zA-Z0-9] ([0-9]" nil t)
|
|
|
902 (forward-char -2)
|
|
|
903 (delete-backward-char 1))
|
|
70
|
904
|
|
74
|
905 ;; (while (re-search-forward "^[^ \t\n]" nil t)
|
|
|
906 ;; (set-extent-face (make-extent (match-beginning 0)
|
|
|
907 ;; (progn (end-of-line) (point)))
|
|
|
908 ;; 'man-heading))
|
|
72
|
909
|
|
74
|
910 ;; boldface the first line
|
|
|
911 (if (looking-at "[^ \t\n].*$")
|
|
|
912 (set-extent-face (make-extent (match-beginning 0) (match-end 0))
|
|
|
913 'man-bold))
|
|
70
|
914
|
|
74
|
915 ;; boldface subsequent title lines
|
|
|
916 ;; Regexp to match section headers changed to match a non-indented
|
|
|
917 ;; line preceded by a blank line and followed by an indented line.
|
|
|
918 ;; This seems to work ok for manual pages but gives better results
|
|
|
919 ;; with other nroff'd files
|
|
|
920 (while (re-search-forward "\n\n\\([^ \t\n].*\\)\n[ \t]+[^ \t\n]" nil t)
|
|
|
921 (goto-char (match-end 1))
|
|
|
922 (set-extent-face (make-extent (match-beginning 1) (match-end 1))
|
|
|
923 'man-heading)
|
|
|
924 (forward-line 1))
|
|
|
925 )
|
|
70
|
926
|
|
76
|
927 (if Manual-use-rosetta-man
|
|
|
928 nil
|
|
|
929 ;; Zap ESC7, ESC8, and ESC9
|
|
|
930 ;; This is for Sun man pages like "man 1 csh"
|
|
|
931 (goto-char (point-min))
|
|
|
932 (while (re-search-forward "\e[789]" nil t)
|
|
|
933 (replace-match "")))
|
|
|
934
|
|
74
|
935 ;; Nuke blanks lines at start.
|
|
|
936 ;; (goto-char (point-min))
|
|
|
937 ;; (skip-chars-forward "\n")
|
|
|
938 ;; (delete-region (point-min) (point))
|
|
|
939
|
|
|
940 (Manual-mouseify-xrefs)
|
|
|
941 )
|
|
|
942
|
|
|
943 (fset 'nuke-nroff-bs 'Manual-nuke-nroff-bs) ; use old name
|
|
|
944
|
|
70
|
945
|
|
74
|
946 (defun Manual-nuke-nroff-bs-footers ()
|
|
|
947 ;; Nuke headers and footers.
|
|
|
948 ;;
|
|
|
949 ;; nroff assumes pages are 66 lines high. We assume that, and that the
|
|
|
950 ;; first and last line on each page is expendible. There is no way to
|
|
|
951 ;; tell the difference between a page break in the middle of a paragraph
|
|
|
952 ;; and a page break between paragraphs (the amount of extra whitespace
|
|
|
953 ;; that nroff inserts is the same in both cases) so this might strip out
|
|
|
954 ;; a blank line were one should remain. I think that's better than
|
|
|
955 ;; leaving in a blank line where there shouldn't be one. (Need I say
|
|
|
956 ;; it: FMH.)
|
|
|
957 ;;
|
|
|
958 ;; Note that if nroff spits out error messages, pages will be more than
|
|
|
959 ;; 66 lines high, and we'll lose badly. That's ok because standard
|
|
|
960 ;; nroff doesn't do any diagnostics, and the "gnroff" wrapper for groff
|
|
|
961 ;; turns off error messages for compatibility. (At least, it's supposed
|
|
|
962 ;; to.)
|
|
|
963 ;;
|
|
|
964 (goto-char (point-min))
|
|
|
965 ;; first lose the status output
|
|
|
966 (let ((case-fold-search t))
|
|
|
967 (if (and (not (looking-at "[^\n]*warning"))
|
|
|
968 (looking-at "Reformatting.*\n"))
|
|
|
969 (delete-region (match-beginning 0) (match-end 0))))
|
|
72
|
970
|
|
74
|
971 ;; kludge around a groff bug where it won't keep quiet about some
|
|
|
972 ;; warnings even with -Wall or -Ww.
|
|
|
973 (cond ((looking-at "grotty:")
|
|
|
974 (while (looking-at "grotty:")
|
|
|
975 (delete-region (point) (progn (forward-line 1) (point))))
|
|
|
976 (if (looking-at " *done\n")
|
|
|
977 (delete-region (point) (match-end 0)))))
|
|
70
|
978
|
|
74
|
979 (let ((pages '())
|
|
|
980 p)
|
|
|
981 ;; collect the page boundary markers before we start deleting, to make
|
|
|
982 ;; it easier to strip things out without changing the page sizes.
|
|
|
983 (while (not (eobp))
|
|
|
984 (forward-line 66)
|
|
|
985 (setq pages (cons (point-marker) pages)))
|
|
|
986 (setq pages (nreverse pages))
|
|
|
987 (while pages
|
|
|
988 (goto-char (car pages))
|
|
|
989 (set-marker (car pages) nil)
|
|
|
990 ;;
|
|
|
991 ;; The lines are: 3 blank; footer; 6 blank; header; 3 blank.
|
|
|
992 ;; We're in between the previous footer and the following header,
|
|
|
993 ;;
|
|
|
994 ;; First lose 3 blank lines, the header, and then 3 more.
|
|
|
995 ;;
|
|
|
996 (setq p (point))
|
|
|
997 (skip-chars-forward "\n")
|
|
|
998 (delete-region p (point))
|
|
|
999 (and (looking-at "[^\n]+\n\n?\n?\n?")
|
|
|
1000 (delete-region (match-beginning 0) (match-end 0)))
|
|
|
1001 ;;
|
|
|
1002 ;; Next lose the footer, and the 3 blank lines after, and before it.
|
|
|
1003 ;; But don't lose the last footer of the manual entry; that contains
|
|
|
1004 ;; the "last change" date, so it's not completely uninteresting.
|
|
|
1005 ;; (Actually lose all blank lines before it; sh(1) needs this.)
|
|
|
1006 ;;
|
|
|
1007 (skip-chars-backward "\n")
|
|
|
1008 (beginning-of-line)
|
|
|
1009 (if (null (cdr pages))
|
|
|
1010 nil
|
|
|
1011 (and (looking-at "[^\n]+\n\n?\n?\n?")
|
|
|
1012 (delete-region (match-beginning 0) (match-end 0))))
|
|
|
1013 (setq p (point))
|
|
|
1014 (skip-chars-backward "\n")
|
|
|
1015 (if (> (- p (point)) 4)
|
|
|
1016 (delete-region (+ 2 (point)) p)
|
|
|
1017 (delete-region (1+ (point)) p))
|
|
|
1018 ; (and (looking-at "\n\n?\n?")
|
|
|
1019 ; (delete-region (match-beginning 0) (match-end 0)))
|
|
72
|
1020
|
|
74
|
1021 (setq pages (cdr pages)))
|
|
|
1022 ;;
|
|
|
1023 ;; Now nuke the extra blank lines at the beginning and end.
|
|
72
|
1024 (goto-char (point-min))
|
|
74
|
1025 (if (looking-at "\n+")
|
|
|
1026 (delete-region (match-beginning 0) (match-end 0)))
|
|
|
1027 (forward-line 1)
|
|
|
1028 (if (looking-at "\n\n+")
|
|
|
1029 (delete-region (1+ (match-beginning 0)) (match-end 0)))
|
|
|
1030 (goto-char (point-max))
|
|
|
1031 (skip-chars-backward "\n")
|
|
|
1032 (delete-region (point) (point-max))
|
|
|
1033 (beginning-of-line)
|
|
|
1034 (forward-char -1)
|
|
|
1035 (setq p (point))
|
|
|
1036 (skip-chars-backward "\n")
|
|
|
1037 (if (= ?\n (following-char)) (forward-char 1))
|
|
|
1038 (if (> (point) (1+ p))
|
|
|
1039 (delete-region (point) p))
|
|
72
|
1040 ))
|
|
|
1041
|
|
74
|
1042 ;(defun Manual-nuke-nroff-bs-footers ()
|
|
|
1043 ; ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)"
|
|
|
1044 ; (goto-char (point-min))
|
|
|
1045 ; (while (re-search-forward "^ *\\([A-Za-z][-_A-Za-z0-9]*([0-9A-Za-z]+)\\).*\\1$" nil t)
|
|
|
1046 ; (replace-match ""))
|
|
|
1047 ;
|
|
|
1048 ; ;;
|
|
|
1049 ; ;; it would appear that we have a choice between sometimes introducing
|
|
|
1050 ; ;; an extra blank line when a paragraph was broken by a footer, and
|
|
|
1051 ; ;; sometimes not putting in a blank line between two paragraphs when
|
|
|
1052 ; ;; a footer appeared right between them. FMH; I choose the latter.
|
|
|
1053 ; ;;
|
|
|
1054 ;
|
|
|
1055 ; ;; Nuke footers: "Printed 12/3/85 27 April 1981 1"
|
|
|
1056 ; ;; Sun appear to be on drugz:
|
|
|
1057 ; ;; "Sun Release 3.0B Last change: 1 February 1985 1"
|
|
|
1058 ; ;; HP are even worse!
|
|
|
1059 ; ;; " Hewlett-Packard -1- (printed 12/31/99)" FMHWA12ID!!
|
|
|
1060 ; ;; System V (well WICATs anyway):
|
|
|
1061 ; ;; "Page 1 (printed 7/24/85)"
|
|
|
1062 ; ;; Who is administering PCP to these corporate bozos?
|
|
|
1063 ; (goto-char (point-min))
|
|
|
1064 ; (while (re-search-forward
|
|
|
1065 ; (cond
|
|
|
1066 ; ((eq system-type 'hpux)
|
|
|
1067 ; "\n\n?[ \t]*Hewlett-Packard\\(\\| Company\\)[ \t]*- [0-9]* -.*\n")
|
|
|
1068 ; ((eq system-type 'dgux-unix)
|
|
|
1069 ; "\n\n?[ \t]*Licensed material--.*Page [0-9]*\n")
|
|
|
1070 ; ((eq system-type 'usg-unix-v)
|
|
|
1071 ; "\n\n? *Page [0-9]*.*(printed [0-9/]*)\n")
|
|
|
1072 ; (t
|
|
|
1073 ; "\n\n?\\(Printed\\|Sun Release\\) [0-9].*[0-9]\n"))
|
|
|
1074 ; nil t)
|
|
|
1075 ; (replace-match ""))
|
|
|
1076 ;
|
|
|
1077 ; ;; Also, hack X footers:
|
|
|
1078 ; ;; "X Version 11 Last change: Release 5 1"
|
|
|
1079 ; (goto-char (point-min))
|
|
|
1080 ; (while (re-search-forward "\n\n?X Version [^\n]+\n" nil t)
|
|
|
1081 ; (replace-match ""))
|
|
|
1082 ;
|
|
|
1083 ; ;; Crunch blank lines
|
|
|
1084 ; (goto-char (point-min))
|
|
|
1085 ; (while (re-search-forward "\n\n\n\n*" nil t)
|
|
|
1086 ; (replace-match "\n\n"))
|
|
|
1087 ; )
|
|
70
|
1088
|
|
74
|
1089 (defun Manual-mouseify-xrefs ()
|
|
|
1090 (goto-char (point-min))
|
|
|
1091 (forward-line 1)
|
|
|
1092 (let ((case-fold-search nil)
|
|
|
1093 s e name extent)
|
|
|
1094 ;; possibly it would be faster to rewrite this expression to search for
|
|
|
1095 ;; a less common sequence first (like "([0-9]") and then back up to see
|
|
|
1096 ;; if it's really a match. This function is 15% of the total time, 13%
|
|
|
1097 ;; of which is this call to re-search-forward.
|
|
|
1098 (while (re-search-forward "[a-zA-Z_][-a-zA-Z0-9_.]*([0-9][a-zA-Z0-9]*)"
|
|
|
1099 nil t)
|
|
|
1100 (setq s (match-beginning 0)
|
|
|
1101 e (match-end 0)
|
|
|
1102 name (buffer-substring s e))
|
|
|
1103 (goto-char s)
|
|
|
1104 (skip-chars-backward " \t")
|
|
|
1105 (if (and (bolp)
|
|
|
1106 (progn (backward-char 1) (= (preceding-char) ?-)))
|
|
|
1107 (progn
|
|
|
1108 (setq s (point))
|
|
|
1109 (skip-chars-backward "-a-zA-Z0-9_.")
|
|
|
1110 (setq name (concat (buffer-substring (point) (1- s)) name))
|
|
|
1111 (setq s (point))))
|
|
|
1112 ;; if there are upper case letters in the section, downcase them.
|
|
|
1113 (if (string-match "(.*[A-Z]+.*)$" name)
|
|
|
1114 (setq name (concat (substring name 0 (match-beginning 0))
|
|
|
1115 (downcase (substring name (match-beginning 0))))))
|
|
|
1116 ;; (setq already-fontified (extent-at s))
|
|
|
1117 (setq extent (make-extent s e))
|
|
|
1118 (set-extent-property extent 'man (list 'Manual-follow-xref name))
|
|
|
1119 (set-extent-property extent 'highlight t)
|
|
|
1120 ;; (if (not already-fontified)...
|
|
|
1121 (set-extent-face extent 'man-xref)
|
|
|
1122 (goto-char e))))
|
|
72
|
1123
|
|
74
|
1124 (defun Manual-follow-xref (&optional name-or-event)
|
|
|
1125 "Invoke `manual-entry' on the cross-reference under the mouse.
|
|
|
1126 When invoked noninteractively, the arg may be an xref string to parse instead."
|
|
|
1127 (interactive "e")
|
|
|
1128 (if (eventp name-or-event)
|
|
|
1129 (let* ((p (event-point name-or-event))
|
|
|
1130 (extent (and p (extent-at p
|
|
|
1131 (event-buffer name-or-event)
|
|
|
1132 'highlight)))
|
|
|
1133 (data (and extent (extent-property extent 'man))))
|
|
|
1134 (if (eq (car-safe data) 'Manual-follow-xref)
|
|
|
1135 (eval data)
|
|
|
1136 (error "no manual cross-reference there.")))
|
|
|
1137 (let ((Manual-match-topic-exactly t)
|
|
|
1138 (Manual-query-multiple-pages nil))
|
|
|
1139 (or (manual-entry name-or-event)
|
|
|
1140 ;; If that didn't work, maybe it's in a different section than the
|
|
|
1141 ;; man page writer expected. For example, man pages tend assume
|
|
|
1142 ;; that all user programs are in section 1, but X tends to generate
|
|
|
1143 ;; makefiles that put things in section "n" instead...
|
|
|
1144 (and (string-match "[ \t]*([^)]+)\\'" name-or-event)
|
|
|
1145 (progn
|
|
|
1146 (message "No entries found for %s; checking other sections..."
|
|
|
1147 name-or-event)
|
|
|
1148 (manual-entry
|
|
|
1149 (substring name-or-event 0 (match-beginning 0))
|
|
|
1150 nil t)))))))
|
|
72
|
1151
|
|
74
|
1152 (defun Manual-popup-menu (&optional event)
|
|
|
1153 "Pops up a menu of cross-references in this manual page.
|
|
|
1154 If there is a cross-reference under the mouse button which invoked this
|
|
|
1155 command, it will be the first item on the menu. Otherwise, they are
|
|
|
1156 on the menu in the order in which they appear in the buffer."
|
|
|
1157 (interactive "e")
|
|
|
1158 (let ((buffer (current-buffer))
|
|
|
1159 (sep "---")
|
|
|
1160 (prefix "Show Manual Page for ")
|
|
|
1161 xref items)
|
|
|
1162 (cond (event
|
|
|
1163 (setq buffer (event-buffer event))
|
|
|
1164 (let* ((p (event-point event))
|
|
|
1165 (extent (and p (extent-at p buffer 'highlight)))
|
|
|
1166 (data (and extent (extent-property extent 'man))))
|
|
|
1167 (if (eq (car-safe data) 'Manual-follow-xref)
|
|
|
1168 (setq xref (nth 1 data))))))
|
|
|
1169 (if xref (setq items (list sep xref)))
|
|
|
1170 (map-extents #'(lambda (extent ignore)
|
|
|
1171 (let ((data (extent-property extent 'man)))
|
|
|
1172 (if (and (eq (car-safe data) 'Manual-follow-xref)
|
|
|
1173 (not (member (nth 1 data) items)))
|
|
|
1174 (setq items (cons (nth 1 data) items)))
|
|
|
1175 nil))
|
|
|
1176 buffer)
|
|
|
1177 (if (eq sep (car items)) (setq items (cdr items)))
|
|
|
1178 (let ((popup-menu-titles nil))
|
|
|
1179 (popup-menu
|
|
|
1180 (cons "Manual Entry"
|
|
|
1181 (mapcar #'(lambda (item)
|
|
|
1182 (if (eq item sep)
|
|
|
1183 item
|
|
|
1184 (vector (concat prefix item)
|
|
|
1185 (list 'Manual-follow-xref item) t)))
|
|
|
1186 (nreverse items)))))))
|
|
70
|
1187
|
|
74
|
1188 (defun pager-cleanup-hook ()
|
|
|
1189 "cleanup man page if called via $PAGER"
|
|
|
1190 (let ((buf-name (or buffer-file-name (buffer-name))))
|
|
|
1191 (if (and (or (string-match "^/tmp/man[0-9]+" buf-name)
|
|
|
1192 (string-match ".*/man/\\(man\\|cat\\)[1-9a-z]/" buf-name))
|
|
|
1193 (not (string-match Manual-bogus-file-pattern buf-name)))
|
|
|
1194 (let (buffer manpage)
|
|
|
1195 (require 'man)
|
|
|
1196 (goto-char (point-min))
|
|
|
1197 (setq buffer-read-only nil)
|
|
|
1198 (Manual-nuke-nroff-bs)
|
|
|
1199 (goto-char (point-min))
|
|
|
1200 (if (re-search-forward "[^ \t]")
|
|
|
1201 (goto-char (- (point) 1)))
|
|
|
1202 (if (looking-at "\\([a-zA-Z0-9]+\\)[ \t]*(")
|
|
|
1203 (setq manpage (buffer-substring (match-beginning 1) (match-end 1)))
|
|
|
1204 (setq manpage "???"))
|
|
|
1205 (setq buffer
|
|
|
1206 (rename-buffer
|
|
|
1207 (generate-new-buffer-name (concat "*man " manpage "*"))))
|
|
|
1208 (setq buffer-file-name nil)
|
|
|
1209 (goto-char (point-min))
|
|
|
1210 (insert (format "%s\n" buf-name))
|
|
|
1211 (goto-char (point-min))
|
|
|
1212 (buffer-disable-undo buffer)
|
|
|
1213 (set-buffer-modified-p nil)
|
|
|
1214 (Manual-mode)
|
|
|
1215 ))))
|
|
4
|
1216
|
|
74
|
1217 (add-hook 'server-visit-hook 'pager-cleanup-hook)
|
|
72
|
1218 (provide 'man)
|
