222 |
of the format-parsing tags function variables if successful.") |
of the format-parsing tags function variables if successful.") |
223 |
|
|
224 |
(defvar file-of-tag-function nil |
(defvar file-of-tag-function nil |
225 |
"Function to do the work of `file-of-tag' (which see).") |
"Function to do the work of `file-of-tag' (which see). |
226 |
|
One optional argument, a boolean specifying to return complete path (nil) or |
227 |
|
relative path (non-nil).") |
228 |
(defvar tags-table-files-function nil |
(defvar tags-table-files-function nil |
229 |
"Function to do the work of `tags-table-files' (which see).") |
"Function to do the work of `tags-table-files' (which see).") |
230 |
(defvar tags-completion-table-function nil |
(defvar tags-completion-table-function nil |
231 |
"Function to build the `tags-completion-table'.") |
"Function to build the `tags-completion-table'.") |
232 |
(defvar snarf-tag-function nil |
(defvar snarf-tag-function nil |
233 |
"Function to get info about a matched tag for `goto-tag-location-function'.") |
"Function to get info about a matched tag for `goto-tag-location-function'. |
234 |
|
One optional argument, specifying to use explicit tag (non-nil) or not (nil). |
235 |
|
The default is nil.") |
236 |
(defvar goto-tag-location-function nil |
(defvar goto-tag-location-function nil |
237 |
"Function of to go to the location in the buffer specified by a tag. |
"Function of to go to the location in the buffer specified by a tag. |
238 |
One argument, the tag info returned by `snarf-tag-function'.") |
One argument, the tag info returned by `snarf-tag-function'.") |
707 |
tags-table-list-started-at nil |
tags-table-list-started-at nil |
708 |
tags-table-set-list nil)) |
tags-table-set-list nil)) |
709 |
|
|
710 |
(defun file-of-tag () |
(defun file-of-tag (&optional relative) |
711 |
"Return the file name of the file whose tags point is within. |
"Return the file name of the file whose tags point is within. |
712 |
Assumes the tags table is the current buffer. |
Assumes the tags table is the current buffer. |
713 |
File name returned is relative to tags table file's directory." |
If RELATIVE is non-nil, file name returned is relative to tags |
714 |
(funcall file-of-tag-function)) |
table file's directory. If RELATIVE is nil, file name returned |
715 |
|
is complete." |
716 |
|
(funcall file-of-tag-function relative)) |
717 |
|
|
718 |
;;;###autoload |
;;;###autoload |
719 |
(defun tags-table-files () |
(defun tags-table-files () |
1149 |
|
|
1150 |
;; Get the local value in the tags table buffer before switching buffers. |
;; Get the local value in the tags table buffer before switching buffers. |
1151 |
(setq goto-func goto-tag-location-function) |
(setq goto-func goto-tag-location-function) |
1152 |
|
(find-file-of-tag-noselect file) |
|
;; Find the right line in the specified file. |
|
|
;; If we are interested in compressed-files, |
|
|
;; we search files with extensions. |
|
|
;; otherwise only the real file. |
|
|
(let* ((buffer-search-extensions (if (featurep 'jka-compr) |
|
|
tags-compression-info-list |
|
|
'(""))) |
|
|
the-buffer |
|
|
(file-search-extensions buffer-search-extensions)) |
|
|
;; search a buffer visiting the file with each possible extension |
|
|
;; Note: there is a small inefficiency in find-buffer-visiting : |
|
|
;; truename is computed even if not needed. Not too sure about this |
|
|
;; but I suspect truename computation accesses the disk. |
|
|
;; It is maybe a good idea to optimise this find-buffer-visiting. |
|
|
;; An alternative would be to use only get-file-buffer |
|
|
;; but this looks less "sure" to find the buffer for the file. |
|
|
(while (and (not the-buffer) buffer-search-extensions) |
|
|
(setq the-buffer (find-buffer-visiting (concat file (car buffer-search-extensions)))) |
|
|
(setq buffer-search-extensions (cdr buffer-search-extensions))) |
|
|
;; if found a buffer but file modified, ensure we re-read ! |
|
|
(if (and the-buffer (not (verify-visited-file-modtime the-buffer))) |
|
|
(find-file-noselect (buffer-file-name the-buffer))) |
|
|
;; if no buffer found, search for files with possible extensions on disk |
|
|
(while (and (not the-buffer) file-search-extensions) |
|
|
(if (not (file-exists-p (concat file (car file-search-extensions)))) |
|
|
(setq file-search-extensions (cdr file-search-extensions)) |
|
|
(setq the-buffer (find-file-noselect (concat file (car file-search-extensions)))))) |
|
|
(if (not the-buffer) |
|
|
(if (featurep 'jka-compr) |
|
|
(error "File %s (with or without extensions %s) not found" file tags-compression-info-list) |
|
|
(error "File %s not found" file)) |
|
|
(set-buffer the-buffer))) |
|
1153 |
(widen) |
(widen) |
1154 |
(push-mark) |
(push-mark) |
1155 |
(funcall goto-func tag-info) |
(funcall goto-func tag-info) |
1156 |
|
|
1157 |
;; Return the buffer where the tag was found. |
;; Return the buffer where the tag was found. |
1158 |
(current-buffer)))) |
(current-buffer)))) |
1159 |
|
|
1160 |
|
(defun find-file-of-tag-noselect (file) |
1161 |
|
;; Find the right line in the specified file. |
1162 |
|
;; If we are interested in compressed-files, |
1163 |
|
;; we search files with extensions. |
1164 |
|
;; otherwise only the real file. |
1165 |
|
(let* ((buffer-search-extensions (if (featurep 'jka-compr) |
1166 |
|
tags-compression-info-list |
1167 |
|
'(""))) |
1168 |
|
the-buffer |
1169 |
|
(file-search-extensions buffer-search-extensions)) |
1170 |
|
;; search a buffer visiting the file with each possible extension |
1171 |
|
;; Note: there is a small inefficiency in find-buffer-visiting : |
1172 |
|
;; truename is computed even if not needed. Not too sure about this |
1173 |
|
;; but I suspect truename computation accesses the disk. |
1174 |
|
;; It is maybe a good idea to optimise this find-buffer-visiting. |
1175 |
|
;; An alternative would be to use only get-file-buffer |
1176 |
|
;; but this looks less "sure" to find the buffer for the file. |
1177 |
|
(while (and (not the-buffer) buffer-search-extensions) |
1178 |
|
(setq the-buffer (find-buffer-visiting (concat file (car buffer-search-extensions)))) |
1179 |
|
(setq buffer-search-extensions (cdr buffer-search-extensions))) |
1180 |
|
;; if found a buffer but file modified, ensure we re-read ! |
1181 |
|
(if (and the-buffer (not (verify-visited-file-modtime the-buffer))) |
1182 |
|
(find-file-noselect (buffer-file-name the-buffer))) |
1183 |
|
;; if no buffer found, search for files with possible extensions on disk |
1184 |
|
(while (and (not the-buffer) file-search-extensions) |
1185 |
|
(if (not (file-exists-p (concat file (car file-search-extensions)))) |
1186 |
|
(setq file-search-extensions (cdr file-search-extensions)) |
1187 |
|
(setq the-buffer (find-file-noselect (concat file (car file-search-extensions)))))) |
1188 |
|
(if (not the-buffer) |
1189 |
|
(if (featurep 'jka-compr) |
1190 |
|
(error "File %s (with or without extensions %s) not found" file tags-compression-info-list) |
1191 |
|
(error "File %s not found" file)) |
1192 |
|
(set-buffer the-buffer)))) |
1193 |
|
|
1194 |
|
(defun find-file-of-tag (file) |
1195 |
|
(let ((buf (find-file-of-tag-noselect file))) |
1196 |
|
(condition-case nil |
1197 |
|
(switch-to-buffer buf) |
1198 |
|
(error (pop-to-buffer buf))))) |
1199 |
|
|
1200 |
;; `etags' TAGS file format support. |
;; `etags' TAGS file format support. |
1201 |
|
|
1236 |
;; Use eq instead of = in case char-after returns nil. |
;; Use eq instead of = in case char-after returns nil. |
1237 |
(eq (char-after (point-min)) ?\f)) |
(eq (char-after (point-min)) ?\f)) |
1238 |
|
|
1239 |
(defun etags-file-of-tag () |
(defun etags-file-of-tag (&optional relative) |
1240 |
(save-excursion |
(save-excursion |
1241 |
(re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n") |
(re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n") |
1242 |
(expand-file-name (buffer-substring (match-beginning 1) (match-end 1)) |
(let ((str (buffer-substring (match-beginning 1) (match-end 1)))) |
1243 |
(file-truename default-directory)))) |
(if relative |
1244 |
|
str |
1245 |
|
(expand-file-name str |
1246 |
|
(file-truename default-directory)))))) |
1247 |
|
|
1248 |
|
|
1249 |
(defun etags-tags-completion-table () |
(defun etags-tags-completion-table () |
1271 |
table))) |
table))) |
1272 |
table)) |
table)) |
1273 |
|
|
1274 |
(defun etags-snarf-tag () |
(defun etags-snarf-tag (&optional use-explicit) |
1275 |
(let (tag-text line startpos) |
(let (tag-text line startpos explicit-start) |
1276 |
(if (save-excursion |
(if (save-excursion |
1277 |
(forward-line -1) |
(forward-line -1) |
1278 |
(looking-at "\f\n")) |
(looking-at "\f\n")) |
1288 |
(setq tag-text (buffer-substring (1- (point)) |
(setq tag-text (buffer-substring (1- (point)) |
1289 |
(save-excursion (beginning-of-line) |
(save-excursion (beginning-of-line) |
1290 |
(point)))) |
(point)))) |
1291 |
;; Skip explicit tag name if present. |
;; If use-explicit is non nil and explicit tag is present, use it as part of |
1292 |
(search-forward "\001" (save-excursion (forward-line 1) (point)) t) |
;; return value. Else just skip it. |
1293 |
|
(setq explicit-start (point)) |
1294 |
|
(when (and (search-forward "\001" (save-excursion (forward-line 1) (point)) t) |
1295 |
|
use-explicit) |
1296 |
|
(setq tag-text (buffer-substring explicit-start (1- (point))))) |
1297 |
|
|
1298 |
|
|
1299 |
(if (looking-at "[0-9]") |
(if (looking-at "[0-9]") |
1300 |
(setq line (string-to-int (buffer-substring |
(setq line (string-to-int (buffer-substring |
1301 |
(point) |
(point) |
1370 |
|
|
1371 |
(defun etags-list-tags (file) |
(defun etags-list-tags (file) |
1372 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1373 |
(when (search-forward (concat "\f\n" file ",") nil t) |
(when (re-search-forward (concat "\f\n" "\\(" file "\\)" ",") nil t) |
1374 |
|
(let ((path (save-excursion (forward-line 1) (file-of-tag))) |
1375 |
|
;; Get the local value in the tags table |
1376 |
|
;; buffer before switching buffers. |
1377 |
|
(goto-func goto-tag-location-function) |
1378 |
|
tag tag-info pt) |
1379 |
(forward-line 1) |
(forward-line 1) |
1380 |
(while (not (or (eobp) (looking-at "\f"))) |
(while (not (or (eobp) (looking-at "\f"))) |
1381 |
(let ((tag (buffer-substring (point) |
(setq tag-info (save-excursion (funcall snarf-tag-function t)) |
1382 |
(progn (skip-chars-forward "^\177") |
tag (car tag-info) |
1383 |
(point)))) |
pt (with-current-buffer standard-output (point))) |
1384 |
(props `(action find-tag-other-window mouse-face highlight |
(princ tag) |
1385 |
face ,tags-tag-face)) |
(when (= (aref tag 0) ?\() (princ " ...)")) |
1386 |
(pt (with-current-buffer standard-output (point)))) |
(with-current-buffer standard-output |
1387 |
(when (looking-at "[^\n]+\001") |
(make-text-button pt (point) |
1388 |
;; There is an explicit tag name; use that. |
'tag-info tag-info |
1389 |
(setq tag (buffer-substring (1+ (point)) ; skip \177 |
'file-path path |
1390 |
(progn (skip-chars-forward "^\001") |
'goto-func goto-func |
1391 |
(point))))) |
'action (lambda (button) |
1392 |
(princ tag) |
(let ((tag-info (button-get button 'tag-info)) |
1393 |
(when (= (aref tag 0) ?\() (princ " ...)")) |
(goto-func (button-get button 'goto-func))) |
1394 |
(add-text-properties pt (with-current-buffer standard-output (point)) |
(find-file-of-tag (button-get button 'file-path)) |
1395 |
(cons 'item (cons tag props)) standard-output)) |
(widen) |
1396 |
|
(funcall goto-func tag-info))) |
1397 |
|
'face 'tags-tag-face |
1398 |
|
'type 'button)) |
1399 |
(terpri) |
(terpri) |
1400 |
(forward-line 1)) |
(forward-line 1)) |
1401 |
t)) |
t))) |
1402 |
|
|
1403 |
(defmacro tags-with-face (face &rest body) |
(defmacro tags-with-face (face &rest body) |
1404 |
"Execute BODY, give output to `standard-output' face FACE." |
"Execute BODY, give output to `standard-output' face FACE." |
1415 |
(princ "\n\n") |
(princ "\n\n") |
1416 |
(tags-with-face 'highlight (princ (car oba))) |
(tags-with-face 'highlight (princ (car oba))) |
1417 |
(princ":\n\n") |
(princ":\n\n") |
1418 |
(let* ((props `(action ,(cadr oba) mouse-face highlight face |
(let* ((beg (point)) |
|
,tags-tag-face)) |
|
|
(beg (point)) |
|
1419 |
(symbs (car (cddr oba))) |
(symbs (car (cddr oba))) |
1420 |
(ins-symb (lambda (sy) |
(ins-symb (lambda (sy) |
1421 |
(let ((sn (symbol-name sy))) |
(let ((sn (symbol-name sy))) |
1422 |
(when (string-match regexp sn) |
(when (string-match regexp sn) |
1423 |
(add-text-properties (point) |
(make-text-button (point) |
1424 |
(progn (princ sy) (point)) |
(progn (princ sy) (point)) |
1425 |
(cons 'item (cons sn props))) |
'action-internal(cadr oba) |
1426 |
|
'action (lambda (button) (funcall |
1427 |
|
(button-get button 'action-internal) |
1428 |
|
(button-get button 'item))) |
1429 |
|
'item sn |
1430 |
|
'face tags-tag-face |
1431 |
|
'type 'button) |
1432 |
(terpri)))))) |
(terpri)))))) |
1433 |
(when (symbolp symbs) |
(when (symbolp symbs) |
1434 |
(if (boundp symbs) |
(if (boundp symbs) |
1449 |
(goto-char (point-min)) |
(goto-char (point-min)) |
1450 |
(while (re-search-forward string nil t) |
(while (re-search-forward string nil t) |
1451 |
(beginning-of-line) |
(beginning-of-line) |
1452 |
(let* ((tag-info (save-excursion (funcall snarf-tag-function))) |
|
1453 |
|
(let* (;; Get the local value in the tags table |
1454 |
|
;; buffer before switching buffers. |
1455 |
|
(goto-func goto-tag-location-function) |
1456 |
|
(tag-info (save-excursion (funcall snarf-tag-function))) |
1457 |
(tag (if (eq t (car tag-info)) nil (car tag-info))) |
(tag (if (eq t (car tag-info)) nil (car tag-info))) |
1458 |
(file (if tag (file-of-tag) |
(file-path (save-excursion (if tag (file-of-tag) |
1459 |
(save-excursion (next-line 1) |
(save-excursion (next-line 1) |
1460 |
(file-of-tag)))) |
(file-of-tag))))) |
1461 |
|
(file-label (if tag (file-of-tag t) |
1462 |
|
(save-excursion (next-line 1) |
1463 |
|
(file-of-tag t)))) |
1464 |
(pt (with-current-buffer standard-output (point)))) |
(pt (with-current-buffer standard-output (point)))) |
1465 |
(if tag |
(if tag |
1466 |
(progn |
(progn |
1467 |
(princ (format "[%s]: " file)) |
(princ (format "[%s]: " file-label)) |
1468 |
(princ tag) |
(princ tag) |
1469 |
(when (= (aref tag 0) ?\() (princ " ...)")) |
(when (= (aref tag 0) ?\() (princ " ...)")) |
1470 |
(with-current-buffer standard-output |
(with-current-buffer standard-output |
1471 |
(make-text-button pt (point) |
(make-text-button pt (point) |
1472 |
'tag-info tag-info |
'tag-info tag-info |
1473 |
'file file |
'file-path file-path |
1474 |
'action (lambda (button) |
'goto-func goto-func |
1475 |
;; TODO: just `find-file is too simple. |
'action (lambda (button) |
1476 |
;; Use code `find-tag-in-order'. |
(let ((tag-info (button-get button 'tag-info)) |
1477 |
(let ((tag-info (button-get button 'tag-info))) |
(goto-func (button-get button 'goto-func))) |
1478 |
(find-file (button-get button 'file)) |
(find-file-of-tag (button-get button 'file-path)) |
1479 |
(etags-goto-tag-location tag-info))) |
(widen) |
1480 |
'face 'tags-tag-face |
(funcall goto-func tag-info))) |
1481 |
'type 'button))) |
'face 'tags-tag-face |
1482 |
(princ (format "- %s" file)) |
'type 'button))) |
1483 |
|
(princ (format "- %s" file-label)) |
1484 |
(with-current-buffer standard-output |
(with-current-buffer standard-output |
1485 |
(make-text-button pt (point) |
(make-text-button pt (point) |
1486 |
'file file |
'file-path file-path |
1487 |
'action (lambda (button) |
'action (lambda (button) |
1488 |
;; TODO: just `find-file is too simple. |
(find-file-of-tag (button-get button 'file-path)) |
1489 |
;; Use code `find-tag-in-order'. |
;; Get the local value in the tags table |
1490 |
(find-file (button-get button 'file)) |
;; buffer before switching buffers. |
1491 |
(goto-char (point-min))) |
(goto-char (point-min))) |
1492 |
'face 'tags-tag-face |
'face 'tags-tag-face |
1493 |
'type 'button)) |
'type 'button)) |
1494 |
)) |
)) |
1495 |
(terpri) |
(terpri) |
1496 |
(forward-line 1)) |
(forward-line 1)) |
1865 |
(or gotany |
(or gotany |
1866 |
(error "File %s not in current tags tables" file))))) |
(error "File %s not in current tags tables" file))))) |
1867 |
(with-current-buffer "*Tags List*" |
(with-current-buffer "*Tags List*" |
1868 |
(setq buffer-read-only t) |
(apropos-mode) |
1869 |
(apropos-mode))) |
(setq buffer-read-only t))) |
1870 |
|
|
1871 |
;;;###autoload |
;;;###autoload |
1872 |
(defun tags-apropos (regexp) |
(defun tags-apropos (regexp) |