Mercurial > emacs
comparison lisp/progmodes/etags.el @ 26720:32e893b03ad2
(etags-tags-completion-table): Modified the
regexp to allow for the CL symbols starting with `+*'.
(tags-completion-table): Doc fix (it's an obarray, not an alist).
(tags-completion-table, tags-recognize-empty-tags-table): Remove
`function' quoting lambda.
(tags-with-face): New macro.
(list-tags, tags-apropos): Use it.
(tags-apropos-additional-actions): New user option.
(etags-tags-apropos-additional): Use it.
(tags-apropos): Call etags-tags-apropos-additional.
(tags-apropos-verbose): New user option.
(etags-tags-apropos): Use it.
(visit-tags-table-buffer, next-file): Use `unless'.
(recognize-empty-tags-table): Renamed to
tags-recognize-empty-tags-table.
(complete-tag): Call tags-complete-tag bypassing try-completion.
author | Gerd Moellmann <gerd@gnu.org> |
---|---|
date | Mon, 06 Dec 1999 13:13:39 +0000 |
parents | 4868ac7f6a3f |
children | 9669a6691caa |
comparison
equal
deleted
inserted
replaced
26719:8a6fd8991465 | 26720:32e893b03ad2 |
---|---|
23 ;; Boston, MA 02111-1307, USA. | 23 ;; Boston, MA 02111-1307, USA. |
24 | 24 |
25 ;;; Code: | 25 ;;; Code: |
26 | 26 |
27 (require 'ring) | 27 (require 'ring) |
28 (eval-when-compile (require 'cl)) ; for `gensym' | |
28 | 29 |
29 ;;;###autoload | 30 ;;;###autoload |
30 (defvar tags-file-name nil | 31 (defvar tags-file-name nil |
31 "*File name of tags table. | 32 "*File name of tags table. |
32 To switch to a new tags table, setting this variable is sufficient. | 33 To switch to a new tags table, setting this variable is sufficient. |
111 "*Length of marker rings `find-tag-marker-ring' and `tags-location-ring'." | 112 "*Length of marker rings `find-tag-marker-ring' and `tags-location-ring'." |
112 :group 'etags | 113 :group 'etags |
113 :type 'integer | 114 :type 'integer |
114 :version "20.3") | 115 :version "20.3") |
115 | 116 |
117 (defcustom tags-tag-face 'default | |
118 "*Face for tags in the output of `tags-apropos'." | |
119 :group 'etags | |
120 :type 'face | |
121 :version "21.1") | |
122 | |
123 (defcustom tags-apropos-verbose nil | |
124 "If non-nil, print the name of the tags file in the *Tags List* buffer." | |
125 :group 'etags | |
126 :type 'boolean | |
127 :version "21.1") | |
128 | |
129 (defcustom tags-apropos-additional-actions nil | |
130 "Specify additional actions for `tags-apropos'. | |
131 | |
132 If non-nil, value should be a list of triples (TITLE FUNCTION | |
133 TO-SEARCH). For each triple, `tags-apropos' processes TO-SEARCH and | |
134 lists tags from it. TO-SEARCH should be an alist, obarray, or symbol. | |
135 If it is a symbol, the symbol's value is used. | |
136 TITLE. a string, is a title used to label the additional list of tags. | |
137 FUNCTION is a function to call when a symbol is selected in the | |
138 *Tags List* buffer. It will be called with one argument SYMBOL which | |
139 is the symbol being selected. | |
140 | |
141 Example value: | |
142 | |
143 '((\"Emacs Lisp\" Info-goto-emacs-command-node obarray) | |
144 (\"Common Lisp\" common-lisp-hyperspec common-lisp-hyperspec-obarray) | |
145 (\"SCWM\" scwm-documentation scwm-obarray))" | |
146 :group 'etags | |
147 :type 'list | |
148 :version "21.1") | |
149 | |
116 (defvar find-tag-marker-ring (make-ring find-tag-marker-ring-length) | 150 (defvar find-tag-marker-ring (make-ring find-tag-marker-ring-length) |
117 "Ring of markers which are locations from which \\[find-tag] was invoked.") | 151 "Ring of markers which are locations from which \\[find-tag] was invoked.") |
118 | 152 |
119 (defvar default-tags-table-function nil | 153 (defvar default-tags-table-function nil |
120 "If non-nil, a function to choose a default tags file for a buffer. | 154 "If non-nil, a function to choose a default tags file for a buffer. |
131 (defvar tags-table-files nil | 165 (defvar tags-table-files nil |
132 "List of file names covered by current tags table. | 166 "List of file names covered by current tags table. |
133 nil means it has not yet been computed; use `tags-table-files' to do so.") | 167 nil means it has not yet been computed; use `tags-table-files' to do so.") |
134 | 168 |
135 (defvar tags-completion-table nil | 169 (defvar tags-completion-table nil |
136 "Alist of tag names defined in current tags table.") | 170 "Obarray of tag names defined in current tags table.") |
137 | 171 |
138 (defvar tags-included-tables nil | 172 (defvar tags-included-tables nil |
139 "List of tags tables included by the current tags table.") | 173 "List of tags tables included by the current tags table.") |
140 | 174 |
141 (defvar next-file-list nil | 175 (defvar next-file-list nil |
142 "List of files for \\[next-file] to process.") | 176 "List of files for \\[next-file] to process.") |
143 | 177 |
144 ;; Hooks for file formats. | 178 ;; Hooks for file formats. |
145 | 179 |
146 (defvar tags-table-format-hooks '(etags-recognize-tags-table | 180 (defvar tags-table-format-hooks '(etags-recognize-tags-table |
147 recognize-empty-tags-table) | 181 tags-recognize-empty-tags-table) |
148 "List of functions to be called in a tags table buffer to identify the type of tags table. | 182 "List of functions to be called in a tags table buffer to identify the type of tags table. |
149 The functions are called in order, with no arguments, | 183 The functions are called in order, with no arguments, |
150 until one returns non-nil. The function should make buffer-local bindings | 184 until one returns non-nil. The function should make buffer-local bindings |
151 of the format-parsing tags function variables if successful.") | 185 of the format-parsing tags function variables if successful.") |
152 | 186 |
523 t)))))) | 557 t)))))) |
524 | 558 |
525 ;; Expand the table name into a full file name. | 559 ;; Expand the table name into a full file name. |
526 (setq tags-file-name (tags-expand-table-name tags-file-name)) | 560 (setq tags-file-name (tags-expand-table-name tags-file-name)) |
527 | 561 |
528 (if (and (eq cont t) | 562 (unless (and (eq cont t) (null tags-table-list-pointer)) |
529 (null tags-table-list-pointer)) | |
530 ;; All out of tables. | |
531 nil | |
532 | |
533 ;; Verify that tags-file-name names a valid tags table. | 563 ;; Verify that tags-file-name names a valid tags table. |
534 ;; Bind another variable with the value of tags-file-name | 564 ;; Bind another variable with the value of tags-file-name |
535 ;; before we switch buffers, in case tags-file-name is buffer-local. | 565 ;; before we switch buffers, in case tags-file-name is buffer-local. |
536 (let ((curbuf (current-buffer)) | 566 (let ((curbuf (current-buffer)) |
537 (local-tags-file-name tags-file-name)) | 567 (local-tags-file-name tags-file-name)) |
673 (let ((tags-file-name (car included))) | 703 (let ((tags-file-name (car included))) |
674 (visit-tags-table-buffer 'same)) | 704 (visit-tags-table-buffer 'same)) |
675 ;; Recurse in that buffer to compute its completion table. | 705 ;; Recurse in that buffer to compute its completion table. |
676 (if (tags-completion-table) | 706 (if (tags-completion-table) |
677 ;; Combine the tables. | 707 ;; Combine the tables. |
678 (mapatoms (function | 708 (mapatoms (lambda (sym) (intern (symbol-name sym) table)) |
679 (lambda (sym) | |
680 (intern (symbol-name sym) table))) | |
681 tags-completion-table)) | 709 tags-completion-table)) |
682 (setq included (cdr included)))) | 710 (setq included (cdr included)))) |
683 (setq tags-completion-table table)) | 711 (setq tags-completion-table table)) |
684 (message "Making tags completion table for %s...done" | 712 (message "Making tags completion table for %s...done" |
685 buffer-file-name)) | 713 buffer-file-name)) |
1064 (defun etags-recognize-tags-table () | 1092 (defun etags-recognize-tags-table () |
1065 (and (etags-verify-tags-table) | 1093 (and (etags-verify-tags-table) |
1066 ;; It is annoying to flash messages on the screen briefly, | 1094 ;; It is annoying to flash messages on the screen briefly, |
1067 ;; and this message is not useful. -- rms | 1095 ;; and this message is not useful. -- rms |
1068 ;; (message "%s is an `etags' TAGS file" buffer-file-name) | 1096 ;; (message "%s is an `etags' TAGS file" buffer-file-name) |
1069 (mapcar (function (lambda (elt) | 1097 (mapcar (lambda (elt) (set (make-local-variable (car elt)) (cdr elt))) |
1070 (set (make-local-variable (car elt)) (cdr elt)))) | |
1071 '((file-of-tag-function . etags-file-of-tag) | 1098 '((file-of-tag-function . etags-file-of-tag) |
1072 (tags-table-files-function . etags-tags-table-files) | 1099 (tags-table-files-function . etags-tags-table-files) |
1073 (tags-completion-table-function . etags-tags-completion-table) | 1100 (tags-completion-table-function . etags-tags-completion-table) |
1074 (snarf-tag-function . etags-snarf-tag) | 1101 (snarf-tag-function . etags-snarf-tag) |
1075 (goto-tag-location-function . etags-goto-tag-location) | 1102 (goto-tag-location-function . etags-goto-tag-location) |
1112 ;; \4 is not interesting; | 1139 ;; \4 is not interesting; |
1113 ;; \5 is the explicitly-specified tag name. | 1140 ;; \5 is the explicitly-specified tag name. |
1114 ;; \6 is the line to start searching at; | 1141 ;; \6 is the line to start searching at; |
1115 ;; \7 is the char to start searching at. | 1142 ;; \7 is the char to start searching at. |
1116 (while (re-search-forward | 1143 (while (re-search-forward |
1117 "^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\ | 1144 "^\\(\\([^\177]+[^-a-zA-Z0-9_+*$\177]+\\)?\ |
1118 \[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\ | 1145 \\([-a-zA-Z0-9_+*$?:]+\\)[^-a-zA-Z0-9_+*$?:\177]*\\)\177\ |
1119 \\([0-9]+\\)?,\\([0-9]+\\)?\n" | 1146 \\(\\([^\n\001]+\\)\001\\)?\\([0-9]+\\)?,\\([0-9]+\\)?\n" |
1120 nil t) | 1147 nil t) |
1121 (intern (if (match-beginning 5) | 1148 (intern (if (match-beginning 5) |
1122 ;; There is an explicit tag name. | 1149 ;; There is an explicit tag name. |
1123 (buffer-substring (match-beginning 5) (match-end 5)) | 1150 (buffer-substring (match-beginning 5) (match-end 5)) |
1124 ;; No explicit tag name. Best guess. | 1151 ;; No explicit tag name. Best guess. |
1217 (forward-char 1)) | 1244 (forward-char 1)) |
1218 (beginning-of-line))) | 1245 (beginning-of-line))) |
1219 | 1246 |
1220 (defun etags-list-tags (file) | 1247 (defun etags-list-tags (file) |
1221 (goto-char 1) | 1248 (goto-char 1) |
1222 (if (not (search-forward (concat "\f\n" file ",") nil t)) | 1249 (when (search-forward (concat "\f\n" file ",") nil t) |
1223 nil | |
1224 (forward-line 1) | 1250 (forward-line 1) |
1225 (while (not (or (eobp) (looking-at "\f"))) | 1251 (while (not (or (eobp) (looking-at "\f"))) |
1226 (let ((tag (buffer-substring (point) | 1252 (let ((tag (buffer-substring (point) |
1227 (progn (skip-chars-forward "^\177") | 1253 (progn (skip-chars-forward "^\177") |
1228 (point))))) | 1254 (point)))) |
1229 (princ (if (looking-at "[^\n]+\001") | 1255 (props `(action find-tag-other-window mouse-face highlight |
1230 ;; There is an explicit tag name; use that. | 1256 face ,tags-tag-face)) |
1231 (buffer-substring (1+ (point)) ;skip \177 | 1257 (pt (with-current-buffer standard-output (point)))) |
1232 (progn (skip-chars-forward "^\001") | 1258 (when (looking-at "[^\n]+\001") |
1233 (point))) | 1259 ;; There is an explicit tag name; use that. |
1234 tag))) | 1260 (setq tag (buffer-substring (1+ (point)) ; skip \177 |
1261 (progn (skip-chars-forward "^\001") | |
1262 (point))))) | |
1263 (princ tag) | |
1264 (when (= (aref tag 0) ?\() (princ " ...)")) | |
1265 (add-text-properties pt (with-current-buffer standard-output (point)) | |
1266 (cons 'item (cons tag props)) standard-output)) | |
1235 (terpri) | 1267 (terpri) |
1236 (forward-line 1)) | 1268 (forward-line 1)) |
1237 t)) | 1269 t)) |
1238 | 1270 |
1271 (defmacro tags-with-face (face &rest body) | |
1272 "Execute BODY, give output to `standard-output' face FACE." | |
1273 (let ((pp (gensym "twf-"))) | |
1274 `(let ((,pp (with-current-buffer standard-output (point)))) | |
1275 ,@body | |
1276 (put-text-property ,pp (with-current-buffer standard-output (point)) | |
1277 'face ,face standard-output)))) | |
1278 | |
1279 (defun etags-tags-apropos-additional (regexp) | |
1280 "Display tags matching REGEXP from `tags-apropos-additional-actions'." | |
1281 (with-current-buffer standard-output | |
1282 (dolist (oba tags-apropos-additional-actions) | |
1283 (princ "\n\n") | |
1284 (tags-with-face 'highlight (princ (car oba))) | |
1285 (princ":\n\n") | |
1286 (let* ((props `(action ,(cadr oba) mouse-face highlight face | |
1287 ,tags-tag-face)) | |
1288 (beg (point)) | |
1289 (symbs (car (cddr oba))) | |
1290 (ins-symb (lambda (sy) | |
1291 (let ((sn (symbol-name sy))) | |
1292 (when (string-match regexp sn) | |
1293 (add-text-properties (point) | |
1294 (progn (princ sy) (point)) | |
1295 (cons 'item (cons sn props))) | |
1296 (terpri)))))) | |
1297 (when (symbolp symbs) | |
1298 (if (boundp symbs) | |
1299 (setq symbs (symbol-value symbs)) | |
1300 (insert "symbol `" (symbol-name symbs) "' has no value\n") | |
1301 (setq symbs nil))) | |
1302 (if (vectorp symbs) | |
1303 (mapatoms ins-symb symbs) | |
1304 (dolist (sy symbs) | |
1305 (funcall ins-symb (car sy)))) | |
1306 (sort-lines nil beg (point)))))) | |
1307 | |
1239 (defun etags-tags-apropos (string) | 1308 (defun etags-tags-apropos (string) |
1309 (when tags-apropos-verbose | |
1310 (princ "Tags in file `") | |
1311 (tags-with-face 'highlight (princ buffer-file-name)) | |
1312 (princ "':\n\n")) | |
1240 (goto-char 1) | 1313 (goto-char 1) |
1241 (while (re-search-forward string nil t) | 1314 (while (re-search-forward string nil t) |
1242 (beginning-of-line) | 1315 (beginning-of-line) |
1243 (princ (buffer-substring (point) | 1316 (let ((tag (buffer-substring (point) |
1244 (progn (skip-chars-forward "^\177") | 1317 (progn (skip-chars-forward "^\177") |
1245 (point)))) | 1318 (point)))) |
1319 (props `(action find-tag-other-window mouse-face highlight | |
1320 face ,tags-tag-face)) | |
1321 (pt (with-current-buffer standard-output (point)))) | |
1322 (princ tag) | |
1323 (when (= (aref tag 0) ?\() (princ " ...)")) | |
1324 (add-text-properties pt (with-current-buffer standard-output (point)) | |
1325 `(item ,tag ,@props) standard-output)) | |
1246 (terpri) | 1326 (terpri) |
1247 (forward-line 1))) | 1327 (forward-line 1)) |
1328 (when tags-apropos-verbose (princ "\n"))) | |
1248 | 1329 |
1249 (defun etags-tags-table-files () | 1330 (defun etags-tags-table-files () |
1250 (let ((files nil) | 1331 (let ((files nil) |
1251 beg) | 1332 beg) |
1252 (goto-char (point-min)) | 1333 (goto-char (point-min)) |
1274 | 1355 |
1275 ;; Empty tags file support. | 1356 ;; Empty tags file support. |
1276 | 1357 |
1277 ;; Recognize an empty file and give it local values of the tags table format | 1358 ;; Recognize an empty file and give it local values of the tags table format |
1278 ;; variables which do nothing. | 1359 ;; variables which do nothing. |
1279 (defun recognize-empty-tags-table () | 1360 (defun tags-recognize-empty-tags-table () |
1280 (and (zerop (buffer-size)) | 1361 (and (zerop (buffer-size)) |
1281 (mapcar (function (lambda (sym) | 1362 (mapcar (lambda (sym) (set (make-local-variable sym) 'ignore)) |
1282 (set (make-local-variable sym) 'ignore))) | |
1283 '(tags-table-files-function | 1363 '(tags-table-files-function |
1284 tags-completion-table-function | 1364 tags-completion-table-function |
1285 find-tag-regexp-search-function | 1365 find-tag-regexp-search-function |
1286 find-tag-search-function | 1366 find-tag-search-function |
1287 tags-apropos-function | 1367 tags-apropos-function |
1288 tags-included-tables-function)) | 1368 tags-included-tables-function)) |
1289 (set (make-local-variable 'verify-tags-table-function) | 1369 (set (make-local-variable 'verify-tags-table-function) |
1290 (function (lambda () | 1370 (lambda () (zerop (buffer-size)))))) |
1291 (zerop (buffer-size))))))) | |
1292 | 1371 |
1293 ;;; Match qualifier functions for tagnames. | 1372 ;; Match qualifier functions for tagnames. |
1294 ;;; XXX these functions assume etags file format. | 1373 ;; XXX these functions assume etags file format. |
1295 | 1374 |
1296 ;; This might be a neat idea, but it's too hairy at the moment. | 1375 ;; This might be a neat idea, but it's too hairy at the moment. |
1297 ;;(defmacro tags-with-syntax (&rest body) | 1376 ;;(defmacro tags-with-syntax (&rest body) |
1298 ;; (` (let ((current (current-buffer)) | 1377 ;; `(let ((current (current-buffer)) |
1299 ;; (otable (syntax-table)) | 1378 ;; (otable (syntax-table)) |
1300 ;; (buffer (find-file-noselect (file-of-tag))) | 1379 ;; (buffer (find-file-noselect (file-of-tag))) |
1301 ;; table) | 1380 ;; table) |
1302 ;; (unwind-protect | 1381 ;; (unwind-protect |
1303 ;; (progn | 1382 ;; (progn |
1304 ;; (set-buffer buffer) | 1383 ;; (set-buffer buffer) |
1305 ;; (setq table (syntax-table)) | 1384 ;; (setq table (syntax-table)) |
1306 ;; (set-buffer current) | 1385 ;; (set-buffer current) |
1307 ;; (set-syntax-table table) | 1386 ;; (set-syntax-table table) |
1308 ;; (,@ body)) | 1387 ;; ,@body) |
1309 ;; (set-syntax-table otable))))) | 1388 ;; (set-syntax-table otable)))) |
1310 ;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form)) | 1389 ;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form)) |
1311 | 1390 |
1312 ;; t if point is at a tag line that matches TAG exactly. | 1391 ;; t if point is at a tag line that matches TAG exactly. |
1313 ;; point should be just after a string that matches TAG. | 1392 ;; point should be just after a string that matches TAG. |
1314 (defun tag-exact-match-p (tag) | 1393 (defun tag-exact-match-p (tag) |
1400 (setq next-file-list (mapcar 'expand-file-name | 1479 (setq next-file-list (mapcar 'expand-file-name |
1401 (tags-table-files)))))))) | 1480 (tags-table-files)))))))) |
1402 (t | 1481 (t |
1403 ;; Initialize the list by evalling the argument. | 1482 ;; Initialize the list by evalling the argument. |
1404 (setq next-file-list (eval initialize)))) | 1483 (setq next-file-list (eval initialize)))) |
1405 (if next-file-list | 1484 (unless next-file-list |
1406 () | |
1407 (and novisit | 1485 (and novisit |
1408 (get-buffer " *next-file*") | 1486 (get-buffer " *next-file*") |
1409 (kill-buffer " *next-file*")) | 1487 (kill-buffer " *next-file*")) |
1410 (error "All files processed")) | 1488 (error "All files processed")) |
1411 (let* ((next (car next-file-list)) | 1489 (let* ((next (car next-file-list)) |
1555 directory specification." | 1633 directory specification." |
1556 (interactive (list (completing-read "List tags in file: " | 1634 (interactive (list (completing-read "List tags in file: " |
1557 'tags-complete-tags-table-file | 1635 'tags-complete-tags-table-file |
1558 nil t nil))) | 1636 nil t nil))) |
1559 (with-output-to-temp-buffer "*Tags List*" | 1637 (with-output-to-temp-buffer "*Tags List*" |
1560 (princ "Tags in file ") | 1638 (princ "Tags in file `") |
1561 (princ file) | 1639 (tags-with-face 'highlight (princ file)) |
1562 (terpri) | 1640 (princ "':\n\n") |
1563 (save-excursion | 1641 (save-excursion |
1564 (let ((first-time t) | 1642 (let ((first-time t) |
1565 (gotany nil)) | 1643 (gotany nil)) |
1566 (while (visit-tags-table-buffer (not first-time)) | 1644 (while (visit-tags-table-buffer (not first-time)) |
1567 (setq first-time nil) | 1645 (setq first-time nil) |
1568 (if (funcall list-tags-function file) | 1646 (if (funcall list-tags-function file) |
1569 (setq gotany t))) | 1647 (setq gotany t))) |
1570 (or gotany | 1648 (or gotany |
1571 (error "File %s not in current tags tables" file)))))) | 1649 (error "File %s not in current tags tables" file))))) |
1650 (with-current-buffer "*Tags List*" | |
1651 (setq buffer-read-only t) | |
1652 (apropos-mode))) | |
1572 | 1653 |
1573 ;;;###autoload | 1654 ;;;###autoload |
1574 (defun tags-apropos (regexp) | 1655 (defun tags-apropos (regexp) |
1575 "Display list of all tags in tags table REGEXP matches." | 1656 "Display list of all tags in tags table REGEXP matches." |
1576 (interactive "sTags apropos (regexp): ") | 1657 (interactive "sTags apropos (regexp): ") |
1577 (with-output-to-temp-buffer "*Tags List*" | 1658 (with-output-to-temp-buffer "*Tags List*" |
1578 (princ "Tags matching regexp ") | 1659 (princ "Click mouse-2 to follow tags.\n\nTags matching regexp `") |
1579 (prin1 regexp) | 1660 (tags-with-face 'highlight (princ regexp)) |
1580 (terpri) | 1661 (princ "':\n\n") |
1581 (save-excursion | 1662 (save-excursion |
1582 (let ((first-time t)) | 1663 (let ((first-time t)) |
1583 (while (visit-tags-table-buffer (not first-time)) | 1664 (while (visit-tags-table-buffer (not first-time)) |
1584 (setq first-time nil) | 1665 (setq first-time nil) |
1585 (funcall tags-apropos-function regexp)))))) | 1666 (funcall tags-apropos-function regexp)))) |
1667 (etags-tags-apropos-additional regexp)) | |
1668 (with-current-buffer "*Tags List*" | |
1669 (setq buffer-read-only t) | |
1670 (apropos-mode))) | |
1586 | 1671 |
1587 ;;; XXX Kludge interface. | 1672 ;;; XXX Kludge interface. |
1588 | 1673 |
1589 ;; XXX If a file is in multiple tables, selection may get the wrong one. | 1674 ;; XXX If a file is in multiple tables, selection may get the wrong one. |
1590 ;;;###autoload | 1675 ;;;###autoload |
1596 (pop-to-buffer "*Tags Table List*") | 1681 (pop-to-buffer "*Tags Table List*") |
1597 (setq buffer-read-only nil) | 1682 (setq buffer-read-only nil) |
1598 (erase-buffer) | 1683 (erase-buffer) |
1599 (let ((set-list tags-table-set-list) | 1684 (let ((set-list tags-table-set-list) |
1600 (desired-point nil)) | 1685 (desired-point nil)) |
1601 (if tags-table-list | 1686 (when tags-table-list |
1602 (progn | |
1603 (setq desired-point (point-marker)) | 1687 (setq desired-point (point-marker)) |
1604 (princ tags-table-list (current-buffer)) | 1688 (princ tags-table-list (current-buffer)) |
1605 (insert "\C-m") | 1689 (insert "\C-m") |
1606 (prin1 (car tags-table-list) (current-buffer)) ;invisible | 1690 (prin1 (car tags-table-list) (current-buffer)) ;invisible |
1607 (insert "\n"))) | 1691 (insert "\n")) |
1608 (while set-list | 1692 (while set-list |
1609 (if (eq (car set-list) tags-table-list) | 1693 (unless (eq (car set-list) tags-table-list) |
1610 ;; Already printed it. | |
1611 () | |
1612 (princ (car set-list) (current-buffer)) | 1694 (princ (car set-list) (current-buffer)) |
1613 (insert "\C-m") | 1695 (insert "\C-m") |
1614 (prin1 (car (car set-list)) (current-buffer)) ;invisible | 1696 (prin1 (car (car set-list)) (current-buffer)) ;invisible |
1615 (insert "\n")) | 1697 (insert "\n")) |
1616 (setq set-list (cdr set-list))) | 1698 (setq set-list (cdr set-list))) |
1617 (if tags-file-name | 1699 (when tags-file-name |
1618 (progn | |
1619 (or desired-point | 1700 (or desired-point |
1620 (setq desired-point (point-marker))) | 1701 (setq desired-point (point-marker))) |
1621 (insert tags-file-name "\C-m") | 1702 (insert tags-file-name "\C-m") |
1622 (prin1 tags-file-name (current-buffer)) ;invisible | 1703 (prin1 tags-file-name (current-buffer)) ;invisible |
1623 (insert "\n"))) | 1704 (insert "\n")) |
1624 (setq set-list (delete tags-file-name | 1705 (setq set-list (delete tags-file-name |
1625 (apply 'nconc (cons (copy-sequence tags-table-list) | 1706 (apply 'nconc (cons (copy-sequence tags-table-list) |
1626 (mapcar 'copy-sequence | 1707 (mapcar 'copy-sequence |
1627 tags-table-set-list))))) | 1708 tags-table-set-list))))) |
1628 (while set-list | 1709 (while set-list |
1697 (or pattern | 1778 (or pattern |
1698 (error "Nothing to complete")) | 1779 (error "Nothing to complete")) |
1699 (search-backward pattern) | 1780 (search-backward pattern) |
1700 (setq beg (point)) | 1781 (setq beg (point)) |
1701 (forward-char (length pattern)) | 1782 (forward-char (length pattern)) |
1702 (setq completion (try-completion pattern 'tags-complete-tag nil)) | 1783 (setq completion (tags-complete-tag pattern nil nil)) |
1703 (cond ((eq completion t)) | 1784 (cond ((eq completion t)) |
1704 ((null completion) | 1785 ((null completion) |
1705 (message "Can't find completion for \"%s\"" pattern) | 1786 (message "Can't find completion for \"%s\"" pattern) |
1706 (ding)) | 1787 (ding)) |
1707 ((not (string= pattern completion)) | 1788 ((not (string= pattern completion)) |