Mercurial > emacs
annotate lisp/=man.el @ 1123:55e605674fb1
* window.c (minibuffer_window): Accept an optional FRAME argument;
if specified, return the minibuffer used by that frame.
* window.c (Fset_window_configuration): Don't signal an error
if the frame size saved in the window configuration doesn't
match the frame's current size; instead, temporarily resize
the frame while installing the window configuration. This is
important because using the minibuffer saves and restores the
current window configuration, and you don't want to signal an
error just because the user resized the frame while using the
minibuffer.
author | Jim Blandy <jimb@redhat.com> |
---|---|
date | Sun, 13 Sep 1992 12:38:21 +0000 |
parents | 213978acbc1e |
children | 4d9550377364 |
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. | |
114 (setq start (save-excursion (forward-line -10) (point))) | |
115 (setq end (save-excursion (forward-line 4) (point))) | |
116 (delete-region start end))) | |
117 ;; Catch the final footer. | |
118 (goto-char (point-max)) | |
119 (delete-region (point) (save-excursion (forward-line -7) (point))) | |
120 | |
121 ;; Nuke underlining and overstriking (only by the same letter) | |
122 (goto-char (point-min)) | |
123 (while (search-forward "\b" nil t) | |
124 (let* ((preceding (char-after (- (point) 2))) | |
125 (following (following-char))) | |
126 (cond ((= preceding following) | |
127 ;; x\bx | |
128 (delete-char -2)) | |
103 | 129 ((and (= preceding ?o) (= following ?\+)) |
130 ;; o\b+ | |
131 (delete-char -2)) | |
58 | 132 ((= preceding ?\_) |
133 ;; _\b | |
134 (delete-char -2)) | |
135 ((= following ?\_) | |
136 ;; \b_ | |
137 (delete-region (1- (point)) (1+ (point))))))) | |
138 | |
139 ;; Zap ESC7, ESC8, and ESC9. | |
140 ;; This is for Sun man pages like "man 1 csh" | |
141 (goto-char (point-min)) | |
142 (while (re-search-forward "\e[789]" nil t) | |
143 (replace-match "")) | |
144 | |
474 | 145 ;; Convert o^H+ into o. |
146 (goto-char (point-min)) | |
147 (while (re-search-forward "o\010\\+" nil t) | |
148 (replace-match "o")) | |
149 | |
150 ;; Nuke the dumb reformatting message | |
151 (goto-char (point-min)) | |
152 (while (re-search-forward "Reformatting page. Wait... done\n\n" nil t) | |
153 (replace-match "")) | |
154 | |
58 | 155 ;; Crunch blank lines |
156 (goto-char (point-min)) | |
157 (while (re-search-forward "\n\n\n\n*" nil t) | |
158 (replace-match "\n\n")) | |
159 | |
160 ;; Nuke blanks lines at start. | |
161 (goto-char (point-min)) | |
162 (skip-chars-forward "\n") | |
163 (delete-region (point-min) (point))) | |
164 | |
165 | |
166 (defun insert-man-file (name) | |
167 ;; Insert manual file (unpacked as necessary) into buffer | |
168 (if (or (equal (substring name -2) ".Z") | |
169 (string-match "/cat[0-9][a-z]?\\.Z/" name)) | |
170 (call-process "zcat" name t nil) | |
171 (if (equal (substring name -2) ".z") | |
172 (call-process "pcat" nil t nil name) | |
173 (insert-file-contents name)))) | |
659
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
474
diff
changeset
|
174 |
505130d1ddf8
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
474
diff
changeset
|
175 ;;; man.el ends here |