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) |
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 |
|
|
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 |
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) |
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 |
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 |
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) |
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. |
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)) |
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) |
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) |