X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/7450e102b1108ec2edc319a4d61ecc6f633be961..a28e0c3b186c123b158749de2d38815757d20962:/ggtags.el diff --git a/ggtags.el b/ggtags.el index 05b804446..d3f13a4ef 100644 --- a/ggtags.el +++ b/ggtags.el @@ -1,9 +1,9 @@ ;;; ggtags.el --- GNU Global source code tagging system -*- lexical-binding: t; -*- -;; Copyright (C) 2013 Leo Liu +;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Author: Leo Liu -;; Version: 0.5 +;; Version: 0.6 ;; Keywords: tools, convenience ;; Created: 2013-01-29 ;; URL: https://github.com/leoliu/ggtags @@ -69,28 +69,44 @@ If nil, use Emacs default." (defvar ggtags-current-tag-name nil) +;; Used by ggtags-global-mode +(defvar ggtags-global-error "match" + "Stem of message to print when no matches are found.") + (defmacro ggtags-ignore-file-error (&rest body) (declare (indent 0)) `(condition-case nil (progn ,@body) (file-error nil))) +;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1518 +(defvar ggtags-global-has-path-style ; introduced in global 6.2.8 + (ggtags-ignore-file-error + (and (string-match-p "^--path-style " + (shell-command-to-string "global --help")) + t)) + "Non-nil if `global' supports --path-style switch.") + (defmacro ggtags-ensure-global-buffer (&rest body) (declare (indent 0)) `(progn - (assert (and (buffer-live-p compilation-last-buffer) - (with-current-buffer compilation-last-buffer - (derived-mode-p 'ggtags-global-mode))) - nil "No global buffer found") + (or (and (buffer-live-p compilation-last-buffer) + (with-current-buffer compilation-last-buffer + (derived-mode-p 'ggtags-global-mode))) + (error "No global buffer found")) (with-current-buffer compilation-last-buffer ,@body))) -(defun ggtags-cache-timestamp (root) - "Get the timestamp of file GTAGS in ROOT directory." +(defun ggtags-get-timestamp (root) + "Get the timestamp (float) of file GTAGS in ROOT directory. +Return -1 if it does not exist." (let ((file (expand-file-name "GTAGS" root))) (if (file-exists-p file) (float-time (nth 5 (file-attributes file))) -1))) +(defun ggtags-get-libpath () + (split-string (or (getenv "GTAGSLIBPATH") "") ":" t)) + (defun ggtags-cache-get (key) (assoc key ggtags-cache)) @@ -112,7 +128,7 @@ If nil, use Emacs default." (defun ggtags-cache-stale-p (key) "Value is non-nil if tags in cache needs to be rebuilt." - (> (ggtags-cache-timestamp key) + (> (ggtags-get-timestamp key) (or (fourth (ggtags-cache-get key)) 0))) ;;;###autoload @@ -124,13 +140,13 @@ If nil, use Emacs default." (comment-string-strip (buffer-string) t t)))))) (defun ggtags-check-root-directory () - (assert (ggtags-root-directory) nil "File GTAGS not found")) + (or (ggtags-root-directory) (error "File GTAGS not found"))) (defun ggtags-ensure-root-directory () (or (ggtags-root-directory) (if (yes-or-no-p "File GTAGS not found; run gtags? ") (let ((root (read-directory-name "Directory: " nil nil t))) - (assert (not (zerop (length root))) nil "No directory chosen") + (and (= (length root) 0) (error "No directory chosen")) (ggtags-ignore-file-error (with-temp-buffer (if (zerop (let ((default-directory @@ -141,6 +157,19 @@ If nil, use Emacs default." (error "%s" (comment-string-strip (buffer-string) t t)))))) (error "Aborted")))) +(defun ggtags-tag-names-1 (root &optional prefix) + (when root + (if (ggtags-cache-stale-p root) + (let* ((default-directory (file-name-as-directory root)) + (tags (with-demoted-errors + (split-string + (with-output-to-string + (call-process "global" nil (list standard-output nil) + nil "-c" (or prefix ""))))))) + (and tags (ggtags-cache-set root tags)) + tags) + (cadr (ggtags-cache-get root))))) + ;;;###autoload (defun ggtags-tag-names (&optional prefix) "Get a list of tag names starting with PREFIX." @@ -149,33 +178,32 @@ If nil, use Emacs default." (if (zerop (call-process "global" nil nil nil "-u")) (ggtags-cache-mark-dirty root nil) (message "ggtags: error running 'global -u'"))) - (if (ggtags-cache-stale-p root) - (let ((tags (ggtags-ignore-file-error - (split-string - (with-output-to-string - (call-process "global" nil (list standard-output nil) - nil "-c" (or prefix ""))))))) - (when tags - (ggtags-cache-set root tags)) - tags) - (cadr (ggtags-cache-get root))))) + (apply 'append (mapcar (lambda (r) + (ggtags-tag-names-1 r prefix)) + (cons root (ggtags-get-libpath)))))) -(defun ggtags-read-tag (&optional reference) +(defun ggtags-read-tag (quick) (ggtags-ensure-root-directory) (let* ((tags (ggtags-tag-names)) (sym (thing-at-point 'symbol)) (default (and (member sym tags) sym))) (setq ggtags-current-tag-name - (completing-read - (format (if default - "%s for tag (default %s): " - "%s for tag: ") - (if reference "Reference" "Definition") default) - tags nil t nil nil default)))) + (if quick (or default (error "No valid tag at point")) + (completing-read + (format (if default "Tag (default %s): " "Tag: ") default) + tags nil t nil nil default))))) + +(defvar ggtags-global-options + (concat "-v --result=grep" + (and ggtags-global-has-path-style " --path-style=shorter")) + "Options (as a string) for running `global'.") ;;;###autoload -(defun ggtags-find-tag (name &optional reference) - (interactive (list (ggtags-read-tag current-prefix-arg) +(defun ggtags-find-tag (name &optional verbose) + "Find definitions or references to tag NAME by context. +If point is at a definition tag, find references, and vice versa. +When called with prefix, ask the name and kind of tag." + (interactive (list (ggtags-read-tag (not current-prefix-arg)) current-prefix-arg)) (ggtags-check-root-directory) (ggtags-navigation-mode +1) @@ -183,43 +211,34 @@ If nil, use Emacs default." (let ((split-window-preferred-function (lambda (w) (split-window (frame-root-window w)))) (default-directory (ggtags-root-directory))) - (compilation-start (format "global -v%s --result=grep \"%s\"" - (if reference "r" "") name) - 'ggtags-global-mode))) + (compilation-start + (if verbose + (format "global %s %s \"%s\"" + ggtags-global-options + (if (y-or-n-p "Kind (y for definition n for reference)? ") + "" "-r") + name) + (format "global %s --from-here=%d:%s \"%s\"" + ggtags-global-options + (line-number-at-pos) + (expand-file-name buffer-file-name) + name)) + 'ggtags-global-mode))) (defun ggtags-find-tag-resume () (interactive) (ggtags-ensure-global-buffer (ggtags-navigation-mode +1) - (compile-goto-error))) - -(defvar ggtags-tag-overlay nil) -(make-variable-buffer-local 'ggtags-tag-overlay) - -(defun ggtags-highlight-tag-at-point () - (unless (overlayp ggtags-tag-overlay) - (setq ggtags-tag-overlay (make-overlay (point) (point))) - (overlay-put ggtags-tag-overlay 'ggtags t)) - (let ((bounds (bounds-of-thing-at-point 'symbol))) - (cond - ((not bounds) - (overlay-put ggtags-tag-overlay 'face nil) - (move-overlay ggtags-tag-overlay (point) (point))) - ((notany (lambda (o) - (overlay-get o 'ggtags)) - (overlays-at (car bounds))) - (move-overlay ggtags-tag-overlay (car bounds) (cdr bounds)) - (overlay-put ggtags-tag-overlay 'face - (when (member (buffer-substring (car bounds) (cdr bounds)) - (ggtags-tag-names)) - 'ggtags-highlight)) - (overlay-put ggtags-tag-overlay 'window t))))) + (let ((split-window-preferred-function + (lambda (w) (split-window (frame-root-window w))))) + (compile-goto-error)))) (defun ggtags-global-exit-message-function (_process-status exit-status msg) (let ((count (save-excursion - (goto-char (point-min)) - (and (re-search-forward "^\\([0-9]+\\) objects? located" nil t) - (string-to-number (match-string 1)))))) + (goto-char (point-max)) + (if (re-search-backward "^\\([0-9]+\\) objects? located" nil t) + (string-to-number (match-string 1)) + 0)))) (cons (if (> exit-status 0) msg (format "found %d %s" count (if (= count 1) "match" "matches"))) @@ -353,10 +372,9 @@ If nil, use Emacs default." (if ggtags-navigation-mode (progn (add-hook 'next-error-hook 'ggtags-move-to-tag) - (add-hook 'minibuffer-setup-hook - 'ggtags-minibuffer-setup-function nil t)) + (add-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function)) (remove-hook 'next-error-hook 'ggtags-move-to-tag) - (remove-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function t))) + (remove-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function))) (defun ggtags-minibuffer-setup-function () ;; Disable ggtags-navigation-mode in minibuffer. @@ -367,12 +385,16 @@ If nil, use Emacs default." (interactive "p") (ggtags-check-root-directory) (let ((root (ggtags-root-directory)) - (count 0)) + (count 0) + (some (lambda (pred list) + (loop for x in list when (funcall pred x) return it)))) (dolist (buf (buffer-list)) (let ((file (and (buffer-live-p buf) (not (eq buf (current-buffer))) (buffer-file-name buf)))) - (when (and file (file-in-directory-p (file-truename file) root)) + (when (and file (funcall some (apply-partially #'file-in-directory-p + (file-truename file)) + (cons root (ggtags-get-libpath)))) (and (kill-buffer buf) (incf count))))) (and interactive @@ -382,10 +404,45 @@ If nil, use Emacs default." (let ((root (ggtags-root-directory))) (and root (ggtags-cache-mark-dirty root t)))) +(defvar ggtags-tag-overlay nil) +(defvar ggtags-highlight-tag-timer nil) +(make-variable-buffer-local 'ggtags-tag-overlay) + +(defun ggtags-highlight-tag-at-point (buffer) + (when (eq buffer (current-buffer)) + (unless (overlayp ggtags-tag-overlay) + (setq ggtags-tag-overlay (make-overlay (point) (point))) + (overlay-put ggtags-tag-overlay 'ggtags t)) + (let* ((bounds (bounds-of-thing-at-point 'symbol)) + (valid-tag (when bounds + (member (buffer-substring (car bounds) (cdr bounds)) + (ggtags-tag-names)))) + (o ggtags-tag-overlay) + (done-p (lambda () + (and (memq o (overlays-at (car bounds))) + (= (overlay-start o) (car bounds)) + (= (overlay-end o) (cdr bounds)) + (or (and valid-tag (overlay-get o 'face)) + (and (not valid-tag) (not (overlay-get o 'face)))))))) + (cond + ((not bounds) + (overlay-put ggtags-tag-overlay 'face nil) + (move-overlay ggtags-tag-overlay (point) (point))) + ((not (funcall done-p)) + (move-overlay o (car bounds) (cdr bounds)) + (overlay-put o 'face (and valid-tag 'ggtags-highlight))))))) + +(defun ggtags-post-command-function () + (when (timerp ggtags-highlight-tag-timer) + (cancel-timer ggtags-highlight-tag-timer)) + (setq ggtags-highlight-tag-timer + (run-with-idle-timer 0.2 nil 'ggtags-highlight-tag-at-point + (current-buffer)))) + (defvar ggtags-mode-map (let ((map (make-sparse-keymap))) (define-key map "\M-." 'ggtags-find-tag) - (define-key map "\C-c\M-n" 'ggtags-find-tag-resume) + (define-key map "\M-," 'ggtags-find-tag-resume) (define-key map "\C-c\M-k" 'ggtags-kill-file-buffers) map)) @@ -394,13 +451,12 @@ If nil, use Emacs default." :lighter (:eval (if ggtags-navigation-mode "" " GG")) (if ggtags-mode (progn - (unless (ggtags-root-directory) - (funcall (if (fboundp 'user-error) 'user-error 'message) - "File GTAGS not found")) + (or (ggtags-root-directory) + (message "File GTAGS not found")) (add-hook 'after-save-hook 'ggtags-after-save-function nil t) - (add-hook 'post-command-hook 'ggtags-highlight-tag-at-point nil t)) + (add-hook 'post-command-hook 'ggtags-post-command-function nil t)) (remove-hook 'after-save-hook 'ggtags-after-save-function t) - (remove-hook 'post-command-hook 'ggtags-highlight-tag-at-point t) + (remove-hook 'post-command-hook 'ggtags-post-command-function t) (and (overlayp ggtags-tag-overlay) (delete-overlay ggtags-tag-overlay)) (setq ggtags-tag-overlay nil))) @@ -413,10 +469,6 @@ If nil, use Emacs default." (forward-line (1- line)) (ggtags-move-to-tag name))) -;; NOTE: `ggtags-build-imenu-index' is signficantly faster and more -;; precise than the similar feature provided by cc mode. Tested with -;; ClassFileWriter.java of the rhino project. - ;;;###autoload (defun ggtags-build-imenu-index () "A function suitable for `imenu-create-index-function'."