![[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 [Apple XNU] / GNUtools / emacs / lisp|
Return to man.el CVS log | Up to [Apple XNU] / GNUtools / emacs / 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 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.0B 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))))
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.