├── .gitignore
├── Makefile
├── README.rst
└── ggtags.el


/.gitignore:
--------------------------------------------------------------------------------
1 | *.elc


--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
 1 | .PHONY: all clean
 2 | 
 3 | ELCFILES = $(addsuffix .elc, $(basename $(wildcard *.el)))
 4 | 
 5 | all: $(ELCFILES)
 6 | 
 7 | %.elc : %.el
 8 | 	@echo Compiling $<
 9 | 	@emacs -batch -q -no-site-file -f batch-byte-compile $<
10 | 
11 | clean:
12 | 	@rm -f *.elc
13 | 


--------------------------------------------------------------------------------
/README.rst:
--------------------------------------------------------------------------------
  1 | =========================================================
  2 |  Emacs frontend to GNU Global source code tagging system
  3 | =========================================================
  4 | 
  5 | This package is part of `GNU ELPA <http://elpa.gnu.org>`_ (``M-x
  6 | list-packages``) and is also available on `MELPA
  7 | <https://melpa.org/#/ggtags>`_.
  8 | 
  9 | The goal is to make working with GNU Global in Emacs as effortlessly
 10 | and intuitively as possible and to integrate tightly with standard
 11 | emacs packages. ``ggtags.el`` is tested in Emacs 24 and 25. Patches,
 12 | feature requests and bug reports are welcome. Thanks.
 13 | 
 14 | Features
 15 | ~~~~~~~~
 16 | 
 17 | #. Build on ``compile.el`` for asynchronicity and its large
 18 |    feature-set.
 19 | #. Automatically update Global's tag files when needed with tuning for
 20 |    large source trees.
 21 | #. Intuitive navigation among multiple matches with mode-line display
 22 |    of current match, total matches and exit status.
 23 | #. Read tag with completion.
 24 | #. Show definition at point.
 25 | #. Jump to #include files.
 26 | #. Support search history and saving a search to register/bookmark.
 27 | #. Query replace.
 28 | #. Manage Global's environment variables on a per-project basis.
 29 | #. Highlight (definition) tag at point.
 30 | #. Abbreviated display of file names.
 31 | #. Support all Global search backends: ``grep``, ``idutils`` etc.
 32 | #. Support `exuberant/universal ctags <https://ctags.io/>`_ and
 33 |    ``pygments`` backend.
 34 | #. Support all Global's output formats: ``grep``, ``ctags-x``,
 35 |    ``cscope`` etc.
 36 | #. Support projects on remote hosts (e.g. via ``tramp``).
 37 | #. Support eldoc.
 38 | #. Search ``GTAGSLIBPATH`` for references and symbols.
 39 | 
 40 | Screenshot
 41 | ~~~~~~~~~~
 42 | 
 43 | .. figure:: http://i.imgur.com/wx8ZPGe.png
 44 |    :width: 500px
 45 |    :target: http://i.imgur.com/wx8ZPGe.png
 46 |    :alt: ggtags.png
 47 | 
 48 | Why GNU Global
 49 | ~~~~~~~~~~~~~~
 50 | 
 51 | The opengrok project composed a feature comparison `table
 52 | <https://github.com/OpenGrok/OpenGrok/wiki/Comparison-with-Similar-Tools>`_
 53 | between a few tools.
 54 | 
 55 | Install Global and plugins
 56 | ~~~~~~~~~~~~~~~~~~~~~~~~~~
 57 | 
 58 | 1. Compile and install Global with ``universal-ctags``
 59 |    ::
 60 | 
 61 |      ./configure --prefix=<PREFIX> --with-universal-ctags=/usr/local/bin/ctags
 62 |      make && make install
 63 | 
 64 |    The executable ``ctags`` is unfortunately named because ``emacs``
 65 |    also includes a command of the same name. So make sure it is from
 66 |    https://ctags.io. See ``plugin-factory/PLUGIN_HOWTO``
 67 |    (``plugin-factory/README`` for Global < 6.5) in GNU Global
 68 |    source for further information.
 69 | 
 70 | 2. Install ``pygments`` plugin
 71 | 
 72 |    The ``pygments`` plugin has been included in ``global`` since
 73 |    version ``6.3.2``. ``pip install pygments`` is the only step
 74 |    required. Note the plugin is not activated by the default
 75 |    ``gtags.conf`` or ``.globalrc``. See
 76 |    ``global/plugin-factory/PLUGIN_HOWTO.pygments`` for details.
 77 | 
 78 |    The following instructions are for older ``global``.
 79 |    ::
 80 | 
 81 |      pip install pygments
 82 |      git clone https://github.com/yoshizow/global-pygments-plugin.git
 83 |      cd global-pygments-plugin/
 84 |      sh reconf.sh
 85 |      ./configure --prefix=<PREFIX> --with-universal-ctags=/usr/local/bin/ctags
 86 |      make && make install
 87 |      cp sample.globalrc $HOME/.globalrc
 88 | 
 89 |    Make sure the value of ``<PREFIX>`` agree with step 1.
 90 | 
 91 | Config
 92 | ~~~~~~
 93 | 
 94 | Global with ``universal-ctags`` and ``pygments`` plugins can support
 95 | dozens of programming languages. For example, to enable
 96 | ``ggtags-mode`` for C/C++/Java modes::
 97 | 
 98 |     (add-hook 'c-mode-common-hook
 99 |               (lambda ()
100 |                 (when (derived-mode-p 'c-mode 'c++-mode 'java-mode)
101 |                   (ggtags-mode 1))))
102 | 
103 | Also see https://github.com/leoliu/ggtags/wiki for more examples.
104 | 
105 | Usage
106 | ~~~~~
107 | 
108 | Open any file in a project and type ``M-x ggtags-mode``. Use ``M-.``
109 | (``ggtags-find-tag-dwim``) to find the tag at point. If the project
110 | has not been indexed (i.e. no ``GTAGS`` file exists), ``ggtags`` will
111 | ask for the project root directory and index it recursively.
112 | Alternatively one can invoke ``ggtags-create-tags`` to index a
113 | directory. The mode line will display the directory name next to the
114 | buffer name. If point is at a valid definition tag, it is underlined.
115 | 
116 | ``ggtags`` is similar to the standard ``etags`` package. For example
117 | these keys ``M-.``, ``M-,`` and ``C-M-.`` should work as expected in
118 | ``ggtags-mode``.
119 | 
120 | The following search commands are available:
121 | 
122 | ggtags-find-tag-dwim
123 | 
124 |    Find a tag by context.
125 | 
126 |    If point is at a definition tag, find references, and vice versa.
127 |    If point is at a line that matches ``ggtags-include-pattern``, find
128 |    the include file instead.
129 | 
130 |    To force finding a definition tag, call it with a prefix (``C-u``).
131 | 
132 | ggtags-find-tag-mouse
133 | 
134 |    Like ``ggtags-find-tag-dwim`` but suitable for binding to mouse
135 |    events.
136 | 
137 | ggtags-find-definition
138 | 
139 |    Find definition tags. With ``C-u`` ask for the tag name with
140 |    completion.
141 | 
142 | ggtags-find-reference
143 | 
144 |    Find reference tags. With ``C-u`` ask for the tag name with completion.
145 | 
146 | ggtags-find-other-symbol
147 | 
148 |    Find tags that have no definitions. With ``C-u`` ask for the tag
149 |    name with completion.
150 | 
151 | ggtags-find-tag-regexp
152 | 
153 |    Find definition tags matching a regexp. By default it lists all
154 |    matching tags in the project. With ``C-u`` restrict the lists to a
155 |    directory of choice.
156 | 
157 | ggtags-idutils-query
158 | 
159 |    Use idutils to find matches.
160 | 
161 | ggtags-grep
162 | 
163 |    Grep for lines matching a regexp. This is usually the slowest.
164 | 
165 | ggtags-find-file
166 | 
167 |    Find a file from all the files indexed by ``gtags``.
168 | 
169 | ggtags-query-replace
170 | 
171 |    Do a query replace in all files found in a search.
172 | 
173 | Handling multiple matches
174 | +++++++++++++++++++++++++
175 | 
176 | When a search finds multiple matches, a buffer named
177 | ``*ggtags-global*`` is popped up and ``ggtags-navigation-mode`` is
178 | turned on to facilitate locating the right match.
179 | ``ggtags-navigation-mode`` makes a few commands in the
180 | ``*ggtags-global*`` buffer globally accessible:
181 | 
182 | ``M-n``
183 | 
184 |    Move to the next match.
185 | 
186 | ``M-p``
187 | 
188 |    Move to the previous match.
189 | 
190 | ``M-}``
191 | 
192 |    Move to next file.
193 | 
194 | ``M-{``
195 | 
196 |    Move to previous file.
197 | 
198 | ``M-=``
199 | 
200 |    Move to the file where navigation session starts.
201 | 
202 | ``M-<``
203 | 
204 |    Move to the first match.
205 | 
206 | ``M->``
207 | 
208 |    Move to the last match.
209 | 
210 | ``C-M-s`` or ``M-s s``
211 | 
212 |    Use ``isearch`` to find the match.
213 | 
214 | ``RET``
215 | 
216 |    Found the right match so exit navigation mode. Resumable by
217 |    ``M-x tags-loop-continue``.
218 | 
219 | ``M-,`` (``M-*`` if Emacs < 25)
220 | 
221 |    Abort and go back to the location where the search was started.
222 | 
223 | Miscellaneous commands
224 | ++++++++++++++++++++++
225 | 
226 | Commands are available from the ``Ggtags`` menu in ``ggtags-mode``.
227 | 
228 | ggtags-prev-mark
229 | 
230 |    Move to the previously (older) visited location. Unlike ``M-,``
231 |    (``M-*`` if Emacs < 25) this doesn't delete the location from the
232 |    tag ring.
233 | 
234 | ggtags-next-mark
235 | 
236 |    Move to the next (newer) visited location.
237 | 
238 | ggtags-view-tag-history
239 | 
240 |    Pop to a buffer listing all visited locations from newest to
241 |    oldest. The buffer is a next error buffer and works with standard
242 |    commands ``next-error`` and ``previous-error``. In addition ``TAB``
243 |    and ``S-TAB`` move to next/prev entry, and ``RET`` visits the
244 |    location. ``M-n`` and ``M-p`` move to and display the next/previous
245 |    entry.
246 | 
247 | ggtags-view-search-history
248 | 
249 |    View or re-run past searches as kept in
250 |    ``ggtags-global-search-history``.
251 | 
252 | ggtags-kill-file-buffers
253 | 
254 |    Kill all file-visiting buffers of current project.
255 | 
256 | ggtags-toggle-project-read-only
257 | 
258 |    Toggle opening files in ``read-only`` mode. Handy if the main
259 |    purpose of source navigation is to read code.
260 | 
261 | ggtags-visit-project-root
262 | 
263 |    Open the project root directory in ``dired``.
264 | 
265 | ggtags-delete-tags
266 | 
267 |    Delete the GTAGS, GRTAGS, GPATH and ID files of current project.
268 | 
269 | ggtags-explain-tags
270 | 
271 |   Explain how each file is indexed in current project.
272 | 
273 | ggtags-browse-file-as-hypertext
274 | 
275 |    Use ``htags`` to generate HTML of the source tree. This allows
276 |    browsing the project in a browser with cross-references.
277 | 
278 | Integration with other packages
279 | +++++++++++++++++++++++++++++++
280 | 
281 | * eldoc
282 | 
283 |   ``Eldoc`` support is set up by default on emacs 24.4+. For older
284 |   versions set, for example, in the desired major mode:
285 | 
286 |   ::
287 | 
288 |      (setq-local eldoc-documentation-function #'ggtags-eldoc-function)
289 | 
290 | * imenu
291 | 
292 |   Emacs major modes usually have excellent support for ``imenu`` so
293 |   this is not enabled by default. To use:
294 |   ::
295 | 
296 |     (setq-local imenu-create-index-function #'ggtags-build-imenu-index)
297 | 
298 | * hippie-exp
299 |   ::
300 | 
301 |      (setq-local hippie-expand-try-functions-list
302 |                  (cons 'ggtags-try-complete-tag hippie-expand-try-functions-list))
303 | 
304 | * company
305 | 
306 |   ``company`` can use ``ggtags`` as completion source via
307 |   ``company-capf`` which is enabled by default.
308 | 
309 | * helm
310 | 
311 |   If ``helm-mode`` is enabled ``ggtags`` will use it for completion if
312 |   ``ggtags-completing-read-function`` is nil.
313 | 
314 | NEWS
315 | ~~~~
316 | 
317 | (devel)
318 | +++++++
319 | 
320 | #. Drop support for Emacs < 25.
321 | #. Integration with ``xref.el``.
322 | #. Make ``ggtags-sort-by-nearness`` actually work.
323 | 
324 | [2018-07-25 Wed] 0.8.13
325 | +++++++++++++++++++++++
326 | 
327 | #. Don't choke on tag names start with ``-`` (`#156
328 |    <https://github.com/leoliu/ggtags/issues/156>`_).
329 | #. ``ggtags-show-definition`` supports ``ggtags-sort-by-nearness``.
330 | #. New variable ``ggtags-extra-args``.
331 | #. Unbreak ``ggtags-sort-by-nearness``.
332 | 
333 | [2016-10-02 Sun] 0.8.12
334 | +++++++++++++++++++++++
335 | 
336 | #. Work with Emacs 25.
337 | #. ``ggtags-navigation-mode`` is more discreet in displaying lighter
338 |    when ``ggtags-enable-navigation-keys`` is set to nil.
339 | #. ``ggtags-make-project`` tries harder to find TAG files respecting
340 |    ``GTAGSDBPATH``.
341 | #. Fix error "Selecting deleted buffer"
342 |    (`#89 <https://github.com/leoliu/ggtags/issues/89>`_).
343 |    
344 | [2015-12-15 Tue] 0.8.11
345 | +++++++++++++++++++++++
346 | 
347 | #. ``ggtags-highlight-tag-delay`` is renamed to
348 |    ``ggtags-highlight-tag``.
349 | #. Tag highlighting can be disabled by setting
350 |    ``ggtags-highlight-tag`` to nil.
351 | 
352 | [2015-06-12 Fri] 0.8.10
353 | +++++++++++++++++++++++
354 | 
355 | #. Tags update on save is configurable by ``ggtags-update-on-save``.
356 | #. New command ``ggtags-explain-tags`` to explain how each file is
357 |    indexed in current project. Global 6.4+ required.
358 | #. New user option ``ggtags-sort-by-nearness`` that sorts matched tags
359 |    by nearness to current directory.
360 | 
361 | [2015-01-16 Fri] 0.8.9
362 | ++++++++++++++++++++++
363 | 
364 | #. ``ggtags-visit-project-root`` can visit past projects.
365 | #. ``eldoc`` support enabled for emacs 24.4+.
366 | 
367 | [2014-12-03 Wed] 0.8.8
368 | ++++++++++++++++++++++
369 | 
370 | #. Command ``ggtags-update-tags`` now runs in the background for large
371 |    projects (per ``ggtags-oversize-limit``) without blocking emacs.
372 | 
373 | [2014-11-10 Mon] 0.8.7
374 | ++++++++++++++++++++++
375 | 
376 | #. New navigation command ``ggtags-navigation-start-file``.
377 | #. New variable ``ggtags-use-sqlite3`` to enable sqlite3 storage.
378 | 
379 | [2014-09-12 Fri] 0.8.6
380 | ++++++++++++++++++++++
381 | 
382 | #. ``ggtags-show-definition`` shows definition with font locking.
383 | 
384 | [2014-06-22 Sun] 0.8.5
385 | ++++++++++++++++++++++
386 | 
387 | #. New command ``ggtags-find-tag-mouse`` for mouse support.
388 | #. New command ``ggtags-find-definition``.
389 | #. Variable ``ggtags-completing-read-function`` restored.
390 | #. ``ggtags-navigation-isearch-forward`` can also be invoked using
391 |    ``M-s s``.
392 | #. Command ``ggtags-global-rerun-search`` renamed to
393 |    ``ggtags-view-search-history``.
394 | #. The output buffer from ``ggtags-view-search-history`` looks
395 |    cleaner.
396 | #. Search history items can be re-arranged with ``C-k`` and ``C-y``.
397 | 
398 | [2014-05-06 Tue] 0.8.4
399 | ++++++++++++++++++++++
400 | 
401 | #. ``M-.`` (``ggtags-find-tag-dwim``) is smarter on new files.
402 | #. Always update tags for current file on save.
403 | #. Can continue search ``GTAGSLIBPATH`` if search turns up 0 matches.
404 |    Customisable via ``ggtags-global-search-libpath-for-reference``.
405 | 
406 | [2014-04-12 Sat] 0.8.3
407 | ++++++++++++++++++++++
408 | 
409 | #. Tweak mode-line lighter in ``ggtags-navigation-mode``.
410 | 
411 | [2014-04-05 Sat] 0.8.2
412 | ++++++++++++++++++++++
413 | 
414 | #. Default ``ggtags-auto-jump-to-match`` to ``history``.
415 | #. Add eldoc support; see ``ggtags-eldoc-function``.
416 | #. Improved support for tramp.
417 | 
418 | [2014-03-30 Sun] 0.8.1
419 | ++++++++++++++++++++++
420 | 
421 | #. Improve ``ggtags-view-tag-history`` and tag history navigation.
422 | #. New customsable variable ``ggtags-global-use-color``.
423 | #. Automatically jump to match from location stored in search history.
424 |    See ``ggtags-auto-jump-to-match``.
425 | #. Rename ``ggtags-supress-navigation-keys`` to
426 |    ``ggtags-enable-navigation-keys`` with a better way to suppress
427 |    navigation key bindings in some buffers including
428 |    ``*ggtags-global*`` buffer.
429 | 
430 | [2014-03-24 Mon] 0.8.0
431 | ++++++++++++++++++++++
432 | 
433 | #. Record search history and re-run past searches.
434 | #. Bookmark or save search to register.
435 | #. New command ``ggtags-show-definition``.
436 | #. Project name on mode line.
437 | #. Automatically use ``.globalrc`` or ``gtags.conf`` file at project
438 |    root.
439 | #. Better completion based on tag types.
440 | #. Use colored output to get column number for jumping to tag.
441 | #. Improve detection of stale GTAGS file based on file modification
442 |    time.
443 | #. New customisable variables ``ggtags-executable-directory``,
444 |    ``ggtags-global-always-update``, ``ggtags-mode-sticky`` and
445 |    ``ggtags-supress-navigation-keys``.
446 | #. Other bug fixes.
447 | 
448 | Bugs
449 | ~~~~
450 | 
451 | https://github.com/leoliu/ggtags/issues
452 | 


--------------------------------------------------------------------------------
/ggtags.el:
--------------------------------------------------------------------------------
   1 | ;;; ggtags.el --- emacs frontend to GNU Global source code tagging system  -*- lexical-binding: t; -*-
   2 | 
   3 | ;; Copyright (C) 2013-2019  Free Software Foundation, Inc.
   4 | 
   5 | ;; Author: Leo Liu <sdl.web@gmail.com>
   6 | ;; Version: 0.9.0
   7 | ;; Keywords: tools, convenience
   8 | ;; Created: 2013-01-29
   9 | ;; URL: https://github.com/leoliu/ggtags
  10 | ;; Package-Requires: ((emacs "25"))
  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 | ;; `ggtags' is similar to the standard `etags' package. These keys
  33 | ;; `M-.', `M-,' and `C-M-.' should work as expected in `ggtags-mode'.
  34 | ;; See the README in https://github.com/leoliu/ggtags for more
  35 | ;; details.
  36 | ;;
  37 | ;; All commands are available from the `Ggtags' menu in `ggtags-mode'.
  38 | 
  39 | ;;; NEWS 0.8.13 (2018-07-25):
  40 | 
  41 | ;; - Don't choke on tag names start with `-'.
  42 | ;; - `ggtags-show-definition' supports `ggtags-sort-by-nearness'.
  43 | ;; - New variable `ggtags-extra-args'.
  44 | ;; - Unbreak `ggtags-sort-by-nearness'.
  45 | ;;
  46 | ;; See full NEWS on https://github.com/leoliu/ggtags#news
  47 | 
  48 | ;;; Code:
  49 | 
  50 | (eval-when-compile
  51 |   (require 'url-parse))
  52 | 
  53 | (require 'cl-lib)
  54 | (require 'ewoc)
  55 | (require 'compile)
  56 | (require 'etags)
  57 | 
  58 | (eval-when-compile
  59 |   (defmacro ignore-errors-unless-debug (&rest body)
  60 |     "Ignore all errors while executing BODY unless debug is on."
  61 |     (declare (debug t) (indent 0))
  62 |     `(condition-case-unless-debug nil (progn ,@body) (error nil)))
  63 | 
  64 |   (defmacro with-display-buffer-no-window (&rest body)
  65 |     (declare (debug t) (indent 0))
  66 |     ;; See http://debbugs.gnu.org/13594
  67 |     `(let ((display-buffer-overriding-action
  68 |             (if ggtags-auto-jump-to-match
  69 |                 (list #'display-buffer-no-window)
  70 |               display-buffer-overriding-action)))
  71 |        ,@body)))
  72 | 
  73 | (defgroup ggtags nil
  74 |   "GNU Global source code tagging system."
  75 |   :group 'tools)
  76 | 
  77 | (defface ggtags-highlight '((t (:underline t)))
  78 |   "Face used to highlight a valid tag at point."
  79 |   :group 'ggtags)
  80 | 
  81 | (defface ggtags-global-line '((t (:inherit secondary-selection)))
  82 |   "Face used to highlight matched line in Global buffer."
  83 |   :group 'ggtags)
  84 | 
  85 | (defcustom ggtags-executable-directory nil
  86 |   "If non-nil the directory to search global executables."
  87 |   :type '(choice (const :tag "Unset" nil) directory)
  88 |   :risky t
  89 |   :group 'ggtags)
  90 | 
  91 | (defcustom ggtags-oversize-limit (* 10 1024 1024)
  92 |   "The over size limit for the  GTAGS file.
  93 | When the size of the GTAGS file is below this limit, ggtags
  94 | always maintains up-to-date tags for the whole source tree by
  95 | running `global -u'. For projects with GTAGS larger than this
  96 | limit, only files edited in Ggtags mode are updated (via `global
  97 | --single-update')."
  98 |   :safe 'numberp
  99 |   :type '(choice (const :tag "None" nil)
 100 |                  (const :tag "Always" t)
 101 |                  number)
 102 |   :group 'ggtags)
 103 | 
 104 | (defcustom ggtags-include-pattern
 105 |   '("^\\s-*#\\s-*\\(?:include\\|import\\)\\s-*[\"<]\\(?:[./]*\\)?\\(.*?\\)[\">]" . 1)
 106 |   "Pattern used to detect #include files.
 107 | Value can be (REGEXP . SUB) or a function with no arguments.
 108 | REGEXP should match from the beginning of line."
 109 |   :type '(choice (const :tag "Disable" nil)
 110 |                  (cons regexp integer)
 111 |                  function)
 112 |   :safe 'stringp
 113 |   :group 'ggtags)
 114 | 
 115 | ;; See also: http://article.gmane.org/gmane.comp.gnu.global.bugs/1751
 116 | (defcustom ggtags-use-project-gtagsconf t
 117 |   "Non-nil to use GTAGSCONF file found at project root.
 118 | File .globalrc and gtags.conf are checked in order.
 119 | 
 120 | Note: GNU Global v6.2.13 has the feature of using gtags.conf at
 121 | project root. Setting this variable to nil doesn't disable this
 122 | feature."
 123 |   :safe 'booleanp
 124 |   :type 'boolean
 125 |   :group 'ggtags)
 126 | 
 127 | (defcustom ggtags-project-duration 600
 128 |   "Seconds to keep information of a project in memory."
 129 |   :type 'number
 130 |   :group 'ggtags)
 131 | 
 132 | (defcustom ggtags-process-environment nil
 133 |   "Similar to `process-environment' with higher precedence.
 134 | Elements are run through `substitute-env-vars' before use.
 135 | GTAGSROOT will always be expanded to current project root
 136 | directory. This is intended for project-wise ggtags-specific
 137 | process environment settings. Note on remote hosts (e.g. tramp)
 138 | directory local variables is not enabled by default per
 139 | `enable-remote-dir-locals' (which see)."
 140 |   :safe 'ggtags-list-of-string-p
 141 |   :type '(repeat string)
 142 |   :group 'ggtags)
 143 | 
 144 | (defcustom ggtags-auto-jump-to-match 'history
 145 |   "Strategy on how to jump to match: nil, first or history.
 146 | 
 147 |     nil: never automatically jump to any match;
 148 |   first: jump to the first match;
 149 | history: jump to the match stored in search history."
 150 |   :type '(choice (const :tag "First match" first)
 151 |                  (const :tag "Search History" history)
 152 |                  (const :tag "Never" nil))
 153 |   :group 'ggtags)
 154 | 
 155 | (defcustom ggtags-global-window-height 8 ; ggtags-global-mode
 156 |   "Number of lines for the *ggtags-global* popup window.
 157 | If nil, use Emacs default."
 158 |   :type '(choice (const :tag "Default" nil) integer)
 159 |   :group 'ggtags)
 160 | 
 161 | (defcustom ggtags-global-abbreviate-filename 40
 162 |   "Non-nil to display file names abbreviated e.g. \"/u/b/env\".
 163 | If an integer abbreviate only names longer than that number."
 164 |   :type '(choice (const :tag "No" nil)
 165 |                  (const :tag "Always" t)
 166 |                  integer)
 167 |   :group 'ggtags)
 168 | 
 169 | (defcustom ggtags-split-window-function split-window-preferred-function
 170 |   "A function to control how ggtags pops up the auxiliary window."
 171 |   :type 'function
 172 |   :group 'ggtags)
 173 | 
 174 | (defcustom ggtags-use-idutils (and (executable-find "mkid") t)
 175 |   "Non-nil to also generate the idutils DB."
 176 |   :type 'boolean
 177 |   :group 'ggtags)
 178 | 
 179 | (defcustom ggtags-use-sqlite3 nil
 180 |   "Use sqlite3 for storage instead of Berkeley DB.
 181 | This feature requires GNU Global 6.3.3+ and is ignored if `gtags'
 182 | isn't built with sqlite3 support."
 183 |   :type 'boolean
 184 |   :safe 'booleanp
 185 |   :group 'ggtags)
 186 | 
 187 | (defcustom ggtags-extra-args nil
 188 |   "Extra arguments to pass to `gtags' in `ggtags-create-tags'."
 189 |   :type '(repeat string)
 190 |   :safe #'ggtags-list-of-string-p
 191 |   :group 'ggtags)
 192 | 
 193 | (defcustom ggtags-sort-by-nearness nil
 194 |   "Sort tags by nearness to current directory.
 195 | GNU Global 6.5+ required."
 196 |   :type 'boolean
 197 |   :safe #'booleanp
 198 |   :group 'ggtags)
 199 | 
 200 | (defcustom ggtags-update-on-save t
 201 |   "Non-nil to update tags for current buffer on saving."
 202 |   ;; It is reported that `global --single-update' can be slow in sshfs
 203 |   ;; directories. See https://github.com/leoliu/ggtags/issues/85.
 204 |   :safe #'booleanp
 205 |   :type 'boolean
 206 |   :group 'ggtags)
 207 | 
 208 | (defcustom ggtags-global-output-format 'grep
 209 |   "Global output format: path, ctags, ctags-x, grep or cscope."
 210 |   :type '(choice (const path)
 211 |                  (const ctags)
 212 |                  (const ctags-x)
 213 |                  (const grep)
 214 |                  (const cscope))
 215 |   :group 'ggtags)
 216 | 
 217 | (defcustom ggtags-global-use-color t
 218 |   "Non-nil to use color in output if supported by Global.
 219 | Note: processing colored output takes noticeable time
 220 | particularly when the output is large."
 221 |   :type 'boolean
 222 |   :safe 'booleanp
 223 |   :group 'ggtags)
 224 | 
 225 | (defcustom ggtags-global-ignore-case nil
 226 |   "Non-nil if Global should ignore case in the search pattern."
 227 |   :safe 'booleanp
 228 |   :type 'boolean
 229 |   :group 'ggtags)
 230 | 
 231 | (defcustom ggtags-global-treat-text nil
 232 |   "Non-nil if Global should include matches from text files.
 233 | This affects `ggtags-find-file' and `ggtags-grep'."
 234 |   :safe 'booleanp
 235 |   :type 'boolean
 236 |   :group 'ggtags)
 237 | 
 238 | ;; See also https://github.com/leoliu/ggtags/issues/52
 239 | (defcustom ggtags-global-search-libpath-for-reference t
 240 |   "If non-nil global will search GTAGSLIBPATH for references.
 241 | Search is only continued in GTAGSLIBPATH if it finds no matches
 242 | in current project."
 243 |   :safe 'booleanp
 244 |   :type 'boolean
 245 |   :group 'ggtags)
 246 | 
 247 | (defcustom ggtags-global-large-output 1000
 248 |   "Number of lines in the Global buffer to indicate large output."
 249 |   :type 'number
 250 |   :group 'ggtags)
 251 | 
 252 | (defcustom ggtags-global-history-length history-length
 253 |   "Maximum number of items to keep in `ggtags-global-search-history'."
 254 |   :type 'integer
 255 |   :group 'ggtags)
 256 | 
 257 | (defcustom ggtags-enable-navigation-keys t
 258 |   "If non-nil key bindings in `ggtags-navigation-map' are enabled."
 259 |   :safe 'booleanp
 260 |   :type 'boolean
 261 |   :group 'ggtags)
 262 | 
 263 | (defcustom ggtags-find-tag-hook nil
 264 |   "Hook run immediately after finding a tag."
 265 |   :options '(recenter reposition-window)
 266 |   :type 'hook
 267 |   :group 'ggtags)
 268 | 
 269 | (defcustom ggtags-get-definition-function #'ggtags-get-definition-default
 270 |   "Function called by `ggtags-show-definition' to get definition.
 271 | It is passed a list of definition candidates of the form:
 272 | 
 273 |  (TEXT NAME FILE LINE)
 274 | 
 275 | where TEXT is usually the source line of the definition.
 276 | 
 277 | The return value is passed to `ggtags-print-definition-function'."
 278 |   :type 'function
 279 |   :group 'ggtags)
 280 | 
 281 | (defcustom ggtags-print-definition-function
 282 |   (lambda (s) (ggtags-echo "%s" (or s "[definition not found]")))
 283 |   "Function used by `ggtags-show-definition' to print definition."
 284 |   :type 'function
 285 |   :group 'ggtags)
 286 | 
 287 | (defcustom ggtags-mode-sticky t
 288 |   "If non-nil enable Ggtags Mode in files visited."
 289 |   :safe 'booleanp
 290 |   :type 'boolean
 291 |   :group 'ggtags)
 292 | 
 293 | (defcustom ggtags-mode-prefix-key "\C-c"
 294 |   "Key binding used for `ggtags-mode-prefix-map'.
 295 | Users should change the value using `customize-variable' to
 296 | properly update `ggtags-mode-map'."
 297 |   :set (lambda (sym value)
 298 |          (when (bound-and-true-p ggtags-mode-map)
 299 |            (let ((old (and (boundp sym) (symbol-value sym))))
 300 |              (and old (define-key ggtags-mode-map old nil)))
 301 |            (and value
 302 |                 (bound-and-true-p ggtags-mode-prefix-map)
 303 |                 (define-key ggtags-mode-map value ggtags-mode-prefix-map)))
 304 |          (set-default sym value))
 305 |   :type 'key-sequence
 306 |   :group 'ggtags)
 307 | 
 308 | (defcustom ggtags-completing-read-function nil
 309 |   "Ggtags specific `completing-read-function' (which see).
 310 | Nil means using the value of `completing-read-function'."
 311 |   :type '(choice (const :tag "Use completing-read-function" nil)
 312 |                  function)
 313 |   :group 'ggtags)
 314 | 
 315 | (define-obsolete-variable-alias 'ggtags-highlight-tag-delay 'ggtags-highlight-tag
 316 |   "0.8.11")
 317 | 
 318 | (defcustom ggtags-highlight-tag 0.25
 319 |   "If non-nil time in seconds before highlighting tag at point.
 320 | Set to nil to disable tag highlighting."
 321 |   :set (lambda (sym value)
 322 |          (when (fboundp 'ggtags-setup-highlight-tag-at-point)
 323 |            (ggtags-setup-highlight-tag-at-point value))
 324 |          (set-default sym value))
 325 |   :type '(choice (const :tag "Disable" nil) number)
 326 |   :group 'ggtags)
 327 | 
 328 | (defcustom ggtags-bounds-of-tag-function (lambda ()
 329 |                                            (bounds-of-thing-at-point 'symbol))
 330 |   "Function to get the start and end positions of the tag at point."
 331 |   :type 'function
 332 |   :group 'ggtags)
 333 | 
 334 | ;; Used by ggtags-global-mode
 335 | (defvar ggtags-global-error "match"
 336 |   "Stem of message to print when no matches are found.")
 337 | 
 338 | (defconst ggtags-bug-url "https://github.com/leoliu/ggtags/issues")
 339 | 
 340 | (defvar ggtags-global-last-buffer nil)
 341 | 
 342 | (defvar ggtags-global-continuation nil)
 343 | 
 344 | (defvar ggtags-current-tag-name nil)
 345 | 
 346 | (defvar ggtags-highlight-tag-overlay nil)
 347 | 
 348 | (defvar ggtags-highlight-tag-timer nil)
 349 | 
 350 | (defmacro ggtags-with-temp-message (message &rest body)
 351 |   (declare (debug t) (indent 1))
 352 |   (let ((init-time (make-symbol "-init-time-"))
 353 |         (tmp-msg (make-symbol "-tmp-msg-")))
 354 |     `(let ((,init-time (float-time))
 355 |            (,tmp-msg ,message))
 356 |        (with-temp-message ,tmp-msg
 357 |          (prog1 (progn ,@body)
 358 |            (message "%sdone (%.2fs)" ,(or tmp-msg "")
 359 |                     (- (float-time) ,init-time)))))))
 360 | 
 361 | (defmacro ggtags-delay-finish-functions (&rest body)
 362 |   "Delay running `compilation-finish-functions' until after BODY."
 363 |   (declare (indent 0) (debug t))
 364 |   (let ((saved (make-symbol "-saved-"))
 365 |         (exit-args (make-symbol "-exit-args-")))
 366 |     `(let ((,saved compilation-finish-functions)
 367 |            ,exit-args)
 368 |        (setq-local compilation-finish-functions nil)
 369 |        (add-hook 'compilation-finish-functions
 370 |                  (lambda (&rest args) (setq ,exit-args args))
 371 |                  nil t)
 372 |        (unwind-protect (progn ,@body)
 373 |          (setq-local compilation-finish-functions ,saved)
 374 |          (and ,exit-args (apply #'run-hook-with-args
 375 |                                 'compilation-finish-functions ,exit-args))))))
 376 | 
 377 | (defmacro ggtags-ensure-global-buffer (&rest body)
 378 |   (declare (debug t) (indent 0))
 379 |   `(progn
 380 |      (or (and (buffer-live-p ggtags-global-last-buffer)
 381 |               (with-current-buffer ggtags-global-last-buffer
 382 |                 (derived-mode-p 'ggtags-global-mode)))
 383 |          (error "No global buffer found"))
 384 |      (with-current-buffer ggtags-global-last-buffer ,@body)))
 385 | 
 386 | (defun ggtags-list-of-string-p (xs)
 387 |   "Return non-nil if XS is a list of strings."
 388 |   (cl-every #'stringp xs))
 389 | 
 390 | (defun ggtags-ensure-localname (file)
 391 |   (and file (or (file-remote-p file 'localname) file)))
 392 | 
 393 | (defun ggtags-echo (format-string &rest args)
 394 |   "Print formatted text to echo area."
 395 |   (let (message-log-max) (apply #'message format-string args)))
 396 | 
 397 | (defun ggtags-forward-to-line (line)
 398 |   "Move to line number LINE in current buffer."
 399 |   (cl-check-type line (integer 1))
 400 |   (save-restriction
 401 |     (widen)
 402 |     (goto-char (point-min))
 403 |     (forward-line (1- line))))
 404 | 
 405 | (defun ggtags-kill-window ()
 406 |   "Quit selected window and kill its buffer."
 407 |   (interactive)
 408 |   (quit-window t))
 409 | 
 410 | (defun ggtags-program-path (name)
 411 |   (if ggtags-executable-directory
 412 |       (expand-file-name name ggtags-executable-directory)
 413 |     name))
 414 | 
 415 | (defun ggtags-process-succeed-p (program &rest args)
 416 |   "Return non-nil if successfully running PROGRAM with ARGS."
 417 |   (let ((program (ggtags-program-path program)))
 418 |     (condition-case err
 419 |         (zerop (apply #'process-file program nil nil nil args))
 420 |       (error (message "`%s' failed: %s" program (error-message-string err))
 421 |              nil))))
 422 | 
 423 | (defun ggtags-process-string (program &rest args)
 424 |   (with-temp-buffer
 425 |     (let ((exit (apply #'process-file
 426 |                        (ggtags-program-path program) nil t nil args))
 427 |           (output (progn
 428 |                     (goto-char (point-max))
 429 |                     (skip-chars-backward " \t\n\r")
 430 |                     (buffer-substring-no-properties (point-min) (point)))))
 431 |       (or (zerop exit)
 432 |           (error "`%s' non-zero exit: %s" program output))
 433 |       output)))
 434 | 
 435 | (defun ggtags-tag-at-point ()
 436 |   (pcase (funcall ggtags-bounds-of-tag-function)
 437 |     (`(,beg . ,end) (buffer-substring-no-properties beg end))))
 438 | 
 439 | ;;; Store for project info and settings
 440 | 
 441 | (defvar ggtags-projects (make-hash-table :size 7 :test #'equal))
 442 | 
 443 | (cl-defstruct (ggtags-project (:constructor ggtags-project--make)
 444 |                               (:copier nil)
 445 |                               (:type vector)
 446 |                               :named)
 447 |   root tag-size has-refs has-path-style has-color dirty-p mtime timestamp)
 448 | 
 449 | (defun ggtags-make-project (root)
 450 |   (cl-check-type root string)
 451 |   (let* ((default-directory (file-name-as-directory root))
 452 |          ;; NOTE: use of GTAGSDBPATH is not recommended. -- GLOBAL(1)
 453 |          ;; ROOT and DB can be different directories due to GTAGSDBPATH.
 454 |          (dbdir (concat (file-remote-p root)
 455 |                         (ggtags-process-string "global" "-p"))))
 456 |     (pcase (nthcdr 5 (file-attributes (expand-file-name "GTAGS" dbdir)))
 457 |       (`(,mtime ,_ ,tag-size . ,_)
 458 |        (let* ((rtags-size (nth 7 (file-attributes (expand-file-name "GRTAGS" dbdir))))
 459 |               (has-refs
 460 |                (when rtags-size
 461 |                  (and (or (> rtags-size (* 32 1024))
 462 |                           (with-demoted-errors "ggtags-make-project: %S"
 463 |                             (not (equal "" (ggtags-process-string "global" "-crs")))))
 464 |                       'has-refs)))
 465 |               ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1518
 466 |               (has-path-style
 467 |                (and (ggtags-process-succeed-p "global" "--path-style" "shorter" "--help")
 468 |                     'has-path-style))
 469 |               ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1542
 470 |               (has-color (and (ggtags-process-succeed-p "global" "--color" "--help")
 471 |                               'has-color)))
 472 |          (puthash default-directory
 473 |                   (ggtags-project--make :root default-directory
 474 |                                         :tag-size tag-size
 475 |                                         :has-refs has-refs
 476 |                                         :has-path-style has-path-style
 477 |                                         :has-color has-color
 478 |                                         :mtime (float-time mtime)
 479 |                                         :timestamp (float-time))
 480 |                   ggtags-projects))))))
 481 | 
 482 | (defun ggtags-project-expired-p (project)
 483 |   (or (< (ggtags-project-timestamp project) 0)
 484 |       (> (- (float-time)
 485 |             (ggtags-project-timestamp project))
 486 |          ggtags-project-duration)))
 487 | 
 488 | (defun ggtags-project-update-mtime-maybe (&optional project)
 489 |   "Update PROJECT's modtime and if current file is newer.
 490 | Value is new modtime if updated."
 491 |   (let ((project (or project (ggtags-find-project))))
 492 |     (when (and (ggtags-project-p project)
 493 |                (consp (visited-file-modtime))
 494 |                (> (float-time (visited-file-modtime))
 495 |                   (ggtags-project-mtime project)))
 496 |       (setf (ggtags-project-dirty-p project) t)
 497 |       (setf (ggtags-project-mtime project)
 498 |             (float-time (visited-file-modtime))))))
 499 | 
 500 | (defun ggtags-project-oversize-p (&optional project)
 501 |   (pcase ggtags-oversize-limit
 502 |     (`nil nil)
 503 |     (`t t)
 504 |     (size (let ((project (or project (ggtags-find-project))))
 505 |             (and project (> (ggtags-project-tag-size project) size))))))
 506 | 
 507 | (defvar-local ggtags-last-default-directory nil)
 508 | (defvar-local ggtags-project-root 'unset
 509 |   "Internal variable for project root directory.")
 510 | 
 511 | ;;;###autoload
 512 | (defun ggtags-find-project ()
 513 |   ;; See https://github.com/leoliu/ggtags/issues/42
 514 |   ;;
 515 |   ;; It is unsafe to cache `ggtags-project-root' in non-file buffers
 516 |   ;; whose `default-directory' can often change.
 517 |   (unless (equal ggtags-last-default-directory default-directory)
 518 |     (kill-local-variable 'ggtags-project-root))
 519 |   (let ((project (gethash ggtags-project-root ggtags-projects)))
 520 |     (if (ggtags-project-p project)
 521 |         (if (ggtags-project-expired-p project)
 522 |             (progn
 523 |               (remhash ggtags-project-root ggtags-projects)
 524 |               (ggtags-find-project))
 525 |           project)
 526 |       (setq ggtags-last-default-directory default-directory)
 527 |       (setq ggtags-project-root
 528 |             (or (ignore-errors
 529 |                   (file-name-as-directory
 530 |                    (concat (file-remote-p default-directory)
 531 |                            ;; Resolves symbolic links
 532 |                            (ggtags-process-string "global" "-pr"))))
 533 |                 ;; 'global -pr' resolves symlinks before checking the
 534 |                 ;; GTAGS file which could cause issues such as
 535 |                 ;; https://github.com/leoliu/ggtags/issues/22, so
 536 |                 ;; let's help it out.
 537 |                 (let ((dir (locate-dominating-file
 538 |                             default-directory
 539 |                             (lambda (dir) (file-regular-p (expand-file-name "GTAGS" dir))))))
 540 |                   ;; `file-truename' may strip the trailing '/' on
 541 |                   ;; remote hosts, see http://debbugs.gnu.org/16851
 542 |                   (and dir (file-name-as-directory (file-truename dir))))))
 543 |       (when ggtags-project-root
 544 |         (if (gethash ggtags-project-root ggtags-projects)
 545 |             (ggtags-find-project)
 546 |           (ggtags-make-project ggtags-project-root))))))
 547 | 
 548 | (defun ggtags-current-project-root ()
 549 |   (and (ggtags-find-project)
 550 |        (ggtags-project-root (ggtags-find-project))))
 551 | 
 552 | (defun ggtags-check-project ()
 553 |   (or (ggtags-find-project) (error "File GTAGS not found")))
 554 | 
 555 | (defun ggtags-ensure-project ()
 556 |   (or (ggtags-find-project)
 557 |       (progn (call-interactively #'ggtags-create-tags)
 558 |              ;; Need checking because `ggtags-create-tags' can create
 559 |              ;; tags in any directory.
 560 |              (ggtags-check-project))))
 561 | 
 562 | (defun ggtags-save-project-settings (&optional noconfirm)
 563 |   "Save Gnu Global's specific environment variables."
 564 |   (interactive "P")
 565 |   (ggtags-check-project)
 566 |   (let* ((inhibit-read-only t)          ; for `add-dir-local-variable'
 567 |          (default-directory (ggtags-current-project-root))
 568 |          ;; Not using `ggtags-with-current-project' to preserve
 569 |          ;; environment variables that may be present in
 570 |          ;; `ggtags-process-environment'.
 571 |          (process-environment
 572 |           (append ggtags-process-environment
 573 |                   process-environment
 574 |                   (and (not (ggtags-project-has-refs (ggtags-find-project)))
 575 |                        (list "GTAGSLABEL=ctags"))))
 576 |          (envlist (delete-dups
 577 |                    (cl-loop for x in process-environment
 578 |                             when (string-match
 579 |                                   "^\\(GTAGS[^=\n]*\\|MAKEOBJDIRPREFIX\\)=" x)
 580 |                             ;; May have duplicates thus `delete-dups'.
 581 |                             collect (concat (match-string 1 x)
 582 |                                             "="
 583 |                                             (getenv (match-string 1 x))))))
 584 |          (help-form (format "y: save\nn: don't save\n=: diff\n?: help\n")))
 585 |     (add-dir-local-variable nil 'ggtags-process-environment envlist)
 586 |     ;; Remove trailing newlines by `add-dir-local-variable'.
 587 |     (let ((delete-trailing-lines t)) (delete-trailing-whitespace))
 588 |     (or noconfirm
 589 |         (while (pcase (read-char-choice
 590 |                        (format "Save `%s'? (y/n/=/?) " buffer-file-name)
 591 |                        '(?y ?n ?= ??))
 592 |                  (?n (user-error "Aborted"))
 593 |                  (?y nil)
 594 |                  (?= (diff-buffer-with-file) 'loop)
 595 |                  (?? (help-form-show) 'loop))))
 596 |     (save-buffer)
 597 |     (kill-buffer)))
 598 | 
 599 | (defun ggtags-toggle-project-read-only ()
 600 |   (interactive)
 601 |   (ggtags-check-project)
 602 |   (let ((inhibit-read-only t)           ; for `add-dir-local-variable'
 603 |         (val (not buffer-read-only))
 604 |         (default-directory (ggtags-current-project-root)))
 605 |     (add-dir-local-variable nil 'buffer-read-only val)
 606 |     (save-buffer)
 607 |     (kill-buffer)
 608 |     (when buffer-file-name
 609 |       (read-only-mode (if val +1 -1)))
 610 |     (when (called-interactively-p 'interactive)
 611 |       (message "Project read-only-mode is %s" (if val "on" "off")))
 612 |     val))
 613 | 
 614 | (defun ggtags-visit-project-root (&optional project)
 615 |   "Visit the root directory of (current) PROJECT in dired.
 616 | When called with a prefix \\[universal-argument], choose from past projects."
 617 |   (interactive (list (and current-prefix-arg
 618 |                           (completing-read "Project: " ggtags-projects))))
 619 |   (dired (cl-typecase project
 620 |            (string project)
 621 |            (ggtags-project (ggtags-project-root project))
 622 |            (t (ggtags-ensure-project) (ggtags-current-project-root)))))
 623 | 
 624 | (defmacro ggtags-with-current-project (&rest body)
 625 |   "Eval BODY in current project's `process-environment'."
 626 |   (declare (debug t) (indent 0))
 627 |   (let ((gtagsroot (make-symbol "-gtagsroot-"))
 628 |         (root (make-symbol "-ggtags-project-root-")))
 629 |     `(let* ((,root ggtags-project-root)
 630 |             (,gtagsroot (when (ggtags-find-project)
 631 |                           (ggtags-ensure-localname
 632 |                            (directory-file-name (ggtags-current-project-root)))))
 633 |             (process-environment
 634 |              (append (let ((process-environment (copy-sequence process-environment)))
 635 |                        (and ,gtagsroot (setenv "GTAGSROOT" ,gtagsroot))
 636 |                        (mapcar #'substitute-env-vars ggtags-process-environment))
 637 |                      process-environment
 638 |                      (and ,gtagsroot (list (concat "GTAGSROOT=" ,gtagsroot)))
 639 |                      (and (ggtags-find-project)
 640 |                           (not (ggtags-project-has-refs (ggtags-find-project)))
 641 |                           (list "GTAGSLABEL=ctags")))))
 642 |        (unwind-protect (save-current-buffer ,@body)
 643 |          (setq ggtags-project-root ,root)))))
 644 | 
 645 | (defun ggtags-get-libpath ()
 646 |   (let ((path (ggtags-with-current-project (getenv "GTAGSLIBPATH"))))
 647 |     (and path (mapcar (apply-partially #'concat (file-remote-p default-directory))
 648 |                       (split-string path (regexp-quote path-separator) t)))))
 649 | 
 650 | (defun ggtags-project-relative-file (file)
 651 |   "Get file name relative to current project root."
 652 |   (ggtags-check-project)
 653 |   (if (file-name-absolute-p file)
 654 |       (file-relative-name file (if (string-prefix-p (ggtags-current-project-root)
 655 |                                                     file)
 656 |                                    (ggtags-current-project-root)
 657 |                                  (locate-dominating-file file "GTAGS")))
 658 |     file))
 659 | 
 660 | (defun ggtags-project-file-p (file)
 661 |   "Return non-nil if FILE is part of current project."
 662 |   (when (ggtags-find-project)
 663 |     (with-temp-buffer
 664 |       (ggtags-with-current-project
 665 |         ;; NOTE: `process-file' requires all files in ARGS be relative
 666 |         ;; to `default-directory'; see its doc string for details.
 667 |         (let ((default-directory (ggtags-current-project-root)))
 668 |           (process-file (ggtags-program-path "global") nil t nil
 669 |                         "-vP" (concat "^" (ggtags-project-relative-file file) "$"))))
 670 |       (goto-char (point-min))
 671 |       (not (re-search-forward "^file not found" nil t)))))
 672 | 
 673 | (defun ggtags-invalidate-buffer-project-root (root)
 674 |   (mapc (lambda (buf)
 675 |           (with-current-buffer buf
 676 |             (and buffer-file-truename
 677 |                  (string-prefix-p root buffer-file-truename)
 678 |                  (kill-local-variable 'ggtags-project-root))))
 679 |         (buffer-list)))
 680 | 
 681 | (defun ggtags-create-tags (root)
 682 |   "Create tag files (e.g. GTAGS) in directory ROOT.
 683 | If file .globalrc or gtags.conf exists in ROOT, it will be used
 684 | as configuration file per `ggtags-use-project-gtagsconf'.
 685 | 
 686 | If file gtags.files exists in ROOT, it should be a list of source
 687 | files to index, which can be used to speed gtags up in large
 688 | source trees. See Info node `(global)gtags' for details."
 689 |   (interactive "DRoot directory: ")
 690 |   (let ((process-environment (copy-sequence process-environment)))
 691 |     (when (zerop (length root)) (error "No root directory provided"))
 692 |     (setenv "GTAGSROOT" (ggtags-ensure-localname
 693 |                          (expand-file-name
 694 |                           (directory-file-name (file-name-as-directory root)))))
 695 |     (ggtags-with-current-project
 696 |       (let ((conf (and ggtags-use-project-gtagsconf
 697 |                        (cl-loop for name in '(".globalrc" "gtags.conf")
 698 |                                 for full = (expand-file-name name root)
 699 |                                 thereis (and (file-exists-p full) full)))))
 700 |         (unless (or conf (getenv "GTAGSLABEL")
 701 |                     (not (yes-or-no-p "Use `ctags' backend? ")))
 702 |           (setenv "GTAGSLABEL" "ctags"))
 703 |         (ggtags-with-temp-message "`gtags' in progress..."
 704 |           (let ((default-directory (file-name-as-directory root))
 705 |                 (args (append (cl-remove-if
 706 |                                #'null
 707 |                                (list (and ggtags-use-idutils "--idutils")
 708 |                                      (and ggtags-use-sqlite3
 709 |                                           (ggtags-process-succeed-p "gtags" "--sqlite3" "--help")
 710 |                                           "--sqlite3")
 711 |                                      (and conf "--gtagsconf")
 712 |                                      (and conf (ggtags-ensure-localname conf))))
 713 |                               ggtags-extra-args)))
 714 |             (condition-case err
 715 |                 (apply #'ggtags-process-string "gtags" args)
 716 |               (error (if (and ggtags-use-idutils
 717 |                               (stringp (cadr err))
 718 |                               (string-match-p "mkid not found" (cadr err)))
 719 |                          ;; Retry without mkid
 720 |                          (apply #'ggtags-process-string
 721 |                                 "gtags" (cl-remove "--idutils" args))
 722 |                        (signal (car err) (cdr err)))))))))
 723 |     (ggtags-invalidate-buffer-project-root (file-truename root))
 724 |     (message "GTAGS generated in `%s'" root)
 725 |     root))
 726 | 
 727 | (defun ggtags-explain-tags ()
 728 |   "Explain how each file is indexed in current project."
 729 |   (interactive (ignore (ggtags-check-project)
 730 |                        (or (ggtags-process-succeed-p "gtags" "--explain" "--help")
 731 |                            (user-error "Global 6.4+ required"))))
 732 |   (ggtags-check-project)
 733 |   (ggtags-with-current-project
 734 |     (let ((default-directory (ggtags-current-project-root)))
 735 |       (compilation-start (concat (ggtags-program-path "gtags") " --explain")))))
 736 | 
 737 | (defun ggtags-update-tags (&optional force)
 738 |   "Update GNU Global tag database.
 739 | Do nothing if GTAGS exceeds the oversize limit unless FORCE.
 740 | 
 741 | When called interactively on large (per `ggtags-oversize-limit')
 742 | projects, the update process runs in the background without
 743 | blocking emacs."
 744 |   (interactive (progn
 745 |                  (ggtags-check-project)
 746 |                  ;; Mark project info expired.
 747 |                  (setf (ggtags-project-timestamp (ggtags-find-project)) -1)
 748 |                  (list 'interactive)))
 749 |   (cond ((and (eq force 'interactive) (ggtags-project-oversize-p))
 750 |          (ggtags-with-current-project
 751 |            (with-display-buffer-no-window
 752 |              (with-current-buffer (compilation-start "global -u")
 753 |                ;; A hack to fool compilation mode to display `global
 754 |                ;; -u finished' on finish.
 755 |                (setq mode-name "global -u")
 756 |                (add-hook 'compilation-finish-functions
 757 |                          #'ggtags-update-tags-finish nil t)))))
 758 |         ((or force (and (ggtags-find-project)
 759 |                         (not (ggtags-project-oversize-p))
 760 |                         (ggtags-project-dirty-p (ggtags-find-project))))
 761 |          (ggtags-with-current-project
 762 |            (ggtags-with-temp-message "`global -u' in progress..."
 763 |              (ggtags-process-string "global" "-u")
 764 |              (ggtags-update-tags-finish))))))
 765 | 
 766 | (defun ggtags-update-tags-finish (&optional buf how)
 767 |   (if (and how buf (string-prefix-p "exited abnormally" how))
 768 |       (display-buffer buf)
 769 |     (setf (ggtags-project-dirty-p (ggtags-find-project)) nil)
 770 |     (setf (ggtags-project-mtime (ggtags-find-project)) (float-time))))
 771 | 
 772 | (defun ggtags-update-tags-single (file &optional nowait)
 773 |   ;; NOTE: NOWAIT is ignored if file is remote file; see
 774 |   ;; `tramp-sh-handle-process-file'.
 775 |   (cl-check-type file string)
 776 |   (let ((nowait (unless (file-remote-p file) nowait)))
 777 |     (ggtags-with-current-project
 778 |       ;; See comment in `ggtags-project-file-p'.
 779 |       (let ((default-directory (ggtags-current-project-root)))
 780 |         (process-file (ggtags-program-path "global") nil (and nowait 0) nil
 781 |                       "--single-update" (ggtags-project-relative-file file))))))
 782 | 
 783 | (defun ggtags-delete-tags ()
 784 |   "Delete file GTAGS, GRTAGS, GPATH, ID etc. generated by gtags."
 785 |   (interactive (ignore (ggtags-check-project)))
 786 |   (when (ggtags-current-project-root)
 787 |     (let* ((re (concat "\\`" (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID")) "\\'"))
 788 |            (files (cl-remove-if-not
 789 |                    (lambda (file)
 790 |                      ;; Don't trust `directory-files'.
 791 |                      (let ((case-fold-search nil))
 792 |                        (string-match-p re (file-name-nondirectory file))))
 793 |                    (directory-files (ggtags-current-project-root) t re)))
 794 |            (buffer "*GTags File List*"))
 795 |       (or files (user-error "No tag files found"))
 796 |       (with-output-to-temp-buffer buffer
 797 |         (princ (mapconcat #'identity files "\n")))
 798 |       (let ((win (get-buffer-window buffer)))
 799 |         (unwind-protect
 800 |             (progn
 801 |               (fit-window-to-buffer win)
 802 |               (when (yes-or-no-p "Remove GNU Global tag files? ")
 803 |                 (with-demoted-errors (mapc #'delete-file files))
 804 |                 (remhash (ggtags-current-project-root) ggtags-projects)
 805 |                 (and (overlayp ggtags-highlight-tag-overlay)
 806 |                      (delete-overlay ggtags-highlight-tag-overlay))))
 807 |           (when (window-live-p win)
 808 |             (quit-window t win)))))))
 809 | 
 810 | (defvar-local ggtags-completion-cache nil)
 811 | 
 812 | ;; See global/libutil/char.c
 813 | ;; (defconst ggtags-regexp-metachars "[][$()*+.?\\{}|^]")
 814 | (defvar ggtags-completion-flag "")      ;internal use
 815 | 
 816 | (defvar ggtags-completion-table
 817 |   (completion-table-dynamic
 818 |    (lambda (prefix)
 819 |      (let ((cache-key (concat prefix "$" ggtags-completion-flag)))
 820 |        (unless (equal cache-key (car ggtags-completion-cache))
 821 |          (setq ggtags-completion-cache
 822 |                (cons cache-key
 823 |                      (ignore-errors-unless-debug
 824 |                        ;; May throw global: only name char is allowed
 825 |                        ;; with -c option.
 826 |                        (ggtags-with-current-project
 827 |                          (split-string
 828 |                           (apply #'ggtags-process-string
 829 |                                  "global"
 830 |                                  (append (and completion-ignore-case '("--ignore-case"))
 831 |                                          ;; Note -c alone returns only definitions
 832 |                                          (list (concat "-c" ggtags-completion-flag) prefix)))
 833 |                           "\n" t)))))))
 834 |      (cdr ggtags-completion-cache))))
 835 | 
 836 | (defun ggtags-completion-at-point ()
 837 |   "A function for `completion-at-point-functions'."
 838 |   (pcase (funcall ggtags-bounds-of-tag-function)
 839 |     (`(,beg . ,end)
 840 |      (and (< beg end) (list beg end ggtags-completion-table)))))
 841 | 
 842 | (defun ggtags-read-tag (&optional type confirm prompt require-match default)
 843 |   (ggtags-ensure-project)
 844 |   (let ((default (or default (ggtags-tag-at-point)))
 845 |         (prompt (or prompt (capitalize (symbol-name (or type 'tag)))))
 846 |         (ggtags-completion-flag (pcase type
 847 |                                   (`(or nil definition) "T")
 848 |                                   (`symbol "s")
 849 |                                   (`reference "r")
 850 |                                   (`id "I")
 851 |                                   (`path "P")
 852 |                                   ((pred stringp) type)
 853 |                                   (_ ggtags-completion-flag))))
 854 |     (setq ggtags-current-tag-name
 855 |           (cond (confirm
 856 |                  (ggtags-update-tags)
 857 |                  (let ((completing-read-function
 858 |                         (or ggtags-completing-read-function
 859 |                             completing-read-function)))
 860 |                    (completing-read
 861 |                     (format (if default "%s (default %s): " "%s: ") prompt default)
 862 |                     ggtags-completion-table nil require-match nil nil default)))
 863 |                 (default (substring-no-properties default))
 864 |                 (t (ggtags-read-tag type t prompt require-match default))))))
 865 | 
 866 | (defun ggtags-sort-by-nearness-p (&optional start-location)
 867 |   (and ggtags-sort-by-nearness
 868 |        (ggtags-process-succeed-p "global" "--nearness=." "--help")
 869 |        (concat "--nearness="
 870 |                (or start-location buffer-file-name default-directory))))
 871 | 
 872 | (defun ggtags-global-build-command (cmd &rest args)
 873 |   ;; CMD can be definition, reference, symbol, grep, idutils
 874 |   (let ((xs (append (list (shell-quote-argument (ggtags-program-path "global"))
 875 |                           "-v"
 876 |                           (format "--result=%s" ggtags-global-output-format)
 877 |                           (and ggtags-global-ignore-case "--ignore-case")
 878 |                           (and ggtags-global-use-color
 879 |                                (ggtags-find-project)
 880 |                                (ggtags-project-has-color (ggtags-find-project))
 881 |                                "--color=always")
 882 |                           (and (ggtags-find-project)
 883 |                                (ggtags-project-has-path-style (ggtags-find-project))
 884 |                                "--path-style=shorter")
 885 |                           (and ggtags-global-treat-text "--other")
 886 |                           (pcase cmd
 887 |                             ((pred stringp) cmd)
 888 |                             (`definition nil) ;-d not supported by Global 5.7.1
 889 |                             (`reference "--reference")
 890 |                             (`symbol "--symbol")
 891 |                             (`path "--path")
 892 |                             (`grep "--grep")
 893 |                             (`idutils "--idutils")))
 894 |                     args)))
 895 |     (mapconcat #'identity (delq nil xs) " ")))
 896 | 
 897 | ;; Can be three values: nil, t and a marker; t means start marker has
 898 | ;; been saved in the tag ring.
 899 | (defvar ggtags-global-start-marker nil)
 900 | (defvar ggtags-global-start-file nil)
 901 | (defvar ggtags-tag-ring-index nil)
 902 | (defvar ggtags-global-search-history nil)
 903 | 
 904 | (defvar ggtags-auto-jump-to-match-target nil)
 905 | 
 906 | (defvar-local ggtags-global-exit-info nil) ; (EXIT-STATUS COUNT DB)
 907 | 
 908 | (defun ggtags-global-save-start-marker ()
 909 |   (when (markerp ggtags-global-start-marker)
 910 |     (setq ggtags-tag-ring-index nil)
 911 |     (xref-push-marker-stack ggtags-global-start-marker)
 912 |     (setq ggtags-global-start-marker t)))
 913 | 
 914 | (defun ggtags-global-start (command &optional directory)
 915 |   (let* ((default-directory (or directory (ggtags-current-project-root)))
 916 |          (split-window-preferred-function ggtags-split-window-function)
 917 |          (env ggtags-process-environment))
 918 |     (unless (and (markerp ggtags-global-start-marker)
 919 |                  (marker-position ggtags-global-start-marker))
 920 |       (setq ggtags-global-start-marker (point-marker)))
 921 |     ;; Record the file name for `ggtags-navigation-start-file'.
 922 |     (setq ggtags-global-start-file buffer-file-name)
 923 |     (setq ggtags-auto-jump-to-match-target
 924 |           (nth 4 (assoc (ggtags-global-search-id command default-directory)
 925 |                         ggtags-global-search-history)))
 926 |     (ggtags-navigation-mode +1)
 927 |     (ggtags-update-tags)
 928 |     (ggtags-with-current-project
 929 |       (with-current-buffer (with-display-buffer-no-window
 930 |                              (compilation-start command 'ggtags-global-mode))
 931 |         (setq-local ggtags-process-environment env)
 932 |         (setq ggtags-global-last-buffer (current-buffer))))))
 933 | 
 934 | (defun ggtags-find-tag-continue ()
 935 |   (interactive)
 936 |   (ggtags-ensure-global-buffer
 937 |     (ggtags-navigation-mode +1)
 938 |     (let ((split-window-preferred-function ggtags-split-window-function))
 939 |       (ignore-errors (compilation-next-error 1))
 940 |       (compile-goto-error))))
 941 | 
 942 | (defun ggtags-find-tag (cmd &rest args)
 943 |   (ggtags-check-project)
 944 |   (let ((nearness (ggtags-sort-by-nearness-p
 945 |                    (ggtags-project-relative-file
 946 |                     (or buffer-file-name default-directory)))))
 947 |     (ggtags-global-start
 948 |      (apply #'ggtags-global-build-command cmd nearness args))))
 949 | 
 950 | (defun ggtags-include-file ()
 951 |   "Calculate the include file based on `ggtags-include-pattern'."
 952 |   (pcase ggtags-include-pattern
 953 |     (`nil nil)
 954 |     ((pred functionp)
 955 |      (funcall ggtags-include-pattern))
 956 |     (`(,re . ,sub)
 957 |      (save-excursion
 958 |        (beginning-of-line)
 959 |        (and (looking-at re) (match-string sub))))
 960 |     (_ (warn "Invalid value for `ggtags-include-pattern': %s"
 961 |              ggtags-include-pattern)
 962 |        nil)))
 963 | 
 964 | ;;;###autoload
 965 | (defun ggtags-find-tag-dwim (name &optional what)
 966 |   "Find NAME by context.
 967 | If point is at a definition tag, find references, and vice versa.
 968 | If point is at a line that matches `ggtags-include-pattern', find
 969 | the include file instead.
 970 | 
 971 | When called interactively with a prefix arg, always find
 972 | definition tags."
 973 |   (interactive
 974 |    (let ((include (and (not current-prefix-arg) (ggtags-include-file))))
 975 |      (ggtags-ensure-project)
 976 |      (if include (list include 'include)
 977 |        (list (ggtags-read-tag 'definition current-prefix-arg)
 978 |              (and current-prefix-arg 'definition)))))
 979 |   (ggtags-check-project)    ; For `ggtags-current-project-root' below.
 980 |   (cond
 981 |    ((eq what 'include)
 982 |     (ggtags-find-file name))
 983 |    ((or (eq what 'definition)
 984 |         (not buffer-file-name)
 985 |         (not (ggtags-project-has-refs (ggtags-find-project)))
 986 |         (not (ggtags-project-file-p buffer-file-name)))
 987 |     (ggtags-find-definition name))
 988 |    (t (ggtags-find-tag
 989 |        (format "--from-here=%d:%s"
 990 |                (line-number-at-pos)
 991 |                ;; Note `ggtags-find-tag' binds `default-directory' to
 992 |                ;; project root.
 993 |                (shell-quote-argument
 994 |                 (ggtags-project-relative-file buffer-file-name)))
 995 |        "--" (shell-quote-argument name)))))
 996 | 
 997 | (defun ggtags-find-tag-mouse (event)
 998 |   (interactive "e")
 999 |   (with-selected-window (posn-window (event-start event))
1000 |     (save-excursion
1001 |       (goto-char (posn-point (event-start event)))
1002 |       (call-interactively #'ggtags-find-tag-dwim))))
1003 | 
1004 | ;; Another option for `M-.'.
1005 | (defun ggtags-find-definition (name)
1006 |   (interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
1007 |   (ggtags-find-tag 'definition "--" (shell-quote-argument name)))
1008 | 
1009 | (defun ggtags-setup-libpath-search (type name)
1010 |   (pcase (and ggtags-global-search-libpath-for-reference
1011 |               (ggtags-get-libpath))
1012 |     ((and libs (guard libs))
1013 |      (cl-labels ((cont (buf how)
1014 |                    (pcase ggtags-global-exit-info
1015 |                      (`(0 0 ,_)
1016 |                       (with-temp-buffer
1017 |                         (setq default-directory
1018 |                               (file-name-as-directory (pop libs)))
1019 |                         (and libs (setq ggtags-global-continuation #'cont))
1020 |                         (if (ggtags-find-project)
1021 |                             (ggtags-find-tag type (shell-quote-argument name))
1022 |                           (cont buf how))))
1023 |                      (_ (ggtags-global-handle-exit buf how)))))
1024 |        (setq ggtags-global-continuation #'cont)))))
1025 | 
1026 | (defun ggtags-find-reference (name)
1027 |   (interactive (list (ggtags-read-tag 'reference current-prefix-arg)))
1028 |   (ggtags-setup-libpath-search 'reference name)
1029 |   (ggtags-find-tag 'reference "--" (shell-quote-argument name)))
1030 | 
1031 | (defun ggtags-find-other-symbol (name)
1032 |   "Find tag NAME that is a reference without a definition."
1033 |   (interactive (list (ggtags-read-tag 'symbol current-prefix-arg)))
1034 |   (ggtags-setup-libpath-search 'symbol name)
1035 |   (ggtags-find-tag 'symbol "--" (shell-quote-argument name)))
1036 | 
1037 | (defun ggtags-quote-pattern (pattern)
1038 |   (prin1-to-string (substring-no-properties pattern)))
1039 | 
1040 | (defun ggtags-idutils-query (pattern)
1041 |   (interactive (list (ggtags-read-tag 'id t)))
1042 |   (ggtags-find-tag 'idutils "--" (ggtags-quote-pattern pattern)))
1043 | 
1044 | (defun ggtags-grep (pattern &optional invert-match)
1045 |   "Grep for lines matching PATTERN.
1046 | Invert the match when called with a prefix arg \\[universal-argument]."
1047 |   (interactive (list (ggtags-read-tag 'definition 'confirm
1048 |                                       (if current-prefix-arg
1049 |                                           "Inverted grep pattern" "Grep pattern"))
1050 |                      current-prefix-arg))
1051 |   (ggtags-find-tag 'grep (and invert-match "--invert-match")
1052 |                    "--" (ggtags-quote-pattern pattern)))
1053 | 
1054 | (defun ggtags-find-file (pattern &optional invert-match)
1055 |   (interactive (list (ggtags-read-tag 'path 'confirm (if current-prefix-arg
1056 |                                                          "Inverted path pattern"
1057 |                                                        "Path pattern")
1058 |                                       nil (thing-at-point 'filename))
1059 |                      current-prefix-arg))
1060 |   (let ((ggtags-global-output-format 'path))
1061 |     (ggtags-find-tag 'path (and invert-match "--invert-match")
1062 |                      "--" (ggtags-quote-pattern pattern))))
1063 | 
1064 | ;; Note: Coloured output requested in http://goo.gl/Y9IcX and appeared
1065 | ;; in global v6.2.12.
1066 | (defun ggtags-find-tag-regexp (regexp directory)
1067 |   "List tags matching REGEXP in DIRECTORY (default to project root).
1068 | When called interactively with a prefix, ask for the directory."
1069 |   (interactive
1070 |    (progn
1071 |      (ggtags-check-project)
1072 |      (list (ggtags-read-tag "" t "POSIX regexp")
1073 |            (if current-prefix-arg
1074 |                (read-directory-name "Directory: " nil nil t)
1075 |              (ggtags-current-project-root)))))
1076 |   (ggtags-check-project)
1077 |   (ggtags-global-start
1078 |    (ggtags-global-build-command nil nil "-l" "--" (ggtags-quote-pattern regexp))
1079 |    (file-name-as-directory directory)))
1080 | 
1081 | (defvar ggtags-navigation-mode)
1082 | 
1083 | (defun ggtags-foreach-file (fn)
1084 |   "Invoke FN with each file found.
1085 | FN is invoked while *ggtags-global* buffer is current."
1086 |   (ggtags-ensure-global-buffer
1087 |     (save-excursion
1088 |       (goto-char (point-min))
1089 |       (while (with-demoted-errors "compilation-next-error: %S"
1090 |                (compilation-next-error 1 'file)
1091 |                t)
1092 |         (funcall fn (caar
1093 |                      (compilation--loc->file-struct
1094 |                       (compilation--message->loc
1095 |                        (get-text-property (point) 'compilation-message)))))))))
1096 | 
1097 | (defun ggtags-query-replace (from to &optional delimited)
1098 |   "Query replace FROM with TO on files in the Global buffer.
1099 | If not in navigation mode, do a grep on FROM first.
1100 | 
1101 | Note: the regular expression FROM must be supported by both
1102 | Global and Emacs."
1103 |   (interactive
1104 |    ;; Note: in 24.4 query-replace-read-args returns a list of 4 elements.
1105 |    (let ((args (query-replace-read-args "Query replace (regexp)" t t)))
1106 |      (list (nth 0 args) (nth 1 args) (nth 2 args))))
1107 |   (unless ggtags-navigation-mode
1108 |     (let ((ggtags-auto-jump-to-match nil))
1109 |       (ggtags-grep from)))
1110 |   (let ((file-form
1111 |          '(let ((files))
1112 |             (ggtags-ensure-global-buffer
1113 |               (ggtags-with-temp-message "Waiting for Grep to finish..."
1114 |                 (while (get-buffer-process (current-buffer))
1115 |                   (sit-for 0.2)))
1116 |               (ggtags-foreach-file
1117 |                (lambda (file) (push (expand-file-name file) files))))
1118 |             (ggtags-navigation-mode -1)
1119 |             (nreverse files))))
1120 |     (tags-query-replace from to delimited file-form)))
1121 | 
1122 | (defun ggtags-global-normalise-command (cmd)
1123 |   (if (string-match
1124 |        (concat (regexp-quote (ggtags-global-build-command nil)) "\\s-*")
1125 |        cmd)
1126 |       (substring-no-properties cmd (match-end 0))
1127 |     cmd))
1128 | 
1129 | (defun ggtags-global-search-id (cmd directory)
1130 |   (sha1 (concat directory (make-string 1 0)
1131 |                 (ggtags-global-normalise-command cmd))))
1132 | 
1133 | (defun ggtags-global-current-search ()
1134 |   ;; CMD DIR ENV LINE TEXT
1135 |   (ggtags-ensure-global-buffer
1136 |     (list (ggtags-global-normalise-command (car compilation-arguments))
1137 |           default-directory
1138 |           ggtags-process-environment
1139 |           (line-number-at-pos)
1140 |           (buffer-substring-no-properties
1141 |            (line-beginning-position) (line-end-position)))))
1142 | 
1143 | (defun ggtags-global-rerun-search (data)
1144 |   (pcase data
1145 |     (`(,cmd ,dir ,env ,line ,_text)
1146 |      (with-current-buffer (let ((ggtags-auto-jump-to-match nil)
1147 |                                 ;; Switch current project to DIR.
1148 |                                 (default-directory dir)
1149 |                                 (ggtags-project-root dir)
1150 |                                 (ggtags-process-environment env))
1151 |                             (ggtags-global-start
1152 |                              (ggtags-global-build-command cmd) dir))
1153 |        (add-hook 'compilation-finish-functions
1154 |                  (lambda (buf _msg)
1155 |                    (with-current-buffer buf
1156 |                      (ggtags-forward-to-line line)
1157 |                      (compile-goto-error)))
1158 |                  nil t)))))
1159 | 
1160 | (defvar-local ggtags-global-search-ewoc nil)
1161 | (defvar ggtags-view-search-history-last nil)
1162 | 
1163 | (defvar ggtags-view-search-history-mode-map
1164 |   (let ((m (make-sparse-keymap)))
1165 |     (define-key m "p" 'ggtags-view-search-history-prev)
1166 |     (define-key m "\M-p" 'ggtags-view-search-history-prev)
1167 |     (define-key m "n" 'ggtags-view-search-history-next)
1168 |     (define-key m "\M-n" 'ggtags-view-search-history-next)
1169 |     (define-key m "\C-k" 'ggtags-view-search-history-kill)
1170 |     (define-key m [remap yank] (lambda (&optional arg) (interactive "P") (yank arg)))
1171 |     (define-key m "\C-c\C-c" 'ggtags-view-search-history-update)
1172 |     (define-key m "r" 'ggtags-save-to-register)
1173 |     (define-key m "\r" 'ggtags-view-search-history-action)
1174 |     (define-key m "q" 'ggtags-kill-window)
1175 |     m))
1176 | 
1177 | (defun ggtags-view-search-history-remember ()
1178 |   (setq ggtags-view-search-history-last
1179 |         (pcase (ewoc-locate ggtags-global-search-ewoc)
1180 |           (`nil nil)
1181 |           (node (ewoc-data node)))))
1182 | 
1183 | (defun ggtags-view-search-history-next (&optional arg)
1184 |   (interactive "p")
1185 |   (let ((arg (or arg 1)))
1186 |     (prog1 (funcall (if (cl-minusp arg) #'ewoc-goto-prev #'ewoc-goto-next)
1187 |                     ggtags-global-search-ewoc (abs arg))
1188 |       (ggtags-view-search-history-remember))))
1189 | 
1190 | (defun ggtags-view-search-history-prev (&optional arg)
1191 |   (interactive "p")
1192 |   (ggtags-view-search-history-next (- (or arg 1))))
1193 | 
1194 | (defun ggtags-view-search-history-kill (&optional append)
1195 |   (interactive "P")
1196 |   (let* ((node (or (ewoc-locate ggtags-global-search-ewoc)
1197 |                    (user-error "No node at point")))
1198 |          (next (ewoc-next ggtags-global-search-ewoc node))
1199 |          (text (filter-buffer-substring (ewoc-location node)
1200 |                                         (if next (ewoc-location next)
1201 |                                           (point-max)))))
1202 |     (put-text-property
1203 |      0 (length text) 'yank-handler
1204 |      (list (lambda (arg)
1205 |              (if (not ggtags-global-search-ewoc)
1206 |                  (insert (car arg))
1207 |                (let* ((inhibit-read-only t)
1208 |                       (node (unless (looking-at-p "[ \t\n]*\\'")
1209 |                               (ewoc-locate ggtags-global-search-ewoc))))
1210 |                  (if node
1211 |                      (ewoc-enter-before ggtags-global-search-ewoc
1212 |                                         node (cadr arg))
1213 |                    (ewoc-enter-last ggtags-global-search-ewoc (cadr arg)))
1214 |                  (setq ggtags-view-search-history-last (cadr arg)))))
1215 |            (list text (ewoc-data node)))
1216 |      text)
1217 |     (if append (kill-append text nil)
1218 |       (kill-new text))
1219 |     (let ((inhibit-read-only t))
1220 |       (ewoc-delete ggtags-global-search-ewoc node))))
1221 | 
1222 | (defun ggtags-view-search-history-update (&optional noconfirm)
1223 |   "Update `ggtags-global-search-history' to current buffer."
1224 |   (interactive "P")
1225 |   (when (and (buffer-modified-p)
1226 |              (or noconfirm
1227 |                  (yes-or-no-p "Modify `ggtags-global-search-history'?")))
1228 |     (setq ggtags-global-search-history
1229 |           (ewoc-collect ggtags-global-search-ewoc #'identity))
1230 |     (set-buffer-modified-p nil)))
1231 | 
1232 | (defun ggtags-view-search-history-action ()
1233 |   (interactive)
1234 |   (let ((data (ewoc-data (or (ewoc-locate ggtags-global-search-ewoc)
1235 |                              (user-error "No search at point")))))
1236 |     (ggtags-view-search-history-remember)
1237 |     (quit-window t)
1238 |     (ggtags-global-rerun-search (cdr data))))
1239 | 
1240 | (defvar bookmark-make-record-function)
1241 | 
1242 | (define-derived-mode ggtags-view-search-history-mode special-mode "SearchHist"
1243 |   "Major mode for viewing search history."
1244 |   :group 'ggtags
1245 |   (setq-local ggtags-enable-navigation-keys nil)
1246 |   (setq-local bookmark-make-record-function #'ggtags-make-bookmark-record)
1247 |   (setq truncate-lines t)
1248 |   (add-hook 'kill-buffer-hook #'ggtags-view-search-history-update nil t))
1249 | 
1250 | (defun ggtags-view-search-history-restore-last ()
1251 |   (when ggtags-view-search-history-last
1252 |     (cl-loop for n = (ewoc-nth ggtags-global-search-ewoc 0)
1253 |              then (ewoc-next ggtags-global-search-ewoc n)
1254 |              while n when (eq (ewoc-data n)
1255 |                               ggtags-view-search-history-last)
1256 |              do (progn (goto-char (ewoc-location n)) (cl-return t)))))
1257 | 
1258 | (defun ggtags-view-search-history ()
1259 |   "Pop to a buffer to view or re-run past searches.
1260 | 
1261 | \\{ggtags-view-search-history-mode-map}"
1262 |   (interactive)
1263 |   (or ggtags-global-search-history (user-error "No search history"))
1264 |   (let ((split-window-preferred-function ggtags-split-window-function)
1265 |         (inhibit-read-only t))
1266 |     (pop-to-buffer "*Ggtags Search History*")
1267 |     (erase-buffer)
1268 |     (ggtags-view-search-history-mode)
1269 |     (cl-labels ((prop (s)
1270 |                   (propertize s 'face 'minibuffer-prompt))
1271 |                 (prop-tag (cmd)
1272 |                   (with-temp-buffer
1273 |                     (insert cmd)
1274 |                     (forward-sexp -1)
1275 |                     (if (eobp)
1276 |                         cmd
1277 |                       (put-text-property (point) (point-max)
1278 |                                          'face font-lock-constant-face)
1279 |                       (buffer-string))))
1280 |                 (pp (data)
1281 |                   (pcase data
1282 |                     (`(,_id ,cmd ,dir ,_env ,line ,text)
1283 |                      (insert (prop " cmd: ") (prop-tag cmd) "\n"
1284 |                              (prop " dir: ") dir "\n"
1285 |                              (prop "line: ") (number-to-string line) "\n"
1286 |                              (prop "text: ") text "\n"
1287 |                              (propertize (make-string 32 ?-) 'face 'shadow))))))
1288 |       (setq ggtags-global-search-ewoc
1289 |             (ewoc-create #'pp "Global search history keys:  n:next  p:prev  r:register  RET:choose\n")))
1290 |     (dolist (data ggtags-global-search-history)
1291 |       (ewoc-enter-last ggtags-global-search-ewoc data))
1292 |     (ggtags-view-search-history-restore-last)
1293 |     (set-buffer-modified-p nil)
1294 |     (fit-window-to-buffer nil (floor (frame-height) 2))))
1295 | 
1296 | (defun ggtags-save-to-register (r)
1297 |   "Save current search session to register R.
1298 | Use \\[jump-to-register] to restore the search session."
1299 |   (interactive (list (register-read-with-preview "Save search to register: ")))
1300 |   (cl-labels ((prn (data)
1301 |                 (pcase data
1302 |                   (`(,command ,root ,_env ,line ,_)
1303 |                    (princ (format "a ggtags search session `%s' in directory `%s' at line %d."
1304 |                                   command root line))))))
1305 |     (set-register r (registerv-make
1306 |                      (if ggtags-global-search-ewoc
1307 |                          (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
1308 |                        (ggtags-global-current-search))
1309 |                      :jump-func #'ggtags-global-rerun-search
1310 |                      :print-func #'prn))))
1311 | 
1312 | (defun ggtags-make-bookmark-record ()
1313 |   `(,(and ggtags-current-tag-name (format "*ggtags %s*" ggtags-current-tag-name))
1314 |     (ggtags-search . ,(if ggtags-global-search-ewoc
1315 |                           (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
1316 |                         (ggtags-global-current-search)))
1317 |     (handler . ggtags-bookmark-jump)))
1318 | 
1319 | (declare-function bookmark-prop-get "bookmark")
1320 | 
1321 | (defun ggtags-bookmark-jump (bmk)
1322 |   (ggtags-global-rerun-search (bookmark-prop-get bmk 'ggtags-search)))
1323 | 
1324 | (defun ggtags-browse-file-as-hypertext (file line)
1325 |   "Browse FILE in hypertext (HTML) form."
1326 |   (interactive (if (or current-prefix-arg (not buffer-file-name))
1327 |                    (list (read-file-name "Browse file: " nil nil t)
1328 |                          (read-number "Line: " 1))
1329 |                  (list buffer-file-name (line-number-at-pos))))
1330 |   (cl-check-type line (integer 1))
1331 |   (or (and file (file-exists-p file)) (error "File `%s' doesn't exist" file))
1332 |   (ggtags-check-project)
1333 |   (or (file-exists-p (expand-file-name "HTML" (ggtags-current-project-root)))
1334 |       (if (yes-or-no-p "No hypertext form exists; run htags? ")
1335 |           (let ((default-directory (ggtags-current-project-root)))
1336 |             (ggtags-with-current-project (ggtags-process-string "htags")))
1337 |         (user-error "Aborted")))
1338 |   (let ((url (ggtags-process-string "gozilla" "-p" (format "+%d" line)
1339 |                                     (file-relative-name file))))
1340 |     (or (equal (file-name-extension
1341 |                 (url-filename (url-generic-parse-url url))) "html")
1342 |         (user-error "No hypertext form for `%s'" file))
1343 |     (when (called-interactively-p 'interactive)
1344 |       (message "Browsing %s" url))
1345 |     (browse-url url)))
1346 | 
1347 | (defun ggtags-next-mark (&optional arg)
1348 |   "Move to the next (newer) mark in the tag marker ring."
1349 |   (interactive)
1350 |   (and (ring-empty-p xref--marker-ring) (user-error "Tag ring empty"))
1351 |   (setq ggtags-tag-ring-index
1352 |         ;; Note `ring-minus1' gets newer item.
1353 |         (funcall (if arg #'ring-plus1 #'ring-minus1)
1354 |                  (or ggtags-tag-ring-index
1355 |                      (progn (xref-push-marker-stack)
1356 |                             0))
1357 |                  (ring-length xref--marker-ring)))
1358 |   (let ((m (ring-ref xref--marker-ring ggtags-tag-ring-index))
1359 |         (i (- (ring-length xref--marker-ring) ggtags-tag-ring-index)))
1360 |     (ggtags-echo "%d%s marker%s" i (pcase (mod i 10)
1361 |                                      (1 "st")
1362 |                                      (2 "nd")
1363 |                                      (3 "rd")
1364 |                                      (_ "th"))
1365 |                  (if (marker-buffer m) "" " (dead)"))
1366 |     (if (not (marker-buffer m))
1367 |         (ding)
1368 |       (switch-to-buffer (marker-buffer m))
1369 |       (goto-char m))))
1370 | 
1371 | (defun ggtags-prev-mark ()
1372 |   "Move to the previous (older) mark in the tag marker ring."
1373 |   (interactive)
1374 |   (ggtags-next-mark 'previous))
1375 | 
1376 | (defvar ggtags-view-tag-history-mode-map
1377 |   (let ((m (make-sparse-keymap)))
1378 |     (define-key m "\M-n" 'next-error-no-select)
1379 |     (define-key m "\M-p" 'previous-error-no-select)
1380 |     (define-key m "q"    'ggtags-kill-window)
1381 |     m))
1382 | 
1383 | (define-derived-mode ggtags-view-tag-history-mode tabulated-list-mode "TagHist"
1384 |   :abbrev-table nil :group 'ggtags)
1385 | 
1386 | (defun ggtags-view-tag-history ()
1387 |   "Pop to a buffer listing visited locations from newest to oldest.
1388 | The buffer is a next error buffer and works with standard
1389 | commands `next-error' and `previous-error'.
1390 | 
1391 | \\{ggtags-view-tag-history-mode-map}"
1392 |   (interactive)
1393 |   (and (ring-empty-p xref--marker-ring)
1394 |        (user-error "Tag ring empty"))
1395 |   (let ((split-window-preferred-function ggtags-split-window-function)
1396 |         (inhibit-read-only t))
1397 |     (pop-to-buffer "*Tag Ring*")
1398 |     (erase-buffer)
1399 |     (ggtags-view-tag-history-mode)
1400 |     (setq next-error-function #'ggtags-view-tag-history-next-error
1401 |           next-error-last-buffer (current-buffer))
1402 |     (setq tabulated-list-entries
1403 |           ;; Use a function so that revert can work properly.
1404 |           (lambda ()
1405 |             (let ((counter (ring-length xref--marker-ring))
1406 |                   (elements (or (ring-elements xref--marker-ring)
1407 |                                 (user-error "Tag ring empty")))
1408 |                   (action (lambda (_button) (next-error 0)))
1409 |                   (get-line (lambda (m)
1410 |                               (with-current-buffer (marker-buffer m)
1411 |                                 (save-excursion
1412 |                                   (goto-char m)
1413 |                                   (buffer-substring (line-beginning-position)
1414 |                                                     (line-end-position)))))))
1415 |               (setq tabulated-list-format
1416 |                     `[("ID" ,(max (1+ (floor (log counter 10))) 2)
1417 |                        car-less-than-car)
1418 |                       ("Buffer" ,(max (cl-loop for m in elements
1419 |                                                for b = (marker-buffer m)
1420 |                                                maximize
1421 |                                                (length (and b (buffer-name b))))
1422 |                                       6)
1423 |                        t :right-align t)
1424 |                       ("Position" ,(max (cl-loop for m in elements
1425 |                                                  for p = (or (marker-position m) 1)
1426 |                                                  maximize (1+ (floor (log p 10))))
1427 |                                         8)
1428 |                        (lambda (x y)
1429 |                          (< (string-to-number (aref (cadr x) 2))
1430 |                             (string-to-number (aref (cadr y) 2))))
1431 |                        :right-align t)
1432 |                       ("Contents" 100 t)])
1433 |               (tabulated-list-init-header)
1434 |               (mapcar (lambda (x)
1435 |                         (prog1
1436 |                             (list counter
1437 |                                   (if (marker-buffer x)
1438 |                                       (vector (number-to-string counter)
1439 |                                               `(,(buffer-name (marker-buffer x))
1440 |                                                 face link
1441 |                                                 follow-link t
1442 |                                                 marker ,x
1443 |                                                 action ,action)
1444 |                                               (number-to-string (marker-position x))
1445 |                                               (funcall get-line x))
1446 |                                     (vector (number-to-string counter)
1447 |                                             "(dead)" "?" "?")))
1448 |                           (cl-decf counter)))
1449 |                       elements))))
1450 |     (setq tabulated-list-sort-key '("ID" . t))
1451 |     (tabulated-list-print)
1452 |     (fit-window-to-buffer nil (floor (frame-height) 2))))
1453 | 
1454 | (defun ggtags-view-tag-history-next-error (&optional arg reset)
1455 |   (if (not reset)
1456 |       (forward-button arg)
1457 |     (goto-char (point-min))
1458 |     (forward-button (if (button-at (point)) 0 1)))
1459 |   (when (get-buffer-window)
1460 |     (set-window-point (get-buffer-window) (point)))
1461 |   (pcase (button-get (button-at (point)) 'marker)
1462 |     ((and (pred markerp) m)
1463 |      (if (eq (get-buffer-window) (selected-window))
1464 |          (pop-to-buffer (marker-buffer m))
1465 |        (switch-to-buffer (marker-buffer m)))
1466 |      (goto-char (marker-position m)))
1467 |     (_ (error "Dead marker"))))
1468 | 
1469 | (defun ggtags-global-exit-message-1 ()
1470 |   "Get the total of matches and db file used."
1471 |   (save-excursion
1472 |     (goto-char (point-max))
1473 |     (if (re-search-backward
1474 |          "^\\w+ \\(not found\\)\\|^\\([0-9]+\\) \\w+ located" nil t)
1475 |         (cons (or (and (match-string 1) 0)
1476 |                   (string-to-number (match-string 2)))
1477 |               (when (re-search-forward
1478 |                      "using \\(?:\\(idutils\\)\\|'[^']*/\\(\\w+\\)'\\)"
1479 |                      (line-end-position)
1480 |                      t)
1481 |                 (or (and (match-string 1) "ID")
1482 |                     (match-string 2))))
1483 |       (cons 0 nil))))
1484 | 
1485 | (defun ggtags-global-exit-message-function (_process-status exit-status msg)
1486 |   "A function for `compilation-exit-message-function'."
1487 |   (pcase (ggtags-global-exit-message-1)
1488 |     (`(,count . ,db)
1489 |      (setq ggtags-global-exit-info (list exit-status count db))
1490 |      ;; Clear the start marker in case of zero matches.
1491 |      (and (zerop count)
1492 |           (markerp ggtags-global-start-marker)
1493 |           (not ggtags-global-continuation)
1494 |           (setq ggtags-global-start-marker nil))
1495 |      (cons (if (> exit-status 0)
1496 |                msg
1497 |              (format "found %d %s" count
1498 |                      (funcall (if (= count 1) #'car #'cadr)
1499 |                               (pcase db
1500 |                                 ("GTAGS"  '("definition" "definitions"))
1501 |                                 ("GSYMS"  '("symbol"     "symbols"))
1502 |                                 ("GRTAGS" '("reference"  "references"))
1503 |                                 ("GPATH"  '("file"       "files"))
1504 |                                 ("ID"     '("identifier" "identifiers"))
1505 |                                 (_         '("match"      "matches"))))))
1506 |            exit-status))))
1507 | 
1508 | (defun ggtags-global-column (start)
1509 |   ;; START is the beginning position of source text.
1510 |   (let ((mbeg (text-property-any start (line-end-position) 'global-color t)))
1511 |     (and mbeg (- mbeg start))))
1512 | 
1513 | ;;; NOTE: Must not match the 'Global started at Mon Jun 3 10:24:13'
1514 | ;;; line or `compilation-auto-jump' will jump there and fail. See
1515 | ;;; comments before the 'gnu' entry in
1516 | ;;; `compilation-error-regexp-alist-alist'.
1517 | (defvar ggtags-global-error-regexp-alist-alist
1518 |   (append
1519 |    `((path "^\\(?:[^\"'\n]*/\\)?[^ )\t\n]+$" 0)
1520 |      ;; ACTIVE_ESCAPE   src/dialog.cc   172
1521 |      (ctags "^\\([^ \t\n]+\\)[ \t]+\\(.*?\\)[ \t]+\\([0-9]+\\)$"
1522 |             2 3 nil nil 2 (1 font-lock-function-name-face))
1523 |      ;; ACTIVE_ESCAPE     172 src/dialog.cc    #undef ACTIVE_ESCAPE
1524 |      (ctags-x "^\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(\\(?:[^/\n]*/\\)?[^ \t\n]+\\)"
1525 |               3 2 (,(lambda () (ggtags-global-column (1+ (match-end 0)))))
1526 |               nil 3 (1 font-lock-function-name-face))
1527 |      ;; src/dialog.cc:172:#undef ACTIVE_ESCAPE
1528 |      (grep "^\\(.+?\\):\\([0-9]+\\):\\(?:$\\|[^0-9\n]\\|[0-9][^0-9\n]\\|[0-9][0-9].\\)"
1529 |            1 2 (,(lambda () (ggtags-global-column (1+ (match-end 2))))) nil 1)
1530 |      ;; src/dialog.cc ACTIVE_ESCAPE 172 #undef ACTIVE_ESCAPE
1531 |      (cscope "^\\(.+?\\)[ \t]+\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\).*\\(?:[^0-9\n]\\|[^0-9\n][0-9]\\|[^:\n][0-9][0-9]\\)$"
1532 |              1 3 nil nil 1 (2 font-lock-function-name-face)))
1533 |    compilation-error-regexp-alist-alist))
1534 | 
1535 | (defun ggtags-abbreviate-file (start end)
1536 |   (let ((inhibit-read-only t)
1537 |         (amount (if (numberp ggtags-global-abbreviate-filename)
1538 |                     (- (- end start) ggtags-global-abbreviate-filename)
1539 |                   999))
1540 |         (advance-word (lambda ()
1541 |                         "Return the length of the text made invisible."
1542 |                         (let ((wend (min end (progn (forward-word 1) (point))))
1543 |                               (wbeg (max start (progn (backward-word 1) (point)))))
1544 |                           (goto-char wend)
1545 |                           (if (<= (- wend wbeg) 1)
1546 |                               0
1547 |                             (put-text-property (1+ wbeg) wend 'invisible t)
1548 |                             (1- (- wend wbeg)))))))
1549 |     (goto-char start)
1550 |     (while (and (> amount 0) (> end (point)))
1551 |       (cl-decf amount (funcall advance-word)))))
1552 | 
1553 | (defun ggtags-abbreviate-files (start end)
1554 |   (goto-char start)
1555 |   (let* ((error-re (cdr (assq (car compilation-error-regexp-alist)
1556 |                               ggtags-global-error-regexp-alist-alist)))
1557 |          (sub (cadr error-re)))
1558 |     (when (and ggtags-global-abbreviate-filename error-re)
1559 |       (while (re-search-forward (car error-re) end t)
1560 |         (when (and (or (not (numberp ggtags-global-abbreviate-filename))
1561 |                        (> (length (match-string sub))
1562 |                           ggtags-global-abbreviate-filename))
1563 |                    ;; Ignore bogus file lines such as:
1564 |                    ;;     Global found 2 matches at Thu Jan 31 13:45:19
1565 |                    (get-text-property (match-beginning sub) 'compilation-message))
1566 |           (ggtags-abbreviate-file (match-beginning sub) (match-end sub)))))))
1567 | 
1568 | (defvar-local ggtags-global-output-lines 0)
1569 | 
1570 | (defun ggtags-global--display-buffer (&optional buffer desired-point)
1571 |   (pcase (let ((buffer (or buffer (current-buffer)))
1572 |                (split-window-preferred-function ggtags-split-window-function))
1573 |            (and (not (get-buffer-window buffer))
1574 |                 (display-buffer buffer '(nil (allow-no-window . t)))))
1575 |     ((and (pred windowp) w)
1576 |      (with-selected-window w
1577 |        (compilation-set-window-height w)
1578 |        (and desired-point (goto-char desired-point))))))
1579 | 
1580 | (defun ggtags-global-filter ()
1581 |   "Called from `compilation-filter-hook' (which see)."
1582 |   (let ((ansi-color-apply-face-function
1583 |          (lambda (beg end face)
1584 |            (when face
1585 |              (ansi-color-apply-overlay-face beg end face)
1586 |              (put-text-property beg end 'global-color t)))))
1587 |     (ansi-color-apply-on-region compilation-filter-start (point)))
1588 |   ;; Get rid of line "Using config file '/PATH/TO/.globalrc'." or
1589 |   ;; "Using default configuration."
1590 |   (when (re-search-backward
1591 |          "^ *Using \\(?:config file '.*\\|default configuration.\\)\n"
1592 |          compilation-filter-start t)
1593 |     (replace-match ""))
1594 |   (cl-incf ggtags-global-output-lines
1595 |            (count-lines compilation-filter-start (point)))
1596 |   ;; If the number of output lines is small
1597 |   ;; `ggtags-global-handle-exit' takes care of displaying the buffer.
1598 |   (when (and (> ggtags-global-output-lines 30) ggtags-navigation-mode)
1599 |     (ggtags-global--display-buffer nil (or compilation-current-error (point-min))))
1600 |   (when (and (eq ggtags-auto-jump-to-match 'history)
1601 |              (numberp ggtags-auto-jump-to-match-target)
1602 |              (not compilation-current-error)
1603 |              ;; `ggtags-global-output-lines' is imprecise but use it
1604 |              ;; as first approximation.
1605 |              (> (+ 10 ggtags-global-output-lines) ggtags-auto-jump-to-match-target)
1606 |              (> (line-number-at-pos (point-max))
1607 |                 ggtags-auto-jump-to-match-target))
1608 |     (ggtags-forward-to-line ggtags-auto-jump-to-match-target)
1609 |     (setq-local ggtags-auto-jump-to-match-target nil)
1610 |     (ggtags-delay-finish-functions
1611 |       (with-display-buffer-no-window
1612 |         (condition-case nil
1613 |             (let ((compilation-auto-jump-to-first-error t))
1614 |               (compilation-auto-jump (current-buffer) (point)))
1615 |           (error (message "\
1616 | ggtags: history match invalid, jump to first match instead")
1617 |                  (first-error)))))
1618 |     ;; `compilation-filter' restores point and as a result commands
1619 |     ;; dependent on point such as `ggtags-navigation-next-file' and
1620 |     ;; `ggtags-navigation-previous-file' fail to work.
1621 |     (run-with-idle-timer
1622 |      0 nil
1623 |      (lambda (buf pt)
1624 |        (and (buffer-live-p buf)
1625 |             (with-current-buffer buf (goto-char pt))))
1626 |      (current-buffer) (point)))
1627 |   (make-local-variable 'ggtags-global-large-output)
1628 |   (when (> ggtags-global-output-lines ggtags-global-large-output)
1629 |     (cl-incf ggtags-global-large-output 500)
1630 |     (ggtags-echo "Output %d lines (Type `C-c C-k' to cancel)"
1631 |                  ggtags-global-output-lines)))
1632 | 
1633 | (defun ggtags-global-handle-exit (buf how)
1634 |   "A function for `compilation-finish-functions' (which see)."
1635 |   (cond
1636 |    (ggtags-global-continuation
1637 |     (let ((cont (prog1 ggtags-global-continuation
1638 |                   (setq ggtags-global-continuation nil))))
1639 |       (funcall cont buf how)))
1640 |    ((string-prefix-p "exited abnormally" how)
1641 |     ;; If exit abnormally display the buffer for inspection.
1642 |     (ggtags-global--display-buffer)
1643 |     (when (save-excursion
1644 |             (goto-char (point-max))
1645 |             (re-search-backward
1646 |              (eval-when-compile
1647 |                (format "^global: %s not found.$"
1648 |                        (regexp-opt '("GTAGS" "GRTAGS" "GSYMS" "GPATH"))))
1649 |              nil t))
1650 |       (ggtags-echo "WARNING: Global tag files missing in `%s'"
1651 |                    ggtags-project-root)
1652 |       (remhash ggtags-project-root ggtags-projects)))
1653 |    (ggtags-auto-jump-to-match
1654 |     (if (pcase (compilation-next-single-property-change
1655 |                 (point-min) 'compilation-message)
1656 |           ((and pt (guard pt))
1657 |            (compilation-next-single-property-change
1658 |             (save-excursion (goto-char pt) (end-of-line) (point))
1659 |             'compilation-message)))
1660 |         ;; There are multiple matches so pop up the buffer.
1661 |         (and ggtags-navigation-mode (ggtags-global--display-buffer))
1662 |       ;; Manually run the `compilation-auto-jump' timer. Hackish but
1663 |       ;; everything else seems unreliable. See:
1664 |       ;;
1665 |       ;; - http://debbugs.gnu.org/13829
1666 |       ;; - http://debbugs.gnu.org/23987
1667 |       ;; - https://github.com/leoliu/ggtags/issues/89
1668 |       ;;
1669 |       (pcase (cl-find 'compilation-auto-jump timer-list :key #'timer--function)
1670 |         (`nil )
1671 |         (timer (timer-event-handler timer)))
1672 |       (ggtags-navigation-mode -1)
1673 |       (ggtags-navigation-mode-cleanup buf t)))))
1674 | 
1675 | (defvar ggtags-global-mode-font-lock-keywords
1676 |   '(("^Global \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
1677 |      (1 'compilation-error)
1678 |      (2 'compilation-error nil t))
1679 |     ("^Global found \\([0-9]+\\)" (1 compilation-info-face))))
1680 | 
1681 | (define-compilation-mode ggtags-global-mode "Global"
1682 |   "A mode for showing outputs from gnu global."
1683 |   ;; Note: Place `ggtags-global-output-format' as first element for
1684 |   ;; `ggtags-abbreviate-files'.
1685 |   (setq-local compilation-error-regexp-alist (list ggtags-global-output-format))
1686 |   (when (markerp ggtags-global-start-marker)
1687 |     (setq ggtags-project-root
1688 |           (buffer-local-value 'ggtags-project-root
1689 |                               (marker-buffer ggtags-global-start-marker))))
1690 |   (pcase ggtags-auto-jump-to-match
1691 |     (`history (make-local-variable 'ggtags-auto-jump-to-match-target)
1692 |               (setq-local compilation-auto-jump-to-first-error
1693 |                           (not ggtags-auto-jump-to-match-target)))
1694 |     (`nil (setq-local compilation-auto-jump-to-first-error nil))
1695 |     (_ (setq-local compilation-auto-jump-to-first-error t)))
1696 |   (setq-local compilation-scroll-output nil)
1697 |   ;; See `compilation-move-to-column' for details.
1698 |   (setq-local compilation-first-column 0)
1699 |   (setq-local compilation-error-screen-columns nil)
1700 |   (setq-local compilation-disable-input t)
1701 |   (setq-local compilation-always-kill t)
1702 |   (setq-local compilation-error-face 'compilation-info)
1703 |   (setq-local compilation-exit-message-function
1704 |               'ggtags-global-exit-message-function)
1705 |   ;; See: https://github.com/leoliu/ggtags/issues/26
1706 |   (setq-local find-file-suppress-same-file-warnings t)
1707 |   (setq-local truncate-lines t)
1708 |   (jit-lock-register #'ggtags-abbreviate-files)
1709 |   (add-hook 'compilation-filter-hook 'ggtags-global-filter nil 'local)
1710 |   (add-hook 'compilation-finish-functions 'ggtags-global-handle-exit nil t)
1711 |   (setq-local bookmark-make-record-function #'ggtags-make-bookmark-record)
1712 |   (setq-local ggtags-enable-navigation-keys nil)
1713 |   (add-hook 'kill-buffer-hook (lambda () (ggtags-navigation-mode -1)) nil t))
1714 | 
1715 | ;; NOTE: Need this to avoid putting menu items in
1716 | ;; `emulation-mode-map-alists', which creates double entries. See
1717 | ;; http://i.imgur.com/VJJTzVc.png
1718 | (defvar ggtags-navigation-map
1719 |   (let ((map (make-sparse-keymap)))
1720 |     (define-key map "\M-n" 'next-error)
1721 |     (define-key map "\M-p" 'previous-error)
1722 |     (define-key map "\M-}" 'ggtags-navigation-next-file)
1723 |     (define-key map "\M-{" 'ggtags-navigation-previous-file)
1724 |     (define-key map "\M-=" 'ggtags-navigation-start-file)
1725 |     (define-key map "\M->" 'ggtags-navigation-last-error)
1726 |     (define-key map "\M-<" 'first-error)
1727 |     ;; Note: shadows `isearch-forward-regexp' but it can still be
1728 |     ;; invoked with `C-u C-s'.
1729 |     (define-key map "\C-\M-s" 'ggtags-navigation-isearch-forward)
1730 |     ;; Add an alternative binding because C-M-s is reported not
1731 |     ;; working on some systems.
1732 |     (define-key map "\M-ss" 'ggtags-navigation-isearch-forward)
1733 |     (define-key map "\C-c\C-k"
1734 |       (lambda () (interactive)
1735 |         (ggtags-ensure-global-buffer (kill-compilation))))
1736 |     (define-key map "\M-o" 'ggtags-navigation-visible-mode)
1737 |     (define-key map [return] 'ggtags-navigation-mode-done)
1738 |     (define-key map "\r" 'ggtags-navigation-mode-done)
1739 |     (define-key map [remap xref-pop-marker-stack] 'ggtags-navigation-mode-abort)
1740 |     map))
1741 | 
1742 | (defvar ggtags-mode-map-alist
1743 |   `((ggtags-enable-navigation-keys . ,ggtags-navigation-map)))
1744 | 
1745 | (defvar ggtags-navigation-mode-map
1746 |   (let ((map (make-sparse-keymap))
1747 |         (menu (make-sparse-keymap "GG-Navigation")))
1748 |     ;; Menu items: (info "(elisp)Extended Menu Items")
1749 |     (define-key map [menu-bar ggtags-navigation] (cons "GG-Navigation" menu))
1750 |     ;; Ordered backwards
1751 |     (define-key menu [visible-mode]
1752 |       '(menu-item "Visible mode" ggtags-navigation-visible-mode
1753 |                   :button (:toggle . (ignore-errors
1754 |                                        (ggtags-ensure-global-buffer
1755 |                                          visible-mode)))))
1756 |     (define-key menu [done]
1757 |       '(menu-item "Finish navigation" ggtags-navigation-mode-done))
1758 |     (define-key menu [abort]
1759 |       '(menu-item "Abort" ggtags-navigation-mode-abort))
1760 |     (define-key menu [last-match]
1761 |       '(menu-item "Last match" ggtags-navigation-last-error))
1762 |     (define-key menu [first-match] '(menu-item "First match" first-error))
1763 |     (define-key menu [previous-file]
1764 |       '(menu-item "Previous file" ggtags-navigation-previous-file))
1765 |     (define-key menu [next-file]
1766 |       '(menu-item "Next file" ggtags-navigation-next-file))
1767 |     (define-key menu [isearch-forward]
1768 |       '(menu-item "Find match with isearch" ggtags-navigation-isearch-forward))
1769 |     (define-key menu [previous]
1770 |       '(menu-item "Previous match" previous-error))
1771 |     (define-key menu [next]
1772 |       '(menu-item "Next match" next-error))
1773 |     map))
1774 | 
1775 | (defun ggtags-move-to-tag (&optional name)
1776 |   "Move to NAME tag in current line."
1777 |   (let ((tag (or name ggtags-current-tag-name)))
1778 |     ;; Do nothing if on the tag already i.e. by `ggtags-global-column'.
1779 |     (unless (or (not tag) (looking-at (concat (regexp-quote tag) "\\_>")))
1780 |       (let ((orig (point))
1781 |             (regexps (mapcar (lambda (fmtstr)
1782 |                                (format fmtstr (regexp-quote tag)))
1783 |                              '("\\_<%s\\_>" "%s\\_>" "%s"))))
1784 |         (beginning-of-line)
1785 |         (if (cl-loop for re in regexps
1786 |                      ;; Note: tag might not agree with current
1787 |                      ;; major-mode's symbol, so try harder. For
1788 |                      ;; example, in `php-mode' $cacheBackend is a
1789 |                      ;; symbol, but cacheBackend is a tag.
1790 |                      thereis (re-search-forward re (line-end-position) t))
1791 |             (goto-char (match-beginning 0))
1792 |           (goto-char orig))))))
1793 | 
1794 | (defun ggtags-navigation-mode-cleanup (&optional buf kill)
1795 |   (let ((buf (or buf ggtags-global-last-buffer)))
1796 |     (and (buffer-live-p buf)
1797 |          (with-current-buffer buf
1798 |            (when (get-buffer-process (current-buffer))
1799 |              (kill-compilation))
1800 |            (when (and (derived-mode-p 'ggtags-global-mode)
1801 |                       (get-buffer-window))
1802 |              (quit-windows-on (current-buffer)))
1803 |            (and kill (kill-buffer buf))))))
1804 | 
1805 | (defun ggtags-navigation-mode-done ()
1806 |   (interactive)
1807 |   (ggtags-navigation-mode -1)
1808 |   (setq tags-loop-scan t
1809 |         tags-loop-operate '(ggtags-find-tag-continue))
1810 |   (ggtags-navigation-mode-cleanup))
1811 | 
1812 | (defun ggtags-navigation-mode-abort ()
1813 |   "Abort navigation and return to where the search was started."
1814 |   (interactive)
1815 |   (ggtags-navigation-mode -1)
1816 |   (ggtags-navigation-mode-cleanup nil t)
1817 |   ;; Run after (ggtags-navigation-mode -1) or
1818 |   ;; ggtags-global-start-marker might not have been saved.
1819 |   (when (and ggtags-global-start-marker
1820 |              (not (markerp ggtags-global-start-marker)))
1821 |     (setq ggtags-global-start-marker nil)
1822 |     (xref-pop-marker-stack)))
1823 | 
1824 | (defun ggtags-navigation-next-file (n)
1825 |   (interactive "p")
1826 |   (ggtags-ensure-global-buffer
1827 |     (compilation-next-file n)
1828 |     (compile-goto-error)))
1829 | 
1830 | (defun ggtags-navigation-previous-file (n)
1831 |   (interactive "p")
1832 |   (ggtags-navigation-next-file (- n)))
1833 | 
1834 | (defun ggtags-navigation-start-file ()
1835 |   "Move to the file where navigation session starts."
1836 |   (interactive)
1837 |   (let ((start-file (or ggtags-global-start-file
1838 |                         (user-error "Cannot decide start file"))))
1839 |     (ggtags-ensure-global-buffer
1840 |       (pcase (cl-block nil
1841 |                (ggtags-foreach-file
1842 |                 (lambda (file)
1843 |                   (when (file-equal-p file start-file)
1844 |                     (cl-return (point))))))
1845 |         (`nil (user-error "No matches for `%s'" start-file))
1846 |         (n (goto-char n) (compile-goto-error))))))
1847 | 
1848 | (defun ggtags-navigation-last-error ()
1849 |   (interactive)
1850 |   (ggtags-ensure-global-buffer
1851 |     (goto-char (point-max))
1852 |     (compilation-previous-error 1)
1853 |     (compile-goto-error)))
1854 | 
1855 | (defun ggtags-navigation-isearch-forward (&optional regexp-p)
1856 |   (interactive "P")
1857 |   (ggtags-ensure-global-buffer
1858 |     (let ((saved (if visible-mode 1 -1)))
1859 |       (visible-mode 1)
1860 |       (with-selected-window (get-buffer-window (current-buffer))
1861 |         (isearch-forward regexp-p)
1862 |         (beginning-of-line)
1863 |         (visible-mode saved)
1864 |         (compile-goto-error)))))
1865 | 
1866 | (defun ggtags-navigation-visible-mode (&optional arg)
1867 |   (interactive (list (or current-prefix-arg 'toggle)))
1868 |   (ggtags-ensure-global-buffer
1869 |     (visible-mode arg)))
1870 | 
1871 | (defvar ggtags-global-line-overlay nil)
1872 | 
1873 | (defun ggtags-global-next-error-function ()
1874 |   (when (eq next-error-last-buffer ggtags-global-last-buffer)
1875 |     (ggtags-move-to-tag)
1876 |     (ggtags-global-save-start-marker)
1877 |     (and (ggtags-project-update-mtime-maybe)
1878 |          (message "File `%s' is newer than GTAGS"
1879 |                   (file-name-nondirectory buffer-file-name)))
1880 |     (and ggtags-mode-sticky (ggtags-mode 1))
1881 |     (ignore-errors
1882 |       (ggtags-ensure-global-buffer
1883 |         (unless (overlayp ggtags-global-line-overlay)
1884 |           (setq ggtags-global-line-overlay (make-overlay (point) (point)))
1885 |           (overlay-put ggtags-global-line-overlay 'face 'ggtags-global-line))
1886 |         (move-overlay ggtags-global-line-overlay
1887 |                       (line-beginning-position) (line-end-position)
1888 |                       (current-buffer))
1889 |         ;; Update search history
1890 |         (let ((id (ggtags-global-search-id (car compilation-arguments)
1891 |                                            default-directory)))
1892 |           (setq ggtags-global-search-history
1893 |                 (cl-remove id ggtags-global-search-history :test #'equal :key #'car))
1894 |           (add-to-history 'ggtags-global-search-history
1895 |                           (cons id (ggtags-global-current-search))
1896 |                           ggtags-global-history-length))))
1897 |     (run-hooks 'ggtags-find-tag-hook)))
1898 | 
1899 | (put 'ggtags-navigation-mode-lighter 'risky-local-variable t)
1900 | 
1901 | (defvar ggtags-navigation-mode-lighter
1902 |   '(" GG["
1903 |     (:eval
1904 |      (if (not (buffer-live-p ggtags-global-last-buffer))
1905 |          '(:propertize "??" face error help-echo "No Global buffer")
1906 |        (with-current-buffer ggtags-global-last-buffer
1907 |          (pcase (or ggtags-global-exit-info '(0 0 ""))
1908 |            (`(,exit ,count ,db)
1909 |             `((:propertize ,(pcase db
1910 |                               (`"GTAGS"  "D")
1911 |                               (`"GRTAGS" "R")
1912 |                               (`"GSYMS"  "S")
1913 |                               (`"GPATH"  "F")
1914 |                               (`"ID"     "I"))
1915 |                            face success)
1916 |               (:propertize
1917 |                ,(pcase (get-text-property (line-beginning-position)
1918 |                                           'compilation-message)
1919 |                   (`nil "?")
1920 |                   ;; Assume the first match appears at line 5
1921 |                   (_ (number-to-string (- (line-number-at-pos) 4))))
1922 |                face success)
1923 |               "/"
1924 |               (:propertize ,(number-to-string count) face success)
1925 |               ,(unless (zerop exit)
1926 |                  `(":" (:propertize ,(number-to-string exit) face error)))))))))
1927 |     "]")
1928 |   "Ligher for `ggtags-navigation-mode'; set to nil to disable it.")
1929 | 
1930 | (define-minor-mode ggtags-navigation-mode nil
1931 |   ;; If `ggtags-enable-navigation-keys' is set to nil only display the
1932 |   ;; lighter in `ggtags-mode' buffers.
1933 |   ;; See https://github.com/leoliu/ggtags/issues/124
1934 |   :lighter (:eval (and (or ggtags-enable-navigation-keys
1935 |                            ggtags-mode)
1936 |                        ggtags-navigation-mode-lighter))
1937 |   :global t
1938 |   (if ggtags-navigation-mode
1939 |       (progn
1940 |         ;; Higher priority for `ggtags-navigation-mode' to avoid being
1941 |         ;; hijacked by modes such as `view-mode'.
1942 |         (add-to-list 'emulation-mode-map-alists 'ggtags-mode-map-alist)
1943 |         (add-hook 'next-error-hook 'ggtags-global-next-error-function)
1944 |         (add-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function))
1945 |     (setq emulation-mode-map-alists
1946 |           (delq 'ggtags-mode-map-alist emulation-mode-map-alists))
1947 |     (remove-hook 'next-error-hook 'ggtags-global-next-error-function)
1948 |     (remove-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function)))
1949 | 
1950 | (defun ggtags-minibuffer-setup-function ()
1951 |   ;; Disable ggtags-navigation-mode in minibuffer.
1952 |   (setq-local ggtags-enable-navigation-keys nil))
1953 | 
1954 | (defun ggtags-kill-file-buffers (&optional interactive)
1955 |   "Kill all buffers visiting files in current project."
1956 |   (interactive "p")
1957 |   (ggtags-check-project)
1958 |   (let ((directories (cons (ggtags-current-project-root) (ggtags-get-libpath)))
1959 |         (count 0))
1960 |     (dolist (buf (buffer-list))
1961 |       (let ((file (and (buffer-live-p buf)
1962 |                        (not (eq buf (current-buffer)))
1963 |                        (buffer-file-name buf))))
1964 |         (when (and file (cl-some (lambda (dir)
1965 |                                    ;; Don't use `file-in-directory-p'
1966 |                                    ;; to allow symbolic links.
1967 |                                    (string-prefix-p dir file))
1968 |                                  directories))
1969 |           (and (kill-buffer buf) (cl-incf count)))))
1970 |     (and interactive
1971 |          (message "%d %s killed" count (if (= count 1) "buffer" "buffers")))))
1972 | 
1973 | (defun ggtags-after-save-function ()
1974 |   (when (ggtags-find-project)
1975 |     (ggtags-project-update-mtime-maybe)
1976 |     (and buffer-file-name ggtags-update-on-save
1977 |          (ggtags-update-tags-single buffer-file-name 'nowait))))
1978 | 
1979 | (defun ggtags-global-output (buffer cmds callback &optional cutoff)
1980 |   "Asynchronously pipe the output of running CMDS to BUFFER.
1981 | When finished invoke CALLBACK in BUFFER with process exit status."
1982 |   (or buffer (error "Output buffer required"))
1983 |   (when (get-buffer-process (get-buffer buffer))
1984 |     ;; Notice running multiple processes in the same buffer so that we
1985 |     ;; can fix the caller. See for example `ggtags-eldoc-function'.
1986 |     (message "Warning: detected %S already running in %S; interrupting..."
1987 |              (get-buffer-process buffer) buffer)
1988 |     (interrupt-process (get-buffer-process buffer)))
1989 |   (let* ((program (car cmds))
1990 |          (args (cdr cmds))
1991 |          (cutoff (and cutoff (+ cutoff (if (get-buffer buffer)
1992 |                                            (with-current-buffer buffer
1993 |                                              (line-number-at-pos (point-max)))
1994 |                                          0))))
1995 |          (filter (lambda (proc string)
1996 |                    (and (buffer-live-p (process-buffer proc))
1997 |                         (with-current-buffer (process-buffer proc)
1998 |                           (goto-char (process-mark proc))
1999 |                           (insert string)
2000 |                           (cl-incf (process-get proc :nlines)
2001 |                                    (count-lines (process-mark proc) (point)))
2002 |                           (set-marker (process-mark proc) (point))
2003 |                           (when (and (> (line-number-at-pos (point-max)) cutoff)
2004 |                                      (process-live-p proc))
2005 |                             (interrupt-process (current-buffer)))))))
2006 |          (sentinel (lambda (proc _msg)
2007 |                      (when (memq (process-status proc) '(exit signal))
2008 |                        (with-current-buffer (process-buffer proc)
2009 |                          (set-process-buffer proc nil)
2010 |                          (funcall callback (process-exit-status proc))))))
2011 |          (proc (apply #'start-file-process program buffer program args)))
2012 |     (set-process-sentinel proc sentinel)
2013 |     (set-process-query-on-exit-flag proc nil)
2014 |     (and cutoff (set-process-filter proc filter))
2015 |     (process-put proc :nlines 0)
2016 |     proc))
2017 | 
2018 | (defun ggtags-global-output-sync (buffer cmds callback)
2019 |   "Synchronously run CMDS and show output in BUFFER.
2020 | When finished invoke CALLBACK in BUFFER with process exit status."
2021 |   ;; Same as `ggtags-global-output'
2022 |   (or buffer (error "Output buffer required"))
2023 |   (when (get-buffer-process (get-buffer buffer))
2024 |     ;; Notice running multiple processes in the same buffer so that we
2025 |     ;; can fix the caller. See for example `ggtags-eldoc-function'.
2026 |     (message "Warning: detected %S already running in %S; interrupting..."
2027 |              (get-buffer-process buffer) buffer)
2028 |     (interrupt-process (get-buffer-process buffer)))
2029 |   (let* ((program (car cmds))
2030 |          (args (cdr cmds))
2031 |          (status (apply #'call-process program nil buffer nil args)))
2032 |     (with-current-buffer buffer
2033 |       (funcall callback status))))
2034 | 
2035 | (cl-defun ggtags-fontify-code (code &optional (mode major-mode))
2036 |   (cl-check-type mode function)
2037 |   (if (stringp code)
2038 |       (with-temp-buffer
2039 |         (insert code)
2040 |         (funcall mode)
2041 |         (font-lock-ensure)
2042 |         (buffer-string))
2043 |     code))
2044 | 
2045 | (defun ggtags-get-definition-default (defs)
2046 |   (and (caar defs)
2047 |        (concat (ggtags-fontify-code (caar defs))
2048 |                (and (cdr defs) " [guess]"))))
2049 | 
2050 | (defun ggtags-show-definition (name)
2051 |   (interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
2052 |   (ggtags-check-project)
2053 |   (let* ((re (cadr (assq 'grep ggtags-global-error-regexp-alist-alist)))
2054 |          (current (current-buffer))
2055 |          (buffer (get-buffer-create " *ggtags-definition*"))
2056 |          ;; `.' works here because ggtags-global-output doesn't set
2057 |          ;; default-directory to project root.
2058 |          (args (delq nil (list (ggtags-sort-by-nearness-p ".")
2059 |                                "--result=grep" "--path-style=absolute" name)))
2060 |          ;; Need these bindings so that let-binding
2061 |          ;; `ggtags-print-definition-function' can work see
2062 |          ;; `ggtags-eldoc-function'.
2063 |          (get-fn ggtags-get-definition-function)
2064 |          (print-fn ggtags-print-definition-function)
2065 |          (show (lambda (_status)
2066 |                  (goto-char (point-min))
2067 |                  (let ((defs (cl-loop while (re-search-forward re nil t)
2068 |                                       collect (list (buffer-substring-no-properties
2069 |                                                      (1+ (match-end 2))
2070 |                                                      (line-end-position))
2071 |                                                     name
2072 |                                                     (match-string 1)
2073 |                                                     (string-to-number (match-string 2))))))
2074 |                    (kill-buffer buffer)
2075 |                    (with-current-buffer current
2076 |                      (funcall print-fn (funcall get-fn defs)))))))
2077 |     (ggtags-with-current-project
2078 |       (ggtags-global-output buffer (cons (ggtags-program-path "global") args)
2079 |                             show 100))))
2080 | 
2081 | (defvar ggtags-mode-prefix-map
2082 |   (let ((m (make-sparse-keymap)))
2083 |     ;; Globally bound to `M-g p'.
2084 |     ;; (define-key m "\M-'" 'previous-error)
2085 |     (define-key m (kbd "M-DEL") 'ggtags-delete-tags)
2086 |     (define-key m "\M-p" 'ggtags-prev-mark)
2087 |     (define-key m "\M-n" 'ggtags-next-mark)
2088 |     (define-key m "\M-f" 'ggtags-find-file)
2089 |     (define-key m "\M-o" 'ggtags-find-other-symbol)
2090 |     (define-key m "\M-g" 'ggtags-grep)
2091 |     (define-key m "\M-i" 'ggtags-idutils-query)
2092 |     (define-key m "\M-b" 'ggtags-browse-file-as-hypertext)
2093 |     (define-key m "\M-k" 'ggtags-kill-file-buffers)
2094 |     (define-key m "\M-h" 'ggtags-view-tag-history)
2095 |     (define-key m "\M-j" 'ggtags-visit-project-root)
2096 |     (define-key m "\M-/" 'ggtags-view-search-history)
2097 |     (define-key m (kbd "M-SPC") 'ggtags-save-to-register)
2098 |     (define-key m (kbd "M-%") 'ggtags-query-replace)
2099 |     (define-key m "\M-?" 'ggtags-show-definition)
2100 |     m))
2101 | 
2102 | (defvar ggtags-mode-map
2103 |   (let ((map (make-sparse-keymap))
2104 |         (menu (make-sparse-keymap "Ggtags")))
2105 |     (define-key map "\M-." 'ggtags-find-tag-dwim)
2106 |     (define-key map (kbd "M-]") 'ggtags-find-reference)
2107 |     (define-key map (kbd "C-M-.") 'ggtags-find-tag-regexp)
2108 |     (define-key map ggtags-mode-prefix-key ggtags-mode-prefix-map)
2109 |     ;; Menu items
2110 |     (define-key map [menu-bar ggtags] (cons "Ggtags" menu))
2111 |     ;; Ordered backwards
2112 |     (define-key menu [report-bugs]
2113 |       `(menu-item "Report bugs"
2114 |                   (lambda () (interactive)
2115 |                     (browse-url ggtags-bug-url)
2116 |                     (message "Please visit %s" ggtags-bug-url))
2117 |                   :help ,(format "Visit %s" ggtags-bug-url)))
2118 |     (define-key menu [custom-ggtags]
2119 |       '(menu-item "Customize Ggtags"
2120 |                   (lambda () (interactive) (customize-group 'ggtags))))
2121 |     (define-key menu [eldoc-mode]
2122 |       '(menu-item "Toggle eldoc mode" eldoc-mode :button (:toggle . eldoc-mode)))
2123 |     (define-key menu [save-project]
2124 |       '(menu-item "Save project settings" ggtags-save-project-settings))
2125 |     (define-key menu [toggle-read-only]
2126 |       '(menu-item "Toggle project read-only" ggtags-toggle-project-read-only
2127 |                   :button (:toggle . buffer-read-only)))
2128 |     (define-key menu [visit-project-root]
2129 |       '(menu-item "Visit project root" ggtags-visit-project-root))
2130 |     (define-key menu [sep2] menu-bar-separator)
2131 |     (define-key menu [browse-hypertext]
2132 |       '(menu-item "Browse as hypertext" ggtags-browse-file-as-hypertext
2133 |                   :enable (ggtags-find-project)))
2134 |     (define-key menu [delete-tags]
2135 |       '(menu-item "Delete tags" ggtags-delete-tags
2136 |                   :enable (ggtags-find-project)
2137 |                   :help "Delete file GTAGS, GRTAGS, GPATH, ID etc."))
2138 |     (define-key menu [kill-buffers]
2139 |       '(menu-item "Kill project file buffers" ggtags-kill-file-buffers
2140 |                   :enable (ggtags-find-project)))
2141 |     (define-key menu [view-tag]
2142 |       '(menu-item "View tag history" ggtags-view-tag-history))
2143 |     (define-key menu [pop-mark]
2144 |       '(menu-item "Pop mark" xref-pop-marker-stack
2145 |                   :help "Pop to previous mark and destroy it"))
2146 |     (define-key menu [next-mark]
2147 |       '(menu-item "Next mark" ggtags-next-mark))
2148 |     (define-key menu [prev-mark]
2149 |       '(menu-item "Previous mark" ggtags-prev-mark))
2150 |     (define-key menu [sep1] menu-bar-separator)
2151 |     (define-key menu [previous-error]
2152 |       '(menu-item "Previous match" previous-error))
2153 |     (define-key menu [next-error]
2154 |       '(menu-item "Next match" next-error))
2155 |     (define-key menu [rerun-search]
2156 |       '(menu-item "View past searches" ggtags-view-search-history))
2157 |     (define-key menu [save-to-register]
2158 |       '(menu-item "Save search to register" ggtags-save-to-register))
2159 |     (define-key menu [find-file]
2160 |       '(menu-item "Find files" ggtags-find-file))
2161 |     (define-key menu [query-replace]
2162 |       '(menu-item "Query replace" ggtags-query-replace))
2163 |     (define-key menu [idutils]
2164 |       '(menu-item "Query idutils DB" ggtags-idutils-query))
2165 |     (define-key menu [grep]
2166 |       '(menu-item "Grep" ggtags-grep))
2167 |     (define-key menu [find-symbol]
2168 |       '(menu-item "Find other symbol" ggtags-find-other-symbol
2169 |                   :help "Find references without definition"))
2170 |     (define-key menu [find-tag-regexp]
2171 |       '(menu-item "Find tag matching regexp" ggtags-find-tag-regexp))
2172 |     (define-key menu [show-definition]
2173 |       '(menu-item "Show definition" ggtags-show-definition))
2174 |     (define-key menu [find-reference]
2175 |       '(menu-item "Find reference" ggtags-find-reference))
2176 |     ;; TODO: bind `find-tag-continue' to `M-*' after dropping support
2177 |     ;; for emacs < 25.
2178 |     (define-key menu [find-tag-continue]
2179 |       '(menu-item "Continue find tag" tags-loop-continue))
2180 |     (define-key menu [find-tag]
2181 |       '(menu-item "Find tag" ggtags-find-tag-dwim))
2182 |     (define-key menu [update-tags]
2183 |       '(menu-item "Update tag files" ggtags-update-tags
2184 |                   :visible (ggtags-find-project)))
2185 |     (define-key menu [run-gtags]
2186 |       '(menu-item "Run gtags" ggtags-create-tags
2187 |                   :visible (not (ggtags-find-project))))
2188 |     map))
2189 | 
2190 | (defvar ggtags-mode-line-project-keymap
2191 |   (let ((map (make-sparse-keymap)))
2192 |     (define-key map [mode-line mouse-1] 'ggtags-visit-project-root)
2193 |     map))
2194 | 
2195 | (put 'ggtags-mode-line-project-name 'risky-local-variable t)
2196 | (defvar ggtags-mode-line-project-name
2197 |   '("[" (:eval (let ((name (if (stringp ggtags-project-root)
2198 |                                (file-name-nondirectory
2199 |                                 (directory-file-name ggtags-project-root))
2200 |                              "?")))
2201 |                  (propertize
2202 |                   name 'face compilation-info-face
2203 |                   'help-echo (if (stringp ggtags-project-root)
2204 |                                  (concat "mouse-1 to visit " ggtags-project-root)
2205 |                                "mouse-1 to set project")
2206 |                   'mouse-face 'mode-line-highlight
2207 |                   'keymap ggtags-mode-line-project-keymap)))
2208 |     "]")
2209 |   "Mode line construct for displaying current project name.
2210 | The value is the name of the project root directory. Setting it
2211 | to nil disables displaying this information.")
2212 | 
2213 | ;;;###autoload
2214 | (define-minor-mode ggtags-mode nil
2215 |   :lighter (:eval (if ggtags-navigation-mode "" " GG"))
2216 |   (ggtags-setup-highlight-tag-at-point ggtags-highlight-tag)
2217 |   (if ggtags-mode
2218 |       (progn
2219 |         (add-hook 'after-save-hook 'ggtags-after-save-function nil t)
2220 |         (add-hook 'xref-backend-functions 'ggtags--xref-backend nil t)
2221 |         ;; Append to serve as a fallback method.
2222 |         (add-hook 'completion-at-point-functions
2223 |                   #'ggtags-completion-at-point t t)
2224 |         ;; Work around http://debbugs.gnu.org/19324
2225 |         (or eldoc-documentation-function
2226 |             (setq-local eldoc-documentation-function #'ignore))
2227 |         (add-function :after-until (local 'eldoc-documentation-function)
2228 |                       #'ggtags-eldoc-function '((name . ggtags-eldoc-function)
2229 |                                                 (depth . -100)))
2230 |         (unless (memq 'ggtags-mode-line-project-name
2231 |                       mode-line-buffer-identification)
2232 |           (setq mode-line-buffer-identification
2233 |                 (append mode-line-buffer-identification
2234 |                         '(ggtags-mode-line-project-name)))))
2235 |     (remove-hook 'after-save-hook 'ggtags-after-save-function t)
2236 |     (remove-hook 'xref-backend-functions 'ggtags--xref-backend t)
2237 |     (remove-hook 'completion-at-point-functions #'ggtags-completion-at-point t)
2238 |     (remove-function (local 'eldoc-documentation-function) 'ggtags-eldoc-function)
2239 |     (setq mode-line-buffer-identification
2240 |           (delq 'ggtags-mode-line-project-name mode-line-buffer-identification))
2241 |     (ggtags-cancel-highlight-tag-at-point 'keep-timer)))
2242 | 
2243 | (defvar ggtags-highlight-tag-map
2244 |   (let ((map (make-sparse-keymap)))
2245 |     ;; Bind down- events so that the global keymap won't ``shine
2246 |     ;; through''. See `mode-line-buffer-identification-keymap' for
2247 |     ;; similar workaround.
2248 |     (define-key map [S-mouse-1] 'ggtags-find-tag-dwim)
2249 |     (define-key map [S-down-mouse-1] 'ignore)
2250 |     (define-key map [S-mouse-3] 'ggtags-find-reference)
2251 |     (define-key map [S-down-mouse-3] 'ignore)
2252 |     map)
2253 |   "Keymap used for valid tag at point.")
2254 | 
2255 | (put 'ggtags-active-tag 'face 'ggtags-highlight)
2256 | (put 'ggtags-active-tag 'keymap ggtags-highlight-tag-map)
2257 | ;; (put 'ggtags-active-tag 'mouse-face 'match)
2258 | (put 'ggtags-active-tag 'help-echo
2259 |      "S-mouse-1 for definitions\nS-mouse-3 for references")
2260 | 
2261 | (defun ggtags-setup-highlight-tag-at-point (flag)
2262 |   (cond ((null flag) (ggtags-cancel-highlight-tag-at-point))
2263 |         ((not (timerp ggtags-highlight-tag-timer))
2264 |          (setq ggtags-highlight-tag-timer
2265 |                (run-with-idle-timer flag t #'ggtags-highlight-tag-at-point)))
2266 |         (t (timer-set-idle-time ggtags-highlight-tag-timer flag t))))
2267 | 
2268 | (defun ggtags-cancel-highlight-tag-at-point (&optional keep-timer)
2269 |   (when (and (not keep-timer)
2270 |              (timerp ggtags-highlight-tag-timer))
2271 |     (cancel-timer ggtags-highlight-tag-timer)
2272 |     (setq ggtags-highlight-tag-timer nil))
2273 |   (when ggtags-highlight-tag-overlay
2274 |     (delete-overlay ggtags-highlight-tag-overlay)
2275 |     (setq ggtags-highlight-tag-overlay nil)))
2276 | 
2277 | (defun ggtags-highlight-tag-at-point ()
2278 |   (when (and ggtags-mode ggtags-project-root (ggtags-find-project))
2279 |     (unless (overlayp ggtags-highlight-tag-overlay)
2280 |       (setq ggtags-highlight-tag-overlay (make-overlay (point) (point) nil t))
2281 |       (overlay-put ggtags-highlight-tag-overlay 'modification-hooks
2282 |                    (list (lambda (o after &rest _args)
2283 |                            (and (not after) (delete-overlay o))))))
2284 |     (let ((bounds (funcall ggtags-bounds-of-tag-function))
2285 |           (o ggtags-highlight-tag-overlay))
2286 |       (cond
2287 |        ((and bounds
2288 |              (eq (overlay-buffer o) (current-buffer))
2289 |              (= (overlay-start o) (car bounds))
2290 |              (= (overlay-end o) (cdr bounds)))
2291 |         ;; Overlay matches current tag so do nothing.
2292 |         nil)
2293 |        ((and bounds (let ((completion-ignore-case nil))
2294 |                       (test-completion
2295 |                        (buffer-substring-no-properties
2296 |                         (car bounds) (cdr bounds))
2297 |                        ggtags-completion-table)))
2298 |         (move-overlay o (car bounds) (cdr bounds) (current-buffer))
2299 |         (overlay-put o 'category 'ggtags-active-tag))
2300 |        (t (move-overlay o
2301 |                         (or (car bounds) (point))
2302 |                         (or (cdr bounds) (point))
2303 |                         (current-buffer))
2304 |           (overlay-put o 'category nil))))))
2305 | 
2306 | ;;; eldoc
2307 | 
2308 | (defvar-local ggtags-eldoc-cache nil)
2309 | 
2310 | (declare-function eldoc-message "eldoc")
2311 | (defun ggtags-eldoc-function ()
2312 |   "A function suitable for `eldoc-documentation-function' (which see)."
2313 |   (pcase (ggtags-tag-at-point)
2314 |     (`nil nil)
2315 |     (tag (if (equal tag (car ggtags-eldoc-cache))
2316 |              (cadr ggtags-eldoc-cache)
2317 |            (and ggtags-project-root (ggtags-find-project)
2318 |                 (let* ((ggtags-print-definition-function
2319 |                         (lambda (s)
2320 |                           (setq ggtags-eldoc-cache (list tag s))
2321 |                           (eldoc-message s))))
2322 |                   ;; Prevent multiple runs of ggtags-show-definition
2323 |                   ;; for the same tag.
2324 |                   (setq ggtags-eldoc-cache (list tag))
2325 |                   (condition-case err
2326 |                       (ggtags-show-definition tag)
2327 |                     (file-error
2328 |                      (remove-function (local 'eldoc-documentation-function)
2329 |                                       'ggtags-eldoc-function)
2330 |                      (message "\
2331 | Function `ggtags-eldoc-function' disabled for eldoc in current buffer: %S" err)))
2332 |                   nil))))))
2333 | 
2334 | ;;; imenu
2335 | 
2336 | (defun ggtags-goto-imenu-index (name line &rest _args)
2337 |   (ggtags-forward-to-line line)
2338 |   (ggtags-move-to-tag name))
2339 | 
2340 | ;;;###autoload
2341 | (defun ggtags-build-imenu-index ()
2342 |   "A function suitable for `imenu-create-index-function'."
2343 |   (let ((file (and buffer-file-name (file-relative-name buffer-file-name))))
2344 |     (and file (with-temp-buffer
2345 |                 (when (with-demoted-errors "ggtags-build-imenu-index: %S"
2346 |                         (zerop (ggtags-with-current-project
2347 |                                  (process-file (ggtags-program-path "global")
2348 |                                                nil t nil "-x" "-f" file))))
2349 |                   (goto-char (point-min))
2350 |                   (cl-loop while (re-search-forward
2351 |                                   "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)" nil t)
2352 |                            collect (list (match-string 1)
2353 |                                          (string-to-number (match-string 2))
2354 |                                          'ggtags-goto-imenu-index)))))))
2355 | 
2356 | ;;; hippie-expand
2357 | 
2358 | ;;;###autoload
2359 | (defun ggtags-try-complete-tag (old)
2360 |   "A function suitable for `hippie-expand-try-functions-list'."
2361 |   (eval-and-compile (require 'hippie-exp))
2362 |   (unless old
2363 |     (he-init-string (or (car (funcall ggtags-bounds-of-tag-function)) (point))
2364 |                     (point))
2365 |     (setq he-expand-list
2366 |           (and (not (equal he-search-string ""))
2367 |                (ggtags-find-project)
2368 |                (sort (all-completions he-search-string
2369 |                                       ggtags-completion-table)
2370 |                      #'string-lessp))))
2371 |   (if (null he-expand-list)
2372 |       (progn
2373 |         (if old (he-reset-string))
2374 |         nil)
2375 |     (he-substitute-string (car he-expand-list))
2376 |     (setq he-expand-list (cdr he-expand-list))
2377 |     t))
2378 | 
2379 | ;;; Xref
2380 | 
2381 | (defconst ggtags--xref-limit 1000)
2382 | 
2383 | (cl-defstruct (ggtags-xref-location
2384 |                (:constructor ggtags-make-xref-location (file line column project-root)))
2385 |   file line column project-root)
2386 | 
2387 | (cl-defmethod xref-location-group ((l ggtags-xref-location))
2388 |   (file-relative-name (ggtags-xref-location-file l) (ggtags-xref-location-project-root l)))
2389 | 
2390 | (cl-defmethod xref-location-marker ((l ggtags-xref-location))
2391 |   (let ((buffer (find-file-noselect (ggtags-xref-location-file l))))
2392 |     (with-current-buffer buffer
2393 |       (save-excursion
2394 |         (goto-char (point-min))
2395 |         (forward-line (1- (ggtags-xref-location-line l)))
2396 |         (move-to-column (1- (ggtags-xref-location-column l)))
2397 |         (point-marker)))))
2398 | 
2399 | (cl-defmethod xref-location-line ((l ggtags-xref-location))
2400 |   (ggtags-xref-location-line l))
2401 | 
2402 | (defun ggtags--xref-backend ()
2403 |   (and (ggtags-find-project)
2404 |        (let ((tag (ggtags-tag-at-point)))
2405 |          ;; Try to use this backend if there is no tag at
2406 |          ;; point, since we may still want to when asking
2407 |          ;; the user for a tag.
2408 |          (or (null tag)
2409 |              (test-completion tag ggtags-completion-table)))
2410 |        'ggtags))
2411 | 
2412 | (cl-defmethod xref-backend-identifier-at-point ((_backend (eql ggtags)))
2413 |   (ggtags-tag-at-point))
2414 | 
2415 | (cl-defmethod xref-backend-identifier-completion-table ((_backend (eql ggtags)))
2416 |   ggtags-completion-table)
2417 | 
2418 | (defun ggtags--xref-collect-tags (tag root colored)
2419 |   "Collect xrefs for TAG from Global output in the `current-buffer'.
2420 | Return the list of xrefs for TAG. Global output is assumed to
2421 | have grep format.
2422 | 
2423 | ROOT is the project root directory to associate with the xrefs.
2424 | 
2425 | If COLORED is non-nil, convert ANSI color codes to font lock text
2426 | properties in the summary text of each xref."
2427 |   (cl-loop
2428 |    with re = (cadr (assq 'grep ggtags-global-error-regexp-alist-alist))
2429 |    while (re-search-forward re nil t)
2430 |    for summary = (buffer-substring (1+ (match-end 2)) (line-end-position))
2431 |    for file = (expand-file-name (match-string 1))
2432 |    for line = (string-to-number (match-string 2))
2433 |    for column = (string-match-p tag summary)
2434 |    if colored do (setq summary (ansi-color-apply summary)) end
2435 |    ;; Sometimes there are false positives, depending on the
2436 |    ;; parser used so only collect lines that actually
2437 |    ;; contain TAG.
2438 |    and when column
2439 |    collect (xref-make
2440 |             summary
2441 |             (ggtags-make-xref-location
2442 |              file
2443 |              line
2444 |              column
2445 |              root))))
2446 | 
2447 | (defun ggtags--xref-find-tags (tag cmd)
2448 |   "Find xrefs of TAG using Global CMD.
2449 | CMD has the same meaning as in `ggtags-global-build-command'.
2450 | Return the list of xrefs for TAG."
2451 |   (let* ((ggtags-global-output-format 'grep)
2452 |          (project (ggtags-find-project))
2453 |          (xrefs nil)
2454 |          (collect
2455 |           (lambda (_status)
2456 |             (goto-char (point-min))
2457 |             (setq xrefs (ggtags--xref-collect-tags
2458 |                          tag
2459 |                          (ggtags-project-root project)
2460 |                          (and ggtags-global-use-color
2461 |                               (ggtags-project-has-color project))))
2462 |             (kill-buffer (current-buffer)))))
2463 |     (ggtags-with-current-project
2464 |       (let ((default-directory (ggtags-current-project-root)))
2465 |         (ggtags-global-output-sync
2466 |          (get-buffer-create " *ggtags-xref*")
2467 |          (append
2468 |           (split-string (ggtags-global-build-command cmd))
2469 |           (list "--" (shell-quote-argument tag)))
2470 |          collect))
2471 |       xrefs)))
2472 | 
2473 | (cl-defmethod xref-backend-definitions ((_backend (eql ggtags)) tag)
2474 |   (ggtags--xref-find-tags tag 'definition))
2475 | 
2476 | (cl-defmethod xref-backend-references ((_backend (eql ggtags)) tag)
2477 |   (ggtags--xref-find-tags tag 'reference))
2478 | 
2479 | (cl-defmethod xref-backend-apropos ((_backend (eql ggtags)) tag)
2480 |   (ggtags--xref-find-tags tag 'grep))
2481 | 
2482 | (defun ggtags-reload (&optional force)
2483 |   (interactive "P")
2484 |   (unload-feature 'ggtags force)
2485 |   (require 'ggtags))
2486 | 
2487 | (provide 'ggtags)
2488 | ;;; ggtags.el ends here
2489 | 


--------------------------------------------------------------------------------