29 |
;;; Code: |
;;; Code: |
30 |
|
|
31 |
(require 'ring) |
(require 'ring) |
32 |
|
(require 'button) |
33 |
|
|
34 |
;;;###autoload |
;;;###autoload |
35 |
(defvar tags-file-name nil |
(defvar tags-file-name nil |
777 |
(save-excursion (end-of-line) (point)) |
(save-excursion (end-of-line) (point)) |
778 |
t)) |
t)) |
779 |
(progn (goto-char (match-end 0)) |
(progn (goto-char (match-end 0)) |
780 |
(buffer-substring (point) |
(buffer-substring-no-properties |
781 |
(progn (forward-sexp -1) |
(point) |
782 |
(while (looking-at "\\s'") |
(progn (forward-sexp -1) |
783 |
(forward-char 1)) |
(while (looking-at "\\s'") |
784 |
(point)))) |
(forward-char 1)) |
785 |
|
(point)))) |
786 |
nil))) |
nil))) |
787 |
|
|
788 |
;; Read a tag name from the minibuffer with defaulting and completion. |
;; Read a tag name from the minibuffer with defaulting and completion. |
789 |
(defun find-tag-tag (string) |
(defun find-tag-tag (string) |
790 |
(let* ((default (funcall (or find-tag-default-function |
(let* ((completion-ignore-case (if (memq tags-case-fold-search '(t nil)) |
791 |
|
tags-case-fold-search |
792 |
|
case-fold-search)) |
793 |
|
(default (funcall (or find-tag-default-function |
794 |
(get major-mode 'find-tag-default-function) |
(get major-mode 'find-tag-default-function) |
795 |
'find-tag-default))) |
'find-tag-default))) |
796 |
(spec (completing-read (if default |
(spec (completing-read (if default |
797 |
(format "%s(default %s) " string default) |
(format "%s (default %s): " |
798 |
|
(substring string 0 (string-match "[ :]+\\'" string)) |
799 |
|
default) |
800 |
string) |
string) |
801 |
'tags-complete-tag |
'tags-complete-tag |
802 |
nil nil nil nil default))) |
nil nil nil nil default))) |
917 |
|
|
918 |
See documentation of variable `tags-file-name'." |
See documentation of variable `tags-file-name'." |
919 |
(interactive (find-tag-interactive "Find tag: ")) |
(interactive (find-tag-interactive "Find tag: ")) |
920 |
(let ((buf (find-tag-noselect tagname next-p regexp-p))) |
(let* ((buf (find-tag-noselect tagname next-p regexp-p)) |
921 |
|
(pos (with-current-buffer buf (point)))) |
922 |
(condition-case nil |
(condition-case nil |
923 |
(switch-to-buffer buf) |
(switch-to-buffer buf) |
924 |
(error (pop-to-buffer buf))))) |
(error (pop-to-buffer buf))) |
925 |
|
(goto-char pos))) |
926 |
;;;###autoload (define-key esc-map "." 'find-tag) |
;;;###autoload (define-key esc-map "." 'find-tag) |
927 |
|
|
928 |
;;;###autoload |
;;;###autoload |
1039 |
;; any member of the function list ORDER (third arg). If ORDER is nil, |
;; any member of the function list ORDER (third arg). If ORDER is nil, |
1040 |
;; use saved state to continue a previous search. |
;; use saved state to continue a previous search. |
1041 |
|
|
1042 |
;; Fourth arg MATCHING is a string, an English '-ing' word, to be used in |
;; Fourth arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match, |
|
;; an error message. |
|
|
|
|
|
;; Fifth arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match, |
|
1043 |
;; point should be moved to the next line. |
;; point should be moved to the next line. |
1044 |
|
|
1045 |
|
;; Fifth arg MATCHING is a string, an English '-ing' word, to be used in |
1046 |
|
;; an error message. |
1047 |
|
|
1048 |
;; Algorithm is as follows. For each qualifier-func in ORDER, go to |
;; Algorithm is as follows. For each qualifier-func in ORDER, go to |
1049 |
;; beginning of tags file, and perform inner loop: for each naive match for |
;; beginning of tags file, and perform inner loop: for each naive match for |
1050 |
;; PATTERN found using SEARCH-FORWARD-FUNC, qualify the naive match using |
;; PATTERN found using SEARCH-FORWARD-FUNC, qualify the naive match using |
1205 |
(find-tag-tag-order . (tag-exact-file-name-match-p |
(find-tag-tag-order . (tag-exact-file-name-match-p |
1206 |
tag-file-name-match-p |
tag-file-name-match-p |
1207 |
tag-exact-match-p |
tag-exact-match-p |
1208 |
|
tag-implicit-name-match-p |
1209 |
tag-symbol-match-p |
tag-symbol-match-p |
1210 |
tag-word-match-p |
tag-word-match-p |
1211 |
tag-partial-file-name-match-p |
tag-partial-file-name-match-p |
1414 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1415 |
(while (re-search-forward string nil t) |
(while (re-search-forward string nil t) |
1416 |
(beginning-of-line) |
(beginning-of-line) |
1417 |
(let ((tag (buffer-substring (point) |
(let* ((tag-info (save-excursion (funcall snarf-tag-function))) |
1418 |
(progn (skip-chars-forward "^\177") |
(tag (if (eq t (car tag-info)) nil (car tag-info))) |
1419 |
(point)))) |
(file (if tag (file-of-tag) |
1420 |
(props `(action find-tag-other-window mouse-face highlight |
(save-excursion (next-line 1) |
1421 |
face ,tags-tag-face)) |
(file-of-tag)))) |
1422 |
(pt (with-current-buffer standard-output (point)))) |
(pt (with-current-buffer standard-output (point)))) |
1423 |
(princ tag) |
(if tag |
1424 |
(when (= (aref tag 0) ?\() (princ " ...)")) |
(progn |
1425 |
(add-text-properties pt (with-current-buffer standard-output (point)) |
(princ (format "[%s]: " file)) |
1426 |
`(item ,tag ,@props) standard-output)) |
(princ tag) |
1427 |
|
(when (= (aref tag 0) ?\() (princ " ...)")) |
1428 |
|
(with-current-buffer standard-output |
1429 |
|
(make-text-button pt (point) |
1430 |
|
'tag-info tag-info |
1431 |
|
'file file |
1432 |
|
'action (lambda (button) |
1433 |
|
;; TODO: just `find-file is too simple. |
1434 |
|
;; Use code `find-tag-in-order'. |
1435 |
|
(let ((tag-info (button-get button 'tag-info))) |
1436 |
|
(find-file (button-get button 'file)) |
1437 |
|
(etags-goto-tag-location tag-info))) |
1438 |
|
'face 'tags-tag-face |
1439 |
|
'type 'button))) |
1440 |
|
(princ (format "- %s" file)) |
1441 |
|
(with-current-buffer standard-output |
1442 |
|
(make-text-button pt (point) |
1443 |
|
'file file |
1444 |
|
'action (lambda (button) |
1445 |
|
;; TODO: just `find-file is too simple. |
1446 |
|
;; Use code `find-tag-in-order'. |
1447 |
|
(find-file (button-get button 'file)) |
1448 |
|
(goto-char (point-min))) |
1449 |
|
'face 'tags-tag-face |
1450 |
|
'type 'button)) |
1451 |
|
)) |
1452 |
(terpri) |
(terpri) |
1453 |
(forward-line 1)) |
(forward-line 1)) |
1454 |
(when tags-apropos-verbose (princ "\n"))) |
(when tags-apropos-verbose (princ "\n"))) |
1496 |
(lambda () (zerop (buffer-size)))))) |
(lambda () (zerop (buffer-size)))))) |
1497 |
|
|
1498 |
;; Match qualifier functions for tagnames. |
;; Match qualifier functions for tagnames. |
1499 |
;; XXX these functions assume etags file format. |
;; These functions assume the etags file format defined in etc/ETAGS.EBNF. |
1500 |
|
|
1501 |
;; This might be a neat idea, but it's too hairy at the moment. |
;; This might be a neat idea, but it's too hairy at the moment. |
1502 |
;;(defmacro tags-with-syntax (&rest body) |
;;(defmacro tags-with-syntax (&rest body) |
1514 |
;; (set-syntax-table otable)))) |
;; (set-syntax-table otable)))) |
1515 |
;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form)) |
;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form)) |
1516 |
|
|
1517 |
|
;; exact file name match, i.e. searched tag must match complete file |
1518 |
|
;; name including directories parts if there are some. |
1519 |
|
(defun tag-exact-file-name-match-p (tag) |
1520 |
|
(and (looking-at ",[0-9\n]") |
1521 |
|
(save-excursion (backward-char (+ 2 (length tag))) |
1522 |
|
(looking-at "\f\n")))) |
1523 |
|
;; file name match as above, but searched tag must match the file |
1524 |
|
;; name not including the directories if there are some. |
1525 |
|
(defun tag-file-name-match-p (tag) |
1526 |
|
(and (looking-at ",[0-9\n]") |
1527 |
|
(save-excursion (backward-char (1+ (length tag))) |
1528 |
|
(looking-at "/")))) |
1529 |
|
;; this / to detect we are after a directory separator is ok for unix, |
1530 |
|
;; is there a variable that contains the regexp for directory separator |
1531 |
|
;; on whatever operating system ? |
1532 |
|
;; Looks like ms-win will lose here :). |
1533 |
|
|
1534 |
;; t if point is at a tag line that matches TAG exactly. |
;; t if point is at a tag line that matches TAG exactly. |
1535 |
;; point should be just after a string that matches TAG. |
;; point should be just after a string that matches TAG. |
1536 |
(defun tag-exact-match-p (tag) |
(defun tag-exact-match-p (tag) |
1540 |
;; We are not on the explicit tag name, but perhaps it follows. |
;; We are not on the explicit tag name, but perhaps it follows. |
1541 |
(looking-at (concat "[^\177\n]*\177" (regexp-quote tag) "\001")))) |
(looking-at (concat "[^\177\n]*\177" (regexp-quote tag) "\001")))) |
1542 |
|
|
1543 |
|
;; t if point is at a tag line that has an implicit name. |
1544 |
|
;; point should be just after a string that matches TAG. |
1545 |
|
(defun tag-implicit-name-match-p (tag) |
1546 |
|
;; Look at the comment of the make_tag function in lib-src/etags.c for |
1547 |
|
;; a textual description of the four rules. |
1548 |
|
(and (string-match "^[^ \t()=,;]+$" tag) ;rule #1 |
1549 |
|
(looking-at "[ \t()=,;]?\177") ;rules #2 and #4 |
1550 |
|
(save-excursion |
1551 |
|
(backward-char (1+ (length tag))) |
1552 |
|
(looking-at "[\n \t()=,;]")))) ;rule #3 |
1553 |
|
|
1554 |
;; t if point is at a tag line that matches TAG as a symbol. |
;; t if point is at a tag line that matches TAG as a symbol. |
1555 |
;; point should be just after a string that matches TAG. |
;; point should be just after a string that matches TAG. |
1556 |
(defun tag-symbol-match-p (tag) |
(defun tag-symbol-match-p (tag) |
1566 |
(save-excursion (backward-char (length tag)) |
(save-excursion (backward-char (length tag)) |
1567 |
(looking-at "\\b")))) |
(looking-at "\\b")))) |
1568 |
|
|
|
;; exact file name match, i.e. searched tag must match complete file |
|
|
;; name including directories parts if there are some. |
|
|
(defun tag-exact-file-name-match-p (tag) |
|
|
(and (looking-at ",[0-9\n]") |
|
|
(save-excursion (backward-char (+ 2 (length tag))) |
|
|
(looking-at "\f\n")))) |
|
|
;; file name match as above, but searched tag must match the file |
|
|
;; name not including the directories if there are some. |
|
|
(defun tag-file-name-match-p (tag) |
|
|
(and (looking-at ",[0-9\n]") |
|
|
(save-excursion (backward-char (1+ (length tag))) |
|
|
(looking-at "/")))) |
|
|
;; this / to detect we are after a directory separator is ok for unix, |
|
|
;; is there a variable that contains the regexp for directory separator |
|
|
;; on whatever operating system ? |
|
|
;; Looks like ms-win will lose here :). |
|
|
|
|
1569 |
;; partial file name match, i.e. searched tag must match a substring |
;; partial file name match, i.e. searched tag must match a substring |
1570 |
;; of the file name (potentially including a directory separator). |
;; of the file name (potentially including a directory separator). |
1571 |
(defun tag-partial-file-name-match-p (tag) |
(defun tag-partial-file-name-match-p (tag) |
1840 |
(funcall tags-apropos-function regexp)))) |
(funcall tags-apropos-function regexp)))) |
1841 |
(etags-tags-apropos-additional regexp)) |
(etags-tags-apropos-additional regexp)) |
1842 |
(with-current-buffer "*Tags List*" |
(with-current-buffer "*Tags List*" |
1843 |
(setq buffer-read-only t) |
(apropos-mode) |
1844 |
(apropos-mode))) |
;; apropos-mode is derived from fundamental-mode and it kills |
1845 |
|
;; all local variables. |
1846 |
|
(setq buffer-read-only t))) |
1847 |
|
|
1848 |
;; XXX Kludge interface. |
;; XXX Kludge interface. |
1849 |
|
|
1946 |
(error "%s" |
(error "%s" |
1947 |
(substitute-command-keys |
(substitute-command-keys |
1948 |
"No tags table loaded; try \\[visit-tags-table]"))) |
"No tags table loaded; try \\[visit-tags-table]"))) |
1949 |
(let ((pattern (funcall (or find-tag-default-function |
(let ((completion-ignore-case (if (memq tags-case-fold-search '(t nil)) |
1950 |
|
tags-case-fold-search |
1951 |
|
case-fold-search)) |
1952 |
|
(pattern (funcall (or find-tag-default-function |
1953 |
(get major-mode 'find-tag-default-function) |
(get major-mode 'find-tag-default-function) |
1954 |
'find-tag-default))) |
'find-tag-default))) |
1955 |
beg |
beg |