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

   1 ;;; ggtags.el --- emacs frontend to GNU Global source code tagging system  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2013-2014  Free Software Foundation, Inc.
   4
   5 ;; Author: Leo Liu <sdl.web@gmail.com>
   6 ;; Version: 0.8.0
   7 ;; Keywords: tools, convenience
   8 ;; Created: 2013-01-29
   9 ;; URL: https://github.com/leoliu/ggtags
  10 ;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
  11
  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.
  16
  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.
  21
  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/>.
  24
  25 ;;; Commentary:
  26
  27 ;; A package to integrate GNU Global source code tagging system
  28 ;; (http://www.gnu.org/software/global) with Emacs.
  29 ;;
  30 ;; Usage:
  31 ;;
  32 ;; Type `M-x ggtags-mode' to enable the minor mode, or as usual enable
  33 ;; it in your desired major mode hooks. When the mode is on the symbol
  34 ;; at point is underlined if it is a valid (definition) tag.
  35 ;;
  36 ;; `M-.' finds definition or references according to the context at
  37 ;; point, i.e. if point is at a definition tag find references and
  38 ;; vice versa. `M-]' finds references.
  39 ;;
  40 ;; If multiple matches are found, navigation mode is entered, the
  41 ;; mode-line lighter changed, and a navigation menu-bar entry
  42 ;; presented. In this mode, `M-n' and `M-p' moves to next and previous
  43 ;; match, `M-}' and `M-{' to next and previous file respectively.
  44 ;; `M-o' toggles between full and abbreviated displays of file names
  45 ;; in the auxiliary popup window. When you locate the right match,
  46 ;; press RET to finish which hides the auxiliary window and exits
  47 ;; navigation mode. You can continue the search using `M-,'. To abort
  48 ;; the search press `M-*'.
  49 ;;
  50 ;; Normally after a few searches a dozen buffers are created visiting
  51 ;; files tracked by GNU Global. `C-c M-k' helps clean them up.
  52 ;;
  53 ;; Check the menu-bar entry `Ggtags' for other useful commands.
  54
  55 ;;; Code:
  56
  57 (eval-when-compile
  58   (require 'url-parse))
  59
  60 (require 'cl-lib)
  61 (require 'compile)
  62 (require 'etags)
  63 (require 'tabulated-list)               ;preloaded since 24.3
  64
  65 (eval-when-compile
  66   (unless (fboundp 'setq-local)
  67     (defmacro setq-local (var val)
  68       (list 'set (list 'make-local-variable (list 'quote var)) val)))
  69
  70   (unless (fboundp 'defvar-local)
  71     (defmacro defvar-local (var val &optional docstring)
  72       (declare (debug defvar) (doc-string 3))
  73       (list 'progn (list 'defvar var val docstring)
  74             (list 'make-variable-buffer-local (list 'quote var))))))
  75
  76 (eval-and-compile
  77   (or (fboundp 'user-error)
  78       (defalias 'user-error 'error)))
  79
  80 (defgroup ggtags nil
  81   "GNU Global source code tagging system."
  82   :group 'tools)
  83
  84 (defface ggtags-highlight '((t (:underline t)))
  85   "Face used to highlight a valid tag at point."
  86   :group 'ggtags)
  87
  88 (defface ggtags-global-line '((t (:inherit secondary-selection)))
  89   "Face used to highlight matched line in Global buffer."
  90   :group 'ggtags)
  91
  92 (defcustom ggtags-oversize-limit (* 10 1024 1024)
  93   "The over size limit for the  GTAGS file.
  94 For large source trees, running 'global -u' can be expensive.
  95 Thus when GTAGS file is larger than this limit, ggtags
  96 automatically switches to 'global --single-update'."
  97   :safe 'numberp
  98   :type '(choice (const :tag "None" nil)
  99                  (const :tag "Always" t)
 100                  number)
 101   :group 'ggtags)
 102
 103 (defcustom ggtags-global-always-update nil
 104   "If non-nil always update tags for current file on save."
 105   :safe 'booleanp
 106   :type 'boolean
 107   :group 'ggtags)
 108
 109 (defcustom ggtags-use-project-gtagsconf t
 110   "Non-nil to automatically use GTAGSCONF file at project root.
 111 File .globalrc and gtags.conf are checked in order."
 112   :safe 'booleanp
 113   :type 'boolean
 114   :group 'ggtags)
 115
 116 (defcustom ggtags-project-duration 600
 117   "Seconds to keep information of a project in memory."
 118   :type 'number
 119   :group 'ggtags)
 120
 121 (defcustom ggtags-process-environment nil
 122   "Similar to `process-environment' with higher precedence.
 123 Elements are run through `substitute-env-vars' before use.
 124 GTAGSROOT will always be expanded to current project root
 125 directory. This is intended for project-wise ggtags-specific
 126 process environment settings. Note on remote hosts (e.g. tramp)
 127 directory local variables is not enabled by default per
 128 `enable-remote-dir-locals' (which see)."
 129   :safe 'ggtags-list-of-string-p
 130   :type '(repeat string)
 131   :group 'ggtags)
 132
 133 (defcustom ggtags-auto-jump-to-first-match t
 134   "Non-nil to automatically jump to the first match."
 135   :type 'boolean
 136   :group 'ggtags)
 137
 138 (defcustom ggtags-global-window-height 8 ; ggtags-global-mode
 139   "Number of lines for the 'global' popup window.
 140 If nil, use Emacs default."
 141   :type '(choice (const :tag "Default" nil) integer)
 142   :group 'ggtags)
 143
 144 (defcustom ggtags-global-abbreviate-filename 35
 145   "Non-nil to display file names abbreviated e.g. \"/u/b/env\".
 146 If an integer abbreviate only names longer than that number."
 147   :type '(choice (const :tag "No" nil)
 148                  (const :tag "Always" t)
 149                  integer)
 150   :group 'ggtags)
 151
 152 (defcustom ggtags-split-window-function split-window-preferred-function
 153   "A function to control how ggtags pops up the auxiliary window."
 154   :type 'function
 155   :group 'ggtags)
 156
 157 (defcustom ggtags-use-idutils (and (executable-find "mkid") t)
 158   "Non-nil to also generate the idutils DB."
 159   :type 'boolean
 160   :group 'ggtags)
 161
 162 (defcustom ggtags-global-output-format 'grep
 163   "The output format for the 'global' command."
 164   :type '(choice (const path)
 165                  (const ctags)
 166                  (const ctags-x)
 167                  (const grep)
 168                  (const cscope))
 169   :group 'ggtags)
 170
 171 (defcustom ggtags-global-ignore-case nil
 172   "Non-nil if Global should ignore case."
 173   :safe 'booleanp
 174   :type 'boolean
 175   :group 'ggtags)
 176
 177 (defcustom ggtags-global-treat-text nil
 178   "Non-nil if Global should include matches from text files."
 179   :safe 'booleanp
 180   :type 'boolean
 181   :group 'ggtags)
 182
 183 (defcustom ggtags-global-large-output 1000
 184   "Number of lines in the Global buffer to indicate large output."
 185   :type 'number
 186   :group 'ggtags)
 187
 188 (defcustom ggtags-find-tag-hook nil
 189   "Hook run immediately after finding a tag."
 190   :options '(recenter reposition-window)
 191   :type 'hook
 192   :group 'ggtags)
 193
 194 (defcustom ggtags-show-definition-function #'ggtags-show-definition-default
 195   "Function called by `ggtags-show-definition' to show definition.
 196 It is passed a list of definnition candidates of the form:
 197
 198  (TEXT NAME FILE LINE)
 199
 200 where TEXT is usually the source line of the definition."
 201   :type 'function
 202   :group 'ggtags)
 203
 204 (defcustom ggtags-mode-sticky t
 205   "If non-nil enable Ggtags Mode in files visited."
 206   :safe 'booleanp
 207   :type 'boolean
 208   :group 'ggtags)
 209
 210 (defcustom ggtags-mode-prefix-key "\C-c"
 211   "Key binding used for `ggtags-mode-prefix-map'.
 212 Users should change the value using `customize-variable' to
 213 properly update `ggtags-mode-map'."
 214   :set (lambda (sym value)
 215          (when (bound-and-true-p ggtags-mode-map)
 216            (let ((old (and (boundp sym) (symbol-value sym))))
 217              (and old (define-key ggtags-mode-map old nil)))
 218            (and value
 219                 (bound-and-true-p ggtags-mode-prefix-map)
 220                 (define-key ggtags-mode-map value ggtags-mode-prefix-map)))
 221          (set-default sym value))
 222   :type 'key-sequence
 223   :group 'ggtags)
 224
 225 (defcustom ggtags-completing-read-function completing-read-function
 226   "Ggtags specific `completing-read-function' (which see)."
 227   :type 'function
 228   :group 'ggtags)
 229
 230 (defcustom ggtags-highlight-tag-delay 0.25
 231   "Time in seconds before highlighting tag at point."
 232   :set (lambda (sym value)
 233          (when (bound-and-true-p ggtags-highlight-tag-timer)
 234            (timer-set-idle-time ggtags-highlight-tag-timer value t))
 235          (set-default sym value))
 236   :type 'number
 237   :group 'ggtags)
 238
 239 (defcustom ggtags-bounds-of-tag-function (lambda ()
 240                                            (bounds-of-thing-at-point 'symbol))
 241   "Function to get the start and end locations of the tag at point."
 242   :type 'function
 243   :group 'ggtags)
 244
 245 (defvar ggtags-bug-url "https://github.com/leoliu/ggtags/issues")
 246
 247 (defvar ggtags-global-last-buffer nil)
 248
 249 (defvar ggtags-current-tag-name nil)
 250
 251 (defvar ggtags-highlight-tag-overlay nil)
 252
 253 (defvar ggtags-highlight-tag-timer nil)
 254
 255 ;; Used by ggtags-global-mode
 256 (defvar ggtags-global-error "match"
 257   "Stem of message to print when no matches are found.")
 258
 259 (defmacro ggtags-ensure-global-buffer (&rest body)
 260   (declare (indent 0))
 261   `(progn
 262      (or (and (buffer-live-p ggtags-global-last-buffer)
 263               (with-current-buffer ggtags-global-last-buffer
 264                 (derived-mode-p 'ggtags-global-mode)))
 265          (error "No global buffer found"))
 266      (with-current-buffer ggtags-global-last-buffer ,@body)))
 267
 268 (defun ggtags-list-of-string-p (xs)
 269   "Return non-nil if XS is a list of strings."
 270   (if (null xs)
 271       t
 272     (and (stringp (car xs))
 273          (ggtags-list-of-string-p (cdr xs)))))
 274
 275 (defun ggtags-process-string (program &rest args)
 276   (with-temp-buffer
 277     (let ((exit (apply #'process-file program nil t nil args))
 278           (output (progn
 279                     (goto-char (point-max))
 280                     (skip-chars-backward " \t\n")
 281                     (buffer-substring (point-min) (point)))))
 282       (or (zerop exit)
 283           (error "`%s' non-zero exit: %s" program output))
 284       output)))
 285
 286 (defun ggtags-tag-at-point ()
 287   (pcase (funcall ggtags-bounds-of-tag-function)
 288     (`(,beg . ,end) (buffer-substring beg end))))
 289
 290 ;;; Store for project info and settings
 291
 292 (defvar ggtags-projects (make-hash-table :size 7 :test #'equal))
 293
 294 (cl-defstruct (ggtags-project (:constructor ggtags-project--make)
 295                               (:copier nil)
 296                               (:type vector)
 297                               :named)
 298   root tag-size has-refs has-path-style has-color dirty-p mtime timestamp)
 299
 300 (defun ggtags-make-project (root)
 301   (cl-check-type root string)
 302   (pcase (nthcdr 5 (file-attributes (expand-file-name "GTAGS" root)))
 303     (`(,mtime ,_ ,tag-size . ,_)
 304      (let* ((default-directory (file-name-as-directory root))
 305             (rtags-size (nth 7 (file-attributes "GRTAGS")))
 306             (has-refs
 307              (when rtags-size
 308                (and (or (> rtags-size (* 32 1024))
 309                         (with-demoted-errors
 310                           (not (equal "" (ggtags-process-string "global" "-crs")))))
 311                     'has-refs)))
 312             ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1518
 313             (has-path-style
 314              (with-demoted-errors       ; in case `global' not found
 315                (and (zerop (process-file "global" nil nil nil
 316                                          "--path-style" "shorter" "--help"))
 317                     'has-path-style)))
 318             ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1542
 319             (has-color
 320              (with-demoted-errors
 321                (and (zerop (process-file "global" nil nil nil "--color" "--help"))
 322                     'has-color))))
 323        (puthash default-directory
 324                 (ggtags-project--make :root default-directory
 325                                       :tag-size tag-size
 326                                       :has-refs has-refs
 327                                       :has-path-style has-path-style
 328                                       :has-color has-color
 329                                       :mtime (float-time mtime)
 330                                       :timestamp (float-time))
 331                 ggtags-projects)))))
 332
 333 (defun ggtags-project-expired-p (project)
 334   (or (< (ggtags-project-timestamp project) 0)
 335       (> (- (float-time)
 336             (ggtags-project-timestamp project))
 337          ggtags-project-duration)))
 338
 339 (defun ggtags-project-update-mtime-maybe (&optional project)
 340   "Update PROJECT's modtime and if current file is newer.
 341 Value is new modtime if updated."
 342   (let ((project (or project (ggtags-find-project))))
 343     (when (and (ggtags-project-p project)
 344                (consp (visited-file-modtime))
 345                (> (float-time (visited-file-modtime))
 346                   (ggtags-project-mtime project)))
 347       (setf (ggtags-project-dirty-p project) t)
 348       (setf (ggtags-project-mtime project)
 349             (float-time (visited-file-modtime))))))
 350
 351 (defun ggtags-project-oversize-p (&optional project)
 352   (pcase ggtags-oversize-limit
 353     (`nil nil)
 354     (`t t)
 355     (size (let ((project (or project (ggtags-find-project))))
 356             (and project (> (ggtags-project-tag-size project) size))))))
 357
 358 (defvar-local ggtags-project-root 'unset
 359   "Internal variable for project root directory.")
 360
 361 ;;;###autoload
 362 (defun ggtags-find-project ()
 363   (let ((project (gethash ggtags-project-root ggtags-projects)))
 364     (if (ggtags-project-p project)
 365         (if (ggtags-project-expired-p project)
 366             (progn
 367               (remhash ggtags-project-root ggtags-projects)
 368               (ggtags-find-project))
 369           project)
 370       (setq ggtags-project-root
 371             (or (ignore-errors (file-name-as-directory
 372                                 (concat (file-remote-p default-directory)
 373                                         ;; Resolves symbolic links
 374                                         (ggtags-process-string "global" "-pr"))))
 375                 ;; 'global -pr' resolves symlinks before checking the
 376                 ;; GTAGS file which could cause issues such as
 377                 ;; https://github.com/leoliu/ggtags/issues/22, so
 378                 ;; let's help it out.
 379                 ;;
 380                 ;; Note: `locate-dominating-file' doesn't accept
 381                 ;; function for NAME before 24.3.
 382                 (let ((gtags (locate-dominating-file default-directory "GTAGS")))
 383                   ;; `file-truename' may strip the trailing '/' on
 384                   ;; remote hosts, see http://debbugs.gnu.org/16851
 385                   (and gtags (file-regular-p gtags)
 386                        (file-name-as-directory (file-truename gtags))))))
 387       (when ggtags-project-root
 388         (if (gethash ggtags-project-root ggtags-projects)
 389             (ggtags-find-project)
 390           (ggtags-make-project ggtags-project-root))))))
 391
 392 (defun ggtags-current-project-root ()
 393   (and (ggtags-find-project)
 394        (ggtags-project-root (ggtags-find-project))))
 395
 396 (defun ggtags-check-project ()
 397   (or (ggtags-find-project) (error "File GTAGS not found")))
 398
 399 (defun ggtags-ensure-project ()
 400   (or (ggtags-find-project)
 401       (when (or (yes-or-no-p "File GTAGS not found; run gtags? ")
 402                 (user-error "Aborted"))
 403         (call-interactively #'ggtags-create-tags)
 404         ;; Need checking because `ggtags-create-tags' can create tags
 405         ;; in any directory.
 406         (ggtags-check-project))))
 407
 408 (defvar delete-trailing-lines)          ;new in 24.3
 409
 410 (defun ggtags-save-project-settings (&optional noconfirm)
 411   "Save Gnu Global's specific environment variables."
 412   (interactive "P")
 413   (ggtags-check-project)
 414   (let* ((inhibit-read-only t)          ; for `add-dir-local-variable'
 415          (default-directory (ggtags-current-project-root))
 416          ;; Not using `ggtags-with-current-project' to preserve
 417          ;; environment variables that may be present in
 418          ;; `ggtags-process-environment'.
 419          (process-environment
 420           (append ggtags-process-environment
 421                   process-environment
 422                   (and (not (ggtags-project-has-refs (ggtags-find-project)))
 423                        (list "GTAGSLABEL=ctags"))))
 424          (envlist (delete-dups
 425                    (cl-loop for x in process-environment
 426                             when (string-match
 427                                   "^\\(GTAGS[^=\n]*\\|MAKEOBJDIRPREFIX\\)=" x)
 428                             ;; May have duplicates thus `delete-dups'.
 429                             collect (concat (match-string 1 x)
 430                                             "="
 431                                             (getenv (match-string 1 x))))))
 432          (help-form (format "y: save\nn: don't save\n=: diff\n?: help\n")))
 433     (add-dir-local-variable nil 'ggtags-process-environment envlist)
 434     ;; Remove trailing newlines by `add-dir-local-variable'.
 435     (let ((delete-trailing-lines t)) (delete-trailing-whitespace))
 436     (or noconfirm
 437         (while (pcase (read-char-choice
 438                        (format "Save `%s'? (y/n/=/?) " buffer-file-name)
 439                        '(?y ?n ?= ??))
 440                  ;; ` required for 24.1 and 24.2
 441                  (`?n (user-error "Aborted"))
 442                  (`?y nil)
 443                  (`?= (diff-buffer-with-file) 'loop)
 444                  (`?? (help-form-show) 'loop))))
 445     (save-buffer)
 446     (kill-buffer)))
 447
 448 (defun ggtags-toggle-project-read-only ()
 449   (interactive)
 450   (ggtags-check-project)
 451   (let ((inhibit-read-only t)           ; for `add-dir-local-variable'
 452         (val (not buffer-read-only))
 453         (default-directory (ggtags-current-project-root)))
 454     (add-dir-local-variable nil 'buffer-read-only val)
 455     (save-buffer)
 456     (kill-buffer)
 457     (when buffer-file-name
 458       (setq buffer-read-only val))
 459     (when (called-interactively-p 'interactive)
 460       (message "Project read-only-mode is %s" (if val "on" "off")))
 461     val))
 462
 463 (defun ggtags-visit-project-root ()
 464   (interactive)
 465   (ggtags-ensure-project)
 466   (dired (ggtags-current-project-root)))
 467
 468 (defmacro ggtags-with-current-project (&rest body)
 469   "Eval BODY in current project's `process-environment'."
 470   (declare (debug t))
 471   (let ((gtagsroot (make-symbol "-gtagsroot-"))
 472         (root (make-symbol "-ggtags-project-root-")))
 473     `(let* ((,root ggtags-project-root)
 474             (,gtagsroot (when (ggtags-find-project)
 475                           (directory-file-name (ggtags-current-project-root))))
 476             (process-environment
 477              (append (let ((process-environment process-environment))
 478                        (and ,gtagsroot (setenv "GTAGSROOT" ,gtagsroot))
 479                        (mapcar #'substitute-env-vars ggtags-process-environment))
 480                      process-environment
 481                      (and ,gtagsroot (list (concat "GTAGSROOT=" ,gtagsroot)))
 482                      (and (ggtags-find-project)
 483                           (not (ggtags-project-has-refs (ggtags-find-project)))
 484                           (list "GTAGSLABEL=ctags")))))
 485        (unwind-protect (save-current-buffer ,@body)
 486          (setq ggtags-project-root ,root)))))
 487
 488 (defun ggtags-get-libpath ()
 489   (let ((path (ggtags-with-current-project (getenv "GTAGSLIBPATH"))))
 490     (and path (mapcar (apply-partially #'concat (file-remote-p default-directory))
 491                       (split-string path (regexp-quote path-separator) t)))))
 492
 493 (defun ggtags-create-tags (root)
 494   "Create tag files (e.g. GTAGS) in directory ROOT.
 495 If file gtags.files exists in ROOT, it should be a list of source
 496 files to index, which can be used to speed gtags up in large
 497 source trees. See Info node `(global)gtags' for details."
 498   (interactive "DRoot directory: ")
 499   (let ((process-environment process-environment))
 500     (when (zerop (length root)) (error "No root directory provided"))
 501     (setenv "GTAGSROOT" (expand-file-name
 502                          (directory-file-name (file-name-as-directory root))))
 503     (ggtags-with-current-project
 504      (let ((conf (and ggtags-use-project-gtagsconf
 505                       (cl-loop for name in '(".globalrc" "gtags.conf")
 506                                for full = (expand-file-name name root)
 507                                thereis (and (file-exists-p full) full)))))
 508        (cond (conf (setenv "GTAGSCONF" conf))
 509              ((and (not (getenv "GTAGSLABEL"))
 510                    (yes-or-no-p "Use `ctags' backend? "))
 511               (setenv "GTAGSLABEL" "ctags"))))
 512      (with-temp-message "`gtags' in progress..."
 513        (let ((default-directory (file-name-as-directory root)))
 514          (condition-case err
 515              (apply #'ggtags-process-string
 516                     "gtags" (and ggtags-use-idutils '("--idutils")))
 517            (error (if (and ggtags-use-idutils
 518                            (stringp (cadr err))
 519                            (string-match-p "mkid not found" (cadr err)))
 520                       ;; Retry without mkid
 521                       (ggtags-process-string "gtags")
 522                     (signal (car err) (cdr err))))))))
 523     (message "GTAGS generated in `%s'" root)
 524     root))
 525
 526 (defun ggtags-update-tags (&optional force)
 527   "Update GNU Global tag database.
 528 Do nothing if GTAGS exceeds the oversize limit unless FORCE is
 529 non-nil."
 530   (interactive (progn
 531                  (ggtags-check-project)
 532                  ;; Mark project info expired.
 533                  (setf (ggtags-project-timestamp (ggtags-find-project)) -1)
 534                  (list t)))
 535   (when (or force (and (ggtags-find-project)
 536                        (not (ggtags-project-oversize-p))
 537                        (ggtags-project-dirty-p (ggtags-find-project))))
 538     (ggtags-with-current-project
 539      (with-temp-message "`global -u' in progress..."
 540        (ggtags-process-string "global" "-u")
 541        (setf (ggtags-project-dirty-p (ggtags-find-project)) nil)
 542        (setf (ggtags-project-mtime (ggtags-find-project)) (float-time))))))
 543
 544 (defvar-local ggtags-completion-cache nil)
 545
 546 ;; See global/libutil/char.c
 547 ;; (defconst ggtags-regexp-metachars "[][$()*+.?\\{}|^]")
 548 (defvar ggtags-completion-flag "")      ;internal use
 549
 550 (defvar ggtags-completion-table
 551   (completion-table-dynamic
 552    (lambda (prefix)
 553      (let ((cache-key (concat prefix "$" ggtags-completion-flag)))
 554        (unless (equal cache-key (car ggtags-completion-cache))
 555          (setq ggtags-completion-cache
 556                (cons cache-key
 557                      (condition-case-unless-debug nil
 558                          ;; May throw global: only name char is
 559                          ;; allowed with -c option.
 560                          (ggtags-with-current-project
 561                           (split-string
 562                            (apply #'ggtags-process-string
 563                                   "global"
 564                                   (append (and completion-ignore-case '("--ignore-case"))
 565                                           ;; Note -c alone returns only definitions
 566                                           (list (concat "-c" ggtags-completion-flag) prefix)))
 567                            "\n" t))
 568                        (error nil))))))
 569      (cdr ggtags-completion-cache))))
 570
 571 (defun ggtags-completion-at-point ()
 572   "A function for `completion-at-point-functions'."
 573   (pcase (funcall ggtags-bounds-of-tag-function)
 574     (`(,beg . ,end)
 575      (and (< beg end) (list beg end ggtags-completion-table)))))
 576
 577 (defun ggtags-read-tag (&optional type confirm prompt require-match default)
 578   (ggtags-ensure-project)
 579   (let ((default (or default (ggtags-tag-at-point)))
 580         (completing-read-function ggtags-completing-read-function)
 581         (prompt (or prompt (capitalize (symbol-name (or type 'tag)))))
 582         (ggtags-completion-flag (pcase type
 583                                   (`(or nil definition) "T")
 584                                   (`symbol "s")
 585                                   (`reference "r")
 586                                   (`id "I")
 587                                   (`path "P")
 588                                   ((pred stringp) type)
 589                                   (_ ggtags-completion-flag))))
 590     (setq ggtags-current-tag-name
 591           (cond (confirm
 592                  (ggtags-update-tags)
 593                  (completing-read
 594                   (format (if default "%s (default %s): " "%s: ") prompt default)
 595                   ggtags-completion-table nil require-match nil nil default))
 596                 ((not default)
 597                  (user-error "No tag at point"))
 598                 (t (substring-no-properties default))))))
 599
 600 (defun ggtags-global-build-command (cmd &rest args)
 601   ;; CMD can be definition, reference, symbol, grep, idutils
 602   (let ((xs (append (list "global" "-v"
 603                           (format "--result=%s" ggtags-global-output-format)
 604                           (and ggtags-global-ignore-case "--ignore-case")
 605                           (and (ggtags-find-project)
 606                                (ggtags-project-has-color (ggtags-find-project))
 607                                "--color=always")
 608                           (and (ggtags-find-project)
 609                                (ggtags-project-has-path-style (ggtags-find-project))
 610                                "--path-style=shorter")
 611                           (and ggtags-global-treat-text "--other")
 612                           (pcase cmd
 613                             ((pred stringp) cmd)
 614                             (`definition "") ;-d not supported by Global 5.7.1
 615                             (`reference "-r")
 616                             (`symbol "-s")
 617                             (`path "--path")
 618                             (`grep "--grep")
 619                             (`idutils "--idutils")))
 620                     args)))
 621     (mapconcat #'identity (delq nil xs) " ")))
 622
 623 ;; takes three values: nil, t and a marker
 624 (defvar ggtags-global-start-marker nil)
 625
 626 (defvar ggtags-global-exit-status 0)
 627 (defvar ggtags-global-match-count 0)
 628
 629 (defvar ggtags-tag-ring-index nil)
 630
 631 (defun ggtags-global-save-start-marker ()
 632   (when (markerp ggtags-global-start-marker)
 633     (setq ggtags-tag-ring-index nil)
 634     (ring-insert find-tag-marker-ring ggtags-global-start-marker)
 635     (setq ggtags-global-start-marker t)))
 636
 637 (defun ggtags-global-start (command &optional root)
 638   (let* ((default-directory (or root (ggtags-current-project-root)))
 639          (split-window-preferred-function ggtags-split-window-function)
 640          ;; See http://debbugs.gnu.org/13594
 641          (display-buffer-overriding-action
 642           (if (and ggtags-auto-jump-to-first-match
 643                    ;; Appeared in emacs 24.4.
 644                    (fboundp 'display-buffer-no-window))
 645               (list #'display-buffer-no-window)
 646             display-buffer-overriding-action)))
 647     (setq ggtags-global-start-marker (point-marker))
 648     (ggtags-navigation-mode +1)
 649     (setq ggtags-global-exit-status 0
 650           ggtags-global-match-count 0)
 651     (ggtags-update-tags)
 652     (ggtags-with-current-project
 653      (setq ggtags-global-last-buffer
 654            (compilation-start command 'ggtags-global-mode)))))
 655
 656 (defun ggtags-find-tag-continue ()
 657   (interactive)
 658   (ggtags-ensure-global-buffer
 659     (ggtags-navigation-mode +1)
 660     (let ((split-window-preferred-function ggtags-split-window-function))
 661       (ignore-errors (compilation-next-error 1))
 662       (compile-goto-error))))
 663
 664 (defun ggtags-find-tag (cmd &rest args)
 665   (ggtags-check-project)
 666   (ggtags-global-start (apply #'ggtags-global-build-command cmd args)))
 667
 668 ;;;###autoload
 669 (defun ggtags-find-tag-dwim (name &optional definition)
 670   "Find definitions or references of tag NAME by context.
 671 If point is at a definition tag, find references, and vice versa.
 672 With a prefix arg (non-nil DEFINITION) always find definitions."
 673   (interactive (list (ggtags-read-tag 'definition current-prefix-arg)
 674                      current-prefix-arg))
 675   (ggtags-check-project)     ; for `ggtags-current-project-root' below
 676   (if (or definition
 677           (not buffer-file-name)
 678           (and (ggtags-find-project)
 679                (not (ggtags-project-has-refs (ggtags-find-project)))))
 680       (ggtags-find-tag 'definition name)
 681     (ggtags-find-tag
 682      (format "--from-here=%d:%s"
 683              (line-number-at-pos)
 684              (shell-quote-argument
 685               ;; Note `ggtags-global-start' binds default-directory to
 686               ;; project root.
 687               (file-relative-name
 688                buffer-file-name
 689                (if (string-prefix-p (ggtags-current-project-root)
 690                                     buffer-file-name)
 691                    (ggtags-current-project-root)
 692                  (locate-dominating-file buffer-file-name "GTAGS")))))
 693      name)))
 694
 695 (defun ggtags-find-reference (name)
 696   (interactive (list (ggtags-read-tag 'reference current-prefix-arg)))
 697   (ggtags-find-tag 'reference name))
 698
 699 (defun ggtags-find-other-symbol (name)
 700   "Find tag NAME that is a reference without a definition."
 701   (interactive (list (ggtags-read-tag 'symbol current-prefix-arg)))
 702   (ggtags-find-tag 'symbol name))
 703
 704 (defun ggtags-quote-pattern (pattern)
 705   (prin1-to-string (substring-no-properties pattern)))
 706
 707 (defun ggtags-idutils-query (pattern)
 708   (interactive (list (ggtags-read-tag 'id t)))
 709   (ggtags-find-tag 'idutils "--" (ggtags-quote-pattern pattern)))
 710
 711 (defun ggtags-grep (pattern &optional invert-match)
 712   "Use `global --grep' to search for lines matching PATTERN.
 713 Invert the match when called with a prefix arg \\[universal-argument]."
 714   (interactive (list (ggtags-read-tag 'definition 'confirm
 715                                       (if current-prefix-arg
 716                                           "Inverted grep pattern" "Grep pattern"))
 717                      current-prefix-arg))
 718   (ggtags-find-tag 'grep (and invert-match "--invert-match")
 719                    "--" (ggtags-quote-pattern pattern)))
 720
 721 (defun ggtags-find-file (pattern &optional invert-match)
 722   (interactive (list (ggtags-read-tag 'path 'confirm (if current-prefix-arg
 723                                                          "Inverted path pattern"
 724                                                        "Path pattern")
 725                                       nil (thing-at-point 'filename))
 726                      current-prefix-arg))
 727   (let ((ggtags-global-output-format 'path))
 728     (ggtags-find-tag 'path (and invert-match "--invert-match")
 729                      "--" (ggtags-quote-pattern pattern))))
 730
 731 ;; NOTE: Coloured output in grep requested: http://goo.gl/Y9IcX
 732 (defun ggtags-find-tag-regexp (regexp directory)
 733   "List tags matching REGEXP in DIRECTORY (default to project root)."
 734   (interactive
 735    (progn
 736      (ggtags-check-project)
 737      (list (ggtags-read-tag "" t "POSIX regexp")
 738            (if current-prefix-arg
 739                (read-directory-name "Directory: " nil nil t)
 740              (ggtags-current-project-root)))))
 741   (ggtags-check-project)
 742   (ggtags-global-start
 743    (ggtags-global-build-command nil nil "-l" "--" (ggtags-quote-pattern regexp))
 744    (file-name-as-directory directory)))
 745
 746 (defun ggtags-query-replace (from to &optional delimited)
 747   "Query replace FROM with TO on files in the Global buffer.
 748 If not in navigation mode, do a grep on FROM first.
 749
 750 Note: the regular expression FROM must be supported by both
 751 Global and Emacs."
 752   (interactive
 753    ;; Note: in 24.4 query-replace-read-args returns a list of 4 elements.
 754    (let ((args (query-replace-read-args "Query replace (regexp)" t t)))
 755      (list (nth 0 args) (nth 1 args) (nth 2 args))))
 756   (unless (bound-and-true-p ggtags-navigation-mode)
 757     (let ((ggtags-auto-jump-to-first-match nil))
 758       (ggtags-grep from)))
 759   (let ((file-form
 760          '(let ((files))
 761             (ggtags-ensure-global-buffer
 762               (with-temp-message "Waiting for Grep to finish..."
 763                 (while (get-buffer-process (current-buffer))
 764                   (sit-for 0.2)))
 765               (goto-char (point-min))
 766               (while (ignore-errors (compilation-next-file 1) t)
 767                 (let ((m (get-text-property (point) 'compilation-message)))
 768                   (push (expand-file-name
 769                          (caar (compilation--loc->file-struct
 770                                 (compilation--message->loc m))))
 771                         files))))
 772             (ggtags-navigation-mode -1)
 773             (nreverse files))))
 774     (tags-query-replace from to delimited file-form)))
 775
 776 (defun ggtags-delete-tag-files ()
 777   "Delete the tag files generated by gtags."
 778   (interactive (ignore (ggtags-check-project)))
 779   (when (ggtags-current-project-root)
 780     (let* ((re (concat "\\`" (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID")) "\\'"))
 781            (files (cl-remove-if-not
 782                    (lambda (file)
 783                      ;; Don't trust `directory-files'.
 784                      (let ((case-fold-search nil))
 785                        (string-match-p re (file-name-nondirectory file))))
 786                    (directory-files (ggtags-current-project-root) t re)))
 787            (buffer "*GTags File List*"))
 788       (or files (user-error "No tag files found"))
 789       (with-output-to-temp-buffer buffer
 790         (princ (mapconcat #'identity files "\n")))
 791       (let ((win (get-buffer-window buffer)))
 792         (unwind-protect
 793             (progn
 794               (fit-window-to-buffer win)
 795               (when (yes-or-no-p "Remove GNU Global tag files? ")
 796                 (with-demoted-errors (mapc #'delete-file files))
 797                 (remhash (ggtags-current-project-root) ggtags-projects)
 798                 (and (overlayp ggtags-highlight-tag-overlay)
 799                      (delete-overlay ggtags-highlight-tag-overlay))))
 800           (when (window-live-p win)
 801             (quit-window t win)))))))
 802
 803 (defun ggtags-browse-file-as-hypertext (file line)
 804   "Browse FILE in hypertext (HTML) form."
 805   (interactive (if (or current-prefix-arg (not buffer-file-name))
 806                    (list (read-file-name "Browse file: " nil nil t)
 807                          (read-number "Line: " 1))
 808                  (list buffer-file-name (line-number-at-pos))))
 809   (cl-check-type line integer)
 810   (or (and file (file-exists-p file)) (error "File `%s' doesn't exist" file))
 811   (ggtags-check-project)
 812   (or (file-exists-p (expand-file-name "HTML" (ggtags-current-project-root)))
 813       (if (yes-or-no-p "No hypertext form exists; run htags? ")
 814           (let ((default-directory (ggtags-current-project-root)))
 815             (ggtags-with-current-project (ggtags-process-string "htags")))
 816         (user-error "Aborted")))
 817   (let ((url (ggtags-process-string "gozilla" "-p" (format "+%d" line)
 818                                     (file-relative-name file))))
 819     (or (equal (file-name-extension
 820                 (url-filename (url-generic-parse-url url))) "html")
 821         (user-error "No hypertext form for `%s'" file))
 822     (when (called-interactively-p 'interactive)
 823       (message "Browsing %s" url))
 824     (browse-url url)))
 825
 826 (defun ggtags-next-mark (&optional arg)
 827   "Move to the next (newer) mark in the tag marker ring."
 828   (interactive)
 829   (and (ring-empty-p find-tag-marker-ring) (user-error "Tag ring empty"))
 830   (setq ggtags-tag-ring-index
 831         ;; Note `ring-minus1' gets newer item.
 832         (funcall (if arg #'ring-plus1 #'ring-minus1)
 833                  (or ggtags-tag-ring-index
 834                      (progn
 835                        (ring-insert find-tag-marker-ring (point-marker))
 836                        0))
 837                  (ring-length find-tag-marker-ring)))
 838   (let ((m (ring-ref find-tag-marker-ring ggtags-tag-ring-index))
 839         (i (- (ring-length find-tag-marker-ring) ggtags-tag-ring-index))
 840         (message-log-max nil))
 841     (message "%d%s marker%s" i (pcase (mod i 10)
 842                                  ;; ` required for 24.1 and 24.2
 843                                  (`1 "st")
 844                                  (`2 "nd")
 845                                  (`3 "rd")
 846                                  (_ "th"))
 847              (if (marker-buffer m) "" " (dead)"))
 848     (if (not (marker-buffer m))
 849         (ding)
 850       (switch-to-buffer (marker-buffer m))
 851       (goto-char m))))
 852
 853 (defun ggtags-prev-mark ()
 854   "Move to the previous (older) mark in the tag marker ring."
 855   (interactive)
 856   (ggtags-next-mark 'previous))
 857
 858 (defun ggtags-view-tag-history ()
 859   (interactive)
 860   (and (ring-empty-p find-tag-marker-ring)
 861        (user-error "Tag ring empty"))
 862   (let ((split-window-preferred-function ggtags-split-window-function)
 863         (inhibit-read-only t))
 864     (pop-to-buffer "*Tag Ring*")
 865     (erase-buffer)
 866     (tabulated-list-mode)
 867     (setq tabulated-list-entries
 868           ;; Use a function so that revert can work properly.
 869           (lambda ()
 870             (let ((counter (ring-length find-tag-marker-ring))
 871                   (elements (or (ring-elements find-tag-marker-ring)
 872                                 (user-error "Tag ring empty")))
 873                   (action
 874                    (lambda (button) (interactive)
 875                      (let ((m (button-get button 'marker)))
 876                        (or (markerp m) (user-error "Marker dead"))
 877                        (setq ggtags-tag-ring-index
 878                              (ring-member find-tag-marker-ring m))
 879                        (pop-to-buffer (marker-buffer m))
 880                        (goto-char (marker-position m)))))
 881                   (get-line
 882                    (lambda (m)
 883                      (with-current-buffer (marker-buffer m)
 884                        (save-excursion
 885                          (goto-char m)
 886                          (buffer-substring (line-beginning-position)
 887                                            (line-end-position)))))))
 888               (setq tabulated-list-format
 889                     `[("ID" ,(max (1+ (floor (log counter 10))) 2)
 890                        (lambda (x y) (< (car x) (car y))))
 891                       ("Buffer" ,(max (cl-loop for m in elements
 892                                                for b = (marker-buffer m)
 893                                                maximize
 894                                                (length (and b (buffer-name b))))
 895                                       6)
 896                        t :right-align t)
 897                       ("Position" ,(max (cl-loop for m in elements
 898                                                  for p = (or (marker-position m) 1)
 899                                                  maximize (1+ (floor (log p 10))))
 900                                         8)
 901                        (lambda (x y)
 902                          (< (string-to-number (aref (cadr x) 2))
 903                             (string-to-number (aref (cadr y) 2))))
 904                        :right-align t)
 905                       ("Contents" 100 t)])
 906               (tabulated-list-init-header)
 907               (mapcar (lambda (x)
 908                         (prog1
 909                             (list counter
 910                                   (if (marker-buffer x)
 911                                       (vector (number-to-string counter)
 912                                               `(,(buffer-name (marker-buffer x))
 913                                                 face link
 914                                                 follow-link t
 915                                                 marker ,x
 916                                                 action ,action)
 917                                               (number-to-string (marker-position x))
 918                                               (funcall get-line x))
 919                                     (vector (number-to-string counter)
 920                                             "(dead)" "?" "?")))
 921                           (cl-decf counter)))
 922                       elements))))
 923     (setq tabulated-list-sort-key '("ID" . t))
 924     (tabulated-list-print)
 925     (fit-window-to-buffer)))
 926
 927 (defun ggtags-global-exit-message-function (_process-status exit-status msg)
 928   (setq ggtags-global-exit-status exit-status)
 929   (pcase-let ((`(,count . ,db)
 930                (save-excursion
 931                  (goto-char (point-max))
 932                  (if (re-search-backward
 933                       "^\\w+ \\(not found\\)\\|^\\([0-9]+\\) \\w+ located" nil t)
 934                      (cons (or (and (match-string 1) 0)
 935                                (string-to-number (match-string 2)))
 936                            (when (re-search-forward
 937                                   "using \\(?:\\(idutils\\)\\|'[^']*/\\(\\w+\\)'\\)"
 938                                   (line-end-position)
 939                                   t)
 940                              (or (and (match-string 1) "ID")
 941                                  (match-string 2))))
 942                    (cons 0 nil)))))
 943     (setq ggtags-global-match-count count)
 944     ;; Clear the start marker in case of zero matches.
 945     (and (zerop count)
 946          (markerp ggtags-global-start-marker)
 947          (setq ggtags-global-start-marker nil))
 948     (cons (if (> exit-status 0)
 949               msg
 950             (format "found %d %s"
 951                     count
 952                     (funcall (if (= count 1) #'car #'cadr)
 953                              (pcase db
 954                                ;; ` required for 24.1 and 24.2
 955                                (`"GTAGS"  '("definition" "definitions"))
 956                                (`"GSYMS"  '("symbol"     "symbols"))
 957                                (`"GRTAGS" '("reference"  "references"))
 958                                (`"GPATH"  '("file"       "files"))
 959                                (`"ID"     '("identifier" "identifiers"))
 960                                (_         '("match"      "matches"))))))
 961           exit-status)))
 962
 963 (defun ggtags-global-column (start)
 964   ;; START is the beginning position of source text.
 965   (let ((mbeg (text-property-any start (line-end-position) 'global-color t)))
 966     (and mbeg (- mbeg start))))
 967
 968 ;;; NOTE: Must not match the 'Global started at Mon Jun 3 10:24:13'
 969 ;;; line or `compilation-auto-jump' will jump there and fail. See
 970 ;;; comments before the 'gnu' entry in
 971 ;;; `compilation-error-regexp-alist-alist'.
 972 (defvar ggtags-global-error-regexp-alist-alist
 973   (append
 974    `((path "^\\(?:[^\"'\n]*/\\)?[^ )\t\n]+$" 0)
 975      ;; ACTIVE_ESCAPE   src/dialog.cc   172
 976      (ctags "^\\([^ \t\n]+\\)[ \t]+\\(.*?\\)[ \t]+\\([0-9]+\\)$"
 977             2 3 nil nil 2 (1 font-lock-function-name-face))
 978      ;; ACTIVE_ESCAPE     172 src/dialog.cc    #undef ACTIVE_ESCAPE
 979      (ctags-x "^\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(\\(?:[^/\n]*/\\)?[^ \t\n]+\\)"
 980               3 2 (,(lambda () (ggtags-global-column (1+ (match-end 0)))))
 981               nil 3 (1 font-lock-function-name-face))
 982      ;; src/dialog.cc:172:#undef ACTIVE_ESCAPE
 983      (grep "^\\(.+?\\):\\([0-9]+\\):\\(?:$\\|[^0-9\n]\\|[0-9][^0-9\n]\\|[0-9][0-9].\\)"
 984            1 2 (,(lambda () (ggtags-global-column (1+ (match-end 2))))) nil 1)
 985      ;; src/dialog.cc ACTIVE_ESCAPE 172 #undef ACTIVE_ESCAPE
 986      (cscope "^\\(.+?\\)[ \t]+\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\).*\\(?:[^0-9\n]\\|[^0-9\n][0-9]\\|[^:\n][0-9][0-9]\\)$"
 987              1 3 nil nil 1 (2 font-lock-function-name-face)))
 988    compilation-error-regexp-alist-alist))
 989
 990 (defun ggtags-abbreviate-file (start end)
 991   (let ((inhibit-read-only t)
 992         (amount (if (numberp ggtags-global-abbreviate-filename)
 993                     (- (- end start) ggtags-global-abbreviate-filename)
 994                   999))
 995         (advance-word (lambda ()
 996                         "Return the length of the text made invisible."
 997                         (let ((wend (min end (progn (forward-word 1) (point))))
 998                               (wbeg (max start (progn (backward-word 1) (point)))))
 999                           (goto-char wend)
1000                           (if (<= (- wend wbeg) 1)
1001                               0
1002                             (put-text-property (1+ wbeg) wend 'invisible t)
1003                             (1- (- wend wbeg)))))))
1004     (goto-char start)
1005     (while (and (> amount 0) (> end (point)))
1006       (cl-decf amount (funcall advance-word)))))
1007
1008 (defun ggtags-abbreviate-files (start end)
1009   (goto-char start)
1010   (let* ((error-re (cdr (assq ggtags-global-output-format
1011                               ggtags-global-error-regexp-alist-alist)))
1012          (sub (cadr error-re)))
1013     (when (and ggtags-global-abbreviate-filename error-re)
1014       (while (re-search-forward (car error-re) end t)
1015         (when (and (or (not (numberp ggtags-global-abbreviate-filename))
1016                        (> (length (match-string sub))
1017                           ggtags-global-abbreviate-filename))
1018                    ;; Ignore bogus file lines such as:
1019                    ;;     Global found 2 matches at Thu Jan 31 13:45:19
1020                    (get-text-property (match-beginning sub) 'compilation-message))
1021           (ggtags-abbreviate-file (match-beginning sub) (match-end sub)))))))
1022
1023 (defvar-local ggtags-global-output-lines 0)
1024
1025 (defun ggtags-global--display-buffer (&optional buffer)
1026   (let ((buffer (or buffer (current-buffer))))
1027     (unless (get-buffer-window buffer)
1028       (let* ((split-window-preferred-function ggtags-split-window-function)
1029              (w (display-buffer (current-buffer) '(nil (allow-no-window . t)))))
1030         (and w (compilation-set-window-height w))))))
1031
1032 (defvar ggtags-navigation-mode)
1033
1034 (defun ggtags-global-filter ()
1035   "Called from `compilation-filter-hook' (which see)."
1036   (let ((ansi-color-apply-face-function
1037          (lambda (beg end face)
1038            (when face
1039              (ansi-color-apply-overlay-face beg end face)
1040              (put-text-property beg end 'global-color t)))))
1041     (ansi-color-apply-on-region compilation-filter-start (point)))
1042   ;; Get rid of line "Using config file '/PATH/TO/.globalrc'." or
1043   ;; "Using default configuration."
1044   (when (re-search-backward
1045          "^ *Using \\(?:config file '.*\\|default configuration.\\)\n"
1046          compilation-filter-start t)
1047     (replace-match ""))
1048   (cl-incf ggtags-global-output-lines
1049            (count-lines compilation-filter-start (point)))
1050   (when (and (> ggtags-global-output-lines 5) (not ggtags-navigation-mode))
1051     (ggtags-global--display-buffer))
1052   (make-local-variable 'ggtags-global-large-output)
1053   (when (> ggtags-global-output-lines ggtags-global-large-output)
1054     (cl-incf ggtags-global-large-output 500)
1055     (let ((message-log-max nil))
1056       (message "Output %d lines (Type `C-c C-k' to cancel)"
1057                ggtags-global-output-lines))))
1058
1059 (defun ggtags-handle-single-match (buf _how)
1060   (if (not (zerop ggtags-global-exit-status))
1061       ;; If exit abnormally display the buffer for inspection.
1062       (ggtags-global--display-buffer)
1063     (when (and ggtags-auto-jump-to-first-match
1064                (save-excursion
1065                  (goto-char (point-min))
1066                  (not (ignore-errors
1067                         (goto-char (compilation-next-single-property-change
1068                                     (point) 'compilation-message))
1069                         (end-of-line)
1070                         (compilation-next-single-property-change
1071                          (point) 'compilation-message)))))
1072       ;; For the `compilation-auto-jump' in idle timer to run. See also:
1073       ;; http://debbugs.gnu.org/13829
1074       (sit-for 0)
1075       (ggtags-navigation-mode -1)
1076       (ggtags-navigation-mode-cleanup buf 0))))
1077
1078 (defvar ggtags-global-mode-font-lock-keywords
1079   '(("^Global \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
1080      (1 'compilation-error)
1081      (2 'compilation-error nil t))
1082     ("^Global found \\([0-9]+\\)" (1 compilation-info-face))))
1083
1084 (defvar compilation-always-kill)        ;new in 24.3
1085
1086 (define-compilation-mode ggtags-global-mode "Global"
1087   "A mode for showing outputs from gnu global."
1088   ;; Make it buffer local for `ggtags-abbreviate-files'.
1089   (make-local-variable 'ggtags-global-output-format)
1090   (setq-local compilation-error-regexp-alist
1091               (list ggtags-global-output-format))
1092   (setq-local compilation-auto-jump-to-first-error
1093               ggtags-auto-jump-to-first-match)
1094   (setq-local compilation-scroll-output 'first-error)
1095   ;; See `compilation-move-to-column' for details.
1096   (setq-local compilation-first-column 0)
1097   (setq-local compilation-error-screen-columns nil)
1098   (setq-local compilation-disable-input t)
1099   (setq-local compilation-always-kill t)
1100   (setq-local compilation-error-face 'compilation-info)
1101   (setq-local compilation-exit-message-function
1102               'ggtags-global-exit-message-function)
1103   ;; See: https://github.com/leoliu/ggtags/issues/26
1104   (setq-local find-file-suppress-same-file-warnings t)
1105   (setq-local truncate-lines t)
1106   (jit-lock-register #'ggtags-abbreviate-files)
1107   (add-hook 'compilation-filter-hook 'ggtags-global-filter nil 'local)
1108   (add-hook 'compilation-finish-functions 'ggtags-handle-single-match nil t)
1109   (add-hook 'kill-buffer-hook (lambda () (ggtags-navigation-mode -1)) nil t))
1110
1111 ;; NOTE: Need this to avoid putting menu items in
1112 ;; `emulation-mode-map-alists', which creates double entries. See
1113 ;; http://i.imgur.com/VJJTzVc.png
1114 (defvar ggtags-navigation-map
1115   (let ((map (make-sparse-keymap)))
1116     (define-key map "\M-n" 'next-error)
1117     (define-key map "\M-p" 'previous-error)
1118     (define-key map "\M-}" 'ggtags-navigation-next-file)
1119     (define-key map "\M-{" 'ggtags-navigation-previous-file)
1120     (define-key map "\M->" 'ggtags-navigation-last-error)
1121     (define-key map "\M-<" 'ggtags-navigation-first-error)
1122     (define-key map "\C-c\C-k"
1123       (lambda () (interactive)
1124         (ggtags-ensure-global-buffer (kill-compilation))))
1125     (define-key map "\M-o" 'ggtags-navigation-visible-mode)
1126     (define-key map [return] 'ggtags-navigation-mode-done)
1127     (define-key map "\r" 'ggtags-navigation-mode-done)
1128     (define-key map [remap pop-tag-mark] 'ggtags-navigation-mode-abort)
1129     map))
1130
1131 (defvar ggtags-mode-map-alist
1132   `((ggtags-navigation-mode . ,ggtags-navigation-map)))
1133
1134 ;; Higher priority for `ggtags-navigation-mode' to avoid being
1135 ;; hijacked by modes such as `view-mode'.
1136 (add-to-list 'emulation-mode-map-alists 'ggtags-mode-map-alist)
1137
1138 (defvar ggtags-navigation-mode-map
1139   (let ((map (make-sparse-keymap))
1140         (menu (make-sparse-keymap "GG-Navigation")))
1141     ;; Menu items: (info "(elisp)Extended Menu Items")
1142     (define-key map [menu-bar ggtags-navigation] (cons "GG-Navigation" menu))
1143     ;; Ordered backwards
1144     (define-key menu [visible-mode]
1145       '(menu-item "Visible mode" ggtags-navigation-visible-mode
1146                   :button (:toggle . (ignore-errors
1147                                        (ggtags-ensure-global-buffer
1148                                          visible-mode)))))
1149     (define-key menu [done]
1150       '(menu-item "Finish navigation" ggtags-navigation-mode-done))
1151     (define-key menu [abort]
1152       '(menu-item "Abort" ggtags-navigation-mode-abort))
1153     (define-key menu [last-error]
1154       '(menu-item "Last error" ggtags-navigation-last-error))
1155     (define-key menu [fist-error]
1156       '(menu-item "Fist error" ggtags-navigation-first-error))
1157     (define-key menu [previous-file]
1158       '(menu-item "Previous file" ggtags-navigation-previous-file))
1159     (define-key menu [next-file]
1160       '(menu-item "Next file" ggtags-navigation-next-file))
1161     (define-key menu [previous]
1162       '(menu-item "Previous match" previous-error))
1163     (define-key menu [next]
1164       '(menu-item "Next match" next-error))
1165     map))
1166
1167 (defun ggtags-move-to-tag (&optional name)
1168   "Move to NAME tag in current line."
1169   (let ((tag (or name ggtags-current-tag-name)))
1170     ;; Do nothing if on the tag already i.e. by `ggtags-global-column'.
1171     (unless (or (not tag) (looking-at (concat (regexp-quote tag) "\\_>")))
1172       (let ((orig (point))
1173             (regexps (mapcar (lambda (fmtstr)
1174                                (format fmtstr (regexp-quote tag)))
1175                              '("\\_<%s\\_>" "%s\\_>" "%s"))))
1176         (beginning-of-line)
1177         (if (cl-loop for re in regexps
1178                      ;; Note: tag might not agree with current
1179                      ;; major-mode's symbol, so try harder. For
1180                      ;; example, in `php-mode' $cacheBackend is a
1181                      ;; symbol, but cacheBackend is a tag.
1182                      thereis (re-search-forward re (line-end-position) t))
1183             (goto-char (match-beginning 0))
1184           (goto-char orig))))))
1185
1186 (defun ggtags-navigation-mode-cleanup (&optional buf time)
1187   (let ((buf (or buf ggtags-global-last-buffer)))
1188     (and (buffer-live-p buf)
1189          (with-current-buffer buf
1190            (when (get-buffer-process (current-buffer))
1191              (kill-compilation))
1192            (when (and (derived-mode-p 'ggtags-global-mode)
1193                       (get-buffer-window))
1194              (quit-window nil (get-buffer-window)))
1195            (and time (run-with-idle-timer time nil #'kill-buffer buf))))))
1196
1197 (defun ggtags-navigation-mode-done ()
1198   (interactive)
1199   (ggtags-navigation-mode -1)
1200   (setq tags-loop-scan t
1201         tags-loop-operate '(ggtags-find-tag-continue))
1202   (ggtags-navigation-mode-cleanup))
1203
1204 (defun ggtags-navigation-mode-abort ()
1205   (interactive)
1206   (ggtags-navigation-mode -1)
1207   ;; Run after (ggtags-navigation-mode -1) or
1208   ;; ggtags-global-start-marker might not have been saved.
1209   (when (and ggtags-global-start-marker
1210              (not (markerp ggtags-global-start-marker)))
1211     (setq ggtags-global-start-marker nil)
1212     (pop-tag-mark))
1213   (ggtags-navigation-mode-cleanup nil 0))
1214
1215 (defun ggtags-navigation-next-file (n)
1216   (interactive "p")
1217   (ggtags-ensure-global-buffer
1218     (compilation-next-file n)
1219     (compile-goto-error)))
1220
1221 (defun ggtags-navigation-previous-file (n)
1222   (interactive "p")
1223   (ggtags-navigation-next-file (- n)))
1224
1225 (defun ggtags-navigation-first-error ()
1226   (interactive)
1227   (ggtags-ensure-global-buffer
1228     (goto-char (point-min))
1229     (compilation-next-error 1)
1230     (compile-goto-error)))
1231
1232 (defun ggtags-navigation-last-error ()
1233   (interactive)
1234   (ggtags-ensure-global-buffer
1235     (goto-char (point-max))
1236     (compilation-previous-error 1)
1237     (compile-goto-error)))
1238
1239 (defun ggtags-navigation-visible-mode (&optional arg)
1240   (interactive (list (or current-prefix-arg 'toggle)))
1241   (ggtags-ensure-global-buffer
1242     (visible-mode arg)))
1243
1244 (defvar ggtags-global-line-overlay nil)
1245
1246 (defun ggtags-global-next-error-function ()
1247   (ggtags-move-to-tag)
1248   (ggtags-global-save-start-marker)
1249   (and (ggtags-project-update-mtime-maybe)
1250        (message "File `%s' is newer than GTAGS"
1251                 (file-name-nondirectory buffer-file-name)))
1252   (and ggtags-mode-sticky (ggtags-mode 1))
1253   (ignore-errors
1254     (ggtags-ensure-global-buffer
1255      (unless (overlayp ggtags-global-line-overlay)
1256        (setq ggtags-global-line-overlay (make-overlay (point) (point)))
1257        (overlay-put ggtags-global-line-overlay 'face 'ggtags-global-line))
1258      (move-overlay ggtags-global-line-overlay
1259                    (line-beginning-position) (line-end-position)
1260                    (current-buffer))))
1261   (run-hooks 'ggtags-find-tag-hook))
1262
1263 (define-minor-mode ggtags-navigation-mode nil
1264   :lighter
1265   (" GG[" (:eval
1266            (ignore-errors
1267              (ggtags-ensure-global-buffer
1268               (let ((index (when (get-text-property (line-beginning-position)
1269                                                     'compilation-message)
1270                              ;; Assume the first match appears at line 5
1271                              (- (line-number-at-pos) 4))))
1272                 `((:propertize ,(if index
1273                                     (number-to-string (max index 0))
1274                                   "?") face success) "/")))))
1275    (:propertize (:eval (number-to-string ggtags-global-match-count))
1276                 face success)
1277    (:eval
1278     (unless (zerop ggtags-global-exit-status)
1279       `(":" (:propertize ,(number-to-string ggtags-global-exit-status)
1280                          face error))))
1281    "]")
1282   :global t
1283   (if ggtags-navigation-mode
1284       (progn
1285         (add-hook 'next-error-hook 'ggtags-global-next-error-function)
1286         (add-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function))
1287     (remove-hook 'next-error-hook 'ggtags-global-next-error-function)
1288     (remove-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function)))
1289
1290 (defun ggtags-minibuffer-setup-function ()
1291   ;; Disable ggtags-navigation-mode in minibuffer.
1292   (setq-local ggtags-navigation-mode nil))
1293
1294 (defun ggtags-kill-file-buffers (&optional interactive)
1295   "Kill all buffers visiting files in current project."
1296   (interactive "p")
1297   (ggtags-check-project)
1298   (let ((directories (cons (ggtags-current-project-root) (ggtags-get-libpath)))
1299         (count 0))
1300     (dolist (buf (buffer-list))
1301       (let ((file (and (buffer-live-p buf)
1302                        (not (eq buf (current-buffer)))
1303                        (buffer-file-name buf))))
1304         (when (and file (cl-some (lambda (dir)
1305                                    ;; Don't use `file-in-directory-p'
1306                                    ;; to allow symbolic links.
1307                                    (string-prefix-p dir file))
1308                                  directories))
1309           (and (kill-buffer buf) (cl-incf count)))))
1310     (and interactive
1311          (message "%d %s killed" count (if (= count 1) "buffer" "buffers")))))
1312
1313 (defun ggtags-after-save-function ()
1314   (when (ggtags-find-project)
1315     (ggtags-project-update-mtime-maybe)
1316     ;; When oversize update on a per-save basis.
1317     (when (and buffer-file-name
1318                (or ggtags-global-always-update (ggtags-project-oversize-p)))
1319       (ggtags-with-current-project
1320        (process-file "global" nil 0 nil "--single-update"
1321                      (file-relative-name buffer-file-name))))))
1322
1323 (defun ggtags-global-output (buffer cmds callback &optional cutoff)
1324   "Asynchrously pipe the output of running CMDS to BUFFER.
1325 When finished invoke CALLBACK in BUFFER with process exit status."
1326   (or buffer (error "Output buffer required"))
1327   (let* ((program (car cmds))
1328          (args (cdr cmds))
1329          (cutoff (and cutoff (+ cutoff (if (get-buffer buffer)
1330                                            (with-current-buffer buffer
1331                                              (line-number-at-pos (point-max)))
1332                                          0))))
1333          (proc (apply #'start-file-process program buffer program args))
1334          (filter (lambda (proc string)
1335                    (and (buffer-live-p (process-buffer proc))
1336                         (with-current-buffer (process-buffer proc)
1337                           (goto-char (process-mark proc))
1338                           (insert string)
1339                           (when (and (> (line-number-at-pos (point-max)) cutoff)
1340                                      (process-live-p proc))
1341                             (interrupt-process (current-buffer)))))))
1342          (sentinel (lambda (proc _msg)
1343                      (when (memq (process-status proc) '(exit signal))
1344                        (with-current-buffer (process-buffer proc)
1345                          (set-process-buffer proc nil)
1346                          (funcall callback (process-exit-status proc)))))))
1347     (set-process-query-on-exit-flag proc nil)
1348     (and cutoff (set-process-filter proc filter))
1349     (set-process-sentinel proc sentinel)
1350     proc))
1351
1352 (defun ggtags-show-definition-default (defs)
1353   (let (message-log-max)
1354     (message "%s%s" (or (caar defs) "[definition not found]")
1355              (if (cdr defs) " [guess]" ""))))
1356
1357 (defun ggtags-show-definition (name)
1358   (interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
1359   (ggtags-check-project)
1360   (let* ((re (cadr (assq 'grep ggtags-global-error-regexp-alist-alist)))
1361          (current (current-buffer))
1362          (buffer (get-buffer-create " *ggtags-definition*"))
1363          (fn ggtags-show-definition-function)
1364          (show (lambda (_status)
1365                  (goto-char (point-min))
1366                  (let ((defs (cl-loop while (re-search-forward re nil t)
1367                                       collect (list (buffer-substring (1+ (match-end 2))
1368                                                                       (line-end-position))
1369                                                     name
1370                                                     (match-string 1)
1371                                                     (string-to-number (match-string 2))))))
1372                    (kill-buffer buffer)
1373                    (with-current-buffer current
1374                      (funcall fn defs))))))
1375     (ggtags-global-output
1376      buffer
1377      (list "global" "--result=grep" "--path-style=absolute" name)
1378      show 100)))
1379
1380 (defvar ggtags-mode-prefix-map
1381   (let ((m (make-sparse-keymap)))
1382     (define-key m "\M-'" 'previous-error)
1383     (define-key m (kbd "M-DEL") 'ggtags-delete-tag-files)
1384     (define-key m "\M-p" 'ggtags-prev-mark)
1385     (define-key m "\M-n" 'ggtags-next-mark)
1386     (define-key m "\M-f" 'ggtags-find-file)
1387     (define-key m "\M-o" 'ggtags-find-other-symbol)
1388     (define-key m "\M-g" 'ggtags-grep)
1389     (define-key m "\M-i" 'ggtags-idutils-query)
1390     (define-key m "\M-b" 'ggtags-browse-file-as-hypertext)
1391     (define-key m "\M-k" 'ggtags-kill-file-buffers)
1392     (define-key m "\M-h" 'ggtags-view-tag-history)
1393     (define-key m "\M-j" 'ggtags-visit-project-root)
1394     (define-key m (kbd "M-%") 'ggtags-query-replace)
1395     (define-key m "\M-?" 'ggtags-show-definition)
1396     m))
1397
1398 (defvar ggtags-mode-map
1399   (let ((map (make-sparse-keymap))
1400         (menu (make-sparse-keymap "Ggtags")))
1401     (define-key map "\M-." 'ggtags-find-tag-dwim)
1402     (define-key map (kbd "M-]") 'ggtags-find-reference)
1403     (define-key map (kbd "C-M-.") 'ggtags-find-tag-regexp)
1404     (define-key map ggtags-mode-prefix-key ggtags-mode-prefix-map)
1405     ;; Menu items
1406     (define-key map [menu-bar ggtags] (cons "Ggtags" menu))
1407     ;; Ordered backwards
1408     (define-key menu [report-bugs]
1409       `(menu-item "Report bugs"
1410                   (lambda () (interactive)
1411                     (browse-url ggtags-bug-url)
1412                     (message "Please visit %s" ggtags-bug-url))
1413                   :help ,(format "Visit %s" ggtags-bug-url)))
1414     (define-key menu [custom-ggtags]
1415       '(menu-item "Customize Ggtags"
1416                   (lambda () (interactive) (customize-group 'ggtags))))
1417     (define-key menu [save-project]
1418       '(menu-item "Save project settings" ggtags-save-project-settings))
1419     (define-key menu [toggle-read-only]
1420       '(menu-item "Toggle project read-only" ggtags-toggle-project-read-only
1421                   :button (:toggle . buffer-read-only)))
1422     (define-key menu [visit-project-root]
1423       '(menu-item "Visit project root" ggtags-visit-project-root))
1424     (define-key menu [sep2] menu-bar-separator)
1425     (define-key menu [browse-hypertext]
1426       '(menu-item "Browse as hypertext" ggtags-browse-file-as-hypertext
1427                   :enable (ggtags-find-project)))
1428     (define-key menu [delete-tags]
1429       '(menu-item "Delete tag files" ggtags-delete-tag-files
1430                   :enable (ggtags-find-project)))
1431     (define-key menu [kill-buffers]
1432       '(menu-item "Kill project file buffers" ggtags-kill-file-buffers
1433                   :enable (ggtags-find-project)))
1434     (define-key menu [view-tag]
1435       '(menu-item "View tag history" ggtags-view-tag-history))
1436     (define-key menu [pop-mark]
1437       '(menu-item "Pop mark" pop-tag-mark
1438                   :help "Pop to previous mark and destroy it"))
1439     (define-key menu [next-mark]
1440       '(menu-item "Next mark" ggtags-next-mark))
1441     (define-key menu [prev-mark]
1442       '(menu-item "Previous mark" ggtags-prev-mark))
1443     (define-key menu [sep1] menu-bar-separator)
1444     (define-key menu [previous-error]
1445       '(menu-item "Previous match" previous-error))
1446     (define-key menu [next-error]
1447       '(menu-item "Next match" next-error))
1448     (define-key menu [find-file]
1449       '(menu-item "Find files" ggtags-find-file))
1450     (define-key menu [query-replace]
1451       '(menu-item "Query replace" ggtags-query-replace))
1452     (define-key menu [idutils]
1453       '(menu-item "Query idutils DB" ggtags-idutils-query))
1454     (define-key menu [grep]
1455       '(menu-item "Grep" ggtags-grep))
1456     (define-key menu [find-symbol]
1457       '(menu-item "Find other symbol" ggtags-find-other-symbol))
1458     (define-key menu [find-tag-regexp]
1459       '(menu-item "Find tag matching regexp" ggtags-find-tag-regexp))
1460     (define-key menu [show-definition]
1461       '(menu-item "Show definition" ggtags-show-definition))
1462     (define-key menu [find-reference]
1463       '(menu-item "Find reference" ggtags-find-reference))
1464     (define-key menu [find-tag-continue]
1465       '(menu-item "Continue find tag" tags-loop-continue))
1466     (define-key menu [find-tag]
1467       '(menu-item "Find tag" ggtags-find-tag-dwim))
1468     (define-key menu [update-tags]
1469       '(menu-item "Update tag files" ggtags-update-tags
1470                   :visible (ggtags-find-project)))
1471     (define-key menu [run-gtags]
1472       '(menu-item "Run gtags" ggtags-create-tags
1473                   :visible (not (ggtags-find-project))))
1474     map))
1475
1476 (defvar ggtags-mode-line-project-keymap
1477   (let ((map (make-sparse-keymap)))
1478     (define-key map [mode-line mouse-1] 'ggtags-visit-project-root)
1479     map))
1480
1481 (put 'ggtags-mode-line-project-name 'risky-local-variable t)
1482 (defvar ggtags-mode-line-project-name
1483   '("[" (:eval (let ((name (if (stringp ggtags-project-root)
1484                                (file-name-nondirectory
1485                                 (directory-file-name ggtags-project-root))
1486                              "?")))
1487                  (propertize
1488                   name 'face compilation-info-face
1489                   'help-echo (if (stringp ggtags-project-root)
1490                                  (concat "mouse-1 to visit " ggtags-project-root)
1491                                "mouse-1 to set project")
1492                   'mouse-face 'mode-line-highlight
1493                   'keymap ggtags-mode-line-project-keymap)))
1494     "]"))
1495
1496 ;;;###autoload
1497 (define-minor-mode ggtags-mode nil
1498   :lighter (:eval (if ggtags-navigation-mode "" " GG"))
1499   (unless (timerp ggtags-highlight-tag-timer)
1500     (setq ggtags-highlight-tag-timer
1501           (run-with-idle-timer
1502            ggtags-highlight-tag-delay t #'ggtags-highlight-tag-at-point)))
1503   (if ggtags-mode
1504       (progn
1505         (add-hook 'after-save-hook 'ggtags-after-save-function nil t)
1506         ;; Append to serve as a fallback method.
1507         (add-hook 'completion-at-point-functions
1508                   #'ggtags-completion-at-point t t)
1509         (unless (memq 'ggtags-mode-line-project-name
1510                       mode-line-buffer-identification)
1511           (setq mode-line-buffer-identification
1512                 (append mode-line-buffer-identification
1513                         '(ggtags-mode-line-project-name)))))
1514     (remove-hook 'after-save-hook 'ggtags-after-save-function t)
1515     (remove-hook 'completion-at-point-functions #'ggtags-completion-at-point t)
1516     (setq mode-line-buffer-identification
1517           (delq 'ggtags-mode-line-project-name mode-line-buffer-identification))
1518     (and (overlayp ggtags-highlight-tag-overlay)
1519          (delete-overlay ggtags-highlight-tag-overlay))
1520     (setq ggtags-highlight-tag-overlay nil)))
1521
1522 (defvar ggtags-highlight-tag-map
1523   (let ((map (make-sparse-keymap)))
1524     ;; Bind down- events so that the global keymap won't ``shine
1525     ;; through''. See `mode-line-buffer-identification-keymap' for
1526     ;; similar workaround.
1527     (define-key map [S-mouse-1] 'ggtags-find-tag-dwim)
1528     (define-key map [S-down-mouse-1] 'ignore)
1529     (define-key map [S-mouse-3] 'ggtags-find-reference)
1530     (define-key map [S-down-mouse-3] 'ignore)
1531     map)
1532   "Keymap used for valid tag at point.")
1533
1534 (put 'ggtags-active-tag 'face 'ggtags-highlight)
1535 (put 'ggtags-active-tag 'keymap ggtags-highlight-tag-map)
1536 ;; (put 'ggtags-active-tag 'mouse-face 'match)
1537 (put 'ggtags-active-tag 'help-echo
1538      "S-mouse-1 for definitions\nS-mouse-3 for references")
1539
1540 (defun ggtags-highlight-tag-at-point ()
1541   (when (and ggtags-mode ggtags-project-root (ggtags-find-project))
1542     (unless (overlayp ggtags-highlight-tag-overlay)
1543       (setq ggtags-highlight-tag-overlay (make-overlay (point) (point) nil t))
1544       (overlay-put ggtags-highlight-tag-overlay 'modification-hooks
1545                    (list (lambda (o after &rest _args)
1546                            (and (not after) (delete-overlay o))))))
1547     (let ((bounds (funcall ggtags-bounds-of-tag-function))
1548           (o ggtags-highlight-tag-overlay))
1549       (cond
1550        ((and bounds
1551              (eq (overlay-buffer o) (current-buffer))
1552              (= (overlay-start o) (car bounds))
1553              (= (overlay-end o) (cdr bounds)))
1554         ;; Overlay matches current tag so do nothing.
1555         nil)
1556        ((and bounds (let ((completion-ignore-case nil))
1557                       (test-completion
1558                        (buffer-substring (car bounds) (cdr bounds))
1559                        ggtags-completion-table)))
1560         (move-overlay o (car bounds) (cdr bounds) (current-buffer))
1561         (overlay-put o 'category 'ggtags-active-tag))
1562        (t (move-overlay o
1563                         (or (car bounds) (point))
1564                         (or (cdr bounds) (point))
1565                         (current-buffer))
1566           (overlay-put o 'category nil))))))
1567
1568 ;;; imenu
1569
1570 (defun ggtags-goto-imenu-index (name line &rest _args)
1571   (save-restriction
1572     (widen)
1573     (goto-char (point-min))
1574     (forward-line (1- line))
1575     (ggtags-move-to-tag name)))
1576
1577 ;;;###autoload
1578 (defun ggtags-build-imenu-index ()
1579   "A function suitable for `imenu-create-index-function'."
1580   (let ((file (and buffer-file-name (file-relative-name buffer-file-name))))
1581     (and file (with-temp-buffer
1582                 (when (with-demoted-errors
1583                         (zerop (ggtags-with-current-project
1584                                 (process-file "global" nil t nil "-x" "-f" file))))
1585                   (goto-char (point-min))
1586                   (cl-loop while (re-search-forward
1587                                   "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)" nil t)
1588                            collect (list (match-string 1)
1589                                          (string-to-number (match-string 2))
1590                                          'ggtags-goto-imenu-index)))))))
1591
1592 ;;; hippie-expand
1593
1594 ;;;###autoload
1595 (defun try-complete-ggtags-tag (old)
1596   "A function suitable for `hippie-expand-try-functions-list'."
1597   (with-no-warnings                     ; to avoid loading hippie-exp
1598     (unless old
1599       (he-init-string (if (looking-back "\\_<.*" (line-beginning-position))
1600                           (match-beginning 0)
1601                         (point))
1602                       (point))
1603       (setq he-expand-list
1604             (and (not (equal he-search-string ""))
1605                  (ggtags-find-project)
1606                  (sort (all-completions he-search-string
1607                                         ggtags-completion-table)
1608                        #'string-lessp))))
1609     (if (null he-expand-list)
1610         (progn
1611           (if old (he-reset-string))
1612           nil)
1613       (he-substitute-string (car he-expand-list))
1614       (setq he-expand-list (cdr he-expand-list))
1615       t)))
1616
1617 (defun ggtags-reload (&optional force)
1618   (interactive "P")
1619   (unload-feature 'ggtags force)
1620   (require 'ggtags))
1621
1622 (defun ggtags-unload-function ()
1623   (setq emulation-mode-map-alists
1624         (delq 'ggtags-mode-map-alist emulation-mode-map-alists))
1625   nil)
1626
1627 (provide 'ggtags)
1628 ;;; ggtags.el ends here