;;; 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 <sdl.web@gmail.com>
-;; Version: 0.5
+;; Version: 0.6
;; Keywords: tools, convenience
;; Created: 2013-01-29
;; URL: https://github.com/leoliu/ggtags
(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))
(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
(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
(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."
(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)
(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")))
(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.
(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
(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))
: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)))
(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'."