Commit | Line | Data |
---|---|---|
1a20f48d JA |
1 | ;; Read in and display parts of Unix manual. |
2 | ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc. | |
3 | ||
4 | ;; This file is part of GNU Emacs. | |
5 | ||
6 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
7 | ;; it under the terms of the GNU General Public License as published by | |
8 | ;; the Free Software Foundation; either version 1, or (at your option) | |
9 | ;; any later version. | |
10 | ||
11 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
12 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;; GNU General Public License for more details. | |
15 | ||
16 | ;; You should have received a copy of the GNU General Public License | |
17 | ;; along with GNU Emacs; see the file COPYING. If not, write to | |
18 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
19 | ||
7229064d | 20 | ;;;###autoload |
1a20f48d JA |
21 | (defun manual-entry (topic &optional section) |
22 | "Display the Unix manual entry for TOPIC. | |
23 | TOPIC is either the title of the entry, or has the form TITLE(SECTION) | |
1d409421 | 24 | where SECTION is the desired section of the manual, as in \"tty(4)\"." |
1a20f48d JA |
25 | (interactive "sManual entry (topic): ") |
26 | (if (= (length topic) 0) | |
27 | (error "Must specify topic")) | |
28 | (if (and (null section) | |
29 | (string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic)) | |
30 | (setq section (substring topic (match-beginning 2) | |
31 | (match-end 2)) | |
32 | topic (substring topic (match-beginning 1) | |
33 | (match-end 1)))) | |
34 | (with-output-to-temp-buffer (concat "*" topic " Manual Entry*") | |
35 | (buffer-disable-undo standard-output) | |
36 | (save-excursion | |
37 | (set-buffer standard-output) | |
38 | (message "Looking for formatted entry for %s%s..." | |
39 | topic (if section (concat "(" section ")") "")) | |
40 | (let ((dirlist manual-formatted-dirlist) | |
41 | (case-fold-search nil) | |
42 | name) | |
43 | (if (and section (or (file-exists-p | |
44 | (setq name (concat manual-formatted-dir-prefix | |
45 | (substring section 0 1) | |
46 | "/" | |
47 | topic "." section))) | |
48 | (file-exists-p | |
49 | (setq name (concat manual-formatted-dir-prefix | |
50 | section | |
51 | "/" | |
52 | topic "." section))))) | |
53 | (insert-man-file name) | |
54 | (while dirlist | |
55 | (let* ((dir (car dirlist)) | |
56 | (name1 (concat dir "/" topic "." | |
57 | (or section | |
58 | (substring | |
59 | dir | |
60 | (1+ (or (string-match "\\.[^./]*$" dir) | |
61 | -2)))))) | |
62 | completions) | |
63 | (if (file-exists-p name1) | |
64 | (insert-man-file name1) | |
65 | (condition-case () | |
66 | (progn | |
67 | (setq completions (file-name-all-completions | |
68 | (concat topic "." (or section "")) | |
69 | dir)) | |
70 | (while completions | |
71 | (insert-man-file (concat dir "/" (car completions))) | |
72 | (setq completions (cdr completions)))) | |
73 | (file-error nil))) | |
74 | (goto-char (point-max))) | |
75 | (setq dirlist (cdr dirlist))))) | |
76 | ||
77 | (if (= (buffer-size) 0) | |
78 | (progn | |
79 | (message "No formatted entry, invoking man %s%s..." | |
80 | (if section (concat section " ") "") topic) | |
81 | (if section | |
82 | (call-process manual-program nil t nil section topic) | |
83 | (call-process manual-program nil t nil topic)) | |
84 | (if (< (buffer-size) 80) | |
85 | (progn | |
86 | (goto-char (point-min)) | |
87 | (end-of-line) | |
88 | (error (buffer-substring 1 (point))))))) | |
89 | ||
90 | (message "Cleaning manual entry for %s..." topic) | |
91 | (nuke-nroff-bs) | |
92 | (set-buffer-modified-p nil) | |
93 | (setq buffer-read-only t) | |
f65866ca | 94 | (view-mode nil 'bury-buffer) |
1a20f48d JA |
95 | (message "")))) |
96 | ||
1d409421 | 97 | ;; Hint: BS stands for more things than "back space" |
1a20f48d JA |
98 | (defun nuke-nroff-bs () |
99 | (interactive "*") | |
100 | ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)" | |
101 | ;; We expext to find a footer just before the header except at the beginning. | |
102 | (goto-char (point-min)) | |
103 | (while (re-search-forward "^ *\\([A-Za-z][-_.A-Za-z0-9]*([0-9A-Z]+)\\).*\\1$" nil t) | |
104 | (let (start end) | |
105 | ;; Put START and END around footer and header and garbage blank lines. | |
106 | ;; Fixed line counts are risky, but allow us to preserve | |
107 | ;; significant blank lines. | |
108 | (setq start (save-excursion (forward-line -10) (point))) | |
109 | (setq end (save-excursion (forward-line 4) (point))) | |
110 | (delete-region start end))) | |
111 | ;; Catch the final footer. | |
112 | (goto-char (point-max)) | |
113 | (delete-region (point) (save-excursion (forward-line -7) (point))) | |
114 | ||
115 | ;; Nuke underlining and overstriking (only by the same letter) | |
116 | (goto-char (point-min)) | |
117 | (while (search-forward "\b" nil t) | |
118 | (let* ((preceding (char-after (- (point) 2))) | |
119 | (following (following-char))) | |
120 | (cond ((= preceding following) | |
121 | ;; x\bx | |
122 | (delete-char -2)) | |
8c59783a RS |
123 | ((and (= preceding ?o) (= following ?\+)) |
124 | ;; o\b+ | |
125 | (delete-char -2)) | |
1a20f48d JA |
126 | ((= preceding ?\_) |
127 | ;; _\b | |
128 | (delete-char -2)) | |
129 | ((= following ?\_) | |
130 | ;; \b_ | |
131 | (delete-region (1- (point)) (1+ (point))))))) | |
132 | ||
133 | ;; Zap ESC7, ESC8, and ESC9. | |
134 | ;; This is for Sun man pages like "man 1 csh" | |
135 | (goto-char (point-min)) | |
136 | (while (re-search-forward "\e[789]" nil t) | |
137 | (replace-match "")) | |
138 | ||
139 | ;; Crunch blank lines | |
140 | (goto-char (point-min)) | |
141 | (while (re-search-forward "\n\n\n\n*" nil t) | |
142 | (replace-match "\n\n")) | |
143 | ||
144 | ;; Nuke blanks lines at start. | |
145 | (goto-char (point-min)) | |
146 | (skip-chars-forward "\n") | |
147 | (delete-region (point-min) (point))) | |
148 | ||
149 | ||
150 | (defun insert-man-file (name) | |
151 | ;; Insert manual file (unpacked as necessary) into buffer | |
152 | (if (or (equal (substring name -2) ".Z") | |
153 | (string-match "/cat[0-9][a-z]?\\.Z/" name)) | |
154 | (call-process "zcat" name t nil) | |
155 | (if (equal (substring name -2) ".z") | |
156 | (call-process "pcat" nil t nil name) | |
157 | (insert-file-contents name)))) |