home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / man.el < prev    next >
Text File  |  1990-07-19  |  5KB  |  154 lines
  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))))
  154.