;;; ggtags.el --- emacs frontend to GNU Global source code tagging system -*- lexical-binding: t; -*-
-;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
;; Author: Leo Liu <sdl.web@gmail.com>
-;; Version: 0.8.6
+;; Version: 0.8.10
;; Keywords: tools, convenience
;; Created: 2013-01-29
;; URL: https://github.com/leoliu/ggtags
;;
;; All commands are available from the `Ggtags' menu in `ggtags-mode'.
+;;; NEWS 0.8.10 (2015-06-12):
+
+;; - Tags update on save is configurable by `ggtags-update-on-save'.
+;; - New command `ggtags-explain-tags' to explain how each file is
+;; indexed in current project.
+;; - New user option `ggtags-sort-by-nearness' that sorts matched tags
+;; by nearness to current directory.
+;;
+;; See full NEWS on https://github.com/leoliu/ggtags#news
+
;;; Code:
(eval-when-compile
(list 'progn (list 'defvar var val docstring)
(list 'make-variable-buffer-local (list 'quote var)))))
+ (or (fboundp 'add-function) (defmacro add-function (&rest _))) ;24.4
+ (or (fboundp 'remove-function) (defmacro remove-function (&rest _)))
+
(defmacro ignore-errors-unless-debug (&rest body)
"Ignore all errors while executing BODY unless debug is on."
(declare (debug t) (indent 0))
:type 'boolean
:group 'ggtags)
+(defcustom ggtags-use-sqlite3 nil
+ "Use sqlite3 for storage instead of Berkeley DB.
+This feature requires GNU Global 6.3.3+ and is ignored if `gtags'
+isn't built with sqlite3 support."
+ :type 'boolean
+ :safe 'booleanp
+ :group 'ggtags)
+
+(defcustom ggtags-sort-by-nearness nil
+ "Sort tags by nearness to current directory.
+GNU Global 6.5+ required."
+ :type 'boolean
+ :safe #'booleanp
+ :group 'ggtags)
+
+(defcustom ggtags-update-on-save t
+ "Non-nil to update tags for current buffer on saving."
+ ;; It is reported that `global --single-update' can be slow in sshfs
+ ;; directories. See https://github.com/leoliu/ggtags/issues/85.
+ :safe #'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
(defcustom ggtags-global-output-format 'grep
"Global output format: path, ctags, ctags-x, grep or cscope."
:type '(choice (const path)
(expand-file-name name ggtags-executable-directory)
name))
+(defun ggtags-process-succeed-p (program &rest args)
+ "Return non-nil if successfully running PROGRAM with ARGS."
+ (let ((program (ggtags-program-path program)))
+ (condition-case err
+ (zerop (apply #'process-file program nil nil nil args))
+ (error (message "`%s' failed: %s" program (error-message-string err))
+ nil))))
+
(defun ggtags-process-string (program &rest args)
(with-temp-buffer
(let ((exit (apply #'process-file
'has-refs)))
;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1518
(has-path-style
- (with-demoted-errors "ggtags-make-project: %S"
- ;; in case `global' not found
- (and (zerop (process-file (ggtags-program-path "global")
- nil nil nil
- "--path-style" "shorter" "--help"))
- 'has-path-style)))
+ (and (ggtags-process-succeed-p "global" "--path-style" "shorter" "--help")
+ 'has-path-style))
;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1542
- (has-color
- (with-demoted-errors "ggtags-make-project: %S"
- (and (zerop (process-file (ggtags-program-path "global")
- nil nil nil
- "--color" "--help"))
- 'has-color))))
+ (has-color (and (ggtags-process-succeed-p "global" "--color" "--help")
+ 'has-color)))
(puthash default-directory
(ggtags-project--make :root default-directory
:tag-size tag-size
(defun ggtags-ensure-project ()
(or (ggtags-find-project)
- (when (or (yes-or-no-p "File GTAGS not found; run gtags? ")
- (user-error "Aborted"))
- (call-interactively #'ggtags-create-tags)
- ;; Need checking because `ggtags-create-tags' can create tags
- ;; in any directory.
- (ggtags-check-project))))
+ (progn (call-interactively #'ggtags-create-tags)
+ ;; Need checking because `ggtags-create-tags' can create
+ ;; tags in any directory.
+ (ggtags-check-project))))
(defvar delete-trailing-lines) ;new in 24.3
(message "Project read-only-mode is %s" (if val "on" "off")))
val))
-(defun ggtags-visit-project-root ()
- (interactive)
- (ggtags-ensure-project)
- (dired (ggtags-current-project-root)))
+(defun ggtags-visit-project-root (&optional project)
+ "Visit the root directory of (current) PROJECT in dired.
+When called with a prefix \\[universal-argument], choose from past projects."
+ (interactive (list (and current-prefix-arg
+ (completing-read "Project: " ggtags-projects))))
+ (dired (cl-typecase project
+ (string project)
+ (ggtags-project (ggtags-project-root project))
+ (t (ggtags-ensure-project) (ggtags-current-project-root)))))
(defmacro ggtags-with-current-project (&rest body)
"Eval BODY in current project's `process-environment'."
(when (ggtags-find-project)
(with-temp-buffer
(ggtags-with-current-project
- (process-file (ggtags-program-path "global") nil t nil
- "-vP" (concat "^" (ggtags-project-relative-file file) "$")))
+ ;; NOTE: `process-file' requires all files in ARGS be relative
+ ;; to `default-directory'; see its doc string for details.
+ (let ((default-directory (ggtags-current-project-root)))
+ (process-file (ggtags-program-path "global") nil t nil
+ "-vP" (concat "^" (ggtags-project-relative-file file) "$"))))
(goto-char (point-min))
(not (re-search-forward "^file not found" nil t)))))
(setenv "GTAGSLABEL" "ctags"))
(ggtags-with-temp-message "`gtags' in progress..."
(let ((default-directory (file-name-as-directory root))
- (args (cl-remove-if #'null
- (list (and ggtags-use-idutils "--idutils")
- (and conf "--gtagsconf")
- (and conf (ggtags-ensure-localname conf))))))
+ (args (cl-remove-if
+ #'null
+ (list (and ggtags-use-idutils "--idutils")
+ (and ggtags-use-sqlite3
+ (ggtags-process-succeed-p "gtags" "--sqlite3" "--help")
+ "--sqlite3")
+ (and conf "--gtagsconf")
+ (and conf (ggtags-ensure-localname conf))))))
(condition-case err
(apply #'ggtags-process-string "gtags" args)
(error (if (and ggtags-use-idutils
(message "GTAGS generated in `%s'" root)
root))
+(defun ggtags-explain-tags ()
+ "Explain how each file is indexed in current project."
+ (interactive (ignore (ggtags-check-project)
+ (or (ggtags-process-succeed-p "gtags" "--explain" "--help")
+ (user-error "Global 6.4+ required"))))
+ (ggtags-check-project)
+ (ggtags-with-current-project
+ (let ((default-directory (ggtags-current-project-root)))
+ (compilation-start (concat (ggtags-program-path "gtags") " --explain")))))
+
(defun ggtags-update-tags (&optional force)
"Update GNU Global tag database.
-Do nothing if GTAGS exceeds the oversize limit unless FORCE."
+Do nothing if GTAGS exceeds the oversize limit unless FORCE.
+
+When called interactively on large (per `ggtags-oversize-limit')
+projects, the update process runs in the background without
+blocking emacs."
(interactive (progn
(ggtags-check-project)
;; Mark project info expired.
(setf (ggtags-project-timestamp (ggtags-find-project)) -1)
- (list t)))
- (when (or force (and (ggtags-find-project)
- (not (ggtags-project-oversize-p))
- (ggtags-project-dirty-p (ggtags-find-project))))
- (ggtags-with-current-project
- (ggtags-with-temp-message "`global -u' in progress..."
- (ggtags-process-string "global" "-u")
- (setf (ggtags-project-dirty-p (ggtags-find-project)) nil)
- (setf (ggtags-project-mtime (ggtags-find-project)) (float-time))))))
+ (list 'interactive)))
+ (cond ((and (eq force 'interactive) (ggtags-project-oversize-p))
+ (ggtags-with-current-project
+ (with-display-buffer-no-window
+ (with-current-buffer (compilation-start "global -u")
+ ;; A hack to fool compilation mode to display `global
+ ;; -u finished' on finish.
+ (setq mode-name "global -u")
+ (add-hook 'compilation-finish-functions
+ #'ggtags-update-tags-finish nil t)))))
+ ((or force (and (ggtags-find-project)
+ (not (ggtags-project-oversize-p))
+ (ggtags-project-dirty-p (ggtags-find-project))))
+ (ggtags-with-current-project
+ (ggtags-with-temp-message "`global -u' in progress..."
+ (ggtags-process-string "global" "-u")
+ (ggtags-update-tags-finish))))))
+
+(defun ggtags-update-tags-finish (&optional buf how)
+ (if (and how buf (string-prefix-p "exited abnormally" how))
+ (display-buffer buf)
+ (setf (ggtags-project-dirty-p (ggtags-find-project)) nil)
+ (setf (ggtags-project-mtime (ggtags-find-project)) (float-time))))
(defun ggtags-update-tags-single (file &optional nowait)
+ ;; NOTE: NOWAIT is ignored if file is remote file; see
+ ;; `tramp-sh-handle-process-file'.
(cl-check-type file string)
- (ggtags-with-current-project
- (process-file (ggtags-program-path "global") nil (and nowait 0) nil
- "--single-update" (ggtags-project-relative-file file))))
+ (let ((nowait (unless (file-remote-p file) nowait)))
+ (ggtags-with-current-project
+ ;; See comment in `ggtags-project-file-p'.
+ (let ((default-directory (ggtags-current-project-root)))
+ (process-file (ggtags-program-path "global") nil (and nowait 0) nil
+ "--single-update" (ggtags-project-relative-file file))))))
(defun ggtags-delete-tags ()
"Delete file GTAGS, GRTAGS, GPATH, ID etc. generated by gtags."
(default (substring-no-properties default))
(t (ggtags-read-tag type t prompt require-match default))))))
+(defun ggtags-sort-by-nearness-p ()
+ (and ggtags-sort-by-nearness
+ (ggtags-process-succeed-p "global" "--nearness" "--help")))
+
(defun ggtags-global-build-command (cmd &rest args)
;; CMD can be definition, reference, symbol, grep, idutils
(let ((xs (append (list (shell-quote-argument (ggtags-program-path "global"))
(ggtags-find-project)
(ggtags-project-has-color (ggtags-find-project))
"--color=always")
+ (and (ggtags-sort-by-nearness-p) "--nearness")
(and (ggtags-find-project)
(ggtags-project-has-path-style (ggtags-find-project))
"--path-style=shorter")
;; Can be three values: nil, t and a marker; t means start marker has
;; been saved in the tag ring.
(defvar ggtags-global-start-marker nil)
+(defvar ggtags-global-start-file nil)
(defvar ggtags-tag-ring-index nil)
(defvar ggtags-global-search-history nil)
(env ggtags-process-environment))
(unless (markerp ggtags-global-start-marker)
(setq ggtags-global-start-marker (point-marker)))
+ ;; Record the file name for `ggtags-navigation-start-file'.
+ (setq ggtags-global-start-file buffer-file-name)
(setq ggtags-auto-jump-to-match-target
(nth 4 (assoc (ggtags-global-search-id command default-directory)
ggtags-global-search-history)))
(defun ggtags-find-tag (cmd &rest args)
(ggtags-check-project)
- (ggtags-global-start (apply #'ggtags-global-build-command cmd args)))
+ (ggtags-global-start (apply #'ggtags-global-build-command cmd args)
+ (and (ggtags-sort-by-nearness-p) default-directory)))
(defun ggtags-include-file ()
"Calculate the include file based on `ggtags-include-pattern'."
(not (ggtags-project-has-refs (ggtags-find-project)))
(not (ggtags-project-file-p buffer-file-name)))
(ggtags-find-definition name))
- (t (ggtags-find-tag (format "--from-here=%d:%s"
- (line-number-at-pos)
- (shell-quote-argument
- ;; Note `ggtags-global-start' binds
- ;; default-directory to project root.
- (ggtags-project-relative-file buffer-file-name)))
- (shell-quote-argument name)))))
+ (t (ggtags-find-tag
+ (format "--from-here=%d:%s"
+ (line-number-at-pos)
+ (shell-quote-argument
+ ;; Note `ggtags-find-tag' may bind `default-directory'
+ ;; to project root.
+ (funcall (if (ggtags-sort-by-nearness-p)
+ #'file-relative-name #'ggtags-project-relative-file)
+ buffer-file-name)))
+ (shell-quote-argument name)))))
(defun ggtags-find-tag-mouse (event)
(interactive "e")
(defvar ggtags-navigation-mode)
+(defun ggtags-foreach-file (fn)
+ "Invoke FN with each file found.
+FN is invoked while *ggtags-global* buffer is current."
+ (ggtags-ensure-global-buffer
+ (save-excursion
+ (goto-char (point-min))
+ (while (with-demoted-errors "compilation-next-error: %S"
+ (compilation-next-error 1 'file)
+ t)
+ (funcall fn (caar
+ (compilation--loc->file-struct
+ (compilation--message->loc
+ (get-text-property (point) 'compilation-message)))))))))
+
(defun ggtags-query-replace (from to &optional delimited)
"Query replace FROM with TO on files in the Global buffer.
If not in navigation mode, do a grep on FROM first.
(ggtags-with-temp-message "Waiting for Grep to finish..."
(while (get-buffer-process (current-buffer))
(sit-for 0.2)))
- (goto-char (point-min))
- (while (ignore-errors (compilation-next-file 1) t)
- (let ((m (get-text-property (point) 'compilation-message)))
- (push (expand-file-name
- (caar (compilation--loc->file-struct
- (compilation--message->loc m))))
- files))))
+ (ggtags-foreach-file
+ (lambda (file) (push (expand-file-name file) files))))
(ggtags-navigation-mode -1)
(nreverse files))))
(tags-query-replace from to delimited file-form)))
(define-key map "\M-p" 'previous-error)
(define-key map "\M-}" 'ggtags-navigation-next-file)
(define-key map "\M-{" 'ggtags-navigation-previous-file)
+ (define-key map "\M-=" 'ggtags-navigation-start-file)
(define-key map "\M->" 'ggtags-navigation-last-error)
(define-key map "\M-<" 'first-error)
;; Note: shadows `isearch-forward-regexp' but it can still be
(interactive "p")
(ggtags-navigation-next-file (- n)))
+(defun ggtags-navigation-start-file ()
+ "Move to the file where navigation session starts."
+ (interactive)
+ (let ((start-file (or ggtags-global-start-file
+ (user-error "Cannot decide start file"))))
+ (ggtags-ensure-global-buffer
+ (pcase (cl-block nil
+ (ggtags-foreach-file
+ (lambda (file)
+ (when (file-equal-p file start-file)
+ (cl-return (point))))))
+ (`nil (user-error "No matches for `%s'" start-file))
+ (n (goto-char n) (compile-goto-error))))))
+
(defun ggtags-navigation-last-error ()
(interactive)
(ggtags-ensure-global-buffer
(defun ggtags-after-save-function ()
(when (ggtags-find-project)
(ggtags-project-update-mtime-maybe)
- (and buffer-file-name
+ (and buffer-file-name ggtags-update-on-save
(ggtags-update-tags-single buffer-file-name 'nowait))))
(defun ggtags-global-output (buffer cmds callback &optional cutoff)
;; Append to serve as a fallback method.
(add-hook 'completion-at-point-functions
#'ggtags-completion-at-point t t)
+ ;; Work around http://debbugs.gnu.org/19324
+ (or eldoc-documentation-function
+ (setq-local eldoc-documentation-function #'ignore))
+ (add-function :after-until (local 'eldoc-documentation-function)
+ #'ggtags-eldoc-function '((name . ggtags-eldoc-function)
+ (depth . -100)))
(unless (memq 'ggtags-mode-line-project-name
mode-line-buffer-identification)
(setq mode-line-buffer-identification
'(ggtags-mode-line-project-name)))))
(remove-hook 'after-save-hook 'ggtags-after-save-function t)
(remove-hook 'completion-at-point-functions #'ggtags-completion-at-point t)
+ (remove-function (local 'eldoc-documentation-function) 'ggtags-eldoc-function)
(setq mode-line-buffer-identification
(delq 'ggtags-mode-line-project-name mode-line-buffer-identification))
(and (overlayp ggtags-highlight-tag-overlay)
;; Prevent multiple runs of ggtags-show-definition
;; for the same tag.
(setq ggtags-eldoc-cache (list tag))
- (ggtags-show-definition tag)
+ (condition-case err
+ (ggtags-show-definition tag)
+ (file-error
+ (remove-function (local 'eldoc-documentation-function)
+ 'ggtags-eldoc-function)
+ (message "\
+Function `ggtags-eldoc-function' disabled for eldoc in current buffer: %S" err)))
nil))))))
;;; imenu