Commit | Line | Data |
---|---|---|
481fa7aa C |
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 | ||
20 | (defun manual-entry (topic &optional section) | |
21 | "Display the Unix manual entry for TOPIC. | |
22 | TOPIC is either the title of the entry, or has the form TITLE(SECTION) | |
23 | where SECTION is the desired section of the manual, as in `tty(4)'." | |
24 | (interactive "sManual entry (topic): ") | |
25 | (if (and (null section) | |
26 | (string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic)) | |
27 | (setq section (substring topic (match-beginning 2) | |
28 | (match-end 2)) | |
29 | topic (substring topic (match-beginning 1) | |
30 | (match-end 1)))) | |
31 | (with-output-to-temp-buffer "*Manual Entry*" | |
32 | (buffer-flush-undo standard-output) | |
33 | (save-excursion | |
34 | (set-buffer standard-output) | |
35 | (message "Looking for formatted entry for %s%s..." | |
36 | topic (if section (concat "(" section ")") "")) | |
37 | (let ((dirlist manual-formatted-dirlist) | |
38 | (case-fold-search nil) | |
39 | name) | |
40 | (if (and section (or (file-exists-p | |
41 | (setq name (concat manual-formatted-dir-prefix | |
42 | (substring section 0 1) | |
43 | "/" | |
44 | topic "." section))) | |
45 | (file-exists-p | |
46 | (setq name (concat manual-formatted-dir-prefix | |
47 | section | |
48 | "/" | |
49 | topic "." section))))) | |
50 | (insert-man-file name) | |
51 | (while dirlist | |
52 | (let* ((dir (car dirlist)) | |
53 | (name1 (concat dir "/" topic "." | |
54 | (or section | |
55 | (substring | |
56 | dir | |
57 | (1+ (or (string-match "\\.[^./]*$" dir) | |
58 | -2)))))) | |
59 | completions) | |
60 | (if (file-exists-p name1) | |
61 | (insert-man-file name1) | |
62 | (condition-case () | |
63 | (progn | |
64 | (setq completions (file-name-all-completions | |
65 | (concat topic "." (or section "")) | |
66 | dir)) | |
67 | (while completions | |
68 | (insert-man-file (concat dir "/" (car completions))) | |
69 | (setq completions (cdr completions)))) | |
70 | (file-error nil))) | |
71 | (goto-char (point-max))) | |
72 | (setq dirlist (cdr dirlist))))) | |
73 | ||
74 | (if (= (buffer-size) 0) | |
75 | (progn | |
76 | (message "No formatted entry, invoking man %s%s..." | |
77 | (if section (concat section " ") "") topic) | |
78 | (if section | |
79 | (call-process manual-program nil t nil section topic) | |
80 | (call-process manual-program nil t nil topic)) | |
81 | (if (< (buffer-size) 80) | |
82 | (progn | |
83 | (goto-char (point-min)) | |
84 | (end-of-line) | |
85 | (error (buffer-substring 1 (point))))))) | |
86 | ||
87 | (message "Cleaning manual entry for %s..." topic) | |
88 | (nuke-nroff-bs) | |
89 | (set-buffer-modified-p nil) | |
90 | (message "")))) | |
91 | ||
92 | ;; Hint: BS stands form more things than "back space" | |
93 | (defun nuke-nroff-bs () | |
94 | (interactive "*") | |
95 | ;; Nuke underlining and overstriking (only by the same letter) | |
96 | (goto-char (point-min)) | |
97 | (while (search-forward "\b" nil t) | |
98 | (let* ((preceding (char-after (- (point) 2))) | |
99 | (following (following-char))) | |
100 | (cond ((= preceding following) | |
101 | ;; x\bx | |
102 | (delete-char -2)) | |
103 | ((= preceding ?\_) | |
104 | ;; _\b | |
105 | (delete-char -2)) | |
106 | ((= following ?\_) | |
107 | ;; \b_ | |
108 | (delete-region (1- (point)) (1+ (point))))))) | |
109 | ||
110 | ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)" | |
111 | (goto-char (point-min)) | |
112 | (while (re-search-forward "^ *\\([A-Za-z][-_A-Za-z0-9]*([0-9A-Z]+)\\).*\\1$" nil t) | |
113 | (replace-match "")) | |
114 | ||
115 | ;; Nuke footers: "Printed 12/3/85 27 April 1981 1" | |
116 | ;; Sun appear to be on drugz: | |
117 | ;; "Sun Release 3.0\ eB\ f Last change: 1 February 1985 1" | |
118 | ;; HP are even worse! | |
119 | ;; " Hewlett-Packard -1- (printed 12/31/99)" FMHWA12ID!! | |
120 | ;; System V (well WICATs anyway): | |
121 | ;; "Page 1 (printed 7/24/85)" | |
122 | ;; Who is administering PCP to these corporate bozos? | |
123 | (goto-char (point-min)) | |
124 | (while (re-search-forward | |
125 | (cond ((eq system-type 'hpux) | |
126 | "^[ \t]*Hewlett-Packard\\(\\| Company\\)[ \t]*- [0-9]* -.*$") | |
127 | ((eq system-type 'usg-unix-v) | |
128 | "^ *Page [0-9]*.*(printed [0-9/]*)$") | |
129 | (t | |
130 | "^\\(Printed\\|Sun Release\\) [0-9].*[0-9]$")) | |
131 | nil t) | |
132 | (replace-match "")) | |
133 | ||
134 | ;; Crunch blank lines | |
135 | (goto-char (point-min)) | |
136 | (while (re-search-forward "\n\n\n\n*" nil t) | |
137 | (replace-match "\n\n")) | |
138 | ||
139 | ;; Nuke blanks lines at start. | |
140 | (goto-char (point-min)) | |
141 | (skip-chars-forward "\n") | |
142 | (delete-region (point-min) (point))) | |
143 | ||
144 | ||
145 | (defun insert-man-file (name) | |
146 | ;; Insert manual file (unpacked as necessary) into buffer | |
147 | (if (or (equal (substring name -2) ".Z") | |
148 | (string-match "/cat[0-9][a-z]?\\.Z/" name)) | |
149 | (call-process "zcat" name t nil) | |
150 | (if (equal (substring name -2) ".z") | |
151 | (call-process "pcat" nil t nil name) | |
152 | (insert-file-contents name)))) |