1 ;;; ggtags.el --- emacs frontend to GNU Global source code tagging system -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2013-2015 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'.
39 ;;; NEWS 0.8.10 (2015-06-12):
41 ;; - Tags update on save is configurable by `ggtags-update-on-save'.
42 ;; - New command `ggtags-explain-tags' to explain how each file is
43 ;; indexed in current project.
44 ;; - New user option `ggtags-sort-by-nearness' that sorts matched tags
45 ;; by nearness to current directory.
47 ;; See full NEWS on https://github.com/leoliu/ggtags#news
58 (require 'tabulated-list) ;preloaded since 24.3
61 (unless (fboundp 'setq-local)
62 (defmacro setq-local (var val)
63 (list 'set (list 'make-local-variable (list 'quote var)) val)))
65 (unless (fboundp 'defvar-local)
66 (defmacro defvar-local (var val &optional docstring)
67 (declare (debug defvar) (doc-string 3))
68 (list 'progn (list 'defvar var val docstring)
69 (list 'make-variable-buffer-local (list 'quote var)))))
71 (or (fboundp 'add-function) (defmacro add-function (&rest _))) ;24.4
72 (or (fboundp 'remove-function) (defmacro remove-function (&rest _)))
74 (defmacro ignore-errors-unless-debug (&rest body)
75 "Ignore all errors while executing BODY unless debug is on."
76 (declare (debug t) (indent 0))
77 `(condition-case-unless-debug nil (progn ,@body) (error nil)))
79 (defmacro with-display-buffer-no-window (&rest body)
80 (declare (debug t) (indent 0))
81 ;; See http://debbugs.gnu.org/13594
82 `(let ((display-buffer-overriding-action
83 (if (and ggtags-auto-jump-to-match
84 ;; Appeared in emacs 24.4.
85 (fboundp 'display-buffer-no-window))
86 (list #'display-buffer-no-window)
87 display-buffer-overriding-action)))
91 (or (fboundp 'user-error) ;24.3
92 (defalias 'user-error 'error))
93 (or (fboundp 'read-only-mode) ;24.3
94 (defalias 'read-only-mode 'toggle-read-only))
95 (or (fboundp 'register-read-with-preview) ;24.4
96 (defalias 'register-read-with-preview 'read-char)))
99 "GNU Global source code tagging system."
102 (defface ggtags-highlight '((t (:underline t)))
103 "Face used to highlight a valid tag at point."
106 (defface ggtags-global-line '((t (:inherit secondary-selection)))
107 "Face used to highlight matched line in Global buffer."
110 (defcustom ggtags-executable-directory nil
111 "If non-nil the directory to search global executables."
112 :type '(choice (const :tag "Unset" nil) directory)
116 (defcustom ggtags-oversize-limit (* 10 1024 1024)
117 "The over size limit for the GTAGS file.
118 When the size of the GTAGS file is below this limit, ggtags
119 always maintains up-to-date tags for the whole source tree by
120 running `global -u'. For projects with GTAGS larger than this
121 limit, only files edited in Ggtags mode are updated (via `global
124 :type '(choice (const :tag "None" nil)
125 (const :tag "Always" t)
129 (defcustom ggtags-include-pattern
130 '("^\\s-*#\\s-*\\(?:include\\|import\\)\\s-*[\"<]\\(?:[./]*\\)?\\(.*?\\)[\">]" . 1)
131 "Pattern used to detect #include files.
132 Value can be (REGEXP . SUB) or a function with no arguments.
133 REGEXP should match from the beginning of line."
134 :type '(choice (const :tag "Disable" nil)
135 (cons regexp integer)
140 ;; See also: http://article.gmane.org/gmane.comp.gnu.global.bugs/1751
141 (defcustom ggtags-use-project-gtagsconf t
142 "Non-nil to use GTAGSCONF file found at project root.
143 File .globalrc and gtags.conf are checked in order.
145 Note: GNU Global v6.2.13 has the feature of using gtags.conf at
146 project root. Setting this variable to nil doesn't disable this
152 (defcustom ggtags-project-duration 600
153 "Seconds to keep information of a project in memory."
157 (defcustom ggtags-process-environment nil
158 "Similar to `process-environment' with higher precedence.
159 Elements are run through `substitute-env-vars' before use.
160 GTAGSROOT will always be expanded to current project root
161 directory. This is intended for project-wise ggtags-specific
162 process environment settings. Note on remote hosts (e.g. tramp)
163 directory local variables is not enabled by default per
164 `enable-remote-dir-locals' (which see)."
165 :safe 'ggtags-list-of-string-p
166 :type '(repeat string)
169 (defcustom ggtags-auto-jump-to-match 'history
170 "Strategy on how to jump to match: nil, first or history.
172 nil: never automatically jump to any match;
173 first: jump to the first match;
174 history: jump to the match stored in search history."
175 :type '(choice (const :tag "First match" first)
176 (const :tag "Search History" history)
177 (const :tag "Never" nil))
180 (defcustom ggtags-global-window-height 8 ; ggtags-global-mode
181 "Number of lines for the *ggtags-global* popup window.
182 If nil, use Emacs default."
183 :type '(choice (const :tag "Default" nil) integer)
186 (defcustom ggtags-global-abbreviate-filename 40
187 "Non-nil to display file names abbreviated e.g. \"/u/b/env\".
188 If an integer abbreviate only names longer than that number."
189 :type '(choice (const :tag "No" nil)
190 (const :tag "Always" t)
194 (defcustom ggtags-split-window-function split-window-preferred-function
195 "A function to control how ggtags pops up the auxiliary window."
199 (defcustom ggtags-use-idutils (and (executable-find "mkid") t)
200 "Non-nil to also generate the idutils DB."
204 (defcustom ggtags-use-sqlite3 nil
205 "Use sqlite3 for storage instead of Berkeley DB.
206 This feature requires GNU Global 6.3.3+ and is ignored if `gtags'
207 isn't built with sqlite3 support."
212 (defcustom ggtags-sort-by-nearness nil
213 "Sort tags by nearness to current directory.
214 GNU Global 6.5+ required."
219 (defcustom ggtags-update-on-save t
220 "Non-nil to update tags for current buffer on saving."
221 ;; It is reported that `global --single-update' can be slow in sshfs
222 ;; directories. See https://github.com/leoliu/ggtags/issues/85.
227 (defcustom ggtags-global-output-format 'grep
228 "Global output format: path, ctags, ctags-x, grep or cscope."
229 :type '(choice (const path)
236 (defcustom ggtags-global-use-color t
237 "Non-nil to use color in output if supported by Global.
238 Note: processing colored output takes noticeable time
239 particularly when the output is large."
244 (defcustom ggtags-global-ignore-case nil
245 "Non-nil if Global should ignore case in the search pattern."
250 (defcustom ggtags-global-treat-text nil
251 "Non-nil if Global should include matches from text files.
252 This affects `ggtags-find-file' and `ggtags-grep'."
257 ;; See also https://github.com/leoliu/ggtags/issues/52
258 (defcustom ggtags-global-search-libpath-for-reference t
259 "If non-nil global will search GTAGSLIBPATH for references.
260 Search is only continued in GTAGSLIBPATH if it finds no matches
266 (defcustom ggtags-global-large-output 1000
267 "Number of lines in the Global buffer to indicate large output."
271 (defcustom ggtags-global-history-length history-length
272 "Maximum number of items to keep in `ggtags-global-search-history'."
276 (defcustom ggtags-enable-navigation-keys t
277 "If non-nil key bindings in `ggtags-navigation-map' are enabled."
282 (defcustom ggtags-find-tag-hook nil
283 "Hook run immediately after finding a tag."
284 :options '(recenter reposition-window)
288 (defcustom ggtags-get-definition-function #'ggtags-get-definition-default
289 "Function called by `ggtags-show-definition' to get definition.
290 It is passed a list of definition candidates of the form:
292 (TEXT NAME FILE LINE)
294 where TEXT is usually the source line of the definition.
296 The return value is passed to `ggtags-print-definition-function'."
300 (defcustom ggtags-print-definition-function
301 (lambda (s) (ggtags-echo "%s" (or s "[definition not found]")))
302 "Function used by `ggtags-show-definition' to print definition."
306 (defcustom ggtags-mode-sticky t
307 "If non-nil enable Ggtags Mode in files visited."
312 (defcustom ggtags-mode-prefix-key "\C-c"
313 "Key binding used for `ggtags-mode-prefix-map'.
314 Users should change the value using `customize-variable' to
315 properly update `ggtags-mode-map'."
316 :set (lambda (sym value)
317 (when (bound-and-true-p ggtags-mode-map)
318 (let ((old (and (boundp sym) (symbol-value sym))))
319 (and old (define-key ggtags-mode-map old nil)))
321 (bound-and-true-p ggtags-mode-prefix-map)
322 (define-key ggtags-mode-map value ggtags-mode-prefix-map)))
323 (set-default sym value))
327 (defcustom ggtags-completing-read-function nil
328 "Ggtags specific `completing-read-function' (which see).
329 Nil means using the value of `completing-read-function'."
330 :type '(choice (const :tag "Use completing-read-function" nil)
334 (defcustom ggtags-highlight-tag-delay 0.25
335 "Time in seconds before highlighting tag at point."
336 :set (lambda (sym value)
337 (when (bound-and-true-p ggtags-highlight-tag-timer)
338 (timer-set-idle-time ggtags-highlight-tag-timer value t))
339 (set-default sym value))
343 (defcustom ggtags-bounds-of-tag-function (lambda ()
344 (bounds-of-thing-at-point 'symbol))
345 "Function to get the start and end positions of the tag at point."
349 ;; Used by ggtags-global-mode
350 (defvar ggtags-global-error "match"
351 "Stem of message to print when no matches are found.")
353 (defconst ggtags-bug-url "https://github.com/leoliu/ggtags/issues")
355 (defvar ggtags-global-last-buffer nil)
357 (defvar ggtags-global-continuation nil)
359 (defvar ggtags-current-tag-name nil)
361 (defvar ggtags-highlight-tag-overlay nil)
363 (defvar ggtags-highlight-tag-timer nil)
365 (defmacro ggtags-with-temp-message (message &rest body)
366 (declare (debug t) (indent 1))
367 (let ((init-time (make-symbol "-init-time-"))
368 (tmp-msg (make-symbol "-tmp-msg-")))
369 `(let ((,init-time (float-time))
371 (with-temp-message ,tmp-msg
372 (prog1 (progn ,@body)
373 (message "%sdone (%.2fs)" ,(or tmp-msg "")
374 (- (float-time) ,init-time)))))))
376 (defmacro ggtags-delay-finish-functions (&rest body)
377 "Delay running `compilation-finish-functions' until after BODY."
378 (declare (indent 0) (debug t))
379 (let ((saved (make-symbol "-saved-"))
380 (exit-args (make-symbol "-exit-args-")))
381 `(let ((,saved compilation-finish-functions)
383 (setq-local compilation-finish-functions nil)
384 (add-hook 'compilation-finish-functions
385 (lambda (&rest args) (setq ,exit-args args))
387 (unwind-protect (progn ,@body)
388 (setq-local compilation-finish-functions ,saved)
389 (and ,exit-args (apply #'run-hook-with-args
390 'compilation-finish-functions ,exit-args))))))
392 (defmacro ggtags-ensure-global-buffer (&rest body)
393 (declare (debug t) (indent 0))
395 (or (and (buffer-live-p ggtags-global-last-buffer)
396 (with-current-buffer ggtags-global-last-buffer
397 (derived-mode-p 'ggtags-global-mode)))
398 (error "No global buffer found"))
399 (with-current-buffer ggtags-global-last-buffer ,@body)))
401 (defun ggtags-list-of-string-p (xs)
402 "Return non-nil if XS is a list of strings."
403 (cl-every #'stringp xs))
405 (defun ggtags-ensure-localname (file)
406 (and file (or (file-remote-p file 'localname) file)))
408 (defun ggtags-echo (format-string &rest args)
409 "Print formatted text to echo area."
410 (let (message-log-max) (apply #'message format-string args)))
412 (defun ggtags-forward-to-line (line)
413 "Move to line number LINE in current buffer."
414 (cl-check-type line (integer 1))
417 (goto-char (point-min))
418 (forward-line (1- line))))
420 (defun ggtags-kill-window ()
421 "Quit selected window and kill its buffer."
425 (defun ggtags-program-path (name)
426 (if ggtags-executable-directory
427 (expand-file-name name ggtags-executable-directory)
430 (defun ggtags-process-succeed-p (program &rest args)
431 "Return non-nil if successfully running PROGRAM with ARGS."
432 (let ((program (ggtags-program-path program)))
434 (zerop (apply #'process-file program nil nil nil args))
435 (error (message "`%s' failed: %s" program (error-message-string err))
438 (defun ggtags-process-string (program &rest args)
440 (let ((exit (apply #'process-file
441 (ggtags-program-path program) nil t nil args))
443 (goto-char (point-max))
444 (skip-chars-backward " \t\n")
445 (buffer-substring (point-min) (point)))))
447 (error "`%s' non-zero exit: %s" program output))
450 (defun ggtags-tag-at-point ()
451 (pcase (funcall ggtags-bounds-of-tag-function)
452 (`(,beg . ,end) (buffer-substring beg end))))
454 ;;; Store for project info and settings
456 (defvar ggtags-projects (make-hash-table :size 7 :test #'equal))
458 (cl-defstruct (ggtags-project (:constructor ggtags-project--make)
462 root tag-size has-refs has-path-style has-color dirty-p mtime timestamp)
464 (defun ggtags-make-project (root)
465 (cl-check-type root string)
466 (pcase (nthcdr 5 (file-attributes (expand-file-name "GTAGS" root)))
467 (`(,mtime ,_ ,tag-size . ,_)
468 (let* ((default-directory (file-name-as-directory root))
469 (rtags-size (nth 7 (file-attributes "GRTAGS")))
472 (and (or (> rtags-size (* 32 1024))
473 (with-demoted-errors "ggtags-make-project: %S"
474 (not (equal "" (ggtags-process-string "global" "-crs")))))
476 ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1518
478 (and (ggtags-process-succeed-p "global" "--path-style" "shorter" "--help")
480 ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1542
481 (has-color (and (ggtags-process-succeed-p "global" "--color" "--help")
483 (puthash default-directory
484 (ggtags-project--make :root default-directory
487 :has-path-style has-path-style
489 :mtime (float-time mtime)
490 :timestamp (float-time))
493 (defun ggtags-project-expired-p (project)
494 (or (< (ggtags-project-timestamp project) 0)
496 (ggtags-project-timestamp project))
497 ggtags-project-duration)))
499 (defun ggtags-project-update-mtime-maybe (&optional project)
500 "Update PROJECT's modtime and if current file is newer.
501 Value is new modtime if updated."
502 (let ((project (or project (ggtags-find-project))))
503 (when (and (ggtags-project-p project)
504 (consp (visited-file-modtime))
505 (> (float-time (visited-file-modtime))
506 (ggtags-project-mtime project)))
507 (setf (ggtags-project-dirty-p project) t)
508 (setf (ggtags-project-mtime project)
509 (float-time (visited-file-modtime))))))
511 (defun ggtags-project-oversize-p (&optional project)
512 (pcase ggtags-oversize-limit
515 (size (let ((project (or project (ggtags-find-project))))
516 (and project (> (ggtags-project-tag-size project) size))))))
518 (defvar-local ggtags-last-default-directory nil)
519 (defvar-local ggtags-project-root 'unset
520 "Internal variable for project root directory.")
523 (defun ggtags-find-project ()
524 ;; See https://github.com/leoliu/ggtags/issues/42
526 ;; It is unsafe to cache `ggtags-project-root' in non-file buffers
527 ;; whose `default-directory' can often change.
528 (unless (equal ggtags-last-default-directory default-directory)
529 (kill-local-variable 'ggtags-project-root))
530 (let ((project (gethash ggtags-project-root ggtags-projects)))
531 (if (ggtags-project-p project)
532 (if (ggtags-project-expired-p project)
534 (remhash ggtags-project-root ggtags-projects)
535 (ggtags-find-project))
537 (setq ggtags-last-default-directory default-directory)
538 (setq ggtags-project-root
539 (or (ignore-errors-unless-debug
540 (file-name-as-directory
541 (concat (file-remote-p default-directory)
542 ;; Resolves symbolic links
543 (ggtags-process-string "global" "-pr"))))
544 ;; 'global -pr' resolves symlinks before checking the
545 ;; GTAGS file which could cause issues such as
546 ;; https://github.com/leoliu/ggtags/issues/22, so
547 ;; let's help it out.
549 ;; Note: `locate-dominating-file' doesn't accept
550 ;; function for NAME before 24.3.
551 (let ((dir (locate-dominating-file default-directory "GTAGS")))
552 ;; `file-truename' may strip the trailing '/' on
553 ;; remote hosts, see http://debbugs.gnu.org/16851
554 (and dir (file-regular-p (expand-file-name "GTAGS" dir))
555 (file-name-as-directory (file-truename dir))))))
556 (when ggtags-project-root
557 (if (gethash ggtags-project-root ggtags-projects)
558 (ggtags-find-project)
559 (ggtags-make-project ggtags-project-root))))))
561 (defun ggtags-current-project-root ()
562 (and (ggtags-find-project)
563 (ggtags-project-root (ggtags-find-project))))
565 (defun ggtags-check-project ()
566 (or (ggtags-find-project) (error "File GTAGS not found")))
568 (defun ggtags-ensure-project ()
569 (or (ggtags-find-project)
570 (progn (call-interactively #'ggtags-create-tags)
571 ;; Need checking because `ggtags-create-tags' can create
572 ;; tags in any directory.
573 (ggtags-check-project))))
575 (defvar delete-trailing-lines) ;new in 24.3
577 (defun ggtags-save-project-settings (&optional noconfirm)
578 "Save Gnu Global's specific environment variables."
580 (ggtags-check-project)
581 (let* ((inhibit-read-only t) ; for `add-dir-local-variable'
582 (default-directory (ggtags-current-project-root))
583 ;; Not using `ggtags-with-current-project' to preserve
584 ;; environment variables that may be present in
585 ;; `ggtags-process-environment'.
587 (append ggtags-process-environment
589 (and (not (ggtags-project-has-refs (ggtags-find-project)))
590 (list "GTAGSLABEL=ctags"))))
591 (envlist (delete-dups
592 (cl-loop for x in process-environment
594 "^\\(GTAGS[^=\n]*\\|MAKEOBJDIRPREFIX\\)=" x)
595 ;; May have duplicates thus `delete-dups'.
596 collect (concat (match-string 1 x)
598 (getenv (match-string 1 x))))))
599 (help-form (format "y: save\nn: don't save\n=: diff\n?: help\n")))
600 (add-dir-local-variable nil 'ggtags-process-environment envlist)
601 ;; Remove trailing newlines by `add-dir-local-variable'.
602 (let ((delete-trailing-lines t)) (delete-trailing-whitespace))
604 (while (pcase (read-char-choice
605 (format "Save `%s'? (y/n/=/?) " buffer-file-name)
607 ;; ` required for 24.1 and 24.2
608 (`?n (user-error "Aborted"))
610 (`?= (diff-buffer-with-file) 'loop)
611 (`?? (help-form-show) 'loop))))
615 (defun ggtags-toggle-project-read-only ()
617 (ggtags-check-project)
618 (let ((inhibit-read-only t) ; for `add-dir-local-variable'
619 (val (not buffer-read-only))
620 (default-directory (ggtags-current-project-root)))
621 (add-dir-local-variable nil 'buffer-read-only val)
624 (when buffer-file-name
625 (read-only-mode (if val +1 -1)))
626 (when (called-interactively-p 'interactive)
627 (message "Project read-only-mode is %s" (if val "on" "off")))
630 (defun ggtags-visit-project-root (&optional project)
631 "Visit the root directory of (current) PROJECT in dired.
632 When called with a prefix \\[universal-argument], choose from past projects."
633 (interactive (list (and current-prefix-arg
634 (completing-read "Project: " ggtags-projects))))
635 (dired (cl-typecase project
637 (ggtags-project (ggtags-project-root project))
638 (t (ggtags-ensure-project) (ggtags-current-project-root)))))
640 (defmacro ggtags-with-current-project (&rest body)
641 "Eval BODY in current project's `process-environment'."
642 (declare (debug t) (indent 0))
643 (let ((gtagsroot (make-symbol "-gtagsroot-"))
644 (root (make-symbol "-ggtags-project-root-")))
645 `(let* ((,root ggtags-project-root)
646 (,gtagsroot (when (ggtags-find-project)
647 (ggtags-ensure-localname
648 (directory-file-name (ggtags-current-project-root)))))
650 (append (let ((process-environment process-environment))
651 (and ,gtagsroot (setenv "GTAGSROOT" ,gtagsroot))
652 (mapcar #'substitute-env-vars ggtags-process-environment))
654 (and ,gtagsroot (list (concat "GTAGSROOT=" ,gtagsroot)))
655 (and (ggtags-find-project)
656 (not (ggtags-project-has-refs (ggtags-find-project)))
657 (list "GTAGSLABEL=ctags")))))
658 (unwind-protect (save-current-buffer ,@body)
659 (setq ggtags-project-root ,root)))))
661 (defun ggtags-get-libpath ()
662 (let ((path (ggtags-with-current-project (getenv "GTAGSLIBPATH"))))
663 (and path (mapcar (apply-partially #'concat (file-remote-p default-directory))
664 (split-string path (regexp-quote path-separator) t)))))
666 (defun ggtags-project-relative-file (file)
667 "Get file name relative to current project root."
668 (ggtags-check-project)
669 (if (file-name-absolute-p file)
670 (file-relative-name file (if (string-prefix-p (ggtags-current-project-root)
672 (ggtags-current-project-root)
673 (locate-dominating-file file "GTAGS")))
676 (defun ggtags-project-file-p (file)
677 "Return non-nil if FILE is part of current project."
678 (when (ggtags-find-project)
680 (ggtags-with-current-project
681 ;; NOTE: `process-file' requires all files in ARGS be relative
682 ;; to `default-directory'; see its doc string for details.
683 (let ((default-directory (ggtags-current-project-root)))
684 (process-file (ggtags-program-path "global") nil t nil
685 "-vP" (concat "^" (ggtags-project-relative-file file) "$"))))
686 (goto-char (point-min))
687 (not (re-search-forward "^file not found" nil t)))))
689 (defun ggtags-invalidate-buffer-project-root (root)
691 (with-current-buffer buf
692 (and buffer-file-truename
693 (string-prefix-p root buffer-file-truename)
694 (kill-local-variable 'ggtags-project-root))))
697 (defun ggtags-create-tags (root)
698 "Create tag files (e.g. GTAGS) in directory ROOT.
699 If file .globalrc or gtags.conf exists in ROOT, it will be used
700 as configuration file per `ggtags-use-project-gtagsconf'.
702 If file gtags.files exists in ROOT, it should be a list of source
703 files to index, which can be used to speed gtags up in large
704 source trees. See Info node `(global)gtags' for details."
705 (interactive "DRoot directory: ")
706 (let ((process-environment process-environment))
707 (when (zerop (length root)) (error "No root directory provided"))
708 (setenv "GTAGSROOT" (ggtags-ensure-localname
710 (directory-file-name (file-name-as-directory root)))))
711 (ggtags-with-current-project
712 (let ((conf (and ggtags-use-project-gtagsconf
713 (cl-loop for name in '(".globalrc" "gtags.conf")
714 for full = (expand-file-name name root)
715 thereis (and (file-exists-p full) full)))))
716 (unless (or conf (getenv "GTAGSLABEL")
717 (not (yes-or-no-p "Use `ctags' backend? ")))
718 (setenv "GTAGSLABEL" "ctags"))
719 (ggtags-with-temp-message "`gtags' in progress..."
720 (let ((default-directory (file-name-as-directory root))
723 (list (and ggtags-use-idutils "--idutils")
724 (and ggtags-use-sqlite3
725 (ggtags-process-succeed-p "gtags" "--sqlite3" "--help")
727 (and conf "--gtagsconf")
728 (and conf (ggtags-ensure-localname conf))))))
730 (apply #'ggtags-process-string "gtags" args)
731 (error (if (and ggtags-use-idutils
733 (string-match-p "mkid not found" (cadr err)))
734 ;; Retry without mkid
735 (apply #'ggtags-process-string
736 "gtags" (cl-remove "--idutils" args))
737 (signal (car err) (cdr err)))))))))
738 (ggtags-invalidate-buffer-project-root (file-truename root))
739 (message "GTAGS generated in `%s'" root)
742 (defun ggtags-explain-tags ()
743 "Explain how each file is indexed in current project."
744 (interactive (ignore (ggtags-check-project)
745 (or (ggtags-process-succeed-p "gtags" "--explain" "--help")
746 (user-error "Global 6.4+ required"))))
747 (ggtags-check-project)
748 (ggtags-with-current-project
749 (let ((default-directory (ggtags-current-project-root)))
750 (compilation-start (concat (ggtags-program-path "gtags") " --explain")))))
752 (defun ggtags-update-tags (&optional force)
753 "Update GNU Global tag database.
754 Do nothing if GTAGS exceeds the oversize limit unless FORCE.
756 When called interactively on large (per `ggtags-oversize-limit')
757 projects, the update process runs in the background without
760 (ggtags-check-project)
761 ;; Mark project info expired.
762 (setf (ggtags-project-timestamp (ggtags-find-project)) -1)
763 (list 'interactive)))
764 (cond ((and (eq force 'interactive) (ggtags-project-oversize-p))
765 (ggtags-with-current-project
766 (with-display-buffer-no-window
767 (with-current-buffer (compilation-start "global -u")
768 ;; A hack to fool compilation mode to display `global
769 ;; -u finished' on finish.
770 (setq mode-name "global -u")
771 (add-hook 'compilation-finish-functions
772 #'ggtags-update-tags-finish nil t)))))
773 ((or force (and (ggtags-find-project)
774 (not (ggtags-project-oversize-p))
775 (ggtags-project-dirty-p (ggtags-find-project))))
776 (ggtags-with-current-project
777 (ggtags-with-temp-message "`global -u' in progress..."
778 (ggtags-process-string "global" "-u")
779 (ggtags-update-tags-finish))))))
781 (defun ggtags-update-tags-finish (&optional buf how)
782 (if (and how buf (string-prefix-p "exited abnormally" how))
784 (setf (ggtags-project-dirty-p (ggtags-find-project)) nil)
785 (setf (ggtags-project-mtime (ggtags-find-project)) (float-time))))
787 (defun ggtags-update-tags-single (file &optional nowait)
788 ;; NOTE: NOWAIT is ignored if file is remote file; see
789 ;; `tramp-sh-handle-process-file'.
790 (cl-check-type file string)
791 (let ((nowait (unless (file-remote-p file) nowait)))
792 (ggtags-with-current-project
793 ;; See comment in `ggtags-project-file-p'.
794 (let ((default-directory (ggtags-current-project-root)))
795 (process-file (ggtags-program-path "global") nil (and nowait 0) nil
796 "--single-update" (ggtags-project-relative-file file))))))
798 (defun ggtags-delete-tags ()
799 "Delete file GTAGS, GRTAGS, GPATH, ID etc. generated by gtags."
800 (interactive (ignore (ggtags-check-project)))
801 (when (ggtags-current-project-root)
802 (let* ((re (concat "\\`" (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID")) "\\'"))
803 (files (cl-remove-if-not
805 ;; Don't trust `directory-files'.
806 (let ((case-fold-search nil))
807 (string-match-p re (file-name-nondirectory file))))
808 (directory-files (ggtags-current-project-root) t re)))
809 (buffer "*GTags File List*"))
810 (or files (user-error "No tag files found"))
811 (with-output-to-temp-buffer buffer
812 (princ (mapconcat #'identity files "\n")))
813 (let ((win (get-buffer-window buffer)))
816 (fit-window-to-buffer win)
817 (when (yes-or-no-p "Remove GNU Global tag files? ")
818 (with-demoted-errors (mapc #'delete-file files))
819 (remhash (ggtags-current-project-root) ggtags-projects)
820 (and (overlayp ggtags-highlight-tag-overlay)
821 (delete-overlay ggtags-highlight-tag-overlay))))
822 (when (window-live-p win)
823 (quit-window t win)))))))
825 (defvar-local ggtags-completion-cache nil)
827 ;; See global/libutil/char.c
828 ;; (defconst ggtags-regexp-metachars "[][$()*+.?\\{}|^]")
829 (defvar ggtags-completion-flag "") ;internal use
831 (defvar ggtags-completion-table
832 (completion-table-dynamic
834 (let ((cache-key (concat prefix "$" ggtags-completion-flag)))
835 (unless (equal cache-key (car ggtags-completion-cache))
836 (setq ggtags-completion-cache
838 (ignore-errors-unless-debug
839 ;; May throw global: only name char is allowed
841 (ggtags-with-current-project
843 (apply #'ggtags-process-string
845 (append (and completion-ignore-case '("--ignore-case"))
846 ;; Note -c alone returns only definitions
847 (list (concat "-c" ggtags-completion-flag) prefix)))
849 (cdr ggtags-completion-cache))))
851 (defun ggtags-completion-at-point ()
852 "A function for `completion-at-point-functions'."
853 (pcase (funcall ggtags-bounds-of-tag-function)
855 (and (< beg end) (list beg end ggtags-completion-table)))))
857 (defun ggtags-read-tag (&optional type confirm prompt require-match default)
858 (ggtags-ensure-project)
859 (let ((default (or default (ggtags-tag-at-point)))
860 (prompt (or prompt (capitalize (symbol-name (or type 'tag)))))
861 (ggtags-completion-flag (pcase type
862 (`(or nil definition) "T")
867 ((pred stringp) type)
868 (_ ggtags-completion-flag))))
869 (setq ggtags-current-tag-name
872 (let ((completing-read-function
873 (or ggtags-completing-read-function
874 completing-read-function)))
876 (format (if default "%s (default %s): " "%s: ") prompt default)
877 ggtags-completion-table nil require-match nil nil default)))
878 (default (substring-no-properties default))
879 (t (ggtags-read-tag type t prompt require-match default))))))
881 (defun ggtags-sort-by-nearness-p ()
882 (and ggtags-sort-by-nearness
883 (ggtags-process-succeed-p "global" "--nearness" "--help")))
885 (defun ggtags-global-build-command (cmd &rest args)
886 ;; CMD can be definition, reference, symbol, grep, idutils
887 (let ((xs (append (list (shell-quote-argument (ggtags-program-path "global"))
889 (format "--result=%s" ggtags-global-output-format)
890 (and ggtags-global-ignore-case "--ignore-case")
891 (and ggtags-global-use-color
892 (ggtags-find-project)
893 (ggtags-project-has-color (ggtags-find-project))
895 (and (ggtags-sort-by-nearness-p) "--nearness")
896 (and (ggtags-find-project)
897 (ggtags-project-has-path-style (ggtags-find-project))
898 "--path-style=shorter")
899 (and ggtags-global-treat-text "--other")
902 (`definition nil) ;-d not supported by Global 5.7.1
903 (`reference "--reference")
907 (`idutils "--idutils")))
909 (mapconcat #'identity (delq nil xs) " ")))
911 ;; Can be three values: nil, t and a marker; t means start marker has
912 ;; been saved in the tag ring.
913 (defvar ggtags-global-start-marker nil)
914 (defvar ggtags-global-start-file nil)
915 (defvar ggtags-tag-ring-index nil)
916 (defvar ggtags-global-search-history nil)
918 (defvar ggtags-auto-jump-to-match-target nil)
920 (defvar-local ggtags-global-exit-info nil) ; (EXIT-STATUS COUNT DB)
922 (defun ggtags-global-save-start-marker ()
923 (when (markerp ggtags-global-start-marker)
924 (setq ggtags-tag-ring-index nil)
925 (ring-insert find-tag-marker-ring ggtags-global-start-marker)
926 (setq ggtags-global-start-marker t)))
928 (defun ggtags-global-start (command &optional directory)
929 (let* ((default-directory (or directory (ggtags-current-project-root)))
930 (split-window-preferred-function ggtags-split-window-function)
931 (env ggtags-process-environment))
932 (unless (markerp ggtags-global-start-marker)
933 (setq ggtags-global-start-marker (point-marker)))
934 ;; Record the file name for `ggtags-navigation-start-file'.
935 (setq ggtags-global-start-file buffer-file-name)
936 (setq ggtags-auto-jump-to-match-target
937 (nth 4 (assoc (ggtags-global-search-id command default-directory)
938 ggtags-global-search-history)))
939 (ggtags-navigation-mode +1)
941 (ggtags-with-current-project
942 (with-current-buffer (with-display-buffer-no-window
943 (compilation-start command 'ggtags-global-mode))
944 (setq-local ggtags-process-environment env)
945 (setq ggtags-global-last-buffer (current-buffer))))))
947 (defun ggtags-find-tag-continue ()
949 (ggtags-ensure-global-buffer
950 (ggtags-navigation-mode +1)
951 (let ((split-window-preferred-function ggtags-split-window-function))
952 (ignore-errors (compilation-next-error 1))
953 (compile-goto-error))))
955 (defun ggtags-find-tag (cmd &rest args)
956 (ggtags-check-project)
957 (ggtags-global-start (apply #'ggtags-global-build-command cmd args)
958 (and (ggtags-sort-by-nearness-p) default-directory)))
960 (defun ggtags-include-file ()
961 "Calculate the include file based on `ggtags-include-pattern'."
962 (pcase ggtags-include-pattern
965 (funcall ggtags-include-pattern))
969 (and (looking-at re) (match-string sub))))
970 (_ (warn "Invalid value for `ggtags-include-pattern': %s"
971 ggtags-include-pattern)
975 (defun ggtags-find-tag-dwim (name &optional what)
976 "Find NAME by context.
977 If point is at a definition tag, find references, and vice versa.
978 If point is at a line that matches `ggtags-include-pattern', find
979 the include file instead.
981 When called interactively with a prefix arg, always find
984 (let ((include (and (not current-prefix-arg) (ggtags-include-file))))
985 (ggtags-ensure-project)
986 (if include (list include 'include)
987 (list (ggtags-read-tag 'definition current-prefix-arg)
988 (and current-prefix-arg 'definition)))))
989 (ggtags-check-project) ; For `ggtags-current-project-root' below.
992 (ggtags-find-file name))
993 ((or (eq what 'definition)
994 (not buffer-file-name)
995 (not (ggtags-project-has-refs (ggtags-find-project)))
996 (not (ggtags-project-file-p buffer-file-name)))
997 (ggtags-find-definition name))
999 (format "--from-here=%d:%s"
1000 (line-number-at-pos)
1001 (shell-quote-argument
1002 ;; Note `ggtags-find-tag' may bind `default-directory'
1004 (funcall (if (ggtags-sort-by-nearness-p)
1005 #'file-relative-name #'ggtags-project-relative-file)
1007 (shell-quote-argument name)))))
1009 (defun ggtags-find-tag-mouse (event)
1011 (with-selected-window (posn-window (event-start event))
1013 (goto-char (posn-point (event-start event)))
1014 (call-interactively #'ggtags-find-tag-dwim))))
1016 ;; Another option for `M-.'.
1017 (defun ggtags-find-definition (name)
1018 (interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
1019 (ggtags-find-tag 'definition (shell-quote-argument name)))
1021 (defun ggtags-setup-libpath-search (type name)
1022 (pcase (and ggtags-global-search-libpath-for-reference
1023 (ggtags-get-libpath))
1024 ((and libs (guard libs))
1025 (cl-labels ((cont (buf how)
1026 (pcase ggtags-global-exit-info
1029 (setq default-directory
1030 (file-name-as-directory (pop libs)))
1031 (and libs (setq ggtags-global-continuation #'cont))
1032 (if (ggtags-find-project)
1033 (ggtags-find-tag type (shell-quote-argument name))
1035 (_ (ggtags-global-handle-exit buf how)))))
1036 (setq ggtags-global-continuation #'cont)))))
1038 (defun ggtags-find-reference (name)
1039 (interactive (list (ggtags-read-tag 'reference current-prefix-arg)))
1040 (ggtags-setup-libpath-search 'reference name)
1041 (ggtags-find-tag 'reference (shell-quote-argument name)))
1043 (defun ggtags-find-other-symbol (name)
1044 "Find tag NAME that is a reference without a definition."
1045 (interactive (list (ggtags-read-tag 'symbol current-prefix-arg)))
1046 (ggtags-setup-libpath-search 'symbol name)
1047 (ggtags-find-tag 'symbol (shell-quote-argument name)))
1049 (defun ggtags-quote-pattern (pattern)
1050 (prin1-to-string (substring-no-properties pattern)))
1052 (defun ggtags-idutils-query (pattern)
1053 (interactive (list (ggtags-read-tag 'id t)))
1054 (ggtags-find-tag 'idutils "--" (ggtags-quote-pattern pattern)))
1056 (defun ggtags-grep (pattern &optional invert-match)
1057 "Grep for lines matching PATTERN.
1058 Invert the match when called with a prefix arg \\[universal-argument]."
1059 (interactive (list (ggtags-read-tag 'definition 'confirm
1060 (if current-prefix-arg
1061 "Inverted grep pattern" "Grep pattern"))
1062 current-prefix-arg))
1063 (ggtags-find-tag 'grep (and invert-match "--invert-match")
1064 "--" (ggtags-quote-pattern pattern)))
1066 (defun ggtags-find-file (pattern &optional invert-match)
1067 (interactive (list (ggtags-read-tag 'path 'confirm (if current-prefix-arg
1068 "Inverted path pattern"
1070 nil (thing-at-point 'filename))
1071 current-prefix-arg))
1072 (let ((ggtags-global-output-format 'path))
1073 (ggtags-find-tag 'path (and invert-match "--invert-match")
1074 "--" (ggtags-quote-pattern pattern))))
1076 ;; Note: Coloured output requested in http://goo.gl/Y9IcX and appeared
1077 ;; in global v6.2.12.
1078 (defun ggtags-find-tag-regexp (regexp directory)
1079 "List tags matching REGEXP in DIRECTORY (default to project root).
1080 When called interactively with a prefix, ask for the directory."
1083 (ggtags-check-project)
1084 (list (ggtags-read-tag "" t "POSIX regexp")
1085 (if current-prefix-arg
1086 (read-directory-name "Directory: " nil nil t)
1087 (ggtags-current-project-root)))))
1088 (ggtags-check-project)
1089 (ggtags-global-start
1090 (ggtags-global-build-command nil nil "-l" "--" (ggtags-quote-pattern regexp))
1091 (file-name-as-directory directory)))
1093 (defvar ggtags-navigation-mode)
1095 (defun ggtags-foreach-file (fn)
1096 "Invoke FN with each file found.
1097 FN is invoked while *ggtags-global* buffer is current."
1098 (ggtags-ensure-global-buffer
1100 (goto-char (point-min))
1101 (while (with-demoted-errors "compilation-next-error: %S"
1102 (compilation-next-error 1 'file)
1105 (compilation--loc->file-struct
1106 (compilation--message->loc
1107 (get-text-property (point) 'compilation-message)))))))))
1109 (defun ggtags-query-replace (from to &optional delimited)
1110 "Query replace FROM with TO on files in the Global buffer.
1111 If not in navigation mode, do a grep on FROM first.
1113 Note: the regular expression FROM must be supported by both
1116 ;; Note: in 24.4 query-replace-read-args returns a list of 4 elements.
1117 (let ((args (query-replace-read-args "Query replace (regexp)" t t)))
1118 (list (nth 0 args) (nth 1 args) (nth 2 args))))
1119 (unless ggtags-navigation-mode
1120 (let ((ggtags-auto-jump-to-match nil))
1121 (ggtags-grep from)))
1124 (ggtags-ensure-global-buffer
1125 (ggtags-with-temp-message "Waiting for Grep to finish..."
1126 (while (get-buffer-process (current-buffer))
1128 (ggtags-foreach-file
1129 (lambda (file) (push (expand-file-name file) files))))
1130 (ggtags-navigation-mode -1)
1132 (tags-query-replace from to delimited file-form)))
1134 (defun ggtags-global-normalise-command (cmd)
1136 (concat (regexp-quote (ggtags-global-build-command nil)) "\\s-*")
1138 (substring-no-properties cmd (match-end 0))
1141 (defun ggtags-global-search-id (cmd directory)
1142 (sha1 (concat directory (make-string 1 0)
1143 (ggtags-global-normalise-command cmd))))
1145 (defun ggtags-global-current-search ()
1146 ;; CMD DIR ENV LINE TEXT
1147 (ggtags-ensure-global-buffer
1148 (list (ggtags-global-normalise-command (car compilation-arguments))
1150 ggtags-process-environment
1151 (line-number-at-pos)
1152 (buffer-substring-no-properties
1153 (line-beginning-position) (line-end-position)))))
1155 (defun ggtags-global-rerun-search (data)
1157 (`(,cmd ,dir ,env ,line ,_text)
1158 (with-current-buffer (let ((ggtags-auto-jump-to-match nil)
1159 ;; Switch current project to DIR.
1160 (default-directory dir)
1161 (ggtags-project-root dir)
1162 (ggtags-process-environment env))
1163 (ggtags-global-start
1164 (ggtags-global-build-command cmd) dir))
1165 (add-hook 'compilation-finish-functions
1167 (with-current-buffer buf
1168 (ggtags-forward-to-line line)
1169 (compile-goto-error)))
1172 (defvar-local ggtags-global-search-ewoc nil)
1173 (defvar ggtags-view-search-history-last nil)
1175 (defvar ggtags-view-search-history-mode-map
1176 (let ((m (make-sparse-keymap)))
1177 (define-key m "p" 'ggtags-view-search-history-prev)
1178 (define-key m "\M-p" 'ggtags-view-search-history-prev)
1179 (define-key m "n" 'ggtags-view-search-history-next)
1180 (define-key m "\M-n" 'ggtags-view-search-history-next)
1181 (define-key m "\C-k" 'ggtags-view-search-history-kill)
1182 (define-key m [remap yank] (lambda (&optional arg) (interactive "P") (yank arg)))
1183 (define-key m "\C-c\C-c" 'ggtags-view-search-history-update)
1184 (define-key m "r" 'ggtags-save-to-register)
1185 (define-key m "\r" 'ggtags-view-search-history-action)
1186 (define-key m "q" 'ggtags-kill-window)
1189 (defun ggtags-view-search-history-remember ()
1190 (setq ggtags-view-search-history-last
1191 (pcase (ewoc-locate ggtags-global-search-ewoc)
1193 (node (ewoc-data node)))))
1195 (defun ggtags-view-search-history-next (&optional arg)
1197 (let ((arg (or arg 1)))
1198 (prog1 (funcall (if (cl-minusp arg) #'ewoc-goto-prev #'ewoc-goto-next)
1199 ggtags-global-search-ewoc (abs arg))
1200 (ggtags-view-search-history-remember))))
1202 (defun ggtags-view-search-history-prev (&optional arg)
1204 (ggtags-view-search-history-next (- (or arg 1))))
1206 (defun ggtags-view-search-history-kill (&optional append)
1208 (let* ((node (or (ewoc-locate ggtags-global-search-ewoc)
1209 (user-error "No node at point")))
1210 (next (ewoc-next ggtags-global-search-ewoc node))
1211 (text (filter-buffer-substring (ewoc-location node)
1212 (if next (ewoc-location next)
1215 0 (length text) 'yank-handler
1217 (if (not ggtags-global-search-ewoc)
1219 (let* ((inhibit-read-only t)
1220 (node (unless (looking-at-p "[ \t\n]*\\'")
1221 (ewoc-locate ggtags-global-search-ewoc))))
1223 (ewoc-enter-before ggtags-global-search-ewoc
1225 (ewoc-enter-last ggtags-global-search-ewoc (cadr arg)))
1226 (setq ggtags-view-search-history-last (cadr arg)))))
1227 (list text (ewoc-data node)))
1229 (if append (kill-append text nil)
1231 (let ((inhibit-read-only t))
1232 (ewoc-delete ggtags-global-search-ewoc node))))
1234 (defun ggtags-view-search-history-update (&optional noconfirm)
1235 "Update `ggtags-global-search-history' to current buffer."
1237 (when (and (buffer-modified-p)
1239 (yes-or-no-p "Modify `ggtags-global-search-history'?")))
1240 (setq ggtags-global-search-history
1241 (ewoc-collect ggtags-global-search-ewoc #'identity))
1242 (set-buffer-modified-p nil)))
1244 (defun ggtags-view-search-history-action ()
1246 (let ((data (ewoc-data (or (ewoc-locate ggtags-global-search-ewoc)
1247 (user-error "No search at point")))))
1248 (ggtags-view-search-history-remember)
1250 (ggtags-global-rerun-search (cdr data))))
1252 (defvar bookmark-make-record-function)
1254 (define-derived-mode ggtags-view-search-history-mode special-mode "SearchHist"
1255 "Major mode for viewing search history."
1257 (setq-local ggtags-enable-navigation-keys nil)
1258 (setq-local bookmark-make-record-function #'ggtags-make-bookmark-record)
1259 (setq truncate-lines t)
1260 (add-hook 'kill-buffer-hook #'ggtags-view-search-history-update nil t))
1262 (defun ggtags-view-search-history-restore-last ()
1263 (when ggtags-view-search-history-last
1264 (cl-loop for n = (ewoc-nth ggtags-global-search-ewoc 0)
1265 then (ewoc-next ggtags-global-search-ewoc n)
1266 while n when (eq (ewoc-data n)
1267 ggtags-view-search-history-last)
1268 do (progn (goto-char (ewoc-location n)) (cl-return t)))))
1270 (defun ggtags-view-search-history ()
1271 "Pop to a buffer to view or re-run past searches.
1273 \\{ggtags-view-search-history-mode-map}"
1275 (or ggtags-global-search-history (user-error "No search history"))
1276 (let ((split-window-preferred-function ggtags-split-window-function)
1277 (inhibit-read-only t))
1278 (pop-to-buffer "*Ggtags Search History*")
1280 (ggtags-view-search-history-mode)
1281 (cl-labels ((prop (s)
1282 (propertize s 'face 'minibuffer-prompt))
1289 (put-text-property (point) (point-max)
1290 'face font-lock-constant-face)
1294 (`(,_id ,cmd ,dir ,_env ,line ,text)
1295 (insert (prop " cmd: ") (prop-tag cmd) "\n"
1296 (prop " dir: ") dir "\n"
1297 (prop "line: ") (number-to-string line) "\n"
1298 (prop "text: ") text "\n"
1299 (propertize (make-string 32 ?-) 'face 'shadow))))))
1300 (setq ggtags-global-search-ewoc
1301 (ewoc-create #'pp "Global search history keys: n:next p:prev r:register RET:choose\n")))
1302 (dolist (data ggtags-global-search-history)
1303 (ewoc-enter-last ggtags-global-search-ewoc data))
1304 (ggtags-view-search-history-restore-last)
1305 (set-buffer-modified-p nil)
1306 (fit-window-to-buffer nil (floor (frame-height) 2))))
1308 (defun ggtags-save-to-register (r)
1309 "Save current search session to register R.
1310 Use \\[jump-to-register] to restore the search session."
1311 (interactive (list (register-read-with-preview "Save search to register: ")))
1312 (cl-labels ((prn (data)
1314 (`(,command ,root ,_env ,line ,_)
1315 (princ (format "a ggtags search session `%s' in directory `%s' at line %d."
1316 command root line))))))
1317 (set-register r (registerv-make
1318 (if ggtags-global-search-ewoc
1319 (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
1320 (ggtags-global-current-search))
1321 :jump-func #'ggtags-global-rerun-search
1322 :print-func #'prn))))
1324 (defun ggtags-make-bookmark-record ()
1325 `(,(and ggtags-current-tag-name (format "*ggtags %s*" ggtags-current-tag-name))
1326 (ggtags-search . ,(if ggtags-global-search-ewoc
1327 (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
1328 (ggtags-global-current-search)))
1329 (handler . ggtags-bookmark-jump)))
1331 (declare-function bookmark-prop-get "bookmark")
1333 (defun ggtags-bookmark-jump (bmk)
1334 (ggtags-global-rerun-search (bookmark-prop-get bmk 'ggtags-search)))
1336 (defun ggtags-browse-file-as-hypertext (file line)
1337 "Browse FILE in hypertext (HTML) form."
1338 (interactive (if (or current-prefix-arg (not buffer-file-name))
1339 (list (read-file-name "Browse file: " nil nil t)
1340 (read-number "Line: " 1))
1341 (list buffer-file-name (line-number-at-pos))))
1342 (cl-check-type line (integer 1))
1343 (or (and file (file-exists-p file)) (error "File `%s' doesn't exist" file))
1344 (ggtags-check-project)
1345 (or (file-exists-p (expand-file-name "HTML" (ggtags-current-project-root)))
1346 (if (yes-or-no-p "No hypertext form exists; run htags? ")
1347 (let ((default-directory (ggtags-current-project-root)))
1348 (ggtags-with-current-project (ggtags-process-string "htags")))
1349 (user-error "Aborted")))
1350 (let ((url (ggtags-process-string "gozilla" "-p" (format "+%d" line)
1351 (file-relative-name file))))
1352 (or (equal (file-name-extension
1353 (url-filename (url-generic-parse-url url))) "html")
1354 (user-error "No hypertext form for `%s'" file))
1355 (when (called-interactively-p 'interactive)
1356 (message "Browsing %s" url))
1359 (defun ggtags-next-mark (&optional arg)
1360 "Move to the next (newer) mark in the tag marker ring."
1362 (and (ring-empty-p find-tag-marker-ring) (user-error "Tag ring empty"))
1363 (setq ggtags-tag-ring-index
1364 ;; Note `ring-minus1' gets newer item.
1365 (funcall (if arg #'ring-plus1 #'ring-minus1)
1366 (or ggtags-tag-ring-index
1368 (ring-insert find-tag-marker-ring (point-marker))
1370 (ring-length find-tag-marker-ring)))
1371 (let ((m (ring-ref find-tag-marker-ring ggtags-tag-ring-index))
1372 (i (- (ring-length find-tag-marker-ring) ggtags-tag-ring-index)))
1373 (ggtags-echo "%d%s marker%s" i (pcase (mod i 10)
1374 ;; ` required for 24.1 and 24.2
1379 (if (marker-buffer m) "" " (dead)"))
1380 (if (not (marker-buffer m))
1382 (switch-to-buffer (marker-buffer m))
1385 (defun ggtags-prev-mark ()
1386 "Move to the previous (older) mark in the tag marker ring."
1388 (ggtags-next-mark 'previous))
1390 (defvar ggtags-view-tag-history-mode-map
1391 (let ((m (make-sparse-keymap)))
1392 (define-key m "\M-n" 'next-error-no-select)
1393 (define-key m "\M-p" 'previous-error-no-select)
1394 (define-key m "q" 'ggtags-kill-window)
1397 (define-derived-mode ggtags-view-tag-history-mode tabulated-list-mode "TagHist"
1398 :abbrev-table nil :group 'ggtags)
1400 (defun ggtags-view-tag-history ()
1401 "Pop to a buffer listing visited locations from newest to oldest.
1402 The buffer is a next error buffer and works with standard
1403 commands `next-error' and `previous-error'.
1405 \\{ggtags-view-tag-history-mode-map}"
1407 (and (ring-empty-p find-tag-marker-ring)
1408 (user-error "Tag ring empty"))
1409 (let ((split-window-preferred-function ggtags-split-window-function)
1410 (inhibit-read-only t))
1411 (pop-to-buffer "*Tag Ring*")
1413 (ggtags-view-tag-history-mode)
1414 (setq next-error-function #'ggtags-view-tag-history-next-error
1415 next-error-last-buffer (current-buffer))
1416 (setq tabulated-list-entries
1417 ;; Use a function so that revert can work properly.
1419 (let ((counter (ring-length find-tag-marker-ring))
1420 (elements (or (ring-elements find-tag-marker-ring)
1421 (user-error "Tag ring empty")))
1422 (action (lambda (_button) (next-error 0)))
1423 (get-line (lambda (m)
1424 (with-current-buffer (marker-buffer m)
1427 (buffer-substring (line-beginning-position)
1428 (line-end-position)))))))
1429 (setq tabulated-list-format
1430 `[("ID" ,(max (1+ (floor (log counter 10))) 2)
1432 ("Buffer" ,(max (cl-loop for m in elements
1433 for b = (marker-buffer m)
1435 (length (and b (buffer-name b))))
1438 ("Position" ,(max (cl-loop for m in elements
1439 for p = (or (marker-position m) 1)
1440 maximize (1+ (floor (log p 10))))
1443 (< (string-to-number (aref (cadr x) 2))
1444 (string-to-number (aref (cadr y) 2))))
1446 ("Contents" 100 t)])
1447 (tabulated-list-init-header)
1451 (if (marker-buffer x)
1452 (vector (number-to-string counter)
1453 `(,(buffer-name (marker-buffer x))
1458 (number-to-string (marker-position x))
1459 (funcall get-line x))
1460 (vector (number-to-string counter)
1464 (setq tabulated-list-sort-key '("ID" . t))
1465 (tabulated-list-print)
1466 (fit-window-to-buffer nil (floor (frame-height) 2))))
1468 (defun ggtags-view-tag-history-next-error (&optional arg reset)
1470 (forward-button arg)
1471 (goto-char (point-min))
1472 (forward-button (if (button-at (point)) 0 1)))
1473 (when (get-buffer-window)
1474 (set-window-point (get-buffer-window) (point)))
1475 (pcase (button-get (button-at (point)) 'marker)
1476 ((and (pred markerp) m)
1477 (if (eq (get-buffer-window) (selected-window))
1478 (pop-to-buffer (marker-buffer m))
1479 (switch-to-buffer (marker-buffer m)))
1480 (goto-char (marker-position m)))
1481 (_ (error "Dead marker"))))
1483 (defun ggtags-global-exit-message-1 ()
1484 "Get the total of matches and db file used."
1486 (goto-char (point-max))
1487 (if (re-search-backward
1488 "^\\w+ \\(not found\\)\\|^\\([0-9]+\\) \\w+ located" nil t)
1489 (cons (or (and (match-string 1) 0)
1490 (string-to-number (match-string 2)))
1491 (when (re-search-forward
1492 "using \\(?:\\(idutils\\)\\|'[^']*/\\(\\w+\\)'\\)"
1495 (or (and (match-string 1) "ID")
1499 (defun ggtags-global-exit-message-function (_process-status exit-status msg)
1500 "A function for `compilation-exit-message-function'."
1501 (pcase (ggtags-global-exit-message-1)
1503 (setq ggtags-global-exit-info (list exit-status count db))
1504 ;; Clear the start marker in case of zero matches.
1506 (markerp ggtags-global-start-marker)
1507 (not ggtags-global-continuation)
1508 (setq ggtags-global-start-marker nil))
1509 (cons (if (> exit-status 0)
1511 (format "found %d %s" count
1512 (funcall (if (= count 1) #'car #'cadr)
1514 ;; ` required for 24.1 and 24.2
1515 (`"GTAGS" '("definition" "definitions"))
1516 (`"GSYMS" '("symbol" "symbols"))
1517 (`"GRTAGS" '("reference" "references"))
1518 (`"GPATH" '("file" "files"))
1519 (`"ID" '("identifier" "identifiers"))
1520 (_ '("match" "matches"))))))
1523 (defun ggtags-global-column (start)
1524 ;; START is the beginning position of source text.
1525 (let ((mbeg (text-property-any start (line-end-position) 'global-color t)))
1526 (and mbeg (- mbeg start))))
1528 ;;; NOTE: Must not match the 'Global started at Mon Jun 3 10:24:13'
1529 ;;; line or `compilation-auto-jump' will jump there and fail. See
1530 ;;; comments before the 'gnu' entry in
1531 ;;; `compilation-error-regexp-alist-alist'.
1532 (defvar ggtags-global-error-regexp-alist-alist
1534 `((path "^\\(?:[^\"'\n]*/\\)?[^ )\t\n]+$" 0)
1535 ;; ACTIVE_ESCAPE src/dialog.cc 172
1536 (ctags "^\\([^ \t\n]+\\)[ \t]+\\(.*?\\)[ \t]+\\([0-9]+\\)$"
1537 2 3 nil nil 2 (1 font-lock-function-name-face))
1538 ;; ACTIVE_ESCAPE 172 src/dialog.cc #undef ACTIVE_ESCAPE
1539 (ctags-x "^\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(\\(?:[^/\n]*/\\)?[^ \t\n]+\\)"
1540 3 2 (,(lambda () (ggtags-global-column (1+ (match-end 0)))))
1541 nil 3 (1 font-lock-function-name-face))
1542 ;; src/dialog.cc:172:#undef ACTIVE_ESCAPE
1543 (grep "^\\(.+?\\):\\([0-9]+\\):\\(?:$\\|[^0-9\n]\\|[0-9][^0-9\n]\\|[0-9][0-9].\\)"
1544 1 2 (,(lambda () (ggtags-global-column (1+ (match-end 2))))) nil 1)
1545 ;; src/dialog.cc ACTIVE_ESCAPE 172 #undef ACTIVE_ESCAPE
1546 (cscope "^\\(.+?\\)[ \t]+\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\).*\\(?:[^0-9\n]\\|[^0-9\n][0-9]\\|[^:\n][0-9][0-9]\\)$"
1547 1 3 nil nil 1 (2 font-lock-function-name-face)))
1548 compilation-error-regexp-alist-alist))
1550 (defun ggtags-abbreviate-file (start end)
1551 (let ((inhibit-read-only t)
1552 (amount (if (numberp ggtags-global-abbreviate-filename)
1553 (- (- end start) ggtags-global-abbreviate-filename)
1555 (advance-word (lambda ()
1556 "Return the length of the text made invisible."
1557 (let ((wend (min end (progn (forward-word 1) (point))))
1558 (wbeg (max start (progn (backward-word 1) (point)))))
1560 (if (<= (- wend wbeg) 1)
1562 (put-text-property (1+ wbeg) wend 'invisible t)
1563 (1- (- wend wbeg)))))))
1565 (while (and (> amount 0) (> end (point)))
1566 (cl-decf amount (funcall advance-word)))))
1568 (defun ggtags-abbreviate-files (start end)
1570 (let* ((error-re (cdr (assq (car compilation-error-regexp-alist)
1571 ggtags-global-error-regexp-alist-alist)))
1572 (sub (cadr error-re)))
1573 (when (and ggtags-global-abbreviate-filename error-re)
1574 (while (re-search-forward (car error-re) end t)
1575 (when (and (or (not (numberp ggtags-global-abbreviate-filename))
1576 (> (length (match-string sub))
1577 ggtags-global-abbreviate-filename))
1578 ;; Ignore bogus file lines such as:
1579 ;; Global found 2 matches at Thu Jan 31 13:45:19
1580 (get-text-property (match-beginning sub) 'compilation-message))
1581 (ggtags-abbreviate-file (match-beginning sub) (match-end sub)))))))
1583 (defvar-local ggtags-global-output-lines 0)
1585 (defun ggtags-global--display-buffer (&optional buffer desired-point)
1586 (pcase (let ((buffer (or buffer (current-buffer)))
1587 (split-window-preferred-function ggtags-split-window-function))
1588 (and (not (get-buffer-window buffer))
1589 (display-buffer buffer '(nil (allow-no-window . t)))))
1590 ((and (pred windowp) w)
1591 (with-selected-window w
1592 (compilation-set-window-height w)
1593 (and desired-point (goto-char desired-point))))))
1595 (defun ggtags-global-filter ()
1596 "Called from `compilation-filter-hook' (which see)."
1597 (let ((ansi-color-apply-face-function
1598 (lambda (beg end face)
1600 (ansi-color-apply-overlay-face beg end face)
1601 (put-text-property beg end 'global-color t)))))
1602 (ansi-color-apply-on-region compilation-filter-start (point)))
1603 ;; Get rid of line "Using config file '/PATH/TO/.globalrc'." or
1604 ;; "Using default configuration."
1605 (when (re-search-backward
1606 "^ *Using \\(?:config file '.*\\|default configuration.\\)\n"
1607 compilation-filter-start t)
1609 (cl-incf ggtags-global-output-lines
1610 (count-lines compilation-filter-start (point)))
1611 ;; If the number of output lines is small
1612 ;; `ggtags-global-handle-exit' takes care of displaying the buffer.
1613 (when (and (> ggtags-global-output-lines 30) ggtags-navigation-mode)
1614 (ggtags-global--display-buffer nil (or compilation-current-error (point-min))))
1615 (when (and (eq ggtags-auto-jump-to-match 'history)
1616 (numberp ggtags-auto-jump-to-match-target)
1617 (not compilation-current-error)
1618 ;; `ggtags-global-output-lines' is imprecise but use it
1619 ;; as first approximation.
1620 (> (+ 10 ggtags-global-output-lines) ggtags-auto-jump-to-match-target)
1621 (> (line-number-at-pos (point-max))
1622 ggtags-auto-jump-to-match-target))
1623 (ggtags-forward-to-line ggtags-auto-jump-to-match-target)
1624 (setq-local ggtags-auto-jump-to-match-target nil)
1626 ;; Can't call `compile-goto-error' here becuase
1627 ;; `compilation-filter' restores point and as a result commands
1628 ;; dependent on point such as `ggtags-navigation-next-file' and
1629 ;; `ggtags-navigation-previous-file' fail to work.
1630 (run-with-idle-timer 0 nil (lambda (buf pt)
1631 (and (buffer-live-p buf)
1632 (with-current-buffer buf
1633 (ggtags-delay-finish-functions
1634 (let ((compilation-auto-jump-to-first-error t))
1635 (with-display-buffer-no-window
1636 (compilation-auto-jump buf pt)))))))
1637 (current-buffer) (point)))
1638 (make-local-variable 'ggtags-global-large-output)
1639 (when (> ggtags-global-output-lines ggtags-global-large-output)
1640 (cl-incf ggtags-global-large-output 500)
1641 (ggtags-echo "Output %d lines (Type `C-c C-k' to cancel)"
1642 ggtags-global-output-lines)))
1644 (defun ggtags-global-handle-exit (buf how)
1645 "A function for `compilation-finish-functions' (which see)."
1647 (ggtags-global-continuation
1648 (let ((cont (prog1 ggtags-global-continuation
1649 (setq ggtags-global-continuation nil))))
1650 (funcall cont buf how)))
1651 ((string-prefix-p "exited abnormally" how)
1652 ;; If exit abnormally display the buffer for inspection.
1653 (ggtags-global--display-buffer)
1654 (when (save-excursion
1655 (goto-char (point-max))
1658 (format "^global: %s not found.$"
1659 (regexp-opt '("GTAGS" "GRTAGS" "GSYMS" "GPATH"))))
1661 (ggtags-echo "WARNING: Global tag files missing in `%s'"
1662 ggtags-project-root)
1663 (remhash ggtags-project-root ggtags-projects)))
1664 (ggtags-auto-jump-to-match
1665 (if (pcase (compilation-next-single-property-change
1666 (point-min) 'compilation-message)
1667 ((and pt (guard pt))
1668 (compilation-next-single-property-change
1669 (save-excursion (goto-char pt) (end-of-line) (point))
1670 'compilation-message)))
1671 ;; There are multiple matches so pop up the buffer.
1672 (and ggtags-navigation-mode (ggtags-global--display-buffer))
1673 ;; For the `compilation-auto-jump' in idle timer to run.
1674 ;; See also: http://debbugs.gnu.org/13829
1676 (ggtags-navigation-mode -1)
1677 (ggtags-navigation-mode-cleanup buf 0)))))
1679 (defvar ggtags-global-mode-font-lock-keywords
1680 '(("^Global \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
1681 (1 'compilation-error)
1682 (2 'compilation-error nil t))
1683 ("^Global found \\([0-9]+\\)" (1 compilation-info-face))))
1685 (defvar compilation-always-kill) ;new in 24.3
1687 (define-compilation-mode ggtags-global-mode "Global"
1688 "A mode for showing outputs from gnu global."
1689 ;; Note: Place `ggtags-global-output-format' as first element for
1690 ;; `ggtags-abbreviate-files'.
1691 (setq-local compilation-error-regexp-alist (list ggtags-global-output-format))
1692 (when (markerp ggtags-global-start-marker)
1693 (setq ggtags-project-root
1694 (buffer-local-value 'ggtags-project-root
1695 (marker-buffer ggtags-global-start-marker))))
1696 (pcase ggtags-auto-jump-to-match
1697 (`history (make-local-variable 'ggtags-auto-jump-to-match-target)
1698 (setq-local compilation-auto-jump-to-first-error
1699 (not ggtags-auto-jump-to-match-target)))
1700 (`nil (setq-local compilation-auto-jump-to-first-error nil))
1701 (_ (setq-local compilation-auto-jump-to-first-error t)))
1702 (setq-local compilation-scroll-output nil)
1703 ;; See `compilation-move-to-column' for details.
1704 (setq-local compilation-first-column 0)
1705 (setq-local compilation-error-screen-columns nil)
1706 (setq-local compilation-disable-input t)
1707 (setq-local compilation-always-kill t)
1708 (setq-local compilation-error-face 'compilation-info)
1709 (setq-local compilation-exit-message-function
1710 'ggtags-global-exit-message-function)
1711 ;; See: https://github.com/leoliu/ggtags/issues/26
1712 (setq-local find-file-suppress-same-file-warnings t)
1713 (setq-local truncate-lines t)
1714 (jit-lock-register #'ggtags-abbreviate-files)
1715 (add-hook 'compilation-filter-hook 'ggtags-global-filter nil 'local)
1716 (add-hook 'compilation-finish-functions 'ggtags-global-handle-exit nil t)
1717 (setq-local bookmark-make-record-function #'ggtags-make-bookmark-record)
1718 (setq-local ggtags-enable-navigation-keys nil)
1719 (add-hook 'kill-buffer-hook (lambda () (ggtags-navigation-mode -1)) nil t))
1721 ;; NOTE: Need this to avoid putting menu items in
1722 ;; `emulation-mode-map-alists', which creates double entries. See
1723 ;; http://i.imgur.com/VJJTzVc.png
1724 (defvar ggtags-navigation-map
1725 (let ((map (make-sparse-keymap)))
1726 (define-key map "\M-n" 'next-error)
1727 (define-key map "\M-p" 'previous-error)
1728 (define-key map "\M-}" 'ggtags-navigation-next-file)
1729 (define-key map "\M-{" 'ggtags-navigation-previous-file)
1730 (define-key map "\M-=" 'ggtags-navigation-start-file)
1731 (define-key map "\M->" 'ggtags-navigation-last-error)
1732 (define-key map "\M-<" 'first-error)
1733 ;; Note: shadows `isearch-forward-regexp' but it can still be
1734 ;; invoked with `C-u C-s'.
1735 (define-key map "\C-\M-s" 'ggtags-navigation-isearch-forward)
1736 ;; Add an alternative binding because C-M-s is reported not
1737 ;; working on some systems.
1738 (define-key map "\M-ss" 'ggtags-navigation-isearch-forward)
1739 (define-key map "\C-c\C-k"
1740 (lambda () (interactive)
1741 (ggtags-ensure-global-buffer (kill-compilation))))
1742 (define-key map "\M-o" 'ggtags-navigation-visible-mode)
1743 (define-key map [return] 'ggtags-navigation-mode-done)
1744 (define-key map "\r" 'ggtags-navigation-mode-done)
1745 (define-key map [remap pop-tag-mark] 'ggtags-navigation-mode-abort)
1748 (defvar ggtags-mode-map-alist
1749 `((ggtags-enable-navigation-keys . ,ggtags-navigation-map)))
1751 (defvar ggtags-navigation-mode-map
1752 (let ((map (make-sparse-keymap))
1753 (menu (make-sparse-keymap "GG-Navigation")))
1754 ;; Menu items: (info "(elisp)Extended Menu Items")
1755 (define-key map [menu-bar ggtags-navigation] (cons "GG-Navigation" menu))
1756 ;; Ordered backwards
1757 (define-key menu [visible-mode]
1758 '(menu-item "Visible mode" ggtags-navigation-visible-mode
1759 :button (:toggle . (ignore-errors
1760 (ggtags-ensure-global-buffer
1762 (define-key menu [done]
1763 '(menu-item "Finish navigation" ggtags-navigation-mode-done))
1764 (define-key menu [abort]
1765 '(menu-item "Abort" ggtags-navigation-mode-abort))
1766 (define-key menu [last-match]
1767 '(menu-item "Last match" ggtags-navigation-last-error))
1768 (define-key menu [first-match] '(menu-item "First match" first-error))
1769 (define-key menu [previous-file]
1770 '(menu-item "Previous file" ggtags-navigation-previous-file))
1771 (define-key menu [next-file]
1772 '(menu-item "Next file" ggtags-navigation-next-file))
1773 (define-key menu [isearch-forward]
1774 '(menu-item "Find match with isearch" ggtags-navigation-isearch-forward))
1775 (define-key menu [previous]
1776 '(menu-item "Previous match" previous-error))
1777 (define-key menu [next]
1778 '(menu-item "Next match" next-error))
1781 (defun ggtags-move-to-tag (&optional name)
1782 "Move to NAME tag in current line."
1783 (let ((tag (or name ggtags-current-tag-name)))
1784 ;; Do nothing if on the tag already i.e. by `ggtags-global-column'.
1785 (unless (or (not tag) (looking-at (concat (regexp-quote tag) "\\_>")))
1786 (let ((orig (point))
1787 (regexps (mapcar (lambda (fmtstr)
1788 (format fmtstr (regexp-quote tag)))
1789 '("\\_<%s\\_>" "%s\\_>" "%s"))))
1791 (if (cl-loop for re in regexps
1792 ;; Note: tag might not agree with current
1793 ;; major-mode's symbol, so try harder. For
1794 ;; example, in `php-mode' $cacheBackend is a
1795 ;; symbol, but cacheBackend is a tag.
1796 thereis (re-search-forward re (line-end-position) t))
1797 (goto-char (match-beginning 0))
1798 (goto-char orig))))))
1800 (defun ggtags-navigation-mode-cleanup (&optional buf time)
1801 (let ((buf (or buf ggtags-global-last-buffer)))
1802 (and (buffer-live-p buf)
1803 (with-current-buffer buf
1804 (when (get-buffer-process (current-buffer))
1806 (when (and (derived-mode-p 'ggtags-global-mode)
1807 (get-buffer-window))
1808 (quit-windows-on (current-buffer)))
1809 (and time (run-with-idle-timer time nil #'kill-buffer buf))))))
1811 (defun ggtags-navigation-mode-done ()
1813 (ggtags-navigation-mode -1)
1814 (setq tags-loop-scan t
1815 tags-loop-operate '(ggtags-find-tag-continue))
1816 (ggtags-navigation-mode-cleanup))
1818 (defun ggtags-navigation-mode-abort ()
1819 "Abort navigation and return to where the search was started."
1821 (ggtags-navigation-mode -1)
1822 (ggtags-navigation-mode-cleanup nil 0)
1823 ;; Run after (ggtags-navigation-mode -1) or
1824 ;; ggtags-global-start-marker might not have been saved.
1825 (when (and ggtags-global-start-marker
1826 (not (markerp ggtags-global-start-marker)))
1827 (setq ggtags-global-start-marker nil)
1830 (defun ggtags-navigation-next-file (n)
1832 (ggtags-ensure-global-buffer
1833 (compilation-next-file n)
1834 (compile-goto-error)))
1836 (defun ggtags-navigation-previous-file (n)
1838 (ggtags-navigation-next-file (- n)))
1840 (defun ggtags-navigation-start-file ()
1841 "Move to the file where navigation session starts."
1843 (let ((start-file (or ggtags-global-start-file
1844 (user-error "Cannot decide start file"))))
1845 (ggtags-ensure-global-buffer
1846 (pcase (cl-block nil
1847 (ggtags-foreach-file
1849 (when (file-equal-p file start-file)
1850 (cl-return (point))))))
1851 (`nil (user-error "No matches for `%s'" start-file))
1852 (n (goto-char n) (compile-goto-error))))))
1854 (defun ggtags-navigation-last-error ()
1856 (ggtags-ensure-global-buffer
1857 (goto-char (point-max))
1858 (compilation-previous-error 1)
1859 (compile-goto-error)))
1861 (defun ggtags-navigation-isearch-forward (&optional regexp-p)
1863 (ggtags-ensure-global-buffer
1864 (let ((saved (if visible-mode 1 -1)))
1866 (with-selected-window (get-buffer-window (current-buffer))
1867 (isearch-forward regexp-p)
1869 (visible-mode saved)
1870 (compile-goto-error)))))
1872 (defun ggtags-navigation-visible-mode (&optional arg)
1873 (interactive (list (or current-prefix-arg 'toggle)))
1874 (ggtags-ensure-global-buffer
1875 (visible-mode arg)))
1877 (defvar ggtags-global-line-overlay nil)
1879 (defun ggtags-global-next-error-function ()
1880 (when (eq next-error-last-buffer ggtags-global-last-buffer)
1881 (ggtags-move-to-tag)
1882 (ggtags-global-save-start-marker)
1883 (and (ggtags-project-update-mtime-maybe)
1884 (message "File `%s' is newer than GTAGS"
1885 (file-name-nondirectory buffer-file-name)))
1886 (and ggtags-mode-sticky (ggtags-mode 1))
1888 (ggtags-ensure-global-buffer
1889 (unless (overlayp ggtags-global-line-overlay)
1890 (setq ggtags-global-line-overlay (make-overlay (point) (point)))
1891 (overlay-put ggtags-global-line-overlay 'face 'ggtags-global-line))
1892 (move-overlay ggtags-global-line-overlay
1893 (line-beginning-position) (line-end-position)
1895 ;; Update search history
1896 (let ((id (ggtags-global-search-id (car compilation-arguments)
1897 default-directory)))
1898 (setq ggtags-global-search-history
1899 (cl-remove id ggtags-global-search-history :test #'equal :key #'car))
1900 (add-to-history 'ggtags-global-search-history
1901 (cons id (ggtags-global-current-search))
1902 ggtags-global-history-length))))
1903 (run-hooks 'ggtags-find-tag-hook)))
1905 (put 'ggtags-navigation-mode-lighter 'risky-local-variable t)
1907 (defvar ggtags-navigation-mode-lighter
1910 (if (not (buffer-live-p ggtags-global-last-buffer))
1911 '(:propertize "??" face error help-echo "No Global buffer")
1912 (with-current-buffer ggtags-global-last-buffer
1913 (pcase (or ggtags-global-exit-info '(0 0 ""))
1914 (`(,exit ,count ,db)
1915 `((:propertize ,(pcase db
1923 ,(pcase (get-text-property (line-beginning-position)
1924 'compilation-message)
1926 ;; Assume the first match appears at line 5
1927 (_ (number-to-string (- (line-number-at-pos) 4))))
1930 (:propertize ,(number-to-string count) face success)
1931 ,(unless (zerop exit)
1932 `(":" (:propertize ,(number-to-string exit) face error)))))))))
1934 "Ligher for `ggtags-navigation-mode'; set to nil to disable it.")
1936 (define-minor-mode ggtags-navigation-mode nil
1937 :lighter ggtags-navigation-mode-lighter
1939 (if ggtags-navigation-mode
1941 ;; Higher priority for `ggtags-navigation-mode' to avoid being
1942 ;; hijacked by modes such as `view-mode'.
1943 (add-to-list 'emulation-mode-map-alists 'ggtags-mode-map-alist)
1944 (add-hook 'next-error-hook 'ggtags-global-next-error-function)
1945 (add-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function))
1946 (setq emulation-mode-map-alists
1947 (delq 'ggtags-mode-map-alist emulation-mode-map-alists))
1948 (remove-hook 'next-error-hook 'ggtags-global-next-error-function)
1949 (remove-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function)))
1951 (defun ggtags-minibuffer-setup-function ()
1952 ;; Disable ggtags-navigation-mode in minibuffer.
1953 (setq-local ggtags-enable-navigation-keys nil))
1955 (defun ggtags-kill-file-buffers (&optional interactive)
1956 "Kill all buffers visiting files in current project."
1958 (ggtags-check-project)
1959 (let ((directories (cons (ggtags-current-project-root) (ggtags-get-libpath)))
1961 (dolist (buf (buffer-list))
1962 (let ((file (and (buffer-live-p buf)
1963 (not (eq buf (current-buffer)))
1964 (buffer-file-name buf))))
1965 (when (and file (cl-some (lambda (dir)
1966 ;; Don't use `file-in-directory-p'
1967 ;; to allow symbolic links.
1968 (string-prefix-p dir file))
1970 (and (kill-buffer buf) (cl-incf count)))))
1972 (message "%d %s killed" count (if (= count 1) "buffer" "buffers")))))
1974 (defun ggtags-after-save-function ()
1975 (when (ggtags-find-project)
1976 (ggtags-project-update-mtime-maybe)
1977 (and buffer-file-name ggtags-update-on-save
1978 (ggtags-update-tags-single buffer-file-name 'nowait))))
1980 (defun ggtags-global-output (buffer cmds callback &optional cutoff)
1981 "Asynchronously pipe the output of running CMDS to BUFFER.
1982 When finished invoke CALLBACK in BUFFER with process exit status."
1983 (or buffer (error "Output buffer required"))
1984 (when (get-buffer-process (get-buffer buffer))
1985 ;; Notice running multiple processes in the same buffer so that we
1986 ;; can fix the caller. See for example `ggtags-eldoc-function'.
1987 (message "Warning: detected %S already running in %S; interrupting..."
1988 (get-buffer-process buffer) buffer)
1989 (interrupt-process (get-buffer-process buffer)))
1990 (let* ((program (car cmds))
1992 (cutoff (and cutoff (+ cutoff (if (get-buffer buffer)
1993 (with-current-buffer buffer
1994 (line-number-at-pos (point-max)))
1996 (proc (apply #'start-file-process program buffer program args))
1997 (filter (lambda (proc string)
1998 (and (buffer-live-p (process-buffer proc))
1999 (with-current-buffer (process-buffer proc)
2000 (goto-char (process-mark proc))
2002 (when (and (> (line-number-at-pos (point-max)) cutoff)
2003 (process-live-p proc))
2004 (interrupt-process (current-buffer)))))))
2005 (sentinel (lambda (proc _msg)
2006 (when (memq (process-status proc) '(exit signal))
2007 (with-current-buffer (process-buffer proc)
2008 (set-process-buffer proc nil)
2009 (funcall callback (process-exit-status proc)))))))
2010 (set-process-query-on-exit-flag proc nil)
2011 (and cutoff (set-process-filter proc filter))
2012 (set-process-sentinel proc sentinel)
2015 (cl-defun ggtags-fontify-code (code &optional (mode major-mode))
2016 (cl-check-type mode function)
2019 (string (cl-labels ((prepare-buffer ()
2020 (with-current-buffer
2021 (get-buffer-create " *Code-Fontify*")
2022 (delay-mode-hooks (funcall mode))
2023 (setq font-lock-mode t)
2024 (funcall font-lock-function font-lock-mode)
2026 (with-current-buffer (prepare-buffer)
2027 (let ((inhibit-read-only t))
2030 (font-lock-default-fontify-region
2031 (point-min) (point-max) nil))
2032 (buffer-string))))))
2034 (defun ggtags-get-definition-default (defs)
2036 (concat (ggtags-fontify-code (caar defs))
2037 (and (cdr defs) " [guess]"))))
2039 (defun ggtags-show-definition (name)
2040 (interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
2041 (ggtags-check-project)
2042 (let* ((re (cadr (assq 'grep ggtags-global-error-regexp-alist-alist)))
2043 (current (current-buffer))
2044 (buffer (get-buffer-create " *ggtags-definition*"))
2045 ;; Need these bindings so that let-binding
2046 ;; `ggtags-print-definition-function' can work see
2047 ;; `ggtags-eldoc-function'.
2048 (get-fn ggtags-get-definition-function)
2049 (print-fn ggtags-print-definition-function)
2050 (show (lambda (_status)
2051 (goto-char (point-min))
2052 (let ((defs (cl-loop while (re-search-forward re nil t)
2053 collect (list (buffer-substring (1+ (match-end 2))
2054 (line-end-position))
2057 (string-to-number (match-string 2))))))
2058 (kill-buffer buffer)
2059 (with-current-buffer current
2060 (funcall print-fn (funcall get-fn defs)))))))
2061 (ggtags-with-current-project
2062 (ggtags-global-output
2064 (list (ggtags-program-path "global")
2065 "--result=grep" "--path-style=absolute" name)
2068 (defvar ggtags-mode-prefix-map
2069 (let ((m (make-sparse-keymap)))
2070 ;; Globally bound to `M-g p'.
2071 ;; (define-key m "\M-'" 'previous-error)
2072 (define-key m (kbd "M-DEL") 'ggtags-delete-tags)
2073 (define-key m "\M-p" 'ggtags-prev-mark)
2074 (define-key m "\M-n" 'ggtags-next-mark)
2075 (define-key m "\M-f" 'ggtags-find-file)
2076 (define-key m "\M-o" 'ggtags-find-other-symbol)
2077 (define-key m "\M-g" 'ggtags-grep)
2078 (define-key m "\M-i" 'ggtags-idutils-query)
2079 (define-key m "\M-b" 'ggtags-browse-file-as-hypertext)
2080 (define-key m "\M-k" 'ggtags-kill-file-buffers)
2081 (define-key m "\M-h" 'ggtags-view-tag-history)
2082 (define-key m "\M-j" 'ggtags-visit-project-root)
2083 (define-key m "\M-/" 'ggtags-view-search-history)
2084 (define-key m (kbd "M-SPC") 'ggtags-save-to-register)
2085 (define-key m (kbd "M-%") 'ggtags-query-replace)
2086 (define-key m "\M-?" 'ggtags-show-definition)
2089 (defvar ggtags-mode-map
2090 (let ((map (make-sparse-keymap))
2091 (menu (make-sparse-keymap "Ggtags")))
2092 (define-key map "\M-." 'ggtags-find-tag-dwim)
2093 (define-key map (kbd "M-]") 'ggtags-find-reference)
2094 (define-key map (kbd "C-M-.") 'ggtags-find-tag-regexp)
2095 (define-key map ggtags-mode-prefix-key ggtags-mode-prefix-map)
2097 (define-key map [menu-bar ggtags] (cons "Ggtags" menu))
2098 ;; Ordered backwards
2099 (define-key menu [report-bugs]
2100 `(menu-item "Report bugs"
2101 (lambda () (interactive)
2102 (browse-url ggtags-bug-url)
2103 (message "Please visit %s" ggtags-bug-url))
2104 :help ,(format "Visit %s" ggtags-bug-url)))
2105 (define-key menu [custom-ggtags]
2106 '(menu-item "Customize Ggtags"
2107 (lambda () (interactive) (customize-group 'ggtags))))
2108 (define-key menu [eldoc-mode]
2109 '(menu-item "Toggle eldoc mode" eldoc-mode :button (:toggle . eldoc-mode)))
2110 (define-key menu [save-project]
2111 '(menu-item "Save project settings" ggtags-save-project-settings))
2112 (define-key menu [toggle-read-only]
2113 '(menu-item "Toggle project read-only" ggtags-toggle-project-read-only
2114 :button (:toggle . buffer-read-only)))
2115 (define-key menu [visit-project-root]
2116 '(menu-item "Visit project root" ggtags-visit-project-root))
2117 (define-key menu [sep2] menu-bar-separator)
2118 (define-key menu [browse-hypertext]
2119 '(menu-item "Browse as hypertext" ggtags-browse-file-as-hypertext
2120 :enable (ggtags-find-project)))
2121 (define-key menu [delete-tags]
2122 '(menu-item "Delete tags" ggtags-delete-tags
2123 :enable (ggtags-find-project)
2124 :help "Delete file GTAGS, GRTAGS, GPATH, ID etc."))
2125 (define-key menu [kill-buffers]
2126 '(menu-item "Kill project file buffers" ggtags-kill-file-buffers
2127 :enable (ggtags-find-project)))
2128 (define-key menu [view-tag]
2129 '(menu-item "View tag history" ggtags-view-tag-history))
2130 (define-key menu [pop-mark]
2131 '(menu-item "Pop mark" pop-tag-mark
2132 :help "Pop to previous mark and destroy it"))
2133 (define-key menu [next-mark]
2134 '(menu-item "Next mark" ggtags-next-mark))
2135 (define-key menu [prev-mark]
2136 '(menu-item "Previous mark" ggtags-prev-mark))
2137 (define-key menu [sep1] menu-bar-separator)
2138 (define-key menu [previous-error]
2139 '(menu-item "Previous match" previous-error))
2140 (define-key menu [next-error]
2141 '(menu-item "Next match" next-error))
2142 (define-key menu [rerun-search]
2143 '(menu-item "View past searches" ggtags-view-search-history))
2144 (define-key menu [save-to-register]
2145 '(menu-item "Save search to register" ggtags-save-to-register))
2146 (define-key menu [find-file]
2147 '(menu-item "Find files" ggtags-find-file))
2148 (define-key menu [query-replace]
2149 '(menu-item "Query replace" ggtags-query-replace))
2150 (define-key menu [idutils]
2151 '(menu-item "Query idutils DB" ggtags-idutils-query))
2152 (define-key menu [grep]
2153 '(menu-item "Grep" ggtags-grep))
2154 (define-key menu [find-symbol]
2155 '(menu-item "Find other symbol" ggtags-find-other-symbol
2156 :help "Find references without definition"))
2157 (define-key menu [find-tag-regexp]
2158 '(menu-item "Find tag matching regexp" ggtags-find-tag-regexp))
2159 (define-key menu [show-definition]
2160 '(menu-item "Show definition" ggtags-show-definition))
2161 (define-key menu [find-reference]
2162 '(menu-item "Find reference" ggtags-find-reference))
2163 (define-key menu [find-tag-continue]
2164 '(menu-item "Continue find tag" tags-loop-continue))
2165 (define-key menu [find-tag]
2166 '(menu-item "Find tag" ggtags-find-tag-dwim))
2167 (define-key menu [update-tags]
2168 '(menu-item "Update tag files" ggtags-update-tags
2169 :visible (ggtags-find-project)))
2170 (define-key menu [run-gtags]
2171 '(menu-item "Run gtags" ggtags-create-tags
2172 :visible (not (ggtags-find-project))))
2175 (defvar ggtags-mode-line-project-keymap
2176 (let ((map (make-sparse-keymap)))
2177 (define-key map [mode-line mouse-1] 'ggtags-visit-project-root)
2180 (put 'ggtags-mode-line-project-name 'risky-local-variable t)
2181 (defvar ggtags-mode-line-project-name
2182 '("[" (:eval (let ((name (if (stringp ggtags-project-root)
2183 (file-name-nondirectory
2184 (directory-file-name ggtags-project-root))
2187 name 'face compilation-info-face
2188 'help-echo (if (stringp ggtags-project-root)
2189 (concat "mouse-1 to visit " ggtags-project-root)
2190 "mouse-1 to set project")
2191 'mouse-face 'mode-line-highlight
2192 'keymap ggtags-mode-line-project-keymap)))
2194 "Mode line construct for displaying current project name.
2195 The value is the name of the project root directory. Setting it
2196 to nil disables displaying this information.")
2199 (define-minor-mode ggtags-mode nil
2200 :lighter (:eval (if ggtags-navigation-mode "" " GG"))
2201 (unless (timerp ggtags-highlight-tag-timer)
2202 (setq ggtags-highlight-tag-timer
2203 (run-with-idle-timer
2204 ggtags-highlight-tag-delay t #'ggtags-highlight-tag-at-point)))
2207 (add-hook 'after-save-hook 'ggtags-after-save-function nil t)
2208 ;; Append to serve as a fallback method.
2209 (add-hook 'completion-at-point-functions
2210 #'ggtags-completion-at-point t t)
2211 ;; Work around http://debbugs.gnu.org/19324
2212 (or eldoc-documentation-function
2213 (setq-local eldoc-documentation-function #'ignore))
2214 (add-function :after-until (local 'eldoc-documentation-function)
2215 #'ggtags-eldoc-function '((name . ggtags-eldoc-function)
2217 (unless (memq 'ggtags-mode-line-project-name
2218 mode-line-buffer-identification)
2219 (setq mode-line-buffer-identification
2220 (append mode-line-buffer-identification
2221 '(ggtags-mode-line-project-name)))))
2222 (remove-hook 'after-save-hook 'ggtags-after-save-function t)
2223 (remove-hook 'completion-at-point-functions #'ggtags-completion-at-point t)
2224 (remove-function (local 'eldoc-documentation-function) 'ggtags-eldoc-function)
2225 (setq mode-line-buffer-identification
2226 (delq 'ggtags-mode-line-project-name mode-line-buffer-identification))
2227 (and (overlayp ggtags-highlight-tag-overlay)
2228 (delete-overlay ggtags-highlight-tag-overlay))
2229 (setq ggtags-highlight-tag-overlay nil)))
2231 (defvar ggtags-highlight-tag-map
2232 (let ((map (make-sparse-keymap)))
2233 ;; Bind down- events so that the global keymap won't ``shine
2234 ;; through''. See `mode-line-buffer-identification-keymap' for
2235 ;; similar workaround.
2236 (define-key map [S-mouse-1] 'ggtags-find-tag-dwim)
2237 (define-key map [S-down-mouse-1] 'ignore)
2238 (define-key map [S-mouse-3] 'ggtags-find-reference)
2239 (define-key map [S-down-mouse-3] 'ignore)
2241 "Keymap used for valid tag at point.")
2243 (put 'ggtags-active-tag 'face 'ggtags-highlight)
2244 (put 'ggtags-active-tag 'keymap ggtags-highlight-tag-map)
2245 ;; (put 'ggtags-active-tag 'mouse-face 'match)
2246 (put 'ggtags-active-tag 'help-echo
2247 "S-mouse-1 for definitions\nS-mouse-3 for references")
2249 (defun ggtags-highlight-tag-at-point ()
2250 (when (and ggtags-mode ggtags-project-root (ggtags-find-project))
2251 (unless (overlayp ggtags-highlight-tag-overlay)
2252 (setq ggtags-highlight-tag-overlay (make-overlay (point) (point) nil t))
2253 (overlay-put ggtags-highlight-tag-overlay 'modification-hooks
2254 (list (lambda (o after &rest _args)
2255 (and (not after) (delete-overlay o))))))
2256 (let ((bounds (funcall ggtags-bounds-of-tag-function))
2257 (o ggtags-highlight-tag-overlay))
2260 (eq (overlay-buffer o) (current-buffer))
2261 (= (overlay-start o) (car bounds))
2262 (= (overlay-end o) (cdr bounds)))
2263 ;; Overlay matches current tag so do nothing.
2265 ((and bounds (let ((completion-ignore-case nil))
2267 (buffer-substring (car bounds) (cdr bounds))
2268 ggtags-completion-table)))
2269 (move-overlay o (car bounds) (cdr bounds) (current-buffer))
2270 (overlay-put o 'category 'ggtags-active-tag))
2272 (or (car bounds) (point))
2273 (or (cdr bounds) (point))
2275 (overlay-put o 'category nil))))))
2279 (defvar-local ggtags-eldoc-cache nil)
2281 (declare-function eldoc-message "eldoc")
2282 (defun ggtags-eldoc-function ()
2283 "A function suitable for `eldoc-documentation-function' (which see)."
2284 (pcase (ggtags-tag-at-point)
2286 (tag (if (equal tag (car ggtags-eldoc-cache))
2287 (cadr ggtags-eldoc-cache)
2288 (and ggtags-project-root (ggtags-find-project)
2289 (let* ((ggtags-print-definition-function
2291 (setq ggtags-eldoc-cache (list tag s))
2292 (eldoc-message s))))
2293 ;; Prevent multiple runs of ggtags-show-definition
2294 ;; for the same tag.
2295 (setq ggtags-eldoc-cache (list tag))
2297 (ggtags-show-definition tag)
2299 (remove-function (local 'eldoc-documentation-function)
2300 'ggtags-eldoc-function)
2302 Function `ggtags-eldoc-function' disabled for eldoc in current buffer: %S" err)))
2307 (defun ggtags-goto-imenu-index (name line &rest _args)
2308 (ggtags-forward-to-line line)
2309 (ggtags-move-to-tag name))
2312 (defun ggtags-build-imenu-index ()
2313 "A function suitable for `imenu-create-index-function'."
2314 (let ((file (and buffer-file-name (file-relative-name buffer-file-name))))
2315 (and file (with-temp-buffer
2316 (when (with-demoted-errors "ggtags-build-imenu-index: %S"
2317 (zerop (ggtags-with-current-project
2318 (process-file (ggtags-program-path "global")
2319 nil t nil "-x" "-f" file))))
2320 (goto-char (point-min))
2321 (cl-loop while (re-search-forward
2322 "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)" nil t)
2323 collect (list (match-string 1)
2324 (string-to-number (match-string 2))
2325 'ggtags-goto-imenu-index)))))))
2330 (defun ggtags-try-complete-tag (old)
2331 "A function suitable for `hippie-expand-try-functions-list'."
2332 (eval-and-compile (require 'hippie-exp))
2334 (he-init-string (or (car (funcall ggtags-bounds-of-tag-function)) (point))
2336 (setq he-expand-list
2337 (and (not (equal he-search-string ""))
2338 (ggtags-find-project)
2339 (sort (all-completions he-search-string
2340 ggtags-completion-table)
2342 (if (null he-expand-list)
2344 (if old (he-reset-string))
2346 (he-substitute-string (car he-expand-list))
2347 (setq he-expand-list (cdr he-expand-list))
2350 (defun ggtags-reload (&optional force)
2352 (unload-feature 'ggtags force)
2356 ;;; ggtags.el ends here