1 ;;; ggtags.el --- emacs frontend to GNU Global source code tagging system -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
5 ;; Author: Leo Liu <sdl.web@gmail.com>
7 ;; Keywords: tools, convenience
9 ;; URL: https://github.com/leoliu/ggtags
10 ;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
12 ;; This program is free software; you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; This program is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
27 ;; A package to integrate GNU Global source code tagging system
28 ;; (http://www.gnu.org/software/global) with Emacs.
32 ;; `ggtags' is similar to the standard `etags' package. These keys
33 ;; `M-.', `M-,', `M-*' and `C-M-.' should work as expected in
34 ;; `ggtags-mode'. See the README in https://github.com/leoliu/ggtags
37 ;; All commands are available from the `Ggtags' menu in `ggtags-mode'.
48 (require 'tabulated-list) ;preloaded since 24.3
51 (unless (fboundp 'setq-local)
52 (defmacro setq-local (var val)
53 (list 'set (list 'make-local-variable (list 'quote var)) val)))
55 (unless (fboundp 'defvar-local)
56 (defmacro defvar-local (var val &optional docstring)
57 (declare (debug defvar) (doc-string 3))
58 (list 'progn (list 'defvar var val docstring)
59 (list 'make-variable-buffer-local (list 'quote var)))))
61 (defmacro ignore-errors-unless-debug (&rest body)
62 "Ignore all errors while executing BODY unless debug is on."
63 (declare (debug t) (indent 0))
64 `(condition-case-unless-debug nil (progn ,@body) (error nil)))
66 (defmacro with-display-buffer-no-window (&rest body)
67 (declare (debug t) (indent 0))
68 ;; See http://debbugs.gnu.org/13594
69 `(let ((display-buffer-overriding-action
70 (if (and ggtags-auto-jump-to-match
71 ;; Appeared in emacs 24.4.
72 (fboundp 'display-buffer-no-window))
73 (list #'display-buffer-no-window)
74 display-buffer-overriding-action)))
78 (or (fboundp 'user-error) ;24.3
79 (defalias 'user-error 'error))
80 (or (fboundp 'read-only-mode) ;24.3
81 (defalias 'read-only-mode 'toggle-read-only))
82 (or (fboundp 'register-read-with-preview) ;24.4
83 (defalias 'register-read-with-preview 'read-char)))
86 "GNU Global source code tagging system."
89 (defface ggtags-highlight '((t (:underline t)))
90 "Face used to highlight a valid tag at point."
93 (defface ggtags-global-line '((t (:inherit secondary-selection)))
94 "Face used to highlight matched line in Global buffer."
97 (defcustom ggtags-executable-directory nil
98 "If non-nil the directory to search global executables."
99 :type '(choice (const :tag "Unset" nil) directory)
103 (defcustom ggtags-oversize-limit (* 10 1024 1024)
104 "The over size limit for the GTAGS file.
105 For large source trees, running 'global -u' can be expensive.
106 Thus when GTAGS file is larger than this limit, ggtags
107 automatically switches to 'global --single-update'."
109 :type '(choice (const :tag "None" nil)
110 (const :tag "Always" t)
114 (defcustom ggtags-global-always-update nil
115 "If non-nil always update tags for current file on save."
120 (defcustom ggtags-include-pattern
121 '("^\\s-*#\\(?:include\\|import\\)\\s-*[\"<]\\(?:[./]*\\)?\\(.*?\\)[\">]" . 1)
122 "Pattern used to detect #include files.
123 Value can be (REGEXP . SUB) or a function with no arguments.
124 REGEXP should match from the beginning of line."
125 :type '(choice (const :tag "Disable" nil)
126 (cons regexp integer)
131 (defcustom ggtags-use-project-gtagsconf t
132 "Non-nil to use GTAGSCONF file found at project root.
133 File .globalrc and gtags.conf are checked in order."
138 (defcustom ggtags-project-duration 600
139 "Seconds to keep information of a project in memory."
143 (defcustom ggtags-process-environment nil
144 "Similar to `process-environment' with higher precedence.
145 Elements are run through `substitute-env-vars' before use.
146 GTAGSROOT will always be expanded to current project root
147 directory. This is intended for project-wise ggtags-specific
148 process environment settings. Note on remote hosts (e.g. tramp)
149 directory local variables is not enabled by default per
150 `enable-remote-dir-locals' (which see)."
151 :safe 'ggtags-list-of-string-p
152 :type '(repeat string)
155 (defcustom ggtags-auto-jump-to-match 'history
156 "Strategy on how to jump to match: nil, first or history.
158 nil: never automatically jump to any match;
159 first: jump to the first match;
160 history: jump to the match stored in search history."
161 :type '(choice (const :tag "First match" first)
162 (const :tag "Search History" history)
163 (const :tag "Never" nil))
166 (defcustom ggtags-global-window-height 8 ; ggtags-global-mode
167 "Number of lines for the *ggtags-global* popup window.
168 If nil, use Emacs default."
169 :type '(choice (const :tag "Default" nil) integer)
172 (defcustom ggtags-global-abbreviate-filename 40
173 "Non-nil to display file names abbreviated e.g. \"/u/b/env\".
174 If an integer abbreviate only names longer than that number."
175 :type '(choice (const :tag "No" nil)
176 (const :tag "Always" t)
180 (defcustom ggtags-split-window-function split-window-preferred-function
181 "A function to control how ggtags pops up the auxiliary window."
185 (defcustom ggtags-use-idutils (and (executable-find "mkid") t)
186 "Non-nil to also generate the idutils DB."
190 (defcustom ggtags-global-output-format 'grep
191 "Global output format: path, ctags, ctags-x, grep or cscope."
192 :type '(choice (const path)
199 (defcustom ggtags-global-use-color t
200 "Non-nil to use color in output if supported by Global.
201 Note: processing colored output takes noticeable time
202 particularly when the output is large."
207 (defcustom ggtags-global-ignore-case nil
208 "Non-nil if Global should ignore case in the search pattern."
213 (defcustom ggtags-global-treat-text nil
214 "Non-nil if Global should include matches from text files.
215 This affects `ggtags-find-file' and `ggtags-grep'."
220 (defcustom ggtags-global-large-output 1000
221 "Number of lines in the Global buffer to indicate large output."
225 (defcustom ggtags-global-history-length history-length
226 "Maximum number of items to keep in `ggtags-global-search-history'."
230 (defcustom ggtags-enable-navigation-keys t
231 "If non-nil key bindings in `ggtags-navigation-map' are enabled."
236 (defcustom ggtags-find-tag-hook nil
237 "Hook run immediately after finding a tag."
238 :options '(recenter reposition-window)
242 (defcustom ggtags-get-definition-function #'ggtags-get-definition-default
243 "Function called by `ggtags-show-definition' to get definition.
244 It is passed a list of definition candidates of the form:
246 (TEXT NAME FILE LINE)
248 where TEXT is usually the source line of the definition.
250 The return value is passed to `ggtags-print-definition-function'."
254 (defcustom ggtags-print-definition-function
255 (lambda (s) (ggtags-echo "%s" (or s "[definition not found]")))
256 "Function used by `ggtags-show-definition' to print definition."
260 (defcustom ggtags-mode-sticky t
261 "If non-nil enable Ggtags Mode in files visited."
266 (defcustom ggtags-mode-prefix-key "\C-c"
267 "Key binding used for `ggtags-mode-prefix-map'.
268 Users should change the value using `customize-variable' to
269 properly update `ggtags-mode-map'."
270 :set (lambda (sym value)
271 (when (bound-and-true-p ggtags-mode-map)
272 (let ((old (and (boundp sym) (symbol-value sym))))
273 (and old (define-key ggtags-mode-map old nil)))
275 (bound-and-true-p ggtags-mode-prefix-map)
276 (define-key ggtags-mode-map value ggtags-mode-prefix-map)))
277 (set-default sym value))
281 (defcustom ggtags-highlight-tag-delay 0.25
282 "Time in seconds before highlighting tag at point."
283 :set (lambda (sym value)
284 (when (bound-and-true-p ggtags-highlight-tag-timer)
285 (timer-set-idle-time ggtags-highlight-tag-timer value t))
286 (set-default sym value))
290 (defcustom ggtags-bounds-of-tag-function (lambda ()
291 (bounds-of-thing-at-point 'symbol))
292 "Function to get the start and end positions of the tag at point."
296 ;; Used by ggtags-global-mode
297 (defvar ggtags-global-error "match"
298 "Stem of message to print when no matches are found.")
300 (defconst ggtags-bug-url "https://github.com/leoliu/ggtags/issues")
302 (defvar ggtags-global-last-buffer nil)
304 (defvar ggtags-current-tag-name nil)
306 (defvar ggtags-highlight-tag-overlay nil)
308 (defvar ggtags-highlight-tag-timer nil)
310 (defmacro ggtags-with-temp-message (message &rest body)
311 (declare (debug t) (indent 1))
312 (let ((init-time (make-symbol "-init-time-"))
313 (tmp-msg (make-symbol "-tmp-msg-")))
314 `(let ((,init-time (float-time))
316 (with-temp-message ,tmp-msg
317 (prog1 (progn ,@body)
318 (message "%sdone (%.2fs)" ,(or tmp-msg "")
319 (- (float-time) ,init-time)))))))
321 (defmacro ggtags-delay-finish-functions (&rest body)
322 "Delay running `compilation-finish-functions' until after BODY."
323 (declare (indent 0) (debug t))
324 (let ((saved (make-symbol "-saved-"))
325 (exit-args (make-symbol "-exit-args-")))
326 `(let ((,saved compilation-finish-functions)
328 (setq-local compilation-finish-functions nil)
329 (add-hook 'compilation-finish-functions
330 (lambda (&rest args) (setq ,exit-args args))
332 (unwind-protect (progn ,@body)
333 (setq-local compilation-finish-functions ,saved)
334 (and ,exit-args (apply #'run-hook-with-args
335 'compilation-finish-functions ,exit-args))))))
337 (defmacro ggtags-ensure-global-buffer (&rest body)
340 (or (and (buffer-live-p ggtags-global-last-buffer)
341 (with-current-buffer ggtags-global-last-buffer
342 (derived-mode-p 'ggtags-global-mode)))
343 (error "No global buffer found"))
344 (with-current-buffer ggtags-global-last-buffer ,@body)))
346 (defun ggtags-list-of-string-p (xs)
347 "Return non-nil if XS is a list of strings."
348 (cl-every #'stringp xs))
350 (defun ggtags-ensure-localname (file)
351 (and file (or (file-remote-p file 'localname) file)))
353 (defun ggtags-echo (format-string &rest args)
354 "Print formatted text to echo area."
355 (let (message-log-max) (apply #'message format-string args)))
357 (defun ggtags-forward-to-line (line)
358 "Move to line number LINE in current buffer."
359 (cl-check-type line (integer 1))
362 (goto-char (point-min))
363 (forward-line (1- line))))
365 (defun ggtags-program-path (name)
366 (if ggtags-executable-directory
367 (expand-file-name name ggtags-executable-directory)
370 (defun ggtags-process-string (program &rest args)
372 (let ((exit (apply #'process-file
373 (ggtags-program-path program) nil t nil args))
375 (goto-char (point-max))
376 (skip-chars-backward " \t\n")
377 (buffer-substring (point-min) (point)))))
379 (error "`%s' non-zero exit: %s" program output))
382 (defun ggtags-tag-at-point ()
383 (pcase (funcall ggtags-bounds-of-tag-function)
384 (`(,beg . ,end) (buffer-substring beg end))))
386 ;;; Store for project info and settings
388 (defvar ggtags-projects (make-hash-table :size 7 :test #'equal))
390 (cl-defstruct (ggtags-project (:constructor ggtags-project--make)
394 root tag-size has-refs has-path-style has-color dirty-p mtime timestamp)
396 (defun ggtags-make-project (root)
397 (cl-check-type root string)
398 (pcase (nthcdr 5 (file-attributes (expand-file-name "GTAGS" root)))
399 (`(,mtime ,_ ,tag-size . ,_)
400 (let* ((default-directory (file-name-as-directory root))
401 (rtags-size (nth 7 (file-attributes "GRTAGS")))
404 (and (or (> rtags-size (* 32 1024))
406 (not (equal "" (ggtags-process-string "global" "-crs")))))
408 ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1518
410 (with-demoted-errors ; in case `global' not found
411 (and (zerop (process-file (ggtags-program-path "global")
413 "--path-style" "shorter" "--help"))
415 ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1542
418 (and (zerop (process-file (ggtags-program-path "global")
422 (puthash default-directory
423 (ggtags-project--make :root default-directory
426 :has-path-style has-path-style
428 :mtime (float-time mtime)
429 :timestamp (float-time))
432 (defun ggtags-project-expired-p (project)
433 (or (< (ggtags-project-timestamp project) 0)
435 (ggtags-project-timestamp project))
436 ggtags-project-duration)))
438 (defun ggtags-project-update-mtime-maybe (&optional project)
439 "Update PROJECT's modtime and if current file is newer.
440 Value is new modtime if updated."
441 (let ((project (or project (ggtags-find-project))))
442 (when (and (ggtags-project-p project)
443 (consp (visited-file-modtime))
444 (> (float-time (visited-file-modtime))
445 (ggtags-project-mtime project)))
446 (setf (ggtags-project-dirty-p project) t)
447 (setf (ggtags-project-mtime project)
448 (float-time (visited-file-modtime))))))
450 (defun ggtags-project-oversize-p (&optional project)
451 (pcase ggtags-oversize-limit
454 (size (let ((project (or project (ggtags-find-project))))
455 (and project (> (ggtags-project-tag-size project) size))))))
457 (defvar-local ggtags-project-root 'unset
458 "Internal variable for project root directory.")
460 (defun ggtags-clear-project-root ()
461 (kill-local-variable 'ggtags-project-root))
464 (defun ggtags-find-project ()
465 ;; See https://github.com/leoliu/ggtags/issues/42
467 ;; It is unsafe to cache `ggtags-project-root' in non-file buffers.
468 ;; But we keep the cache for a command's duration so that multiple
469 ;; calls of `ggtags-find-project' has no performance impact.
470 (unless buffer-file-name
471 (add-hook 'pre-command-hook #'ggtags-clear-project-root nil t))
472 (let ((project (gethash ggtags-project-root ggtags-projects)))
473 (if (ggtags-project-p project)
474 (if (ggtags-project-expired-p project)
476 (remhash ggtags-project-root ggtags-projects)
477 (ggtags-find-project))
479 (setq ggtags-project-root
480 (or (ignore-errors-unless-debug
481 (file-name-as-directory
482 (concat (file-remote-p default-directory)
483 ;; Resolves symbolic links
484 (ggtags-process-string "global" "-pr"))))
485 ;; 'global -pr' resolves symlinks before checking the
486 ;; GTAGS file which could cause issues such as
487 ;; https://github.com/leoliu/ggtags/issues/22, so
488 ;; let's help it out.
490 ;; Note: `locate-dominating-file' doesn't accept
491 ;; function for NAME before 24.3.
492 (let ((dir (locate-dominating-file default-directory "GTAGS")))
493 ;; `file-truename' may strip the trailing '/' on
494 ;; remote hosts, see http://debbugs.gnu.org/16851
495 (and dir (file-regular-p (expand-file-name "GTAGS" dir))
496 (file-name-as-directory (file-truename dir))))))
497 (when ggtags-project-root
498 (if (gethash ggtags-project-root ggtags-projects)
499 (ggtags-find-project)
500 (ggtags-make-project ggtags-project-root))))))
502 (defun ggtags-current-project-root ()
503 (and (ggtags-find-project)
504 (ggtags-project-root (ggtags-find-project))))
506 (defun ggtags-check-project ()
507 (or (ggtags-find-project) (error "File GTAGS not found")))
509 (defun ggtags-ensure-project ()
510 (or (ggtags-find-project)
511 (when (or (yes-or-no-p "File GTAGS not found; run gtags? ")
512 (user-error "Aborted"))
513 (call-interactively #'ggtags-create-tags)
514 ;; Need checking because `ggtags-create-tags' can create tags
516 (ggtags-check-project))))
518 (defvar delete-trailing-lines) ;new in 24.3
520 (defun ggtags-save-project-settings (&optional noconfirm)
521 "Save Gnu Global's specific environment variables."
523 (ggtags-check-project)
524 (let* ((inhibit-read-only t) ; for `add-dir-local-variable'
525 (default-directory (ggtags-current-project-root))
526 ;; Not using `ggtags-with-current-project' to preserve
527 ;; environment variables that may be present in
528 ;; `ggtags-process-environment'.
530 (append ggtags-process-environment
532 (and (not (ggtags-project-has-refs (ggtags-find-project)))
533 (list "GTAGSLABEL=ctags"))))
534 (envlist (delete-dups
535 (cl-loop for x in process-environment
537 "^\\(GTAGS[^=\n]*\\|MAKEOBJDIRPREFIX\\)=" x)
538 ;; May have duplicates thus `delete-dups'.
539 collect (concat (match-string 1 x)
541 (getenv (match-string 1 x))))))
542 (help-form (format "y: save\nn: don't save\n=: diff\n?: help\n")))
543 (add-dir-local-variable nil 'ggtags-process-environment envlist)
544 ;; Remove trailing newlines by `add-dir-local-variable'.
545 (let ((delete-trailing-lines t)) (delete-trailing-whitespace))
547 (while (pcase (read-char-choice
548 (format "Save `%s'? (y/n/=/?) " buffer-file-name)
550 ;; ` required for 24.1 and 24.2
551 (`?n (user-error "Aborted"))
553 (`?= (diff-buffer-with-file) 'loop)
554 (`?? (help-form-show) 'loop))))
558 (defun ggtags-toggle-project-read-only ()
560 (ggtags-check-project)
561 (let ((inhibit-read-only t) ; for `add-dir-local-variable'
562 (val (not buffer-read-only))
563 (default-directory (ggtags-current-project-root)))
564 (add-dir-local-variable nil 'buffer-read-only val)
567 (when buffer-file-name
568 (read-only-mode (if val +1 -1)))
569 (when (called-interactively-p 'interactive)
570 (message "Project read-only-mode is %s" (if val "on" "off")))
573 (defun ggtags-visit-project-root ()
575 (ggtags-ensure-project)
576 (dired (ggtags-current-project-root)))
578 (defmacro ggtags-with-current-project (&rest body)
579 "Eval BODY in current project's `process-environment'."
581 (let ((gtagsroot (make-symbol "-gtagsroot-"))
582 (root (make-symbol "-ggtags-project-root-")))
583 `(let* ((,root ggtags-project-root)
584 (,gtagsroot (when (ggtags-find-project)
585 (ggtags-ensure-localname
586 (directory-file-name (ggtags-current-project-root)))))
588 (append (let ((process-environment process-environment))
589 (and ,gtagsroot (setenv "GTAGSROOT" ,gtagsroot))
590 (mapcar #'substitute-env-vars ggtags-process-environment))
592 (and ,gtagsroot (list (concat "GTAGSROOT=" ,gtagsroot)))
593 (and (ggtags-find-project)
594 (not (ggtags-project-has-refs (ggtags-find-project)))
595 (list "GTAGSLABEL=ctags")))))
596 (unwind-protect (save-current-buffer ,@body)
597 (setq ggtags-project-root ,root)))))
599 (defun ggtags-get-libpath ()
600 (let ((path (ggtags-with-current-project (getenv "GTAGSLIBPATH"))))
601 (and path (mapcar (apply-partially #'concat (file-remote-p default-directory))
602 (split-string path (regexp-quote path-separator) t)))))
604 (defun ggtags-create-tags (root)
605 "Create tag files (e.g. GTAGS) in directory ROOT.
606 If file .globalrc or gtags.conf exists in ROOT, it will be used
607 as configuration file per `ggtags-use-project-gtagsconf'.
609 If file gtags.files exists in ROOT, it should be a list of source
610 files to index, which can be used to speed gtags up in large
611 source trees. See Info node `(global)gtags' for details."
612 (interactive "DRoot directory: ")
613 (let ((process-environment process-environment))
614 (when (zerop (length root)) (error "No root directory provided"))
615 (setenv "GTAGSROOT" (ggtags-ensure-localname
617 (directory-file-name (file-name-as-directory root)))))
618 (ggtags-with-current-project
619 (let ((conf (and ggtags-use-project-gtagsconf
620 (cl-loop for name in '(".globalrc" "gtags.conf")
621 for full = (expand-file-name name root)
622 thereis (and (file-exists-p full) full)))))
623 (unless (or conf (getenv "GTAGSLABEL")
624 (not (yes-or-no-p "Use `ctags' backend? ")))
625 (setenv "GTAGSLABEL" "ctags"))
626 (ggtags-with-temp-message "`gtags' in progress..."
627 (let ((default-directory (file-name-as-directory root))
629 ;; Place --idutils first
630 #'null (list (and ggtags-use-idutils "--idutils")
631 (and conf "--gtagsconf")
632 (and conf (ggtags-ensure-localname conf))))))
634 (apply #'ggtags-process-string "gtags" args)
635 (error (if (and ggtags-use-idutils
637 (string-match-p "mkid not found" (cadr err)))
638 ;; Retry without mkid
639 (apply #'ggtags-process-string
640 "gtags" (cl-remove "--idutils" args))
641 (signal (car err) (cdr err)))))))))
642 (message "GTAGS generated in `%s'" root)
645 (defun ggtags-update-tags (&optional force)
646 "Update GNU Global tag database.
647 Do nothing if GTAGS exceeds the oversize limit unless FORCE."
649 (ggtags-check-project)
650 ;; Mark project info expired.
651 (setf (ggtags-project-timestamp (ggtags-find-project)) -1)
653 (when (or force (and (ggtags-find-project)
654 (not (ggtags-project-oversize-p))
655 (ggtags-project-dirty-p (ggtags-find-project))))
656 (ggtags-with-current-project
657 (ggtags-with-temp-message "`global -u' in progress..."
658 (ggtags-process-string "global" "-u")
659 (setf (ggtags-project-dirty-p (ggtags-find-project)) nil)
660 (setf (ggtags-project-mtime (ggtags-find-project)) (float-time))))))
662 (defvar-local ggtags-completion-cache nil)
664 ;; See global/libutil/char.c
665 ;; (defconst ggtags-regexp-metachars "[][$()*+.?\\{}|^]")
666 (defvar ggtags-completion-flag "") ;internal use
668 (defvar ggtags-completion-table
669 (completion-table-dynamic
671 (let ((cache-key (concat prefix "$" ggtags-completion-flag)))
672 (unless (equal cache-key (car ggtags-completion-cache))
673 (setq ggtags-completion-cache
675 (ignore-errors-unless-debug
676 ;; May throw global: only name char is allowed
678 (ggtags-with-current-project
680 (apply #'ggtags-process-string
682 (append (and completion-ignore-case '("--ignore-case"))
683 ;; Note -c alone returns only definitions
684 (list (concat "-c" ggtags-completion-flag) prefix)))
686 (cdr ggtags-completion-cache))))
688 (defun ggtags-completion-at-point ()
689 "A function for `completion-at-point-functions'."
690 (pcase (funcall ggtags-bounds-of-tag-function)
692 (and (< beg end) (list beg end ggtags-completion-table)))))
694 (defun ggtags-read-tag (&optional type confirm prompt require-match default)
695 (ggtags-ensure-project)
696 (let ((default (or default (ggtags-tag-at-point)))
697 (prompt (or prompt (capitalize (symbol-name (or type 'tag)))))
698 (ggtags-completion-flag (pcase type
699 (`(or nil definition) "T")
704 ((pred stringp) type)
705 (_ ggtags-completion-flag))))
706 (setq ggtags-current-tag-name
710 (format (if default "%s (default %s): " "%s: ") prompt default)
711 ggtags-completion-table nil require-match nil nil default))
712 (default (substring-no-properties default))
713 (t (ggtags-read-tag type t prompt require-match default))))))
715 (defun ggtags-global-build-command (cmd &rest args)
716 ;; CMD can be definition, reference, symbol, grep, idutils
717 (let ((xs (append (list (shell-quote-argument (ggtags-program-path "global"))
719 (format "--result=%s" ggtags-global-output-format)
720 (and ggtags-global-ignore-case "--ignore-case")
721 (and ggtags-global-use-color
722 (ggtags-find-project)
723 (ggtags-project-has-color (ggtags-find-project))
725 (and (ggtags-find-project)
726 (ggtags-project-has-path-style (ggtags-find-project))
727 "--path-style=shorter")
728 (and ggtags-global-treat-text "--other")
731 (`definition "") ;-d not supported by Global 5.7.1
736 (`idutils "--idutils")))
738 (mapconcat #'identity (delq nil xs) " ")))
740 ;; takes three values: nil, t and a marker
741 (defvar ggtags-global-start-marker nil)
742 (defvar ggtags-global-exit-status 0)
743 (defvar ggtags-global-match-count 0)
744 (defvar ggtags-tag-ring-index nil)
745 (defvar ggtags-global-search-history nil)
747 (defvar ggtags-auto-jump-to-match-target nil)
749 (defun ggtags-global-save-start-marker ()
750 (when (markerp ggtags-global-start-marker)
751 (setq ggtags-tag-ring-index nil)
752 (ring-insert find-tag-marker-ring ggtags-global-start-marker)
753 (setq ggtags-global-start-marker t)))
755 (defun ggtags-global-start (command &optional directory)
756 (let* ((default-directory (or directory (ggtags-current-project-root)))
757 (split-window-preferred-function ggtags-split-window-function)
758 (env ggtags-process-environment))
759 (setq ggtags-global-start-marker (point-marker))
760 (setq ggtags-auto-jump-to-match-target
761 (nth 4 (assoc (ggtags-global-search-id command default-directory)
762 ggtags-global-search-history)))
763 (ggtags-navigation-mode +1)
764 (setq ggtags-global-exit-status 0
765 ggtags-global-match-count 0)
767 (ggtags-with-current-project
768 (with-current-buffer (with-display-buffer-no-window
769 (compilation-start command 'ggtags-global-mode))
770 (setq-local ggtags-process-environment env)
771 (setq ggtags-global-last-buffer (current-buffer))))))
773 (defun ggtags-find-tag-continue ()
775 (ggtags-ensure-global-buffer
776 (ggtags-navigation-mode +1)
777 (let ((split-window-preferred-function ggtags-split-window-function))
778 (ignore-errors (compilation-next-error 1))
779 (compile-goto-error))))
781 (defun ggtags-find-tag (cmd &rest args)
782 (ggtags-check-project)
783 (ggtags-global-start (apply #'ggtags-global-build-command cmd args)))
785 (defun ggtags-include-file ()
786 "Calculate the include file based on `ggtags-include-pattern'."
787 (pcase ggtags-include-pattern
790 (funcall ggtags-include-pattern))
794 (and (looking-at re) (match-string sub))))
795 (_ (warn "Invalid value for `ggtags-include-pattern':%s"
796 ggtags-include-pattern)
800 (defun ggtags-find-tag-dwim (name &optional what)
801 "Find NAME by context.
802 If point is at a definition tag, find references, and vice versa.
803 If point is at a line that matches `ggtags-include-pattern', find
804 the include file instead.
806 When called interactively with a prefix arg, always find
809 (let ((include (and (not current-prefix-arg) (ggtags-include-file))))
810 (ggtags-ensure-project)
811 (if include (list include 'include)
812 (list (ggtags-read-tag 'definition current-prefix-arg)
813 (and current-prefix-arg 'definition)))))
814 (ggtags-check-project) ; for `ggtags-current-project-root' below
817 (ggtags-find-file name))
818 ((or (eq what 'definition)
819 (not buffer-file-name)
820 (and (ggtags-find-project)
821 (not (ggtags-project-has-refs (ggtags-find-project)))))
822 (ggtags-find-tag 'definition (shell-quote-argument name)))
824 (format "--from-here=%d:%s"
826 (shell-quote-argument
827 ;; Note `ggtags-global-start' binds default-directory to
831 (if (string-prefix-p (ggtags-current-project-root)
833 (ggtags-current-project-root)
834 (locate-dominating-file buffer-file-name "GTAGS")))))
835 (shell-quote-argument name)))))
837 (defun ggtags-find-reference (name)
838 (interactive (list (ggtags-read-tag 'reference current-prefix-arg)))
839 (ggtags-find-tag 'reference (shell-quote-argument name)))
841 (defun ggtags-find-other-symbol (name)
842 "Find tag NAME that is a reference without a definition."
843 (interactive (list (ggtags-read-tag 'symbol current-prefix-arg)))
844 (ggtags-find-tag 'symbol (shell-quote-argument name)))
846 (defun ggtags-quote-pattern (pattern)
847 (prin1-to-string (substring-no-properties pattern)))
849 (defun ggtags-idutils-query (pattern)
850 (interactive (list (ggtags-read-tag 'id t)))
851 (ggtags-find-tag 'idutils "--" (ggtags-quote-pattern pattern)))
853 (defun ggtags-grep (pattern &optional invert-match)
854 "Grep for lines matching PATTERN.
855 Invert the match when called with a prefix arg \\[universal-argument]."
856 (interactive (list (ggtags-read-tag 'definition 'confirm
857 (if current-prefix-arg
858 "Inverted grep pattern" "Grep pattern"))
860 (ggtags-find-tag 'grep (and invert-match "--invert-match")
861 "--" (ggtags-quote-pattern pattern)))
863 (defun ggtags-find-file (pattern &optional invert-match)
864 (interactive (list (ggtags-read-tag 'path 'confirm (if current-prefix-arg
865 "Inverted path pattern"
867 nil (thing-at-point 'filename))
869 (let ((ggtags-global-output-format 'path))
870 (ggtags-find-tag 'path (and invert-match "--invert-match")
871 "--" (ggtags-quote-pattern pattern))))
873 ;; NOTE: Coloured output in grep requested: http://goo.gl/Y9IcX
874 (defun ggtags-find-tag-regexp (regexp directory)
875 "List tags matching REGEXP in DIRECTORY (default to project root).
876 When called interactively with a prefix, ask for the directory."
879 (ggtags-check-project)
880 (list (ggtags-read-tag "" t "POSIX regexp")
881 (if current-prefix-arg
882 (read-directory-name "Directory: " nil nil t)
883 (ggtags-current-project-root)))))
884 (ggtags-check-project)
886 (ggtags-global-build-command nil nil "-l" "--" (ggtags-quote-pattern regexp))
887 (file-name-as-directory directory)))
889 (defvar ggtags-navigation-mode)
891 (defun ggtags-query-replace (from to &optional delimited)
892 "Query replace FROM with TO on files in the Global buffer.
893 If not in navigation mode, do a grep on FROM first.
895 Note: the regular expression FROM must be supported by both
898 ;; Note: in 24.4 query-replace-read-args returns a list of 4 elements.
899 (let ((args (query-replace-read-args "Query replace (regexp)" t t)))
900 (list (nth 0 args) (nth 1 args) (nth 2 args))))
901 (unless ggtags-navigation-mode
902 (let ((ggtags-auto-jump-to-match nil))
906 (ggtags-ensure-global-buffer
907 (ggtags-with-temp-message "Waiting for Grep to finish..."
908 (while (get-buffer-process (current-buffer))
910 (goto-char (point-min))
911 (while (ignore-errors (compilation-next-file 1) t)
912 (let ((m (get-text-property (point) 'compilation-message)))
913 (push (expand-file-name
914 (caar (compilation--loc->file-struct
915 (compilation--message->loc m))))
917 (ggtags-navigation-mode -1)
919 (tags-query-replace from to delimited file-form)))
921 (defun ggtags-global-search-id (cmd directory)
922 (sha1 (concat directory (make-string 1 0) cmd)))
924 (defun ggtags-global-current-search ()
925 ;; CMD DIR ENV LINE TEXT
926 (ggtags-ensure-global-buffer
927 (list (car compilation-arguments)
929 ggtags-process-environment
931 (buffer-substring-no-properties
932 (line-beginning-position) (line-end-position)))))
934 (defun ggtags-global-rerun-search-1 (data)
936 (`(,cmd ,dir ,env ,line ,_text)
937 (with-current-buffer (let ((ggtags-auto-jump-to-match nil)
938 ;; Switch current project to DIR.
939 (default-directory dir)
940 (ggtags-project-root dir)
941 (ggtags-process-environment env))
942 (ggtags-global-start cmd dir))
943 (add-hook 'compilation-finish-functions
945 (with-current-buffer buf
946 (ggtags-forward-to-line line)
947 (compile-goto-error)))
950 (defvar-local ggtags-global-search-ewoc nil)
951 (defvar ggtags-global-rerun-search-last nil)
953 (defvar ggtags-global-rerun-search-map
956 (setq ggtags-global-rerun-search-last
957 (ewoc-data (ewoc-locate ggtags-global-search-ewoc))))
960 (ewoc-goto-next ggtags-global-search-ewoc arg)
964 (ewoc-goto-prev ggtags-global-search-ewoc arg)
968 (quit-windows-on (ewoc-buffer ggtags-global-search-ewoc) t))
971 (let ((node (ewoc-locate ggtags-global-search-ewoc)))
975 (ggtags-global-rerun-search-1 (cdr (ewoc-data node)))))))
976 (let ((m (make-sparse-keymap)))
977 (set-keymap-parent m special-mode-map)
978 (define-key m "p" #'prev)
979 (define-key m "\M-p" #'prev)
980 (define-key m "n" #'next)
981 (define-key m "\M-n" #'next)
982 (define-key m "r" #'ggtags-save-to-register)
983 (define-key m "q" #'quit)
984 (define-key m "\r" #'done)
987 (defvar bookmark-make-record-function)
989 (defun ggtags-global-rerun-search ()
990 "Pop up a buffer to choose a past search to re-run.
992 \\{ggtags-global-rerun-search-map}"
994 (or ggtags-global-search-history (user-error "No search history"))
995 (let ((split-window-preferred-function ggtags-split-window-function)
996 (inhibit-read-only t))
997 (pop-to-buffer "*Ggtags Search History*")
1000 (use-local-map ggtags-global-rerun-search-map)
1001 (setq-local ggtags-enable-navigation-keys nil)
1002 (setq-local bookmark-make-record-function #'ggtags-make-bookmark-record)
1003 (setq truncate-lines t)
1004 (cl-labels ((prop (s) (propertize s 'face 'minibuffer-prompt))
1007 (`(,_id ,cmd ,dir ,_env ,line ,text)
1008 (insert (prop " cmd: ") cmd "\n"
1009 (prop " dir: ") dir "\n"
1010 (prop "line: ") (number-to-string line) "\n"
1011 (prop "text: ") text "\n"
1012 (propertize (make-string 32 ?-) 'face 'shadow))))))
1013 (setq ggtags-global-search-ewoc
1014 (ewoc-create #'pp "Global search history keys: n:next p:prev r:register RET:choose\n")))
1015 (dolist (data ggtags-global-search-history)
1016 (ewoc-enter-last ggtags-global-search-ewoc data))
1017 (and ggtags-global-rerun-search-last
1018 (re-search-forward (cadr ggtags-global-rerun-search-last) nil t)
1019 (ewoc-goto-node ggtags-global-search-ewoc
1020 (ewoc-locate ggtags-global-search-ewoc)))
1021 (set-buffer-modified-p nil)
1022 (fit-window-to-buffer nil (floor (frame-height) 2))))
1024 (defun ggtags-save-to-register (r)
1025 "Save current search session to register R.
1026 Use \\[jump-to-register] to restore the search session."
1027 (interactive (list (register-read-with-preview "Save search to register: ")))
1028 (cl-labels ((prn (data)
1030 (`(,command ,root ,_env ,line ,_)
1031 (princ (format "a ggtags search session `%s' in directory `%s' at line %d."
1032 command root line))))))
1033 (set-register r (registerv-make
1034 (if ggtags-global-search-ewoc
1035 (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
1036 (ggtags-global-current-search))
1037 :jump-func #'ggtags-global-rerun-search-1
1038 :print-func #'prn))))
1040 (defun ggtags-make-bookmark-record ()
1041 `(,(and ggtags-current-tag-name (format "*ggtags %s*" ggtags-current-tag-name))
1042 (ggtags-search . ,(if ggtags-global-search-ewoc
1043 (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
1044 (ggtags-global-current-search)))
1045 (handler . ggtags-bookmark-jump)))
1047 (declare-function bookmark-prop-get "bookmark")
1049 (defun ggtags-bookmark-jump (bmk)
1050 (ggtags-global-rerun-search-1 (bookmark-prop-get bmk 'ggtags-search)))
1052 (defun ggtags-delete-tag-files ()
1053 "Delete the GTAGS, GRTAGS, GPATH etc. files generated by gtags."
1054 (interactive (ignore (ggtags-check-project)))
1055 (when (ggtags-current-project-root)
1056 (let* ((re (concat "\\`" (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID")) "\\'"))
1057 (files (cl-remove-if-not
1059 ;; Don't trust `directory-files'.
1060 (let ((case-fold-search nil))
1061 (string-match-p re (file-name-nondirectory file))))
1062 (directory-files (ggtags-current-project-root) t re)))
1063 (buffer "*GTags File List*"))
1064 (or files (user-error "No tag files found"))
1065 (with-output-to-temp-buffer buffer
1066 (princ (mapconcat #'identity files "\n")))
1067 (let ((win (get-buffer-window buffer)))
1070 (fit-window-to-buffer win)
1071 (when (yes-or-no-p "Remove GNU Global tag files? ")
1072 (with-demoted-errors (mapc #'delete-file files))
1073 (remhash (ggtags-current-project-root) ggtags-projects)
1074 (and (overlayp ggtags-highlight-tag-overlay)
1075 (delete-overlay ggtags-highlight-tag-overlay))))
1076 (when (window-live-p win)
1077 (quit-window t win)))))))
1079 (defun ggtags-browse-file-as-hypertext (file line)
1080 "Browse FILE in hypertext (HTML) form."
1081 (interactive (if (or current-prefix-arg (not buffer-file-name))
1082 (list (read-file-name "Browse file: " nil nil t)
1083 (read-number "Line: " 1))
1084 (list buffer-file-name (line-number-at-pos))))
1085 (cl-check-type line (integer 1))
1086 (or (and file (file-exists-p file)) (error "File `%s' doesn't exist" file))
1087 (ggtags-check-project)
1088 (or (file-exists-p (expand-file-name "HTML" (ggtags-current-project-root)))
1089 (if (yes-or-no-p "No hypertext form exists; run htags? ")
1090 (let ((default-directory (ggtags-current-project-root)))
1091 (ggtags-with-current-project (ggtags-process-string "htags")))
1092 (user-error "Aborted")))
1093 (let ((url (ggtags-process-string "gozilla" "-p" (format "+%d" line)
1094 (file-relative-name file))))
1095 (or (equal (file-name-extension
1096 (url-filename (url-generic-parse-url url))) "html")
1097 (user-error "No hypertext form for `%s'" file))
1098 (when (called-interactively-p 'interactive)
1099 (message "Browsing %s" url))
1102 (defun ggtags-next-mark (&optional arg)
1103 "Move to the next (newer) mark in the tag marker ring."
1105 (and (ring-empty-p find-tag-marker-ring) (user-error "Tag ring empty"))
1106 (setq ggtags-tag-ring-index
1107 ;; Note `ring-minus1' gets newer item.
1108 (funcall (if arg #'ring-plus1 #'ring-minus1)
1109 (or ggtags-tag-ring-index
1111 (ring-insert find-tag-marker-ring (point-marker))
1113 (ring-length find-tag-marker-ring)))
1114 (let ((m (ring-ref find-tag-marker-ring ggtags-tag-ring-index))
1115 (i (- (ring-length find-tag-marker-ring) ggtags-tag-ring-index)))
1116 (ggtags-echo "%d%s marker%s" i (pcase (mod i 10)
1117 ;; ` required for 24.1 and 24.2
1122 (if (marker-buffer m) "" " (dead)"))
1123 (if (not (marker-buffer m))
1125 (switch-to-buffer (marker-buffer m))
1128 (defun ggtags-prev-mark ()
1129 "Move to the previous (older) mark in the tag marker ring."
1131 (ggtags-next-mark 'previous))
1133 (defvar ggtags-view-tag-history-mode-map
1134 (let ((m (make-sparse-keymap)))
1135 (define-key m "\M-n" 'next-error-no-select)
1136 (define-key m "\M-p" 'previous-error-no-select)
1137 (define-key m "q" (lambda () (interactive) (quit-window t)))
1140 (define-derived-mode ggtags-view-tag-history-mode tabulated-list-mode "TagHist"
1141 :abbrev-table nil :group 'ggtags)
1143 (defun ggtags-view-tag-history ()
1144 "Pop to a buffer listing visited locations from newest to oldest.
1145 The buffer is a next error buffer and works with standard
1146 commands `next-error' and `previous-error'.
1148 \\{ggtags-view-tag-history-mode-map}"
1150 (and (ring-empty-p find-tag-marker-ring)
1151 (user-error "Tag ring empty"))
1152 (let ((split-window-preferred-function ggtags-split-window-function)
1153 (inhibit-read-only t))
1154 (pop-to-buffer "*Tag Ring*")
1156 (ggtags-view-tag-history-mode)
1157 (setq next-error-function #'ggtags-view-tag-history-next-error
1158 next-error-last-buffer (current-buffer))
1159 (setq tabulated-list-entries
1160 ;; Use a function so that revert can work properly.
1162 (let ((counter (ring-length find-tag-marker-ring))
1163 (elements (or (ring-elements find-tag-marker-ring)
1164 (user-error "Tag ring empty")))
1165 (action (lambda (_button) (next-error 0)))
1166 (get-line (lambda (m)
1167 (with-current-buffer (marker-buffer m)
1170 (buffer-substring (line-beginning-position)
1171 (line-end-position)))))))
1172 (setq tabulated-list-format
1173 `[("ID" ,(max (1+ (floor (log counter 10))) 2)
1175 ("Buffer" ,(max (cl-loop for m in elements
1176 for b = (marker-buffer m)
1178 (length (and b (buffer-name b))))
1181 ("Position" ,(max (cl-loop for m in elements
1182 for p = (or (marker-position m) 1)
1183 maximize (1+ (floor (log p 10))))
1186 (< (string-to-number (aref (cadr x) 2))
1187 (string-to-number (aref (cadr y) 2))))
1189 ("Contents" 100 t)])
1190 (tabulated-list-init-header)
1194 (if (marker-buffer x)
1195 (vector (number-to-string counter)
1196 `(,(buffer-name (marker-buffer x))
1201 (number-to-string (marker-position x))
1202 (funcall get-line x))
1203 (vector (number-to-string counter)
1207 (setq tabulated-list-sort-key '("ID" . t))
1208 (tabulated-list-print)
1209 (fit-window-to-buffer nil (floor (frame-height) 2))))
1211 (defun ggtags-view-tag-history-next-error (&optional arg reset)
1213 (forward-button arg)
1214 (goto-char (point-min))
1215 (forward-button (if (button-at (point)) 0 1)))
1216 (when (get-buffer-window)
1217 (set-window-point (get-buffer-window) (point)))
1218 (pcase (button-get (button-at (point)) 'marker)
1219 ((and (pred markerp) m)
1220 (if (eq (get-buffer-window) (selected-window))
1221 (pop-to-buffer (marker-buffer m))
1222 (switch-to-buffer (marker-buffer m)))
1223 (goto-char (marker-position m)))
1224 (_ (error "Dead marker"))))
1226 (defun ggtags-global-exit-message-function (_process-status exit-status msg)
1227 (setq ggtags-global-exit-status exit-status)
1228 (pcase-let ((`(,count . ,db)
1230 (goto-char (point-max))
1231 (if (re-search-backward
1232 "^\\w+ \\(not found\\)\\|^\\([0-9]+\\) \\w+ located" nil t)
1233 (cons (or (and (match-string 1) 0)
1234 (string-to-number (match-string 2)))
1235 (when (re-search-forward
1236 "using \\(?:\\(idutils\\)\\|'[^']*/\\(\\w+\\)'\\)"
1239 (or (and (match-string 1) "ID")
1242 (setq ggtags-global-match-count count)
1243 ;; Clear the start marker in case of zero matches.
1245 (markerp ggtags-global-start-marker)
1246 (setq ggtags-global-start-marker nil))
1247 (cons (if (> exit-status 0)
1249 (format "found %d %s"
1251 (funcall (if (= count 1) #'car #'cadr)
1253 ;; ` required for 24.1 and 24.2
1254 (`"GTAGS" '("definition" "definitions"))
1255 (`"GSYMS" '("symbol" "symbols"))
1256 (`"GRTAGS" '("reference" "references"))
1257 (`"GPATH" '("file" "files"))
1258 (`"ID" '("identifier" "identifiers"))
1259 (_ '("match" "matches"))))))
1262 (defun ggtags-global-column (start)
1263 ;; START is the beginning position of source text.
1264 (let ((mbeg (text-property-any start (line-end-position) 'global-color t)))
1265 (and mbeg (- mbeg start))))
1267 ;;; NOTE: Must not match the 'Global started at Mon Jun 3 10:24:13'
1268 ;;; line or `compilation-auto-jump' will jump there and fail. See
1269 ;;; comments before the 'gnu' entry in
1270 ;;; `compilation-error-regexp-alist-alist'.
1271 (defvar ggtags-global-error-regexp-alist-alist
1273 `((path "^\\(?:[^\"'\n]*/\\)?[^ )\t\n]+$" 0)
1274 ;; ACTIVE_ESCAPE src/dialog.cc 172
1275 (ctags "^\\([^ \t\n]+\\)[ \t]+\\(.*?\\)[ \t]+\\([0-9]+\\)$"
1276 2 3 nil nil 2 (1 font-lock-function-name-face))
1277 ;; ACTIVE_ESCAPE 172 src/dialog.cc #undef ACTIVE_ESCAPE
1278 (ctags-x "^\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(\\(?:[^/\n]*/\\)?[^ \t\n]+\\)"
1279 3 2 (,(lambda () (ggtags-global-column (1+ (match-end 0)))))
1280 nil 3 (1 font-lock-function-name-face))
1281 ;; src/dialog.cc:172:#undef ACTIVE_ESCAPE
1282 (grep "^\\(.+?\\):\\([0-9]+\\):\\(?:$\\|[^0-9\n]\\|[0-9][^0-9\n]\\|[0-9][0-9].\\)"
1283 1 2 (,(lambda () (ggtags-global-column (1+ (match-end 2))))) nil 1)
1284 ;; src/dialog.cc ACTIVE_ESCAPE 172 #undef ACTIVE_ESCAPE
1285 (cscope "^\\(.+?\\)[ \t]+\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\).*\\(?:[^0-9\n]\\|[^0-9\n][0-9]\\|[^:\n][0-9][0-9]\\)$"
1286 1 3 nil nil 1 (2 font-lock-function-name-face)))
1287 compilation-error-regexp-alist-alist))
1289 (defun ggtags-abbreviate-file (start end)
1290 (let ((inhibit-read-only t)
1291 (amount (if (numberp ggtags-global-abbreviate-filename)
1292 (- (- end start) ggtags-global-abbreviate-filename)
1294 (advance-word (lambda ()
1295 "Return the length of the text made invisible."
1296 (let ((wend (min end (progn (forward-word 1) (point))))
1297 (wbeg (max start (progn (backward-word 1) (point)))))
1299 (if (<= (- wend wbeg) 1)
1301 (put-text-property (1+ wbeg) wend 'invisible t)
1302 (1- (- wend wbeg)))))))
1304 (while (and (> amount 0) (> end (point)))
1305 (cl-decf amount (funcall advance-word)))))
1307 (defun ggtags-abbreviate-files (start end)
1309 (let* ((error-re (cdr (assq ggtags-global-output-format
1310 ggtags-global-error-regexp-alist-alist)))
1311 (sub (cadr error-re)))
1312 (when (and ggtags-global-abbreviate-filename error-re)
1313 (while (re-search-forward (car error-re) end t)
1314 (when (and (or (not (numberp ggtags-global-abbreviate-filename))
1315 (> (length (match-string sub))
1316 ggtags-global-abbreviate-filename))
1317 ;; Ignore bogus file lines such as:
1318 ;; Global found 2 matches at Thu Jan 31 13:45:19
1319 (get-text-property (match-beginning sub) 'compilation-message))
1320 (ggtags-abbreviate-file (match-beginning sub) (match-end sub)))))))
1322 (defvar-local ggtags-global-output-lines 0)
1324 (defun ggtags-global--display-buffer (&optional buffer desired-point)
1325 (pcase (let ((buffer (or buffer (current-buffer)))
1326 (split-window-preferred-function ggtags-split-window-function))
1327 (and (not (get-buffer-window buffer))
1328 (display-buffer buffer '(nil (allow-no-window . t)))))
1329 ((and (pred windowp) w)
1330 (with-selected-window w
1331 (compilation-set-window-height w)
1332 (and desired-point (goto-char desired-point))))))
1334 (defun ggtags-global-filter ()
1335 "Called from `compilation-filter-hook' (which see)."
1336 (let ((ansi-color-apply-face-function
1337 (lambda (beg end face)
1339 (ansi-color-apply-overlay-face beg end face)
1340 (put-text-property beg end 'global-color t)))))
1341 (ansi-color-apply-on-region compilation-filter-start (point)))
1342 ;; Get rid of line "Using config file '/PATH/TO/.globalrc'." or
1343 ;; "Using default configuration."
1344 (when (re-search-backward
1345 "^ *Using \\(?:config file '.*\\|default configuration.\\)\n"
1346 compilation-filter-start t)
1348 (cl-incf ggtags-global-output-lines
1349 (count-lines compilation-filter-start (point)))
1350 ;; If the number of output lines is small
1351 ;; `ggtags-global-handle-exit' takes care of displaying the buffer.
1352 (when (and (> ggtags-global-output-lines 30) ggtags-navigation-mode)
1353 (ggtags-global--display-buffer nil (or compilation-current-error (point-min))))
1354 (when (and (eq ggtags-auto-jump-to-match 'history)
1355 (numberp ggtags-auto-jump-to-match-target)
1356 (not compilation-current-error)
1357 ;; `ggtags-global-output-lines' is imprecise but use it
1358 ;; as first approximation.
1359 (> (+ 10 ggtags-global-output-lines) ggtags-auto-jump-to-match-target)
1360 (> (line-number-at-pos (point-max))
1361 ggtags-auto-jump-to-match-target))
1362 (ggtags-forward-to-line ggtags-auto-jump-to-match-target)
1363 (setq-local ggtags-auto-jump-to-match-target nil)
1365 ;; Can't call `compile-goto-error' here becuase
1366 ;; `compilation-filter' restores point and as a result commands
1367 ;; dependent on point such as `ggtags-navigation-next-file' and
1368 ;; `ggtags-navigation-previous-file' fail to work.
1369 (run-with-idle-timer 0 nil (lambda (buf pt)
1370 (and (buffer-live-p buf)
1371 (with-current-buffer buf
1372 (ggtags-delay-finish-functions
1373 (let ((compilation-auto-jump-to-first-error t))
1374 (with-display-buffer-no-window
1375 (compilation-auto-jump buf pt)))))))
1376 (current-buffer) (point)))
1377 (make-local-variable 'ggtags-global-large-output)
1378 (when (> ggtags-global-output-lines ggtags-global-large-output)
1379 (cl-incf ggtags-global-large-output 500)
1380 (ggtags-echo "Output %d lines (Type `C-c C-k' to cancel)"
1381 ggtags-global-output-lines)))
1383 (defun ggtags-global-handle-exit (buf how)
1384 "A function for `compilation-finish-functions' (which see)."
1386 ((string-prefix-p "exited abnormally" how)
1387 ;; If exit abnormally display the buffer for inspection.
1388 (ggtags-global--display-buffer))
1389 (ggtags-auto-jump-to-match
1390 (if (pcase (compilation-next-single-property-change
1391 (point-min) 'compilation-message)
1392 ((and pt (guard pt))
1393 (compilation-next-single-property-change
1394 (save-excursion (goto-char pt) (end-of-line) (point))
1395 'compilation-message)))
1396 ;; There are multiple matches so pop up the buffer.
1397 (ggtags-global--display-buffer)
1398 ;; For the `compilation-auto-jump' in idle timer to run.
1399 ;; See also: http://debbugs.gnu.org/13829
1401 (ggtags-navigation-mode -1)
1402 (ggtags-navigation-mode-cleanup buf 0)))))
1404 (defvar ggtags-global-mode-font-lock-keywords
1405 '(("^Global \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
1406 (1 'compilation-error)
1407 (2 'compilation-error nil t))
1408 ("^Global found \\([0-9]+\\)" (1 compilation-info-face))))
1410 (defvar compilation-always-kill) ;new in 24.3
1412 (define-compilation-mode ggtags-global-mode "Global"
1413 "A mode for showing outputs from gnu global."
1414 ;; Make it buffer local for `ggtags-abbreviate-files'.
1415 (make-local-variable 'ggtags-global-output-format)
1416 (setq-local compilation-error-regexp-alist
1417 (list ggtags-global-output-format))
1418 (pcase ggtags-auto-jump-to-match
1419 (`history (make-local-variable 'ggtags-auto-jump-to-match-target)
1420 (setq-local compilation-auto-jump-to-first-error
1421 (not ggtags-auto-jump-to-match-target)))
1422 (`nil (setq-local compilation-auto-jump-to-first-error nil))
1423 (_ (setq-local compilation-auto-jump-to-first-error t)))
1424 (setq-local compilation-scroll-output nil)
1425 ;; See `compilation-move-to-column' for details.
1426 (setq-local compilation-first-column 0)
1427 (setq-local compilation-error-screen-columns nil)
1428 (setq-local compilation-disable-input t)
1429 (setq-local compilation-always-kill t)
1430 (setq-local compilation-error-face 'compilation-info)
1431 (setq-local compilation-exit-message-function
1432 'ggtags-global-exit-message-function)
1433 ;; See: https://github.com/leoliu/ggtags/issues/26
1434 (setq-local find-file-suppress-same-file-warnings t)
1435 (setq-local truncate-lines t)
1436 (jit-lock-register #'ggtags-abbreviate-files)
1437 (add-hook 'compilation-filter-hook 'ggtags-global-filter nil 'local)
1438 (add-hook 'compilation-finish-functions 'ggtags-global-handle-exit nil t)
1439 (setq-local bookmark-make-record-function #'ggtags-make-bookmark-record)
1440 (setq-local ggtags-enable-navigation-keys nil)
1441 (add-hook 'kill-buffer-hook (lambda () (ggtags-navigation-mode -1)) nil t))
1443 ;; NOTE: Need this to avoid putting menu items in
1444 ;; `emulation-mode-map-alists', which creates double entries. See
1445 ;; http://i.imgur.com/VJJTzVc.png
1446 (defvar ggtags-navigation-map
1447 (let ((map (make-sparse-keymap)))
1448 (define-key map "\M-n" 'next-error)
1449 (define-key map "\M-p" 'previous-error)
1450 (define-key map "\M-}" 'ggtags-navigation-next-file)
1451 (define-key map "\M-{" 'ggtags-navigation-previous-file)
1452 (define-key map "\M->" 'ggtags-navigation-last-error)
1453 (define-key map "\M-<" 'ggtags-navigation-first-error)
1454 ;; Note: shadows `isearch-forward-regexp' but it can be invoked
1455 ;; with C-u C-s instead.
1456 (define-key map "\C-\M-s" 'ggtags-navigation-isearch-forward)
1457 (define-key map "\C-c\C-k"
1458 (lambda () (interactive)
1459 (ggtags-ensure-global-buffer (kill-compilation))))
1460 (define-key map "\M-o" 'ggtags-navigation-visible-mode)
1461 (define-key map [return] 'ggtags-navigation-mode-done)
1462 (define-key map "\r" 'ggtags-navigation-mode-done)
1463 (define-key map [remap pop-tag-mark] 'ggtags-navigation-mode-abort)
1466 (defvar ggtags-mode-map-alist
1467 `((ggtags-enable-navigation-keys . ,ggtags-navigation-map)))
1469 (defvar ggtags-navigation-mode-map
1470 (let ((map (make-sparse-keymap))
1471 (menu (make-sparse-keymap "GG-Navigation")))
1472 ;; Menu items: (info "(elisp)Extended Menu Items")
1473 (define-key map [menu-bar ggtags-navigation] (cons "GG-Navigation" menu))
1474 ;; Ordered backwards
1475 (define-key menu [visible-mode]
1476 '(menu-item "Visible mode" ggtags-navigation-visible-mode
1477 :button (:toggle . (ignore-errors
1478 (ggtags-ensure-global-buffer
1480 (define-key menu [done]
1481 '(menu-item "Finish navigation" ggtags-navigation-mode-done))
1482 (define-key menu [abort]
1483 '(menu-item "Abort" ggtags-navigation-mode-abort))
1484 (define-key menu [last-match]
1485 '(menu-item "Last match" ggtags-navigation-last-error))
1486 (define-key menu [first-match]
1487 '(menu-item "First match" ggtags-navigation-first-error))
1488 (define-key menu [previous-file]
1489 '(menu-item "Previous file" ggtags-navigation-previous-file))
1490 (define-key menu [next-file]
1491 '(menu-item "Next file" ggtags-navigation-next-file))
1492 (define-key menu [isearch-forward]
1493 '(menu-item "Find match with isearch" ggtags-navigation-isearch-forward))
1494 (define-key menu [previous]
1495 '(menu-item "Previous match" previous-error))
1496 (define-key menu [next]
1497 '(menu-item "Next match" next-error))
1500 (defun ggtags-move-to-tag (&optional name)
1501 "Move to NAME tag in current line."
1502 (let ((tag (or name ggtags-current-tag-name)))
1503 ;; Do nothing if on the tag already i.e. by `ggtags-global-column'.
1504 (unless (or (not tag) (looking-at (concat (regexp-quote tag) "\\_>")))
1505 (let ((orig (point))
1506 (regexps (mapcar (lambda (fmtstr)
1507 (format fmtstr (regexp-quote tag)))
1508 '("\\_<%s\\_>" "%s\\_>" "%s"))))
1510 (if (cl-loop for re in regexps
1511 ;; Note: tag might not agree with current
1512 ;; major-mode's symbol, so try harder. For
1513 ;; example, in `php-mode' $cacheBackend is a
1514 ;; symbol, but cacheBackend is a tag.
1515 thereis (re-search-forward re (line-end-position) t))
1516 (goto-char (match-beginning 0))
1517 (goto-char orig))))))
1519 (defun ggtags-navigation-mode-cleanup (&optional buf time)
1520 (let ((buf (or buf ggtags-global-last-buffer)))
1521 (and (buffer-live-p buf)
1522 (with-current-buffer buf
1523 (when (get-buffer-process (current-buffer))
1525 (when (and (derived-mode-p 'ggtags-global-mode)
1526 (get-buffer-window))
1527 (quit-windows-on (current-buffer)))
1528 (and time (run-with-idle-timer time nil #'kill-buffer buf))))))
1530 (defun ggtags-navigation-mode-done ()
1532 (ggtags-navigation-mode -1)
1533 (setq tags-loop-scan t
1534 tags-loop-operate '(ggtags-find-tag-continue))
1535 (ggtags-navigation-mode-cleanup))
1537 (defun ggtags-navigation-mode-abort ()
1539 (ggtags-navigation-mode -1)
1540 (ggtags-navigation-mode-cleanup nil 0)
1541 ;; Run after (ggtags-navigation-mode -1) or
1542 ;; ggtags-global-start-marker might not have been saved.
1543 (when (and ggtags-global-start-marker
1544 (not (markerp ggtags-global-start-marker)))
1545 (setq ggtags-global-start-marker nil)
1548 (defun ggtags-navigation-next-file (n)
1550 (ggtags-ensure-global-buffer
1551 (compilation-next-file n)
1552 (compile-goto-error)))
1554 (defun ggtags-navigation-previous-file (n)
1556 (ggtags-navigation-next-file (- n)))
1558 (defun ggtags-navigation-first-error ()
1560 (ggtags-ensure-global-buffer
1561 (goto-char (point-min))
1562 (compilation-next-error 1)
1563 (compile-goto-error)))
1565 (defun ggtags-navigation-last-error ()
1567 (ggtags-ensure-global-buffer
1568 (goto-char (point-max))
1569 (compilation-previous-error 1)
1570 (compile-goto-error)))
1572 (defun ggtags-navigation-isearch-forward (&optional regexp-p)
1574 (ggtags-ensure-global-buffer
1575 (let ((saved (if visible-mode 1 -1)))
1577 (with-selected-window (get-buffer-window (current-buffer))
1578 (isearch-forward regexp-p)
1580 (visible-mode saved)
1581 (compile-goto-error)))))
1583 (defun ggtags-navigation-visible-mode (&optional arg)
1584 (interactive (list (or current-prefix-arg 'toggle)))
1585 (ggtags-ensure-global-buffer
1586 (visible-mode arg)))
1588 (defvar ggtags-global-line-overlay nil)
1590 (defun ggtags-global-next-error-function ()
1591 (when (eq next-error-last-buffer ggtags-global-last-buffer)
1592 (ggtags-move-to-tag)
1593 (ggtags-global-save-start-marker)
1594 (and (ggtags-project-update-mtime-maybe)
1595 (message "File `%s' is newer than GTAGS"
1596 (file-name-nondirectory buffer-file-name)))
1597 (and ggtags-mode-sticky (ggtags-mode 1))
1599 (ggtags-ensure-global-buffer
1600 (unless (overlayp ggtags-global-line-overlay)
1601 (setq ggtags-global-line-overlay (make-overlay (point) (point)))
1602 (overlay-put ggtags-global-line-overlay 'face 'ggtags-global-line))
1603 (move-overlay ggtags-global-line-overlay
1604 (line-beginning-position) (line-end-position)
1606 ;; Update search history
1607 (let ((id (ggtags-global-search-id (car compilation-arguments)
1608 default-directory)))
1609 (setq ggtags-global-search-history
1610 (cl-remove id ggtags-global-search-history :test #'equal :key #'car))
1611 (add-to-history 'ggtags-global-search-history
1612 (cons id (ggtags-global-current-search))
1613 ggtags-global-history-length))))
1614 (run-hooks 'ggtags-find-tag-hook)))
1616 (define-minor-mode ggtags-navigation-mode nil
1620 (ggtags-ensure-global-buffer
1621 (let ((index (when (get-text-property (line-beginning-position)
1622 'compilation-message)
1623 ;; Assume the first match appears at line 5
1624 (- (line-number-at-pos) 4))))
1625 `((:propertize ,(if index
1626 (number-to-string (max index 0))
1627 "?") face success) "/")))))
1628 (:propertize (:eval (number-to-string ggtags-global-match-count))
1631 (unless (zerop ggtags-global-exit-status)
1632 `(":" (:propertize ,(number-to-string ggtags-global-exit-status)
1636 (if ggtags-navigation-mode
1638 ;; Higher priority for `ggtags-navigation-mode' to avoid being
1639 ;; hijacked by modes such as `view-mode'.
1640 (add-to-list 'emulation-mode-map-alists 'ggtags-mode-map-alist)
1641 (add-hook 'next-error-hook 'ggtags-global-next-error-function)
1642 (add-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function))
1643 (setq emulation-mode-map-alists
1644 (delq 'ggtags-mode-map-alist emulation-mode-map-alists))
1645 (remove-hook 'next-error-hook 'ggtags-global-next-error-function)
1646 (remove-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function)))
1648 (defun ggtags-minibuffer-setup-function ()
1649 ;; Disable ggtags-navigation-mode in minibuffer.
1650 (setq-local ggtags-enable-navigation-keys nil))
1652 (defun ggtags-kill-file-buffers (&optional interactive)
1653 "Kill all buffers visiting files in current project."
1655 (ggtags-check-project)
1656 (let ((directories (cons (ggtags-current-project-root) (ggtags-get-libpath)))
1658 (dolist (buf (buffer-list))
1659 (let ((file (and (buffer-live-p buf)
1660 (not (eq buf (current-buffer)))
1661 (buffer-file-name buf))))
1662 (when (and file (cl-some (lambda (dir)
1663 ;; Don't use `file-in-directory-p'
1664 ;; to allow symbolic links.
1665 (string-prefix-p dir file))
1667 (and (kill-buffer buf) (cl-incf count)))))
1669 (message "%d %s killed" count (if (= count 1) "buffer" "buffers")))))
1671 (defun ggtags-after-save-function ()
1672 (when (ggtags-find-project)
1673 (ggtags-project-update-mtime-maybe)
1674 ;; When oversize update on a per-save basis.
1675 (when (and buffer-file-name
1676 (or ggtags-global-always-update (ggtags-project-oversize-p)))
1677 (ggtags-with-current-project
1678 (process-file (ggtags-program-path "global") nil 0 nil "--single-update"
1679 (file-relative-name buffer-file-name))))))
1681 (defun ggtags-global-output (buffer cmds callback &optional cutoff)
1682 "Asynchronously pipe the output of running CMDS to BUFFER.
1683 When finished invoke CALLBACK in BUFFER with process exit status."
1684 (or buffer (error "Output buffer required"))
1685 (when (get-buffer-process (get-buffer buffer))
1686 ;; Notice running multiple processes in the same buffer so that we
1687 ;; can fix the caller. See for example `ggtags-eldoc-function'.
1688 (message "Warning: detected %S already running in %S; interrupting..."
1689 (get-buffer-process buffer) buffer)
1690 (interrupt-process (get-buffer-process buffer)))
1691 (let* ((program (car cmds))
1693 (cutoff (and cutoff (+ cutoff (if (get-buffer buffer)
1694 (with-current-buffer buffer
1695 (line-number-at-pos (point-max)))
1697 (proc (apply #'start-file-process program buffer program args))
1698 (filter (lambda (proc string)
1699 (and (buffer-live-p (process-buffer proc))
1700 (with-current-buffer (process-buffer proc)
1701 (goto-char (process-mark proc))
1703 (when (and (> (line-number-at-pos (point-max)) cutoff)
1704 (process-live-p proc))
1705 (interrupt-process (current-buffer)))))))
1706 (sentinel (lambda (proc _msg)
1707 (when (memq (process-status proc) '(exit signal))
1708 (with-current-buffer (process-buffer proc)
1709 (set-process-buffer proc nil)
1710 (funcall callback (process-exit-status proc)))))))
1711 (set-process-query-on-exit-flag proc nil)
1712 (and cutoff (set-process-filter proc filter))
1713 (set-process-sentinel proc sentinel)
1716 (defun ggtags-get-definition-default (defs)
1718 (concat (caar defs) (and (cdr defs) " [guess]"))))
1720 (defun ggtags-show-definition (name)
1721 (interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
1722 (ggtags-check-project)
1723 (let* ((re (cadr (assq 'grep ggtags-global-error-regexp-alist-alist)))
1724 (current (current-buffer))
1725 (buffer (get-buffer-create " *ggtags-definition*"))
1726 ;; Need these bindings so that let-binding
1727 ;; `ggtags-print-definition-function' can work see
1728 ;; `ggtags-eldoc-function'.
1729 (get-fn ggtags-get-definition-function)
1730 (print-fn ggtags-print-definition-function)
1731 (show (lambda (_status)
1732 (goto-char (point-min))
1733 (let ((defs (cl-loop while (re-search-forward re nil t)
1734 collect (list (buffer-substring (1+ (match-end 2))
1735 (line-end-position))
1738 (string-to-number (match-string 2))))))
1739 (kill-buffer buffer)
1740 (with-current-buffer current
1741 (funcall print-fn (funcall get-fn defs)))))))
1742 (ggtags-with-current-project
1743 (ggtags-global-output
1745 (list (ggtags-program-path "global")
1746 "--result=grep" "--path-style=absolute" name)
1749 (defvar ggtags-mode-prefix-map
1750 (let ((m (make-sparse-keymap)))
1751 ;; Globally bound to `M-g p'.
1752 ;; (define-key m "\M-'" 'previous-error)
1753 (define-key m (kbd "M-DEL") 'ggtags-delete-tag-files)
1754 (define-key m "\M-p" 'ggtags-prev-mark)
1755 (define-key m "\M-n" 'ggtags-next-mark)
1756 (define-key m "\M-f" 'ggtags-find-file)
1757 (define-key m "\M-o" 'ggtags-find-other-symbol)
1758 (define-key m "\M-g" 'ggtags-grep)
1759 (define-key m "\M-i" 'ggtags-idutils-query)
1760 (define-key m "\M-b" 'ggtags-browse-file-as-hypertext)
1761 (define-key m "\M-k" 'ggtags-kill-file-buffers)
1762 (define-key m "\M-h" 'ggtags-view-tag-history)
1763 (define-key m "\M-j" 'ggtags-visit-project-root)
1764 (define-key m "\M-/" 'ggtags-global-rerun-search)
1765 (define-key m (kbd "M-SPC") 'ggtags-save-to-register)
1766 (define-key m (kbd "M-%") 'ggtags-query-replace)
1767 (define-key m "\M-?" 'ggtags-show-definition)
1770 (defvar ggtags-mode-map
1771 (let ((map (make-sparse-keymap))
1772 (menu (make-sparse-keymap "Ggtags")))
1773 (define-key map "\M-." 'ggtags-find-tag-dwim)
1774 (define-key map (kbd "M-]") 'ggtags-find-reference)
1775 (define-key map (kbd "C-M-.") 'ggtags-find-tag-regexp)
1776 (define-key map ggtags-mode-prefix-key ggtags-mode-prefix-map)
1778 (define-key map [menu-bar ggtags] (cons "Ggtags" menu))
1779 ;; Ordered backwards
1780 (define-key menu [report-bugs]
1781 `(menu-item "Report bugs"
1782 (lambda () (interactive)
1783 (browse-url ggtags-bug-url)
1784 (message "Please visit %s" ggtags-bug-url))
1785 :help ,(format "Visit %s" ggtags-bug-url)))
1786 (define-key menu [custom-ggtags]
1787 '(menu-item "Customize Ggtags"
1788 (lambda () (interactive) (customize-group 'ggtags))))
1789 (define-key menu [eldoc-mode]
1790 '(menu-item "Toggle eldoc mode" eldoc-mode :button (:toggle . eldoc-mode)))
1791 (define-key menu [save-project]
1792 '(menu-item "Save project settings" ggtags-save-project-settings))
1793 (define-key menu [toggle-read-only]
1794 '(menu-item "Toggle project read-only" ggtags-toggle-project-read-only
1795 :button (:toggle . buffer-read-only)))
1796 (define-key menu [visit-project-root]
1797 '(menu-item "Visit project root" ggtags-visit-project-root))
1798 (define-key menu [sep2] menu-bar-separator)
1799 (define-key menu [browse-hypertext]
1800 '(menu-item "Browse as hypertext" ggtags-browse-file-as-hypertext
1801 :enable (ggtags-find-project)))
1802 (define-key menu [delete-tags]
1803 '(menu-item "Delete tag files" ggtags-delete-tag-files
1804 :enable (ggtags-find-project)))
1805 (define-key menu [kill-buffers]
1806 '(menu-item "Kill project file buffers" ggtags-kill-file-buffers
1807 :enable (ggtags-find-project)))
1808 (define-key menu [view-tag]
1809 '(menu-item "View tag history" ggtags-view-tag-history))
1810 (define-key menu [pop-mark]
1811 '(menu-item "Pop mark" pop-tag-mark
1812 :help "Pop to previous mark and destroy it"))
1813 (define-key menu [next-mark]
1814 '(menu-item "Next mark" ggtags-next-mark))
1815 (define-key menu [prev-mark]
1816 '(menu-item "Previous mark" ggtags-prev-mark))
1817 (define-key menu [sep1] menu-bar-separator)
1818 (define-key menu [rerun-search]
1819 '(menu-item "Re-run past search" ggtags-global-rerun-search))
1820 (define-key menu [save-to-register]
1821 '(menu-item "Save search to register" ggtags-save-to-register))
1822 (define-key menu [previous-error]
1823 '(menu-item "Previous match" previous-error))
1824 (define-key menu [next-error]
1825 '(menu-item "Next match" next-error))
1826 (define-key menu [find-file]
1827 '(menu-item "Find files" ggtags-find-file))
1828 (define-key menu [query-replace]
1829 '(menu-item "Query replace" ggtags-query-replace))
1830 (define-key menu [idutils]
1831 '(menu-item "Query idutils DB" ggtags-idutils-query))
1832 (define-key menu [grep]
1833 '(menu-item "Grep" ggtags-grep))
1834 (define-key menu [find-symbol]
1835 '(menu-item "Find other symbol" ggtags-find-other-symbol))
1836 (define-key menu [find-tag-regexp]
1837 '(menu-item "Find tag matching regexp" ggtags-find-tag-regexp))
1838 (define-key menu [show-definition]
1839 '(menu-item "Show definition" ggtags-show-definition))
1840 (define-key menu [find-reference]
1841 '(menu-item "Find reference" ggtags-find-reference))
1842 (define-key menu [find-tag-continue]
1843 '(menu-item "Continue find tag" tags-loop-continue))
1844 (define-key menu [find-tag]
1845 '(menu-item "Find tag" ggtags-find-tag-dwim))
1846 (define-key menu [update-tags]
1847 '(menu-item "Update tag files" ggtags-update-tags
1848 :visible (ggtags-find-project)))
1849 (define-key menu [run-gtags]
1850 '(menu-item "Run gtags" ggtags-create-tags
1851 :visible (not (ggtags-find-project))))
1854 (defvar ggtags-mode-line-project-keymap
1855 (let ((map (make-sparse-keymap)))
1856 (define-key map [mode-line mouse-1] 'ggtags-visit-project-root)
1859 (put 'ggtags-mode-line-project-name 'risky-local-variable t)
1860 (defvar ggtags-mode-line-project-name
1861 '("[" (:eval (let ((name (if (stringp ggtags-project-root)
1862 (file-name-nondirectory
1863 (directory-file-name ggtags-project-root))
1866 name 'face compilation-info-face
1867 'help-echo (if (stringp ggtags-project-root)
1868 (concat "mouse-1 to visit " ggtags-project-root)
1869 "mouse-1 to set project")
1870 'mouse-face 'mode-line-highlight
1871 'keymap ggtags-mode-line-project-keymap)))
1873 "Mode line construct for displaying current project name.
1874 The value is the name of the project root directory. Setting it
1875 to nil disables displaying this information.")
1878 (define-minor-mode ggtags-mode nil
1879 :lighter (:eval (if ggtags-navigation-mode "" " GG"))
1880 (unless (timerp ggtags-highlight-tag-timer)
1881 (setq ggtags-highlight-tag-timer
1882 (run-with-idle-timer
1883 ggtags-highlight-tag-delay t #'ggtags-highlight-tag-at-point)))
1886 (add-hook 'after-save-hook 'ggtags-after-save-function nil t)
1887 ;; Append to serve as a fallback method.
1888 (add-hook 'completion-at-point-functions
1889 #'ggtags-completion-at-point t t)
1890 (unless (memq 'ggtags-mode-line-project-name
1891 mode-line-buffer-identification)
1892 (setq mode-line-buffer-identification
1893 (append mode-line-buffer-identification
1894 '(ggtags-mode-line-project-name)))))
1895 (remove-hook 'after-save-hook 'ggtags-after-save-function t)
1896 (remove-hook 'completion-at-point-functions #'ggtags-completion-at-point t)
1897 (setq mode-line-buffer-identification
1898 (delq 'ggtags-mode-line-project-name mode-line-buffer-identification))
1899 (and (overlayp ggtags-highlight-tag-overlay)
1900 (delete-overlay ggtags-highlight-tag-overlay))
1901 (setq ggtags-highlight-tag-overlay nil)))
1903 (defvar ggtags-highlight-tag-map
1904 (let ((map (make-sparse-keymap)))
1905 ;; Bind down- events so that the global keymap won't ``shine
1906 ;; through''. See `mode-line-buffer-identification-keymap' for
1907 ;; similar workaround.
1908 (define-key map [S-mouse-1] 'ggtags-find-tag-dwim)
1909 (define-key map [S-down-mouse-1] 'ignore)
1910 (define-key map [S-mouse-3] 'ggtags-find-reference)
1911 (define-key map [S-down-mouse-3] 'ignore)
1913 "Keymap used for valid tag at point.")
1915 (put 'ggtags-active-tag 'face 'ggtags-highlight)
1916 (put 'ggtags-active-tag 'keymap ggtags-highlight-tag-map)
1917 ;; (put 'ggtags-active-tag 'mouse-face 'match)
1918 (put 'ggtags-active-tag 'help-echo
1919 "S-mouse-1 for definitions\nS-mouse-3 for references")
1921 (defun ggtags-highlight-tag-at-point ()
1922 (when (and ggtags-mode ggtags-project-root (ggtags-find-project))
1923 (unless (overlayp ggtags-highlight-tag-overlay)
1924 (setq ggtags-highlight-tag-overlay (make-overlay (point) (point) nil t))
1925 (overlay-put ggtags-highlight-tag-overlay 'modification-hooks
1926 (list (lambda (o after &rest _args)
1927 (and (not after) (delete-overlay o))))))
1928 (let ((bounds (funcall ggtags-bounds-of-tag-function))
1929 (o ggtags-highlight-tag-overlay))
1932 (eq (overlay-buffer o) (current-buffer))
1933 (= (overlay-start o) (car bounds))
1934 (= (overlay-end o) (cdr bounds)))
1935 ;; Overlay matches current tag so do nothing.
1937 ((and bounds (let ((completion-ignore-case nil))
1939 (buffer-substring (car bounds) (cdr bounds))
1940 ggtags-completion-table)))
1941 (move-overlay o (car bounds) (cdr bounds) (current-buffer))
1942 (overlay-put o 'category 'ggtags-active-tag))
1944 (or (car bounds) (point))
1945 (or (cdr bounds) (point))
1947 (overlay-put o 'category nil))))))
1951 (defvar-local ggtags-eldoc-cache nil)
1953 (declare-function eldoc-message "eldoc")
1954 (defun ggtags-eldoc-function ()
1955 "A function suitable for `eldoc-documentation-function' (which see)."
1956 (pcase (ggtags-tag-at-point)
1958 (tag (if (equal tag (car ggtags-eldoc-cache))
1959 (cadr ggtags-eldoc-cache)
1960 (and ggtags-project-root (ggtags-find-project)
1961 (let* ((ggtags-print-definition-function
1963 (setq ggtags-eldoc-cache (list tag s))
1964 (eldoc-message s))))
1965 ;; Prevent multiple runs of ggtags-show-definition
1966 ;; for the same tag.
1967 (setq ggtags-eldoc-cache (list tag))
1968 (ggtags-show-definition tag)
1973 (defun ggtags-goto-imenu-index (name line &rest _args)
1974 (ggtags-forward-to-line line)
1975 (ggtags-move-to-tag name))
1978 (defun ggtags-build-imenu-index ()
1979 "A function suitable for `imenu-create-index-function'."
1980 (let ((file (and buffer-file-name (file-relative-name buffer-file-name))))
1981 (and file (with-temp-buffer
1982 (when (with-demoted-errors
1983 (zerop (ggtags-with-current-project
1984 (process-file (ggtags-program-path "global")
1985 nil t nil "-x" "-f" file))))
1986 (goto-char (point-min))
1987 (cl-loop while (re-search-forward
1988 "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)" nil t)
1989 collect (list (match-string 1)
1990 (string-to-number (match-string 2))
1991 'ggtags-goto-imenu-index)))))))
1996 (defun ggtags-try-complete-tag (old)
1997 "A function suitable for `hippie-expand-try-functions-list'."
1998 (eval-and-compile (require 'hippie-exp))
2000 (he-init-string (or (car (funcall ggtags-bounds-of-tag-function)) (point))
2002 (setq he-expand-list
2003 (and (not (equal he-search-string ""))
2004 (ggtags-find-project)
2005 (sort (all-completions he-search-string
2006 ggtags-completion-table)
2008 (if (null he-expand-list)
2010 (if old (he-reset-string))
2012 (he-substitute-string (car he-expand-list))
2013 (setq he-expand-list (cdr he-expand-list))
2016 (defun ggtags-reload (&optional force)
2018 (unload-feature 'ggtags force)
2022 ;;; ggtags.el ends here