58
|
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 (= (length topic) 0)
|
|
26 (error "Must specify topic"))
|
|
27 (if (and (null section)
|
|
28 (string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic))
|
|
29 (setq section (substring topic (match-beginning 2)
|
|
30 (match-end 2))
|
|
31 topic (substring topic (match-beginning 1)
|
|
32 (match-end 1))))
|
|
33 (with-output-to-temp-buffer (concat "*" topic " Manual Entry*")
|
|
34 (buffer-disable-undo standard-output)
|
|
35 (save-excursion
|
|
36 (set-buffer standard-output)
|
|
37 (message "Looking for formatted entry for %s%s..."
|
|
38 topic (if section (concat "(" section ")") ""))
|
|
39 (let ((dirlist manual-formatted-dirlist)
|
|
40 (case-fold-search nil)
|
|
41 name)
|
|
42 (if (and section (or (file-exists-p
|
|
43 (setq name (concat manual-formatted-dir-prefix
|
|
44 (substring section 0 1)
|
|
45 "/"
|
|
46 topic "." section)))
|
|
47 (file-exists-p
|
|
48 (setq name (concat manual-formatted-dir-prefix
|
|
49 section
|
|
50 "/"
|
|
51 topic "." section)))))
|
|
52 (insert-man-file name)
|
|
53 (while dirlist
|
|
54 (let* ((dir (car dirlist))
|
|
55 (name1 (concat dir "/" topic "."
|
|
56 (or section
|
|
57 (substring
|
|
58 dir
|
|
59 (1+ (or (string-match "\\.[^./]*$" dir)
|
|
60 -2))))))
|
|
61 completions)
|
|
62 (if (file-exists-p name1)
|
|
63 (insert-man-file name1)
|
|
64 (condition-case ()
|
|
65 (progn
|
|
66 (setq completions (file-name-all-completions
|
|
67 (concat topic "." (or section ""))
|
|
68 dir))
|
|
69 (while completions
|
|
70 (insert-man-file (concat dir "/" (car completions)))
|
|
71 (setq completions (cdr completions))))
|
|
72 (file-error nil)))
|
|
73 (goto-char (point-max)))
|
|
74 (setq dirlist (cdr dirlist)))))
|
|
75
|
|
76 (if (= (buffer-size) 0)
|
|
77 (progn
|
|
78 (message "No formatted entry, invoking man %s%s..."
|
|
79 (if section (concat section " ") "") topic)
|
|
80 (if section
|
|
81 (call-process manual-program nil t nil section topic)
|
|
82 (call-process manual-program nil t nil topic))
|
|
83 (if (< (buffer-size) 80)
|
|
84 (progn
|
|
85 (goto-char (point-min))
|
|
86 (end-of-line)
|
|
87 (error (buffer-substring 1 (point)))))))
|
|
88
|
|
89 (message "Cleaning manual entry for %s..." topic)
|
|
90 (nuke-nroff-bs)
|
|
91 (set-buffer-modified-p nil)
|
|
92 (setq buffer-read-only t)
|
74
|
93 (view-mode nil 'bury-buffer)
|
58
|
94 (message ""))))
|
|
95
|
|
96 ;; Hint: BS stands form more things than "back space"
|
|
97 (defun nuke-nroff-bs ()
|
|
98 (interactive "*")
|
|
99 ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)"
|
|
100 ;; We expext to find a footer just before the header except at the beginning.
|
|
101 (goto-char (point-min))
|
|
102 (while (re-search-forward "^ *\\([A-Za-z][-_.A-Za-z0-9]*([0-9A-Z]+)\\).*\\1$" nil t)
|
|
103 (let (start end)
|
|
104 ;; Put START and END around footer and header and garbage blank lines.
|
|
105 ;; Fixed line counts are risky, but allow us to preserve
|
|
106 ;; significant blank lines.
|
|
107 (setq start (save-excursion (forward-line -10) (point)))
|
|
108 (setq end (save-excursion (forward-line 4) (point)))
|
|
109 (delete-region start end)))
|
|
110 ;; Catch the final footer.
|
|
111 (goto-char (point-max))
|
|
112 (delete-region (point) (save-excursion (forward-line -7) (point)))
|
|
113
|
|
114 ;; Nuke underlining and overstriking (only by the same letter)
|
|
115 (goto-char (point-min))
|
|
116 (while (search-forward "\b" nil t)
|
|
117 (let* ((preceding (char-after (- (point) 2)))
|
|
118 (following (following-char)))
|
|
119 (cond ((= preceding following)
|
|
120 ;; x\bx
|
|
121 (delete-char -2))
|
103
|
122 ((and (= preceding ?o) (= following ?\+))
|
|
123 ;; o\b+
|
|
124 (delete-char -2))
|
58
|
125 ((= preceding ?\_)
|
|
126 ;; _\b
|
|
127 (delete-char -2))
|
|
128 ((= following ?\_)
|
|
129 ;; \b_
|
|
130 (delete-region (1- (point)) (1+ (point)))))))
|
|
131
|
|
132 ;; Zap ESC7, ESC8, and ESC9.
|
|
133 ;; This is for Sun man pages like "man 1 csh"
|
|
134 (goto-char (point-min))
|
|
135 (while (re-search-forward "\e[789]" nil t)
|
|
136 (replace-match ""))
|
|
137
|
|
138 ;; Crunch blank lines
|
|
139 (goto-char (point-min))
|
|
140 (while (re-search-forward "\n\n\n\n*" nil t)
|
|
141 (replace-match "\n\n"))
|
|
142
|
|
143 ;; Nuke blanks lines at start.
|
|
144 (goto-char (point-min))
|
|
145 (skip-chars-forward "\n")
|
|
146 (delete-region (point-min) (point)))
|
|
147
|
|
148
|
|
149 (defun insert-man-file (name)
|
|
150 ;; Insert manual file (unpacked as necessary) into buffer
|
|
151 (if (or (equal (substring name -2) ".Z")
|
|
152 (string-match "/cat[0-9][a-z]?\\.Z/" name))
|
|
153 (call-process "zcat" name t nil)
|
|
154 (if (equal (substring name -2) ".z")
|
|
155 (call-process "pcat" nil t nil name)
|
|
156 (insert-file-contents name))))
|