home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / superman / hsuperman.el next >
Encoding:
Text File  |  1992-05-13  |  4.4 KB  |  126 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         hsuperman.el
  4. ;; SUMMARY:      Fixes to Superman V1.0 for compatibility with 'manual-entry'.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;;
  7. ;; AUTHOR:       Bob Weiner
  8. ;; ORG:          Brown U.
  9. ;;
  10. ;; ORIG-DATE:    29-Dec-91 at 03:04:38
  11. ;; LAST-MOD:      2-Mar-92 at 21:36:11 by Bob Weiner
  12. ;;
  13. ;; This file is part of Hyperbole.
  14. ;;
  15. ;; Copyright (C) 1991, Brown University, Providence, RI
  16. ;; Developed with support from Motorola Inc.
  17. ;;
  18. ;; Based on "superman.el" by Barry A. Warsaw <bwarsaw@cen.com>
  19. ;; and "man.el", a part of GNU Emacs.
  20. ;; Available for use and distribution under the same terms as GNU Emacs.
  21. ;;
  22. ;; DESCRIPTION:  
  23. ;; DESCRIP-END.
  24.  
  25. ;;; ************************************************************************
  26. ;;; Other required Elisp libraries
  27. ;;; ************************************************************************
  28.  
  29. (load "superman")
  30.  
  31. ;;; ************************************************************************
  32. ;;; Public functions
  33. ;;; ************************************************************************
  34.  
  35. ;;; Make this command compatible with previous incarnations of 'manual-entry'.
  36. (fset 'manual-entry 'sm-manual-entry)
  37. (defun sm-manual-entry (man-args &optional section)
  38.   "Get Un*x manual pages given by string MAN-ARGS and optional SECTION string.
  39. This command is the top-level command in the superman package. It runs
  40. a Un*x command to retrieve and clean a manpage in the background and
  41. places the results in a sm-manual-mode (manpage browsing) buffer. See
  42. variable sm-notify for what happens when the buffer is ready.
  43. Universal argument non-nil forces sm-getpage-in-background to start a new
  44. background process."
  45.   (interactive
  46.    (let* ((default-entry (sm-default-man-entry))
  47.       (args
  48.        (read-string (format "%sman "
  49.                 (if (string= default-entry "") ""
  50.                   (format "(default: man %s) "
  51.                       default-entry))))))
  52.      (list (if (string= args "") default-entry args))))
  53.   (if (string= man-args "")
  54.       (error "(sm-manual-entry): No man args given.")
  55.     (if (stringp section)
  56.     (setq man-args (concat section " " man-args)))
  57.     (sm-getpage-in-background (sm-man-args-format man-args)
  58.                   (consp current-prefix-arg))
  59.     ))
  60.  
  61. ;;; ************************************************************************
  62. ;;; Private functions
  63. ;;; ************************************************************************
  64.  
  65. ;;; Test with:
  66. ;;;   (sm-man-args-format "man 2N me 3 You THEM(1) her(L)  us(5p) 1 we")
  67. ;;;   ==>   "man 2n me 3 You 1 THEM l her 5 us 1 we"
  68. ;;;
  69. (defun sm-man-args-format (args-str)
  70.   "Changes each \"topic(section)\" to \"section topic\" in ARGS-STR.
  71. Also downcases alphabetic section names when
  72. 'sm-downcase-section-letters-p' is non-nil."
  73.   (if (stringp args-str)
  74.       (let ((rtn-str "")
  75.         (start 0)
  76.         (dncase1 (if sm-downcase-section-letters-p
  77.             'downcase 'identity))
  78.         (dncase2 (if sm-downcase-section-letters-p
  79.             'sm-downcase 'identity))
  80.         topic section match prev-start)
  81.     (while (setq match
  82.              (string-match
  83.               "\\([^( \t]+\\)[ \t]*(\\([^)]\\)[^)]*)[ \t]*"
  84.               args-str start))
  85.       (setq prev-start start
  86.         start (match-end 0)
  87.         topic (substring args-str (match-beginning 1)
  88.                  (match-end 1))
  89.         section (funcall dncase1
  90.                  (substring args-str (match-beginning 2)
  91.                         (match-end 2)))
  92.         rtn-str (concat rtn-str
  93.                 (substring args-str prev-start match)
  94.                 section " " topic " ")))
  95.     (setq rtn-str (concat rtn-str (substring args-str start))
  96.           rtn-str (substring rtn-str 0 (string-match "[ \t]+$" rtn-str)))
  97.     (funcall dncase2 rtn-str))))
  98.  
  99. ;;; ************************************************************************
  100. ;;; Private variables
  101. ;;; ************************************************************************
  102.  
  103. (setq sm-filter-list
  104.   '(("sed "
  105.      ("-e 's/.\010//g'"
  106.       "-e '/[Nn]o such file or directory/d'"
  107.       "-e '/Reformatting page.  Wait... done/d'"
  108.       "-e '/^\\([A-Z][A-Z.]*([0-9A-Za-z][-0-9A-Za-z+]*)\\).*\\1$/d'"
  109.       "-e '/^[ \\t]*Hewlett-Packard Company[ \\t]*- [0-9]* -.*$/d'"
  110.       "-e '/^[ \\t]*Hewlett-Packard[ \\t]*- [0-9]* -.*$/d'"
  111.       "-e '/^ *Page [0-9]*.*(printed [0-9\\/]*)$/d'"
  112.       "-e '/^Printed [0-9].*[0-9]$/d'"
  113.       "-e '/^Sun .*/d'"
  114.       "-e '/^\\n$/D'"
  115.       ))
  116.     ("awk '"
  117.      ("BEGIN { blankline=0; anonblank=0; }"
  118.       "/^$/ { if (anonblank==0) next; }"
  119.       "{ anonblank=1; }"
  120.       "/^$/ { blankline++; next; }"
  121.       "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }"
  122.       "'"
  123.       ))))
  124.  
  125. (provide 'hsuperman)
  126.