Mercurial > emacs
comparison lisp/progmodes/etags.el @ 36736:2eea125a1272
2001-03-12 Philippe Waroquiers <wao@gull.tact.cfmu.eurocontrol.be>
* progmodes/etags.el (tags-compression-info-list): New variable.
(find-tag-in-order): Use it to deal with compressed source files.
(tag-file-name-match-p): New function.
(etags-recognize-tags-table): Use it for better match of file names.
author | Francesco Potortì <pot@gnu.org> |
---|---|
date | Mon, 12 Mar 2001 12:33:39 +0000 |
parents | 850d490d87f3 |
children | 1e71d38a27df |
comparison
equal
deleted
inserted
replaced
36735:e8c547e94600 | 36736:2eea125a1272 |
---|---|
61 To switch to a new list of tags tables, setting this variable is sufficient. | 61 To switch to a new list of tags tables, setting this variable is sufficient. |
62 If you set this variable, do not also set `tags-file-name'. | 62 If you set this variable, do not also set `tags-file-name'. |
63 Use the `etags' program to make a tags table file." | 63 Use the `etags' program to make a tags table file." |
64 :group 'etags | 64 :group 'etags |
65 :type '(repeat file)) | 65 :type '(repeat file)) |
66 | |
67 ;;;###autoload | |
68 (defcustom tags-compression-info-list '("" ".Z" ".bz2" ".gz" ".tgz") | |
69 "*List of extensions tried by etags when jka-compr is used. | |
70 An empty string means search the non-compressed file. | |
71 These extensions will be tried only if jka-compr was activated | |
72 (i.e. via customize of auto-compression-mode or by calling the function | |
73 auto-compression-mode)." | |
74 :type 'sexp ;;; what should be put here to have a list of strings ? | |
75 :group 'etags) | |
76 | |
77 ;;; !!! tags-compression-info-list should probably be replaced by access | |
78 ;;; to directory list and matching jka-compr-compression-info-list. Currently, | |
79 ;;; this implementation forces each modification of | |
80 ;;; jka-compr-compression-info-list to be reflected in this var. | |
81 ;;; An alternative could be to say that introducing a special | |
82 ;;; element in this list (e.g. t) means : try at this point | |
83 ;;; using directory listing and regexp matching using | |
84 ;;; jka-compr-compression-info-list. | |
85 | |
66 | 86 |
67 ;;;###autoload | 87 ;;;###autoload |
68 (defcustom tags-add-tables 'ask-user | 88 (defcustom tags-add-tables 'ask-user |
69 "*Control whether to add a new tags table to the current list. | 89 "*Control whether to add a new tags table to the current list. |
70 t means do; nil means don't (always start a new list). | 90 t means do; nil means don't (always start a new list). |
1100 (beginning-of-line) | 1120 (beginning-of-line) |
1101 (setq tag-lines-already-matched (cons match-marker | 1121 (setq tag-lines-already-matched (cons match-marker |
1102 tag-lines-already-matched)) | 1122 tag-lines-already-matched)) |
1103 ;; Expand the filename, using the tags table buffer's default-directory. | 1123 ;; Expand the filename, using the tags table buffer's default-directory. |
1104 ;; We should be able to search for file-name backwards in file-of-tag: | 1124 ;; We should be able to search for file-name backwards in file-of-tag: |
1105 ;; the beginning-of-line is ok except when positionned on a "file-name" tag. | 1125 ;; the beginning-of-line is ok except when positioned on a "file-name" tag. |
1106 (setq file (expand-file-name | 1126 (setq file (expand-file-name |
1107 (if (or (eq (car order) 'tag-exact-file-name-match-p) | 1127 (if (memq (car order) '(tag-exact-file-name-match-p |
1108 (eq (car order) 'tag-partial-file-name-match-p)) | 1128 tag-file-name-match-p |
1129 tag-partial-file-name-match-p)) | |
1109 (save-excursion (next-line 1) | 1130 (save-excursion (next-line 1) |
1110 (file-of-tag)) | 1131 (file-of-tag)) |
1111 (file-of-tag))) | 1132 (file-of-tag))) |
1112 tag-info (funcall snarf-tag-function)) | 1133 tag-info (funcall snarf-tag-function)) |
1113 | 1134 |
1114 ;; Get the local value in the tags table buffer before switching buffers. | 1135 ;; Get the local value in the tags table buffer before switching buffers. |
1115 (setq goto-func goto-tag-location-function) | 1136 (setq goto-func goto-tag-location-function) |
1116 | 1137 |
1117 ;; Find the right line in the specified file. | 1138 ;; Find the right line in the specified file. |
1118 (set-buffer (find-file-noselect file)) | 1139 ;; If we are interested in compressed-files, |
1140 ;; we search files with extensions. | |
1141 ;; otherwise only the real file. | |
1142 (let* ((buffer-search-extensions (if (featurep 'jka-compr) | |
1143 tags-compression-info-list | |
1144 '(""))) | |
1145 the-buffer | |
1146 (file-search-extensions buffer-search-extensions)) | |
1147 ;; search a buffer visiting the file with each possible extension | |
1148 ;; Note: there is a small inefficiency in find-buffer-visiting : | |
1149 ;; truename is computed even if not needed. Not too sure about this | |
1150 ;; but I suspect truename computation accesses the disk. | |
1151 ;; It is maybe a good idea to optimise this find-buffer-visiting. | |
1152 ;; An alternative would be to use only get-file-buffer | |
1153 ;; but this looks less "sure" to find the buffer for the file. | |
1154 (while (and (not the-buffer) buffer-search-extensions) | |
1155 (setq the-buffer (find-buffer-visiting (concat file (car buffer-search-extensions)))) | |
1156 (setq buffer-search-extensions (cdr buffer-search-extensions))) | |
1157 ;; if found a buffer but file modified, ensure we re-read ! | |
1158 (if (and the-buffer (not (verify-visited-file-modtime the-buffer))) | |
1159 (find-file-noselect (buffer-file-name the-buffer))) | |
1160 ;; if no buffer found, search for files with possible extensions on disk | |
1161 (while (and (not the-buffer) file-search-extensions) | |
1162 (if (not (file-exists-p (concat file (car file-search-extensions)))) | |
1163 (setq file-search-extensions (cdr file-search-extensions)) | |
1164 (setq the-buffer (find-file-noselect (concat file (car file-search-extensions)))))) | |
1165 (if (not the-buffer) | |
1166 (if (featurep 'jka-compr) | |
1167 (error "File %s (with or without extensions %s) not found" file tags-compression-info-list) | |
1168 (error "File %s not found" file)) | |
1169 (set-buffer the-buffer))) | |
1119 (widen) | 1170 (widen) |
1120 (push-mark) | 1171 (push-mark) |
1121 (funcall goto-func tag-info) | 1172 (funcall goto-func tag-info) |
1122 | 1173 |
1123 ;; Return the buffer where the tag was found. | 1174 ;; Return the buffer where the tag was found. |
1141 (find-tag-regexp-search-function . re-search-forward) | 1192 (find-tag-regexp-search-function . re-search-forward) |
1142 (find-tag-regexp-tag-order . (tag-re-match-p)) | 1193 (find-tag-regexp-tag-order . (tag-re-match-p)) |
1143 (find-tag-regexp-next-line-after-failure-p . t) | 1194 (find-tag-regexp-next-line-after-failure-p . t) |
1144 (find-tag-search-function . search-forward) | 1195 (find-tag-search-function . search-forward) |
1145 (find-tag-tag-order . (tag-exact-file-name-match-p | 1196 (find-tag-tag-order . (tag-exact-file-name-match-p |
1197 tag-file-name-match-p | |
1146 tag-exact-match-p | 1198 tag-exact-match-p |
1147 tag-symbol-match-p | 1199 tag-symbol-match-p |
1148 tag-word-match-p | 1200 tag-word-match-p |
1149 tag-partial-file-name-match-p | 1201 tag-partial-file-name-match-p |
1150 tag-any-match-p)) | 1202 tag-any-match-p)) |
1449 (defun tag-word-match-p (tag) | 1501 (defun tag-word-match-p (tag) |
1450 (and (looking-at "\\b.*\177") | 1502 (and (looking-at "\\b.*\177") |
1451 (save-excursion (backward-char (length tag)) | 1503 (save-excursion (backward-char (length tag)) |
1452 (looking-at "\\b")))) | 1504 (looking-at "\\b")))) |
1453 | 1505 |
1506 ;;; exact file name match, i.e. searched tag must match complete file | |
1507 ;;; name including directories parts if there are some. | |
1454 (defun tag-exact-file-name-match-p (tag) | 1508 (defun tag-exact-file-name-match-p (tag) |
1455 (and (looking-at ",") | 1509 (and (looking-at ",") |
1456 (save-excursion (backward-char (+ 2 (length tag))) | 1510 (save-excursion (backward-char (+ 2 (length tag))) |
1457 (looking-at "\f\n")))) | 1511 (looking-at "\f\n")))) |
1512 ;;; file name match as above, but searched tag must match the file | |
1513 ;;; name not including the directories if there are some. | |
1514 (defun tag-file-name-match-p (tag) | |
1515 (and (looking-at ",") | |
1516 (save-excursion (backward-char (1+ (length tag))) | |
1517 (looking-at "/")))) | |
1518 ;;; this / to detect we are after a directory separator is ok for unix, | |
1519 ;;; is there a variable that contains the regexp for directory separator | |
1520 ;;; on whatever operating system ? | |
1521 ;;; Looks like ms-win will lose here :). | |
1522 | |
1523 ;;; partial file name match, i.e. searched tag must match a substring | |
1524 ;;; of the file name (potentially including a directory separator). | |
1458 (defun tag-partial-file-name-match-p (tag) | 1525 (defun tag-partial-file-name-match-p (tag) |
1459 (and (looking-at ".*,") | 1526 (and (looking-at ".*,") |
1460 (save-excursion (beginning-of-line) | 1527 (save-excursion (beginning-of-line) |
1461 (backward-char 2) | 1528 (backward-char 2) |
1462 (looking-at "\f\n")))) | 1529 (looking-at "\f\n")))) |
1569 `tags-case-fold-search'." | 1636 `tags-case-fold-search'." |
1570 (let ((case-fold-search (if (memq tags-case-fold-search '(t nil)) | 1637 (let ((case-fold-search (if (memq tags-case-fold-search '(t nil)) |
1571 tags-case-fold-search | 1638 tags-case-fold-search |
1572 case-fold-search))) | 1639 case-fold-search))) |
1573 (eval form))) | 1640 (eval form))) |
1574 | 1641 |
1575 | 1642 |
1576 ;;;###autoload | 1643 ;;;###autoload |
1577 (defun tags-loop-continue (&optional first-time) | 1644 (defun tags-loop-continue (&optional first-time) |
1578 "Continue last \\[tags-search] or \\[tags-query-replace] command. | 1645 "Continue last \\[tags-search] or \\[tags-query-replace] command. |
1579 Used noninteractively with non-nil argument to begin such a command (the | 1646 Used noninteractively with non-nil argument to begin such a command (the |