/[emacs]/emacs/lisp/man.el
ViewVC logotype

Diff of /emacs/lisp/man.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.111 by pj, Sun Jan 13 09:58:40 2002 UTC revision 1.111.4.1 by miles, Fri Apr 4 06:20:10 2003 UTC
# Line 95  Line 95 
95  ;;; Code:  ;;; Code:
96    
97  (require 'assoc)  (require 'assoc)
98    (require 'button)
99    
100  ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv  ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
101  ;; empty defvars (keep the compiler quiet)  ;; empty defvars (keep the compiler quiet)
# Line 210  the associated section number." Line 211  the associated section number."
211                         (string :tag "Real Section")))                         (string :tag "Real Section")))
212    :group 'man)    :group 'man)
213    
214    (defcustom Man-header-file-path
215      '("/usr/include" "/usr/local/include")
216      "C Header file search path used in Man."
217      :type '(repeat string)
218      :group 'man)
219    
220  (defvar manual-program "man"  (defvar manual-program "man"
221    "The name of the program that produces man pages.")    "The name of the program that produces man pages.")
222    
# Line 264  This regular expression should start wit Line 271  This regular expression should start wit
271    (concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))")    (concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))")
272    "Regular expression describing a reference to another manpage.")    "Regular expression describing a reference to another manpage.")
273    
274    (defvar Man-synopsis-regexp "SYNOPSIS"
275      "Regular expression for SYNOPSIS heading (or your equivalent).
276    This regexp should not start with a `^' character.")
277    
278    (defvar Man-files-regexp "FILES"
279      "Regular expression for FILES heading (or your equivalent).
280    This regexp should not start with a `^' character.")
281    
282    (defvar Man-include-regexp "#[ \t]*include[ \t]*"
283      "Regular expression describing the #include (directive of cpp).")
284    
285    (defvar Man-file-name-regexp "[^<>\" \t\n]+"
286      "Regular expression describing <> in #include line (directive of cpp).")
287    
288    (defvar Man-normal-file-prefix-regexp "[/~$]"
289      "Regular expression describing a file path appeared in FILES section.")
290    
291    (defvar Man-header-regexp
292      (concat "\\(" Man-include-regexp "\\)"
293              "[<\"]"
294              "\\(" Man-file-name-regexp "\\)"
295              "[>\"]")
296      "Regular expression describing references to header files.")
297    
298    (defvar Man-normal-file-regexp
299      (concat Man-normal-file-prefix-regexp Man-file-name-regexp)
300      "Regular expression describing references to normal files.")
301    
302  ;; This includes the section as an optional part to catch hyphenated  ;; This includes the section as an optional part to catch hyphenated
303  ;; refernces to manpages.  ;; refernces to manpages.
304  (defvar Man-hyphenated-reference-regexp  (defvar Man-hyphenated-reference-regexp
# Line 333  make -a one of the switches, if your `ma Line 368  make -a one of the switches, if your `ma
368    
369  (if Man-mode-map  (if Man-mode-map
370      nil      nil
371    (setq Man-mode-map (make-keymap))    (setq Man-mode-map (copy-keymap button-buffer-map))
372    (suppress-keymap Man-mode-map)    (suppress-keymap Man-mode-map)
373    (define-key Man-mode-map " "    'scroll-up)    (define-key Man-mode-map " "    'scroll-up)
374    (define-key Man-mode-map "\177" 'scroll-down)    (define-key Man-mode-map "\177" 'scroll-down)
# Line 350  make -a one of the switches, if your `ma Line 385  make -a one of the switches, if your `ma
385    (define-key Man-mode-map "k"    'Man-kill)    (define-key Man-mode-map "k"    'Man-kill)
386    (define-key Man-mode-map "q"    'Man-quit)    (define-key Man-mode-map "q"    'Man-quit)
387    (define-key Man-mode-map "m"    'man)    (define-key Man-mode-map "m"    'man)
   (define-key Man-mode-map "\r"   'man-follow)  
   (define-key Man-mode-map [mouse-2]   'man-follow-mouse)  
388    (define-key Man-mode-map "?"    'describe-mode)    (define-key Man-mode-map "?"    'describe-mode)
389    )    )
390    
391    ;; buttons
392    (define-button-type 'Man-xref-man-page
393      'action (lambda (button) (man-follow (button-label button)))
394      'help-echo "RET, mouse-2: display this man page")
395    
396    (define-button-type 'Man-xref-header-file
397        'action (lambda (button)
398                  (let ((w (button-get button 'Man-target-string)))
399                    (unless (Man-view-header-file w)
400                      (error "Cannot find header file: %s" w))))
401        'help-echo "mouse-2: display this header file")
402    
403    (define-button-type 'Man-xref-normal-file
404      'action (lambda (button)
405                (let ((f (substitute-in-file-name
406                          (button-get button 'Man-target-string))))
407                  (if (file-exists-p f)
408                      (if (file-readable-p f)
409                          (view-file f)
410                        (error "Cannot read a file: %s" f))
411                    (error "Cannot find a file: %s" f))))
412      'help-echo "mouse-2: mouse-2: display this file")
413    
414    
415  ;; ======================================================================  ;; ======================================================================
416  ;; utilities  ;; utilities
# Line 497  This guess is based on the text surround Line 553  This guess is based on the text surround
553      (save-excursion      (save-excursion
554        ;; Default man entry title is any word the cursor is on, or if        ;; Default man entry title is any word the cursor is on, or if
555        ;; cursor not on a word, then nearest preceding word.        ;; cursor not on a word, then nearest preceding word.
556        (setq word (current-word))        (skip-chars-backward "-a-zA-Z0-9._+:")
557          (let ((start (point)))
558            (skip-chars-forward "-a-zA-Z0-9._+:")
559            (setq word (buffer-substring start (point))))
560        (if (string-match "[._]+$" word)        (if (string-match "[._]+$" word)
561            (setq word (substring word 0 (match-beginning 0))))            (setq word (substring word 0 (match-beginning 0))))
562        ;; If looking at something like ioctl(2) or brc(1M), include the        ;; If looking at something like ioctl(2) or brc(1M), include the
# Line 559  all sections related to a subject, put s Line 618  all sections related to a subject, put s
618        (error "No item under point")        (error "No item under point")
619      (man man-args)))      (man man-args)))
620    
 (defun man-follow-mouse (e)  
   "Get a Un*x manual page of the item under the mouse and put it in a buffer."  
   (interactive "e")  
   (save-excursion  
     (mouse-set-point e)  
     (call-interactively 'man-follow)))  
   
621  (defun Man-getpage-in-background (topic)  (defun Man-getpage-in-background (topic)
622    "Use TOPIC to build and fire off the manpage and cleaning command."    "Use TOPIC to build and fire off the manpage and cleaning command."
623    (let* ((man-args topic)    (let* ((man-args topic)
# Line 590  all sections related to a subject, put s Line 642  all sections related to a subject, put s
642               (if default-enable-multibyte-characters               (if default-enable-multibyte-characters
643                   locale-coding-system 'raw-text-unix))                   locale-coding-system 'raw-text-unix))
644              ;; Avoid possible error by using a directory that always exists.              ;; Avoid possible error by using a directory that always exists.
645              (default-directory "/"))              (default-directory
646                  (if (and (file-directory-p default-directory)
647                           (not (find-file-name-handler default-directory
648                                                        'file-directory-p)))
649                      default-directory
650                    "/")))
651          ;; Prevent any attempt to use display terminal fanciness.          ;; Prevent any attempt to use display terminal fanciness.
652          (setenv "TERM" "dumb")          (setenv "TERM" "dumb")
653            ;; In Debian Woody, at least, we get overlong lines under X
654            ;; unless COLUMNS or MANWIDTH is set.  This isn't a problem on
655            ;; a tty.  man(1) says:
656            ;;        MANWIDTH
657            ;;               If $MANWIDTH is set, its value is used as the  line
658            ;;               length  for which manual pages should be formatted.
659            ;;               If it is not set, manual pages  will  be  formatted
660            ;;               with  a line length appropriate to the current ter-
661            ;;               minal (using an ioctl(2) if available, the value of
662            ;;               $COLUMNS,  or falling back to 80 characters if nei-
663            ;;               ther is available).
664            (if window-system
665                (unless (or (getenv "MANWIDTH") (getenv "COLUMNS"))
666                  ;; This isn't strictly correct, since we don't know how
667                  ;; the page will actually be displayed, but it seems
668                  ;; reasonable.
669                  (setenv "COLUMNS" (number-to-string (frame-width)))))
670          (if (fboundp 'start-process)          (if (fboundp 'start-process)
671              (set-process-sentinel              (set-process-sentinel
672               (start-process manual-program buffer "sh" "-c"               (start-process manual-program buffer "sh" "-c"
673                              (format (Man-build-man-command) man-args))                              (format (Man-build-man-command) man-args))
674               'Man-bgproc-sentinel)               'Man-bgproc-sentinel)
675            (progn            (setenv "GROFF_NO_SGR" "1")
676              (let ((exit-status            (let ((exit-status
677                     (call-process shell-file-name nil (list buffer nil) nil "-c"                   (call-process shell-file-name nil (list buffer nil) nil "-c"
678                                   (format (Man-build-man-command) man-args)))                                 (format (Man-build-man-command) man-args)))
679                    (msg ""))                  (msg ""))
680                (or (and (numberp exit-status)              (or (and (numberp exit-status)
681                         (= exit-status 0))                       (= exit-status 0))
682                    (and (numberp exit-status)                  (and (numberp exit-status)
683                         (setq msg                       (setq msg
684                               (format "exited abnormally with code %d"                             (format "exited abnormally with code %d"
685                                       exit-status)))                                     exit-status)))
686                    (setq msg exit-status))                  (setq msg exit-status))
687                (Man-bgproc-sentinel bufname msg))))))))              (Man-bgproc-sentinel bufname msg)))))))
688    
689  (defun Man-notify-when-ready (man-buffer)  (defun Man-notify-when-ready (man-buffer)
690    "Notify the user when MAN-BUFFER is ready.    "Notify the user when MAN-BUFFER is ready.
# Line 656  See the variable `Man-notify-method' for Line 730  See the variable `Man-notify-method' for
730       )))       )))
731    
732  (defun Man-softhyphen-to-minus ()  (defun Man-softhyphen-to-minus ()
733    ;; \255 is some kind of dash in Latin-N.  Versions of Debian man, at    ;; \255 is SOFT HYPHEN in Latin-N.  Versions of Debian man, at
734    ;; least, emit it even when not in a Latin-N locale.    ;; least, emit it even when not in a Latin-N locale.
735    (unless (eq t (compare-strings "latin-" 0 nil    (unless (eq t (compare-strings "latin-" 0 nil
736                                   current-language-environment 0 6 t))                                   current-language-environment 0 6 t))
# Line 712  Same for the ANSI bold and normal escape Line 786  Same for the ANSI bold and normal escape
786      (put-text-property (1- (point)) (point) 'face 'bold))      (put-text-property (1- (point)) (point) 'face 'bold))
787    (goto-char (point-min))    (goto-char (point-min))
788    ;; Try to recognize common forms of cross references.    ;; Try to recognize common forms of cross references.
789    (while (re-search-forward "\\w+([0-9].?)" nil t)    (Man-highlight-references)
     (put-text-property (match-beginning 0) (match-end 0)  
                        'mouse-face 'highlight))  
790    (Man-softhyphen-to-minus)    (Man-softhyphen-to-minus)
791    (message "%s man page made up" Man-arguments))    (message "%s man page made up" Man-arguments))
792    
793    (defun Man-highlight-references ()
794      "Highlight the references on mouse-over.
795    references include items in the SEE ALSO section,
796    header file(#include <foo.h>) and files in FILES"
797      (let ((dummy 0))
798        (Man-highlight-references0
799         Man-see-also-regexp Man-reference-regexp 1 dummy
800         'Man-xref-man-page)
801        (Man-highlight-references0
802         Man-synopsis-regexp Man-header-regexp 0 2
803         'Man-xref-header-file)
804        (Man-highlight-references0
805         Man-files-regexp Man-normal-file-regexp 0 0
806         'Man-xref-normal-file)))
807    
808    (defun Man-highlight-references0 (start-section regexp button-pos target-pos type)
809      ;; Based on `Man-build-references-alist'
810      (when (Man-find-section start-section)
811        (forward-line 1)
812        (let ((end (save-excursion
813                     (Man-next-section 1)
814                     (point))))
815          (back-to-indentation)
816          (while (re-search-forward regexp end t)
817            (make-text-button
818             (match-beginning button-pos)
819             (match-end button-pos)
820             'type type
821             'Man-target-string (match-string target-pos)
822             )))))
823    
824  (defun Man-cleanup-manpage ()  (defun Man-cleanup-manpage ()
825    "Remove overstriking and underlining from the current buffer."    "Remove overstriking and underlining from the current buffer."
826    (interactive)    (interactive)
# Line 1168  Specify which REFERENCE to use; default Line 1271  Specify which REFERENCE to use; default
1271      (if Man-circular-pages-flag      (if Man-circular-pages-flag
1272          (Man-goto-page (length Man-page-list))          (Man-goto-page (length Man-page-list))
1273        (error "You're looking at the first manpage in the buffer"))))        (error "You're looking at the first manpage in the buffer"))))
1274    
1275    ;; Header file support
1276    (defun Man-view-header-file (file)
1277      "View a header file specified by FILE from `Man-header-file-path'."
1278      (let ((path Man-header-file-path)
1279            complete-path)
1280        (while path
1281          (setq complete-path (concat (car path) "/" file)
1282                path (cdr path))
1283          (if (file-readable-p complete-path)
1284              (progn (view-file complete-path)
1285                     (setq path nil))
1286            (setq complete-path nil)))
1287        complete-path))
1288    
1289  ;; Init the man package variables, if not already done.  ;; Init the man package variables, if not already done.
1290  (Man-init-defvars)  (Man-init-defvars)

Legend:
Removed from v.1.111  
changed lines
  Added in v.1.111.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26