Initial revision

1 files changed, 152 insertions, 0 deletions

diff --git a/lisp/=man.el b/lisp/=man.el
new file mode 100644
index 00000000000..077559206f4
--- /dev/null
+++ b/lisp/=man.el
@@ -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))))