-;;; ggtags.el --- GNU Global source code tagging system -*- lexical-binding: t; -*-
+;;; ggtags.el --- emacs frontend to GNU Global source code tagging system -*- lexical-binding: t; -*-
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
;; Author: Leo Liu <sdl.web@gmail.com>
-;; Version: 0.7.6
+;; Version: 0.8.1
;; Keywords: tools, convenience
;; Created: 2013-01-29
;; URL: https://github.com/leoliu/ggtags
-;; Package-Requires: ((emacs "24"))
+;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;;
;; Usage:
;;
-;; Type `M-x ggtags-mode' to enable the minor mode, or as usual enable
-;; it in your desired major mode hooks. When the mode is on the symbol
-;; at point is underlined if it is a valid (definition) tag.
+;; `ggtags' is similar to the standard `etags' package. These keys
+;; `M-.', `M-,', `M-*' and `C-M-.' should work as expected in
+;; `ggtags-mode'. See the README in https://github.com/leoliu/ggtags
+;; for more details.
;;
-;; `M-.' finds definition or references according to the context at
-;; point, i.e. if point is at a definition tag find references and
-;; vice versa. `M-]' finds references.
-;;
-;; If multiple matches are found, navigation mode is entered, the
-;; mode-line lighter changed, and a navigation menu-bar entry
-;; presented. In this mode, `M-n' and `M-p' moves to next and previous
-;; match, `M-}' and `M-{' to next and previous file respectively.
-;; `M-o' toggles between full and abbreviated displays of file names
-;; in the auxiliary popup window. When you locate the right match,
-;; press RET to finish which hides the auxiliary window and exits
-;; navigation mode. You can continue the search using `M-,'. To abort
-;; the search press `M-*'.
-;;
-;; Normally after a few searches a dozen buffers are created visiting
-;; files tracked by GNU Global. `C-c M-k' helps clean them up.
-;;
-;; Check the menu-bar entry `Ggtags' for other useful commands.
+;; All commands are available from the `Ggtags' menu in `ggtags-mode'.
;;; Code:
(eval-when-compile
- (require 'cl)
(require 'url-parse))
+(require 'cl-lib)
+(require 'ewoc)
(require 'compile)
(require 'etags)
+(require 'tabulated-list) ;preloaded since 24.3
(eval-when-compile
(unless (fboundp 'setq-local)
(defmacro defvar-local (var val &optional docstring)
(declare (debug defvar) (doc-string 3))
(list 'progn (list 'defvar var val docstring)
- (list 'make-variable-buffer-local (list 'quote var))))))
+ (list 'make-variable-buffer-local (list 'quote var)))))
+
+ (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))))
(eval-and-compile
- (or (fboundp 'user-error)
- (defalias 'user-error 'error)))
+ (or (fboundp 'user-error) ;24.3
+ (defalias 'user-error 'error))
+ (or (fboundp 'read-only-mode) ;24.3
+ (defalias 'read-only-mode 'toggle-read-only))
+ (or (fboundp 'register-read-with-preview) ;24.4
+ (defalias 'register-read-with-preview 'read-char)))
(defgroup ggtags nil
"GNU Global source code tagging system."
"Face used to highlight matched line in Global buffer."
:group 'ggtags)
+(defcustom ggtags-executable-directory nil
+ "If non-nil the directory to search global executables."
+ :type '(choice (const :tag "Unset" nil) directory)
+ :risky t
+ :group 'ggtags)
+
(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.
number)
:group 'ggtags)
-(defcustom ggtags-project-duration 3600
+(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."
+ :type '(choice (const :tag "Disable" nil)
+ (cons regexp integer)
+ function)
+ :safe 'stringp
+ :group 'ggtags)
+
+(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."
+ :safe 'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
+(defcustom ggtags-project-duration 600
"Seconds to keep information of a project in memory."
:type 'number
:group 'ggtags)
Elements are run through `substitute-env-vars' before use.
GTAGSROOT will always be expanded to current project root
directory. This is intended for project-wise ggtags-specific
-process environment settings."
+process environment settings. Note on remote hosts (e.g. tramp)
+directory local variables is not enabled by default per
+`enable-remote-dir-locals' (which see)."
:safe 'ggtags-list-of-string-p
: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 'first
+ "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
- "Number of lines for the 'global' popup window.
+ "Number of lines for the *ggtags-global* popup window.
If nil, use Emacs default."
:type '(choice (const :tag "Default" nil) integer)
:group 'ggtags)
-(defcustom ggtags-global-abbreviate-filename 35
+(defcustom ggtags-global-abbreviate-filename 40
"Non-nil to display file names abbreviated e.g. \"/u/b/env\".
If an integer abbreviate only names longer than that number."
:type '(choice (const :tag "No" nil)
:group 'ggtags)
(defcustom ggtags-global-output-format 'grep
- "The output format for the 'global' command."
+ "Global output format: path, ctags, ctags-x, grep or cscope."
:type '(choice (const path)
(const ctags)
(const ctags-x)
(const cscope))
:group 'ggtags)
+(defcustom ggtags-global-use-color t
+ "Non-nil to use color in output if supported by Global."
+ :type 'boolean
+ :safe 'booleanp
+ :group 'ggtags)
+
(defcustom ggtags-global-ignore-case nil
- "Non-nil if Global should ignore case."
+ "Non-nil if Global should ignore case in the search pattern."
:safe 'booleanp
:type 'boolean
:group 'ggtags)
(defcustom ggtags-global-treat-text nil
- "Non-nil if Global should include matches from text files."
+ "Non-nil if Global should include matches from text files.
+This affects `ggtags-find-file' and `ggtags-grep'."
:safe 'booleanp
:type 'boolean
:group 'ggtags)
:type 'number
:group 'ggtags)
+(defcustom ggtags-global-history-length history-length
+ "Maximum number of items to keep in `ggtags-global-search-history'."
+ :type 'integer
+ :group 'ggtags)
+
+(defcustom ggtags-enable-navigation-keys t
+ "If non-nil key bindings in `ggtags-navigation-map' are enabled."
+ :safe 'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
+(defcustom ggtags-find-tag-hook nil
+ "Hook run immediately after finding a tag."
+ :options '(recenter reposition-window)
+ :type 'hook
+ :group 'ggtags)
+
+(defcustom ggtags-show-definition-function #'ggtags-show-definition-default
+ "Function called by `ggtags-show-definition' to show 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."
+ :type 'function
+ :group 'ggtags)
+
+(defcustom ggtags-mode-sticky t
+ "If non-nil enable Ggtags Mode in files visited."
+ :safe 'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
(defcustom ggtags-mode-prefix-key "\C-c"
"Key binding used for `ggtags-mode-prefix-map'.
Users should change the value using `customize-variable' to
:type 'key-sequence
:group 'ggtags)
-(defcustom ggtags-completing-read-function completing-read-function
- "Ggtags specific `completing-read-function' (which see)."
- :type 'function
- :group 'ggtags)
-
(defcustom ggtags-highlight-tag-delay 0.25
"Time in seconds before highlighting tag at point."
:set (lambda (sym value)
(defcustom ggtags-bounds-of-tag-function (lambda ()
(bounds-of-thing-at-point 'symbol))
- "Function to get the start and end locations of the tag at point."
+ "Function to get the start and end positions of the tag at point."
:type 'function
:group 'ggtags)
-(defvar ggtags-bug-url "https://github.com/leoliu/ggtags/issues")
+;; 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-highlight-tag-timer nil)
-;; Used by ggtags-global-mode
-(defvar ggtags-global-error "match"
- "Stem of message to print when no matches are found.")
-
-;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1518
-(defvar ggtags-global-has-path-style ; introduced in global 6.2.8
- (with-demoted-errors ; in case `global' not found
- (zerop (process-file "global" nil nil nil
- "--path-style" "shorter" "--help")))
- "Non-nil if `global' supports --path-style switch.")
-
-;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1542
-(defvar ggtags-global-has-color
- (with-demoted-errors
- (zerop (process-file "global" nil nil nil "--color" "--help"))))
-
(defmacro ggtags-ensure-global-buffer (&rest body)
(declare (indent 0))
`(progn
(error "No global buffer found"))
(with-current-buffer ggtags-global-last-buffer ,@body)))
-(defmacro ggtags-with-process-environment (&rest body)
- (declare (debug t))
- `(let ((process-environment
- (append (let ((process-environment process-environment))
- (when (ggtags-find-project)
- (setenv "GTAGSROOT" (directory-file-name
- (ggtags-current-project-root))))
- (mapcar #'substitute-env-vars ggtags-process-environment))
- process-environment
- (and (ggtags-find-project)
- (not (ggtags-project-has-rtags (ggtags-find-project)))
- (list "GTAGSLABEL=ctags")))))
- ,@body))
-
(defun ggtags-list-of-string-p (xs)
"Return non-nil if XS is a list of strings."
- (if (null xs)
- t
- (and (stringp (car xs))
- (ggtags-list-of-string-p (cdr xs)))))
+ (cl-every #'stringp xs))
-(defun ggtags-get-libpath ()
- (let ((path (ggtags-with-process-environment (getenv "GTAGSLIBPATH"))))
- (and path (split-string path (regexp-quote path-separator) t))))
+(defun ggtags-forward-to-line (line)
+ "Move to line number LINE in current buffer."
+ (cl-check-type line (integer 1))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (1- line))))
+
+(defun ggtags-program-path (name)
+ (if ggtags-executable-directory
+ (expand-file-name name ggtags-executable-directory)
+ name))
(defun ggtags-process-string (program &rest args)
(with-temp-buffer
- (let ((exit (apply #'process-file program nil t nil args))
+ (let ((exit (apply #'process-file
+ (ggtags-program-path program) nil t nil args))
(output (progn
(goto-char (point-max))
(skip-chars-backward " \t\n")
output)))
(defun ggtags-tag-at-point ()
- (let ((bounds (funcall ggtags-bounds-of-tag-function)))
- (and bounds (buffer-substring (car bounds) (cdr bounds)))))
+ (pcase (funcall ggtags-bounds-of-tag-function)
+ (`(,beg . ,end) (buffer-substring beg end))))
-;;; Store for project settings
+;;; Store for project info and settings
(defvar ggtags-projects (make-hash-table :size 7 :test #'equal))
-(defstruct (ggtags-project (:constructor ggtags-project--make)
- (:copier nil)
- (:type vector)
- :named)
- root tag-size has-rtags dirty-p timestamp)
+(cl-defstruct (ggtags-project (:constructor ggtags-project--make)
+ (:copier nil)
+ (:type vector)
+ :named)
+ root config tag-size has-refs has-path-style has-color dirty-p mtime timestamp)
(defun ggtags-make-project (root)
- (check-type root string)
- (let* ((default-directory (file-name-as-directory root))
- (tag-size (or (nth 7 (file-attributes "GTAGS")) -1))
- (rtags-size (nth 7 (file-attributes "GRTAGS")))
- (has-rtags
- (when rtags-size
- (or (> rtags-size (* 32 1024))
- (with-demoted-errors
- (not (equal "" (ggtags-process-string "global" "-crs"))))))))
- (puthash default-directory (ggtags-project--make
- :root default-directory :has-rtags has-rtags
- :tag-size tag-size :timestamp (float-time))
- ggtags-projects)))
-
-(defvar-local ggtags-project 'unset)
+ (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
+ (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
+ (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
+ (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
+ :has-color has-color
+ :mtime (float-time mtime)
+ :timestamp (float-time))
+ ggtags-projects)))))
(defun ggtags-project-expired-p (project)
- (> (- (float-time)
- (ggtags-project-timestamp project))
- ggtags-project-duration))
+ (or (< (ggtags-project-timestamp project) 0)
+ (> (- (float-time)
+ (ggtags-project-timestamp project))
+ ggtags-project-duration)))
+
+(defun ggtags-project-update-mtime-maybe (&optional project)
+ "Update PROJECT's modtime and if current file is newer.
+Value is new modtime if updated."
+ (let ((project (or project (ggtags-find-project))))
+ (when (and (ggtags-project-p project)
+ (consp (visited-file-modtime))
+ (> (float-time (visited-file-modtime))
+ (ggtags-project-mtime project)))
+ (setf (ggtags-project-dirty-p project) t)
+ (setf (ggtags-project-mtime project)
+ (float-time (visited-file-modtime))))))
(defun ggtags-project-oversize-p (&optional project)
(pcase ggtags-oversize-limit
(size (let ((project (or project (ggtags-find-project))))
(and project (> (ggtags-project-tag-size project) size))))))
+(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 ()
- (if (ggtags-project-p ggtags-project)
- (if (not (ggtags-project-expired-p ggtags-project))
- ggtags-project
- (remhash (ggtags-project-root ggtags-project) ggtags-projects)
- (kill-local-variable 'ggtags-project)
- (ggtags-find-project))
- (let ((root (ignore-errors (file-name-as-directory
- ;; Resolves symbolic links
- (ggtags-process-string "global" "-pr")))))
- (setq ggtags-project
- (and root (or (gethash root ggtags-projects)
- (ggtags-make-project root)))))))
+ ;; 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)
+ (progn
+ (remhash ggtags-project-root ggtags-projects)
+ (ggtags-find-project))
+ project)
+ (setq ggtags-project-root
+ (or (ignore-errors-unless-debug
+ (file-name-as-directory
+ (concat (file-remote-p default-directory)
+ ;; Resolves symbolic links
+ (ggtags-process-string "global" "-pr"))))
+ ;; 'global -pr' resolves symlinks before checking the
+ ;; GTAGS file which could cause issues such as
+ ;; https://github.com/leoliu/ggtags/issues/22, so
+ ;; let's help it out.
+ ;;
+ ;; Note: `locate-dominating-file' doesn't accept
+ ;; function for NAME before 24.3.
+ (let ((dir (locate-dominating-file default-directory "GTAGS")))
+ ;; `file-truename' may strip the trailing '/' on
+ ;; remote hosts, see http://debbugs.gnu.org/16851
+ (and dir (file-regular-p (expand-file-name "GTAGS" dir))
+ (file-name-as-directory (file-truename dir))))))
+ (when ggtags-project-root
+ (if (gethash ggtags-project-root ggtags-projects)
+ (ggtags-find-project)
+ (ggtags-make-project ggtags-project-root))))))
(defun ggtags-current-project-root ()
(and (ggtags-find-project)
(defun ggtags-check-project ()
(or (ggtags-find-project) (error "File GTAGS not found")))
+(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))))
+
+(defvar delete-trailing-lines) ;new in 24.3
+
(defun ggtags-save-project-settings (&optional noconfirm)
"Save Gnu Global's specific environment variables."
(interactive "P")
(ggtags-check-project)
(let* ((inhibit-read-only t) ; for `add-dir-local-variable'
(default-directory (ggtags-current-project-root))
- ;; Not using `ggtags-with-process-environment' to preserve
+ ;; Not using `ggtags-with-current-project' to preserve
;; environment variables that may be present in
;; `ggtags-process-environment'.
(process-environment
(append ggtags-process-environment
process-environment
- (and (not (ggtags-project-has-rtags (ggtags-find-project)))
+ (and (not (ggtags-project-has-refs (ggtags-find-project)))
(list "GTAGSLABEL=ctags"))))
(envlist (delete-dups
- (loop for x in process-environment
- when (string-match
- "^\\(GTAGS[^=\n]*\\|MAKEOBJDIRPREFIX\\)=" x)
- ;; May have duplicates thus `delete-dups'.
- collect (concat (match-string 1 x)
- "="
- (getenv (match-string 1 x))))))
+ (cl-loop for x in process-environment
+ when (string-match
+ "^\\(GTAGS[^=\n]*\\|MAKEOBJDIRPREFIX\\)=" x)
+ ;; May have duplicates thus `delete-dups'.
+ collect (concat (match-string 1 x)
+ "="
+ (getenv (match-string 1 x))))))
(help-form (format "y: save\nn: don't save\n=: diff\n?: help\n")))
(add-dir-local-variable nil 'ggtags-process-environment envlist)
;; Remove trailing newlines by `add-dir-local-variable'.
(while (pcase (read-char-choice
(format "Save `%s'? (y/n/=/?) " buffer-file-name)
'(?y ?n ?= ??))
- (?n (user-error "Aborted"))
- (?y nil)
- (?= (diff-buffer-with-file) 'loop)
- (?? (help-form-show) 'loop))))
+ ;; ` required for 24.1 and 24.2
+ (`?n (user-error "Aborted"))
+ (`?y nil)
+ (`?= (diff-buffer-with-file) 'loop)
+ (`?? (help-form-show) 'loop))))
(save-buffer)
(kill-buffer)))
(save-buffer)
(kill-buffer)
(when buffer-file-name
- (setq buffer-read-only val))
+ (read-only-mode (if val +1 -1)))
(when (called-interactively-p 'interactive)
(message "Project read-only-mode is %s" (if val "on" "off")))
val))
-(defun ggtags-ensure-project ()
+(defun ggtags-visit-project-root ()
(interactive)
- (or (ggtags-find-project)
- (when (or (yes-or-no-p "File GTAGS not found; run gtags? ")
- (user-error "Aborted"))
- (let ((root (read-directory-name "Directory: " nil nil t))
- (process-environment process-environment))
- (and (zerop (length root)) (user-error "No directory chosen"))
- (setenv "GTAGSROOT"
- (directory-file-name (file-name-as-directory root)))
- (ggtags-with-process-environment
- (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)))
- (apply #'ggtags-process-string
- "gtags" (and ggtags-use-idutils '("--idutils"))))))
- (message "GTAGS generated in `%s'" root)
- (ggtags-find-project)))))
+ (ggtags-ensure-project)
+ (dired (ggtags-current-project-root)))
+
+(defmacro ggtags-with-current-project (&rest body)
+ "Eval BODY in current project's `process-environment'."
+ (declare (debug t))
+ (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))))
+ (process-environment
+ (append (let ((process-environment process-environment))
+ (and ,gtagsroot (setenv "GTAGSROOT" ,gtagsroot))
+ (mapcar #'substitute-env-vars ggtags-process-environment))
+ process-environment
+ (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)))))))
+ (unwind-protect (save-current-buffer ,@body)
+ (setq ggtags-project-root ,root)))))
+
+(defun ggtags-get-libpath ()
+ (let ((path (ggtags-with-current-project (getenv "GTAGSLIBPATH"))))
+ (and path (mapcar (apply-partially #'concat (file-remote-p default-directory))
+ (split-string path (regexp-quote path-separator) 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
+as configuration file per `ggtags-use-project-gtagsconf'.
+
+If file gtags.files exists in ROOT, it should be a list of source
+files to index, which can be used to speed gtags up in large
+source trees. See Info node `(global)gtags' for details."
+ (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))))
+ (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))))))))
+ (message "GTAGS generated in `%s'" root)
+ root))
(defun ggtags-update-tags (&optional force)
"Update GNU Global tag database.
-Do nothing if GTAGS exceeds the oversize limit unless FORCE is
-non-nil."
- (interactive "P")
+Do nothing if GTAGS exceeds the oversize limit unless FORCE."
+ (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-process-environment
- (with-temp-message "Running `global -u'"
+ (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-dirty-p (ggtags-find-project)) nil)
+ (setf (ggtags-project-mtime (ggtags-find-project)) (float-time))))))
(defvar-local ggtags-completion-cache nil)
+;; See global/libutil/char.c
+;; (defconst ggtags-regexp-metachars "[][$()*+.?\\{}|^]")
+(defvar ggtags-completion-flag "") ;internal use
+
(defvar ggtags-completion-table
(completion-table-dynamic
(lambda (prefix)
- (unless (equal prefix (car ggtags-completion-cache))
- (setq ggtags-completion-cache
- (cons prefix
- (ggtags-with-process-environment
- (split-string
- (apply #'ggtags-process-string
- "global"
- ;; Note -c alone returns only definitions
- (if completion-ignore-case
- (list "--ignore-case" "-Tc" prefix)
- (list "-Tc" prefix)))
- "\n" t)))))
+ (let ((cache-key (concat prefix "$" ggtags-completion-flag)))
+ (unless (equal cache-key (car ggtags-completion-cache))
+ (setq ggtags-completion-cache
+ (cons cache-key
+ (ignore-errors-unless-debug
+ ;; 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)))))))
(cdr ggtags-completion-cache))))
-(defun ggtags-read-tag ()
+(defun ggtags-completion-at-point ()
+ "A function for `completion-at-point-functions'."
+ (pcase (funcall ggtags-bounds-of-tag-function)
+ (`(,beg . ,end)
+ (and (< beg end) (list beg end ggtags-completion-table)))))
+
+(defun ggtags-read-tag (&optional type confirm prompt require-match default)
(ggtags-ensure-project)
- (let ((default (ggtags-tag-at-point))
- (completing-read-function ggtags-completing-read-function))
+ (let ((default (or default (ggtags-tag-at-point)))
+ (prompt (or prompt (capitalize (symbol-name (or type 'tag)))))
+ (ggtags-completion-flag (pcase type
+ (`(or nil definition) "T")
+ (`symbol "s")
+ (`reference "r")
+ (`id "I")
+ (`path "P")
+ ((pred stringp) type)
+ (_ ggtags-completion-flag))))
(setq ggtags-current-tag-name
- (cond (current-prefix-arg
+ (cond (confirm
(ggtags-update-tags)
(completing-read
- (format (if default "Tag (default %s): " "Tag: ") default)
- ggtags-completion-table nil t nil nil default))
- ((not default)
- (user-error "No tag at point"))
- (t (substring-no-properties default))))))
+ (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
- (let ((xs (append (list "global" "-v"
+ (let ((xs (append (list (shell-quote-argument (ggtags-program-path "global"))
+ "-v"
(format "--result=%s" ggtags-global-output-format)
(and ggtags-global-ignore-case "--ignore-case")
- (and ggtags-global-has-color "--color")
- (and ggtags-global-has-path-style
+ (and ggtags-global-use-color
+ (ggtags-find-project)
+ (ggtags-project-has-color (ggtags-find-project))
+ "--color=always")
+ (and (ggtags-find-project)
+ (ggtags-project-has-path-style (ggtags-find-project))
"--path-style=shorter")
(and ggtags-global-treat-text "--other")
(pcase cmd
((pred stringp) cmd)
- (`definition "-d")
+ (`definition "") ;-d not supported by Global 5.7.1
(`reference "-r")
(`symbol "-s")
(`path "--path")
(`grep "--grep")
(`idutils "--idutils")))
args)))
- (mapconcat 'identity (delq nil xs) " ")))
+ (mapconcat #'identity (delq nil xs) " ")))
;; takes three values: nil, t and a marker
(defvar ggtags-global-start-marker nil)
-
(defvar ggtags-global-exit-status 0)
(defvar ggtags-global-match-count 0)
-
(defvar ggtags-tag-ring-index nil)
+(defvar ggtags-global-search-history nil)
+
+(defvar ggtags-auto-jump-to-match-target nil)
(defun ggtags-global-save-start-marker ()
(when (markerp ggtags-global-start-marker)
(ring-insert find-tag-marker-ring ggtags-global-start-marker)
(setq ggtags-global-start-marker t)))
-(defun ggtags-global-start (command &optional root)
- (let* ((default-directory (or root (ggtags-current-project-root)))
- (split-window-preferred-function ggtags-split-window-function))
+(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-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))
+ (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-process-environment
- (setq ggtags-global-last-buffer
- (compilation-start command 'ggtags-global-mode)))))
+ (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))))))
(defun ggtags-find-tag-continue ()
(interactive)
(ignore-errors (compilation-next-error 1))
(compile-goto-error))))
-(defun ggtags-find-tag (cmd name)
+(defun ggtags-find-tag (cmd &rest args)
(ggtags-check-project)
- (ggtags-global-start (ggtags-global-build-command cmd name)))
+ (ggtags-global-start (apply #'ggtags-global-build-command cmd args)))
;;;###autoload
-(defun ggtags-find-tag-dwim (name &optional definition)
- "Find definitions or references of tag NAME by context.
+(defun ggtags-find-tag-dwim (name &optional what)
+ "Find NAME by context.
If point is at a definition tag, find references, and vice versa.
-With a prefix arg (non-nil DEFINITION) always find definitions."
- (interactive (list (ggtags-read-tag) current-prefix-arg))
- (if (or definition
- (not buffer-file-name)
- (and (ggtags-find-project)
- (not (ggtags-project-has-rtags (ggtags-find-project)))))
- (ggtags-find-tag 'definition name)
- (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
- (ggtags-current-project-root))))
- name)))
+If point is at a line that matches `ggtags-include-pattern', find
+the include file instead.
+
+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))))))))
+ (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
+ (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 (shell-quote-argument 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")))))
+ (shell-quote-argument name)))))
(defun ggtags-find-reference (name)
- (interactive (list (ggtags-read-tag)))
- (ggtags-find-tag 'reference name))
+ (interactive (list (ggtags-read-tag 'reference current-prefix-arg)))
+ (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)))
- (ggtags-find-tag 'symbol name))
+ (interactive (list (ggtags-read-tag 'symbol current-prefix-arg)))
+ (ggtags-find-tag 'symbol (shell-quote-argument name)))
-(defun ggtags-read-string (prompt)
- "Like `read-string' but handle default automatically."
- (ggtags-ensure-project)
- (let ((prompt (if (string-match ": *\\'" prompt)
- (substring prompt 0 (match-beginning 0))
- prompt))
- (default (ggtags-tag-at-point)))
- (read-string (format (if default "%s (default `%s'): "
- "%s: ")
- prompt default)
- nil nil (and default (substring-no-properties default)))))
+(defun ggtags-quote-pattern (pattern)
+ (prin1-to-string (substring-no-properties pattern)))
+
+(defun ggtags-idutils-query (pattern)
+ (interactive (list (ggtags-read-tag 'id t)))
+ (ggtags-find-tag 'idutils "--" (ggtags-quote-pattern pattern)))
(defun ggtags-grep (pattern &optional invert-match)
- "Use `global --grep' to search for lines matching PATTERN.
+ "Grep for lines matching PATTERN.
Invert the match when called with a prefix arg \\[universal-argument]."
- (interactive (list (ggtags-read-string (if current-prefix-arg
- "Inverted grep pattern"
- "Grep pattern"))
+ (interactive (list (ggtags-read-tag 'definition 'confirm
+ (if current-prefix-arg
+ "Inverted grep pattern" "Grep pattern"))
current-prefix-arg))
- (ggtags-find-tag 'grep (format "%s--regexp %S"
- (if invert-match "--invert-match " "")
- pattern)))
-
-(defun ggtags-idutils-query (pattern)
- (interactive (list (ggtags-read-string "ID query pattern")))
- (ggtags-find-tag 'idutils (format "--regexp %S" pattern)))
+ (ggtags-find-tag 'grep (and invert-match "--invert-match")
+ "--" (ggtags-quote-pattern pattern)))
(defun ggtags-find-file (pattern &optional invert-match)
- (interactive (list (ggtags-read-string (if current-prefix-arg
- "Inverted path pattern"
- "Path pattern"))
+ (interactive (list (ggtags-read-tag 'path 'confirm (if current-prefix-arg
+ "Inverted path pattern"
+ "Path pattern")
+ nil (thing-at-point 'filename))
current-prefix-arg))
(let ((ggtags-global-output-format 'path))
- (ggtags-find-tag 'path (format "%s--regexp %S"
- (if invert-match "--invert-match " "")
- pattern))))
+ (ggtags-find-tag 'path (and invert-match "--invert-match")
+ "--" (ggtags-quote-pattern pattern))))
;; NOTE: Coloured output in grep requested: http://goo.gl/Y9IcX
(defun ggtags-find-tag-regexp (regexp directory)
- "List tags matching REGEXP in DIRECTORY (default to project root)."
+ "List tags matching REGEXP in DIRECTORY (default to project root).
+When called interactively with a prefix, ask for the directory."
(interactive
- (list (ggtags-read-string "POSIX regexp")
- (if current-prefix-arg
- (read-directory-name "Directory: " nil nil t)
- (ggtags-current-project-root))))
+ (progn
+ (ggtags-check-project)
+ (list (ggtags-read-tag "" t "POSIX regexp")
+ (if current-prefix-arg
+ (read-directory-name "Directory: " nil nil t)
+ (ggtags-current-project-root)))))
(ggtags-check-project)
- (let ((root (file-name-as-directory directory))
- (cmd (ggtags-global-build-command
- nil nil "-l" "--regexp" (prin1-to-string regexp))))
- (ggtags-global-start cmd root)))
+ (ggtags-global-start
+ (ggtags-global-build-command nil nil "-l" "--" (ggtags-quote-pattern regexp))
+ (file-name-as-directory directory)))
+
+(defvar ggtags-navigation-mode)
(defun ggtags-query-replace (from to &optional delimited)
"Query replace FROM with TO on files in the Global buffer.
Note: the regular expression FROM must be supported by both
Global and Emacs."
- (interactive (query-replace-read-args "Query replace (regexp)" t t))
- (unless (bound-and-true-p ggtags-navigation-mode)
- (let ((ggtags-auto-jump-to-first-match nil))
+ (interactive
+ ;; Note: in 24.4 query-replace-read-args returns a list of 4 elements.
+ (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-match nil))
(ggtags-grep from)))
(let ((file-form
'(let ((files))
(nreverse files))))
(tags-query-replace from to delimited file-form)))
-(defun ggtags-delete-tag-files ()
- "Delete the tag files generated by gtags."
+(defun ggtags-global-search-id (cmd directory)
+ (sha1 (concat directory (make-string 1 0) cmd)))
+
+(defun ggtags-global-current-search ()
+ ;; CMD DIR ENV LINE TEXT
+ (ggtags-ensure-global-buffer
+ (list (car compilation-arguments)
+ default-directory
+ ggtags-process-environment
+ (line-number-at-pos)
+ (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position)))))
+
+(defun ggtags-global-rerun-search-1 (data)
+ (pcase data
+ (`(,cmd ,dir ,env ,line ,_text)
+ (with-current-buffer (let ((ggtags-auto-jump-to-match nil)
+ ;; Switch current project to DIR.
+ (default-directory dir)
+ (ggtags-project-root dir)
+ (ggtags-process-environment env))
+ (ggtags-global-start cmd dir))
+ (add-hook 'compilation-finish-functions
+ (lambda (buf _msg)
+ (with-current-buffer buf
+ (ggtags-forward-to-line line)
+ (compile-goto-error)))
+ nil t)))))
+
+(defvar-local ggtags-global-search-ewoc nil)
+(defvar ggtags-global-rerun-search-last nil)
+
+(defvar ggtags-global-rerun-search-map
+ (cl-labels
+ ((save ()
+ (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))
+ (prev (arg)
+ (interactive "p")
+ (ewoc-goto-prev ggtags-global-search-ewoc arg)
+ (save))
+ (quit ()
+ (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)))))))
+ (let ((m (make-sparse-keymap)))
+ (set-keymap-parent m special-mode-map)
+ (define-key m "p" #'prev)
+ (define-key m "\M-p" #'prev)
+ (define-key m "n" #'next)
+ (define-key m "\M-n" #'next)
+ (define-key m "r" #'ggtags-save-to-register)
+ (define-key m "q" #'quit)
+ (define-key m "\r" #'done)
+ m)))
+
+(defvar bookmark-make-record-function)
+
+(defun ggtags-global-rerun-search ()
+ "Pop up a buffer to choose a past search to re-run.
+
+\\{ggtags-global-rerun-search-map}"
(interactive)
+ (or ggtags-global-search-history (user-error "No search history"))
+ (let ((split-window-preferred-function ggtags-split-window-function)
+ (inhibit-read-only t))
+ (pop-to-buffer "*Ggtags Search History*")
+ (erase-buffer)
+ (special-mode)
+ (use-local-map ggtags-global-rerun-search-map)
+ (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))
+ (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))))))
+ (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)
+ (ewoc-enter-last ggtags-global-search-ewoc data))
+ (and ggtags-global-rerun-search-last
+ (re-search-forward (cadr ggtags-global-rerun-search-last) nil t)
+ (ewoc-goto-node ggtags-global-search-ewoc
+ (ewoc-locate ggtags-global-search-ewoc)))
+ (set-buffer-modified-p nil)
+ (fit-window-to-buffer nil (floor (frame-height) 2))))
+
+(defun ggtags-save-to-register (r)
+ "Save current search session to register R.
+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))))))
+ (set-register r (registerv-make
+ (if ggtags-global-search-ewoc
+ (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
+ (ggtags-global-current-search))
+ :jump-func #'ggtags-global-rerun-search-1
+ :print-func #'prn))))
+
+(defun ggtags-make-bookmark-record ()
+ `(,(and ggtags-current-tag-name (format "*ggtags %s*" ggtags-current-tag-name))
+ (ggtags-search . ,(if ggtags-global-search-ewoc
+ (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
+ (ggtags-global-current-search)))
+ (handler . ggtags-bookmark-jump)))
+
+(declare-function bookmark-prop-get "bookmark")
+
+(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 ((files (directory-files (ggtags-current-project-root) t
- (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID"))))
- (buffer "*GTags File List*"))
+ (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
- (dolist (file files)
- (princ file)
- (princ "\n")))
+ (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? ")
- (mapc 'delete-file files)
+ (with-demoted-errors (mapc #'delete-file files))
(remhash (ggtags-current-project-root) ggtags-projects)
- (delete-overlay ggtags-highlight-tag-overlay)
- (kill-local-variable 'ggtags-project)))
+ (and (overlayp ggtags-highlight-tag-overlay)
+ (delete-overlay ggtags-highlight-tag-overlay))))
(when (window-live-p win)
(quit-window t win)))))))
(list (read-file-name "Browse file: " nil nil t)
(read-number "Line: " 1))
(list buffer-file-name (line-number-at-pos))))
- (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)))
(if (yes-or-no-p "No hypertext form exists; run htags? ")
(let ((default-directory (ggtags-current-project-root)))
- (ggtags-with-process-environment (ggtags-process-string "htags")))
+ (ggtags-with-current-project (ggtags-process-string "htags")))
(user-error "Aborted")))
- (let ((url (ggtags-process-string "gozilla" "-p" (format "+%d" line) file)))
+ (let ((url (ggtags-process-string "gozilla" "-p" (format "+%d" line)
+ (file-relative-name file))))
(or (equal (file-name-extension
(url-filename (url-generic-parse-url url))) "html")
(user-error "No hypertext form for `%s'" file))
(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)
- (1 "st")
- (2 "nd")
- (3 "rd")
+ ;; ` required for 24.1 and 24.2
+ (`1 "st")
+ (`2 "nd")
+ (`3 "rd")
(_ "th"))
(if (marker-buffer m) "" " (dead)"))
(if (not (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 (log10 counter))) 2)
- (lambda (x y) (< (car x) (car y))))
- ("Buffer" ,(max (loop for m in elements
- for b = (marker-buffer m)
- maximize
- (length (and b (buffer-name b))))
+ `[("ID" ,(max (1+ (floor (log counter 10))) 2)
+ car-less-than-car)
+ ("Buffer" ,(max (cl-loop for m in elements
+ for b = (marker-buffer m)
+ maximize
+ (length (and b (buffer-name b))))
6)
t :right-align t)
- ("Position" ,(max (loop for m in elements
- for p = (or (marker-position m) 1)
- maximize (1+ (floor (log10 p))))
+ ("Position" ,(max (cl-loop for m in elements
+ for p = (or (marker-position m) 1)
+ maximize (1+ (floor (log p 10))))
8)
(lambda (x y)
(< (string-to-number (aref (cadr x) 2))
(funcall get-line x))
(vector (number-to-string counter)
"(dead)" "?" "?")))
- (decf counter)))
+ (cl-decf counter)))
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-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 "^\\([0-9]+\\) \\w+ located" nil t)
- (cons (string-to-number (match-string 1))
+ (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)
msg
(format "found %d %s"
count
- (funcall (if (= count 1) 'first 'second)
+ (funcall (if (= count 1) #'car #'cadr)
(pcase db
- ("GTAGS" '("definition" "definitions"))
- ("GSYMS" '("symbol" "symbols"))
- ("GRTAGS" '("reference" "references"))
- ("ID" '("identifier" "identifiers"))
- (_ '("match" "matches"))))))
+ ;; ` 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.
+ (let ((mbeg (text-property-any start (line-end-position) 'global-color t)))
+ (and mbeg (- mbeg start))))
+
;;; NOTE: Must not match the 'Global started at Mon Jun 3 10:24:13'
;;; line or `compilation-auto-jump' will jump there and fail. See
;;; comments before the 'gnu' entry in
;;; `compilation-error-regexp-alist-alist'.
(defvar ggtags-global-error-regexp-alist-alist
(append
- '((path "^\\(?:[^/\n]*/\\)?[^ )\t\n]+$" 0)
- ;; ACTIVE_ESCAPE src/dialog.cc 172
+ `((path "^\\(?:[^\"'\n]*/\\)?[^ )\t\n]+$" 0)
+ ;; 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
(ctags-x "^\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(\\(?:[^/\n]*/\\)?[^ \t\n]+\\)"
- 3 2 nil nil 3 (1 font-lock-function-name-face))
+ 3 2 (,(lambda () (ggtags-global-column (1+ (match-end 0)))))
+ nil 3 (1 font-lock-function-name-face))
;; src/dialog.cc:172:#undef ACTIVE_ESCAPE
(grep "^\\(.+?\\):\\([0-9]+\\):\\(?:$\\|[^0-9\n]\\|[0-9][^0-9\n]\\|[0-9][0-9].\\)"
- 1 2 nil nil 1)
+ 1 2 (,(lambda () (ggtags-global-column (1+ (match-end 2))))) nil 1)
;; src/dialog.cc ACTIVE_ESCAPE 172 #undef ACTIVE_ESCAPE
(cscope "^\\(.+?\\)[ \t]+\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\).*\\(?:[^0-9\n]\\|[^0-9\n][0-9]\\|[^:\n][0-9][0-9]\\)$"
1 3 nil nil 1 (2 font-lock-function-name-face)))
(1- (- wend wbeg)))))))
(goto-char start)
(while (and (> amount 0) (> end (point)))
- (decf amount (funcall advance-word)))))
+ (cl-decf amount (funcall advance-word)))))
(defun ggtags-abbreviate-files (start end)
(goto-char start)
(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-filter ()
"Called from `compilation-filter-hook' (which see)."
- ;; Get rid of line "Using config file '/PATH/TO/.globalrc'."
- (when (re-search-backward "^ *Using config file '.*\n"
- compilation-filter-start t)
+ (let ((ansi-color-apply-face-function
+ (lambda (beg end face)
+ (when face
+ (ansi-color-apply-overlay-face beg end face)
+ (put-text-property beg end 'global-color t)))))
+ (ansi-color-apply-on-region compilation-filter-start (point)))
+ ;; Get rid of line "Using config file '/PATH/TO/.globalrc'." or
+ ;; "Using default configuration."
+ (when (re-search-backward
+ "^ *Using \\(?:config file '.*\\|default configuration.\\)\n"
+ compilation-filter-start t)
(replace-match ""))
- (ansi-color-apply-on-region compilation-filter-start (point))
- (incf ggtags-global-output-lines
- (count-lines compilation-filter-start (point)))
+ (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))
+ (when (and (eq ggtags-auto-jump-to-match 'history)
+ (numberp ggtags-auto-jump-to-match-target)
+ ;; `ggtags-global-output-lines' is imprecise.
+ (> (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.
+ (setq-local compilation-auto-jump-to-first-error t)
+ (run-with-idle-timer 0 nil #'compilation-auto-jump (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)
- (when (and ggtags-auto-jump-to-first-match
- ;; If exit abnormally keep the window for inspection.
- (zerop ggtags-global-exit-status)
- (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)))))
+(defun ggtags-global-handle-exit (buf how)
+ "A function for `compilation-finish-functions' (which see)."
+ (cond
+ ((string-prefix-p "exited abnormally" how)
+ ;; If exit abnormally display the buffer for inspection.
+ (ggtags-global--display-buffer))
+ ((and ggtags-auto-jump-to-match
+ (not (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)))))
+ ;; For the `compilation-auto-jump' in idle timer to run.
+ ;; See also: http://debbugs.gnu.org/13829
+ (sit-for 0)
(ggtags-navigation-mode -1)
- ;; 0.5s delay for `ggtags-auto-jump-to-first-match'
- (sit-for 0) ; See: http://debbugs.gnu.org/13829
- (ggtags-navigation-mode-cleanup buf 0.5)))
+ (ggtags-navigation-mode-cleanup buf 0))))
(defvar ggtags-global-mode-font-lock-keywords
'(("^Global \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
(2 'compilation-error nil t))
("^Global found \\([0-9]+\\)" (1 compilation-info-face))))
+(defvar compilation-always-kill) ;new in 24.3
+
(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)
- (setq-local compilation-scroll-output 'first-error)
+ (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 compilation-error-screen-columns nil)
(setq-local compilation-disable-input t)
(setq-local compilation-always-kill t)
(setq-local compilation-error-face 'compilation-info)
(setq-local compilation-exit-message-function
'ggtags-global-exit-message-function)
+ ;; See: https://github.com/leoliu/ggtags/issues/26
+ (setq-local find-file-suppress-same-file-warnings t)
(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)
- (define-key ggtags-global-mode-map "\M-o" 'visible-mode))
+ (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
;; `emulation-mode-map-alists', which creates double entries. See
(define-key map "\M-{" 'ggtags-navigation-previous-file)
(define-key map "\M->" 'ggtags-navigation-last-error)
(define-key map "\M-<" 'ggtags-navigation-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)
(define-key map "\C-c\C-k"
(lambda () (interactive)
(ggtags-ensure-global-buffer (kill-compilation))))
(define-key map "\M-o" 'ggtags-navigation-visible-mode)
(define-key map [return] 'ggtags-navigation-mode-done)
(define-key map "\r" 'ggtags-navigation-mode-done)
- ;; Intercept M-. and M-* keys
(define-key map [remap pop-tag-mark] 'ggtags-navigation-mode-abort)
- (define-key map [remap ggtags-find-tag-dwim] 'undefined)
map))
(defvar ggtags-mode-map-alist
- `((ggtags-navigation-mode . ,ggtags-navigation-map)))
-
-;; Higher priority for `ggtags-navigation-mode' to avoid being
-;; hijacked by modes such as `view-mode'.
-(add-to-list 'emulation-mode-map-alists 'ggtags-mode-map-alist)
+ `((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" ggtags-navigation-first-error))
(define-key menu [previous-file]
'(menu-item "Previous file" ggtags-navigation-previous-file))
(define-key menu [next-file]
'(menu-item "Next file" ggtags-navigation-next-file))
+ (define-key menu [isearch-forward]
+ '(menu-item "Find match with isearch" ggtags-navigation-isearch-forward))
(define-key menu [previous]
'(menu-item "Previous match" previous-error))
(define-key menu [next]
(defun ggtags-move-to-tag (&optional name)
"Move to NAME tag in current line."
- (let ((orig (point))
- (tag (or name ggtags-current-tag-name)))
- (beginning-of-line)
- (if (and tag (re-search-forward
- (concat "\\_<" (regexp-quote tag) "\\_>")
- (line-end-position)
- t))
- (goto-char (match-beginning 0))
- (goto-char orig))))
+ (let ((tag (or name ggtags-current-tag-name)))
+ ;; Do nothing if on the tag already i.e. by `ggtags-global-column'.
+ (unless (or (not tag) (looking-at (concat (regexp-quote tag) "\\_>")))
+ (let ((orig (point))
+ (regexps (mapcar (lambda (fmtstr)
+ (format fmtstr (regexp-quote tag)))
+ '("\\_<%s\\_>" "%s\\_>" "%s"))))
+ (beginning-of-line)
+ (if (cl-loop for re in regexps
+ ;; Note: tag might not agree with current
+ ;; major-mode's symbol, so try harder. For
+ ;; example, in `php-mode' $cacheBackend is a
+ ;; symbol, but cacheBackend is a tag.
+ thereis (re-search-forward re (line-end-position) t))
+ (goto-char (match-beginning 0))
+ (goto-char orig))))))
(defun ggtags-navigation-mode-cleanup (&optional buf time)
(let ((buf (or buf ggtags-global-last-buffer)))
(kill-compilation))
(when (and (derived-mode-p 'ggtags-global-mode)
(get-buffer-window))
- (quit-window nil (get-buffer-window)))
- (and time (run-with-idle-timer time nil 'kill-buffer buf))))))
+ (quit-windows-on (current-buffer)))
+ (and time (run-with-idle-timer time nil #'kill-buffer buf))))))
(defun ggtags-navigation-mode-done ()
(interactive)
(defun ggtags-navigation-mode-abort ()
(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")
(compilation-previous-error 1)
(compile-goto-error)))
+(defun ggtags-navigation-isearch-forward (&optional regexp-p)
+ (interactive "P")
+ (ggtags-ensure-global-buffer
+ (let ((saved (if visible-mode 1 -1)))
+ (visible-mode 1)
+ (with-selected-window (get-buffer-window (current-buffer))
+ (isearch-forward regexp-p)
+ (beginning-of-line)
+ (visible-mode saved)
+ (compile-goto-error)))))
+
(defun ggtags-navigation-visible-mode (&optional arg)
(interactive (list (or current-prefix-arg 'toggle)))
(ggtags-ensure-global-buffer
(defvar ggtags-global-line-overlay nil)
-(defun ggtags-global-next-error-hook ()
- (ggtags-move-to-tag)
- (ggtags-global-save-start-marker)
- (ignore-errors
- (ggtags-ensure-global-buffer
- (unless (overlayp ggtags-global-line-overlay)
- (setq ggtags-global-line-overlay (make-overlay (point) (point)))
- (overlay-put ggtags-global-line-overlay 'face 'ggtags-global-line))
- (move-overlay ggtags-global-line-overlay
- (line-beginning-position) (line-end-position)
- (current-buffer)))))
+(defun ggtags-global-next-error-function ()
+ (when (eq next-error-last-buffer ggtags-global-last-buffer)
+ (ggtags-move-to-tag)
+ (ggtags-global-save-start-marker)
+ (and (ggtags-project-update-mtime-maybe)
+ (message "File `%s' is newer than GTAGS"
+ (file-name-nondirectory buffer-file-name)))
+ (and ggtags-mode-sticky (ggtags-mode 1))
+ (ignore-errors
+ (ggtags-ensure-global-buffer
+ (unless (overlayp ggtags-global-line-overlay)
+ (setq ggtags-global-line-overlay (make-overlay (point) (point)))
+ (overlay-put ggtags-global-line-overlay 'face 'ggtags-global-line))
+ (move-overlay ggtags-global-line-overlay
+ (line-beginning-position) (line-end-position)
+ (current-buffer))
+ ;; Update search history
+ (let ((id (ggtags-global-search-id (car compilation-arguments)
+ default-directory)))
+ (setq ggtags-global-search-history
+ (cl-remove id ggtags-global-search-history :test #'equal :key #'car))
+ (add-to-history 'ggtags-global-search-history
+ (cons id (ggtags-global-current-search))
+ ggtags-global-history-length))))
+ (run-hooks 'ggtags-find-tag-hook)))
(define-minor-mode ggtags-navigation-mode nil
:lighter
- (" GG[" (:eval (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) "/"))))
+ (" 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
:global t
(if ggtags-navigation-mode
(progn
- (add-hook 'next-error-hook 'ggtags-global-next-error-hook)
+ ;; Higher priority for `ggtags-navigation-mode' to avoid being
+ ;; hijacked by modes such as `view-mode'.
+ (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))
- ;; Call `ggtags-global-save-start-marker' in case of exiting from
- ;; `ggtags-handle-single-match' for single match.
- (ggtags-global-save-start-marker)
- (remove-hook 'next-error-hook 'ggtags-global-next-error-hook)
+ (setq emulation-mode-map-alists
+ (delq 'ggtags-mode-map-alist emulation-mode-map-alists))
+ (remove-hook 'next-error-hook 'ggtags-global-next-error-function)
(remove-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function)))
(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."
(interactive "p")
(ggtags-check-project)
(let ((directories (cons (ggtags-current-project-root) (ggtags-get-libpath)))
- (count 0)
- (some (lambda (pred list)
- (loop for x in list when (funcall pred x) return it))))
+ (count 0))
(dolist (buf (buffer-list))
(let ((file (and (buffer-live-p buf)
(not (eq buf (current-buffer)))
(buffer-file-name buf))))
- (when (and file (funcall some
- (lambda (dir)
+ (when (and file (cl-some (lambda (dir)
;; Don't use `file-in-directory-p'
;; to allow symbolic links.
(string-prefix-p dir file))
directories))
- (and (kill-buffer buf) (incf count)))))
+ (and (kill-buffer buf) (cl-incf count)))))
(and interactive
(message "%d %s killed" count (if (= count 1) "buffer" "buffers")))))
(defun ggtags-after-save-function ()
(when (ggtags-find-project)
- (setf (ggtags-project-dirty-p (ggtags-find-project)) t)
+ (ggtags-project-update-mtime-maybe)
;; When oversize update on a per-save basis.
- (when (and buffer-file-name (ggtags-project-oversize-p))
- (ggtags-with-process-environment
- (process-file "global" nil 0 nil "--single-update"
+ (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))))))
+(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"))
+ (let* ((program (car cmds))
+ (args (cdr cmds))
+ (cutoff (and cutoff (+ cutoff (if (get-buffer buffer)
+ (with-current-buffer buffer
+ (line-number-at-pos (point-max)))
+ 0))))
+ (proc (apply #'start-file-process program buffer program args))
+ (filter (lambda (proc string)
+ (and (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (goto-char (process-mark proc))
+ (insert string)
+ (when (and (> (line-number-at-pos (point-max)) cutoff)
+ (process-live-p proc))
+ (interrupt-process (current-buffer)))))))
+ (sentinel (lambda (proc _msg)
+ (when (memq (process-status proc) '(exit signal))
+ (with-current-buffer (process-buffer proc)
+ (set-process-buffer proc nil)
+ (funcall callback (process-exit-status proc)))))))
+ (set-process-query-on-exit-flag proc nil)
+ (and cutoff (set-process-filter proc filter))
+ (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-show-definition (name)
+ (interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
+ (ggtags-check-project)
+ (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)
+ (show (lambda (_status)
+ (goto-char (point-min))
+ (let ((defs (cl-loop while (re-search-forward re nil t)
+ collect (list (buffer-substring (1+ (match-end 2))
+ (line-end-position))
+ name
+ (match-string 1)
+ (string-to-number (match-string 2))))))
+ (kill-buffer buffer)
+ (with-current-buffer current
+ (funcall fn defs))))))
+ (ggtags-with-current-project
+ (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 "\M-p" 'ggtags-prev-mark)
(define-key m "\M-n" 'ggtags-next-mark)
(define-key m "\M-b" 'ggtags-browse-file-as-hypertext)
(define-key m "\M-k" 'ggtags-kill-file-buffers)
(define-key m "\M-h" 'ggtags-view-tag-history)
+ (define-key m "\M-j" 'ggtags-visit-project-root)
+ (define-key m "\M-/" 'ggtags-global-rerun-search)
+ (define-key m (kbd "M-SPC") 'ggtags-save-to-register)
(define-key m (kbd "M-%") 'ggtags-query-replace)
+ (define-key m "\M-?" 'ggtags-show-definition)
m))
(defvar ggtags-mode-map
(define-key menu [toggle-read-only]
'(menu-item "Toggle project read-only" ggtags-toggle-project-read-only
:button (:toggle . buffer-read-only)))
+ (define-key menu [visit-project-root]
+ '(menu-item "Visit project root" ggtags-visit-project-root))
(define-key menu [sep2] menu-bar-separator)
(define-key menu [browse-hypertext]
'(menu-item "Browse as hypertext" ggtags-browse-file-as-hypertext
(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 [find-file]
'(menu-item "Find files" ggtags-find-file))
(define-key menu [query-replace]
'(menu-item "Find other symbol" ggtags-find-other-symbol))
(define-key menu [find-tag-regexp]
'(menu-item "Find tag matching regexp" ggtags-find-tag-regexp))
+ (define-key menu [show-definition]
+ '(menu-item "Show definition" ggtags-show-definition))
(define-key menu [find-reference]
'(menu-item "Find reference" ggtags-find-reference))
(define-key menu [find-tag-continue]
'(menu-item "Update tag files" ggtags-update-tags
:visible (ggtags-find-project)))
(define-key menu [run-gtags]
- '(menu-item "Run gtags" ggtags-ensure-project
+ '(menu-item "Run gtags" ggtags-create-tags
:visible (not (ggtags-find-project))))
map))
+(defvar ggtags-mode-line-project-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line mouse-1] 'ggtags-visit-project-root)
+ map))
+
+(put 'ggtags-mode-line-project-name 'risky-local-variable t)
+(defvar ggtags-mode-line-project-name
+ '("[" (:eval (let ((name (if (stringp ggtags-project-root)
+ (file-name-nondirectory
+ (directory-file-name ggtags-project-root))
+ "?")))
+ (propertize
+ name 'face compilation-info-face
+ 'help-echo (if (stringp ggtags-project-root)
+ (concat "mouse-1 to visit " ggtags-project-root)
+ "mouse-1 to set project")
+ 'mouse-face 'mode-line-highlight
+ 'keymap ggtags-mode-line-project-keymap)))
+ "]")
+ "Mode line construct for displaying current project name.
+The value is the name of the project root directory. Setting it
+to nil disables displaying this information.")
+
;;;###autoload
(define-minor-mode ggtags-mode nil
:lighter (:eval (if ggtags-navigation-mode "" " GG"))
(unless (timerp ggtags-highlight-tag-timer)
(setq ggtags-highlight-tag-timer
(run-with-idle-timer
- ggtags-highlight-tag-delay t 'ggtags-highlight-tag-at-point)))
+ ggtags-highlight-tag-delay t #'ggtags-highlight-tag-at-point)))
(if ggtags-mode
(progn
(add-hook 'after-save-hook 'ggtags-after-save-function nil t)
- (or (executable-find "global")
- (message "Failed to find GNU Global")))
+ ;; Append to serve as a fallback method.
+ (add-hook 'completion-at-point-functions
+ #'ggtags-completion-at-point t t)
+ (unless (memq 'ggtags-mode-line-project-name
+ mode-line-buffer-identification)
+ (setq mode-line-buffer-identification
+ (append 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)
+ (setq mode-line-buffer-identification
+ (delq 'ggtags-mode-line-project-name mode-line-buffer-identification))
(and (overlayp ggtags-highlight-tag-overlay)
(delete-overlay ggtags-highlight-tag-overlay))
(setq ggtags-highlight-tag-overlay nil)))
(defvar ggtags-highlight-tag-map
(let ((map (make-sparse-keymap)))
- (define-key map [S-down-mouse-1] 'ggtags-find-tag-dwim)
- (define-key map [S-down-mouse-3] 'ggtags-find-reference)
+ ;; Bind down- events so that the global keymap won't ``shine
+ ;; through''. See `mode-line-buffer-identification-keymap' for
+ ;; similar workaround.
+ (define-key map [S-mouse-1] 'ggtags-find-tag-dwim)
+ (define-key map [S-down-mouse-1] 'ignore)
+ (define-key map [S-mouse-3] 'ggtags-find-reference)
+ (define-key map [S-down-mouse-3] 'ignore)
map)
"Keymap used for valid tag at point.")
(put 'ggtags-active-tag 'face 'ggtags-highlight)
(put 'ggtags-active-tag 'keymap ggtags-highlight-tag-map)
;; (put 'ggtags-active-tag 'mouse-face 'match)
-(put 'ggtags-active-tag 'modification-hooks
- (list (lambda (o after &rest _args)
- (and (not after) (delete-overlay o)))))
(put 'ggtags-active-tag 'help-echo
- "S-down-mouse-1 for definitions\nS-down-mouse-3 for references")
+ "S-mouse-1 for definitions\nS-mouse-3 for references")
(defun ggtags-highlight-tag-at-point ()
- (when (and ggtags-mode (eq ggtags-project 'unset))
- (ggtags-find-project))
- (when (and ggtags-mode ggtags-project)
+ (when (and ggtags-mode ggtags-project-root (ggtags-find-project))
(unless (overlayp ggtags-highlight-tag-overlay)
- (setq ggtags-highlight-tag-overlay (make-overlay (point) (point) nil t)))
+ (setq ggtags-highlight-tag-overlay (make-overlay (point) (point) nil t))
+ (overlay-put ggtags-highlight-tag-overlay 'modification-hooks
+ (list (lambda (o after &rest _args)
+ (and (not after) (delete-overlay o))))))
(let ((bounds (funcall ggtags-bounds-of-tag-function))
(o ggtags-highlight-tag-overlay))
(cond
((and bounds
- (overlay-get o 'category)
(eq (overlay-buffer o) (current-buffer))
(= (overlay-start o) (car bounds))
(= (overlay-end o) (cdr bounds)))
- ;; Tag is already highlighted so do nothing.
+ ;; Overlay matches current tag so do nothing.
nil)
((and bounds (let ((completion-ignore-case nil))
(test-completion
;;; imenu
(defun ggtags-goto-imenu-index (name line &rest _args)
- (save-restriction
- (widen)
- (goto-char (point-min))
- (forward-line (1- line))
- (ggtags-move-to-tag name)))
+ (ggtags-forward-to-line line)
+ (ggtags-move-to-tag name))
;;;###autoload
(defun ggtags-build-imenu-index ()
"A function suitable for `imenu-create-index-function'."
- (when buffer-file-name
- (let ((file (file-relative-name buffer-file-name)))
- (with-temp-buffer
- (when (with-demoted-errors
- (zerop (ggtags-with-process-environment
- (process-file "global" nil t nil "-x" "-f" file))))
- (goto-char (point-min))
- (loop while (re-search-forward
- "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)" nil t)
- collect (list (match-string 1)
- (string-to-number (match-string 2))
- 'ggtags-goto-imenu-index)))))))
+ (let ((file (and buffer-file-name (file-relative-name buffer-file-name))))
+ (and file (with-temp-buffer
+ (when (with-demoted-errors
+ (zerop (ggtags-with-current-project
+ (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)
+ collect (list (match-string 1)
+ (string-to-number (match-string 2))
+ 'ggtags-goto-imenu-index)))))))
;;; hippie-expand
;;;###autoload
-(defun try-complete-ggtags-tag (old)
+(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")
(unload-feature 'ggtags force)
(require 'ggtags))
-(defun ggtags-unload-function ()
- (setq emulation-mode-map-alists
- (delq 'ggtags-mode-map-alist emulation-mode-map-alists))
- nil)
-
(provide 'ggtags)
;;; ggtags.el ends here