diff options
| author | Martin Rudalics | 2007-12-31 17:53:30 +0000 |
|---|---|---|
| committer | Martin Rudalics | 2007-12-31 17:53:30 +0000 |
| commit | d8b3b1a17d6861377759f16ea933d81be0756a89 (patch) | |
| tree | e2b3d7063e3f95e3ece045d52bad276e193dc29d /lisp | |
| parent | 606c9f599e3ff5fc66935ab6380e36b777d1060d (diff) | |
| download | emacs-d8b3b1a17d6861377759f16ea933d81be0756a89.tar.gz emacs-d8b3b1a17d6861377759f16ea933d81be0756a89.zip | |
(Man-default-man-entry): Make this a defun. Improve
guessing mechanism and handling of section numbers.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/man.el | 103 |
2 files changed, 77 insertions, 31 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index cd73a8e0018..89b535ac79f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,8 @@ | |||
| 1 | 2007-12-31 Martin Rudalics <rudalics@gmx.at> | ||
| 2 | |||
| 3 | * man.el (Man-default-man-entry): Make this a defun. Improve | ||
| 4 | guessing mechanism and handling of section numbers. | ||
| 5 | |||
| 1 | 2007-12-31 Richard Stallman <rms@gnu.org> | 6 | 2007-12-31 Richard Stallman <rms@gnu.org> |
| 2 | 7 | ||
| 3 | * faces.el (face-all-attributes): If FRAME is nil, return defaults. | 8 | * faces.el (face-all-attributes): If FRAME is nil, return defaults. |
diff --git a/lisp/man.el b/lisp/man.el index 48639cd764b..1f4288bc803 100644 --- a/lisp/man.el +++ b/lisp/man.el | |||
| @@ -642,50 +642,91 @@ a new value." | |||
| 642 | 642 | ||
| 643 | 643 | ||
| 644 | ;; ====================================================================== | 644 | ;; ====================================================================== |
| 645 | ;; default man entry: get word under point | 645 | ;; default man entry: get word near point |
| 646 | 646 | ||
| 647 | (defsubst Man-default-man-entry (&optional pos) | 647 | (defun Man-default-man-entry (&optional pos) |
| 648 | "Make a guess at a default manual entry based on the text at POS. | 648 | "Guess default manual entry based on the text near position POS. |
| 649 | If POS is nil, the current point is used." | 649 | POS defaults to `point'." |
| 650 | (let (word start original-pos distance) | 650 | (let (word start pos column distance) |
| 651 | (save-excursion | 651 | (save-excursion |
| 652 | (if pos (goto-char pos)) | 652 | (when pos (goto-char pos)) |
| 653 | ;; Default man entry title is any word the cursor is on, or if | 653 | (setq pos (point)) |
| 654 | ;; cursor not on a word, nearest preceding or next word-like | 654 | ;; The default title is the nearest entry-like object before or |
| 655 | ;; object on this line. | 655 | ;; after POS. |
| 656 | (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) | 656 | (if (and (skip-chars-backward " \ta-zA-Z0-9+") |
| 657 | (not (zerop (skip-chars-backward "("))) | ||
| 658 | ;; Try to handle the special case where POS is on a | ||
| 659 | ;; section number. | ||
| 660 | (looking-at | ||
| 661 | (concat "([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) | ||
| 662 | ;; We skipped a valid section number backwards, look at | ||
| 663 | ;; preceding text. | ||
| 664 | (or (and (skip-chars-backward ",; \t") | ||
| 665 | (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:")))) | ||
| 666 | ;; Not a valid entry, move POS after closing paren. | ||
| 667 | (not (setq pos (match-end 0))))) | ||
| 668 | ;; We have a candidate, make `start' record its starting | ||
| 669 | ;; position. | ||
| 657 | (setq start (point)) | 670 | (setq start (point)) |
| 658 | (setq original-pos (point)) | 671 | ;; Otherwise look at char before POS. |
| 659 | (setq distance (abs (skip-chars-backward ",; \t"))) | 672 | (goto-char pos) |
| 660 | (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) | 673 | (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) |
| 661 | (progn | 674 | ;; Our candidate is just before or around POS. |
| 662 | (setq start (point)) | 675 | (setq start (point)) |
| 663 | (goto-char original-pos) | 676 | ;; Otherwise record the current column and look backwards. |
| 664 | (if (and (< (skip-chars-forward ",; \t") distance) | 677 | (setq column (current-column)) |
| 665 | (looking-at "[-a-zA-Z0-9._+:]")) | 678 | (skip-chars-backward ",; \t") |
| 666 | (setq start (point)) | 679 | ;; Record the distance travelled. |
| 667 | (goto-char start))) | 680 | (setq distance (- column (current-column))) |
| 668 | (skip-chars-forward ",; \t") | 681 | (when (looking-back |
| 669 | (setq start (point)))) | 682 | (concat "([ \t]*\\(?:" Man-section-regexp "\\)[ \t]*)")) |
| 683 | ;; Skip section number backwards. | ||
| 684 | (goto-char (match-beginning 0)) | ||
| 685 | (skip-chars-backward " \t")) | ||
| 686 | (if (not (zerop (skip-chars-backward "-a-zA-Z0-9._+:"))) | ||
| 687 | (progn | ||
| 688 | ;; We have a candidate before POS ... | ||
| 689 | (setq start (point)) | ||
| 690 | (goto-char pos) | ||
| 691 | (if (and (skip-chars-forward ",; \t") | ||
| 692 | (< (- (current-column) column) distance) | ||
| 693 | (looking-at "[-a-zA-Z0-9._+:]")) | ||
| 694 | ;; ... but the one after POS is better. | ||
| 695 | (setq start (point)) | ||
| 696 | ;; ... and anything after POS is worse. | ||
| 697 | (goto-char start))) | ||
| 698 | ;; No candidate before POS. | ||
| 699 | (goto-char pos) | ||
| 700 | (skip-chars-forward ",; \t") | ||
| 701 | (setq start (point))))) | ||
| 702 | ;; We have found a suitable starting point, try to skip at least | ||
| 703 | ;; one character. | ||
| 670 | (skip-chars-forward "-a-zA-Z0-9._+:") | 704 | (skip-chars-forward "-a-zA-Z0-9._+:") |
| 671 | (setq word (buffer-substring-no-properties start (point))) | 705 | (setq word (buffer-substring-no-properties start (point))) |
| 672 | ;; If there is a continuation at the end of line, check the | 706 | ;; If there is a continuation at the end of line, check the |
| 673 | ;; following line too, eg: | 707 | ;; following line too, eg: |
| 674 | ;; see this- | 708 | ;; see this- |
| 675 | ;; command-here(1) | 709 | ;; command-here(1) |
| 710 | ;; Note: This code gets executed iff our entry is after POS. | ||
| 676 | (when (looking-at "[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])") | 711 | (when (looking-at "[ \t\r\n]+\\([-a-zA-Z0-9._+:]+\\)([0-9])") |
| 677 | (setq word (concat word (match-string-no-properties 1)))) | 712 | (setq word (concat word (match-string-no-properties 1))) |
| 713 | ;; Make sure the section number gets included by the code below. | ||
| 714 | (goto-char (match-end 1))) | ||
| 678 | (when (string-match "[._]+$" word) | 715 | (when (string-match "[._]+$" word) |
| 679 | (setq word (substring word 0 (match-beginning 0)))) | 716 | (setq word (substring word 0 (match-beginning 0)))) |
| 680 | ;; If looking at something like *strcat(... , remove the '*' | 717 | ;; The following was commented out since the preceding code |
| 681 | (when (string-match "^*" word) | 718 | ;; should not produce a leading "*" in the first place. |
| 682 | (setq word (substring word 1))) | 719 | ;;; ;; If looking at something like *strcat(... , remove the '*' |
| 683 | ;; If looking at something like ioctl(2) or brc(1M), include the | 720 | ;;; (when (string-match "^*" word) |
| 684 | ;; section number in the returned value. Remove text properties. | 721 | ;;; (setq word (substring word 1))) |
| 685 | (concat word | 722 | (concat |
| 686 | (if (looking-at | 723 | word |
| 687 | (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) | 724 | (and (not (string-equal word "")) |
| 688 | (format "(%s)" (match-string-no-properties 1))))))) | 725 | ;; If looking at something like ioctl(2) or brc(1M), |
| 726 | ;; include the section number in the returned value. | ||
| 727 | (looking-at | ||
| 728 | (concat "[ \t]*([ \t]*\\(" Man-section-regexp "\\)[ \t]*)")) | ||
| 729 | (format "(%s)" (match-string-no-properties 1))))))) | ||
| 689 | 730 | ||
| 690 | 731 | ||
| 691 | ;; ====================================================================== | 732 | ;; ====================================================================== |