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