.emacs.d.git - Gitblit

Chizi123

2018-11-17 c4001ccd1864293b64aa37d83a9d9457eb875e70

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