Mercurial > emacs
annotate lisp/=man.el @ 1642:340feb030df1
*** empty log message ***
author | David J. MacKenzie <djm@gnu.org> |
---|---|
date | Thu, 26 Nov 1992 04:42:40 +0000 |
parents | 3a14fd87bade |
children | f287613dfc28 |
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 | |
807
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
24 ;;; Code: |
4f28bd14272c
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
659
diff
changeset
|
25 |
256 | 26 ;;;###autoload |
58 | 27 (defun manual-entry (topic &optional section) |
28 "Display the Unix manual entry for TOPIC. | |
29 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
|
30 where SECTION is the desired section of the manual, as in \"tty(4)\"." |
58 | 31 (interactive "sManual entry (topic): ") |
32 (if (= (length topic) 0) | |
33 (error "Must specify topic")) | |
34 (if (and (null section) | |
35 (string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic)) | |
36 (setq section (substring topic (match-beginning 2) | |
37 (match-end 2)) | |
38 topic (substring topic (match-beginning 1) | |
39 (match-end 1)))) | |
40 (with-output-to-temp-buffer (concat "*" topic " Manual Entry*") | |
41 (buffer-disable-undo standard-output) | |
42 (save-excursion | |
43 (set-buffer standard-output) | |
44 (message "Looking for formatted entry for %s%s..." | |
45 topic (if section (concat "(" section ")") "")) | |
46 (let ((dirlist manual-formatted-dirlist) | |
47 (case-fold-search nil) | |
48 name) | |
49 (if (and section (or (file-exists-p | |
50 (setq name (concat manual-formatted-dir-prefix | |
51 (substring section 0 1) | |
52 "/" | |
53 topic "." section))) | |
54 (file-exists-p | |
55 (setq name (concat manual-formatted-dir-prefix | |
56 section | |
57 "/" | |
58 topic "." section))))) | |
59 (insert-man-file name) | |
60 (while dirlist | |
61 (let* ((dir (car dirlist)) | |
62 (name1 (concat dir "/" topic "." | |
63 (or section | |
64 (substring | |
65 dir | |
66 (1+ (or (string-match "\\.[^./]*$" dir) | |
67 -2)))))) | |
68 completions) | |
69 (if (file-exists-p name1) | |
70 (insert-man-file name1) | |
71 (condition-case () | |
72 (progn | |
73 (setq completions (file-name-all-completions | |
74 (concat topic "." (or section "")) | |
75 dir)) | |
76 (while completions | |
77 (insert-man-file (concat dir "/" (car completions))) | |
78 (setq completions (cdr completions)))) | |
79 (file-error nil))) | |
80 (goto-char (point-max))) | |
81 (setq dirlist (cdr dirlist))))) | |
82 | |
83 (if (= (buffer-size) 0) | |
84 (progn | |
85 (message "No formatted entry, invoking man %s%s..." | |
86 (if section (concat section " ") "") topic) | |
87 (if section | |
88 (call-process manual-program nil t nil section topic) | |
89 (call-process manual-program nil t nil topic)) | |
90 (if (< (buffer-size) 80) | |
91 (progn | |
92 (goto-char (point-min)) | |
93 (end-of-line) | |
94 (error (buffer-substring 1 (point))))))) | |
95 | |
96 (message "Cleaning manual entry for %s..." topic) | |
97 (nuke-nroff-bs) | |
98 (set-buffer-modified-p nil) | |
99 (setq buffer-read-only t) | |
74 | 100 (view-mode nil 'bury-buffer) |
58 | 101 (message "")))) |
102 | |
225
5ed62d0099e4
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
103
diff
changeset
|
103 ;; Hint: BS stands for more things than "back space" |
58 | 104 (defun nuke-nroff-bs () |
105 (interactive "*") | |
106 ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)" | |
107 ;; We expext to find a footer just before the header except at the beginning. | |
108 (goto-char (point-min)) | |
109 (while (re-search-forward "^ *\\([A-Za-z][-_.A-Za-z0-9]*([0-9A-Z]+)\\).*\\1$" nil t) | |
110 (let (start end) | |
111 ;; Put START and END around footer and header and garbage blank lines. | |
112 ;; Fixed line counts are risky, but allow us to preserve | |
113 ;; significant blank lines. | |
1298
3a14fd87bade
(nuke-nroff-bs): Delete just 9 lines above header.
Richard M. Stallman <rms@gnu.org>
parents:
1296
diff
changeset
|
114 ;; 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
|
115 (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
|
116 (setq end (save-excursion (forward-line 3) (point))) |
58 | 117 (delete-region start end))) |
118 ;; Catch the final footer. | |
119 (goto-char (point-max)) | |
120 (delete-region (point) (save-excursion (forward-line -7) (point))) | |
121 | |
122 ;; Nuke underlining and overstriking (only by the same letter) | |
123 (goto-char (point-min)) | |
124 (while (search-forward "\b" nil t) | |
125 (let* ((preceding (char-after (- (point) 2))) | |
126 (following (following-char))) | |
127 (cond ((= preceding following) | |
128 ;; x\bx | |
129 (delete-char -2)) | |
103 | 130 ((and (= preceding ?o) (= following ?\+)) |
131 ;; o\b+ | |
132 (delete-char -2)) | |
58 | 133 ((= preceding ?\_) |
134 ;; _\b | |
135 (delete-char -2)) | |
136 ((= following ?\_) | |
137 ;; \b_ | |
138 (delete-region (1- (point)) (1+ (point))))))) | |
139 | |
140 ;; Zap ESC7, ESC8, and ESC9. | |
141 ;; This is for Sun man pages like "man 1 csh" | |
142 (goto-char (point-min)) | |
143 (while (re-search-forward "\e[789]" nil t) | |
144 (replace-match "")) | |
145 | |
474 | 146 ;; Convert o^H+ into o. |
147 (goto-char (point-min)) | |
148 (while (re-search-forward "o\010\\+" nil t) | |
149 (replace-match "o")) | |
150 | |
151 ;; Nuke the dumb reformatting message | |
152 (goto-char (point-min)) | |
153 (while (re-search-forward "Reformatting page. Wait... done\n\n" nil t) | |
154 (replace-match "")) | |
155 | |
58 | 156 ;; Crunch blank lines |
157 (goto-char (point-min)) | |
158 (while (re-search-forward "\n\n\n\n*" nil t) | |
159 (replace-match "\n\n")) | |
160 | |
161 ;; Nuke blanks lines at start. | |
162 (goto-char (point-min)) | |
163 (skip-chars-forward "\n") | |
164 (delete-region (point-min) (point))) | |
165 | |
166 | |
167 (defun insert-man-file (name) | |
168 ;; Insert manual file (unpacked as necessary) into buffer | |
169 (if (or (equal (substring name -2) ".Z") | |
170 (string-match "/cat[0-9][a-z]?\\.Z/" name)) | |
171 (call-process "zcat" name t nil) | |
172 (if (equal (substring name -2) ".z") | |
173 (call-process "pcat" nil t nil name) | |
174 (insert-file-contents name)))) | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
474
diff
changeset
|
175 |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
474
diff
changeset
|
176 ;;; man.el ends here |