Mercurial > emacs
annotate lisp/=man.el @ 31198:ce9e93f8341e
*** empty log message ***
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sun, 27 Aug 2000 02:09:36 +0000 |
parents | f287613dfc28 |
children |
rev | line source |
---|---|
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
474
diff
changeset
|
1 ;;; man.el --- read in and display parts of Unix manual. |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
474
diff
changeset
|
2 |
845 | 3 ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc. |
4 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
5 ;; Maintainer: FSF |
811
e694e0879463
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
807
diff
changeset
|
6 ;; Keywords: unix |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
7 |
58 | 8 ;; This file is part of GNU Emacs. |
9 | |
10 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 ;; it under the terms of the GNU General Public License as published by | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
12 ;; the Free Software Foundation; either version 2, or (at your option) |
58 | 13 ;; any later version. |
14 | |
15 ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 ;; GNU General Public License for more details. | |
19 | |
20 ;; You should have received a copy of the GNU General Public License | |
21 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
22 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
23 | |
2308
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1298
diff
changeset
|
24 ;;; Commentary: |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1298
diff
changeset
|
25 |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1298
diff
changeset
|
26 ;; This package provides an equivalent of the UNIX man(1) command within |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1298
diff
changeset
|
27 ;; Emacs. The single entry point is `manual-entry'. |
f287613dfc28
Added or corrected Commentary sections
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
1298
diff
changeset
|
28 |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
29 ;;; Code: |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
30 |
256 | 31 ;;;###autoload |
58 | 32 (defun manual-entry (topic &optional section) |
33 "Display the Unix manual entry for TOPIC. | |
34 TOPIC is either the title of the entry, or has the form TITLE(SECTION) | |
225
5ed62d0099e4
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
103
diff
changeset
|
35 where SECTION is the desired section of the manual, as in \"tty(4)\"." |
58 | 36 (interactive "sManual entry (topic): ") |
37 (if (= (length topic) 0) | |
38 (error "Must specify topic")) | |
39 (if (and (null section) | |
40 (string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic)) | |
41 (setq section (substring topic (match-beginning 2) | |
42 (match-end 2)) | |
43 topic (substring topic (match-beginning 1) | |
44 (match-end 1)))) | |
45 (with-output-to-temp-buffer (concat "*" topic " Manual Entry*") | |
46 (buffer-disable-undo standard-output) | |
47 (save-excursion | |
48 (set-buffer standard-output) | |
49 (message "Looking for formatted entry for %s%s..." | |
50 topic (if section (concat "(" section ")") "")) | |
51 (let ((dirlist manual-formatted-dirlist) | |
52 (case-fold-search nil) | |
53 name) | |
54 (if (and section (or (file-exists-p | |
55 (setq name (concat manual-formatted-dir-prefix | |
56 (substring section 0 1) | |
57 "/" | |
58 topic "." section))) | |
59 (file-exists-p | |
60 (setq name (concat manual-formatted-dir-prefix | |
61 section | |
62 "/" | |
63 topic "." section))))) | |
64 (insert-man-file name) | |
65 (while dirlist | |
66 (let* ((dir (car dirlist)) | |
67 (name1 (concat dir "/" topic "." | |
68 (or section | |
69 (substring | |
70 dir | |
71 (1+ (or (string-match "\\.[^./]*$" dir) | |
72 -2)))))) | |
73 completions) | |
74 (if (file-exists-p name1) | |
75 (insert-man-file name1) | |
76 (condition-case () | |
77 (progn | |
78 (setq completions (file-name-all-completions | |
79 (concat topic "." (or section "")) | |
80 dir)) | |
81 (while completions | |
82 (insert-man-file (concat dir "/" (car completions))) | |
83 (setq completions (cdr completions)))) | |
84 (file-error nil))) | |
85 (goto-char (point-max))) | |
86 (setq dirlist (cdr dirlist))))) | |
87 | |
88 (if (= (buffer-size) 0) | |
89 (progn | |
90 (message "No formatted entry, invoking man %s%s..." | |
91 (if section (concat section " ") "") topic) | |
92 (if section | |
93 (call-process manual-program nil t nil section topic) | |
94 (call-process manual-program nil t nil topic)) | |
95 (if (< (buffer-size) 80) | |
96 (progn | |
97 (goto-char (point-min)) | |
98 (end-of-line) | |
99 (error (buffer-substring 1 (point))))))) | |
100 | |
101 (message "Cleaning manual entry for %s..." topic) | |
102 (nuke-nroff-bs) | |
103 (set-buffer-modified-p nil) | |
104 (setq buffer-read-only t) | |
74 | 105 (view-mode nil 'bury-buffer) |
58 | 106 (message "")))) |
107 | |
225
5ed62d0099e4
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
103
diff
changeset
|
108 ;; Hint: BS stands for more things than "back space" |
58 | 109 (defun nuke-nroff-bs () |
110 (interactive "*") | |
111 ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)" | |
112 ;; We expext to find a footer just before the header except at the beginning. | |
113 (goto-char (point-min)) | |
114 (while (re-search-forward "^ *\\([A-Za-z][-_.A-Za-z0-9]*([0-9A-Z]+)\\).*\\1$" nil t) | |
115 (let (start end) | |
116 ;; Put START and END around footer and header and garbage blank lines. | |
117 ;; Fixed line counts are risky, but allow us to preserve | |
118 ;; significant blank lines. | |
1298
3a14fd87bade
(nuke-nroff-bs): Delete just 9 lines above header.
Richard M. Stallman <rms@gnu.org>
parents:
1296
diff
changeset
|
119 ;; These numbers are correct for MORE BSD, at least. |
3a14fd87bade
(nuke-nroff-bs): Delete just 9 lines above header.
Richard M. Stallman <rms@gnu.org>
parents:
1296
diff
changeset
|
120 (setq start (save-excursion (forward-line -9) (point))) |
1296
4d9550377364
(nuke-nroff-bs): Was nuking one line too many after header.
Richard M. Stallman <rms@gnu.org>
parents:
845
diff
changeset
|
121 (setq end (save-excursion (forward-line 3) (point))) |
58 | 122 (delete-region start end))) |
123 ;; Catch the final footer. | |
124 (goto-char (point-max)) | |
125 (delete-region (point) (save-excursion (forward-line -7) (point))) | |
126 | |
127 ;; Nuke underlining and overstriking (only by the same letter) | |
128 (goto-char (point-min)) | |
129 (while (search-forward "\b" nil t) | |
130 (let* ((preceding (char-after (- (point) 2))) | |
131 (following (following-char))) | |
132 (cond ((= preceding following) | |
133 ;; x\bx | |
134 (delete-char -2)) | |
103 | 135 ((and (= preceding ?o) (= following ?\+)) |
136 ;; o\b+ | |
137 (delete-char -2)) | |
58 | 138 ((= preceding ?\_) |
139 ;; _\b | |
140 (delete-char -2)) | |
141 ((= following ?\_) | |
142 ;; \b_ | |
143 (delete-region (1- (point)) (1+ (point))))))) | |
144 | |
145 ;; Zap ESC7, ESC8, and ESC9. | |
146 ;; This is for Sun man pages like "man 1 csh" | |
147 (goto-char (point-min)) | |
148 (while (re-search-forward "\e[789]" nil t) | |
149 (replace-match "")) | |
150 | |
474 | 151 ;; Convert o^H+ into o. |
152 (goto-char (point-min)) | |
153 (while (re-search-forward "o\010\\+" nil t) | |
154 (replace-match "o")) | |
155 | |
156 ;; Nuke the dumb reformatting message | |
157 (goto-char (point-min)) | |
158 (while (re-search-forward "Reformatting page. Wait... done\n\n" nil t) | |
159 (replace-match "")) | |
160 | |
58 | 161 ;; Crunch blank lines |
162 (goto-char (point-min)) | |
163 (while (re-search-forward "\n\n\n\n*" nil t) | |
164 (replace-match "\n\n")) | |
165 | |
166 ;; Nuke blanks lines at start. | |
167 (goto-char (point-min)) | |
168 (skip-chars-forward "\n") | |
169 (delete-region (point-min) (point))) | |
170 | |
171 | |
172 (defun insert-man-file (name) | |
173 ;; Insert manual file (unpacked as necessary) into buffer | |
174 (if (or (equal (substring name -2) ".Z") | |
175 (string-match "/cat[0-9][a-z]?\\.Z/" name)) | |
176 (call-process "zcat" name t nil) | |
177 (if (equal (substring name -2) ".z") | |
178 (call-process "pcat" nil t nil name) | |
179 (insert-file-contents name)))) | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
474
diff
changeset
|
180 |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
474
diff
changeset
|
181 ;;; man.el ends here |