/[emacs]/emacs/lisp/progmodes/etags.el
ViewVC logotype

Diff of /emacs/lisp/progmodes/etags.el

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

revision 1.165 by monnier, Mon May 20 18:48:33 2002 UTC revision 1.165.2.1 by miles, Fri Apr 4 06:20:32 2003 UTC
# Line 29  Line 29 
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
# Line 776  Assumes the tags table is the current bu Line 777  Assumes the tags table is the current bu
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)))
# Line 910  Contrast this with the ring of marks gon Line 917  Contrast this with the ring of marks gon
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
# Line 1030  where they were found." Line 1039  where they were found."
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
# Line 1196  where they were found." Line 1205  where they were found."
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
# Line 1404  where they were found." Line 1414  where they were found."
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")))
# Line 1461  where they were found." Line 1496  where they were found."
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)
# Line 1479  where they were found." Line 1514  where they were found."
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)
# Line 1488  where they were found." Line 1540  where they were found."
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)
# Line 1503  where they were found." Line 1566  where they were found."
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)
# Line 1794  directory specification." Line 1840  directory specification."
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    
# Line 1898  for \\[find-tag] (which see)." Line 1946  for \\[find-tag] (which see)."
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

Legend:
Removed from v.1.165  
changed lines
  Added in v.1.165.2.1

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