![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to man.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to man.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp |
1.1 root 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 distributed in the hope that it will be useful,
7: ;; but WITHOUT ANY WARRANTY. No author or distributor
8: ;; accepts responsibility to anyone for the consequences of using it
9: ;; or for whether it serves any particular purpose or works at all,
10: ;; unless he says so in writing. Refer to the GNU Emacs General Public
11: ;; License for full details.
12:
13: ;; Everyone is granted permission to copy, modify and redistribute
14: ;; GNU Emacs, but only under the conditions described in the
15: ;; GNU Emacs General Public License. A copy of this license is
16: ;; supposed to have been given to you along with GNU Emacs so you
17: ;; can know your rights and responsibilities. It should be in a
18: ;; file named COPYING. Among other things, the copyright notice
19: ;; and this notice must be preserved on all copies.
20:
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)
24: where SECTION is the desired section of the manual, as in `tty(4)'."
25: (interactive "sManual entry (topic): ")
26: (if (and (null section)
27: (string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic))
28: (setq section (substring topic (match-beginning 2)
29: (match-end 2))
30: topic (substring topic (match-beginning 1)
31: (match-end 1))))
32: (with-output-to-temp-buffer "*Manual Entry*"
33: (buffer-flush-undo standard-output)
34: (save-excursion
35: (set-buffer standard-output)
36: (message "Looking for formatted entry for %s%s..."
37: topic (if section (concat "(" section ")") ""))
38: (let ((dirlist manual-formatted-dirlist)
39: (case-fold-search nil)
40: name)
41: (if (and section (or (file-exists-p
42: (setq name (concat manual-formatted-dir-prefix
43: (substring section 0 1)
44: "/"
45: topic "." section)))
46: (file-exists-p
47: (setq name (concat manual-formatted-dir-prefix
48: section
49: "/"
50: topic "." section)))))
51: (insert-man-file name)
52: (while dirlist
53: (let* ((dir (car dirlist))
54: (name1 (concat dir "/" topic "."
55: (or section
56: (substring
57: dir
58: (1+ (or (string-match "\\.[^./]*$" dir)
59: -2))))))
60: completions)
61: (if (file-exists-p name1)
62: (insert-man-file name1)
63: (condition-case ()
64: (progn
65: (setq completions (file-name-all-completions
66: (concat topic "." (or section ""))
67: dir))
68: (while completions
69: (insert-man-file (concat dir "/" (car completions)))
70: (setq completions (cdr completions))))
71: (file-error nil)))
72: (goto-char (point-max)))
73: (setq dirlist (cdr dirlist)))))
74:
75: (if (= (buffer-size) 0)
76: (progn
77: (message "No formatted entry, invoking man %s%s..."
78: (if section (concat section " ") "") topic)
79: (if section
80: (call-process manual-program nil t nil section topic)
81: (call-process manual-program nil t nil topic))
82: (if (< (buffer-size) 80)
83: (progn
84: (goto-char (point-min))
85: (end-of-line)
86: (error (buffer-substring 1 (point)))))))
87:
88: (message "Cleaning manual entry for %s..." topic)
89: (nuke-nroff-bs)
90: (set-buffer-modified-p nil)
91: (message ""))))
92:
93: ;; Hint: BS stands form more things than "back space"
94: (defun nuke-nroff-bs ()
95: (interactive "*")
96: ;; Nuke underlining and overstriking (only by the same letter)
97: (goto-char (point-min))
98: (while (search-forward "\b" nil t)
99: (let* ((preceding (char-after (- (point) 2)))
100: (following (following-char)))
101: (cond ((= preceding following)
102: ;; x\bx
103: (delete-char -2))
104: ((= preceding ?\_)
105: ;; _\b
106: (delete-char -2))
107: ((= following ?\_)
108: ;; \b_
109: (delete-region (1- (point)) (1+ (point)))))))
110:
111: ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)"
112: (goto-char (point-min))
113: (while (re-search-forward "^ *\\([A-Za-z][-_A-Za-z0-9]*([0-9A-Z]+)\\).*\\1$" nil t)
114: (replace-match ""))
115:
116: ;; Nuke footers: "Printed 12/3/85 27 April 1981 1"
117: ;; Sun appear to be on drugz:
118: ;; "Sun Release 3.0B Last change: 1 February 1985 1"
119: ;; HP are even worse!
120: ;; " Hewlett-Packard -1- (printed 12/31/99)" FMHWA12ID!!
121: ;; System V (well WICATs anyway):
122: ;; "Page 1 (printed 7/24/85)"
123: ;; Who is administering PCP to these corporate bozos?
124: (goto-char (point-min))
125: (while (re-search-forward
126: (cond ((eq system-type 'hpux)
127: "^[ \t]*Hewlett-Packard\\(\\| Company\\)[ \t]*- [0-9]* -.*$")
128: ((eq system-type 'usg-unix-v)
129: "^ *Page [0-9]*.*(printed [0-9/]*)$")
130: (t
131: "^\\(Printed\\|Sun Release\\) [0-9].*[0-9]$"))
132: nil t)
133: (replace-match ""))
134:
135: ;; Crunch blank lines
136: (goto-char (point-min))
137: (while (re-search-forward "\n\n\n\n*" nil t)
138: (replace-match "\n\n"))
139:
140: ;; Nuke blanks lines at start.
141: (goto-char (point-min))
142: (skip-chars-forward "\n")
143: (delete-region (point-min) (point)))
144:
145:
146: (defun insert-man-file (name)
147: ;; Insert manual file (unpacked as necessary) into buffer
148: (if (or (equal (substring name -2) ".Z")
149: (string-match "/cat[0-9][a-z]?\\.Z/" name))
150: (call-process "zcat" name t nil)
151: (if (equal (substring name -2) ".z")
152: (call-process "pcat" nil t nil name)
153: (insert-file-contents name))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.