code.delx.au - gnu-emacs-elpa/blob - ggtags.el

   1 ;;; ggtags.el --- GNU Global source code tagging system  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2013  Free Software Foundation, Inc.
   4
   5 ;; Author: Leo Liu <sdl.web@gmail.com>
   6 ;; Version: 0.7.3
   7 ;; Keywords: tools, convenience
   8 ;; Created: 2013-01-29
   9 ;; URL: https://github.com/leoliu/ggtags
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation, either version 3 of the License, or
  14 ;; (at your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  23
  24 ;;; Commentary:
  25
  26 ;; A package to integrate GNU Global source code tagging system
  27 ;; (http://www.gnu.org/software/global) with Emacs.
  28 ;;
  29 ;; Usage:
  30 ;;
  31 ;; Type `M-x ggtags-mode' to enable the minor mode, or as usual enable
  32 ;; it in your desired major mode hooks. When the mode is on the symbol
  33 ;; at point is underlined if it is a valid (definition) tag.
  34 ;;
  35 ;; `M-.' finds definition or references according to the context at
  36 ;; point, i.e. if point is at a definition tag find references and
  37 ;; vice versa. `M-]' finds references.
  38 ;;
  39 ;; If multiple matches are found, navigation mode is entered, the
  40 ;; mode-line lighter changed, and a navigation menu-bar entry
  41 ;; presented. In this mode, `M-n' and `M-p' moves to next and previous
  42 ;; match, `M-}' and `M-{' to next and previous file respectively.
  43 ;; `M-o' toggles between full and abbreviated displays of file names
  44 ;; in the auxiliary popup window. When you locate the right match,
  45 ;; press RET to finish which hides the auxiliary window and exits
  46 ;; navigation mode. You can continue the search using `M-,'. To abort
  47 ;; the search press `M-*'.
  48 ;;
  49 ;; Normally after a few searches a dozen buffers are created visiting
  50 ;; files tracked by GNU Global. `C-c M-k' helps clean them up.
  51 ;;
  52 ;; Check the menu-bar entry `Ggtags' for other useful commands.
  53
  54 ;;; Code:
  55
  56 (eval-when-compile
  57   (require 'cl)
  58   (require 'url-parse))
  59
  60 (require 'compile)
  61
  62 (eval-when-compile
  63   (unless (fboundp 'setq-local)
  64     (defmacro setq-local (var val)
  65       (list 'set (list 'make-local-variable (list 'quote var)) val)))
  66
  67   (unless (fboundp 'defvar-local)
  68     (defmacro defvar-local (var val &optional docstring)
  69       (declare (debug defvar) (doc-string 3))
  70       (list 'progn (list 'defvar var val docstring)
  71             (list 'make-variable-buffer-local (list 'quote var))))))
  72
  73 (eval-and-compile
  74   (or (fboundp 'user-error)
  75       (defalias 'user-error 'error)))
  76
  77 (defgroup ggtags nil
  78   "GNU Global source code tagging system."
  79   :group 'tools)
  80
  81 (defface ggtags-highlight '((t (:underline t)))
  82   "Face used to highlight a valid tag at point."
  83   :group 'ggtags)
  84
  85 (defface ggtags-global-line '((t (:inherit secondary-selection)))
  86   "Face used to highlight matched line in Global buffer."
  87   :group 'ggtags)
  88
  89 (defcustom ggtags-oversize-limit (* 50 1024 1024)
  90   "The over size limit for the  GTAGS file.
  91 For large source trees, running 'global -u' can be expensive.
  92 Thus when GTAGS file is larger than this limit, ggtags
  93 automatically switches to 'global --single-update'.
  94
  95 Change is effective when a project's information is renewed.
  96 See also `ggtags-project-duration'."
  97   :safe 'numberp
  98   :type '(choice (const :tag "None" nil)
  99                  (const :tag "Always" t)
 100                  number)
 101   :group 'ggtags)
 102
 103 (defcustom ggtags-project-duration 3600
 104   "Seconds to keep information of a project in memory."
 105   :type 'number
 106   :group 'ggtags)
 107
 108 (defcustom ggtags-process-environment nil
 109   "Similar to `process-environment' with higher precedence.
 110 Elements are run through `substitute-env-vars' before use.
 111 GTAGSROOT will always be expanded to current project root
 112 directory. This is intended for project-wise ggtags-specific
 113 process environment settings."
 114   :safe 'ggtags-list-of-string-p
 115   :type '(repeat string)
 116   :group 'ggtags)
 117
 118 (defcustom ggtags-auto-jump-to-first-match t
 119   "Non-nil to automatically jump to the first match."
 120   :type 'boolean
 121   :group 'ggtags)
 122
 123 (defcustom ggtags-global-window-height 8 ; ggtags-global-mode
 124   "Number of lines for the 'global' popup window.
 125 If nil, use Emacs default."
 126   :type '(choice (const :tag "Default" nil) integer)
 127   :group 'ggtags)
 128
 129 (defcustom ggtags-global-abbreviate-filename 35
 130   "Non-nil to display file names abbreviated e.g. \"/u/b/env\".
 131 If an integer abbreviate only names longer than that number."
 132   :type '(choice (const :tag "No" nil)
 133                  (const :tag "Always" t)
 134                  integer)
 135   :group 'ggtags)
 136
 137 (defcustom ggtags-split-window-function split-window-preferred-function
 138   "A function to control how ggtags pops up the auxiliary window."
 139   :type 'function
 140   :group 'ggtags)
 141
 142 (defcustom ggtags-use-idutils (and (executable-find "mkid") t)
 143   "Non-nil to also generate the idutils DB."
 144   :type 'boolean
 145   :group 'ggtags)
 146
 147 (defcustom ggtags-global-output-format 'grep
 148   "The output format for the 'global' command."
 149   :type '(choice (const path)
 150                  (const ctags)
 151                  (const ctags-x)
 152                  (const grep)
 153                  (const cscope))
 154   :group 'ggtags)
 155
 156 (defcustom ggtags-global-ignore-case nil
 157   "Non-nil if Global should ignore case."
 158   :safe 'booleanp
 159   :type 'boolean
 160   :group 'ggtags)
 161
 162 (defcustom ggtags-global-treat-text nil
 163   "Non-nil if Global should include matches from text files."
 164   :safe 'booleanp
 165   :type 'boolean
 166   :group 'ggtags)
 167
 168 (defcustom ggtags-global-large-output 1000
 169   "Number of lines in the Global buffer to indicate large output."
 170   :type 'number
 171   :group 'ggtags)
 172
 173 (defcustom ggtags-mode-prefix-key "\C-c"
 174   "Key binding used for `ggtags-mode-prefix-map'.
 175 Users should change the value using `customize-variable' to
 176 properly update `ggtags-mode-map'."
 177   :set (lambda (sym value)
 178          (when (bound-and-true-p ggtags-mode-map)
 179            (let ((old (and (boundp sym) (symbol-value sym))))
 180              (and old (define-key ggtags-mode-map old nil)))
 181            (and value
 182                 (bound-and-true-p ggtags-mode-prefix-map)
 183                 (define-key ggtags-mode-map value ggtags-mode-prefix-map)))
 184          (set-default sym value))
 185   :type 'key-sequence
 186   :group 'ggtags)
 187
 188 (defcustom ggtags-completing-read-function completing-read-function
 189   "Ggtags specific `completing-read-function' (which see)."
 190   :type 'function
 191   :group 'ggtags)
 192
 193 (defcustom ggtags-highlight-tag-delay 0.25
 194   "Time in seconds before highlighting tag at point."
 195   :set (lambda (sym value)
 196          (when (bound-and-true-p ggtags-highlight-tag-timer)
 197            (timer-set-idle-time ggtags-highlight-tag-timer value t))
 198          (set-default sym value))
 199   :type 'number
 200   :group 'ggtags)
 201
 202 (defcustom ggtags-bounds-of-tag-function (lambda ()
 203                                            (bounds-of-thing-at-point 'symbol))
 204   "Function to get the start and end locations of the tag at point."
 205   :type 'function
 206   :group 'ggtags)
 207
 208 (defvar ggtags-bug-url "https://github.com/leoliu/ggtags/issues")
 209
 210 (defvar ggtags-global-last-buffer nil)
 211
 212 (defvar ggtags-current-tag-name nil)
 213
 214 (defvar ggtags-highlight-tag-overlay nil)
 215
 216 (defvar ggtags-highlight-tag-timer nil)
 217
 218 ;; Used by ggtags-global-mode
 219 (defvar ggtags-global-error "match"
 220   "Stem of message to print when no matches are found.")
 221
 222 ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1518
 223 (defvar ggtags-global-has-path-style    ; introduced in global 6.2.8
 224   (with-demoted-errors                  ; in case `global' not found
 225     (zerop (process-file "global" nil nil nil
 226                          "--path-style" "shorter" "--help")))
 227   "Non-nil if `global' supports --path-style switch.")
 228
 229 ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1542
 230 (defvar ggtags-global-has-color
 231   (with-demoted-errors
 232     (zerop (process-file "global" nil nil nil "--color" "--help"))))
 233
 234 (defmacro ggtags-ensure-global-buffer (&rest body)
 235   (declare (indent 0))
 236   `(progn
 237      (or (and (buffer-live-p ggtags-global-last-buffer)
 238               (with-current-buffer ggtags-global-last-buffer
 239                 (derived-mode-p 'ggtags-global-mode)))
 240          (error "No global buffer found"))
 241      (with-current-buffer ggtags-global-last-buffer ,@body)))
 242
 243 (defmacro ggtags-with-process-environment (&rest body)
 244   (declare (debug t))
 245   `(let ((process-environment
 246           (append (let ((process-environment process-environment))
 247                     (when (ggtags-find-project)
 248                       (setenv "GTAGSROOT" (directory-file-name
 249                                            (ggtags-current-project-root))))
 250                     (mapcar #'substitute-env-vars ggtags-process-environment))
 251                   process-environment
 252                   (and (ggtags-find-project)
 253                        (not (ggtags-project-has-rtags (ggtags-find-project)))
 254                        (list "GTAGSLABEL=ctags")))))
 255      ,@body))
 256
 257 (defun ggtags-list-of-string-p (xs)
 258   "Return non-nil if XS is a list of strings."
 259   (if (null xs)
 260       t
 261     (and (stringp (car xs))
 262          (ggtags-list-of-string-p (cdr xs)))))
 263
 264 (defun ggtags-get-libpath ()
 265   (let ((path (ggtags-with-process-environment (getenv "GTAGSLIBPATH"))))
 266     (and path (split-string path (regexp-quote path-separator) t))))
 267
 268 (defun ggtags-process-string (program &rest args)
 269   (with-temp-buffer
 270     (let ((exit (apply #'process-file program nil t nil args))
 271           (output (progn
 272                     (goto-char (point-max))
 273                     (skip-chars-backward " \t\n")
 274                     (buffer-substring (point-min) (point)))))
 275       (or (zerop exit)
 276           (error "`%s' non-zero exit: %s" program output))
 277       output)))
 278
 279 (defun ggtags-tag-at-point ()
 280   (let ((bounds (funcall ggtags-bounds-of-tag-function)))
 281     (and bounds (buffer-substring (car bounds) (cdr bounds)))))
 282
 283 ;;; Store for project settings
 284
 285 (defvar ggtags-projects (make-hash-table :size 7 :test #'equal))
 286
 287 (defstruct (ggtags-project (:constructor ggtags-project--make)
 288                            (:copier nil)
 289                            (:type vector)
 290                            :named)
 291   root dirty-p has-rtags oversize-p timestamp)
 292
 293 (defun ggtags-make-project (root)
 294   (check-type root string)
 295   (let* ((default-directory (file-name-as-directory root))
 296          (rtags-size (nth 7 (file-attributes "GRTAGS")))
 297          (has-rtags
 298           (when rtags-size
 299             (or (> rtags-size (* 32 1024))
 300                 (with-demoted-errors
 301                   (not (equal "" (ggtags-process-string "global" "-crs")))))))
 302          (oversize-p (pcase ggtags-oversize-limit
 303                        (`nil nil)
 304                        (`t t)
 305                        (t (> (or (nth 7 (file-attributes "GTAGS")) 0)
 306                              ggtags-oversize-limit)))))
 307     (puthash default-directory (ggtags-project--make
 308                                 :root default-directory :has-rtags has-rtags
 309                                 :oversize-p oversize-p :timestamp (float-time))
 310              ggtags-projects)))
 311
 312 (defvar-local ggtags-project 'unset)
 313
 314 (defun ggtags-project-expired-p (project)
 315   (> (- (float-time)
 316         (ggtags-project-timestamp project))
 317      ggtags-project-duration))
 318
 319 ;;;###autoload
 320 (defun ggtags-find-project ()
 321   (if (ggtags-project-p ggtags-project)
 322       (if (not (ggtags-project-expired-p ggtags-project))
 323           ggtags-project
 324         (remhash (ggtags-project-root ggtags-project) ggtags-projects)
 325         (kill-local-variable 'ggtags-project)
 326         (ggtags-find-project))
 327     (let ((root (ignore-errors (file-name-as-directory
 328                                 ;; Resolves symbolic links
 329                                 (ggtags-process-string "global" "-pr")))))
 330       (setq ggtags-project
 331             (and root (or (gethash root ggtags-projects)
 332                           (ggtags-make-project root)))))))
 333
 334 (defun ggtags-current-project-root ()
 335   (and (ggtags-find-project)
 336        (ggtags-project-root (ggtags-find-project))))
 337
 338 (defun ggtags-check-project ()
 339   (or (ggtags-find-project) (error "File GTAGS not found")))
 340
 341 (defun ggtags-save-project-settings (&optional confirm)
 342   "Save Gnu Global's specific environment variables."
 343   (interactive "P")
 344   (ggtags-check-project)
 345   (let* ((default-directory (ggtags-current-project-root))
 346          ;; Not using `ggtags-with-process-environment' to preserve
 347          ;; environment variables that may be present in
 348          ;; `ggtags-process-environment'.
 349          (process-environment
 350           (append ggtags-process-environment
 351                   process-environment
 352                   (and (not (ggtags-project-has-rtags (ggtags-find-project)))
 353                        (list "GTAGSLABEL=ctags"))))
 354          (envlist (loop for x in '("GTAGSROOT"
 355                                    "GTAGSDBPATH"
 356                                    "GTAGSLIBPATH"
 357                                    "GTAGSCONF"
 358                                    "GTAGSLABEL"
 359                                    "MAKEOBJDIRPREFIX"
 360                                    "GTAGSTHROUGH"
 361                                    "GTAGSBLANKENCODE")
 362                         when (getenv x)
 363                         collect (concat x "=" (getenv x)))))
 364     (add-dir-local-variable nil 'ggtags-process-environment envlist)
 365     (unless confirm (save-buffer) (kill-buffer))))
 366
 367 (defun ggtags-ensure-project ()
 368   (interactive)
 369   (or (ggtags-find-project)
 370       (when (or (yes-or-no-p "File GTAGS not found; run gtags? ")
 371                 (user-error "Aborted"))
 372         (let ((root (read-directory-name "Directory: " nil nil t))
 373               (process-environment process-environment))
 374           (and (zerop (length root)) (user-error "No directory chosen"))
 375           (setenv "GTAGSROOT"
 376                   (directory-file-name (file-name-as-directory root)))
 377           (ggtags-with-process-environment
 378            (and (not (getenv "GTAGSLABEL"))
 379                 (yes-or-no-p "Use `ctags' backend? ")
 380                 (setenv "GTAGSLABEL" "ctags"))
 381            (with-temp-message "`gtags' in progress..."
 382              (let ((default-directory (file-name-as-directory root)))
 383                (apply #'ggtags-process-string
 384                       "gtags" (and ggtags-use-idutils '("--idutils"))))))
 385           (message "GTAGS generated in `%s'" root)
 386           (ggtags-find-project)))))
 387
 388 (defun ggtags-update-tags (&optional force)
 389   "Update GNU Global tag database."
 390   (interactive "P")
 391   (when (or force (and (ggtags-find-project)
 392                        (ggtags-project-dirty-p (ggtags-find-project))))
 393     (ggtags-with-process-environment
 394      (with-temp-message "Running `global -u'"
 395        (ggtags-process-string "global" "-u")
 396        (setf (ggtags-project-dirty-p (ggtags-find-project)) nil)))))
 397
 398 (defvar-local ggtags-completion-cache nil)
 399
 400 (defvar ggtags-completion-table
 401   (completion-table-dynamic
 402    (lambda (prefix)
 403      (when (and (ggtags-find-project)
 404                 (not (ggtags-project-oversize-p (ggtags-find-project))))
 405        (ggtags-update-tags))
 406      (unless (equal prefix (car ggtags-completion-cache))
 407        (setq ggtags-completion-cache
 408              (cons prefix
 409                    (ggtags-with-process-environment
 410                     (split-string
 411                      (apply #'ggtags-process-string
 412                             "global"
 413                             ;; Note -c alone returns only definitions
 414                             (if completion-ignore-case
 415                                 (list "--ignore-case" "-Tc" prefix)
 416                               (list "-Tc" prefix)))
 417                      "\n" t)))))
 418      (cdr ggtags-completion-cache))))
 419
 420 (defun ggtags-read-tag ()
 421   (ggtags-ensure-project)
 422   (let ((default (ggtags-tag-at-point))
 423         (completing-read-function ggtags-completing-read-function))
 424     (setq ggtags-current-tag-name
 425           (cond (current-prefix-arg
 426                  (completing-read
 427                   (format (if default "Tag (default %s): " "Tag: ") default)
 428                   ggtags-completion-table nil t nil nil default))
 429                 ((not default)
 430                  (user-error "No tag at point"))
 431                 (t (substring-no-properties default))))))
 432
 433 (defun ggtags-global-build-command (cmd &rest args)
 434   ;; CMD can be definition, reference, symbol, grep, idutils
 435   (let ((xs (append (list "global" "-v"
 436                           (format "--result=%s" ggtags-global-output-format)
 437                           (and ggtags-global-ignore-case "--ignore-case")
 438                           (and ggtags-global-has-color "--color")
 439                           (and ggtags-global-has-path-style
 440                                "--path-style=shorter")
 441                           (and ggtags-global-treat-text "--other")
 442                           (pcase cmd
 443                             ((pred stringp) cmd)
 444                             (`definition "-d")
 445                             (`reference "-r")
 446                             (`symbol "-s")
 447                             (`path "--path")
 448                             (`grep "--grep")
 449                             (`idutils "--idutils")))
 450                     args)))
 451     (mapconcat 'identity (delq nil xs) " ")))
 452
 453 ;; takes three values: nil, t and a marker
 454 (defvar ggtags-global-start-marker nil)
 455
 456 (defvar ggtags-global-exit-status 0)
 457 (defvar ggtags-global-match-count 0)
 458
 459 (defvar ggtags-tag-ring-index nil)
 460
 461 (defun ggtags-global-save-start-marker ()
 462   (when (markerp ggtags-global-start-marker)
 463     (eval-and-compile (require 'etags))
 464     (setq ggtags-tag-ring-index nil)
 465     (ring-insert find-tag-marker-ring ggtags-global-start-marker)
 466     (setq ggtags-global-start-marker t)))
 467
 468 (defun ggtags-global-start (command &optional root)
 469   (let* ((default-directory (or root (ggtags-current-project-root)))
 470          (split-window-preferred-function ggtags-split-window-function))
 471     (setq ggtags-global-start-marker (point-marker))
 472     (ggtags-navigation-mode +1)
 473     (setq ggtags-global-exit-status 0
 474           ggtags-global-match-count 0)
 475     (ggtags-with-process-environment
 476      (setq ggtags-global-last-buffer
 477            (compilation-start command 'ggtags-global-mode)))))
 478
 479 (defun ggtags-find-tag-continue ()
 480   (interactive)
 481   (ggtags-ensure-global-buffer
 482     (ggtags-navigation-mode +1)
 483     (let ((split-window-preferred-function ggtags-split-window-function))
 484       (ignore-errors (compilation-next-error 1))
 485       (compile-goto-error))))
 486
 487 (defun ggtags-find-tag (cmd name)
 488   (ggtags-check-project)
 489   (ggtags-global-start (ggtags-global-build-command cmd name)))
 490
 491 ;;;###autoload
 492 (defun ggtags-find-tag-dwim (name &optional definition)
 493   "Find definitions or references of tag NAME by context.
 494 If point is at a definition tag, find references, and vice versa.
 495 With a prefix arg (non-nil DEFINITION) always find definitions."
 496   (interactive (list (ggtags-read-tag) current-prefix-arg))
 497   (if (or definition
 498           (not buffer-file-name)
 499           (and (ggtags-find-project)
 500                (not (ggtags-project-has-rtags (ggtags-find-project)))))
 501       (ggtags-find-tag 'definition name)
 502     (ggtags-find-tag (format "--from-here=%d:%s"
 503                              (line-number-at-pos)
 504                              (shell-quote-argument
 505                               (file-relative-name buffer-file-name)))
 506                      name)))
 507
 508 (defun ggtags-find-reference (name)
 509   (interactive (list (ggtags-read-tag)))
 510   (ggtags-find-tag 'reference name))
 511
 512 (defun ggtags-find-other-symbol (name)
 513   "Find tag NAME that is a reference without a definition."
 514   (interactive (list (ggtags-read-tag)))
 515   (ggtags-find-tag 'symbol name))
 516
 517 (defun ggtags-read-string (prompt)
 518   "Like `read-string' but handle default automatically."
 519   (ggtags-ensure-project)
 520   (let ((prompt (if (string-match ": *\\'" prompt)
 521                     (substring prompt 0 (match-beginning 0))
 522                   prompt))
 523         (default (ggtags-tag-at-point)))
 524     (read-string (format (if default "%s (default `%s'): "
 525                            "%s: ")
 526                          prompt default)
 527                  nil nil (and default (substring-no-properties default)))))
 528
 529 (defun ggtags-grep (pattern &optional invert-match)
 530   "Use `global --grep' to search for lines matching PATTERN.
 531 Invert the match when called with a prefix arg \\[universal-argument]."
 532   (interactive (list (ggtags-read-string (if current-prefix-arg
 533                                              "Inverted grep pattern"
 534                                            "Grep pattern"))
 535                      current-prefix-arg))
 536   (ggtags-find-tag 'grep (format "%s--regexp %S"
 537                                  (if invert-match "--invert-match " "")
 538                                  pattern)))
 539
 540 (defun ggtags-idutils-query (pattern)
 541   (interactive (list (ggtags-read-string "ID query pattern")))
 542   (ggtags-find-tag 'idutils (format "--regexp %S" pattern)))
 543
 544 (defun ggtags-find-file (pattern &optional invert-match)
 545   (interactive (list (ggtags-read-string (if current-prefix-arg
 546                                              "Inverted path pattern"
 547                                            "Path pattern"))
 548                      current-prefix-arg))
 549   (let ((ggtags-global-output-format 'path))
 550     (ggtags-find-tag 'path (format "%s--regexp %S"
 551                                    (if invert-match "--invert-match " "")
 552                                    pattern))))
 553
 554 ;; NOTE: Coloured output in grep requested: http://goo.gl/Y9IcX
 555 (defun ggtags-find-tag-regexp (regexp directory)
 556   "List tags matching REGEXP in DIRECTORY (default to project root)."
 557   (interactive
 558    (list (ggtags-read-string "POSIX regexp")
 559          (if current-prefix-arg
 560              (read-directory-name "Directory: " nil nil t)
 561            (ggtags-current-project-root))))
 562   (ggtags-check-project)
 563   (let ((root (file-name-as-directory directory))
 564         (cmd (ggtags-global-build-command
 565               nil nil "-l" "--regexp" (prin1-to-string regexp))))
 566     (ggtags-global-start cmd root)))
 567
 568 (defun ggtags-query-replace (from to &optional delimited)
 569   "Query replace FROM with TO on files in the Global buffer.
 570 If not in navigation mode, do a grep on FROM first.
 571
 572 Note: the regular expression FROM must be supported by both
 573 Global and Emacs."
 574   (interactive (query-replace-read-args "Query replace (regexp)" t t))
 575   (unless (bound-and-true-p ggtags-navigation-mode)
 576     (let ((ggtags-auto-jump-to-first-match nil))
 577       (ggtags-grep from)))
 578   (let ((file-form
 579          '(let ((files))
 580             (ggtags-ensure-global-buffer
 581               (with-temp-message "Waiting for Grep to finish..."
 582                 (while (get-buffer-process (current-buffer))
 583                   (sit-for 0.2)))
 584               (goto-char (point-min))
 585               (while (ignore-errors (compilation-next-file 1) t)
 586                 (let ((m (get-text-property (point) 'compilation-message)))
 587                   (push (expand-file-name
 588                          (caar (compilation--loc->file-struct
 589                                 (compilation--message->loc m))))
 590                         files))))
 591             (ggtags-navigation-mode -1)
 592             (nreverse files))))
 593     (tags-query-replace from to delimited file-form)))
 594
 595 (defun ggtags-delete-tag-files ()
 596   "Delete the tag files generated by gtags."
 597   (interactive)
 598   (when (ggtags-current-project-root)
 599     (let ((files (directory-files (ggtags-current-project-root) t
 600                                   (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID"))))
 601           (buffer "*GTags File List*"))
 602       (or files (user-error "No tag files found"))
 603       (with-output-to-temp-buffer buffer
 604         (dolist (file files)
 605           (princ file)
 606           (princ "\n")))
 607       (let ((win (get-buffer-window buffer)))
 608         (unwind-protect
 609             (progn
 610               (fit-window-to-buffer win)
 611               (when (yes-or-no-p "Remove GNU Global tag files? ")
 612                 (mapc 'delete-file files)
 613                 (remhash (ggtags-current-project-root) ggtags-projects)
 614                 (delete-overlay ggtags-highlight-tag-overlay)
 615                 (kill-local-variable 'ggtags-project)))
 616           (when (window-live-p win)
 617             (quit-window t win)))))))
 618
 619 (defun ggtags-browse-file-as-hypertext (file line)
 620   "Browse FILE in hypertext (HTML) form."
 621   (interactive (if (or current-prefix-arg (not buffer-file-name))
 622                    (list (read-file-name "Browse file: " nil nil t)
 623                          (read-number "Line: " 1))
 624                  (list buffer-file-name (line-number-at-pos))))
 625   (check-type line integer)
 626   (or (and file (file-exists-p file)) (error "File `%s' doesn't exist" file))
 627   (ggtags-check-project)
 628   (or (file-exists-p (expand-file-name "HTML" (ggtags-current-project-root)))
 629       (if (yes-or-no-p "No hypertext form exists; run htags? ")
 630           (let ((default-directory (ggtags-current-project-root)))
 631             (ggtags-with-process-environment (ggtags-process-string "htags")))
 632         (user-error "Aborted")))
 633   (let ((url (ggtags-process-string "gozilla" "-p" (format "+%d" line) file)))
 634     (or (equal (file-name-extension
 635                 (url-filename (url-generic-parse-url url))) "html")
 636         (user-error "No hypertext form for `%s'" file))
 637     (when (called-interactively-p 'interactive)
 638       (message "Browsing %s" url))
 639     (browse-url url)))
 640
 641 (defun ggtags-next-mark (&optional arg)
 642   "Move to the next (newer) mark in the tag marker ring."
 643   (interactive)
 644   (and (zerop (ring-length find-tag-marker-ring))
 645        (user-error "No %s mark" (if arg "previous" "next")))
 646   (setq ggtags-tag-ring-index
 647         ;; Note `ring-minus1' gets newer item.
 648         (funcall (if arg #'ring-plus1 #'ring-minus1)
 649                  (or ggtags-tag-ring-index
 650                      (progn
 651                        (ring-insert find-tag-marker-ring (point-marker))
 652                        0))
 653                  (ring-length find-tag-marker-ring)))
 654   (let ((m (ring-ref find-tag-marker-ring ggtags-tag-ring-index))
 655         (i (- (ring-length find-tag-marker-ring) ggtags-tag-ring-index))
 656         (message-log-max nil))
 657     (message "%d%s marker%s" i (pcase (mod i 10)
 658                                  (1 "st")
 659                                  (2 "nd")
 660                                  (3 "rd")
 661                                  (_ "th"))
 662              (if (marker-buffer m) "" " (dead)"))
 663     (if (not (marker-buffer m))
 664         (ding)
 665       (switch-to-buffer (marker-buffer m))
 666       (goto-char m))))
 667
 668 (defun ggtags-prev-mark ()
 669   "Move to the previous (older) mark in the tag marker ring."
 670   (interactive)
 671   (ggtags-next-mark 'previous))
 672
 673 (defun ggtags-view-tag-history ()
 674   (interactive)
 675   (and (ring-empty-p find-tag-marker-ring)
 676        (user-error "Tag ring empty"))
 677   (let ((split-window-preferred-function ggtags-split-window-function)
 678         (inhibit-read-only t))
 679     (pop-to-buffer "*Tag Ring*")
 680     (erase-buffer)
 681     (tabulated-list-mode)
 682     (setq tabulated-list-entries
 683           ;; Use a function so that revert can work properly.
 684           (lambda ()
 685             (let ((counter (ring-length find-tag-marker-ring))
 686                   (elements (or (ring-elements find-tag-marker-ring)
 687                                 (user-error "Tag ring empty")))
 688                   (action
 689                    (lambda (button) (interactive)
 690                      (let ((m (button-get button 'marker)))
 691                        (or (markerp m) (user-error "Marker dead"))
 692                        (setq ggtags-tag-ring-index
 693                              (ring-member find-tag-marker-ring m))
 694                        (pop-to-buffer (marker-buffer m))
 695                        (goto-char (marker-position m)))))
 696                   (get-line
 697                    (lambda (m)
 698                      (with-current-buffer (marker-buffer m)
 699                        (save-excursion
 700                          (goto-char m)
 701                          (buffer-substring (line-beginning-position)
 702                                            (line-end-position)))))))
 703               (setq tabulated-list-format
 704                     `[("ID" ,(max (1+ (floor (log10 counter))) 2)
 705                        (lambda (x y) (< (car x) (car y))))
 706                       ("Buffer" ,(max (loop for m in elements
 707                                             for b = (marker-buffer m)
 708                                             maximize
 709                                             (length (and b (buffer-name b))))
 710                                       6)
 711                        t :right-align t)
 712                       ("Position" ,(max (loop for m in elements
 713                                               for p = (or (marker-position m) 1)
 714                                               maximize (1+ (floor (log10 p))))
 715                                         8)
 716                        (lambda (x y)
 717                          (< (string-to-number (aref (cadr x) 2))
 718                             (string-to-number (aref (cadr y) 2))))
 719                        :right-align t)
 720                       ("Contents" 100 t)])
 721               (tabulated-list-init-header)
 722               (setq tabulated-list-sort-key '("ID" . t))
 723               (mapcar (lambda (x)
 724                         (prog1
 725                             (list counter
 726                                   (if (marker-buffer x)
 727                                       (vector (number-to-string counter)
 728                                               `(,(buffer-name (marker-buffer x))
 729                                                 face link
 730                                                 follow-link t
 731                                                 marker ,x
 732                                                 action ,action)
 733                                               (number-to-string (marker-position x))
 734                                               (funcall get-line x))
 735                                     (vector (number-to-string counter)
 736                                             "(dead)" "?" "?")))
 737                           (decf counter)))
 738                       elements))))
 739     (tabulated-list-print)
 740     (fit-window-to-buffer)))
 741
 742 (defun ggtags-global-exit-message-function (_process-status exit-status msg)
 743   (setq ggtags-global-exit-status exit-status)
 744   (let ((count (save-excursion
 745                  (goto-char (point-max))
 746                  (if (re-search-backward "^\\([0-9]+\\) \\w+ located" nil t)
 747                      (string-to-number (match-string 1))
 748                    0))))
 749     (setq ggtags-global-match-count count)
 750     ;; Clear the start marker in case of zero matches.
 751     (and (zerop count)
 752          (markerp ggtags-global-start-marker)
 753          (setq ggtags-global-start-marker nil))
 754     (cons (if (> exit-status 0)
 755               msg
 756             (format "found %d %s" count (if (= count 1) "match" "matches")))
 757           exit-status)))
 758
 759 ;;; NOTE: Must not match the 'Global started at Mon Jun 3 10:24:13'
 760 ;;; line or `compilation-auto-jump' will jump there and fail. See
 761 ;;; comments before the 'gnu' entry in
 762 ;;; `compilation-error-regexp-alist-alist'.
 763 (defvar ggtags-global-error-regexp-alist-alist
 764   (append
 765    '((path "^\\(?:[^/\n]*/\\)?[^ )\t\n]+$" 0)
 766      ;; ACTIVE_ESCAPE   src/dialog.cc   172
 767      (ctags "^\\([^ \t\n]+\\)[ \t]+\\(.*?\\)[ \t]+\\([0-9]+\\)$"
 768             2 3 nil nil 2 (1 font-lock-function-name-face))
 769      ;; ACTIVE_ESCAPE     172 src/dialog.cc    #undef ACTIVE_ESCAPE
 770      (ctags-x "^\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(\\(?:[^/\n]*/\\)?[^ \t\n]+\\)"
 771               3 2 nil nil 3 (1 font-lock-function-name-face))
 772      ;; src/dialog.cc:172:#undef ACTIVE_ESCAPE
 773      (grep "^\\(.+?\\):\\([0-9]+\\):\\(?:$\\|[^0-9\n]\\|[0-9][^0-9\n]\\|[0-9][0-9].\\)"
 774            1 2 nil nil 1)
 775      ;; src/dialog.cc ACTIVE_ESCAPE 172 #undef ACTIVE_ESCAPE
 776      (cscope "^\\(.+?\\)[ \t]+\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\).*\\(?:[^0-9\n]\\|[^0-9\n][0-9]\\|[^:\n][0-9][0-9]\\)$"
 777              1 3 nil nil 1 (2 font-lock-function-name-face)))
 778    compilation-error-regexp-alist-alist))
 779
 780 (defun ggtags-abbreviate-file (start end)
 781   (let ((inhibit-read-only t)
 782         (amount (if (numberp ggtags-global-abbreviate-filename)
 783                     (- (- end start) ggtags-global-abbreviate-filename)
 784                   999))
 785         (advance-word (lambda ()
 786                         "Return the length of the text made invisible."
 787                         (let ((wend (min end (progn (forward-word 1) (point))))
 788                               (wbeg (max start (progn (backward-word 1) (point)))))
 789                           (goto-char wend)
 790                           (if (<= (- wend wbeg) 1)
 791                               0
 792                             (put-text-property (1+ wbeg) wend 'invisible t)
 793                             (1- (- wend wbeg)))))))
 794     (goto-char start)
 795     (while (and (> amount 0) (> end (point)))
 796       (decf amount (funcall advance-word)))))
 797
 798 (defun ggtags-abbreviate-files (start end)
 799   (goto-char start)
 800   (let* ((error-re (cdr (assq ggtags-global-output-format
 801                               ggtags-global-error-regexp-alist-alist)))
 802          (sub (cadr error-re)))
 803     (when (and ggtags-global-abbreviate-filename error-re)
 804       (while (re-search-forward (car error-re) end t)
 805         (when (and (or (not (numberp ggtags-global-abbreviate-filename))
 806                        (> (length (match-string sub))
 807                           ggtags-global-abbreviate-filename))
 808                    ;; Ignore bogus file lines such as:
 809                    ;;     Global found 2 matches at Thu Jan 31 13:45:19
 810                    (get-text-property (match-beginning sub) 'compilation-message))
 811           (ggtags-abbreviate-file (match-beginning sub) (match-end sub)))))))
 812
 813 (defvar-local ggtags-global-output-lines 0)
 814
 815 (defun ggtags-global-filter ()
 816   "Called from `compilation-filter-hook' (which see)."
 817   ;; Get rid of line "Using config file '/PATH/TO/.globalrc'."
 818   (when (re-search-backward "^ *Using config file '.*\n"
 819                             compilation-filter-start t)
 820     (replace-match ""))
 821   (ansi-color-apply-on-region compilation-filter-start (point))
 822   (incf ggtags-global-output-lines
 823         (count-lines compilation-filter-start (point)))
 824   (when (> ggtags-global-output-lines ggtags-global-large-output)
 825     (let ((message-log-max nil))
 826       (message "Output %d lines (Type `C-c C-k' to cancel)"
 827                ggtags-global-output-lines))))
 828
 829 (defun ggtags-handle-single-match (buf _how)
 830   (when (and ggtags-auto-jump-to-first-match
 831              ;; If exit abnormally keep the window for inspection.
 832              (zerop ggtags-global-exit-status)
 833              (save-excursion
 834                (goto-char (point-min))
 835                (not (ignore-errors
 836                       (goto-char (compilation-next-single-property-change
 837                                   (point) 'compilation-message))
 838                       (end-of-line)
 839                       (compilation-next-single-property-change
 840                        (point) 'compilation-message)))))
 841     (ggtags-navigation-mode -1)
 842     ;; 0.5s delay for `ggtags-auto-jump-to-first-match'
 843     (sit-for 0)                    ; See: http://debbugs.gnu.org/13829
 844     (ggtags-navigation-mode-cleanup buf 0.5)))
 845
 846 (defvar ggtags-global-mode-font-lock-keywords
 847   '(("^Global \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
 848      (1 'compilation-error)
 849      (2 'compilation-error nil t))
 850     ("^Global found \\([0-9]+\\)" (1 compilation-info-face))))
 851
 852 (define-compilation-mode ggtags-global-mode "Global"
 853   "A mode for showing outputs from gnu global."
 854   ;; Make it buffer local for `ggtags-abbreviate-files'.
 855   (make-local-variable 'ggtags-global-output-format)
 856   (setq-local compilation-error-regexp-alist
 857               (list ggtags-global-output-format))
 858   (setq-local compilation-auto-jump-to-first-error
 859               ggtags-auto-jump-to-first-match)
 860   (setq-local compilation-scroll-output 'first-error)
 861   (setq-local compilation-disable-input t)
 862   (setq-local compilation-always-kill t)
 863   (setq-local compilation-error-face 'compilation-info)
 864   (setq-local compilation-exit-message-function
 865               'ggtags-global-exit-message-function)
 866   (setq-local truncate-lines t)
 867   (jit-lock-register #'ggtags-abbreviate-files)
 868   (add-hook 'compilation-filter-hook 'ggtags-global-filter nil 'local)
 869   (add-hook 'compilation-finish-functions 'ggtags-handle-single-match nil t)
 870   (define-key ggtags-global-mode-map "\M-o" 'visible-mode))
 871
 872 ;; NOTE: Need this to avoid putting menu items in
 873 ;; `emulation-mode-map-alists', which creates double entries. See
 874 ;; http://i.imgur.com/VJJTzVc.png
 875 (defvar ggtags-navigation-map
 876   (let ((map (make-sparse-keymap)))
 877     (define-key map "\M-n" 'next-error)
 878     (define-key map "\M-p" 'previous-error)
 879     (define-key map "\M-}" 'ggtags-navigation-next-file)
 880     (define-key map "\M-{" 'ggtags-navigation-previous-file)
 881     (define-key map "\M->" 'ggtags-navigation-last-error)
 882     (define-key map "\M-<" 'ggtags-navigation-first-error)
 883     (define-key map "\C-c\C-k"
 884       (lambda () (interactive)
 885         (ggtags-ensure-global-buffer (kill-compilation))))
 886     (define-key map "\M-o" 'ggtags-navigation-visible-mode)
 887     (define-key map [return] 'ggtags-navigation-mode-done)
 888     (define-key map "\r" 'ggtags-navigation-mode-done)
 889     ;; Intercept M-. and M-* keys
 890     (define-key map [remap pop-tag-mark] 'ggtags-navigation-mode-abort)
 891     (define-key map [remap ggtags-find-tag-dwim] 'undefined)
 892     map))
 893
 894 (defvar ggtags-mode-map-alist
 895   `((ggtags-navigation-mode . ,ggtags-navigation-map)))
 896
 897 ;; Higher priority for `ggtags-navigation-mode' to avoid being
 898 ;; hijacked by modes such as `view-mode'.
 899 (add-to-list 'emulation-mode-map-alists 'ggtags-mode-map-alist)
 900
 901 (defvar ggtags-navigation-mode-map
 902   (let ((map (make-sparse-keymap))
 903         (menu (make-sparse-keymap "GG-Navigation")))
 904     ;; Menu items: (info "(elisp)Extended Menu Items")
 905     (define-key map [menu-bar ggtags-navigation] (cons "GG-Navigation" menu))
 906     ;; Ordered backwards
 907     (define-key menu [visible-mode]
 908       '(menu-item "Visible mode" ggtags-navigation-visible-mode
 909                   :button (:toggle . (ignore-errors
 910                                        (ggtags-ensure-global-buffer
 911                                          visible-mode)))))
 912     (define-key menu [done]
 913       '(menu-item "Finish navigation" ggtags-navigation-mode-done))
 914     (define-key menu [abort]
 915       '(menu-item "Abort" ggtags-navigation-mode-abort))
 916     (define-key menu [last-error]
 917       '(menu-item "Last error" ggtags-navigation-last-error))
 918     (define-key menu [fist-error]
 919       '(menu-item "Fist error" ggtags-navigation-first-error))
 920     (define-key menu [previous-file]
 921       '(menu-item "Previous file" ggtags-navigation-previous-file))
 922     (define-key menu [next-file]
 923       '(menu-item "Next file" ggtags-navigation-next-file))
 924     (define-key menu [previous]
 925       '(menu-item "Previous match" previous-error))
 926     (define-key menu [next]
 927       '(menu-item "Next match" next-error))
 928     map))
 929
 930 (defun ggtags-move-to-tag (&optional name)
 931   "Move to NAME tag in current line."
 932   (let ((orig (point))
 933         (tag (or name ggtags-current-tag-name)))
 934     (beginning-of-line)
 935     (if (and tag (re-search-forward
 936                   (concat "\\_<" (regexp-quote tag) "\\_>")
 937                   (line-end-position)
 938                   t))
 939         (goto-char (match-beginning 0))
 940       (goto-char orig))))
 941
 942 (defun ggtags-navigation-mode-cleanup (&optional buf time)
 943   (let ((buf (or buf ggtags-global-last-buffer)))
 944     (and (buffer-live-p buf)
 945          (with-current-buffer buf
 946            (when (get-buffer-process (current-buffer))
 947              (kill-compilation))
 948            (when (and (derived-mode-p 'ggtags-global-mode)
 949                       (get-buffer-window))
 950              (quit-window nil (get-buffer-window)))
 951            (and time (run-with-idle-timer time nil 'kill-buffer buf))))))
 952
 953 (defun ggtags-navigation-mode-done ()
 954   (interactive)
 955   (ggtags-navigation-mode -1)
 956   (setq tags-loop-scan t
 957         tags-loop-operate '(ggtags-find-tag-continue))
 958   (ggtags-navigation-mode-cleanup))
 959
 960 (defun ggtags-navigation-mode-abort ()
 961   (interactive)
 962   (ggtags-navigation-mode -1)
 963   ;; Run after (ggtags-navigation-mode -1) or
 964   ;; ggtags-global-start-marker might not have been saved.
 965   (when (and (not (markerp ggtags-global-start-marker))
 966              ggtags-global-start-marker)
 967     (setq ggtags-global-start-marker nil)
 968     (pop-tag-mark))
 969   (ggtags-navigation-mode-cleanup nil 0))
 970
 971 (defun ggtags-navigation-next-file (n)
 972   (interactive "p")
 973   (ggtags-ensure-global-buffer
 974     (compilation-next-file n)
 975     (compile-goto-error)))
 976
 977 (defun ggtags-navigation-previous-file (n)
 978   (interactive "p")
 979   (ggtags-navigation-next-file (- n)))
 980
 981 (defun ggtags-navigation-first-error ()
 982   (interactive)
 983   (ggtags-ensure-global-buffer
 984     (goto-char (point-min))
 985     (compilation-next-error 1)
 986     (compile-goto-error)))
 987
 988 (defun ggtags-navigation-last-error ()
 989   (interactive)
 990   (ggtags-ensure-global-buffer
 991     (goto-char (point-max))
 992     (compilation-previous-error 1)
 993     (compile-goto-error)))
 994
 995 (defun ggtags-navigation-visible-mode (&optional arg)
 996   (interactive (list (or current-prefix-arg 'toggle)))
 997   (ggtags-ensure-global-buffer
 998     (visible-mode arg)))
 999
1000 (defvar ggtags-global-line-overlay nil)
1001
1002 (defun ggtags-global-next-error-hook ()
1003   (ggtags-move-to-tag)
1004   (ggtags-global-save-start-marker)
1005   (ignore-errors
1006     (ggtags-ensure-global-buffer
1007       (unless (overlayp ggtags-global-line-overlay)
1008         (setq ggtags-global-line-overlay (make-overlay (point) (point)))
1009         (overlay-put ggtags-global-line-overlay 'face 'ggtags-global-line))
1010       (move-overlay ggtags-global-line-overlay
1011                     (line-beginning-position) (line-end-position)
1012                     (current-buffer)))))
1013
1014 (define-minor-mode ggtags-navigation-mode nil
1015   :lighter
1016   (" GG[" (:eval (ggtags-ensure-global-buffer
1017                    (let ((index (when (get-text-property (line-beginning-position)
1018                                                          'compilation-message)
1019                                   ;; Assume the first match appears at line 5
1020                                   (- (line-number-at-pos) 4))))
1021                      `((:propertize ,(if index
1022                                          (number-to-string (max index 0))
1023                                        "?") face success) "/"))))
1024    (:propertize (:eval (number-to-string ggtags-global-match-count))
1025                 face success)
1026    (:eval
1027     (unless (zerop ggtags-global-exit-status)
1028       `(":" (:propertize ,(number-to-string ggtags-global-exit-status)
1029                          face error))))
1030    "]")
1031   :global t
1032   (if ggtags-navigation-mode
1033       (progn
1034         (add-hook 'next-error-hook 'ggtags-global-next-error-hook)
1035         (add-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function))
1036     ;; Call `ggtags-global-save-start-marker' in case of exiting from
1037     ;; `ggtags-handle-single-match' for single match.
1038     (ggtags-global-save-start-marker)
1039     (remove-hook 'next-error-hook 'ggtags-global-next-error-hook)
1040     (remove-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function)))
1041
1042 (defun ggtags-minibuffer-setup-function ()
1043   ;; Disable ggtags-navigation-mode in minibuffer.
1044   (setq-local ggtags-navigation-mode nil))
1045
1046 (defun ggtags-kill-file-buffers (&optional interactive)
1047   "Kill all buffers visiting files in current project."
1048   (interactive "p")
1049   (ggtags-check-project)
1050   (let ((directories (cons (ggtags-current-project-root) (ggtags-get-libpath)))
1051         (count 0)
1052         (some (lambda (pred list)
1053                 (loop for x in list when (funcall pred x) return it))))
1054     (dolist (buf (buffer-list))
1055       (let ((file (and (buffer-live-p buf)
1056                        (not (eq buf (current-buffer)))
1057                        (buffer-file-name buf))))
1058         (when (and file (funcall some
1059                                  (lambda (dir)
1060                                    ;; Don't use `file-in-directory-p'
1061                                    ;; to allow symbolic links.
1062                                    (string-prefix-p dir file))
1063                                  directories))
1064           (and (kill-buffer buf) (incf count)))))
1065     (and interactive
1066          (message "%d %s killed" count (if (= count 1) "buffer" "buffers")))))
1067
1068 (defun ggtags-after-save-function ()
1069   (when (ggtags-find-project)
1070     (setf (ggtags-project-dirty-p (ggtags-find-project)) t)
1071     ;; When oversize update on a per-save basis.
1072     (when (and buffer-file-name
1073                (ggtags-project-oversize-p (ggtags-find-project)))
1074       (ggtags-with-process-environment
1075        (process-file "global" nil 0 nil "--single-update"
1076                      (file-relative-name buffer-file-name))))))
1077
1078 (defvar ggtags-mode-prefix-map
1079   (let ((m (make-sparse-keymap)))
1080     (define-key m (kbd "M-DEL") 'ggtags-delete-tag-files)
1081     (define-key m "\M-p" 'ggtags-prev-mark)
1082     (define-key m "\M-n" 'ggtags-next-mark)
1083     (define-key m "\M-f" 'ggtags-find-file)
1084     (define-key m "\M-o" 'ggtags-find-other-symbol)
1085     (define-key m "\M-g" 'ggtags-grep)
1086     (define-key m "\M-i" 'ggtags-idutils-query)
1087     (define-key m "\M-b" 'ggtags-browse-file-as-hypertext)
1088     (define-key m "\M-k" 'ggtags-kill-file-buffers)
1089     (define-key m "\M-h" 'ggtags-view-tag-history)
1090     (define-key m (kbd "M-%") 'ggtags-query-replace)
1091     m))
1092
1093 (defvar ggtags-mode-map
1094   (let ((map (make-sparse-keymap))
1095         (menu (make-sparse-keymap "Ggtags")))
1096     (define-key map "\M-." 'ggtags-find-tag-dwim)
1097     (define-key map (kbd "M-]") 'ggtags-find-reference)
1098     (define-key map (kbd "C-M-.") 'ggtags-find-tag-regexp)
1099     (define-key map ggtags-mode-prefix-key ggtags-mode-prefix-map)
1100     ;; Menu items
1101     (define-key map [menu-bar ggtags] (cons "Ggtags" menu))
1102     ;; Ordered backwards
1103     (define-key menu [report-bugs]
1104       `(menu-item "Report bugs"
1105                   (lambda () (interactive)
1106                     (browse-url ggtags-bug-url)
1107                     (message "Please visit %s" ggtags-bug-url))
1108                   :help ,(format "Visit %s" ggtags-bug-url)))
1109     (define-key menu [custom-ggtags]
1110       '(menu-item "Customize Ggtags"
1111                   (lambda () (interactive) (customize-group 'ggtags))))
1112     (define-key menu [save-project]
1113       '(menu-item "Save project settings" ggtags-save-project-settings))
1114     (define-key menu [sep2] menu-bar-separator)
1115     (define-key menu [browse-hypertext]
1116       '(menu-item "Browse as hypertext" ggtags-browse-file-as-hypertext
1117                   :enable (ggtags-find-project)))
1118     (define-key menu [delete-tags]
1119       '(menu-item "Delete tag files" ggtags-delete-tag-files
1120                   :enable (ggtags-find-project)))
1121     (define-key menu [kill-buffers]
1122       '(menu-item "Kill project file buffers" ggtags-kill-file-buffers
1123                   :enable (ggtags-find-project)))
1124     (define-key menu [view-tag]
1125       '(menu-item "View tag history" ggtags-view-tag-history))
1126     (define-key menu [pop-mark]
1127       '(menu-item "Pop mark" pop-tag-mark
1128                   :help "Pop to previous mark and destroy it"))
1129     (define-key menu [next-mark]
1130       '(menu-item "Next mark" ggtags-next-mark))
1131     (define-key menu [prev-mark]
1132       '(menu-item "Previous mark" ggtags-prev-mark))
1133     (define-key menu [sep1] menu-bar-separator)
1134     (define-key menu [find-file]
1135       '(menu-item "Find files" ggtags-find-file))
1136     (define-key menu [query-replace]
1137       '(menu-item "Query replace" ggtags-query-replace))
1138     (define-key menu [idutils]
1139       '(menu-item "Query idutils DB" ggtags-idutils-query))
1140     (define-key menu [grep]
1141       '(menu-item "Use grep" ggtags-grep))
1142     (define-key menu [find-symbol]
1143       '(menu-item "Find other symbol" ggtags-find-other-symbol))
1144     (define-key menu [find-tag-regexp]
1145       '(menu-item "Find tag matching regexp" ggtags-find-tag-regexp))
1146     (define-key menu [find-reference]
1147       '(menu-item "Find reference" ggtags-find-reference))
1148     (define-key menu [find-tag-continue]
1149       '(menu-item "Continue find tag" tags-loop-continue))
1150     (define-key menu [find-tag]
1151       '(menu-item "Find tag" ggtags-find-tag-dwim))
1152     (define-key menu [update-tags]
1153       '(menu-item "Update tag files" ggtags-update-tags
1154                   :visible (ggtags-find-project)))
1155     (define-key menu [run-gtags]
1156       '(menu-item "Run gtags" ggtags-ensure-project
1157                   :visible (not (ggtags-find-project))))
1158     map))
1159
1160 ;;;###autoload
1161 (define-minor-mode ggtags-mode nil
1162   :lighter (:eval (if ggtags-navigation-mode "" " GG"))
1163   (unless (timerp ggtags-highlight-tag-timer)
1164     (setq ggtags-highlight-tag-timer
1165           (run-with-idle-timer
1166            ggtags-highlight-tag-delay t 'ggtags-highlight-tag-at-point)))
1167   (if ggtags-mode
1168       (progn
1169         (add-hook 'after-save-hook 'ggtags-after-save-function nil t)
1170         (or (executable-find "global")
1171             (message "Failed to find GNU Global")))
1172     (remove-hook 'after-save-hook 'ggtags-after-save-function t)
1173     (and (overlayp ggtags-highlight-tag-overlay)
1174          (delete-overlay ggtags-highlight-tag-overlay))
1175     (setq ggtags-highlight-tag-overlay nil)))
1176
1177 (defvar ggtags-highlight-tag-map
1178   (let ((map (make-sparse-keymap)))
1179     (define-key map [S-down-mouse-1] 'ggtags-find-tag-dwim)
1180     (define-key map [S-down-mouse-3] 'ggtags-find-reference)
1181     map)
1182   "Keymap used for valid tag at point.")
1183
1184 (put 'ggtags-active-tag 'face 'ggtags-highlight)
1185 (put 'ggtags-active-tag 'keymap ggtags-highlight-tag-map)
1186 ;; (put 'ggtags-active-tag 'mouse-face 'match)
1187 (put 'ggtags-active-tag 'modification-hooks
1188      (list (lambda (o after &rest _args)
1189              (and (not after) (delete-overlay o)))))
1190 (put 'ggtags-active-tag 'help-echo
1191      "S-down-mouse-1 for definitions\nS-down-mouse-3 for references")
1192
1193 (defun ggtags-highlight-tag-at-point ()
1194   (when (and ggtags-mode (eq ggtags-project 'unset))
1195     (ggtags-find-project))
1196   (when (and ggtags-mode ggtags-project)
1197     (unless (overlayp ggtags-highlight-tag-overlay)
1198       (let ((o (make-overlay (point) (point) nil t)))
1199         (setq ggtags-highlight-tag-overlay o)))
1200     (let ((bounds (funcall ggtags-bounds-of-tag-function))
1201           (o ggtags-highlight-tag-overlay))
1202       (cond
1203        ((and bounds
1204              (overlay-get o 'category)
1205              (eq (overlay-buffer o) (current-buffer))
1206              (= (overlay-start o) (car bounds))
1207              (= (overlay-end o) (cdr bounds)))
1208         ;; Tag is already highlighted so do nothing.
1209         nil)
1210        ((and bounds (let ((completion-ignore-case nil))
1211                       (test-completion
1212                        (buffer-substring (car bounds) (cdr bounds))
1213                        ggtags-completion-table)))
1214         (move-overlay o (car bounds) (cdr bounds) (current-buffer))
1215         (overlay-put o 'category 'ggtags-active-tag))
1216        (t (move-overlay o
1217                         (or (car bounds) (point))
1218                         (or (cdr bounds) (point))
1219                         (current-buffer))
1220           (overlay-put o 'category nil))))))
1221
1222 ;;; imenu
1223
1224 (defun ggtags-goto-imenu-index (name line &rest _args)
1225   (save-restriction
1226     (widen)
1227     (goto-char (point-min))
1228     (forward-line (1- line))
1229     (ggtags-move-to-tag name)))
1230
1231 ;;;###autoload
1232 (defun ggtags-build-imenu-index ()
1233   "A function suitable for `imenu-create-index-function'."
1234   (when buffer-file-name
1235     (let ((file (file-relative-name buffer-file-name)))
1236       (with-temp-buffer
1237         (when (with-demoted-errors
1238                 (zerop (ggtags-with-process-environment
1239                         (process-file "global" nil t nil "-x" "-f" file))))
1240           (goto-char (point-min))
1241           (loop while (re-search-forward
1242                        "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)" nil t)
1243                 collect (list (match-string 1)
1244                               (string-to-number (match-string 2))
1245                               'ggtags-goto-imenu-index)))))))
1246
1247 ;;; hippie-expand
1248
1249 ;;;###autoload
1250 (defun try-complete-ggtags-tag (old)
1251   "A function suitable for `hippie-expand-try-functions-list'."
1252   (with-no-warnings                     ; to avoid loading hippie-exp
1253     (unless old
1254       (he-init-string (if (looking-back "\\_<.*" (line-beginning-position))
1255                           (match-beginning 0)
1256                         (point))
1257                       (point))
1258       (setq he-expand-list
1259             (and (not (equal he-search-string ""))
1260                  (ggtags-find-project)
1261                  (sort (all-completions he-search-string
1262                                         ggtags-completion-table)
1263                        'string-lessp))))
1264     (if (null he-expand-list)
1265         (progn
1266           (if old (he-reset-string))
1267           nil)
1268       (he-substitute-string (car he-expand-list))
1269       (setq he-expand-list (cdr he-expand-list))
1270       t)))
1271
1272 (defun ggtags-reload (&optional force)
1273   (interactive "P")
1274   (unload-feature 'ggtags force)
1275   (require 'ggtags))
1276
1277 (defun ggtags-unload-function ()
1278   (setq emulation-mode-map-alists
1279         (delq 'ggtags-mode-map-alist emulation-mode-map-alists))
1280   nil)
1281
1282 (provide 'ggtags)
1283 ;;; ggtags.el ends here