;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
;; Author: Leo Liu <sdl.web@gmail.com>
-;; Version: 0.8.0
+;; Version: 0.8.5
;; Keywords: tools, convenience
;; Created: 2013-01-29
;; URL: https://github.com/leoliu/ggtags
;; `ggtags-mode'. See the README in https://github.com/leoliu/ggtags
;; for more details.
;;
-;; All commands are made available in the menu-bar entry `Ggtags' in
-;; `ggtags-mode'.
+;; All commands are available from the `Ggtags' menu in `ggtags-mode'.
;;; Code:
(defmacro ignore-errors-unless-debug (&rest body)
"Ignore all errors while executing BODY unless debug is on."
(declare (debug t) (indent 0))
- `(condition-case-unless-debug nil (progn ,@body) (error nil))))
+ `(condition-case-unless-debug nil (progn ,@body) (error nil)))
+
+ (defmacro with-display-buffer-no-window (&rest body)
+ (declare (debug t) (indent 0))
+ ;; See http://debbugs.gnu.org/13594
+ `(let ((display-buffer-overriding-action
+ (if (and ggtags-auto-jump-to-match
+ ;; Appeared in emacs 24.4.
+ (fboundp 'display-buffer-no-window))
+ (list #'display-buffer-no-window)
+ display-buffer-overriding-action)))
+ ,@body)))
(eval-and-compile
(or (fboundp 'user-error) ;24.3
(defcustom ggtags-oversize-limit (* 10 1024 1024)
"The over size limit for the GTAGS file.
-For large source trees, running 'global -u' can be expensive.
-Thus when GTAGS file is larger than this limit, ggtags
-automatically switches to 'global --single-update'."
+When the size of the GTAGS file is below this limit, ggtags
+always maintains up-to-date tags for the whole source tree by
+running `global -u'. For projects with GTAGS larger than this
+limit, only files edited in Ggtags mode are updated (via `global
+--single-update')."
:safe 'numberp
:type '(choice (const :tag "None" nil)
(const :tag "Always" t)
number)
:group 'ggtags)
-(defcustom ggtags-global-always-update nil
- "If non-nil always update tags for current file on save."
- :safe 'booleanp
- :type 'boolean
- :group 'ggtags)
-
(defcustom ggtags-include-pattern
'("^\\s-*#\\(?:include\\|import\\)\\s-*[\"<]\\(?:[./]*\\)?\\(.*?\\)[\">]" . 1)
"Pattern used to detect #include files.
-Value can be (REGEXP . SUB) or a function with no arguments."
+Value can be (REGEXP . SUB) or a function with no arguments.
+REGEXP should match from the beginning of line."
:type '(choice (const :tag "Disable" nil)
(cons regexp integer)
function)
:safe 'stringp
:group 'ggtags)
+;; See also: http://article.gmane.org/gmane.comp.gnu.global.bugs/1751
(defcustom ggtags-use-project-gtagsconf t
"Non-nil to use GTAGSCONF file found at project root.
-File .globalrc and gtags.conf are checked in order."
+File .globalrc and gtags.conf are checked in order.
+
+Note: GNU Global v6.2.13 has the feature of using gtags.conf at
+project root. Setting this variable to nil doesn't disable this
+feature."
:safe 'booleanp
:type 'boolean
:group 'ggtags)
:type '(repeat string)
:group 'ggtags)
-(defcustom ggtags-auto-jump-to-first-match t
- "Non-nil to automatically jump to the first match."
- :type 'boolean
+(defcustom ggtags-auto-jump-to-match 'history
+ "Strategy on how to jump to match: nil, first or history.
+
+ nil: never automatically jump to any match;
+ first: jump to the first match;
+history: jump to the match stored in search history."
+ :type '(choice (const :tag "First match" first)
+ (const :tag "Search History" history)
+ (const :tag "Never" nil))
:group 'ggtags)
(defcustom ggtags-global-window-height 8 ; ggtags-global-mode
(const cscope))
:group 'ggtags)
+(defcustom ggtags-global-use-color t
+ "Non-nil to use color in output if supported by Global.
+Note: processing colored output takes noticeable time
+particularly when the output is large."
+ :type 'boolean
+ :safe 'booleanp
+ :group 'ggtags)
+
(defcustom ggtags-global-ignore-case nil
"Non-nil if Global should ignore case in the search pattern."
:safe 'booleanp
:type 'boolean
:group 'ggtags)
+;; See also https://github.com/leoliu/ggtags/issues/52
+(defcustom ggtags-global-search-libpath-for-reference t
+ "If non-nil global will search GTAGSLIBPATH for references.
+Search is only continued in GTAGSLIBPATH if it finds no matches
+in current project."
+ :safe 'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
(defcustom ggtags-global-large-output 1000
"Number of lines in the Global buffer to indicate large output."
:type 'number
:type 'integer
:group 'ggtags)
-(defcustom ggtags-suppress-navigation-keys nil
- "If non-nil key bindings in `ggtags-navigation-map' are suppressed."
+(defcustom ggtags-enable-navigation-keys t
+ "If non-nil key bindings in `ggtags-navigation-map' are enabled."
+ :safe 'booleanp
:type 'boolean
:group 'ggtags)
:type 'hook
:group 'ggtags)
-(defcustom ggtags-show-definition-function #'ggtags-show-definition-default
- "Function called by `ggtags-show-definition' to show definition.
+(defcustom ggtags-get-definition-function #'ggtags-get-definition-default
+ "Function called by `ggtags-show-definition' to get definition.
It is passed a list of definition candidates of the form:
(TEXT NAME FILE LINE)
-where TEXT is usually the source line of the definition."
+where TEXT is usually the source line of the definition.
+
+The return value is passed to `ggtags-print-definition-function'."
+ :type 'function
+ :group 'ggtags)
+
+(defcustom ggtags-print-definition-function
+ (lambda (s) (ggtags-echo "%s" (or s "[definition not found]")))
+ "Function used by `ggtags-show-definition' to print definition."
:type 'function
:group 'ggtags)
:type 'key-sequence
:group 'ggtags)
-(defcustom ggtags-completing-read-function completing-read-function
- "Ggtags specific `completing-read-function' (which see)."
- :type 'function
+(defcustom ggtags-completing-read-function nil
+ "Ggtags specific `completing-read-function' (which see).
+Nil means using the value of `completing-read-function'."
+ :type '(choice (const :tag "Use completing-read-function" nil)
+ function)
:group 'ggtags)
(defcustom ggtags-highlight-tag-delay 0.25
:type 'function
:group 'ggtags)
+;; Used by ggtags-global-mode
+(defvar ggtags-global-error "match"
+ "Stem of message to print when no matches are found.")
+
(defconst ggtags-bug-url "https://github.com/leoliu/ggtags/issues")
(defvar ggtags-global-last-buffer nil)
+(defvar ggtags-global-continuation nil)
+
(defvar ggtags-current-tag-name nil)
(defvar ggtags-highlight-tag-overlay nil)
(defvar ggtags-highlight-tag-timer nil)
-;; Used by ggtags-global-mode
-(defvar ggtags-global-error "match"
- "Stem of message to print when no matches are found.")
+(defmacro ggtags-with-temp-message (message &rest body)
+ (declare (debug t) (indent 1))
+ (let ((init-time (make-symbol "-init-time-"))
+ (tmp-msg (make-symbol "-tmp-msg-")))
+ `(let ((,init-time (float-time))
+ (,tmp-msg ,message))
+ (with-temp-message ,tmp-msg
+ (prog1 (progn ,@body)
+ (message "%sdone (%.2fs)" ,(or tmp-msg "")
+ (- (float-time) ,init-time)))))))
+
+(defmacro ggtags-delay-finish-functions (&rest body)
+ "Delay running `compilation-finish-functions' until after BODY."
+ (declare (indent 0) (debug t))
+ (let ((saved (make-symbol "-saved-"))
+ (exit-args (make-symbol "-exit-args-")))
+ `(let ((,saved compilation-finish-functions)
+ ,exit-args)
+ (setq-local compilation-finish-functions nil)
+ (add-hook 'compilation-finish-functions
+ (lambda (&rest args) (setq ,exit-args args))
+ nil t)
+ (unwind-protect (progn ,@body)
+ (setq-local compilation-finish-functions ,saved)
+ (and ,exit-args (apply #'run-hook-with-args
+ 'compilation-finish-functions ,exit-args))))))
(defmacro ggtags-ensure-global-buffer (&rest body)
- (declare (indent 0))
+ (declare (debug t) (indent 0))
`(progn
(or (and (buffer-live-p ggtags-global-last-buffer)
(with-current-buffer ggtags-global-last-buffer
"Return non-nil if XS is a list of strings."
(cl-every #'stringp xs))
+(defun ggtags-ensure-localname (file)
+ (and file (or (file-remote-p file 'localname) file)))
+
+(defun ggtags-echo (format-string &rest args)
+ "Print formatted text to echo area."
+ (let (message-log-max) (apply #'message format-string args)))
+
(defun ggtags-forward-to-line (line)
"Move to line number LINE in current buffer."
(cl-check-type line (integer 1))
(:copier nil)
(:type vector)
:named)
- root config tag-size has-refs has-path-style has-color dirty-p mtime timestamp)
+ root tag-size has-refs has-path-style has-color dirty-p mtime timestamp)
(defun ggtags-make-project (root)
(cl-check-type root string)
(pcase (nthcdr 5 (file-attributes (expand-file-name "GTAGS" root)))
(`(,mtime ,_ ,tag-size . ,_)
(let* ((default-directory (file-name-as-directory root))
- (config (cl-some (lambda (c) (and (file-exists-p c) c))
- '(".globalrc" "gtags.conf")))
(rtags-size (nth 7 (file-attributes "GRTAGS")))
(has-refs
(when rtags-size
(and (or (> rtags-size (* 32 1024))
- (with-demoted-errors
+ (with-demoted-errors "ggtags-make-project: %S"
(not (equal "" (ggtags-process-string "global" "-crs")))))
'has-refs)))
;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1518
(has-path-style
- (with-demoted-errors ; in case `global' not found
+ (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)))
;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1542
(has-color
- (with-demoted-errors
+ (with-demoted-errors "ggtags-make-project: %S"
(and (zerop (process-file (ggtags-program-path "global")
nil nil nil
"--color" "--help"))
'has-color))))
(puthash default-directory
(ggtags-project--make :root default-directory
- :config config
:tag-size tag-size
:has-refs has-refs
:has-path-style has-path-style
(defvar-local ggtags-project-root 'unset
"Internal variable for project root directory.")
+(defun ggtags-clear-project-root ()
+ (kill-local-variable 'ggtags-project-root))
+
;;;###autoload
(defun ggtags-find-project ()
+ ;; See https://github.com/leoliu/ggtags/issues/42
+ ;;
+ ;; It is unsafe to cache `ggtags-project-root' in non-file buffers.
+ ;; But we keep the cache for a command's duration so that multiple
+ ;; calls of `ggtags-find-project' has no performance impact.
+ (unless buffer-file-name
+ (add-hook 'pre-command-hook #'ggtags-clear-project-root nil t))
(let ((project (gethash ggtags-project-root ggtags-projects)))
(if (ggtags-project-p project)
(if (ggtags-project-expired-p project)
(defmacro ggtags-with-current-project (&rest body)
"Eval BODY in current project's `process-environment'."
- (declare (debug t))
+ (declare (debug t) (indent 0))
(let ((gtagsroot (make-symbol "-gtagsroot-"))
(root (make-symbol "-ggtags-project-root-")))
`(let* ((,root ggtags-project-root)
(,gtagsroot (when (ggtags-find-project)
- (directory-file-name (ggtags-current-project-root))))
+ (ggtags-ensure-localname
+ (directory-file-name (ggtags-current-project-root)))))
(process-environment
(append (let ((process-environment process-environment))
(and ,gtagsroot (setenv "GTAGSROOT" ,gtagsroot))
(and ,gtagsroot (list (concat "GTAGSROOT=" ,gtagsroot)))
(and (ggtags-find-project)
(not (ggtags-project-has-refs (ggtags-find-project)))
- (list "GTAGSLABEL=ctags"))
- (and ggtags-use-project-gtagsconf ,gtagsroot
- (ggtags-project-config (ggtags-find-project))
- (list (concat "GTAGSCONF="
- (expand-file-name (ggtags-project-config
- (ggtags-find-project))
- ,gtagsroot)))))))
+ (list "GTAGSLABEL=ctags")))))
(unwind-protect (save-current-buffer ,@body)
(setq ggtags-project-root ,root)))))
(and path (mapcar (apply-partially #'concat (file-remote-p default-directory))
(split-string path (regexp-quote path-separator) t)))))
+(defun ggtags-project-relative-file (file)
+ "Get file name relative to current project root."
+ (ggtags-check-project)
+ (if (file-name-absolute-p file)
+ (file-relative-name file (if (string-prefix-p (ggtags-current-project-root)
+ file)
+ (ggtags-current-project-root)
+ (locate-dominating-file file "GTAGS")))
+ file))
+
+(defun ggtags-project-file-p (file)
+ "Return non-nil if FILE is part of current project."
+ (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) "$")))
+ (goto-char (point-min))
+ (not (re-search-forward "^file not found" nil t)))))
+
(defun ggtags-create-tags (root)
"Create tag files (e.g. GTAGS) in directory ROOT.
If file .globalrc or gtags.conf exists in ROOT, it will be used
(interactive "DRoot directory: ")
(let ((process-environment process-environment))
(when (zerop (length root)) (error "No root directory provided"))
- (setenv "GTAGSROOT" (expand-file-name
- (directory-file-name (file-name-as-directory root))))
+ (setenv "GTAGSROOT" (ggtags-ensure-localname
+ (expand-file-name
+ (directory-file-name (file-name-as-directory root)))))
(ggtags-with-current-project
- (let ((conf (and ggtags-use-project-gtagsconf
- (cl-loop for name in '(".globalrc" "gtags.conf")
- for full = (expand-file-name name root)
- thereis (and (file-exists-p full) full)))))
- (cond (conf (setenv "GTAGSCONF" conf))
- ((and (not (getenv "GTAGSLABEL"))
- (yes-or-no-p "Use `ctags' backend? "))
- (setenv "GTAGSLABEL" "ctags"))))
- (with-temp-message "`gtags' in progress..."
- (let ((default-directory (file-name-as-directory root)))
- (condition-case err
- (apply #'ggtags-process-string
- "gtags" (and ggtags-use-idutils '("--idutils")))
- (error (if (and ggtags-use-idutils
- (stringp (cadr err))
- (string-match-p "mkid not found" (cadr err)))
- ;; Retry without mkid
- (ggtags-process-string "gtags")
- (signal (car err) (cdr err))))))))
+ (let ((conf (and ggtags-use-project-gtagsconf
+ (cl-loop for name in '(".globalrc" "gtags.conf")
+ for full = (expand-file-name name root)
+ thereis (and (file-exists-p full) full)))))
+ (unless (or conf (getenv "GTAGSLABEL")
+ (not (yes-or-no-p "Use `ctags' backend? ")))
+ (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))))))
+ (condition-case err
+ (apply #'ggtags-process-string "gtags" args)
+ (error (if (and ggtags-use-idutils
+ (stringp (cadr err))
+ (string-match-p "mkid not found" (cadr err)))
+ ;; Retry without mkid
+ (apply #'ggtags-process-string
+ "gtags" (cl-remove "--idutils" args))
+ (signal (car err) (cdr err)))))))))
(message "GTAGS generated in `%s'" root)
root))
(not (ggtags-project-oversize-p))
(ggtags-project-dirty-p (ggtags-find-project))))
(ggtags-with-current-project
- (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))))))
+ (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))))))
+
+(defun ggtags-update-tags-single (file &optional nowait)
+ (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))))
+
+(defun ggtags-delete-tags ()
+ "Delete file GTAGS, GRTAGS, GPATH, ID etc. generated by gtags."
+ (interactive (ignore (ggtags-check-project)))
+ (when (ggtags-current-project-root)
+ (let* ((re (concat "\\`" (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID")) "\\'"))
+ (files (cl-remove-if-not
+ (lambda (file)
+ ;; Don't trust `directory-files'.
+ (let ((case-fold-search nil))
+ (string-match-p re (file-name-nondirectory file))))
+ (directory-files (ggtags-current-project-root) t re)))
+ (buffer "*GTags File List*"))
+ (or files (user-error "No tag files found"))
+ (with-output-to-temp-buffer buffer
+ (princ (mapconcat #'identity files "\n")))
+ (let ((win (get-buffer-window buffer)))
+ (unwind-protect
+ (progn
+ (fit-window-to-buffer win)
+ (when (yes-or-no-p "Remove GNU Global tag files? ")
+ (with-demoted-errors (mapc #'delete-file files))
+ (remhash (ggtags-current-project-root) ggtags-projects)
+ (and (overlayp ggtags-highlight-tag-overlay)
+ (delete-overlay ggtags-highlight-tag-overlay))))
+ (when (window-live-p win)
+ (quit-window t win)))))))
(defvar-local ggtags-completion-cache nil)
;; May throw global: only name char is allowed
;; with -c option.
(ggtags-with-current-project
- (split-string
- (apply #'ggtags-process-string
- "global"
- (append (and completion-ignore-case '("--ignore-case"))
- ;; Note -c alone returns only definitions
- (list (concat "-c" ggtags-completion-flag) prefix)))
- "\n" t)))))))
+ (split-string
+ (apply #'ggtags-process-string
+ "global"
+ (append (and completion-ignore-case '("--ignore-case"))
+ ;; Note -c alone returns only definitions
+ (list (concat "-c" ggtags-completion-flag) prefix)))
+ "\n" t)))))))
(cdr ggtags-completion-cache))))
(defun ggtags-completion-at-point ()
(defun ggtags-read-tag (&optional type confirm prompt require-match default)
(ggtags-ensure-project)
(let ((default (or default (ggtags-tag-at-point)))
- (completing-read-function ggtags-completing-read-function)
(prompt (or prompt (capitalize (symbol-name (or type 'tag)))))
(ggtags-completion-flag (pcase type
(`(or nil definition) "T")
(setq ggtags-current-tag-name
(cond (confirm
(ggtags-update-tags)
- (completing-read
- (format (if default "%s (default %s): " "%s: ") prompt default)
- ggtags-completion-table nil require-match nil nil default))
- ((not default)
- (user-error "No tag at point"))
- (t (substring-no-properties default))))))
+ (let ((completing-read-function
+ (or ggtags-completing-read-function
+ completing-read-function)))
+ (completing-read
+ (format (if default "%s (default %s): " "%s: ") prompt default)
+ ggtags-completion-table nil require-match nil nil default)))
+ (default (substring-no-properties default))
+ (t (ggtags-read-tag type t prompt require-match default))))))
(defun ggtags-global-build-command (cmd &rest args)
;; CMD can be definition, reference, symbol, grep, idutils
"-v"
(format "--result=%s" ggtags-global-output-format)
(and ggtags-global-ignore-case "--ignore-case")
- (and (ggtags-find-project)
+ (and ggtags-global-use-color
+ (ggtags-find-project)
(ggtags-project-has-color (ggtags-find-project))
"--color=always")
(and (ggtags-find-project)
args)))
(mapconcat #'identity (delq nil xs) " ")))
-;; takes three values: nil, t and a marker
+;; 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-tag-ring-index nil)
+(defvar ggtags-global-search-history nil)
-(defvar ggtags-global-exit-status 0)
-(defvar ggtags-global-match-count 0)
+(defvar ggtags-auto-jump-to-match-target nil)
-(defvar ggtags-tag-ring-index nil)
+(defvar-local ggtags-global-exit-info nil) ; (EXIT-STATUS COUNT DB)
(defun ggtags-global-save-start-marker ()
(when (markerp ggtags-global-start-marker)
(defun ggtags-global-start (command &optional directory)
(let* ((default-directory (or directory (ggtags-current-project-root)))
(split-window-preferred-function ggtags-split-window-function)
- ;; See http://debbugs.gnu.org/13594
- (display-buffer-overriding-action
- (if (and ggtags-auto-jump-to-first-match
- ;; Appeared in emacs 24.4.
- (fboundp 'display-buffer-no-window))
- (list #'display-buffer-no-window)
- display-buffer-overriding-action))
(env ggtags-process-environment))
- (setq ggtags-global-start-marker (point-marker))
+ (unless (markerp ggtags-global-start-marker)
+ (setq ggtags-global-start-marker (point-marker)))
+ (setq ggtags-auto-jump-to-match-target
+ (nth 4 (assoc (ggtags-global-search-id command default-directory)
+ ggtags-global-search-history)))
(ggtags-navigation-mode +1)
- (setq ggtags-global-exit-status 0
- ggtags-global-match-count 0)
(ggtags-update-tags)
(ggtags-with-current-project
- (with-current-buffer (compilation-start command 'ggtags-global-mode)
- (setq-local ggtags-process-environment env)
- (setq ggtags-global-last-buffer (current-buffer))))))
+ (with-current-buffer (with-display-buffer-no-window
+ (compilation-start command 'ggtags-global-mode))
+ (setq-local ggtags-process-environment env)
+ (setq ggtags-global-last-buffer (current-buffer))))))
(defun ggtags-find-tag-continue ()
(interactive)
(ggtags-check-project)
(ggtags-global-start (apply #'ggtags-global-build-command cmd args)))
+(defun ggtags-include-file ()
+ "Calculate the include file based on `ggtags-include-pattern'."
+ (pcase ggtags-include-pattern
+ (`nil nil)
+ ((pred functionp)
+ (funcall ggtags-include-pattern))
+ (`(,re . ,sub)
+ (save-excursion
+ (beginning-of-line)
+ (and (looking-at re) (match-string sub))))
+ (_ (warn "Invalid value for `ggtags-include-pattern': %s"
+ ggtags-include-pattern)
+ nil)))
+
;;;###autoload
(defun ggtags-find-tag-dwim (name &optional what)
"Find NAME by context.
When called interactively with a prefix arg, always find
definition tags."
(interactive
- (let ((include (and (not current-prefix-arg)
- ggtags-include-pattern
- (save-excursion
- (beginning-of-line)
- (if (functionp ggtags-include-pattern)
- (funcall ggtags-include-pattern)
- (and (looking-at (car ggtags-include-pattern))
- (match-string (cdr ggtags-include-pattern))))))))
+ (let ((include (and (not current-prefix-arg) (ggtags-include-file))))
+ (ggtags-ensure-project)
(if include (list include 'include)
(list (ggtags-read-tag 'definition current-prefix-arg)
(and current-prefix-arg 'definition)))))
- (ggtags-check-project) ; for `ggtags-current-project-root' below
+ (ggtags-check-project) ; For `ggtags-current-project-root' below.
(cond
((eq what 'include)
(ggtags-find-file name))
((or (eq what 'definition)
(not buffer-file-name)
- (and (ggtags-find-project)
- (not (ggtags-project-has-refs (ggtags-find-project)))))
- (ggtags-find-tag '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.
- (file-relative-name
- buffer-file-name
- (if (string-prefix-p (ggtags-current-project-root)
- buffer-file-name)
- (ggtags-current-project-root)
- (locate-dominating-file buffer-file-name "GTAGS")))))
- name))))
+ (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)))))
+
+(defun ggtags-find-tag-mouse (event)
+ (interactive "e")
+ (with-selected-window (posn-window (event-start event))
+ (save-excursion
+ (goto-char (posn-point (event-start event)))
+ (call-interactively #'ggtags-find-tag-dwim))))
+
+;; Another option for `M-.'.
+(defun ggtags-find-definition (name)
+ (interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
+ (ggtags-find-tag 'definition (shell-quote-argument name)))
+
+(defun ggtags-setup-libpath-search (type name)
+ (pcase (and ggtags-global-search-libpath-for-reference
+ (ggtags-get-libpath))
+ ((and libs (guard libs))
+ (cl-labels ((cont (buf how)
+ (pcase ggtags-global-exit-info
+ (`(0 0 ,_)
+ (with-temp-buffer
+ (setq default-directory
+ (file-name-as-directory (pop libs)))
+ (and libs (setq ggtags-global-continuation #'cont))
+ (if (ggtags-find-project)
+ (ggtags-find-tag type (shell-quote-argument name))
+ (cont buf how))))
+ (_ (ggtags-global-handle-exit buf how)))))
+ (setq ggtags-global-continuation #'cont)))))
(defun ggtags-find-reference (name)
(interactive (list (ggtags-read-tag 'reference current-prefix-arg)))
- (ggtags-find-tag 'reference name))
+ (ggtags-setup-libpath-search 'reference name)
+ (ggtags-find-tag 'reference (shell-quote-argument name)))
(defun ggtags-find-other-symbol (name)
"Find tag NAME that is a reference without a definition."
(interactive (list (ggtags-read-tag 'symbol current-prefix-arg)))
- (ggtags-find-tag 'symbol name))
+ (ggtags-setup-libpath-search 'symbol name)
+ (ggtags-find-tag 'symbol (shell-quote-argument name)))
(defun ggtags-quote-pattern (pattern)
(prin1-to-string (substring-no-properties pattern)))
(ggtags-find-tag 'path (and invert-match "--invert-match")
"--" (ggtags-quote-pattern pattern))))
-;; NOTE: Coloured output in grep requested: http://goo.gl/Y9IcX
+;; Note: Coloured output requested in http://goo.gl/Y9IcX and appeared
+;; in global v6.2.12.
(defun ggtags-find-tag-regexp (regexp directory)
"List tags matching REGEXP in DIRECTORY (default to project root).
When called interactively with a prefix, ask for the directory."
(let ((args (query-replace-read-args "Query replace (regexp)" t t)))
(list (nth 0 args) (nth 1 args) (nth 2 args))))
(unless ggtags-navigation-mode
- (let ((ggtags-auto-jump-to-first-match nil))
+ (let ((ggtags-auto-jump-to-match nil))
(ggtags-grep from)))
(let ((file-form
'(let ((files))
(ggtags-ensure-global-buffer
- (with-temp-message "Waiting for Grep to finish..."
+ (ggtags-with-temp-message "Waiting for Grep to finish..."
(while (get-buffer-process (current-buffer))
(sit-for 0.2)))
(goto-char (point-min))
(nreverse files))))
(tags-query-replace from to delimited file-form)))
-(defvar ggtags-global-search-history nil)
-
(defun ggtags-global-search-id (cmd directory)
(sha1 (concat directory (make-string 1 0) cmd)))
(defun ggtags-global-rerun-search-1 (data)
(pcase data
(`(,cmd ,dir ,env ,line ,_text)
- (with-current-buffer (let ((ggtags-auto-jump-to-first-match nil)
+ (with-current-buffer (let ((ggtags-auto-jump-to-match nil)
;; Switch current project to DIR.
(default-directory dir)
(ggtags-project-root dir)
(defvar ggtags-global-rerun-search-map
(cl-labels
((save ()
- (setq ggtags-global-rerun-search-last
- (ewoc-data (ewoc-locate ggtags-global-search-ewoc))))
+ (setq ggtags-global-rerun-search-last
+ (ewoc-data (ewoc-locate ggtags-global-search-ewoc))))
(next (arg)
- (interactive "p")
- (ewoc-goto-next ggtags-global-search-ewoc arg)
- (save))
+ (interactive "p")
+ (ewoc-goto-next ggtags-global-search-ewoc arg)
+ (save))
(prev (arg)
- (interactive "p")
- (ewoc-goto-prev ggtags-global-search-ewoc arg)
- (save))
+ (interactive "p")
+ (ewoc-goto-prev ggtags-global-search-ewoc arg)
+ (save))
(quit ()
- (interactive)
- (quit-windows-on (ewoc-buffer ggtags-global-search-ewoc) t))
+ (interactive)
+ (quit-windows-on (ewoc-buffer ggtags-global-search-ewoc) t))
(done ()
- (interactive)
- (let ((node (ewoc-locate ggtags-global-search-ewoc)))
- (when node
- (save)
- (quit)
- (ggtags-global-rerun-search-1 (cdr (ewoc-data node)))))))
+ (interactive)
+ (let ((node (ewoc-locate ggtags-global-search-ewoc)))
+ (when node
+ (save)
+ (quit)
+ (ggtags-global-rerun-search-1 (cdr (ewoc-data node)))))))
(let ((m (make-sparse-keymap)))
(set-keymap-parent m special-mode-map)
(define-key m "p" #'prev)
(erase-buffer)
(special-mode)
(use-local-map ggtags-global-rerun-search-map)
- (setq-local ggtags-navigation-mode nil)
+ (setq-local ggtags-enable-navigation-keys nil)
(setq-local bookmark-make-record-function #'ggtags-make-bookmark-record)
(setq truncate-lines t)
- (cl-labels ((prop (s) (propertize s 'face 'minibuffer-prompt))
+ (cl-labels ((prop (s)
+ (propertize s 'face 'minibuffer-prompt))
(pp (data)
- (pcase data
- (`(,_id ,cmd ,dir ,_env ,line ,text)
- (insert (prop " cmd: ") cmd "\n"
- (prop " dir: ") dir "\n"
- (prop "line: ") (number-to-string line) "\n"
- (prop "text: ") text "\n"
- (propertize (make-string 32 ?-) 'face 'shadow))))))
+ (pcase data
+ (`(,_id ,cmd ,dir ,_env ,line ,text)
+ (insert (prop " cmd: ") cmd "\n"
+ (prop " dir: ") dir "\n"
+ (prop "line: ") (number-to-string line) "\n"
+ (prop "text: ") text "\n"
+ (propertize (make-string 32 ?-) 'face 'shadow))))))
(setq ggtags-global-search-ewoc
(ewoc-create #'pp "Global search history keys: n:next p:prev r:register RET:choose\n")))
(dolist (data ggtags-global-search-history)
Use \\[jump-to-register] to restore the search session."
(interactive (list (register-read-with-preview "Save search to register: ")))
(cl-labels ((prn (data)
- (pcase data
- (`(,command ,root ,_env ,line ,_)
- (princ (format "a ggtags search session `%s' in directory `%s' at line %d."
- command root line))))))
+ (pcase data
+ (`(,command ,root ,_env ,line ,_)
+ (princ (format "a ggtags search session `%s' in directory `%s' at line %d."
+ command root line))))))
(set-register r (registerv-make
(if ggtags-global-search-ewoc
(cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
(defun ggtags-bookmark-jump (bmk)
(ggtags-global-rerun-search-1 (bookmark-prop-get bmk 'ggtags-search)))
-(defun ggtags-delete-tag-files ()
- "Delete the GTAGS, GRTAGS, GPATH etc. files generated by gtags."
- (interactive (ignore (ggtags-check-project)))
- (when (ggtags-current-project-root)
- (let* ((re (concat "\\`" (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID")) "\\'"))
- (files (cl-remove-if-not
- (lambda (file)
- ;; Don't trust `directory-files'.
- (let ((case-fold-search nil))
- (string-match-p re (file-name-nondirectory file))))
- (directory-files (ggtags-current-project-root) t re)))
- (buffer "*GTags File List*"))
- (or files (user-error "No tag files found"))
- (with-output-to-temp-buffer buffer
- (princ (mapconcat #'identity files "\n")))
- (let ((win (get-buffer-window buffer)))
- (unwind-protect
- (progn
- (fit-window-to-buffer win)
- (when (yes-or-no-p "Remove GNU Global tag files? ")
- (with-demoted-errors (mapc #'delete-file files))
- (remhash (ggtags-current-project-root) ggtags-projects)
- (and (overlayp ggtags-highlight-tag-overlay)
- (delete-overlay ggtags-highlight-tag-overlay))))
- (when (window-live-p win)
- (quit-window t win)))))))
-
(defun ggtags-browse-file-as-hypertext (file line)
"Browse FILE in hypertext (HTML) form."
(interactive (if (or current-prefix-arg (not buffer-file-name))
(list (read-file-name "Browse file: " nil nil t)
(read-number "Line: " 1))
(list buffer-file-name (line-number-at-pos))))
- (cl-check-type line integer)
+ (cl-check-type line (integer 1))
(or (and file (file-exists-p file)) (error "File `%s' doesn't exist" file))
(ggtags-check-project)
(or (file-exists-p (expand-file-name "HTML" (ggtags-current-project-root)))
0))
(ring-length find-tag-marker-ring)))
(let ((m (ring-ref find-tag-marker-ring ggtags-tag-ring-index))
- (i (- (ring-length find-tag-marker-ring) ggtags-tag-ring-index))
- (message-log-max nil))
- (message "%d%s marker%s" i (pcase (mod i 10)
- ;; ` required for 24.1 and 24.2
- (`1 "st")
- (`2 "nd")
- (`3 "rd")
- (_ "th"))
- (if (marker-buffer m) "" " (dead)"))
+ (i (- (ring-length find-tag-marker-ring) ggtags-tag-ring-index)))
+ (ggtags-echo "%d%s marker%s" i (pcase (mod i 10)
+ ;; ` required for 24.1 and 24.2
+ (`1 "st")
+ (`2 "nd")
+ (`3 "rd")
+ (_ "th"))
+ (if (marker-buffer m) "" " (dead)"))
(if (not (marker-buffer m))
(ding)
(switch-to-buffer (marker-buffer m))
(interactive)
(ggtags-next-mark 'previous))
+(defvar ggtags-view-tag-history-mode-map
+ (let ((m (make-sparse-keymap)))
+ (define-key m "\M-n" 'next-error-no-select)
+ (define-key m "\M-p" 'previous-error-no-select)
+ (define-key m "q" (lambda () (interactive) (quit-window t)))
+ m))
+
+(define-derived-mode ggtags-view-tag-history-mode tabulated-list-mode "TagHist"
+ :abbrev-table nil :group 'ggtags)
+
(defun ggtags-view-tag-history ()
+ "Pop to a buffer listing visited locations from newest to oldest.
+The buffer is a next error buffer and works with standard
+commands `next-error' and `previous-error'.
+
+\\{ggtags-view-tag-history-mode-map}"
(interactive)
(and (ring-empty-p find-tag-marker-ring)
(user-error "Tag ring empty"))
(inhibit-read-only t))
(pop-to-buffer "*Tag Ring*")
(erase-buffer)
- (tabulated-list-mode)
+ (ggtags-view-tag-history-mode)
+ (setq next-error-function #'ggtags-view-tag-history-next-error
+ next-error-last-buffer (current-buffer))
(setq tabulated-list-entries
;; Use a function so that revert can work properly.
(lambda ()
(let ((counter (ring-length find-tag-marker-ring))
(elements (or (ring-elements find-tag-marker-ring)
(user-error "Tag ring empty")))
- (action
- (lambda (button) (interactive)
- (let ((m (button-get button 'marker)))
- (or (markerp m) (user-error "Marker dead"))
- (setq ggtags-tag-ring-index
- (ring-member find-tag-marker-ring m))
- (pop-to-buffer (marker-buffer m))
- (goto-char (marker-position m)))))
- (get-line
- (lambda (m)
- (with-current-buffer (marker-buffer m)
- (save-excursion
- (goto-char m)
- (buffer-substring (line-beginning-position)
- (line-end-position)))))))
+ (action (lambda (_button) (next-error 0)))
+ (get-line (lambda (m)
+ (with-current-buffer (marker-buffer m)
+ (save-excursion
+ (goto-char m)
+ (buffer-substring (line-beginning-position)
+ (line-end-position)))))))
(setq tabulated-list-format
`[("ID" ,(max (1+ (floor (log counter 10))) 2)
- (lambda (x y) (< (car x) (car y))))
+ car-less-than-car)
("Buffer" ,(max (cl-loop for m in elements
for b = (marker-buffer m)
maximize
elements))))
(setq tabulated-list-sort-key '("ID" . t))
(tabulated-list-print)
- (fit-window-to-buffer)))
+ (fit-window-to-buffer nil (floor (frame-height) 2))))
+
+(defun ggtags-view-tag-history-next-error (&optional arg reset)
+ (if (not reset)
+ (forward-button arg)
+ (goto-char (point-min))
+ (forward-button (if (button-at (point)) 0 1)))
+ (when (get-buffer-window)
+ (set-window-point (get-buffer-window) (point)))
+ (pcase (button-get (button-at (point)) 'marker)
+ ((and (pred markerp) m)
+ (if (eq (get-buffer-window) (selected-window))
+ (pop-to-buffer (marker-buffer m))
+ (switch-to-buffer (marker-buffer m)))
+ (goto-char (marker-position m)))
+ (_ (error "Dead marker"))))
+
+(defun ggtags-global-exit-message-1 ()
+ "Get the total of matches and db file used."
+ (save-excursion
+ (goto-char (point-max))
+ (if (re-search-backward
+ "^\\w+ \\(not found\\)\\|^\\([0-9]+\\) \\w+ located" nil t)
+ (cons (or (and (match-string 1) 0)
+ (string-to-number (match-string 2)))
+ (when (re-search-forward
+ "using \\(?:\\(idutils\\)\\|'[^']*/\\(\\w+\\)'\\)"
+ (line-end-position)
+ t)
+ (or (and (match-string 1) "ID")
+ (match-string 2))))
+ (cons 0 nil))))
(defun ggtags-global-exit-message-function (_process-status exit-status msg)
- (setq ggtags-global-exit-status exit-status)
- (pcase-let ((`(,count . ,db)
- (save-excursion
- (goto-char (point-max))
- (if (re-search-backward
- "^\\w+ \\(not found\\)\\|^\\([0-9]+\\) \\w+ located" nil t)
- (cons (or (and (match-string 1) 0)
- (string-to-number (match-string 2)))
- (when (re-search-forward
- "using \\(?:\\(idutils\\)\\|'[^']*/\\(\\w+\\)'\\)"
- (line-end-position)
- t)
- (or (and (match-string 1) "ID")
- (match-string 2))))
- (cons 0 nil)))))
- (setq ggtags-global-match-count count)
- ;; Clear the start marker in case of zero matches.
- (and (zerop count)
- (markerp ggtags-global-start-marker)
- (setq ggtags-global-start-marker nil))
- (cons (if (> exit-status 0)
- msg
- (format "found %d %s"
- count
- (funcall (if (= count 1) #'car #'cadr)
- (pcase db
- ;; ` required for 24.1 and 24.2
- (`"GTAGS" '("definition" "definitions"))
- (`"GSYMS" '("symbol" "symbols"))
- (`"GRTAGS" '("reference" "references"))
- (`"GPATH" '("file" "files"))
- (`"ID" '("identifier" "identifiers"))
- (_ '("match" "matches"))))))
- exit-status)))
+ "A function for `compilation-exit-message-function'."
+ (pcase (ggtags-global-exit-message-1)
+ (`(,count . ,db)
+ (setq ggtags-global-exit-info (list exit-status count db))
+ ;; Clear the start marker in case of zero matches.
+ (and (zerop count)
+ (markerp ggtags-global-start-marker)
+ (not ggtags-global-continuation)
+ (setq ggtags-global-start-marker nil))
+ (cons (if (> exit-status 0)
+ msg
+ (format "found %d %s" count
+ (funcall (if (= count 1) #'car #'cadr)
+ (pcase db
+ ;; ` required for 24.1 and 24.2
+ (`"GTAGS" '("definition" "definitions"))
+ (`"GSYMS" '("symbol" "symbols"))
+ (`"GRTAGS" '("reference" "references"))
+ (`"GPATH" '("file" "files"))
+ (`"ID" '("identifier" "identifiers"))
+ (_ '("match" "matches"))))))
+ exit-status))))
(defun ggtags-global-column (start)
;; START is the beginning position of source text.
(defvar ggtags-global-error-regexp-alist-alist
(append
`((path "^\\(?:[^\"'\n]*/\\)?[^ )\t\n]+$" 0)
- ;; ACTIVE_ESCAPE src/dialog.cc 172
+ ;; ACTIVE_ESCAPE src/dialog.cc 172
(ctags "^\\([^ \t\n]+\\)[ \t]+\\(.*?\\)[ \t]+\\([0-9]+\\)$"
2 3 nil nil 2 (1 font-lock-function-name-face))
;; ACTIVE_ESCAPE 172 src/dialog.cc #undef ACTIVE_ESCAPE
(defun ggtags-abbreviate-files (start end)
(goto-char start)
- (let* ((error-re (cdr (assq ggtags-global-output-format
+ (let* ((error-re (cdr (assq (car compilation-error-regexp-alist)
ggtags-global-error-regexp-alist-alist)))
(sub (cadr error-re)))
(when (and ggtags-global-abbreviate-filename error-re)
(defvar-local ggtags-global-output-lines 0)
-(defun ggtags-global--display-buffer (&optional buffer)
- (let ((buffer (or buffer (current-buffer))))
- (unless (get-buffer-window buffer)
- (let* ((split-window-preferred-function ggtags-split-window-function)
- (w (display-buffer buffer '(nil (allow-no-window . t)))))
- (and w (compilation-set-window-height w))))))
+(defun ggtags-global--display-buffer (&optional buffer desired-point)
+ (pcase (let ((buffer (or buffer (current-buffer)))
+ (split-window-preferred-function ggtags-split-window-function))
+ (and (not (get-buffer-window buffer))
+ (display-buffer buffer '(nil (allow-no-window . t)))))
+ ((and (pred windowp) w)
+ (with-selected-window w
+ (compilation-set-window-height w)
+ (and desired-point (goto-char desired-point))))))
(defun ggtags-global-filter ()
"Called from `compilation-filter-hook' (which see)."
(replace-match ""))
(cl-incf ggtags-global-output-lines
(count-lines compilation-filter-start (point)))
- (when (and (> ggtags-global-output-lines 5) ggtags-navigation-mode)
- (ggtags-global--display-buffer))
+ ;; If the number of output lines is small
+ ;; `ggtags-global-handle-exit' takes care of displaying the buffer.
+ (when (and (> ggtags-global-output-lines 30) ggtags-navigation-mode)
+ (ggtags-global--display-buffer nil (or compilation-current-error (point-min))))
+ (when (and (eq ggtags-auto-jump-to-match 'history)
+ (numberp ggtags-auto-jump-to-match-target)
+ (not compilation-current-error)
+ ;; `ggtags-global-output-lines' is imprecise but use it
+ ;; as first approximation.
+ (> (+ 10 ggtags-global-output-lines) ggtags-auto-jump-to-match-target)
+ (> (line-number-at-pos (point-max))
+ ggtags-auto-jump-to-match-target))
+ (ggtags-forward-to-line ggtags-auto-jump-to-match-target)
+ (setq-local ggtags-auto-jump-to-match-target nil)
+ ;;
+ ;; Can't call `compile-goto-error' here becuase
+ ;; `compilation-filter' restores point and as a result commands
+ ;; dependent on point such as `ggtags-navigation-next-file' and
+ ;; `ggtags-navigation-previous-file' fail to work.
+ (run-with-idle-timer 0 nil (lambda (buf pt)
+ (and (buffer-live-p buf)
+ (with-current-buffer buf
+ (ggtags-delay-finish-functions
+ (let ((compilation-auto-jump-to-first-error t))
+ (with-display-buffer-no-window
+ (compilation-auto-jump buf pt)))))))
+ (current-buffer) (point)))
(make-local-variable 'ggtags-global-large-output)
(when (> ggtags-global-output-lines ggtags-global-large-output)
(cl-incf ggtags-global-large-output 500)
- (let ((message-log-max nil))
- (message "Output %d lines (Type `C-c C-k' to cancel)"
- ggtags-global-output-lines))))
-
-(defun ggtags-handle-single-match (buf how)
- (if (string-prefix-p "exited abnormally" how)
- ;; If exit abnormally display the buffer for inspection.
- (ggtags-global--display-buffer)
- (when (and ggtags-auto-jump-to-first-match
- (save-excursion
- (goto-char (point-min))
- (not (ignore-errors
- (goto-char (compilation-next-single-property-change
- (point) 'compilation-message))
- (end-of-line)
- (compilation-next-single-property-change
- (point) 'compilation-message)))))
- ;; For the `compilation-auto-jump' in idle timer to run. See also:
- ;; http://debbugs.gnu.org/13829
+ (ggtags-echo "Output %d lines (Type `C-c C-k' to cancel)"
+ ggtags-global-output-lines)))
+
+(defun ggtags-global-handle-exit (buf how)
+ "A function for `compilation-finish-functions' (which see)."
+ (cond
+ (ggtags-global-continuation
+ (let ((cont (prog1 ggtags-global-continuation
+ (setq ggtags-global-continuation nil))))
+ (funcall cont buf how)))
+ ((string-prefix-p "exited abnormally" how)
+ ;; If exit abnormally display the buffer for inspection.
+ (ggtags-global--display-buffer)
+ (when (save-excursion
+ (goto-char (point-max))
+ (re-search-backward
+ (eval-when-compile
+ (format "^global: %s not found.$"
+ (regexp-opt '("GTAGS" "GRTAGS" "GSYMS" "GPATH"))))
+ nil t))
+ (ggtags-echo "WARNING: Global tag files missing in `%s'"
+ ggtags-project-root)
+ (remhash ggtags-project-root ggtags-projects)))
+ (ggtags-auto-jump-to-match
+ (if (pcase (compilation-next-single-property-change
+ (point-min) 'compilation-message)
+ ((and pt (guard pt))
+ (compilation-next-single-property-change
+ (save-excursion (goto-char pt) (end-of-line) (point))
+ 'compilation-message)))
+ ;; There are multiple matches so pop up the buffer.
+ (ggtags-global--display-buffer)
+ ;; For the `compilation-auto-jump' in idle timer to run.
+ ;; See also: http://debbugs.gnu.org/13829
(sit-for 0)
(ggtags-navigation-mode -1)
- (ggtags-navigation-mode-cleanup buf 0))))
+ (ggtags-navigation-mode-cleanup buf 0)))))
(defvar ggtags-global-mode-font-lock-keywords
'(("^Global \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
(define-compilation-mode ggtags-global-mode "Global"
"A mode for showing outputs from gnu global."
- ;; Make it buffer local for `ggtags-abbreviate-files'.
- (make-local-variable 'ggtags-global-output-format)
- (setq-local compilation-error-regexp-alist
- (list ggtags-global-output-format))
- (setq-local compilation-auto-jump-to-first-error
- ggtags-auto-jump-to-first-match)
+ ;; Note: Place `ggtags-global-output-format' as first element for
+ ;; `ggtags-abbreviate-files'.
+ (setq-local compilation-error-regexp-alist (list ggtags-global-output-format))
+ (when (markerp ggtags-global-start-marker)
+ (setq ggtags-project-root
+ (buffer-local-value 'ggtags-project-root
+ (marker-buffer ggtags-global-start-marker))))
+ (pcase ggtags-auto-jump-to-match
+ (`history (make-local-variable 'ggtags-auto-jump-to-match-target)
+ (setq-local compilation-auto-jump-to-first-error
+ (not ggtags-auto-jump-to-match-target)))
+ (`nil (setq-local compilation-auto-jump-to-first-error nil))
+ (_ (setq-local compilation-auto-jump-to-first-error t)))
(setq-local compilation-scroll-output nil)
;; See `compilation-move-to-column' for details.
(setq-local compilation-first-column 0)
(setq-local truncate-lines t)
(jit-lock-register #'ggtags-abbreviate-files)
(add-hook 'compilation-filter-hook 'ggtags-global-filter nil 'local)
- (add-hook 'compilation-finish-functions 'ggtags-handle-single-match nil t)
+ (add-hook 'compilation-finish-functions 'ggtags-global-handle-exit nil t)
(setq-local bookmark-make-record-function #'ggtags-make-bookmark-record)
+ (setq-local ggtags-enable-navigation-keys nil)
(add-hook 'kill-buffer-hook (lambda () (ggtags-navigation-mode -1)) nil t))
;; NOTE: Need this to avoid putting menu items in
(define-key map "\M-}" 'ggtags-navigation-next-file)
(define-key map "\M-{" 'ggtags-navigation-previous-file)
(define-key map "\M->" 'ggtags-navigation-last-error)
- (define-key map "\M-<" 'ggtags-navigation-first-error)
+ (define-key map "\M-<" 'first-error)
;; Note: shadows `isearch-forward-regexp' but it can be invoked
;; with C-u C-s instead.
(define-key map "\C-\M-s" 'ggtags-navigation-isearch-forward)
map))
(defvar ggtags-mode-map-alist
- `((ggtags-navigation-mode . ,ggtags-navigation-map)))
+ `((ggtags-enable-navigation-keys . ,ggtags-navigation-map)))
(defvar ggtags-navigation-mode-map
(let ((map (make-sparse-keymap))
'(menu-item "Finish navigation" ggtags-navigation-mode-done))
(define-key menu [abort]
'(menu-item "Abort" ggtags-navigation-mode-abort))
- (define-key menu [last-error]
- '(menu-item "Last error" ggtags-navigation-last-error))
- (define-key menu [fist-error]
- '(menu-item "Fist error" ggtags-navigation-first-error))
+ (define-key menu [last-match]
+ '(menu-item "Last match" ggtags-navigation-last-error))
+ (define-key menu [first-match] '(menu-item "First match" first-error))
(define-key menu [previous-file]
'(menu-item "Previous file" ggtags-navigation-previous-file))
(define-key menu [next-file]
(ggtags-navigation-mode-cleanup))
(defun ggtags-navigation-mode-abort ()
+ "Abort navigation and return to where the search was started."
(interactive)
(ggtags-navigation-mode -1)
+ (ggtags-navigation-mode-cleanup nil 0)
;; Run after (ggtags-navigation-mode -1) or
;; ggtags-global-start-marker might not have been saved.
(when (and ggtags-global-start-marker
(not (markerp ggtags-global-start-marker)))
(setq ggtags-global-start-marker nil)
- (pop-tag-mark))
- (ggtags-navigation-mode-cleanup nil 0))
+ (pop-tag-mark)))
(defun ggtags-navigation-next-file (n)
(interactive "p")
(interactive "p")
(ggtags-navigation-next-file (- n)))
-(defun ggtags-navigation-first-error ()
- (interactive)
- (ggtags-ensure-global-buffer
- (goto-char (point-min))
- (compilation-next-error 1)
- (compile-goto-error)))
-
(defun ggtags-navigation-last-error ()
(interactive)
(ggtags-ensure-global-buffer
ggtags-global-history-length))))
(run-hooks 'ggtags-find-tag-hook)))
+(put 'ggtags-navigation-mode-lighter 'risky-local-variable t)
+
+(defvar ggtags-navigation-mode-lighter
+ '(" GG["
+ (:eval
+ (if (not (buffer-live-p ggtags-global-last-buffer))
+ '(:propertize "??" face error help-echo "No Global buffer")
+ (with-current-buffer ggtags-global-last-buffer
+ (pcase (or ggtags-global-exit-info '(0 0 ""))
+ (`(,exit ,count ,db)
+ `((:propertize ,(pcase db
+ (`"GTAGS" "D")
+ (`"GRTAGS" "R")
+ (`"GSYMS" "S")
+ (`"GPATH" "F")
+ (`"ID" "I"))
+ face success)
+ (:propertize
+ ,(pcase (get-text-property (line-beginning-position)
+ 'compilation-message)
+ (`nil "?")
+ ;; Assume the first match appears at line 5
+ (_ (number-to-string (- (line-number-at-pos) 4))))
+ face success)
+ "/"
+ (:propertize ,(number-to-string count) face success)
+ ,(unless (zerop exit)
+ `(":" (:propertize ,(number-to-string exit) face error)))))))))
+ "]")
+ "Ligher for `ggtags-navigation-mode'; set to nil to disable it.")
+
(define-minor-mode ggtags-navigation-mode nil
- :lighter
- (" GG[" (:eval
- (ignore-errors
- (ggtags-ensure-global-buffer
- (let ((index (when (get-text-property (line-beginning-position)
- 'compilation-message)
- ;; Assume the first match appears at line 5
- (- (line-number-at-pos) 4))))
- `((:propertize ,(if index
- (number-to-string (max index 0))
- "?") face success) "/")))))
- (:propertize (:eval (number-to-string ggtags-global-match-count))
- face success)
- (:eval
- (unless (zerop ggtags-global-exit-status)
- `(":" (:propertize ,(number-to-string ggtags-global-exit-status)
- face error))))
- "]")
+ :lighter ggtags-navigation-mode-lighter
:global t
(if ggtags-navigation-mode
(progn
;; Higher priority for `ggtags-navigation-mode' to avoid being
;; hijacked by modes such as `view-mode'.
- (unless ggtags-suppress-navigation-keys
- (add-to-list 'emulation-mode-map-alists 'ggtags-mode-map-alist))
+ (add-to-list 'emulation-mode-map-alists 'ggtags-mode-map-alist)
(add-hook 'next-error-hook 'ggtags-global-next-error-function)
(add-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function))
(setq emulation-mode-map-alists
(defun ggtags-minibuffer-setup-function ()
;; Disable ggtags-navigation-mode in minibuffer.
- (setq-local ggtags-navigation-mode nil))
+ (setq-local ggtags-enable-navigation-keys nil))
(defun ggtags-kill-file-buffers (&optional interactive)
"Kill all buffers visiting files in current project."
(defun ggtags-after-save-function ()
(when (ggtags-find-project)
(ggtags-project-update-mtime-maybe)
- ;; When oversize update on a per-save basis.
- (when (and buffer-file-name
- (or ggtags-global-always-update (ggtags-project-oversize-p)))
- (ggtags-with-current-project
- (process-file (ggtags-program-path "global") nil 0 nil "--single-update"
- (file-relative-name buffer-file-name))))))
+ (and buffer-file-name
+ (ggtags-update-tags-single buffer-file-name 'nowait))))
(defun ggtags-global-output (buffer cmds callback &optional cutoff)
"Asynchronously pipe the output of running CMDS to BUFFER.
When finished invoke CALLBACK in BUFFER with process exit status."
(or buffer (error "Output buffer required"))
+ (when (get-buffer-process (get-buffer buffer))
+ ;; Notice running multiple processes in the same buffer so that we
+ ;; can fix the caller. See for example `ggtags-eldoc-function'.
+ (message "Warning: detected %S already running in %S; interrupting..."
+ (get-buffer-process buffer) buffer)
+ (interrupt-process (get-buffer-process buffer)))
(let* ((program (car cmds))
(args (cdr cmds))
(cutoff (and cutoff (+ cutoff (if (get-buffer buffer)
(set-process-sentinel proc sentinel)
proc))
-(defun ggtags-show-definition-default (defs)
- (let (message-log-max)
- (message "%s%s" (or (caar defs) "[definition not found]")
- (if (cdr defs) " [guess]" ""))))
+(defun ggtags-get-definition-default (defs)
+ (and (caar defs)
+ (concat (caar defs) (and (cdr defs) " [guess]"))))
(defun ggtags-show-definition (name)
(interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
(let* ((re (cadr (assq 'grep ggtags-global-error-regexp-alist-alist)))
(current (current-buffer))
(buffer (get-buffer-create " *ggtags-definition*"))
- (fn ggtags-show-definition-function)
+ ;; Need these bindings so that let-binding
+ ;; `ggtags-print-definition-function' can work see
+ ;; `ggtags-eldoc-function'.
+ (get-fn ggtags-get-definition-function)
+ (print-fn ggtags-print-definition-function)
(show (lambda (_status)
(goto-char (point-min))
(let ((defs (cl-loop while (re-search-forward re nil t)
(string-to-number (match-string 2))))))
(kill-buffer buffer)
(with-current-buffer current
- (funcall fn defs))))))
+ (funcall print-fn (funcall get-fn defs)))))))
(ggtags-with-current-project
- (ggtags-global-output
- buffer
- (list (ggtags-program-path "global")
- "--result=grep" "--path-style=absolute" name)
- show 100))))
+ (ggtags-global-output
+ buffer
+ (list (ggtags-program-path "global")
+ "--result=grep" "--path-style=absolute" name)
+ show 100))))
(defvar ggtags-mode-prefix-map
(let ((m (make-sparse-keymap)))
;; Globally bound to `M-g p'.
;; (define-key m "\M-'" 'previous-error)
- (define-key m (kbd "M-DEL") 'ggtags-delete-tag-files)
+ (define-key m (kbd "M-DEL") 'ggtags-delete-tags)
(define-key m "\M-p" 'ggtags-prev-mark)
(define-key m "\M-n" 'ggtags-next-mark)
(define-key m "\M-f" 'ggtags-find-file)
(define-key menu [custom-ggtags]
'(menu-item "Customize Ggtags"
(lambda () (interactive) (customize-group 'ggtags))))
+ (define-key menu [eldoc-mode]
+ '(menu-item "Toggle eldoc mode" eldoc-mode :button (:toggle . eldoc-mode)))
(define-key menu [save-project]
'(menu-item "Save project settings" ggtags-save-project-settings))
(define-key menu [toggle-read-only]
'(menu-item "Browse as hypertext" ggtags-browse-file-as-hypertext
:enable (ggtags-find-project)))
(define-key menu [delete-tags]
- '(menu-item "Delete tag files" ggtags-delete-tag-files
- :enable (ggtags-find-project)))
+ '(menu-item "Delete tags" ggtags-delete-tags
+ :enable (ggtags-find-project)
+ :help "Delete file GTAGS, GRTAGS, GPATH, ID etc."))
(define-key menu [kill-buffers]
'(menu-item "Kill project file buffers" ggtags-kill-file-buffers
:enable (ggtags-find-project)))
(define-key menu [prev-mark]
'(menu-item "Previous mark" ggtags-prev-mark))
(define-key menu [sep1] menu-bar-separator)
- (define-key menu [rerun-search]
- '(menu-item "Rerun past search" ggtags-global-rerun-search))
- (define-key menu [save-to-register]
- '(menu-item "Save search session" ggtags-save-to-register))
(define-key menu [previous-error]
'(menu-item "Previous match" previous-error))
(define-key menu [next-error]
'(menu-item "Next match" next-error))
+ (define-key menu [rerun-search]
+ '(menu-item "Re-run past search" ggtags-global-rerun-search))
+ (define-key menu [save-to-register]
+ '(menu-item "Save search to register" ggtags-save-to-register))
(define-key menu [find-file]
'(menu-item "Find files" ggtags-find-file))
(define-key menu [query-replace]
(define-key menu [grep]
'(menu-item "Grep" ggtags-grep))
(define-key menu [find-symbol]
- '(menu-item "Find other symbol" ggtags-find-other-symbol))
+ '(menu-item "Find other symbol" ggtags-find-other-symbol
+ :help "Find references without definition"))
(define-key menu [find-tag-regexp]
'(menu-item "Find tag matching regexp" ggtags-find-tag-regexp))
(define-key menu [show-definition]
(current-buffer))
(overlay-put o 'category nil))))))
+;;; eldoc
+
+(defvar-local ggtags-eldoc-cache nil)
+
+(declare-function eldoc-message "eldoc")
+(defun ggtags-eldoc-function ()
+ "A function suitable for `eldoc-documentation-function' (which see)."
+ (pcase (ggtags-tag-at-point)
+ (`nil nil)
+ (tag (if (equal tag (car ggtags-eldoc-cache))
+ (cadr ggtags-eldoc-cache)
+ (and ggtags-project-root (ggtags-find-project)
+ (let* ((ggtags-print-definition-function
+ (lambda (s)
+ (setq ggtags-eldoc-cache (list tag s))
+ (eldoc-message s))))
+ ;; Prevent multiple runs of ggtags-show-definition
+ ;; for the same tag.
+ (setq ggtags-eldoc-cache (list tag))
+ (ggtags-show-definition tag)
+ nil))))))
+
;;; imenu
(defun ggtags-goto-imenu-index (name line &rest _args)
"A function suitable for `imenu-create-index-function'."
(let ((file (and buffer-file-name (file-relative-name buffer-file-name))))
(and file (with-temp-buffer
- (when (with-demoted-errors
+ (when (with-demoted-errors "ggtags-build-imenu-index: %S"
(zerop (ggtags-with-current-project
- (process-file (ggtags-program-path "global")
- nil t nil "-x" "-f" file))))
+ (process-file (ggtags-program-path "global")
+ nil t nil "-x" "-f" file))))
(goto-char (point-min))
(cl-loop while (re-search-forward
"^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)" nil t)
;;;###autoload
(defun ggtags-try-complete-tag (old)
"A function suitable for `hippie-expand-try-functions-list'."
- (with-no-warnings ; to avoid loading hippie-exp
- (unless old
- (he-init-string (if (looking-back "\\_<.*" (line-beginning-position))
- (match-beginning 0)
- (point))
- (point))
- (setq he-expand-list
- (and (not (equal he-search-string ""))
- (ggtags-find-project)
- (sort (all-completions he-search-string
- ggtags-completion-table)
- #'string-lessp))))
- (if (null he-expand-list)
- (progn
- (if old (he-reset-string))
- nil)
- (he-substitute-string (car he-expand-list))
- (setq he-expand-list (cdr he-expand-list))
- t)))
+ (eval-and-compile (require 'hippie-exp))
+ (unless old
+ (he-init-string (or (car (funcall ggtags-bounds-of-tag-function)) (point))
+ (point))
+ (setq he-expand-list
+ (and (not (equal he-search-string ""))
+ (ggtags-find-project)
+ (sort (all-completions he-search-string
+ ggtags-completion-table)
+ #'string-lessp))))
+ (if (null he-expand-list)
+ (progn
+ (if old (he-reset-string))
+ nil)
+ (he-substitute-string (car he-expand-list))
+ (setq he-expand-list (cdr he-expand-list))
+ t))
(defun ggtags-reload (&optional force)
(interactive "P")