Initial revision
This commit is contained in:
Joseph Arceneaux
parent
4bf7f5d128
commit
1a20f48da0
1 changed files with 152 additions and 0 deletions
152
lisp/man.el
Normal file
152
lisp/man.el
Normal file
|
|
@ -0,0 +1,152 @@
|
|||
;; Read in and display parts of Unix manual.
|
||||
;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software; you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation; either version 1, or (at your option)
|
||||
;; any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||
|
||||
(defun manual-entry (topic &optional section)
|
||||
"Display the Unix manual entry for TOPIC.
|
||||
TOPIC is either the title of the entry, or has the form TITLE(SECTION)
|
||||
where SECTION is the desired section of the manual, as in `tty(4)'."
|
||||
(interactive "sManual entry (topic): ")
|
||||
(if (= (length topic) 0)
|
||||
(error "Must specify topic"))
|
||||
(if (and (null section)
|
||||
(string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic))
|
||||
(setq section (substring topic (match-beginning 2)
|
||||
(match-end 2))
|
||||
topic (substring topic (match-beginning 1)
|
||||
(match-end 1))))
|
||||
(with-output-to-temp-buffer (concat "*" topic " Manual Entry*")
|
||||
(buffer-disable-undo standard-output)
|
||||
(save-excursion
|
||||
(set-buffer standard-output)
|
||||
(message "Looking for formatted entry for %s%s..."
|
||||
topic (if section (concat "(" section ")") ""))
|
||||
(let ((dirlist manual-formatted-dirlist)
|
||||
(case-fold-search nil)
|
||||
name)
|
||||
(if (and section (or (file-exists-p
|
||||
(setq name (concat manual-formatted-dir-prefix
|
||||
(substring section 0 1)
|
||||
"/"
|
||||
topic "." section)))
|
||||
(file-exists-p
|
||||
(setq name (concat manual-formatted-dir-prefix
|
||||
section
|
||||
"/"
|
||||
topic "." section)))))
|
||||
(insert-man-file name)
|
||||
(while dirlist
|
||||
(let* ((dir (car dirlist))
|
||||
(name1 (concat dir "/" topic "."
|
||||
(or section
|
||||
(substring
|
||||
dir
|
||||
(1+ (or (string-match "\\.[^./]*$" dir)
|
||||
-2))))))
|
||||
completions)
|
||||
(if (file-exists-p name1)
|
||||
(insert-man-file name1)
|
||||
(condition-case ()
|
||||
(progn
|
||||
(setq completions (file-name-all-completions
|
||||
(concat topic "." (or section ""))
|
||||
dir))
|
||||
(while completions
|
||||
(insert-man-file (concat dir "/" (car completions)))
|
||||
(setq completions (cdr completions))))
|
||||
(file-error nil)))
|
||||
(goto-char (point-max)))
|
||||
(setq dirlist (cdr dirlist)))))
|
||||
|
||||
(if (= (buffer-size) 0)
|
||||
(progn
|
||||
(message "No formatted entry, invoking man %s%s..."
|
||||
(if section (concat section " ") "") topic)
|
||||
(if section
|
||||
(call-process manual-program nil t nil section topic)
|
||||
(call-process manual-program nil t nil topic))
|
||||
(if (< (buffer-size) 80)
|
||||
(progn
|
||||
(goto-char (point-min))
|
||||
(end-of-line)
|
||||
(error (buffer-substring 1 (point)))))))
|
||||
|
||||
(message "Cleaning manual entry for %s..." topic)
|
||||
(nuke-nroff-bs)
|
||||
(set-buffer-modified-p nil)
|
||||
(setq buffer-read-only t)
|
||||
(message ""))))
|
||||
|
||||
;; Hint: BS stands form more things than "back space"
|
||||
(defun nuke-nroff-bs ()
|
||||
(interactive "*")
|
||||
;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)"
|
||||
;; We expext to find a footer just before the header except at the beginning.
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^ *\\([A-Za-z][-_.A-Za-z0-9]*([0-9A-Z]+)\\).*\\1$" nil t)
|
||||
(let (start end)
|
||||
;; Put START and END around footer and header and garbage blank lines.
|
||||
;; Fixed line counts are risky, but allow us to preserve
|
||||
;; significant blank lines.
|
||||
(setq start (save-excursion (forward-line -10) (point)))
|
||||
(setq end (save-excursion (forward-line 4) (point)))
|
||||
(delete-region start end)))
|
||||
;; Catch the final footer.
|
||||
(goto-char (point-max))
|
||||
(delete-region (point) (save-excursion (forward-line -7) (point)))
|
||||
|
||||
;; Nuke underlining and overstriking (only by the same letter)
|
||||
(goto-char (point-min))
|
||||
(while (search-forward "\b" nil t)
|
||||
(let* ((preceding (char-after (- (point) 2)))
|
||||
(following (following-char)))
|
||||
(cond ((= preceding following)
|
||||
;; x\bx
|
||||
(delete-char -2))
|
||||
((= preceding ?\_)
|
||||
;; _\b
|
||||
(delete-char -2))
|
||||
((= following ?\_)
|
||||
;; \b_
|
||||
(delete-region (1- (point)) (1+ (point)))))))
|
||||
|
||||
;; Zap ESC7, ESC8, and ESC9.
|
||||
;; This is for Sun man pages like "man 1 csh"
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\e[789]" nil t)
|
||||
(replace-match ""))
|
||||
|
||||
;; Crunch blank lines
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "\n\n\n\n*" nil t)
|
||||
(replace-match "\n\n"))
|
||||
|
||||
;; Nuke blanks lines at start.
|
||||
(goto-char (point-min))
|
||||
(skip-chars-forward "\n")
|
||||
(delete-region (point-min) (point)))
|
||||
|
||||
|
||||
(defun insert-man-file (name)
|
||||
;; Insert manual file (unpacked as necessary) into buffer
|
||||
(if (or (equal (substring name -2) ".Z")
|
||||
(string-match "/cat[0-9][a-z]?\\.Z/" name))
|
||||
(call-process "zcat" name t nil)
|
||||
(if (equal (substring name -2) ".z")
|
||||
(call-process "pcat" nil t nil name)
|
||||
(insert-file-contents name))))
|
||||
Loading…
Add table
Reference in a new issue