#+BEGIN_SRC emacs-lisp
(if (>= emacs-major-version 24)
(progn
- (add-to-list 'load-path "~/.emacs.d/elpa/ggtags-20150814.842" t)
+ (add-to-list 'load-path "~/.emacs.d/elpa/ggtags-20151214.1344" t)
(require 'ggtags)
- (add-to-list 'load-path "~/.emacs.d/elpa/helm-gtags-20151016.201" t)
+ (add-to-list 'load-path "~/.emacs.d/elpa/helm-gtags-20160202.503" t)
(require 'helm-gtags)
(add-hook 'puppet-mode-hook
(lambda()
+++ /dev/null
-;;; ggtags-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
-\f
-;;;### (autoloads nil "ggtags" "ggtags.el" (22057 58127 0 0))
-;;; Generated autoloads from ggtags.el
-
-(autoload 'ggtags-find-project "ggtags" "\
-
-
-\(fn)" nil nil)
-
-(autoload 'ggtags-find-tag-dwim "ggtags" "\
-Find NAME by context.
-If point is at a definition tag, find references, and vice versa.
-If point is at a line that matches `ggtags-include-pattern', find
-the include file instead.
-
-When called interactively with a prefix arg, always find
-definition tags.
-
-\(fn NAME &optional WHAT)" t nil)
-
-(autoload 'ggtags-mode "ggtags" "\
-Toggle Ggtags mode on or off.
-With a prefix argument ARG, enable Ggtags mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
-\\{ggtags-mode-map}
-
-\(fn &optional ARG)" t nil)
-
-(autoload 'ggtags-build-imenu-index "ggtags" "\
-A function suitable for `imenu-create-index-function'.
-
-\(fn)" nil nil)
-
-(autoload 'ggtags-try-complete-tag "ggtags" "\
-A function suitable for `hippie-expand-try-functions-list'.
-
-\(fn OLD)" nil nil)
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; End:
-;;; ggtags-autoloads.el ends here
+++ /dev/null
-(define-package "ggtags" "20150814.842" "emacs frontend to GNU Global source code tagging system" '((emacs "24") (cl-lib "0.5")) :url "https://github.com/leoliu/ggtags" :keywords '("tools" "convenience"))
+++ /dev/null
-;;; ggtags.el --- emacs frontend to GNU Global source code tagging system -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
-
-;; Author: Leo Liu <sdl.webNOSPAMgmail.com>
-;; Version: 0.8.11
-;; Package-Version: 20150814.842
-;; Keywords: tools, convenience
-;; Created: 2013-01-29
-;; URL: https://github.com/leoliu/ggtags
-;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; A package to integrate GNU Global source code tagging system
-;; (http://www.gnu.org/software/global) with Emacs.
-;;
-;; Usage:
-;;
-;; `ggtags' is similar to the standard `etags' package. These keys
-;; `M-.', `M-,', `M-*' and `C-M-.' should work as expected in
-;; `ggtags-mode'. See the README in https://github.com/leoliu/ggtags
-;; for more details.
-;;
-;; All commands are available from the `Ggtags' menu in `ggtags-mode'.
-
-;;; NEWS 0.8.10 (2015-06-12):
-
-;; - Tags update on save is configurable by `ggtags-update-on-save'.
-;; - New command `ggtags-explain-tags' to explain how each file is
-;; indexed in current project.
-;; - New user option `ggtags-sort-by-nearness' that sorts matched tags
-;; by nearness to current directory.
-;;
-;; See full NEWS on https://github.com/leoliu/ggtags#news
-
-;;; Code:
-
-(eval-when-compile
- (require 'url-parse))
-
-(require 'cl-lib)
-(require 'ewoc)
-(require 'compile)
-(require 'etags)
-(require 'tabulated-list) ;preloaded since 24.3
-
-(eval-when-compile
- (unless (fboundp 'setq-local)
- (defmacro setq-local (var val)
- (list 'set (list 'make-local-variable (list 'quote var)) val)))
-
- (unless (fboundp 'defvar-local)
- (defmacro defvar-local (var val &optional docstring)
- (declare (debug defvar) (doc-string 3))
- (list 'progn (list 'defvar var val docstring)
- (list 'make-variable-buffer-local (list 'quote var)))))
-
- (or (fboundp 'add-function) (defmacro add-function (&rest _))) ;24.4
- (or (fboundp 'remove-function) (defmacro remove-function (&rest _)))
-
- (defmacro ignore-errors-unless-debug (&rest body)
- "Ignore all errors while executing BODY unless debug is on."
- (declare (debug t) (indent 0))
- `(condition-case-unless-debug nil (progn ,@body) (error nil)))
-
- (defmacro with-display-buffer-no-window (&rest body)
- (declare (debug t) (indent 0))
- ;; See http://debbugs.gnu.org/13594
- `(let ((display-buffer-overriding-action
- (if (and ggtags-auto-jump-to-match
- ;; Appeared in emacs 24.4.
- (fboundp 'display-buffer-no-window))
- (list #'display-buffer-no-window)
- display-buffer-overriding-action)))
- ,@body)))
-
-(eval-and-compile
- (or (fboundp 'user-error) ;24.3
- (defalias 'user-error 'error))
- (or (fboundp 'read-only-mode) ;24.3
- (defalias 'read-only-mode 'toggle-read-only))
- (or (fboundp 'register-read-with-preview) ;24.4
- (defalias 'register-read-with-preview 'read-char)))
-
-(defgroup ggtags nil
- "GNU Global source code tagging system."
- :group 'tools)
-
-(defface ggtags-highlight '((t (:underline t)))
- "Face used to highlight a valid tag at point."
- :group 'ggtags)
-
-(defface ggtags-global-line '((t (:inherit secondary-selection)))
- "Face used to highlight matched line in Global buffer."
- :group 'ggtags)
-
-(defcustom ggtags-executable-directory nil
- "If non-nil the directory to search global executables."
- :type '(choice (const :tag "Unset" nil) directory)
- :risky t
- :group 'ggtags)
-
-(defcustom ggtags-oversize-limit (* 10 1024 1024)
- "The over size limit for the GTAGS file.
-When the size of the GTAGS file is below this limit, ggtags
-always maintains up-to-date tags for the whole source tree by
-running `global -u'. For projects with GTAGS larger than this
-limit, only files edited in Ggtags mode are updated (via `global
---single-update')."
- :safe 'numberp
- :type '(choice (const :tag "None" nil)
- (const :tag "Always" t)
- number)
- :group 'ggtags)
-
-(defcustom ggtags-include-pattern
- '("^\\s-*#\\s-*\\(?:include\\|import\\)\\s-*[\"<]\\(?:[./]*\\)?\\(.*?\\)[\">]" . 1)
- "Pattern used to detect #include files.
-Value can be (REGEXP . SUB) or a function with no arguments.
-REGEXP should match from the beginning of line."
- :type '(choice (const :tag "Disable" nil)
- (cons regexp integer)
- function)
- :safe 'stringp
- :group 'ggtags)
-
-;; See also: http://article.gmane.org/gmane.comp.gnu.global.bugs/1751
-(defcustom ggtags-use-project-gtagsconf t
- "Non-nil to use GTAGSCONF file found at project root.
-File .globalrc and gtags.conf are checked in order.
-
-Note: GNU Global v6.2.13 has the feature of using gtags.conf at
-project root. Setting this variable to nil doesn't disable this
-feature."
- :safe 'booleanp
- :type 'boolean
- :group 'ggtags)
-
-(defcustom ggtags-project-duration 600
- "Seconds to keep information of a project in memory."
- :type 'number
- :group 'ggtags)
-
-(defcustom ggtags-process-environment nil
- "Similar to `process-environment' with higher precedence.
-Elements are run through `substitute-env-vars' before use.
-GTAGSROOT will always be expanded to current project root
-directory. This is intended for project-wise ggtags-specific
-process environment settings. Note on remote hosts (e.g. tramp)
-directory local variables is not enabled by default per
-`enable-remote-dir-locals' (which see)."
- :safe 'ggtags-list-of-string-p
- :type '(repeat string)
- :group 'ggtags)
-
-(defcustom ggtags-auto-jump-to-match 'history
- "Strategy on how to jump to match: nil, first or history.
-
- nil: never automatically jump to any match;
- first: jump to the first match;
-history: jump to the match stored in search history."
- :type '(choice (const :tag "First match" first)
- (const :tag "Search History" history)
- (const :tag "Never" nil))
- :group 'ggtags)
-
-(defcustom ggtags-global-window-height 8 ; ggtags-global-mode
- "Number of lines for the *ggtags-global* popup window.
-If nil, use Emacs default."
- :type '(choice (const :tag "Default" nil) integer)
- :group 'ggtags)
-
-(defcustom ggtags-global-abbreviate-filename 40
- "Non-nil to display file names abbreviated e.g. \"/u/b/env\".
-If an integer abbreviate only names longer than that number."
- :type '(choice (const :tag "No" nil)
- (const :tag "Always" t)
- integer)
- :group 'ggtags)
-
-(defcustom ggtags-split-window-function split-window-preferred-function
- "A function to control how ggtags pops up the auxiliary window."
- :type 'function
- :group 'ggtags)
-
-(defcustom ggtags-use-idutils (and (executable-find "mkid") t)
- "Non-nil to also generate the idutils DB."
- :type 'boolean
- :group 'ggtags)
-
-(defcustom ggtags-use-sqlite3 nil
- "Use sqlite3 for storage instead of Berkeley DB.
-This feature requires GNU Global 6.3.3+ and is ignored if `gtags'
-isn't built with sqlite3 support."
- :type 'boolean
- :safe 'booleanp
- :group 'ggtags)
-
-(defcustom ggtags-sort-by-nearness nil
- "Sort tags by nearness to current directory.
-GNU Global 6.5+ required."
- :type 'boolean
- :safe #'booleanp
- :group 'ggtags)
-
-(defcustom ggtags-update-on-save t
- "Non-nil to update tags for current buffer on saving."
- ;; It is reported that `global --single-update' can be slow in sshfs
- ;; directories. See https://github.com/leoliu/ggtags/issues/85.
- :safe #'booleanp
- :type 'boolean
- :group 'ggtags)
-
-(defcustom ggtags-global-output-format 'grep
- "Global output format: path, ctags, ctags-x, grep or cscope."
- :type '(choice (const path)
- (const ctags)
- (const ctags-x)
- (const grep)
- (const cscope))
- :group 'ggtags)
-
-(defcustom ggtags-global-use-color t
- "Non-nil to use color in output if supported by Global.
-Note: processing colored output takes noticeable time
-particularly when the output is large."
- :type 'boolean
- :safe 'booleanp
- :group 'ggtags)
-
-(defcustom ggtags-global-ignore-case nil
- "Non-nil if Global should ignore case in the search pattern."
- :safe 'booleanp
- :type 'boolean
- :group 'ggtags)
-
-(defcustom ggtags-global-treat-text nil
- "Non-nil if Global should include matches from text files.
-This affects `ggtags-find-file' and `ggtags-grep'."
- :safe 'booleanp
- :type 'boolean
- :group 'ggtags)
-
-;; See also https://github.com/leoliu/ggtags/issues/52
-(defcustom ggtags-global-search-libpath-for-reference t
- "If non-nil global will search GTAGSLIBPATH for references.
-Search is only continued in GTAGSLIBPATH if it finds no matches
-in current project."
- :safe 'booleanp
- :type 'boolean
- :group 'ggtags)
-
-(defcustom ggtags-global-large-output 1000
- "Number of lines in the Global buffer to indicate large output."
- :type 'number
- :group 'ggtags)
-
-(defcustom ggtags-global-history-length history-length
- "Maximum number of items to keep in `ggtags-global-search-history'."
- :type 'integer
- :group 'ggtags)
-
-(defcustom ggtags-enable-navigation-keys t
- "If non-nil key bindings in `ggtags-navigation-map' are enabled."
- :safe 'booleanp
- :type 'boolean
- :group 'ggtags)
-
-(defcustom ggtags-find-tag-hook nil
- "Hook run immediately after finding a tag."
- :options '(recenter reposition-window)
- :type 'hook
- :group 'ggtags)
-
-(defcustom ggtags-get-definition-function #'ggtags-get-definition-default
- "Function called by `ggtags-show-definition' to get definition.
-It is passed a list of definition candidates of the form:
-
- (TEXT NAME FILE LINE)
-
-where TEXT is usually the source line of the definition.
-
-The return value is passed to `ggtags-print-definition-function'."
- :type 'function
- :group 'ggtags)
-
-(defcustom ggtags-print-definition-function
- (lambda (s) (ggtags-echo "%s" (or s "[definition not found]")))
- "Function used by `ggtags-show-definition' to print definition."
- :type 'function
- :group 'ggtags)
-
-(defcustom ggtags-mode-sticky t
- "If non-nil enable Ggtags Mode in files visited."
- :safe 'booleanp
- :type 'boolean
- :group 'ggtags)
-
-(defcustom ggtags-mode-prefix-key "\C-c"
- "Key binding used for `ggtags-mode-prefix-map'.
-Users should change the value using `customize-variable' to
-properly update `ggtags-mode-map'."
- :set (lambda (sym value)
- (when (bound-and-true-p ggtags-mode-map)
- (let ((old (and (boundp sym) (symbol-value sym))))
- (and old (define-key ggtags-mode-map old nil)))
- (and value
- (bound-and-true-p ggtags-mode-prefix-map)
- (define-key ggtags-mode-map value ggtags-mode-prefix-map)))
- (set-default sym value))
- :type 'key-sequence
- :group 'ggtags)
-
-(defcustom ggtags-completing-read-function nil
- "Ggtags specific `completing-read-function' (which see).
-Nil means using the value of `completing-read-function'."
- :type '(choice (const :tag "Use completing-read-function" nil)
- function)
- :group 'ggtags)
-
-(defcustom ggtags-highlight-tag-delay 0.25
- "Time in seconds before highlighting tag at point."
- :set (lambda (sym value)
- (when (bound-and-true-p ggtags-highlight-tag-timer)
- (timer-set-idle-time ggtags-highlight-tag-timer value t))
- (set-default sym value))
- :type 'number
- :group 'ggtags)
-
-(defcustom ggtags-bounds-of-tag-function (lambda ()
- (bounds-of-thing-at-point 'symbol))
- "Function to get the start and end positions of the tag at point."
- :type 'function
- :group 'ggtags)
-
-;; Used by ggtags-global-mode
-(defvar ggtags-global-error "match"
- "Stem of message to print when no matches are found.")
-
-(defconst ggtags-bug-url "https://github.com/leoliu/ggtags/issues")
-
-(defvar ggtags-global-last-buffer nil)
-
-(defvar ggtags-global-continuation nil)
-
-(defvar ggtags-current-tag-name nil)
-
-(defvar ggtags-highlight-tag-overlay nil)
-
-(defvar ggtags-highlight-tag-timer nil)
-
-(defmacro ggtags-with-temp-message (message &rest body)
- (declare (debug t) (indent 1))
- (let ((init-time (make-symbol "-init-time-"))
- (tmp-msg (make-symbol "-tmp-msg-")))
- `(let ((,init-time (float-time))
- (,tmp-msg ,message))
- (with-temp-message ,tmp-msg
- (prog1 (progn ,@body)
- (message "%sdone (%.2fs)" ,(or tmp-msg "")
- (- (float-time) ,init-time)))))))
-
-(defmacro ggtags-delay-finish-functions (&rest body)
- "Delay running `compilation-finish-functions' until after BODY."
- (declare (indent 0) (debug t))
- (let ((saved (make-symbol "-saved-"))
- (exit-args (make-symbol "-exit-args-")))
- `(let ((,saved compilation-finish-functions)
- ,exit-args)
- (setq-local compilation-finish-functions nil)
- (add-hook 'compilation-finish-functions
- (lambda (&rest args) (setq ,exit-args args))
- nil t)
- (unwind-protect (progn ,@body)
- (setq-local compilation-finish-functions ,saved)
- (and ,exit-args (apply #'run-hook-with-args
- 'compilation-finish-functions ,exit-args))))))
-
-(defmacro ggtags-ensure-global-buffer (&rest body)
- (declare (debug t) (indent 0))
- `(progn
- (or (and (buffer-live-p ggtags-global-last-buffer)
- (with-current-buffer ggtags-global-last-buffer
- (derived-mode-p 'ggtags-global-mode)))
- (error "No global buffer found"))
- (with-current-buffer ggtags-global-last-buffer ,@body)))
-
-(defun ggtags-list-of-string-p (xs)
- "Return non-nil if XS is a list of strings."
- (cl-every #'stringp xs))
-
-(defun ggtags-ensure-localname (file)
- (and file (or (file-remote-p file 'localname) file)))
-
-(defun ggtags-echo (format-string &rest args)
- "Print formatted text to echo area."
- (let (message-log-max) (apply #'message format-string args)))
-
-(defun ggtags-forward-to-line (line)
- "Move to line number LINE in current buffer."
- (cl-check-type line (integer 1))
- (save-restriction
- (widen)
- (goto-char (point-min))
- (forward-line (1- line))))
-
-(defun ggtags-kill-window ()
- "Quit selected window and kill its buffer."
- (interactive)
- (quit-window t))
-
-(defun ggtags-program-path (name)
- (if ggtags-executable-directory
- (expand-file-name name ggtags-executable-directory)
- name))
-
-(defun ggtags-process-succeed-p (program &rest args)
- "Return non-nil if successfully running PROGRAM with ARGS."
- (let ((program (ggtags-program-path program)))
- (condition-case err
- (zerop (apply #'process-file program nil nil nil args))
- (error (message "`%s' failed: %s" program (error-message-string err))
- nil))))
-
-(defun ggtags-process-string (program &rest args)
- (with-temp-buffer
- (let ((exit (apply #'process-file
- (ggtags-program-path program) nil t nil args))
- (output (progn
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (buffer-substring (point-min) (point)))))
- (or (zerop exit)
- (error "`%s' non-zero exit: %s" program output))
- output)))
-
-(defun ggtags-tag-at-point ()
- (pcase (funcall ggtags-bounds-of-tag-function)
- (`(,beg . ,end) (buffer-substring beg end))))
-
-;;; Store for project info and settings
-
-(defvar ggtags-projects (make-hash-table :size 7 :test #'equal))
-
-(cl-defstruct (ggtags-project (:constructor ggtags-project--make)
- (:copier nil)
- (:type vector)
- :named)
- root tag-size has-refs has-path-style has-color dirty-p mtime timestamp)
-
-(defun ggtags-make-project (root)
- (cl-check-type root string)
- (pcase (nthcdr 5 (file-attributes (expand-file-name "GTAGS" root)))
- (`(,mtime ,_ ,tag-size . ,_)
- (let* ((default-directory (file-name-as-directory root))
- (rtags-size (nth 7 (file-attributes "GRTAGS")))
- (has-refs
- (when rtags-size
- (and (or (> rtags-size (* 32 1024))
- (with-demoted-errors "ggtags-make-project: %S"
- (not (equal "" (ggtags-process-string "global" "-crs")))))
- 'has-refs)))
- ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1518
- (has-path-style
- (and (ggtags-process-succeed-p "global" "--path-style" "shorter" "--help")
- 'has-path-style))
- ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1542
- (has-color (and (ggtags-process-succeed-p "global" "--color" "--help")
- 'has-color)))
- (puthash default-directory
- (ggtags-project--make :root default-directory
- :tag-size tag-size
- :has-refs has-refs
- :has-path-style has-path-style
- :has-color has-color
- :mtime (float-time mtime)
- :timestamp (float-time))
- ggtags-projects)))))
-
-(defun ggtags-project-expired-p (project)
- (or (< (ggtags-project-timestamp project) 0)
- (> (- (float-time)
- (ggtags-project-timestamp project))
- ggtags-project-duration)))
-
-(defun ggtags-project-update-mtime-maybe (&optional project)
- "Update PROJECT's modtime and if current file is newer.
-Value is new modtime if updated."
- (let ((project (or project (ggtags-find-project))))
- (when (and (ggtags-project-p project)
- (consp (visited-file-modtime))
- (> (float-time (visited-file-modtime))
- (ggtags-project-mtime project)))
- (setf (ggtags-project-dirty-p project) t)
- (setf (ggtags-project-mtime project)
- (float-time (visited-file-modtime))))))
-
-(defun ggtags-project-oversize-p (&optional project)
- (pcase ggtags-oversize-limit
- (`nil nil)
- (`t t)
- (size (let ((project (or project (ggtags-find-project))))
- (and project (> (ggtags-project-tag-size project) size))))))
-
-(defvar-local ggtags-last-default-directory nil)
-(defvar-local ggtags-project-root 'unset
- "Internal variable for project root directory.")
-
-;;;###autoload
-(defun ggtags-find-project ()
- ;; See https://github.com/leoliu/ggtags/issues/42
- ;;
- ;; It is unsafe to cache `ggtags-project-root' in non-file buffers
- ;; whose `default-directory' can often change.
- (unless (equal ggtags-last-default-directory default-directory)
- (kill-local-variable 'ggtags-project-root))
- (let ((project (gethash ggtags-project-root ggtags-projects)))
- (if (ggtags-project-p project)
- (if (ggtags-project-expired-p project)
- (progn
- (remhash ggtags-project-root ggtags-projects)
- (ggtags-find-project))
- project)
- (setq ggtags-last-default-directory default-directory)
- (setq ggtags-project-root
- (or (ignore-errors-unless-debug
- (file-name-as-directory
- (concat (file-remote-p default-directory)
- ;; Resolves symbolic links
- (ggtags-process-string "global" "-pr"))))
- ;; 'global -pr' resolves symlinks before checking the
- ;; GTAGS file which could cause issues such as
- ;; https://github.com/leoliu/ggtags/issues/22, so
- ;; let's help it out.
- ;;
- ;; Note: `locate-dominating-file' doesn't accept
- ;; function for NAME before 24.3.
- (let ((dir (locate-dominating-file default-directory "GTAGS")))
- ;; `file-truename' may strip the trailing '/' on
- ;; remote hosts, see http://debbugs.gnu.org/16851
- (and dir (file-regular-p (expand-file-name "GTAGS" dir))
- (file-name-as-directory (file-truename dir))))))
- (when ggtags-project-root
- (if (gethash ggtags-project-root ggtags-projects)
- (ggtags-find-project)
- (ggtags-make-project ggtags-project-root))))))
-
-(defun ggtags-current-project-root ()
- (and (ggtags-find-project)
- (ggtags-project-root (ggtags-find-project))))
-
-(defun ggtags-check-project ()
- (or (ggtags-find-project) (error "File GTAGS not found")))
-
-(defun ggtags-ensure-project ()
- (or (ggtags-find-project)
- (progn (call-interactively #'ggtags-create-tags)
- ;; Need checking because `ggtags-create-tags' can create
- ;; tags in any directory.
- (ggtags-check-project))))
-
-(defvar delete-trailing-lines) ;new in 24.3
-
-(defun ggtags-save-project-settings (&optional noconfirm)
- "Save Gnu Global's specific environment variables."
- (interactive "P")
- (ggtags-check-project)
- (let* ((inhibit-read-only t) ; for `add-dir-local-variable'
- (default-directory (ggtags-current-project-root))
- ;; Not using `ggtags-with-current-project' to preserve
- ;; environment variables that may be present in
- ;; `ggtags-process-environment'.
- (process-environment
- (append ggtags-process-environment
- process-environment
- (and (not (ggtags-project-has-refs (ggtags-find-project)))
- (list "GTAGSLABEL=ctags"))))
- (envlist (delete-dups
- (cl-loop for x in process-environment
- when (string-match
- "^\\(GTAGS[^=\n]*\\|MAKEOBJDIRPREFIX\\)=" x)
- ;; May have duplicates thus `delete-dups'.
- collect (concat (match-string 1 x)
- "="
- (getenv (match-string 1 x))))))
- (help-form (format "y: save\nn: don't save\n=: diff\n?: help\n")))
- (add-dir-local-variable nil 'ggtags-process-environment envlist)
- ;; Remove trailing newlines by `add-dir-local-variable'.
- (let ((delete-trailing-lines t)) (delete-trailing-whitespace))
- (or noconfirm
- (while (pcase (read-char-choice
- (format "Save `%s'? (y/n/=/?) " buffer-file-name)
- '(?y ?n ?= ??))
- ;; ` required for 24.1 and 24.2
- (`?n (user-error "Aborted"))
- (`?y nil)
- (`?= (diff-buffer-with-file) 'loop)
- (`?? (help-form-show) 'loop))))
- (save-buffer)
- (kill-buffer)))
-
-(defun ggtags-toggle-project-read-only ()
- (interactive)
- (ggtags-check-project)
- (let ((inhibit-read-only t) ; for `add-dir-local-variable'
- (val (not buffer-read-only))
- (default-directory (ggtags-current-project-root)))
- (add-dir-local-variable nil 'buffer-read-only val)
- (save-buffer)
- (kill-buffer)
- (when buffer-file-name
- (read-only-mode (if val +1 -1)))
- (when (called-interactively-p 'interactive)
- (message "Project read-only-mode is %s" (if val "on" "off")))
- val))
-
-(defun ggtags-visit-project-root (&optional project)
- "Visit the root directory of (current) PROJECT in dired.
-When called with a prefix \\[universal-argument], choose from past projects."
- (interactive (list (and current-prefix-arg
- (completing-read "Project: " ggtags-projects))))
- (dired (cl-typecase project
- (string project)
- (ggtags-project (ggtags-project-root project))
- (t (ggtags-ensure-project) (ggtags-current-project-root)))))
-
-(defmacro ggtags-with-current-project (&rest body)
- "Eval BODY in current project's `process-environment'."
- (declare (debug t) (indent 0))
- (let ((gtagsroot (make-symbol "-gtagsroot-"))
- (root (make-symbol "-ggtags-project-root-")))
- `(let* ((,root ggtags-project-root)
- (,gtagsroot (when (ggtags-find-project)
- (ggtags-ensure-localname
- (directory-file-name (ggtags-current-project-root)))))
- (process-environment
- (append (let ((process-environment (copy-sequence process-environment)))
- (and ,gtagsroot (setenv "GTAGSROOT" ,gtagsroot))
- (mapcar #'substitute-env-vars ggtags-process-environment))
- process-environment
- (and ,gtagsroot (list (concat "GTAGSROOT=" ,gtagsroot)))
- (and (ggtags-find-project)
- (not (ggtags-project-has-refs (ggtags-find-project)))
- (list "GTAGSLABEL=ctags")))))
- (unwind-protect (save-current-buffer ,@body)
- (setq ggtags-project-root ,root)))))
-
-(defun ggtags-get-libpath ()
- (let ((path (ggtags-with-current-project (getenv "GTAGSLIBPATH"))))
- (and path (mapcar (apply-partially #'concat (file-remote-p default-directory))
- (split-string path (regexp-quote path-separator) t)))))
-
-(defun ggtags-project-relative-file (file)
- "Get file name relative to current project root."
- (ggtags-check-project)
- (if (file-name-absolute-p file)
- (file-relative-name file (if (string-prefix-p (ggtags-current-project-root)
- file)
- (ggtags-current-project-root)
- (locate-dominating-file file "GTAGS")))
- file))
-
-(defun ggtags-project-file-p (file)
- "Return non-nil if FILE is part of current project."
- (when (ggtags-find-project)
- (with-temp-buffer
- (ggtags-with-current-project
- ;; NOTE: `process-file' requires all files in ARGS be relative
- ;; to `default-directory'; see its doc string for details.
- (let ((default-directory (ggtags-current-project-root)))
- (process-file (ggtags-program-path "global") nil t nil
- "-vP" (concat "^" (ggtags-project-relative-file file) "$"))))
- (goto-char (point-min))
- (not (re-search-forward "^file not found" nil t)))))
-
-(defun ggtags-invalidate-buffer-project-root (root)
- (mapc (lambda (buf)
- (with-current-buffer buf
- (and buffer-file-truename
- (string-prefix-p root buffer-file-truename)
- (kill-local-variable 'ggtags-project-root))))
- (buffer-list)))
-
-(defun ggtags-create-tags (root)
- "Create tag files (e.g. GTAGS) in directory ROOT.
-If file .globalrc or gtags.conf exists in ROOT, it will be used
-as configuration file per `ggtags-use-project-gtagsconf'.
-
-If file gtags.files exists in ROOT, it should be a list of source
-files to index, which can be used to speed gtags up in large
-source trees. See Info node `(global)gtags' for details."
- (interactive "DRoot directory: ")
- (let ((process-environment (copy-sequence process-environment)))
- (when (zerop (length root)) (error "No root directory provided"))
- (setenv "GTAGSROOT" (ggtags-ensure-localname
- (expand-file-name
- (directory-file-name (file-name-as-directory root)))))
- (ggtags-with-current-project
- (let ((conf (and ggtags-use-project-gtagsconf
- (cl-loop for name in '(".globalrc" "gtags.conf")
- for full = (expand-file-name name root)
- thereis (and (file-exists-p full) full)))))
- (unless (or conf (getenv "GTAGSLABEL")
- (not (yes-or-no-p "Use `ctags' backend? ")))
- (setenv "GTAGSLABEL" "ctags"))
- (ggtags-with-temp-message "`gtags' in progress..."
- (let ((default-directory (file-name-as-directory root))
- (args (cl-remove-if
- #'null
- (list (and ggtags-use-idutils "--idutils")
- (and ggtags-use-sqlite3
- (ggtags-process-succeed-p "gtags" "--sqlite3" "--help")
- "--sqlite3")
- (and conf "--gtagsconf")
- (and conf (ggtags-ensure-localname conf))))))
- (condition-case err
- (apply #'ggtags-process-string "gtags" args)
- (error (if (and ggtags-use-idutils
- (stringp (cadr err))
- (string-match-p "mkid not found" (cadr err)))
- ;; Retry without mkid
- (apply #'ggtags-process-string
- "gtags" (cl-remove "--idutils" args))
- (signal (car err) (cdr err)))))))))
- (ggtags-invalidate-buffer-project-root (file-truename root))
- (message "GTAGS generated in `%s'" root)
- root))
-
-(defun ggtags-explain-tags ()
- "Explain how each file is indexed in current project."
- (interactive (ignore (ggtags-check-project)
- (or (ggtags-process-succeed-p "gtags" "--explain" "--help")
- (user-error "Global 6.4+ required"))))
- (ggtags-check-project)
- (ggtags-with-current-project
- (let ((default-directory (ggtags-current-project-root)))
- (compilation-start (concat (ggtags-program-path "gtags") " --explain")))))
-
-(defun ggtags-update-tags (&optional force)
- "Update GNU Global tag database.
-Do nothing if GTAGS exceeds the oversize limit unless FORCE.
-
-When called interactively on large (per `ggtags-oversize-limit')
-projects, the update process runs in the background without
-blocking emacs."
- (interactive (progn
- (ggtags-check-project)
- ;; Mark project info expired.
- (setf (ggtags-project-timestamp (ggtags-find-project)) -1)
- (list 'interactive)))
- (cond ((and (eq force 'interactive) (ggtags-project-oversize-p))
- (ggtags-with-current-project
- (with-display-buffer-no-window
- (with-current-buffer (compilation-start "global -u")
- ;; A hack to fool compilation mode to display `global
- ;; -u finished' on finish.
- (setq mode-name "global -u")
- (add-hook 'compilation-finish-functions
- #'ggtags-update-tags-finish nil t)))))
- ((or force (and (ggtags-find-project)
- (not (ggtags-project-oversize-p))
- (ggtags-project-dirty-p (ggtags-find-project))))
- (ggtags-with-current-project
- (ggtags-with-temp-message "`global -u' in progress..."
- (ggtags-process-string "global" "-u")
- (ggtags-update-tags-finish))))))
-
-(defun ggtags-update-tags-finish (&optional buf how)
- (if (and how buf (string-prefix-p "exited abnormally" how))
- (display-buffer buf)
- (setf (ggtags-project-dirty-p (ggtags-find-project)) nil)
- (setf (ggtags-project-mtime (ggtags-find-project)) (float-time))))
-
-(defun ggtags-update-tags-single (file &optional nowait)
- ;; NOTE: NOWAIT is ignored if file is remote file; see
- ;; `tramp-sh-handle-process-file'.
- (cl-check-type file string)
- (let ((nowait (unless (file-remote-p file) nowait)))
- (ggtags-with-current-project
- ;; See comment in `ggtags-project-file-p'.
- (let ((default-directory (ggtags-current-project-root)))
- (process-file (ggtags-program-path "global") nil (and nowait 0) nil
- "--single-update" (ggtags-project-relative-file file))))))
-
-(defun ggtags-delete-tags ()
- "Delete file GTAGS, GRTAGS, GPATH, ID etc. generated by gtags."
- (interactive (ignore (ggtags-check-project)))
- (when (ggtags-current-project-root)
- (let* ((re (concat "\\`" (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID")) "\\'"))
- (files (cl-remove-if-not
- (lambda (file)
- ;; Don't trust `directory-files'.
- (let ((case-fold-search nil))
- (string-match-p re (file-name-nondirectory file))))
- (directory-files (ggtags-current-project-root) t re)))
- (buffer "*GTags File List*"))
- (or files (user-error "No tag files found"))
- (with-output-to-temp-buffer buffer
- (princ (mapconcat #'identity files "\n")))
- (let ((win (get-buffer-window buffer)))
- (unwind-protect
- (progn
- (fit-window-to-buffer win)
- (when (yes-or-no-p "Remove GNU Global tag files? ")
- (with-demoted-errors (mapc #'delete-file files))
- (remhash (ggtags-current-project-root) ggtags-projects)
- (and (overlayp ggtags-highlight-tag-overlay)
- (delete-overlay ggtags-highlight-tag-overlay))))
- (when (window-live-p win)
- (quit-window t win)))))))
-
-(defvar-local ggtags-completion-cache nil)
-
-;; See global/libutil/char.c
-;; (defconst ggtags-regexp-metachars "[][$()*+.?\\{}|^]")
-(defvar ggtags-completion-flag "") ;internal use
-
-(defvar ggtags-completion-table
- (completion-table-dynamic
- (lambda (prefix)
- (let ((cache-key (concat prefix "$" ggtags-completion-flag)))
- (unless (equal cache-key (car ggtags-completion-cache))
- (setq ggtags-completion-cache
- (cons cache-key
- (ignore-errors-unless-debug
- ;; May throw global: only name char is allowed
- ;; with -c option.
- (ggtags-with-current-project
- (split-string
- (apply #'ggtags-process-string
- "global"
- (append (and completion-ignore-case '("--ignore-case"))
- ;; Note -c alone returns only definitions
- (list (concat "-c" ggtags-completion-flag) prefix)))
- "\n" t)))))))
- (cdr ggtags-completion-cache))))
-
-(defun ggtags-completion-at-point ()
- "A function for `completion-at-point-functions'."
- (pcase (funcall ggtags-bounds-of-tag-function)
- (`(,beg . ,end)
- (and (< beg end) (list beg end ggtags-completion-table)))))
-
-(defun ggtags-read-tag (&optional type confirm prompt require-match default)
- (ggtags-ensure-project)
- (let ((default (or default (ggtags-tag-at-point)))
- (prompt (or prompt (capitalize (symbol-name (or type 'tag)))))
- (ggtags-completion-flag (pcase type
- (`(or nil definition) "T")
- (`symbol "s")
- (`reference "r")
- (`id "I")
- (`path "P")
- ((pred stringp) type)
- (_ ggtags-completion-flag))))
- (setq ggtags-current-tag-name
- (cond (confirm
- (ggtags-update-tags)
- (let ((completing-read-function
- (or ggtags-completing-read-function
- completing-read-function)))
- (completing-read
- (format (if default "%s (default %s): " "%s: ") prompt default)
- ggtags-completion-table nil require-match nil nil default)))
- (default (substring-no-properties default))
- (t (ggtags-read-tag type t prompt require-match default))))))
-
-(defun ggtags-sort-by-nearness-p ()
- (and ggtags-sort-by-nearness
- (ggtags-process-succeed-p "global" "--nearness" "--help")))
-
-(defun ggtags-global-build-command (cmd &rest args)
- ;; CMD can be definition, reference, symbol, grep, idutils
- (let ((xs (append (list (shell-quote-argument (ggtags-program-path "global"))
- "-v"
- (format "--result=%s" ggtags-global-output-format)
- (and ggtags-global-ignore-case "--ignore-case")
- (and ggtags-global-use-color
- (ggtags-find-project)
- (ggtags-project-has-color (ggtags-find-project))
- "--color=always")
- (and (ggtags-sort-by-nearness-p) "--nearness")
- (and (ggtags-find-project)
- (ggtags-project-has-path-style (ggtags-find-project))
- "--path-style=shorter")
- (and ggtags-global-treat-text "--other")
- (pcase cmd
- ((pred stringp) cmd)
- (`definition nil) ;-d not supported by Global 5.7.1
- (`reference "--reference")
- (`symbol "--symbol")
- (`path "--path")
- (`grep "--grep")
- (`idutils "--idutils")))
- args)))
- (mapconcat #'identity (delq nil xs) " ")))
-
-;; Can be three values: nil, t and a marker; t means start marker has
-;; been saved in the tag ring.
-(defvar ggtags-global-start-marker nil)
-(defvar ggtags-global-start-file nil)
-(defvar ggtags-tag-ring-index nil)
-(defvar ggtags-global-search-history nil)
-
-(defvar ggtags-auto-jump-to-match-target nil)
-
-(defvar-local ggtags-global-exit-info nil) ; (EXIT-STATUS COUNT DB)
-
-(defun ggtags-global-save-start-marker ()
- (when (markerp ggtags-global-start-marker)
- (setq ggtags-tag-ring-index nil)
- (ring-insert find-tag-marker-ring ggtags-global-start-marker)
- (setq ggtags-global-start-marker t)))
-
-(defun ggtags-global-start (command &optional directory)
- (let* ((default-directory (or directory (ggtags-current-project-root)))
- (split-window-preferred-function ggtags-split-window-function)
- (env ggtags-process-environment))
- (unless (and (markerp ggtags-global-start-marker)
- (marker-position ggtags-global-start-marker))
- (setq ggtags-global-start-marker (point-marker)))
- ;; Record the file name for `ggtags-navigation-start-file'.
- (setq ggtags-global-start-file buffer-file-name)
- (setq ggtags-auto-jump-to-match-target
- (nth 4 (assoc (ggtags-global-search-id command default-directory)
- ggtags-global-search-history)))
- (ggtags-navigation-mode +1)
- (ggtags-update-tags)
- (ggtags-with-current-project
- (with-current-buffer (with-display-buffer-no-window
- (compilation-start command 'ggtags-global-mode))
- (setq-local ggtags-process-environment env)
- (setq ggtags-global-last-buffer (current-buffer))))))
-
-(defun ggtags-find-tag-continue ()
- (interactive)
- (ggtags-ensure-global-buffer
- (ggtags-navigation-mode +1)
- (let ((split-window-preferred-function ggtags-split-window-function))
- (ignore-errors (compilation-next-error 1))
- (compile-goto-error))))
-
-(defun ggtags-find-tag (cmd &rest args)
- (ggtags-check-project)
- (ggtags-global-start (apply #'ggtags-global-build-command cmd args)
- (and (ggtags-sort-by-nearness-p) default-directory)))
-
-(defun ggtags-include-file ()
- "Calculate the include file based on `ggtags-include-pattern'."
- (pcase ggtags-include-pattern
- (`nil nil)
- ((pred functionp)
- (funcall ggtags-include-pattern))
- (`(,re . ,sub)
- (save-excursion
- (beginning-of-line)
- (and (looking-at re) (match-string sub))))
- (_ (warn "Invalid value for `ggtags-include-pattern': %s"
- ggtags-include-pattern)
- nil)))
-
-;;;###autoload
-(defun ggtags-find-tag-dwim (name &optional what)
- "Find NAME by context.
-If point is at a definition tag, find references, and vice versa.
-If point is at a line that matches `ggtags-include-pattern', find
-the include file instead.
-
-When called interactively with a prefix arg, always find
-definition tags."
- (interactive
- (let ((include (and (not current-prefix-arg) (ggtags-include-file))))
- (ggtags-ensure-project)
- (if include (list include 'include)
- (list (ggtags-read-tag 'definition current-prefix-arg)
- (and current-prefix-arg 'definition)))))
- (ggtags-check-project) ; For `ggtags-current-project-root' below.
- (cond
- ((eq what 'include)
- (ggtags-find-file name))
- ((or (eq what 'definition)
- (not buffer-file-name)
- (not (ggtags-project-has-refs (ggtags-find-project)))
- (not (ggtags-project-file-p buffer-file-name)))
- (ggtags-find-definition name))
- (t (ggtags-find-tag
- (format "--from-here=%d:%s"
- (line-number-at-pos)
- (shell-quote-argument
- ;; Note `ggtags-find-tag' may bind `default-directory'
- ;; to project root.
- (funcall (if (ggtags-sort-by-nearness-p)
- #'file-relative-name #'ggtags-project-relative-file)
- buffer-file-name)))
- (shell-quote-argument name)))))
-
-(defun ggtags-find-tag-mouse (event)
- (interactive "e")
- (with-selected-window (posn-window (event-start event))
- (save-excursion
- (goto-char (posn-point (event-start event)))
- (call-interactively #'ggtags-find-tag-dwim))))
-
-;; Another option for `M-.'.
-(defun ggtags-find-definition (name)
- (interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
- (ggtags-find-tag 'definition (shell-quote-argument name)))
-
-(defun ggtags-setup-libpath-search (type name)
- (pcase (and ggtags-global-search-libpath-for-reference
- (ggtags-get-libpath))
- ((and libs (guard libs))
- (cl-labels ((cont (buf how)
- (pcase ggtags-global-exit-info
- (`(0 0 ,_)
- (with-temp-buffer
- (setq default-directory
- (file-name-as-directory (pop libs)))
- (and libs (setq ggtags-global-continuation #'cont))
- (if (ggtags-find-project)
- (ggtags-find-tag type (shell-quote-argument name))
- (cont buf how))))
- (_ (ggtags-global-handle-exit buf how)))))
- (setq ggtags-global-continuation #'cont)))))
-
-(defun ggtags-find-reference (name)
- (interactive (list (ggtags-read-tag 'reference current-prefix-arg)))
- (ggtags-setup-libpath-search 'reference name)
- (ggtags-find-tag 'reference (shell-quote-argument name)))
-
-(defun ggtags-find-other-symbol (name)
- "Find tag NAME that is a reference without a definition."
- (interactive (list (ggtags-read-tag 'symbol current-prefix-arg)))
- (ggtags-setup-libpath-search 'symbol name)
- (ggtags-find-tag 'symbol (shell-quote-argument name)))
-
-(defun ggtags-quote-pattern (pattern)
- (prin1-to-string (substring-no-properties pattern)))
-
-(defun ggtags-idutils-query (pattern)
- (interactive (list (ggtags-read-tag 'id t)))
- (ggtags-find-tag 'idutils "--" (ggtags-quote-pattern pattern)))
-
-(defun ggtags-grep (pattern &optional invert-match)
- "Grep for lines matching PATTERN.
-Invert the match when called with a prefix arg \\[universal-argument]."
- (interactive (list (ggtags-read-tag 'definition 'confirm
- (if current-prefix-arg
- "Inverted grep pattern" "Grep pattern"))
- current-prefix-arg))
- (ggtags-find-tag 'grep (and invert-match "--invert-match")
- "--" (ggtags-quote-pattern pattern)))
-
-(defun ggtags-find-file (pattern &optional invert-match)
- (interactive (list (ggtags-read-tag 'path 'confirm (if current-prefix-arg
- "Inverted path pattern"
- "Path pattern")
- nil (thing-at-point 'filename))
- current-prefix-arg))
- (let ((ggtags-global-output-format 'path))
- (ggtags-find-tag 'path (and invert-match "--invert-match")
- "--" (ggtags-quote-pattern pattern))))
-
-;; Note: Coloured output requested in http://goo.gl/Y9IcX and appeared
-;; in global v6.2.12.
-(defun ggtags-find-tag-regexp (regexp directory)
- "List tags matching REGEXP in DIRECTORY (default to project root).
-When called interactively with a prefix, ask for the directory."
- (interactive
- (progn
- (ggtags-check-project)
- (list (ggtags-read-tag "" t "POSIX regexp")
- (if current-prefix-arg
- (read-directory-name "Directory: " nil nil t)
- (ggtags-current-project-root)))))
- (ggtags-check-project)
- (ggtags-global-start
- (ggtags-global-build-command nil nil "-l" "--" (ggtags-quote-pattern regexp))
- (file-name-as-directory directory)))
-
-(defvar ggtags-navigation-mode)
-
-(defun ggtags-foreach-file (fn)
- "Invoke FN with each file found.
-FN is invoked while *ggtags-global* buffer is current."
- (ggtags-ensure-global-buffer
- (save-excursion
- (goto-char (point-min))
- (while (with-demoted-errors "compilation-next-error: %S"
- (compilation-next-error 1 'file)
- t)
- (funcall fn (caar
- (compilation--loc->file-struct
- (compilation--message->loc
- (get-text-property (point) 'compilation-message)))))))))
-
-(defun ggtags-query-replace (from to &optional delimited)
- "Query replace FROM with TO on files in the Global buffer.
-If not in navigation mode, do a grep on FROM first.
-
-Note: the regular expression FROM must be supported by both
-Global and Emacs."
- (interactive
- ;; Note: in 24.4 query-replace-read-args returns a list of 4 elements.
- (let ((args (query-replace-read-args "Query replace (regexp)" t t)))
- (list (nth 0 args) (nth 1 args) (nth 2 args))))
- (unless ggtags-navigation-mode
- (let ((ggtags-auto-jump-to-match nil))
- (ggtags-grep from)))
- (let ((file-form
- '(let ((files))
- (ggtags-ensure-global-buffer
- (ggtags-with-temp-message "Waiting for Grep to finish..."
- (while (get-buffer-process (current-buffer))
- (sit-for 0.2)))
- (ggtags-foreach-file
- (lambda (file) (push (expand-file-name file) files))))
- (ggtags-navigation-mode -1)
- (nreverse files))))
- (tags-query-replace from to delimited file-form)))
-
-(defun ggtags-global-normalise-command (cmd)
- (if (string-match
- (concat (regexp-quote (ggtags-global-build-command nil)) "\\s-*")
- cmd)
- (substring-no-properties cmd (match-end 0))
- cmd))
-
-(defun ggtags-global-search-id (cmd directory)
- (sha1 (concat directory (make-string 1 0)
- (ggtags-global-normalise-command cmd))))
-
-(defun ggtags-global-current-search ()
- ;; CMD DIR ENV LINE TEXT
- (ggtags-ensure-global-buffer
- (list (ggtags-global-normalise-command (car compilation-arguments))
- default-directory
- ggtags-process-environment
- (line-number-at-pos)
- (buffer-substring-no-properties
- (line-beginning-position) (line-end-position)))))
-
-(defun ggtags-global-rerun-search (data)
- (pcase data
- (`(,cmd ,dir ,env ,line ,_text)
- (with-current-buffer (let ((ggtags-auto-jump-to-match nil)
- ;; Switch current project to DIR.
- (default-directory dir)
- (ggtags-project-root dir)
- (ggtags-process-environment env))
- (ggtags-global-start
- (ggtags-global-build-command cmd) dir))
- (add-hook 'compilation-finish-functions
- (lambda (buf _msg)
- (with-current-buffer buf
- (ggtags-forward-to-line line)
- (compile-goto-error)))
- nil t)))))
-
-(defvar-local ggtags-global-search-ewoc nil)
-(defvar ggtags-view-search-history-last nil)
-
-(defvar ggtags-view-search-history-mode-map
- (let ((m (make-sparse-keymap)))
- (define-key m "p" 'ggtags-view-search-history-prev)
- (define-key m "\M-p" 'ggtags-view-search-history-prev)
- (define-key m "n" 'ggtags-view-search-history-next)
- (define-key m "\M-n" 'ggtags-view-search-history-next)
- (define-key m "\C-k" 'ggtags-view-search-history-kill)
- (define-key m [remap yank] (lambda (&optional arg) (interactive "P") (yank arg)))
- (define-key m "\C-c\C-c" 'ggtags-view-search-history-update)
- (define-key m "r" 'ggtags-save-to-register)
- (define-key m "\r" 'ggtags-view-search-history-action)
- (define-key m "q" 'ggtags-kill-window)
- m))
-
-(defun ggtags-view-search-history-remember ()
- (setq ggtags-view-search-history-last
- (pcase (ewoc-locate ggtags-global-search-ewoc)
- (`nil nil)
- (node (ewoc-data node)))))
-
-(defun ggtags-view-search-history-next (&optional arg)
- (interactive "p")
- (let ((arg (or arg 1)))
- (prog1 (funcall (if (cl-minusp arg) #'ewoc-goto-prev #'ewoc-goto-next)
- ggtags-global-search-ewoc (abs arg))
- (ggtags-view-search-history-remember))))
-
-(defun ggtags-view-search-history-prev (&optional arg)
- (interactive "p")
- (ggtags-view-search-history-next (- (or arg 1))))
-
-(defun ggtags-view-search-history-kill (&optional append)
- (interactive "P")
- (let* ((node (or (ewoc-locate ggtags-global-search-ewoc)
- (user-error "No node at point")))
- (next (ewoc-next ggtags-global-search-ewoc node))
- (text (filter-buffer-substring (ewoc-location node)
- (if next (ewoc-location next)
- (point-max)))))
- (put-text-property
- 0 (length text) 'yank-handler
- (list (lambda (arg)
- (if (not ggtags-global-search-ewoc)
- (insert (car arg))
- (let* ((inhibit-read-only t)
- (node (unless (looking-at-p "[ \t\n]*\\'")
- (ewoc-locate ggtags-global-search-ewoc))))
- (if node
- (ewoc-enter-before ggtags-global-search-ewoc
- node (cadr arg))
- (ewoc-enter-last ggtags-global-search-ewoc (cadr arg)))
- (setq ggtags-view-search-history-last (cadr arg)))))
- (list text (ewoc-data node)))
- text)
- (if append (kill-append text nil)
- (kill-new text))
- (let ((inhibit-read-only t))
- (ewoc-delete ggtags-global-search-ewoc node))))
-
-(defun ggtags-view-search-history-update (&optional noconfirm)
- "Update `ggtags-global-search-history' to current buffer."
- (interactive "P")
- (when (and (buffer-modified-p)
- (or noconfirm
- (yes-or-no-p "Modify `ggtags-global-search-history'?")))
- (setq ggtags-global-search-history
- (ewoc-collect ggtags-global-search-ewoc #'identity))
- (set-buffer-modified-p nil)))
-
-(defun ggtags-view-search-history-action ()
- (interactive)
- (let ((data (ewoc-data (or (ewoc-locate ggtags-global-search-ewoc)
- (user-error "No search at point")))))
- (ggtags-view-search-history-remember)
- (quit-window t)
- (ggtags-global-rerun-search (cdr data))))
-
-(defvar bookmark-make-record-function)
-
-(define-derived-mode ggtags-view-search-history-mode special-mode "SearchHist"
- "Major mode for viewing search history."
- :group 'ggtags
- (setq-local ggtags-enable-navigation-keys nil)
- (setq-local bookmark-make-record-function #'ggtags-make-bookmark-record)
- (setq truncate-lines t)
- (add-hook 'kill-buffer-hook #'ggtags-view-search-history-update nil t))
-
-(defun ggtags-view-search-history-restore-last ()
- (when ggtags-view-search-history-last
- (cl-loop for n = (ewoc-nth ggtags-global-search-ewoc 0)
- then (ewoc-next ggtags-global-search-ewoc n)
- while n when (eq (ewoc-data n)
- ggtags-view-search-history-last)
- do (progn (goto-char (ewoc-location n)) (cl-return t)))))
-
-(defun ggtags-view-search-history ()
- "Pop to a buffer to view or re-run past searches.
-
-\\{ggtags-view-search-history-mode-map}"
- (interactive)
- (or ggtags-global-search-history (user-error "No search history"))
- (let ((split-window-preferred-function ggtags-split-window-function)
- (inhibit-read-only t))
- (pop-to-buffer "*Ggtags Search History*")
- (erase-buffer)
- (ggtags-view-search-history-mode)
- (cl-labels ((prop (s)
- (propertize s 'face 'minibuffer-prompt))
- (prop-tag (cmd)
- (with-temp-buffer
- (insert cmd)
- (forward-sexp -1)
- (if (eobp)
- cmd
- (put-text-property (point) (point-max)
- 'face font-lock-constant-face)
- (buffer-string))))
- (pp (data)
- (pcase data
- (`(,_id ,cmd ,dir ,_env ,line ,text)
- (insert (prop " cmd: ") (prop-tag cmd) "\n"
- (prop " dir: ") dir "\n"
- (prop "line: ") (number-to-string line) "\n"
- (prop "text: ") text "\n"
- (propertize (make-string 32 ?-) 'face 'shadow))))))
- (setq ggtags-global-search-ewoc
- (ewoc-create #'pp "Global search history keys: n:next p:prev r:register RET:choose\n")))
- (dolist (data ggtags-global-search-history)
- (ewoc-enter-last ggtags-global-search-ewoc data))
- (ggtags-view-search-history-restore-last)
- (set-buffer-modified-p nil)
- (fit-window-to-buffer nil (floor (frame-height) 2))))
-
-(defun ggtags-save-to-register (r)
- "Save current search session to register R.
-Use \\[jump-to-register] to restore the search session."
- (interactive (list (register-read-with-preview "Save search to register: ")))
- (cl-labels ((prn (data)
- (pcase data
- (`(,command ,root ,_env ,line ,_)
- (princ (format "a ggtags search session `%s' in directory `%s' at line %d."
- command root line))))))
- (set-register r (registerv-make
- (if ggtags-global-search-ewoc
- (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
- (ggtags-global-current-search))
- :jump-func #'ggtags-global-rerun-search
- :print-func #'prn))))
-
-(defun ggtags-make-bookmark-record ()
- `(,(and ggtags-current-tag-name (format "*ggtags %s*" ggtags-current-tag-name))
- (ggtags-search . ,(if ggtags-global-search-ewoc
- (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
- (ggtags-global-current-search)))
- (handler . ggtags-bookmark-jump)))
-
-(declare-function bookmark-prop-get "bookmark")
-
-(defun ggtags-bookmark-jump (bmk)
- (ggtags-global-rerun-search (bookmark-prop-get bmk 'ggtags-search)))
-
-(defun ggtags-browse-file-as-hypertext (file line)
- "Browse FILE in hypertext (HTML) form."
- (interactive (if (or current-prefix-arg (not buffer-file-name))
- (list (read-file-name "Browse file: " nil nil t)
- (read-number "Line: " 1))
- (list buffer-file-name (line-number-at-pos))))
- (cl-check-type line (integer 1))
- (or (and file (file-exists-p file)) (error "File `%s' doesn't exist" file))
- (ggtags-check-project)
- (or (file-exists-p (expand-file-name "HTML" (ggtags-current-project-root)))
- (if (yes-or-no-p "No hypertext form exists; run htags? ")
- (let ((default-directory (ggtags-current-project-root)))
- (ggtags-with-current-project (ggtags-process-string "htags")))
- (user-error "Aborted")))
- (let ((url (ggtags-process-string "gozilla" "-p" (format "+%d" line)
- (file-relative-name file))))
- (or (equal (file-name-extension
- (url-filename (url-generic-parse-url url))) "html")
- (user-error "No hypertext form for `%s'" file))
- (when (called-interactively-p 'interactive)
- (message "Browsing %s" url))
- (browse-url url)))
-
-(defun ggtags-next-mark (&optional arg)
- "Move to the next (newer) mark in the tag marker ring."
- (interactive)
- (and (ring-empty-p find-tag-marker-ring) (user-error "Tag ring empty"))
- (setq ggtags-tag-ring-index
- ;; Note `ring-minus1' gets newer item.
- (funcall (if arg #'ring-plus1 #'ring-minus1)
- (or ggtags-tag-ring-index
- (progn
- (ring-insert find-tag-marker-ring (point-marker))
- 0))
- (ring-length find-tag-marker-ring)))
- (let ((m (ring-ref find-tag-marker-ring ggtags-tag-ring-index))
- (i (- (ring-length find-tag-marker-ring) ggtags-tag-ring-index)))
- (ggtags-echo "%d%s marker%s" i (pcase (mod i 10)
- ;; ` required for 24.1 and 24.2
- (`1 "st")
- (`2 "nd")
- (`3 "rd")
- (_ "th"))
- (if (marker-buffer m) "" " (dead)"))
- (if (not (marker-buffer m))
- (ding)
- (switch-to-buffer (marker-buffer m))
- (goto-char m))))
-
-(defun ggtags-prev-mark ()
- "Move to the previous (older) mark in the tag marker ring."
- (interactive)
- (ggtags-next-mark 'previous))
-
-(defvar ggtags-view-tag-history-mode-map
- (let ((m (make-sparse-keymap)))
- (define-key m "\M-n" 'next-error-no-select)
- (define-key m "\M-p" 'previous-error-no-select)
- (define-key m "q" 'ggtags-kill-window)
- m))
-
-(define-derived-mode ggtags-view-tag-history-mode tabulated-list-mode "TagHist"
- :abbrev-table nil :group 'ggtags)
-
-(defun ggtags-view-tag-history ()
- "Pop to a buffer listing visited locations from newest to oldest.
-The buffer is a next error buffer and works with standard
-commands `next-error' and `previous-error'.
-
-\\{ggtags-view-tag-history-mode-map}"
- (interactive)
- (and (ring-empty-p find-tag-marker-ring)
- (user-error "Tag ring empty"))
- (let ((split-window-preferred-function ggtags-split-window-function)
- (inhibit-read-only t))
- (pop-to-buffer "*Tag Ring*")
- (erase-buffer)
- (ggtags-view-tag-history-mode)
- (setq next-error-function #'ggtags-view-tag-history-next-error
- next-error-last-buffer (current-buffer))
- (setq tabulated-list-entries
- ;; Use a function so that revert can work properly.
- (lambda ()
- (let ((counter (ring-length find-tag-marker-ring))
- (elements (or (ring-elements find-tag-marker-ring)
- (user-error "Tag ring empty")))
- (action (lambda (_button) (next-error 0)))
- (get-line (lambda (m)
- (with-current-buffer (marker-buffer m)
- (save-excursion
- (goto-char m)
- (buffer-substring (line-beginning-position)
- (line-end-position)))))))
- (setq tabulated-list-format
- `[("ID" ,(max (1+ (floor (log counter 10))) 2)
- car-less-than-car)
- ("Buffer" ,(max (cl-loop for m in elements
- for b = (marker-buffer m)
- maximize
- (length (and b (buffer-name b))))
- 6)
- t :right-align t)
- ("Position" ,(max (cl-loop for m in elements
- for p = (or (marker-position m) 1)
- maximize (1+ (floor (log p 10))))
- 8)
- (lambda (x y)
- (< (string-to-number (aref (cadr x) 2))
- (string-to-number (aref (cadr y) 2))))
- :right-align t)
- ("Contents" 100 t)])
- (tabulated-list-init-header)
- (mapcar (lambda (x)
- (prog1
- (list counter
- (if (marker-buffer x)
- (vector (number-to-string counter)
- `(,(buffer-name (marker-buffer x))
- face link
- follow-link t
- marker ,x
- action ,action)
- (number-to-string (marker-position x))
- (funcall get-line x))
- (vector (number-to-string counter)
- "(dead)" "?" "?")))
- (cl-decf counter)))
- elements))))
- (setq tabulated-list-sort-key '("ID" . t))
- (tabulated-list-print)
- (fit-window-to-buffer nil (floor (frame-height) 2))))
-
-(defun ggtags-view-tag-history-next-error (&optional arg reset)
- (if (not reset)
- (forward-button arg)
- (goto-char (point-min))
- (forward-button (if (button-at (point)) 0 1)))
- (when (get-buffer-window)
- (set-window-point (get-buffer-window) (point)))
- (pcase (button-get (button-at (point)) 'marker)
- ((and (pred markerp) m)
- (if (eq (get-buffer-window) (selected-window))
- (pop-to-buffer (marker-buffer m))
- (switch-to-buffer (marker-buffer m)))
- (goto-char (marker-position m)))
- (_ (error "Dead marker"))))
-
-(defun ggtags-global-exit-message-1 ()
- "Get the total of matches and db file used."
- (save-excursion
- (goto-char (point-max))
- (if (re-search-backward
- "^\\w+ \\(not found\\)\\|^\\([0-9]+\\) \\w+ located" nil t)
- (cons (or (and (match-string 1) 0)
- (string-to-number (match-string 2)))
- (when (re-search-forward
- "using \\(?:\\(idutils\\)\\|'[^']*/\\(\\w+\\)'\\)"
- (line-end-position)
- t)
- (or (and (match-string 1) "ID")
- (match-string 2))))
- (cons 0 nil))))
-
-(defun ggtags-global-exit-message-function (_process-status exit-status msg)
- "A function for `compilation-exit-message-function'."
- (pcase (ggtags-global-exit-message-1)
- (`(,count . ,db)
- (setq ggtags-global-exit-info (list exit-status count db))
- ;; Clear the start marker in case of zero matches.
- (and (zerop count)
- (markerp ggtags-global-start-marker)
- (not ggtags-global-continuation)
- (setq ggtags-global-start-marker nil))
- (cons (if (> exit-status 0)
- msg
- (format "found %d %s" count
- (funcall (if (= count 1) #'car #'cadr)
- (pcase db
- ;; ` required for 24.1 and 24.2
- (`"GTAGS" '("definition" "definitions"))
- (`"GSYMS" '("symbol" "symbols"))
- (`"GRTAGS" '("reference" "references"))
- (`"GPATH" '("file" "files"))
- (`"ID" '("identifier" "identifiers"))
- (_ '("match" "matches"))))))
- exit-status))))
-
-(defun ggtags-global-column (start)
- ;; START is the beginning position of source text.
- (let ((mbeg (text-property-any start (line-end-position) 'global-color t)))
- (and mbeg (- mbeg start))))
-
-;;; NOTE: Must not match the 'Global started at Mon Jun 3 10:24:13'
-;;; line or `compilation-auto-jump' will jump there and fail. See
-;;; comments before the 'gnu' entry in
-;;; `compilation-error-regexp-alist-alist'.
-(defvar ggtags-global-error-regexp-alist-alist
- (append
- `((path "^\\(?:[^\"'\n]*/\\)?[^ )\t\n]+$" 0)
- ;; ACTIVE_ESCAPE src/dialog.cc 172
- (ctags "^\\([^ \t\n]+\\)[ \t]+\\(.*?\\)[ \t]+\\([0-9]+\\)$"
- 2 3 nil nil 2 (1 font-lock-function-name-face))
- ;; ACTIVE_ESCAPE 172 src/dialog.cc #undef ACTIVE_ESCAPE
- (ctags-x "^\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(\\(?:[^/\n]*/\\)?[^ \t\n]+\\)"
- 3 2 (,(lambda () (ggtags-global-column (1+ (match-end 0)))))
- nil 3 (1 font-lock-function-name-face))
- ;; src/dialog.cc:172:#undef ACTIVE_ESCAPE
- (grep "^\\(.+?\\):\\([0-9]+\\):\\(?:$\\|[^0-9\n]\\|[0-9][^0-9\n]\\|[0-9][0-9].\\)"
- 1 2 (,(lambda () (ggtags-global-column (1+ (match-end 2))))) nil 1)
- ;; src/dialog.cc ACTIVE_ESCAPE 172 #undef ACTIVE_ESCAPE
- (cscope "^\\(.+?\\)[ \t]+\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\).*\\(?:[^0-9\n]\\|[^0-9\n][0-9]\\|[^:\n][0-9][0-9]\\)$"
- 1 3 nil nil 1 (2 font-lock-function-name-face)))
- compilation-error-regexp-alist-alist))
-
-(defun ggtags-abbreviate-file (start end)
- (let ((inhibit-read-only t)
- (amount (if (numberp ggtags-global-abbreviate-filename)
- (- (- end start) ggtags-global-abbreviate-filename)
- 999))
- (advance-word (lambda ()
- "Return the length of the text made invisible."
- (let ((wend (min end (progn (forward-word 1) (point))))
- (wbeg (max start (progn (backward-word 1) (point)))))
- (goto-char wend)
- (if (<= (- wend wbeg) 1)
- 0
- (put-text-property (1+ wbeg) wend 'invisible t)
- (1- (- wend wbeg)))))))
- (goto-char start)
- (while (and (> amount 0) (> end (point)))
- (cl-decf amount (funcall advance-word)))))
-
-(defun ggtags-abbreviate-files (start end)
- (goto-char start)
- (let* ((error-re (cdr (assq (car compilation-error-regexp-alist)
- ggtags-global-error-regexp-alist-alist)))
- (sub (cadr error-re)))
- (when (and ggtags-global-abbreviate-filename error-re)
- (while (re-search-forward (car error-re) end t)
- (when (and (or (not (numberp ggtags-global-abbreviate-filename))
- (> (length (match-string sub))
- ggtags-global-abbreviate-filename))
- ;; Ignore bogus file lines such as:
- ;; Global found 2 matches at Thu Jan 31 13:45:19
- (get-text-property (match-beginning sub) 'compilation-message))
- (ggtags-abbreviate-file (match-beginning sub) (match-end sub)))))))
-
-(defvar-local ggtags-global-output-lines 0)
-
-(defun ggtags-global--display-buffer (&optional buffer desired-point)
- (pcase (let ((buffer (or buffer (current-buffer)))
- (split-window-preferred-function ggtags-split-window-function))
- (and (not (get-buffer-window buffer))
- (display-buffer buffer '(nil (allow-no-window . t)))))
- ((and (pred windowp) w)
- (with-selected-window w
- (compilation-set-window-height w)
- (and desired-point (goto-char desired-point))))))
-
-(defun ggtags-global-filter ()
- "Called from `compilation-filter-hook' (which see)."
- (let ((ansi-color-apply-face-function
- (lambda (beg end face)
- (when face
- (ansi-color-apply-overlay-face beg end face)
- (put-text-property beg end 'global-color t)))))
- (ansi-color-apply-on-region compilation-filter-start (point)))
- ;; Get rid of line "Using config file '/PATH/TO/.globalrc'." or
- ;; "Using default configuration."
- (when (re-search-backward
- "^ *Using \\(?:config file '.*\\|default configuration.\\)\n"
- compilation-filter-start t)
- (replace-match ""))
- (cl-incf ggtags-global-output-lines
- (count-lines compilation-filter-start (point)))
- ;; If the number of output lines is small
- ;; `ggtags-global-handle-exit' takes care of displaying the buffer.
- (when (and (> ggtags-global-output-lines 30) ggtags-navigation-mode)
- (ggtags-global--display-buffer nil (or compilation-current-error (point-min))))
- (when (and (eq ggtags-auto-jump-to-match 'history)
- (numberp ggtags-auto-jump-to-match-target)
- (not compilation-current-error)
- ;; `ggtags-global-output-lines' is imprecise but use it
- ;; as first approximation.
- (> (+ 10 ggtags-global-output-lines) ggtags-auto-jump-to-match-target)
- (> (line-number-at-pos (point-max))
- ggtags-auto-jump-to-match-target))
- (ggtags-forward-to-line ggtags-auto-jump-to-match-target)
- (setq-local ggtags-auto-jump-to-match-target nil)
- (ggtags-delay-finish-functions
- (with-display-buffer-no-window
- (condition-case nil
- (let ((compilation-auto-jump-to-first-error t))
- (compilation-auto-jump (current-buffer) (point)))
- (error (message "\
-ggtags: history match invalid, jump to first error instead")
- (first-error)))))
- ;; `compilation-filter' restores point and as a result commands
- ;; dependent on point such as `ggtags-navigation-next-file' and
- ;; `ggtags-navigation-previous-file' fail to work.
- (run-with-idle-timer
- 0 nil
- (lambda (buf pt)
- (and (buffer-live-p buf)
- (with-current-buffer buf (goto-char pt))))
- (current-buffer) (point)))
- (make-local-variable 'ggtags-global-large-output)
- (when (> ggtags-global-output-lines ggtags-global-large-output)
- (cl-incf ggtags-global-large-output 500)
- (ggtags-echo "Output %d lines (Type `C-c C-k' to cancel)"
- ggtags-global-output-lines)))
-
-(defun ggtags-global-handle-exit (buf how)
- "A function for `compilation-finish-functions' (which see)."
- (cond
- (ggtags-global-continuation
- (let ((cont (prog1 ggtags-global-continuation
- (setq ggtags-global-continuation nil))))
- (funcall cont buf how)))
- ((string-prefix-p "exited abnormally" how)
- ;; If exit abnormally display the buffer for inspection.
- (ggtags-global--display-buffer)
- (when (save-excursion
- (goto-char (point-max))
- (re-search-backward
- (eval-when-compile
- (format "^global: %s not found.$"
- (regexp-opt '("GTAGS" "GRTAGS" "GSYMS" "GPATH"))))
- nil t))
- (ggtags-echo "WARNING: Global tag files missing in `%s'"
- ggtags-project-root)
- (remhash ggtags-project-root ggtags-projects)))
- (ggtags-auto-jump-to-match
- (if (pcase (compilation-next-single-property-change
- (point-min) 'compilation-message)
- ((and pt (guard pt))
- (compilation-next-single-property-change
- (save-excursion (goto-char pt) (end-of-line) (point))
- 'compilation-message)))
- ;; There are multiple matches so pop up the buffer.
- (and ggtags-navigation-mode (ggtags-global--display-buffer))
- ;; For the `compilation-auto-jump' in idle timer to run.
- ;; See also: http://debbugs.gnu.org/13829
- (sit-for 0)
- (ggtags-navigation-mode -1)
- (ggtags-navigation-mode-cleanup buf 0)))))
-
-(defvar ggtags-global-mode-font-lock-keywords
- '(("^Global \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
- (1 'compilation-error)
- (2 'compilation-error nil t))
- ("^Global found \\([0-9]+\\)" (1 compilation-info-face))))
-
-(defvar compilation-always-kill) ;new in 24.3
-
-(define-compilation-mode ggtags-global-mode "Global"
- "A mode for showing outputs from gnu global."
- ;; Note: Place `ggtags-global-output-format' as first element for
- ;; `ggtags-abbreviate-files'.
- (setq-local compilation-error-regexp-alist (list ggtags-global-output-format))
- (when (markerp ggtags-global-start-marker)
- (setq ggtags-project-root
- (buffer-local-value 'ggtags-project-root
- (marker-buffer ggtags-global-start-marker))))
- (pcase ggtags-auto-jump-to-match
- (`history (make-local-variable 'ggtags-auto-jump-to-match-target)
- (setq-local compilation-auto-jump-to-first-error
- (not ggtags-auto-jump-to-match-target)))
- (`nil (setq-local compilation-auto-jump-to-first-error nil))
- (_ (setq-local compilation-auto-jump-to-first-error t)))
- (setq-local compilation-scroll-output nil)
- ;; See `compilation-move-to-column' for details.
- (setq-local compilation-first-column 0)
- (setq-local compilation-error-screen-columns nil)
- (setq-local compilation-disable-input t)
- (setq-local compilation-always-kill t)
- (setq-local compilation-error-face 'compilation-info)
- (setq-local compilation-exit-message-function
- 'ggtags-global-exit-message-function)
- ;; See: https://github.com/leoliu/ggtags/issues/26
- (setq-local find-file-suppress-same-file-warnings t)
- (setq-local truncate-lines t)
- (jit-lock-register #'ggtags-abbreviate-files)
- (add-hook 'compilation-filter-hook 'ggtags-global-filter nil 'local)
- (add-hook 'compilation-finish-functions 'ggtags-global-handle-exit nil t)
- (setq-local bookmark-make-record-function #'ggtags-make-bookmark-record)
- (setq-local ggtags-enable-navigation-keys nil)
- (add-hook 'kill-buffer-hook (lambda () (ggtags-navigation-mode -1)) nil t))
-
-;; NOTE: Need this to avoid putting menu items in
-;; `emulation-mode-map-alists', which creates double entries. See
-;; http://i.imgur.com/VJJTzVc.png
-(defvar ggtags-navigation-map
- (let ((map (make-sparse-keymap)))
- (define-key map "\M-n" 'next-error)
- (define-key map "\M-p" 'previous-error)
- (define-key map "\M-}" 'ggtags-navigation-next-file)
- (define-key map "\M-{" 'ggtags-navigation-previous-file)
- (define-key map "\M-=" 'ggtags-navigation-start-file)
- (define-key map "\M->" 'ggtags-navigation-last-error)
- (define-key map "\M-<" 'first-error)
- ;; Note: shadows `isearch-forward-regexp' but it can still be
- ;; invoked with `C-u C-s'.
- (define-key map "\C-\M-s" 'ggtags-navigation-isearch-forward)
- ;; Add an alternative binding because C-M-s is reported not
- ;; working on some systems.
- (define-key map "\M-ss" 'ggtags-navigation-isearch-forward)
- (define-key map "\C-c\C-k"
- (lambda () (interactive)
- (ggtags-ensure-global-buffer (kill-compilation))))
- (define-key map "\M-o" 'ggtags-navigation-visible-mode)
- (define-key map [return] 'ggtags-navigation-mode-done)
- (define-key map "\r" 'ggtags-navigation-mode-done)
- (define-key map [remap pop-tag-mark] 'ggtags-navigation-mode-abort)
- map))
-
-(defvar ggtags-mode-map-alist
- `((ggtags-enable-navigation-keys . ,ggtags-navigation-map)))
-
-(defvar ggtags-navigation-mode-map
- (let ((map (make-sparse-keymap))
- (menu (make-sparse-keymap "GG-Navigation")))
- ;; Menu items: (info "(elisp)Extended Menu Items")
- (define-key map [menu-bar ggtags-navigation] (cons "GG-Navigation" menu))
- ;; Ordered backwards
- (define-key menu [visible-mode]
- '(menu-item "Visible mode" ggtags-navigation-visible-mode
- :button (:toggle . (ignore-errors
- (ggtags-ensure-global-buffer
- visible-mode)))))
- (define-key menu [done]
- '(menu-item "Finish navigation" ggtags-navigation-mode-done))
- (define-key menu [abort]
- '(menu-item "Abort" ggtags-navigation-mode-abort))
- (define-key menu [last-match]
- '(menu-item "Last match" ggtags-navigation-last-error))
- (define-key menu [first-match] '(menu-item "First match" first-error))
- (define-key menu [previous-file]
- '(menu-item "Previous file" ggtags-navigation-previous-file))
- (define-key menu [next-file]
- '(menu-item "Next file" ggtags-navigation-next-file))
- (define-key menu [isearch-forward]
- '(menu-item "Find match with isearch" ggtags-navigation-isearch-forward))
- (define-key menu [previous]
- '(menu-item "Previous match" previous-error))
- (define-key menu [next]
- '(menu-item "Next match" next-error))
- map))
-
-(defun ggtags-move-to-tag (&optional name)
- "Move to NAME tag in current line."
- (let ((tag (or name ggtags-current-tag-name)))
- ;; Do nothing if on the tag already i.e. by `ggtags-global-column'.
- (unless (or (not tag) (looking-at (concat (regexp-quote tag) "\\_>")))
- (let ((orig (point))
- (regexps (mapcar (lambda (fmtstr)
- (format fmtstr (regexp-quote tag)))
- '("\\_<%s\\_>" "%s\\_>" "%s"))))
- (beginning-of-line)
- (if (cl-loop for re in regexps
- ;; Note: tag might not agree with current
- ;; major-mode's symbol, so try harder. For
- ;; example, in `php-mode' $cacheBackend is a
- ;; symbol, but cacheBackend is a tag.
- thereis (re-search-forward re (line-end-position) t))
- (goto-char (match-beginning 0))
- (goto-char orig))))))
-
-(defun ggtags-navigation-mode-cleanup (&optional buf time)
- (let ((buf (or buf ggtags-global-last-buffer)))
- (and (buffer-live-p buf)
- (with-current-buffer buf
- (when (get-buffer-process (current-buffer))
- (kill-compilation))
- (when (and (derived-mode-p 'ggtags-global-mode)
- (get-buffer-window))
- (quit-windows-on (current-buffer)))
- (and time (run-with-idle-timer time nil #'kill-buffer buf))))))
-
-(defun ggtags-navigation-mode-done ()
- (interactive)
- (ggtags-navigation-mode -1)
- (setq tags-loop-scan t
- tags-loop-operate '(ggtags-find-tag-continue))
- (ggtags-navigation-mode-cleanup))
-
-(defun ggtags-navigation-mode-abort ()
- "Abort navigation and return to where the search was started."
- (interactive)
- (ggtags-navigation-mode -1)
- (ggtags-navigation-mode-cleanup nil 0)
- ;; Run after (ggtags-navigation-mode -1) or
- ;; ggtags-global-start-marker might not have been saved.
- (when (and ggtags-global-start-marker
- (not (markerp ggtags-global-start-marker)))
- (setq ggtags-global-start-marker nil)
- (pop-tag-mark)))
-
-(defun ggtags-navigation-next-file (n)
- (interactive "p")
- (ggtags-ensure-global-buffer
- (compilation-next-file n)
- (compile-goto-error)))
-
-(defun ggtags-navigation-previous-file (n)
- (interactive "p")
- (ggtags-navigation-next-file (- n)))
-
-(defun ggtags-navigation-start-file ()
- "Move to the file where navigation session starts."
- (interactive)
- (let ((start-file (or ggtags-global-start-file
- (user-error "Cannot decide start file"))))
- (ggtags-ensure-global-buffer
- (pcase (cl-block nil
- (ggtags-foreach-file
- (lambda (file)
- (when (file-equal-p file start-file)
- (cl-return (point))))))
- (`nil (user-error "No matches for `%s'" start-file))
- (n (goto-char n) (compile-goto-error))))))
-
-(defun ggtags-navigation-last-error ()
- (interactive)
- (ggtags-ensure-global-buffer
- (goto-char (point-max))
- (compilation-previous-error 1)
- (compile-goto-error)))
-
-(defun ggtags-navigation-isearch-forward (&optional regexp-p)
- (interactive "P")
- (ggtags-ensure-global-buffer
- (let ((saved (if visible-mode 1 -1)))
- (visible-mode 1)
- (with-selected-window (get-buffer-window (current-buffer))
- (isearch-forward regexp-p)
- (beginning-of-line)
- (visible-mode saved)
- (compile-goto-error)))))
-
-(defun ggtags-navigation-visible-mode (&optional arg)
- (interactive (list (or current-prefix-arg 'toggle)))
- (ggtags-ensure-global-buffer
- (visible-mode arg)))
-
-(defvar ggtags-global-line-overlay nil)
-
-(defun ggtags-global-next-error-function ()
- (when (eq next-error-last-buffer ggtags-global-last-buffer)
- (ggtags-move-to-tag)
- (ggtags-global-save-start-marker)
- (and (ggtags-project-update-mtime-maybe)
- (message "File `%s' is newer than GTAGS"
- (file-name-nondirectory buffer-file-name)))
- (and ggtags-mode-sticky (ggtags-mode 1))
- (ignore-errors
- (ggtags-ensure-global-buffer
- (unless (overlayp ggtags-global-line-overlay)
- (setq ggtags-global-line-overlay (make-overlay (point) (point)))
- (overlay-put ggtags-global-line-overlay 'face 'ggtags-global-line))
- (move-overlay ggtags-global-line-overlay
- (line-beginning-position) (line-end-position)
- (current-buffer))
- ;; Update search history
- (let ((id (ggtags-global-search-id (car compilation-arguments)
- default-directory)))
- (setq ggtags-global-search-history
- (cl-remove id ggtags-global-search-history :test #'equal :key #'car))
- (add-to-history 'ggtags-global-search-history
- (cons id (ggtags-global-current-search))
- ggtags-global-history-length))))
- (run-hooks 'ggtags-find-tag-hook)))
-
-(put 'ggtags-navigation-mode-lighter 'risky-local-variable t)
-
-(defvar ggtags-navigation-mode-lighter
- '(" GG["
- (:eval
- (if (not (buffer-live-p ggtags-global-last-buffer))
- '(:propertize "??" face error help-echo "No Global buffer")
- (with-current-buffer ggtags-global-last-buffer
- (pcase (or ggtags-global-exit-info '(0 0 ""))
- (`(,exit ,count ,db)
- `((:propertize ,(pcase db
- (`"GTAGS" "D")
- (`"GRTAGS" "R")
- (`"GSYMS" "S")
- (`"GPATH" "F")
- (`"ID" "I"))
- face success)
- (:propertize
- ,(pcase (get-text-property (line-beginning-position)
- 'compilation-message)
- (`nil "?")
- ;; Assume the first match appears at line 5
- (_ (number-to-string (- (line-number-at-pos) 4))))
- face success)
- "/"
- (:propertize ,(number-to-string count) face success)
- ,(unless (zerop exit)
- `(":" (:propertize ,(number-to-string exit) face error)))))))))
- "]")
- "Ligher for `ggtags-navigation-mode'; set to nil to disable it.")
-
-(define-minor-mode ggtags-navigation-mode nil
- :lighter ggtags-navigation-mode-lighter
- :global t
- (if ggtags-navigation-mode
- (progn
- ;; Higher priority for `ggtags-navigation-mode' to avoid being
- ;; hijacked by modes such as `view-mode'.
- (add-to-list 'emulation-mode-map-alists 'ggtags-mode-map-alist)
- (add-hook 'next-error-hook 'ggtags-global-next-error-function)
- (add-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function))
- (setq emulation-mode-map-alists
- (delq 'ggtags-mode-map-alist emulation-mode-map-alists))
- (remove-hook 'next-error-hook 'ggtags-global-next-error-function)
- (remove-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function)))
-
-(defun ggtags-minibuffer-setup-function ()
- ;; Disable ggtags-navigation-mode in minibuffer.
- (setq-local ggtags-enable-navigation-keys nil))
-
-(defun ggtags-kill-file-buffers (&optional interactive)
- "Kill all buffers visiting files in current project."
- (interactive "p")
- (ggtags-check-project)
- (let ((directories (cons (ggtags-current-project-root) (ggtags-get-libpath)))
- (count 0))
- (dolist (buf (buffer-list))
- (let ((file (and (buffer-live-p buf)
- (not (eq buf (current-buffer)))
- (buffer-file-name buf))))
- (when (and file (cl-some (lambda (dir)
- ;; Don't use `file-in-directory-p'
- ;; to allow symbolic links.
- (string-prefix-p dir file))
- directories))
- (and (kill-buffer buf) (cl-incf count)))))
- (and interactive
- (message "%d %s killed" count (if (= count 1) "buffer" "buffers")))))
-
-(defun ggtags-after-save-function ()
- (when (ggtags-find-project)
- (ggtags-project-update-mtime-maybe)
- (and buffer-file-name ggtags-update-on-save
- (ggtags-update-tags-single buffer-file-name 'nowait))))
-
-(defun ggtags-global-output (buffer cmds callback &optional cutoff)
- "Asynchronously pipe the output of running CMDS to BUFFER.
-When finished invoke CALLBACK in BUFFER with process exit status."
- (or buffer (error "Output buffer required"))
- (when (get-buffer-process (get-buffer buffer))
- ;; Notice running multiple processes in the same buffer so that we
- ;; can fix the caller. See for example `ggtags-eldoc-function'.
- (message "Warning: detected %S already running in %S; interrupting..."
- (get-buffer-process buffer) buffer)
- (interrupt-process (get-buffer-process buffer)))
- (let* ((program (car cmds))
- (args (cdr cmds))
- (cutoff (and cutoff (+ cutoff (if (get-buffer buffer)
- (with-current-buffer buffer
- (line-number-at-pos (point-max)))
- 0))))
- (proc (apply #'start-file-process program buffer program args))
- (filter (lambda (proc string)
- (and (buffer-live-p (process-buffer proc))
- (with-current-buffer (process-buffer proc)
- (goto-char (process-mark proc))
- (insert string)
- (when (and (> (line-number-at-pos (point-max)) cutoff)
- (process-live-p proc))
- (interrupt-process (current-buffer)))))))
- (sentinel (lambda (proc _msg)
- (when (memq (process-status proc) '(exit signal))
- (with-current-buffer (process-buffer proc)
- (set-process-buffer proc nil)
- (funcall callback (process-exit-status proc)))))))
- (set-process-query-on-exit-flag proc nil)
- (and cutoff (set-process-filter proc filter))
- (set-process-sentinel proc sentinel)
- proc))
-
-(cl-defun ggtags-fontify-code (code &optional (mode major-mode))
- (cl-check-type mode function)
- (cl-typecase code
- ((not string) code)
- (string (cl-labels ((prepare-buffer ()
- (with-current-buffer
- (get-buffer-create " *Code-Fontify*")
- (delay-mode-hooks (funcall mode))
- (setq font-lock-mode t)
- (funcall font-lock-function font-lock-mode)
- (setq jit-lock-mode nil)
- (current-buffer))))
- (with-current-buffer (prepare-buffer)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert code)
- (font-lock-default-fontify-region
- (point-min) (point-max) nil))
- (buffer-string))))))
-
-(defun ggtags-get-definition-default (defs)
- (and (caar defs)
- (concat (ggtags-fontify-code (caar defs))
- (and (cdr defs) " [guess]"))))
-
-(defun ggtags-show-definition (name)
- (interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
- (ggtags-check-project)
- (let* ((re (cadr (assq 'grep ggtags-global-error-regexp-alist-alist)))
- (current (current-buffer))
- (buffer (get-buffer-create " *ggtags-definition*"))
- ;; Need these bindings so that let-binding
- ;; `ggtags-print-definition-function' can work see
- ;; `ggtags-eldoc-function'.
- (get-fn ggtags-get-definition-function)
- (print-fn ggtags-print-definition-function)
- (show (lambda (_status)
- (goto-char (point-min))
- (let ((defs (cl-loop while (re-search-forward re nil t)
- collect (list (buffer-substring (1+ (match-end 2))
- (line-end-position))
- name
- (match-string 1)
- (string-to-number (match-string 2))))))
- (kill-buffer buffer)
- (with-current-buffer current
- (funcall print-fn (funcall get-fn defs)))))))
- (ggtags-with-current-project
- (ggtags-global-output
- buffer
- (list (ggtags-program-path "global")
- "--result=grep" "--path-style=absolute" name)
- show 100))))
-
-(defvar ggtags-mode-prefix-map
- (let ((m (make-sparse-keymap)))
- ;; Globally bound to `M-g p'.
- ;; (define-key m "\M-'" 'previous-error)
- (define-key m (kbd "M-DEL") 'ggtags-delete-tags)
- (define-key m "\M-p" 'ggtags-prev-mark)
- (define-key m "\M-n" 'ggtags-next-mark)
- (define-key m "\M-f" 'ggtags-find-file)
- (define-key m "\M-o" 'ggtags-find-other-symbol)
- (define-key m "\M-g" 'ggtags-grep)
- (define-key m "\M-i" 'ggtags-idutils-query)
- (define-key m "\M-b" 'ggtags-browse-file-as-hypertext)
- (define-key m "\M-k" 'ggtags-kill-file-buffers)
- (define-key m "\M-h" 'ggtags-view-tag-history)
- (define-key m "\M-j" 'ggtags-visit-project-root)
- (define-key m "\M-/" 'ggtags-view-search-history)
- (define-key m (kbd "M-SPC") 'ggtags-save-to-register)
- (define-key m (kbd "M-%") 'ggtags-query-replace)
- (define-key m "\M-?" 'ggtags-show-definition)
- m))
-
-(defvar ggtags-mode-map
- (let ((map (make-sparse-keymap))
- (menu (make-sparse-keymap "Ggtags")))
- (define-key map "\M-." 'ggtags-find-tag-dwim)
- (define-key map (kbd "M-]") 'ggtags-find-reference)
- (define-key map (kbd "C-M-.") 'ggtags-find-tag-regexp)
- (define-key map ggtags-mode-prefix-key ggtags-mode-prefix-map)
- ;; Menu items
- (define-key map [menu-bar ggtags] (cons "Ggtags" menu))
- ;; Ordered backwards
- (define-key menu [report-bugs]
- `(menu-item "Report bugs"
- (lambda () (interactive)
- (browse-url ggtags-bug-url)
- (message "Please visit %s" ggtags-bug-url))
- :help ,(format "Visit %s" ggtags-bug-url)))
- (define-key menu [custom-ggtags]
- '(menu-item "Customize Ggtags"
- (lambda () (interactive) (customize-group 'ggtags))))
- (define-key menu [eldoc-mode]
- '(menu-item "Toggle eldoc mode" eldoc-mode :button (:toggle . eldoc-mode)))
- (define-key menu [save-project]
- '(menu-item "Save project settings" ggtags-save-project-settings))
- (define-key menu [toggle-read-only]
- '(menu-item "Toggle project read-only" ggtags-toggle-project-read-only
- :button (:toggle . buffer-read-only)))
- (define-key menu [visit-project-root]
- '(menu-item "Visit project root" ggtags-visit-project-root))
- (define-key menu [sep2] menu-bar-separator)
- (define-key menu [browse-hypertext]
- '(menu-item "Browse as hypertext" ggtags-browse-file-as-hypertext
- :enable (ggtags-find-project)))
- (define-key menu [delete-tags]
- '(menu-item "Delete tags" ggtags-delete-tags
- :enable (ggtags-find-project)
- :help "Delete file GTAGS, GRTAGS, GPATH, ID etc."))
- (define-key menu [kill-buffers]
- '(menu-item "Kill project file buffers" ggtags-kill-file-buffers
- :enable (ggtags-find-project)))
- (define-key menu [view-tag]
- '(menu-item "View tag history" ggtags-view-tag-history))
- (define-key menu [pop-mark]
- '(menu-item "Pop mark" pop-tag-mark
- :help "Pop to previous mark and destroy it"))
- (define-key menu [next-mark]
- '(menu-item "Next mark" ggtags-next-mark))
- (define-key menu [prev-mark]
- '(menu-item "Previous mark" ggtags-prev-mark))
- (define-key menu [sep1] menu-bar-separator)
- (define-key menu [previous-error]
- '(menu-item "Previous match" previous-error))
- (define-key menu [next-error]
- '(menu-item "Next match" next-error))
- (define-key menu [rerun-search]
- '(menu-item "View past searches" ggtags-view-search-history))
- (define-key menu [save-to-register]
- '(menu-item "Save search to register" ggtags-save-to-register))
- (define-key menu [find-file]
- '(menu-item "Find files" ggtags-find-file))
- (define-key menu [query-replace]
- '(menu-item "Query replace" ggtags-query-replace))
- (define-key menu [idutils]
- '(menu-item "Query idutils DB" ggtags-idutils-query))
- (define-key menu [grep]
- '(menu-item "Grep" ggtags-grep))
- (define-key menu [find-symbol]
- '(menu-item "Find other symbol" ggtags-find-other-symbol
- :help "Find references without definition"))
- (define-key menu [find-tag-regexp]
- '(menu-item "Find tag matching regexp" ggtags-find-tag-regexp))
- (define-key menu [show-definition]
- '(menu-item "Show definition" ggtags-show-definition))
- (define-key menu [find-reference]
- '(menu-item "Find reference" ggtags-find-reference))
- (define-key menu [find-tag-continue]
- '(menu-item "Continue find tag" tags-loop-continue))
- (define-key menu [find-tag]
- '(menu-item "Find tag" ggtags-find-tag-dwim))
- (define-key menu [update-tags]
- '(menu-item "Update tag files" ggtags-update-tags
- :visible (ggtags-find-project)))
- (define-key menu [run-gtags]
- '(menu-item "Run gtags" ggtags-create-tags
- :visible (not (ggtags-find-project))))
- map))
-
-(defvar ggtags-mode-line-project-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [mode-line mouse-1] 'ggtags-visit-project-root)
- map))
-
-(put 'ggtags-mode-line-project-name 'risky-local-variable t)
-(defvar ggtags-mode-line-project-name
- '("[" (:eval (let ((name (if (stringp ggtags-project-root)
- (file-name-nondirectory
- (directory-file-name ggtags-project-root))
- "?")))
- (propertize
- name 'face compilation-info-face
- 'help-echo (if (stringp ggtags-project-root)
- (concat "mouse-1 to visit " ggtags-project-root)
- "mouse-1 to set project")
- 'mouse-face 'mode-line-highlight
- 'keymap ggtags-mode-line-project-keymap)))
- "]")
- "Mode line construct for displaying current project name.
-The value is the name of the project root directory. Setting it
-to nil disables displaying this information.")
-
-;;;###autoload
-(define-minor-mode ggtags-mode nil
- :lighter (:eval (if ggtags-navigation-mode "" " GG"))
- (unless (timerp ggtags-highlight-tag-timer)
- (setq ggtags-highlight-tag-timer
- (run-with-idle-timer
- ggtags-highlight-tag-delay t #'ggtags-highlight-tag-at-point)))
- (if ggtags-mode
- (progn
- (add-hook 'after-save-hook 'ggtags-after-save-function nil t)
- ;; Append to serve as a fallback method.
- (add-hook 'completion-at-point-functions
- #'ggtags-completion-at-point t t)
- ;; Work around http://debbugs.gnu.org/19324
- (or eldoc-documentation-function
- (setq-local eldoc-documentation-function #'ignore))
- (add-function :after-until (local 'eldoc-documentation-function)
- #'ggtags-eldoc-function '((name . ggtags-eldoc-function)
- (depth . -100)))
- (unless (memq 'ggtags-mode-line-project-name
- mode-line-buffer-identification)
- (setq mode-line-buffer-identification
- (append mode-line-buffer-identification
- '(ggtags-mode-line-project-name)))))
- (remove-hook 'after-save-hook 'ggtags-after-save-function t)
- (remove-hook 'completion-at-point-functions #'ggtags-completion-at-point t)
- (remove-function (local 'eldoc-documentation-function) 'ggtags-eldoc-function)
- (setq mode-line-buffer-identification
- (delq 'ggtags-mode-line-project-name mode-line-buffer-identification))
- (and (overlayp ggtags-highlight-tag-overlay)
- (delete-overlay ggtags-highlight-tag-overlay))
- (setq ggtags-highlight-tag-overlay nil)))
-
-(defvar ggtags-highlight-tag-map
- (let ((map (make-sparse-keymap)))
- ;; Bind down- events so that the global keymap won't ``shine
- ;; through''. See `mode-line-buffer-identification-keymap' for
- ;; similar workaround.
- (define-key map [S-mouse-1] 'ggtags-find-tag-dwim)
- (define-key map [S-down-mouse-1] 'ignore)
- (define-key map [S-mouse-3] 'ggtags-find-reference)
- (define-key map [S-down-mouse-3] 'ignore)
- map)
- "Keymap used for valid tag at point.")
-
-(put 'ggtags-active-tag 'face 'ggtags-highlight)
-(put 'ggtags-active-tag 'keymap ggtags-highlight-tag-map)
-;; (put 'ggtags-active-tag 'mouse-face 'match)
-(put 'ggtags-active-tag 'help-echo
- "S-mouse-1 for definitions\nS-mouse-3 for references")
-
-(defun ggtags-highlight-tag-at-point ()
- (when (and ggtags-mode ggtags-project-root (ggtags-find-project))
- (unless (overlayp ggtags-highlight-tag-overlay)
- (setq ggtags-highlight-tag-overlay (make-overlay (point) (point) nil t))
- (overlay-put ggtags-highlight-tag-overlay 'modification-hooks
- (list (lambda (o after &rest _args)
- (and (not after) (delete-overlay o))))))
- (let ((bounds (funcall ggtags-bounds-of-tag-function))
- (o ggtags-highlight-tag-overlay))
- (cond
- ((and bounds
- (eq (overlay-buffer o) (current-buffer))
- (= (overlay-start o) (car bounds))
- (= (overlay-end o) (cdr bounds)))
- ;; Overlay matches current tag so do nothing.
- nil)
- ((and bounds (let ((completion-ignore-case nil))
- (test-completion
- (buffer-substring (car bounds) (cdr bounds))
- ggtags-completion-table)))
- (move-overlay o (car bounds) (cdr bounds) (current-buffer))
- (overlay-put o 'category 'ggtags-active-tag))
- (t (move-overlay o
- (or (car bounds) (point))
- (or (cdr bounds) (point))
- (current-buffer))
- (overlay-put o 'category nil))))))
-
-;;; eldoc
-
-(defvar-local ggtags-eldoc-cache nil)
-
-(declare-function eldoc-message "eldoc")
-(defun ggtags-eldoc-function ()
- "A function suitable for `eldoc-documentation-function' (which see)."
- (pcase (ggtags-tag-at-point)
- (`nil nil)
- (tag (if (equal tag (car ggtags-eldoc-cache))
- (cadr ggtags-eldoc-cache)
- (and ggtags-project-root (ggtags-find-project)
- (let* ((ggtags-print-definition-function
- (lambda (s)
- (setq ggtags-eldoc-cache (list tag s))
- (eldoc-message s))))
- ;; Prevent multiple runs of ggtags-show-definition
- ;; for the same tag.
- (setq ggtags-eldoc-cache (list tag))
- (condition-case err
- (ggtags-show-definition tag)
- (file-error
- (remove-function (local 'eldoc-documentation-function)
- 'ggtags-eldoc-function)
- (message "\
-Function `ggtags-eldoc-function' disabled for eldoc in current buffer: %S" err)))
- nil))))))
-
-;;; imenu
-
-(defun ggtags-goto-imenu-index (name line &rest _args)
- (ggtags-forward-to-line line)
- (ggtags-move-to-tag name))
-
-;;;###autoload
-(defun ggtags-build-imenu-index ()
- "A function suitable for `imenu-create-index-function'."
- (let ((file (and buffer-file-name (file-relative-name buffer-file-name))))
- (and file (with-temp-buffer
- (when (with-demoted-errors "ggtags-build-imenu-index: %S"
- (zerop (ggtags-with-current-project
- (process-file (ggtags-program-path "global")
- nil t nil "-x" "-f" file))))
- (goto-char (point-min))
- (cl-loop while (re-search-forward
- "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)" nil t)
- collect (list (match-string 1)
- (string-to-number (match-string 2))
- 'ggtags-goto-imenu-index)))))))
-
-;;; hippie-expand
-
-;;;###autoload
-(defun ggtags-try-complete-tag (old)
- "A function suitable for `hippie-expand-try-functions-list'."
- (eval-and-compile (require 'hippie-exp))
- (unless old
- (he-init-string (or (car (funcall ggtags-bounds-of-tag-function)) (point))
- (point))
- (setq he-expand-list
- (and (not (equal he-search-string ""))
- (ggtags-find-project)
- (sort (all-completions he-search-string
- ggtags-completion-table)
- #'string-lessp))))
- (if (null he-expand-list)
- (progn
- (if old (he-reset-string))
- nil)
- (he-substitute-string (car he-expand-list))
- (setq he-expand-list (cdr he-expand-list))
- t))
-
-(defun ggtags-reload (&optional force)
- (interactive "P")
- (unload-feature 'ggtags force)
- (require 'ggtags))
-
-(provide 'ggtags)
-;;; ggtags.el ends here
--- /dev/null
+;;; ggtags-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
+\f
+;;;### (autoloads nil "ggtags" "ggtags.el" (22215 7674 0 0))
+;;; Generated autoloads from ggtags.el
+
+(autoload 'ggtags-find-project "ggtags" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'ggtags-find-tag-dwim "ggtags" "\
+Find NAME by context.
+If point is at a definition tag, find references, and vice versa.
+If point is at a line that matches `ggtags-include-pattern', find
+the include file instead.
+
+When called interactively with a prefix arg, always find
+definition tags.
+
+\(fn NAME &optional WHAT)" t nil)
+
+(autoload 'ggtags-mode "ggtags" "\
+Toggle Ggtags mode on or off.
+With a prefix argument ARG, enable Ggtags mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
+\\{ggtags-mode-map}
+
+\(fn &optional ARG)" t nil)
+
+(autoload 'ggtags-build-imenu-index "ggtags" "\
+A function suitable for `imenu-create-index-function'.
+
+\(fn)" nil nil)
+
+(autoload 'ggtags-try-complete-tag "ggtags" "\
+A function suitable for `hippie-expand-try-functions-list'.
+
+\(fn OLD)" nil nil)
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; ggtags-autoloads.el ends here
--- /dev/null
+(define-package "ggtags" "20151214.1344" "emacs frontend to GNU Global source code tagging system" '((emacs "24") (cl-lib "0.5")) :url "https://github.com/leoliu/ggtags" :keywords '("tools" "convenience"))
--- /dev/null
+;;; ggtags.el --- emacs frontend to GNU Global source code tagging system -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2013-2015 Free Software Foundation, Inc.
+
+;; Author: Leo Liu <sdl.webNOSPAMgmail.com>
+;; Version: 0.8.11
+;; Package-Version: 20151214.1344
+;; Keywords: tools, convenience
+;; Created: 2013-01-29
+;; URL: https://github.com/leoliu/ggtags
+;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; A package to integrate GNU Global source code tagging system
+;; (http://www.gnu.org/software/global) with Emacs.
+;;
+;; Usage:
+;;
+;; `ggtags' is similar to the standard `etags' package. These keys
+;; `M-.', `M-,', `M-*' and `C-M-.' should work as expected in
+;; `ggtags-mode'. See the README in https://github.com/leoliu/ggtags
+;; for more details.
+;;
+;; All commands are available from the `Ggtags' menu in `ggtags-mode'.
+
+;;; NEWS 0.8.11 (2015-12-15):
+
+;; - `ggtags-highlight-tag-delay' is renamed to `ggtags-highlight-tag'
+;; - Tag highlighting can be disabled by setting
+;; `ggtags-highlight-tag' to nil.
+;;
+;; See full NEWS on https://github.com/leoliu/ggtags#news
+
+;;; Code:
+
+(eval-when-compile
+ (require 'url-parse))
+
+(require 'cl-lib)
+(require 'ewoc)
+(require 'compile)
+(require 'etags)
+(require 'tabulated-list) ;preloaded since 24.3
+
+(eval-when-compile
+ (unless (fboundp 'setq-local)
+ (defmacro setq-local (var val)
+ (list 'set (list 'make-local-variable (list 'quote var)) val)))
+
+ (unless (fboundp 'defvar-local)
+ (defmacro defvar-local (var val &optional docstring)
+ (declare (debug defvar) (doc-string 3))
+ (list 'progn (list 'defvar var val docstring)
+ (list 'make-variable-buffer-local (list 'quote var)))))
+
+ (or (fboundp 'add-function) (defmacro add-function (&rest _))) ;24.4
+ (or (fboundp 'remove-function) (defmacro remove-function (&rest _)))
+
+ (defmacro ignore-errors-unless-debug (&rest body)
+ "Ignore all errors while executing BODY unless debug is on."
+ (declare (debug t) (indent 0))
+ `(condition-case-unless-debug nil (progn ,@body) (error nil)))
+
+ (defmacro with-display-buffer-no-window (&rest body)
+ (declare (debug t) (indent 0))
+ ;; See http://debbugs.gnu.org/13594
+ `(let ((display-buffer-overriding-action
+ (if (and ggtags-auto-jump-to-match
+ ;; Appeared in emacs 24.4.
+ (fboundp 'display-buffer-no-window))
+ (list #'display-buffer-no-window)
+ display-buffer-overriding-action)))
+ ,@body)))
+
+(eval-and-compile
+ (or (fboundp 'user-error) ;24.3
+ (defalias 'user-error 'error))
+ (or (fboundp 'read-only-mode) ;24.3
+ (defalias 'read-only-mode 'toggle-read-only))
+ (or (fboundp 'register-read-with-preview) ;24.4
+ (defalias 'register-read-with-preview 'read-char)))
+
+(defgroup ggtags nil
+ "GNU Global source code tagging system."
+ :group 'tools)
+
+(defface ggtags-highlight '((t (:underline t)))
+ "Face used to highlight a valid tag at point."
+ :group 'ggtags)
+
+(defface ggtags-global-line '((t (:inherit secondary-selection)))
+ "Face used to highlight matched line in Global buffer."
+ :group 'ggtags)
+
+(defcustom ggtags-executable-directory nil
+ "If non-nil the directory to search global executables."
+ :type '(choice (const :tag "Unset" nil) directory)
+ :risky t
+ :group 'ggtags)
+
+(defcustom ggtags-oversize-limit (* 10 1024 1024)
+ "The over size limit for the GTAGS file.
+When the size of the GTAGS file is below this limit, ggtags
+always maintains up-to-date tags for the whole source tree by
+running `global -u'. For projects with GTAGS larger than this
+limit, only files edited in Ggtags mode are updated (via `global
+--single-update')."
+ :safe 'numberp
+ :type '(choice (const :tag "None" nil)
+ (const :tag "Always" t)
+ number)
+ :group 'ggtags)
+
+(defcustom ggtags-include-pattern
+ '("^\\s-*#\\s-*\\(?:include\\|import\\)\\s-*[\"<]\\(?:[./]*\\)?\\(.*?\\)[\">]" . 1)
+ "Pattern used to detect #include files.
+Value can be (REGEXP . SUB) or a function with no arguments.
+REGEXP should match from the beginning of line."
+ :type '(choice (const :tag "Disable" nil)
+ (cons regexp integer)
+ function)
+ :safe 'stringp
+ :group 'ggtags)
+
+;; See also: http://article.gmane.org/gmane.comp.gnu.global.bugs/1751
+(defcustom ggtags-use-project-gtagsconf t
+ "Non-nil to use GTAGSCONF file found at project root.
+File .globalrc and gtags.conf are checked in order.
+
+Note: GNU Global v6.2.13 has the feature of using gtags.conf at
+project root. Setting this variable to nil doesn't disable this
+feature."
+ :safe 'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
+(defcustom ggtags-project-duration 600
+ "Seconds to keep information of a project in memory."
+ :type 'number
+ :group 'ggtags)
+
+(defcustom ggtags-process-environment nil
+ "Similar to `process-environment' with higher precedence.
+Elements are run through `substitute-env-vars' before use.
+GTAGSROOT will always be expanded to current project root
+directory. This is intended for project-wise ggtags-specific
+process environment settings. Note on remote hosts (e.g. tramp)
+directory local variables is not enabled by default per
+`enable-remote-dir-locals' (which see)."
+ :safe 'ggtags-list-of-string-p
+ :type '(repeat string)
+ :group 'ggtags)
+
+(defcustom ggtags-auto-jump-to-match 'history
+ "Strategy on how to jump to match: nil, first or history.
+
+ nil: never automatically jump to any match;
+ first: jump to the first match;
+history: jump to the match stored in search history."
+ :type '(choice (const :tag "First match" first)
+ (const :tag "Search History" history)
+ (const :tag "Never" nil))
+ :group 'ggtags)
+
+(defcustom ggtags-global-window-height 8 ; ggtags-global-mode
+ "Number of lines for the *ggtags-global* popup window.
+If nil, use Emacs default."
+ :type '(choice (const :tag "Default" nil) integer)
+ :group 'ggtags)
+
+(defcustom ggtags-global-abbreviate-filename 40
+ "Non-nil to display file names abbreviated e.g. \"/u/b/env\".
+If an integer abbreviate only names longer than that number."
+ :type '(choice (const :tag "No" nil)
+ (const :tag "Always" t)
+ integer)
+ :group 'ggtags)
+
+(defcustom ggtags-split-window-function split-window-preferred-function
+ "A function to control how ggtags pops up the auxiliary window."
+ :type 'function
+ :group 'ggtags)
+
+(defcustom ggtags-use-idutils (and (executable-find "mkid") t)
+ "Non-nil to also generate the idutils DB."
+ :type 'boolean
+ :group 'ggtags)
+
+(defcustom ggtags-use-sqlite3 nil
+ "Use sqlite3 for storage instead of Berkeley DB.
+This feature requires GNU Global 6.3.3+ and is ignored if `gtags'
+isn't built with sqlite3 support."
+ :type 'boolean
+ :safe 'booleanp
+ :group 'ggtags)
+
+(defcustom ggtags-sort-by-nearness nil
+ "Sort tags by nearness to current directory.
+GNU Global 6.5+ required."
+ :type 'boolean
+ :safe #'booleanp
+ :group 'ggtags)
+
+(defcustom ggtags-update-on-save t
+ "Non-nil to update tags for current buffer on saving."
+ ;; It is reported that `global --single-update' can be slow in sshfs
+ ;; directories. See https://github.com/leoliu/ggtags/issues/85.
+ :safe #'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
+(defcustom ggtags-global-output-format 'grep
+ "Global output format: path, ctags, ctags-x, grep or cscope."
+ :type '(choice (const path)
+ (const ctags)
+ (const ctags-x)
+ (const grep)
+ (const cscope))
+ :group 'ggtags)
+
+(defcustom ggtags-global-use-color t
+ "Non-nil to use color in output if supported by Global.
+Note: processing colored output takes noticeable time
+particularly when the output is large."
+ :type 'boolean
+ :safe 'booleanp
+ :group 'ggtags)
+
+(defcustom ggtags-global-ignore-case nil
+ "Non-nil if Global should ignore case in the search pattern."
+ :safe 'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
+(defcustom ggtags-global-treat-text nil
+ "Non-nil if Global should include matches from text files.
+This affects `ggtags-find-file' and `ggtags-grep'."
+ :safe 'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
+;; See also https://github.com/leoliu/ggtags/issues/52
+(defcustom ggtags-global-search-libpath-for-reference t
+ "If non-nil global will search GTAGSLIBPATH for references.
+Search is only continued in GTAGSLIBPATH if it finds no matches
+in current project."
+ :safe 'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
+(defcustom ggtags-global-large-output 1000
+ "Number of lines in the Global buffer to indicate large output."
+ :type 'number
+ :group 'ggtags)
+
+(defcustom ggtags-global-history-length history-length
+ "Maximum number of items to keep in `ggtags-global-search-history'."
+ :type 'integer
+ :group 'ggtags)
+
+(defcustom ggtags-enable-navigation-keys t
+ "If non-nil key bindings in `ggtags-navigation-map' are enabled."
+ :safe 'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
+(defcustom ggtags-find-tag-hook nil
+ "Hook run immediately after finding a tag."
+ :options '(recenter reposition-window)
+ :type 'hook
+ :group 'ggtags)
+
+(defcustom ggtags-get-definition-function #'ggtags-get-definition-default
+ "Function called by `ggtags-show-definition' to get definition.
+It is passed a list of definition candidates of the form:
+
+ (TEXT NAME FILE LINE)
+
+where TEXT is usually the source line of the definition.
+
+The return value is passed to `ggtags-print-definition-function'."
+ :type 'function
+ :group 'ggtags)
+
+(defcustom ggtags-print-definition-function
+ (lambda (s) (ggtags-echo "%s" (or s "[definition not found]")))
+ "Function used by `ggtags-show-definition' to print definition."
+ :type 'function
+ :group 'ggtags)
+
+(defcustom ggtags-mode-sticky t
+ "If non-nil enable Ggtags Mode in files visited."
+ :safe 'booleanp
+ :type 'boolean
+ :group 'ggtags)
+
+(defcustom ggtags-mode-prefix-key "\C-c"
+ "Key binding used for `ggtags-mode-prefix-map'.
+Users should change the value using `customize-variable' to
+properly update `ggtags-mode-map'."
+ :set (lambda (sym value)
+ (when (bound-and-true-p ggtags-mode-map)
+ (let ((old (and (boundp sym) (symbol-value sym))))
+ (and old (define-key ggtags-mode-map old nil)))
+ (and value
+ (bound-and-true-p ggtags-mode-prefix-map)
+ (define-key ggtags-mode-map value ggtags-mode-prefix-map)))
+ (set-default sym value))
+ :type 'key-sequence
+ :group 'ggtags)
+
+(defcustom ggtags-completing-read-function nil
+ "Ggtags specific `completing-read-function' (which see).
+Nil means using the value of `completing-read-function'."
+ :type '(choice (const :tag "Use completing-read-function" nil)
+ function)
+ :group 'ggtags)
+
+(define-obsolete-variable-alias 'ggtags-highlight-tag-delay 'ggtags-highlight-tag
+ "0.8.11")
+
+(defcustom ggtags-highlight-tag 0.25
+ "If non-nil time in seconds before highlighting tag at point.
+Set to `nil' to disable tag highlighting."
+ :set (lambda (sym value)
+ (when (fboundp 'ggtags-setup-highlight-tag-at-point)
+ (ggtags-setup-highlight-tag-at-point value))
+ (set-default sym value))
+ :type '(choice (const :tag "Disable" nil) number)
+ :group 'ggtags)
+
+(defcustom ggtags-bounds-of-tag-function (lambda ()
+ (bounds-of-thing-at-point 'symbol))
+ "Function to get the start and end positions of the tag at point."
+ :type 'function
+ :group 'ggtags)
+
+;; Used by ggtags-global-mode
+(defvar ggtags-global-error "match"
+ "Stem of message to print when no matches are found.")
+
+(defconst ggtags-bug-url "https://github.com/leoliu/ggtags/issues")
+
+(defvar ggtags-global-last-buffer nil)
+
+(defvar ggtags-global-continuation nil)
+
+(defvar ggtags-current-tag-name nil)
+
+(defvar ggtags-highlight-tag-overlay nil)
+
+(defvar ggtags-highlight-tag-timer nil)
+
+(defmacro ggtags-with-temp-message (message &rest body)
+ (declare (debug t) (indent 1))
+ (let ((init-time (make-symbol "-init-time-"))
+ (tmp-msg (make-symbol "-tmp-msg-")))
+ `(let ((,init-time (float-time))
+ (,tmp-msg ,message))
+ (with-temp-message ,tmp-msg
+ (prog1 (progn ,@body)
+ (message "%sdone (%.2fs)" ,(or tmp-msg "")
+ (- (float-time) ,init-time)))))))
+
+(defmacro ggtags-delay-finish-functions (&rest body)
+ "Delay running `compilation-finish-functions' until after BODY."
+ (declare (indent 0) (debug t))
+ (let ((saved (make-symbol "-saved-"))
+ (exit-args (make-symbol "-exit-args-")))
+ `(let ((,saved compilation-finish-functions)
+ ,exit-args)
+ (setq-local compilation-finish-functions nil)
+ (add-hook 'compilation-finish-functions
+ (lambda (&rest args) (setq ,exit-args args))
+ nil t)
+ (unwind-protect (progn ,@body)
+ (setq-local compilation-finish-functions ,saved)
+ (and ,exit-args (apply #'run-hook-with-args
+ 'compilation-finish-functions ,exit-args))))))
+
+(defmacro ggtags-ensure-global-buffer (&rest body)
+ (declare (debug t) (indent 0))
+ `(progn
+ (or (and (buffer-live-p ggtags-global-last-buffer)
+ (with-current-buffer ggtags-global-last-buffer
+ (derived-mode-p 'ggtags-global-mode)))
+ (error "No global buffer found"))
+ (with-current-buffer ggtags-global-last-buffer ,@body)))
+
+(defun ggtags-list-of-string-p (xs)
+ "Return non-nil if XS is a list of strings."
+ (cl-every #'stringp xs))
+
+(defun ggtags-ensure-localname (file)
+ (and file (or (file-remote-p file 'localname) file)))
+
+(defun ggtags-echo (format-string &rest args)
+ "Print formatted text to echo area."
+ (let (message-log-max) (apply #'message format-string args)))
+
+(defun ggtags-forward-to-line (line)
+ "Move to line number LINE in current buffer."
+ (cl-check-type line (integer 1))
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (forward-line (1- line))))
+
+(defun ggtags-kill-window ()
+ "Quit selected window and kill its buffer."
+ (interactive)
+ (quit-window t))
+
+(defun ggtags-program-path (name)
+ (if ggtags-executable-directory
+ (expand-file-name name ggtags-executable-directory)
+ name))
+
+(defun ggtags-process-succeed-p (program &rest args)
+ "Return non-nil if successfully running PROGRAM with ARGS."
+ (let ((program (ggtags-program-path program)))
+ (condition-case err
+ (zerop (apply #'process-file program nil nil nil args))
+ (error (message "`%s' failed: %s" program (error-message-string err))
+ nil))))
+
+(defun ggtags-process-string (program &rest args)
+ (with-temp-buffer
+ (let ((exit (apply #'process-file
+ (ggtags-program-path program) nil t nil args))
+ (output (progn
+ (goto-char (point-max))
+ (skip-chars-backward " \t\n")
+ (buffer-substring (point-min) (point)))))
+ (or (zerop exit)
+ (error "`%s' non-zero exit: %s" program output))
+ output)))
+
+(defun ggtags-tag-at-point ()
+ (pcase (funcall ggtags-bounds-of-tag-function)
+ (`(,beg . ,end) (buffer-substring beg end))))
+
+;;; Store for project info and settings
+
+(defvar ggtags-projects (make-hash-table :size 7 :test #'equal))
+
+(cl-defstruct (ggtags-project (:constructor ggtags-project--make)
+ (:copier nil)
+ (:type vector)
+ :named)
+ root tag-size has-refs has-path-style has-color dirty-p mtime timestamp)
+
+(defun ggtags-make-project (root)
+ (cl-check-type root string)
+ (pcase (nthcdr 5 (file-attributes (expand-file-name "GTAGS" root)))
+ (`(,mtime ,_ ,tag-size . ,_)
+ (let* ((default-directory (file-name-as-directory root))
+ (rtags-size (nth 7 (file-attributes "GRTAGS")))
+ (has-refs
+ (when rtags-size
+ (and (or (> rtags-size (* 32 1024))
+ (with-demoted-errors "ggtags-make-project: %S"
+ (not (equal "" (ggtags-process-string "global" "-crs")))))
+ 'has-refs)))
+ ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1518
+ (has-path-style
+ (and (ggtags-process-succeed-p "global" "--path-style" "shorter" "--help")
+ 'has-path-style))
+ ;; http://thread.gmane.org/gmane.comp.gnu.global.bugs/1542
+ (has-color (and (ggtags-process-succeed-p "global" "--color" "--help")
+ 'has-color)))
+ (puthash default-directory
+ (ggtags-project--make :root default-directory
+ :tag-size tag-size
+ :has-refs has-refs
+ :has-path-style has-path-style
+ :has-color has-color
+ :mtime (float-time mtime)
+ :timestamp (float-time))
+ ggtags-projects)))))
+
+(defun ggtags-project-expired-p (project)
+ (or (< (ggtags-project-timestamp project) 0)
+ (> (- (float-time)
+ (ggtags-project-timestamp project))
+ ggtags-project-duration)))
+
+(defun ggtags-project-update-mtime-maybe (&optional project)
+ "Update PROJECT's modtime and if current file is newer.
+Value is new modtime if updated."
+ (let ((project (or project (ggtags-find-project))))
+ (when (and (ggtags-project-p project)
+ (consp (visited-file-modtime))
+ (> (float-time (visited-file-modtime))
+ (ggtags-project-mtime project)))
+ (setf (ggtags-project-dirty-p project) t)
+ (setf (ggtags-project-mtime project)
+ (float-time (visited-file-modtime))))))
+
+(defun ggtags-project-oversize-p (&optional project)
+ (pcase ggtags-oversize-limit
+ (`nil nil)
+ (`t t)
+ (size (let ((project (or project (ggtags-find-project))))
+ (and project (> (ggtags-project-tag-size project) size))))))
+
+(defvar-local ggtags-last-default-directory nil)
+(defvar-local ggtags-project-root 'unset
+ "Internal variable for project root directory.")
+
+;;;###autoload
+(defun ggtags-find-project ()
+ ;; See https://github.com/leoliu/ggtags/issues/42
+ ;;
+ ;; It is unsafe to cache `ggtags-project-root' in non-file buffers
+ ;; whose `default-directory' can often change.
+ (unless (equal ggtags-last-default-directory default-directory)
+ (kill-local-variable 'ggtags-project-root))
+ (let ((project (gethash ggtags-project-root ggtags-projects)))
+ (if (ggtags-project-p project)
+ (if (ggtags-project-expired-p project)
+ (progn
+ (remhash ggtags-project-root ggtags-projects)
+ (ggtags-find-project))
+ project)
+ (setq ggtags-last-default-directory default-directory)
+ (setq ggtags-project-root
+ (or (ignore-errors-unless-debug
+ (file-name-as-directory
+ (concat (file-remote-p default-directory)
+ ;; Resolves symbolic links
+ (ggtags-process-string "global" "-pr"))))
+ ;; 'global -pr' resolves symlinks before checking the
+ ;; GTAGS file which could cause issues such as
+ ;; https://github.com/leoliu/ggtags/issues/22, so
+ ;; let's help it out.
+ ;;
+ ;; Note: `locate-dominating-file' doesn't accept
+ ;; function for NAME before 24.3.
+ (let ((dir (locate-dominating-file default-directory "GTAGS")))
+ ;; `file-truename' may strip the trailing '/' on
+ ;; remote hosts, see http://debbugs.gnu.org/16851
+ (and dir (file-regular-p (expand-file-name "GTAGS" dir))
+ (file-name-as-directory (file-truename dir))))))
+ (when ggtags-project-root
+ (if (gethash ggtags-project-root ggtags-projects)
+ (ggtags-find-project)
+ (ggtags-make-project ggtags-project-root))))))
+
+(defun ggtags-current-project-root ()
+ (and (ggtags-find-project)
+ (ggtags-project-root (ggtags-find-project))))
+
+(defun ggtags-check-project ()
+ (or (ggtags-find-project) (error "File GTAGS not found")))
+
+(defun ggtags-ensure-project ()
+ (or (ggtags-find-project)
+ (progn (call-interactively #'ggtags-create-tags)
+ ;; Need checking because `ggtags-create-tags' can create
+ ;; tags in any directory.
+ (ggtags-check-project))))
+
+(defvar delete-trailing-lines) ;new in 24.3
+
+(defun ggtags-save-project-settings (&optional noconfirm)
+ "Save Gnu Global's specific environment variables."
+ (interactive "P")
+ (ggtags-check-project)
+ (let* ((inhibit-read-only t) ; for `add-dir-local-variable'
+ (default-directory (ggtags-current-project-root))
+ ;; Not using `ggtags-with-current-project' to preserve
+ ;; environment variables that may be present in
+ ;; `ggtags-process-environment'.
+ (process-environment
+ (append ggtags-process-environment
+ process-environment
+ (and (not (ggtags-project-has-refs (ggtags-find-project)))
+ (list "GTAGSLABEL=ctags"))))
+ (envlist (delete-dups
+ (cl-loop for x in process-environment
+ when (string-match
+ "^\\(GTAGS[^=\n]*\\|MAKEOBJDIRPREFIX\\)=" x)
+ ;; May have duplicates thus `delete-dups'.
+ collect (concat (match-string 1 x)
+ "="
+ (getenv (match-string 1 x))))))
+ (help-form (format "y: save\nn: don't save\n=: diff\n?: help\n")))
+ (add-dir-local-variable nil 'ggtags-process-environment envlist)
+ ;; Remove trailing newlines by `add-dir-local-variable'.
+ (let ((delete-trailing-lines t)) (delete-trailing-whitespace))
+ (or noconfirm
+ (while (pcase (read-char-choice
+ (format "Save `%s'? (y/n/=/?) " buffer-file-name)
+ '(?y ?n ?= ??))
+ ;; ` required for 24.1 and 24.2
+ (`?n (user-error "Aborted"))
+ (`?y nil)
+ (`?= (diff-buffer-with-file) 'loop)
+ (`?? (help-form-show) 'loop))))
+ (save-buffer)
+ (kill-buffer)))
+
+(defun ggtags-toggle-project-read-only ()
+ (interactive)
+ (ggtags-check-project)
+ (let ((inhibit-read-only t) ; for `add-dir-local-variable'
+ (val (not buffer-read-only))
+ (default-directory (ggtags-current-project-root)))
+ (add-dir-local-variable nil 'buffer-read-only val)
+ (save-buffer)
+ (kill-buffer)
+ (when buffer-file-name
+ (read-only-mode (if val +1 -1)))
+ (when (called-interactively-p 'interactive)
+ (message "Project read-only-mode is %s" (if val "on" "off")))
+ val))
+
+(defun ggtags-visit-project-root (&optional project)
+ "Visit the root directory of (current) PROJECT in dired.
+When called with a prefix \\[universal-argument], choose from past projects."
+ (interactive (list (and current-prefix-arg
+ (completing-read "Project: " ggtags-projects))))
+ (dired (cl-typecase project
+ (string project)
+ (ggtags-project (ggtags-project-root project))
+ (t (ggtags-ensure-project) (ggtags-current-project-root)))))
+
+(defmacro ggtags-with-current-project (&rest body)
+ "Eval BODY in current project's `process-environment'."
+ (declare (debug t) (indent 0))
+ (let ((gtagsroot (make-symbol "-gtagsroot-"))
+ (root (make-symbol "-ggtags-project-root-")))
+ `(let* ((,root ggtags-project-root)
+ (,gtagsroot (when (ggtags-find-project)
+ (ggtags-ensure-localname
+ (directory-file-name (ggtags-current-project-root)))))
+ (process-environment
+ (append (let ((process-environment (copy-sequence process-environment)))
+ (and ,gtagsroot (setenv "GTAGSROOT" ,gtagsroot))
+ (mapcar #'substitute-env-vars ggtags-process-environment))
+ process-environment
+ (and ,gtagsroot (list (concat "GTAGSROOT=" ,gtagsroot)))
+ (and (ggtags-find-project)
+ (not (ggtags-project-has-refs (ggtags-find-project)))
+ (list "GTAGSLABEL=ctags")))))
+ (unwind-protect (save-current-buffer ,@body)
+ (setq ggtags-project-root ,root)))))
+
+(defun ggtags-get-libpath ()
+ (let ((path (ggtags-with-current-project (getenv "GTAGSLIBPATH"))))
+ (and path (mapcar (apply-partially #'concat (file-remote-p default-directory))
+ (split-string path (regexp-quote path-separator) t)))))
+
+(defun ggtags-project-relative-file (file)
+ "Get file name relative to current project root."
+ (ggtags-check-project)
+ (if (file-name-absolute-p file)
+ (file-relative-name file (if (string-prefix-p (ggtags-current-project-root)
+ file)
+ (ggtags-current-project-root)
+ (locate-dominating-file file "GTAGS")))
+ file))
+
+(defun ggtags-project-file-p (file)
+ "Return non-nil if FILE is part of current project."
+ (when (ggtags-find-project)
+ (with-temp-buffer
+ (ggtags-with-current-project
+ ;; NOTE: `process-file' requires all files in ARGS be relative
+ ;; to `default-directory'; see its doc string for details.
+ (let ((default-directory (ggtags-current-project-root)))
+ (process-file (ggtags-program-path "global") nil t nil
+ "-vP" (concat "^" (ggtags-project-relative-file file) "$"))))
+ (goto-char (point-min))
+ (not (re-search-forward "^file not found" nil t)))))
+
+(defun ggtags-invalidate-buffer-project-root (root)
+ (mapc (lambda (buf)
+ (with-current-buffer buf
+ (and buffer-file-truename
+ (string-prefix-p root buffer-file-truename)
+ (kill-local-variable 'ggtags-project-root))))
+ (buffer-list)))
+
+(defun ggtags-create-tags (root)
+ "Create tag files (e.g. GTAGS) in directory ROOT.
+If file .globalrc or gtags.conf exists in ROOT, it will be used
+as configuration file per `ggtags-use-project-gtagsconf'.
+
+If file gtags.files exists in ROOT, it should be a list of source
+files to index, which can be used to speed gtags up in large
+source trees. See Info node `(global)gtags' for details."
+ (interactive "DRoot directory: ")
+ (let ((process-environment (copy-sequence process-environment)))
+ (when (zerop (length root)) (error "No root directory provided"))
+ (setenv "GTAGSROOT" (ggtags-ensure-localname
+ (expand-file-name
+ (directory-file-name (file-name-as-directory root)))))
+ (ggtags-with-current-project
+ (let ((conf (and ggtags-use-project-gtagsconf
+ (cl-loop for name in '(".globalrc" "gtags.conf")
+ for full = (expand-file-name name root)
+ thereis (and (file-exists-p full) full)))))
+ (unless (or conf (getenv "GTAGSLABEL")
+ (not (yes-or-no-p "Use `ctags' backend? ")))
+ (setenv "GTAGSLABEL" "ctags"))
+ (ggtags-with-temp-message "`gtags' in progress..."
+ (let ((default-directory (file-name-as-directory root))
+ (args (cl-remove-if
+ #'null
+ (list (and ggtags-use-idutils "--idutils")
+ (and ggtags-use-sqlite3
+ (ggtags-process-succeed-p "gtags" "--sqlite3" "--help")
+ "--sqlite3")
+ (and conf "--gtagsconf")
+ (and conf (ggtags-ensure-localname conf))))))
+ (condition-case err
+ (apply #'ggtags-process-string "gtags" args)
+ (error (if (and ggtags-use-idutils
+ (stringp (cadr err))
+ (string-match-p "mkid not found" (cadr err)))
+ ;; Retry without mkid
+ (apply #'ggtags-process-string
+ "gtags" (cl-remove "--idutils" args))
+ (signal (car err) (cdr err)))))))))
+ (ggtags-invalidate-buffer-project-root (file-truename root))
+ (message "GTAGS generated in `%s'" root)
+ root))
+
+(defun ggtags-explain-tags ()
+ "Explain how each file is indexed in current project."
+ (interactive (ignore (ggtags-check-project)
+ (or (ggtags-process-succeed-p "gtags" "--explain" "--help")
+ (user-error "Global 6.4+ required"))))
+ (ggtags-check-project)
+ (ggtags-with-current-project
+ (let ((default-directory (ggtags-current-project-root)))
+ (compilation-start (concat (ggtags-program-path "gtags") " --explain")))))
+
+(defun ggtags-update-tags (&optional force)
+ "Update GNU Global tag database.
+Do nothing if GTAGS exceeds the oversize limit unless FORCE.
+
+When called interactively on large (per `ggtags-oversize-limit')
+projects, the update process runs in the background without
+blocking emacs."
+ (interactive (progn
+ (ggtags-check-project)
+ ;; Mark project info expired.
+ (setf (ggtags-project-timestamp (ggtags-find-project)) -1)
+ (list 'interactive)))
+ (cond ((and (eq force 'interactive) (ggtags-project-oversize-p))
+ (ggtags-with-current-project
+ (with-display-buffer-no-window
+ (with-current-buffer (compilation-start "global -u")
+ ;; A hack to fool compilation mode to display `global
+ ;; -u finished' on finish.
+ (setq mode-name "global -u")
+ (add-hook 'compilation-finish-functions
+ #'ggtags-update-tags-finish nil t)))))
+ ((or force (and (ggtags-find-project)
+ (not (ggtags-project-oversize-p))
+ (ggtags-project-dirty-p (ggtags-find-project))))
+ (ggtags-with-current-project
+ (ggtags-with-temp-message "`global -u' in progress..."
+ (ggtags-process-string "global" "-u")
+ (ggtags-update-tags-finish))))))
+
+(defun ggtags-update-tags-finish (&optional buf how)
+ (if (and how buf (string-prefix-p "exited abnormally" how))
+ (display-buffer buf)
+ (setf (ggtags-project-dirty-p (ggtags-find-project)) nil)
+ (setf (ggtags-project-mtime (ggtags-find-project)) (float-time))))
+
+(defun ggtags-update-tags-single (file &optional nowait)
+ ;; NOTE: NOWAIT is ignored if file is remote file; see
+ ;; `tramp-sh-handle-process-file'.
+ (cl-check-type file string)
+ (let ((nowait (unless (file-remote-p file) nowait)))
+ (ggtags-with-current-project
+ ;; See comment in `ggtags-project-file-p'.
+ (let ((default-directory (ggtags-current-project-root)))
+ (process-file (ggtags-program-path "global") nil (and nowait 0) nil
+ "--single-update" (ggtags-project-relative-file file))))))
+
+(defun ggtags-delete-tags ()
+ "Delete file GTAGS, GRTAGS, GPATH, ID etc. generated by gtags."
+ (interactive (ignore (ggtags-check-project)))
+ (when (ggtags-current-project-root)
+ (let* ((re (concat "\\`" (regexp-opt '("GPATH" "GRTAGS" "GTAGS" "ID")) "\\'"))
+ (files (cl-remove-if-not
+ (lambda (file)
+ ;; Don't trust `directory-files'.
+ (let ((case-fold-search nil))
+ (string-match-p re (file-name-nondirectory file))))
+ (directory-files (ggtags-current-project-root) t re)))
+ (buffer "*GTags File List*"))
+ (or files (user-error "No tag files found"))
+ (with-output-to-temp-buffer buffer
+ (princ (mapconcat #'identity files "\n")))
+ (let ((win (get-buffer-window buffer)))
+ (unwind-protect
+ (progn
+ (fit-window-to-buffer win)
+ (when (yes-or-no-p "Remove GNU Global tag files? ")
+ (with-demoted-errors (mapc #'delete-file files))
+ (remhash (ggtags-current-project-root) ggtags-projects)
+ (and (overlayp ggtags-highlight-tag-overlay)
+ (delete-overlay ggtags-highlight-tag-overlay))))
+ (when (window-live-p win)
+ (quit-window t win)))))))
+
+(defvar-local ggtags-completion-cache nil)
+
+;; See global/libutil/char.c
+;; (defconst ggtags-regexp-metachars "[][$()*+.?\\{}|^]")
+(defvar ggtags-completion-flag "") ;internal use
+
+(defvar ggtags-completion-table
+ (completion-table-dynamic
+ (lambda (prefix)
+ (let ((cache-key (concat prefix "$" ggtags-completion-flag)))
+ (unless (equal cache-key (car ggtags-completion-cache))
+ (setq ggtags-completion-cache
+ (cons cache-key
+ (ignore-errors-unless-debug
+ ;; May throw global: only name char is allowed
+ ;; with -c option.
+ (ggtags-with-current-project
+ (split-string
+ (apply #'ggtags-process-string
+ "global"
+ (append (and completion-ignore-case '("--ignore-case"))
+ ;; Note -c alone returns only definitions
+ (list (concat "-c" ggtags-completion-flag) prefix)))
+ "\n" t)))))))
+ (cdr ggtags-completion-cache))))
+
+(defun ggtags-completion-at-point ()
+ "A function for `completion-at-point-functions'."
+ (pcase (funcall ggtags-bounds-of-tag-function)
+ (`(,beg . ,end)
+ (and (< beg end) (list beg end ggtags-completion-table)))))
+
+(defun ggtags-read-tag (&optional type confirm prompt require-match default)
+ (ggtags-ensure-project)
+ (let ((default (or default (ggtags-tag-at-point)))
+ (prompt (or prompt (capitalize (symbol-name (or type 'tag)))))
+ (ggtags-completion-flag (pcase type
+ (`(or nil definition) "T")
+ (`symbol "s")
+ (`reference "r")
+ (`id "I")
+ (`path "P")
+ ((pred stringp) type)
+ (_ ggtags-completion-flag))))
+ (setq ggtags-current-tag-name
+ (cond (confirm
+ (ggtags-update-tags)
+ (let ((completing-read-function
+ (or ggtags-completing-read-function
+ completing-read-function)))
+ (completing-read
+ (format (if default "%s (default %s): " "%s: ") prompt default)
+ ggtags-completion-table nil require-match nil nil default)))
+ (default (substring-no-properties default))
+ (t (ggtags-read-tag type t prompt require-match default))))))
+
+(defun ggtags-sort-by-nearness-p ()
+ (and ggtags-sort-by-nearness
+ (ggtags-process-succeed-p "global" "--nearness" "--help")))
+
+(defun ggtags-global-build-command (cmd &rest args)
+ ;; CMD can be definition, reference, symbol, grep, idutils
+ (let ((xs (append (list (shell-quote-argument (ggtags-program-path "global"))
+ "-v"
+ (format "--result=%s" ggtags-global-output-format)
+ (and ggtags-global-ignore-case "--ignore-case")
+ (and ggtags-global-use-color
+ (ggtags-find-project)
+ (ggtags-project-has-color (ggtags-find-project))
+ "--color=always")
+ (and (ggtags-sort-by-nearness-p) "--nearness")
+ (and (ggtags-find-project)
+ (ggtags-project-has-path-style (ggtags-find-project))
+ "--path-style=shorter")
+ (and ggtags-global-treat-text "--other")
+ (pcase cmd
+ ((pred stringp) cmd)
+ (`definition nil) ;-d not supported by Global 5.7.1
+ (`reference "--reference")
+ (`symbol "--symbol")
+ (`path "--path")
+ (`grep "--grep")
+ (`idutils "--idutils")))
+ args)))
+ (mapconcat #'identity (delq nil xs) " ")))
+
+;; Can be three values: nil, t and a marker; t means start marker has
+;; been saved in the tag ring.
+(defvar ggtags-global-start-marker nil)
+(defvar ggtags-global-start-file nil)
+(defvar ggtags-tag-ring-index nil)
+(defvar ggtags-global-search-history nil)
+
+(defvar ggtags-auto-jump-to-match-target nil)
+
+(defvar-local ggtags-global-exit-info nil) ; (EXIT-STATUS COUNT DB)
+
+(defun ggtags-global-save-start-marker ()
+ (when (markerp ggtags-global-start-marker)
+ (setq ggtags-tag-ring-index nil)
+ (ring-insert find-tag-marker-ring ggtags-global-start-marker)
+ (setq ggtags-global-start-marker t)))
+
+(defun ggtags-global-start (command &optional directory)
+ (let* ((default-directory (or directory (ggtags-current-project-root)))
+ (split-window-preferred-function ggtags-split-window-function)
+ (env ggtags-process-environment))
+ (unless (and (markerp ggtags-global-start-marker)
+ (marker-position ggtags-global-start-marker))
+ (setq ggtags-global-start-marker (point-marker)))
+ ;; Record the file name for `ggtags-navigation-start-file'.
+ (setq ggtags-global-start-file buffer-file-name)
+ (setq ggtags-auto-jump-to-match-target
+ (nth 4 (assoc (ggtags-global-search-id command default-directory)
+ ggtags-global-search-history)))
+ (ggtags-navigation-mode +1)
+ (ggtags-update-tags)
+ (ggtags-with-current-project
+ (with-current-buffer (with-display-buffer-no-window
+ (compilation-start command 'ggtags-global-mode))
+ (setq-local ggtags-process-environment env)
+ (setq ggtags-global-last-buffer (current-buffer))))))
+
+(defun ggtags-find-tag-continue ()
+ (interactive)
+ (ggtags-ensure-global-buffer
+ (ggtags-navigation-mode +1)
+ (let ((split-window-preferred-function ggtags-split-window-function))
+ (ignore-errors (compilation-next-error 1))
+ (compile-goto-error))))
+
+(defun ggtags-find-tag (cmd &rest args)
+ (ggtags-check-project)
+ (ggtags-global-start (apply #'ggtags-global-build-command cmd args)
+ (and (ggtags-sort-by-nearness-p) default-directory)))
+
+(defun ggtags-include-file ()
+ "Calculate the include file based on `ggtags-include-pattern'."
+ (pcase ggtags-include-pattern
+ (`nil nil)
+ ((pred functionp)
+ (funcall ggtags-include-pattern))
+ (`(,re . ,sub)
+ (save-excursion
+ (beginning-of-line)
+ (and (looking-at re) (match-string sub))))
+ (_ (warn "Invalid value for `ggtags-include-pattern': %s"
+ ggtags-include-pattern)
+ nil)))
+
+;;;###autoload
+(defun ggtags-find-tag-dwim (name &optional what)
+ "Find NAME by context.
+If point is at a definition tag, find references, and vice versa.
+If point is at a line that matches `ggtags-include-pattern', find
+the include file instead.
+
+When called interactively with a prefix arg, always find
+definition tags."
+ (interactive
+ (let ((include (and (not current-prefix-arg) (ggtags-include-file))))
+ (ggtags-ensure-project)
+ (if include (list include 'include)
+ (list (ggtags-read-tag 'definition current-prefix-arg)
+ (and current-prefix-arg 'definition)))))
+ (ggtags-check-project) ; For `ggtags-current-project-root' below.
+ (cond
+ ((eq what 'include)
+ (ggtags-find-file name))
+ ((or (eq what 'definition)
+ (not buffer-file-name)
+ (not (ggtags-project-has-refs (ggtags-find-project)))
+ (not (ggtags-project-file-p buffer-file-name)))
+ (ggtags-find-definition name))
+ (t (ggtags-find-tag
+ (format "--from-here=%d:%s"
+ (line-number-at-pos)
+ (shell-quote-argument
+ ;; Note `ggtags-find-tag' may bind `default-directory'
+ ;; to project root.
+ (funcall (if (ggtags-sort-by-nearness-p)
+ #'file-relative-name #'ggtags-project-relative-file)
+ buffer-file-name)))
+ (shell-quote-argument name)))))
+
+(defun ggtags-find-tag-mouse (event)
+ (interactive "e")
+ (with-selected-window (posn-window (event-start event))
+ (save-excursion
+ (goto-char (posn-point (event-start event)))
+ (call-interactively #'ggtags-find-tag-dwim))))
+
+;; Another option for `M-.'.
+(defun ggtags-find-definition (name)
+ (interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
+ (ggtags-find-tag 'definition (shell-quote-argument name)))
+
+(defun ggtags-setup-libpath-search (type name)
+ (pcase (and ggtags-global-search-libpath-for-reference
+ (ggtags-get-libpath))
+ ((and libs (guard libs))
+ (cl-labels ((cont (buf how)
+ (pcase ggtags-global-exit-info
+ (`(0 0 ,_)
+ (with-temp-buffer
+ (setq default-directory
+ (file-name-as-directory (pop libs)))
+ (and libs (setq ggtags-global-continuation #'cont))
+ (if (ggtags-find-project)
+ (ggtags-find-tag type (shell-quote-argument name))
+ (cont buf how))))
+ (_ (ggtags-global-handle-exit buf how)))))
+ (setq ggtags-global-continuation #'cont)))))
+
+(defun ggtags-find-reference (name)
+ (interactive (list (ggtags-read-tag 'reference current-prefix-arg)))
+ (ggtags-setup-libpath-search 'reference name)
+ (ggtags-find-tag 'reference (shell-quote-argument name)))
+
+(defun ggtags-find-other-symbol (name)
+ "Find tag NAME that is a reference without a definition."
+ (interactive (list (ggtags-read-tag 'symbol current-prefix-arg)))
+ (ggtags-setup-libpath-search 'symbol name)
+ (ggtags-find-tag 'symbol (shell-quote-argument name)))
+
+(defun ggtags-quote-pattern (pattern)
+ (prin1-to-string (substring-no-properties pattern)))
+
+(defun ggtags-idutils-query (pattern)
+ (interactive (list (ggtags-read-tag 'id t)))
+ (ggtags-find-tag 'idutils "--" (ggtags-quote-pattern pattern)))
+
+(defun ggtags-grep (pattern &optional invert-match)
+ "Grep for lines matching PATTERN.
+Invert the match when called with a prefix arg \\[universal-argument]."
+ (interactive (list (ggtags-read-tag 'definition 'confirm
+ (if current-prefix-arg
+ "Inverted grep pattern" "Grep pattern"))
+ current-prefix-arg))
+ (ggtags-find-tag 'grep (and invert-match "--invert-match")
+ "--" (ggtags-quote-pattern pattern)))
+
+(defun ggtags-find-file (pattern &optional invert-match)
+ (interactive (list (ggtags-read-tag 'path 'confirm (if current-prefix-arg
+ "Inverted path pattern"
+ "Path pattern")
+ nil (thing-at-point 'filename))
+ current-prefix-arg))
+ (let ((ggtags-global-output-format 'path))
+ (ggtags-find-tag 'path (and invert-match "--invert-match")
+ "--" (ggtags-quote-pattern pattern))))
+
+;; Note: Coloured output requested in http://goo.gl/Y9IcX and appeared
+;; in global v6.2.12.
+(defun ggtags-find-tag-regexp (regexp directory)
+ "List tags matching REGEXP in DIRECTORY (default to project root).
+When called interactively with a prefix, ask for the directory."
+ (interactive
+ (progn
+ (ggtags-check-project)
+ (list (ggtags-read-tag "" t "POSIX regexp")
+ (if current-prefix-arg
+ (read-directory-name "Directory: " nil nil t)
+ (ggtags-current-project-root)))))
+ (ggtags-check-project)
+ (ggtags-global-start
+ (ggtags-global-build-command nil nil "-l" "--" (ggtags-quote-pattern regexp))
+ (file-name-as-directory directory)))
+
+(defvar ggtags-navigation-mode)
+
+(defun ggtags-foreach-file (fn)
+ "Invoke FN with each file found.
+FN is invoked while *ggtags-global* buffer is current."
+ (ggtags-ensure-global-buffer
+ (save-excursion
+ (goto-char (point-min))
+ (while (with-demoted-errors "compilation-next-error: %S"
+ (compilation-next-error 1 'file)
+ t)
+ (funcall fn (caar
+ (compilation--loc->file-struct
+ (compilation--message->loc
+ (get-text-property (point) 'compilation-message)))))))))
+
+(defun ggtags-query-replace (from to &optional delimited)
+ "Query replace FROM with TO on files in the Global buffer.
+If not in navigation mode, do a grep on FROM first.
+
+Note: the regular expression FROM must be supported by both
+Global and Emacs."
+ (interactive
+ ;; Note: in 24.4 query-replace-read-args returns a list of 4 elements.
+ (let ((args (query-replace-read-args "Query replace (regexp)" t t)))
+ (list (nth 0 args) (nth 1 args) (nth 2 args))))
+ (unless ggtags-navigation-mode
+ (let ((ggtags-auto-jump-to-match nil))
+ (ggtags-grep from)))
+ (let ((file-form
+ '(let ((files))
+ (ggtags-ensure-global-buffer
+ (ggtags-with-temp-message "Waiting for Grep to finish..."
+ (while (get-buffer-process (current-buffer))
+ (sit-for 0.2)))
+ (ggtags-foreach-file
+ (lambda (file) (push (expand-file-name file) files))))
+ (ggtags-navigation-mode -1)
+ (nreverse files))))
+ (tags-query-replace from to delimited file-form)))
+
+(defun ggtags-global-normalise-command (cmd)
+ (if (string-match
+ (concat (regexp-quote (ggtags-global-build-command nil)) "\\s-*")
+ cmd)
+ (substring-no-properties cmd (match-end 0))
+ cmd))
+
+(defun ggtags-global-search-id (cmd directory)
+ (sha1 (concat directory (make-string 1 0)
+ (ggtags-global-normalise-command cmd))))
+
+(defun ggtags-global-current-search ()
+ ;; CMD DIR ENV LINE TEXT
+ (ggtags-ensure-global-buffer
+ (list (ggtags-global-normalise-command (car compilation-arguments))
+ default-directory
+ ggtags-process-environment
+ (line-number-at-pos)
+ (buffer-substring-no-properties
+ (line-beginning-position) (line-end-position)))))
+
+(defun ggtags-global-rerun-search (data)
+ (pcase data
+ (`(,cmd ,dir ,env ,line ,_text)
+ (with-current-buffer (let ((ggtags-auto-jump-to-match nil)
+ ;; Switch current project to DIR.
+ (default-directory dir)
+ (ggtags-project-root dir)
+ (ggtags-process-environment env))
+ (ggtags-global-start
+ (ggtags-global-build-command cmd) dir))
+ (add-hook 'compilation-finish-functions
+ (lambda (buf _msg)
+ (with-current-buffer buf
+ (ggtags-forward-to-line line)
+ (compile-goto-error)))
+ nil t)))))
+
+(defvar-local ggtags-global-search-ewoc nil)
+(defvar ggtags-view-search-history-last nil)
+
+(defvar ggtags-view-search-history-mode-map
+ (let ((m (make-sparse-keymap)))
+ (define-key m "p" 'ggtags-view-search-history-prev)
+ (define-key m "\M-p" 'ggtags-view-search-history-prev)
+ (define-key m "n" 'ggtags-view-search-history-next)
+ (define-key m "\M-n" 'ggtags-view-search-history-next)
+ (define-key m "\C-k" 'ggtags-view-search-history-kill)
+ (define-key m [remap yank] (lambda (&optional arg) (interactive "P") (yank arg)))
+ (define-key m "\C-c\C-c" 'ggtags-view-search-history-update)
+ (define-key m "r" 'ggtags-save-to-register)
+ (define-key m "\r" 'ggtags-view-search-history-action)
+ (define-key m "q" 'ggtags-kill-window)
+ m))
+
+(defun ggtags-view-search-history-remember ()
+ (setq ggtags-view-search-history-last
+ (pcase (ewoc-locate ggtags-global-search-ewoc)
+ (`nil nil)
+ (node (ewoc-data node)))))
+
+(defun ggtags-view-search-history-next (&optional arg)
+ (interactive "p")
+ (let ((arg (or arg 1)))
+ (prog1 (funcall (if (cl-minusp arg) #'ewoc-goto-prev #'ewoc-goto-next)
+ ggtags-global-search-ewoc (abs arg))
+ (ggtags-view-search-history-remember))))
+
+(defun ggtags-view-search-history-prev (&optional arg)
+ (interactive "p")
+ (ggtags-view-search-history-next (- (or arg 1))))
+
+(defun ggtags-view-search-history-kill (&optional append)
+ (interactive "P")
+ (let* ((node (or (ewoc-locate ggtags-global-search-ewoc)
+ (user-error "No node at point")))
+ (next (ewoc-next ggtags-global-search-ewoc node))
+ (text (filter-buffer-substring (ewoc-location node)
+ (if next (ewoc-location next)
+ (point-max)))))
+ (put-text-property
+ 0 (length text) 'yank-handler
+ (list (lambda (arg)
+ (if (not ggtags-global-search-ewoc)
+ (insert (car arg))
+ (let* ((inhibit-read-only t)
+ (node (unless (looking-at-p "[ \t\n]*\\'")
+ (ewoc-locate ggtags-global-search-ewoc))))
+ (if node
+ (ewoc-enter-before ggtags-global-search-ewoc
+ node (cadr arg))
+ (ewoc-enter-last ggtags-global-search-ewoc (cadr arg)))
+ (setq ggtags-view-search-history-last (cadr arg)))))
+ (list text (ewoc-data node)))
+ text)
+ (if append (kill-append text nil)
+ (kill-new text))
+ (let ((inhibit-read-only t))
+ (ewoc-delete ggtags-global-search-ewoc node))))
+
+(defun ggtags-view-search-history-update (&optional noconfirm)
+ "Update `ggtags-global-search-history' to current buffer."
+ (interactive "P")
+ (when (and (buffer-modified-p)
+ (or noconfirm
+ (yes-or-no-p "Modify `ggtags-global-search-history'?")))
+ (setq ggtags-global-search-history
+ (ewoc-collect ggtags-global-search-ewoc #'identity))
+ (set-buffer-modified-p nil)))
+
+(defun ggtags-view-search-history-action ()
+ (interactive)
+ (let ((data (ewoc-data (or (ewoc-locate ggtags-global-search-ewoc)
+ (user-error "No search at point")))))
+ (ggtags-view-search-history-remember)
+ (quit-window t)
+ (ggtags-global-rerun-search (cdr data))))
+
+(defvar bookmark-make-record-function)
+
+(define-derived-mode ggtags-view-search-history-mode special-mode "SearchHist"
+ "Major mode for viewing search history."
+ :group 'ggtags
+ (setq-local ggtags-enable-navigation-keys nil)
+ (setq-local bookmark-make-record-function #'ggtags-make-bookmark-record)
+ (setq truncate-lines t)
+ (add-hook 'kill-buffer-hook #'ggtags-view-search-history-update nil t))
+
+(defun ggtags-view-search-history-restore-last ()
+ (when ggtags-view-search-history-last
+ (cl-loop for n = (ewoc-nth ggtags-global-search-ewoc 0)
+ then (ewoc-next ggtags-global-search-ewoc n)
+ while n when (eq (ewoc-data n)
+ ggtags-view-search-history-last)
+ do (progn (goto-char (ewoc-location n)) (cl-return t)))))
+
+(defun ggtags-view-search-history ()
+ "Pop to a buffer to view or re-run past searches.
+
+\\{ggtags-view-search-history-mode-map}"
+ (interactive)
+ (or ggtags-global-search-history (user-error "No search history"))
+ (let ((split-window-preferred-function ggtags-split-window-function)
+ (inhibit-read-only t))
+ (pop-to-buffer "*Ggtags Search History*")
+ (erase-buffer)
+ (ggtags-view-search-history-mode)
+ (cl-labels ((prop (s)
+ (propertize s 'face 'minibuffer-prompt))
+ (prop-tag (cmd)
+ (with-temp-buffer
+ (insert cmd)
+ (forward-sexp -1)
+ (if (eobp)
+ cmd
+ (put-text-property (point) (point-max)
+ 'face font-lock-constant-face)
+ (buffer-string))))
+ (pp (data)
+ (pcase data
+ (`(,_id ,cmd ,dir ,_env ,line ,text)
+ (insert (prop " cmd: ") (prop-tag cmd) "\n"
+ (prop " dir: ") dir "\n"
+ (prop "line: ") (number-to-string line) "\n"
+ (prop "text: ") text "\n"
+ (propertize (make-string 32 ?-) 'face 'shadow))))))
+ (setq ggtags-global-search-ewoc
+ (ewoc-create #'pp "Global search history keys: n:next p:prev r:register RET:choose\n")))
+ (dolist (data ggtags-global-search-history)
+ (ewoc-enter-last ggtags-global-search-ewoc data))
+ (ggtags-view-search-history-restore-last)
+ (set-buffer-modified-p nil)
+ (fit-window-to-buffer nil (floor (frame-height) 2))))
+
+(defun ggtags-save-to-register (r)
+ "Save current search session to register R.
+Use \\[jump-to-register] to restore the search session."
+ (interactive (list (register-read-with-preview "Save search to register: ")))
+ (cl-labels ((prn (data)
+ (pcase data
+ (`(,command ,root ,_env ,line ,_)
+ (princ (format "a ggtags search session `%s' in directory `%s' at line %d."
+ command root line))))))
+ (set-register r (registerv-make
+ (if ggtags-global-search-ewoc
+ (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
+ (ggtags-global-current-search))
+ :jump-func #'ggtags-global-rerun-search
+ :print-func #'prn))))
+
+(defun ggtags-make-bookmark-record ()
+ `(,(and ggtags-current-tag-name (format "*ggtags %s*" ggtags-current-tag-name))
+ (ggtags-search . ,(if ggtags-global-search-ewoc
+ (cdr (ewoc-data (ewoc-locate ggtags-global-search-ewoc)))
+ (ggtags-global-current-search)))
+ (handler . ggtags-bookmark-jump)))
+
+(declare-function bookmark-prop-get "bookmark")
+
+(defun ggtags-bookmark-jump (bmk)
+ (ggtags-global-rerun-search (bookmark-prop-get bmk 'ggtags-search)))
+
+(defun ggtags-browse-file-as-hypertext (file line)
+ "Browse FILE in hypertext (HTML) form."
+ (interactive (if (or current-prefix-arg (not buffer-file-name))
+ (list (read-file-name "Browse file: " nil nil t)
+ (read-number "Line: " 1))
+ (list buffer-file-name (line-number-at-pos))))
+ (cl-check-type line (integer 1))
+ (or (and file (file-exists-p file)) (error "File `%s' doesn't exist" file))
+ (ggtags-check-project)
+ (or (file-exists-p (expand-file-name "HTML" (ggtags-current-project-root)))
+ (if (yes-or-no-p "No hypertext form exists; run htags? ")
+ (let ((default-directory (ggtags-current-project-root)))
+ (ggtags-with-current-project (ggtags-process-string "htags")))
+ (user-error "Aborted")))
+ (let ((url (ggtags-process-string "gozilla" "-p" (format "+%d" line)
+ (file-relative-name file))))
+ (or (equal (file-name-extension
+ (url-filename (url-generic-parse-url url))) "html")
+ (user-error "No hypertext form for `%s'" file))
+ (when (called-interactively-p 'interactive)
+ (message "Browsing %s" url))
+ (browse-url url)))
+
+(defun ggtags-next-mark (&optional arg)
+ "Move to the next (newer) mark in the tag marker ring."
+ (interactive)
+ (and (ring-empty-p find-tag-marker-ring) (user-error "Tag ring empty"))
+ (setq ggtags-tag-ring-index
+ ;; Note `ring-minus1' gets newer item.
+ (funcall (if arg #'ring-plus1 #'ring-minus1)
+ (or ggtags-tag-ring-index
+ (progn
+ (ring-insert find-tag-marker-ring (point-marker))
+ 0))
+ (ring-length find-tag-marker-ring)))
+ (let ((m (ring-ref find-tag-marker-ring ggtags-tag-ring-index))
+ (i (- (ring-length find-tag-marker-ring) ggtags-tag-ring-index)))
+ (ggtags-echo "%d%s marker%s" i (pcase (mod i 10)
+ ;; ` required for 24.1 and 24.2
+ (`1 "st")
+ (`2 "nd")
+ (`3 "rd")
+ (_ "th"))
+ (if (marker-buffer m) "" " (dead)"))
+ (if (not (marker-buffer m))
+ (ding)
+ (switch-to-buffer (marker-buffer m))
+ (goto-char m))))
+
+(defun ggtags-prev-mark ()
+ "Move to the previous (older) mark in the tag marker ring."
+ (interactive)
+ (ggtags-next-mark 'previous))
+
+(defvar ggtags-view-tag-history-mode-map
+ (let ((m (make-sparse-keymap)))
+ (define-key m "\M-n" 'next-error-no-select)
+ (define-key m "\M-p" 'previous-error-no-select)
+ (define-key m "q" 'ggtags-kill-window)
+ m))
+
+(define-derived-mode ggtags-view-tag-history-mode tabulated-list-mode "TagHist"
+ :abbrev-table nil :group 'ggtags)
+
+(defun ggtags-view-tag-history ()
+ "Pop to a buffer listing visited locations from newest to oldest.
+The buffer is a next error buffer and works with standard
+commands `next-error' and `previous-error'.
+
+\\{ggtags-view-tag-history-mode-map}"
+ (interactive)
+ (and (ring-empty-p find-tag-marker-ring)
+ (user-error "Tag ring empty"))
+ (let ((split-window-preferred-function ggtags-split-window-function)
+ (inhibit-read-only t))
+ (pop-to-buffer "*Tag Ring*")
+ (erase-buffer)
+ (ggtags-view-tag-history-mode)
+ (setq next-error-function #'ggtags-view-tag-history-next-error
+ next-error-last-buffer (current-buffer))
+ (setq tabulated-list-entries
+ ;; Use a function so that revert can work properly.
+ (lambda ()
+ (let ((counter (ring-length find-tag-marker-ring))
+ (elements (or (ring-elements find-tag-marker-ring)
+ (user-error "Tag ring empty")))
+ (action (lambda (_button) (next-error 0)))
+ (get-line (lambda (m)
+ (with-current-buffer (marker-buffer m)
+ (save-excursion
+ (goto-char m)
+ (buffer-substring (line-beginning-position)
+ (line-end-position)))))))
+ (setq tabulated-list-format
+ `[("ID" ,(max (1+ (floor (log counter 10))) 2)
+ car-less-than-car)
+ ("Buffer" ,(max (cl-loop for m in elements
+ for b = (marker-buffer m)
+ maximize
+ (length (and b (buffer-name b))))
+ 6)
+ t :right-align t)
+ ("Position" ,(max (cl-loop for m in elements
+ for p = (or (marker-position m) 1)
+ maximize (1+ (floor (log p 10))))
+ 8)
+ (lambda (x y)
+ (< (string-to-number (aref (cadr x) 2))
+ (string-to-number (aref (cadr y) 2))))
+ :right-align t)
+ ("Contents" 100 t)])
+ (tabulated-list-init-header)
+ (mapcar (lambda (x)
+ (prog1
+ (list counter
+ (if (marker-buffer x)
+ (vector (number-to-string counter)
+ `(,(buffer-name (marker-buffer x))
+ face link
+ follow-link t
+ marker ,x
+ action ,action)
+ (number-to-string (marker-position x))
+ (funcall get-line x))
+ (vector (number-to-string counter)
+ "(dead)" "?" "?")))
+ (cl-decf counter)))
+ elements))))
+ (setq tabulated-list-sort-key '("ID" . t))
+ (tabulated-list-print)
+ (fit-window-to-buffer nil (floor (frame-height) 2))))
+
+(defun ggtags-view-tag-history-next-error (&optional arg reset)
+ (if (not reset)
+ (forward-button arg)
+ (goto-char (point-min))
+ (forward-button (if (button-at (point)) 0 1)))
+ (when (get-buffer-window)
+ (set-window-point (get-buffer-window) (point)))
+ (pcase (button-get (button-at (point)) 'marker)
+ ((and (pred markerp) m)
+ (if (eq (get-buffer-window) (selected-window))
+ (pop-to-buffer (marker-buffer m))
+ (switch-to-buffer (marker-buffer m)))
+ (goto-char (marker-position m)))
+ (_ (error "Dead marker"))))
+
+(defun ggtags-global-exit-message-1 ()
+ "Get the total of matches and db file used."
+ (save-excursion
+ (goto-char (point-max))
+ (if (re-search-backward
+ "^\\w+ \\(not found\\)\\|^\\([0-9]+\\) \\w+ located" nil t)
+ (cons (or (and (match-string 1) 0)
+ (string-to-number (match-string 2)))
+ (when (re-search-forward
+ "using \\(?:\\(idutils\\)\\|'[^']*/\\(\\w+\\)'\\)"
+ (line-end-position)
+ t)
+ (or (and (match-string 1) "ID")
+ (match-string 2))))
+ (cons 0 nil))))
+
+(defun ggtags-global-exit-message-function (_process-status exit-status msg)
+ "A function for `compilation-exit-message-function'."
+ (pcase (ggtags-global-exit-message-1)
+ (`(,count . ,db)
+ (setq ggtags-global-exit-info (list exit-status count db))
+ ;; Clear the start marker in case of zero matches.
+ (and (zerop count)
+ (markerp ggtags-global-start-marker)
+ (not ggtags-global-continuation)
+ (setq ggtags-global-start-marker nil))
+ (cons (if (> exit-status 0)
+ msg
+ (format "found %d %s" count
+ (funcall (if (= count 1) #'car #'cadr)
+ (pcase db
+ ;; ` required for 24.1 and 24.2
+ (`"GTAGS" '("definition" "definitions"))
+ (`"GSYMS" '("symbol" "symbols"))
+ (`"GRTAGS" '("reference" "references"))
+ (`"GPATH" '("file" "files"))
+ (`"ID" '("identifier" "identifiers"))
+ (_ '("match" "matches"))))))
+ exit-status))))
+
+(defun ggtags-global-column (start)
+ ;; START is the beginning position of source text.
+ (let ((mbeg (text-property-any start (line-end-position) 'global-color t)))
+ (and mbeg (- mbeg start))))
+
+;;; NOTE: Must not match the 'Global started at Mon Jun 3 10:24:13'
+;;; line or `compilation-auto-jump' will jump there and fail. See
+;;; comments before the 'gnu' entry in
+;;; `compilation-error-regexp-alist-alist'.
+(defvar ggtags-global-error-regexp-alist-alist
+ (append
+ `((path "^\\(?:[^\"'\n]*/\\)?[^ )\t\n]+$" 0)
+ ;; ACTIVE_ESCAPE src/dialog.cc 172
+ (ctags "^\\([^ \t\n]+\\)[ \t]+\\(.*?\\)[ \t]+\\([0-9]+\\)$"
+ 2 3 nil nil 2 (1 font-lock-function-name-face))
+ ;; ACTIVE_ESCAPE 172 src/dialog.cc #undef ACTIVE_ESCAPE
+ (ctags-x "^\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\(\\(?:[^/\n]*/\\)?[^ \t\n]+\\)"
+ 3 2 (,(lambda () (ggtags-global-column (1+ (match-end 0)))))
+ nil 3 (1 font-lock-function-name-face))
+ ;; src/dialog.cc:172:#undef ACTIVE_ESCAPE
+ (grep "^\\(.+?\\):\\([0-9]+\\):\\(?:$\\|[^0-9\n]\\|[0-9][^0-9\n]\\|[0-9][0-9].\\)"
+ 1 2 (,(lambda () (ggtags-global-column (1+ (match-end 2))))) nil 1)
+ ;; src/dialog.cc ACTIVE_ESCAPE 172 #undef ACTIVE_ESCAPE
+ (cscope "^\\(.+?\\)[ \t]+\\([^ \t\n]+\\)[ \t]+\\([0-9]+\\).*\\(?:[^0-9\n]\\|[^0-9\n][0-9]\\|[^:\n][0-9][0-9]\\)$"
+ 1 3 nil nil 1 (2 font-lock-function-name-face)))
+ compilation-error-regexp-alist-alist))
+
+(defun ggtags-abbreviate-file (start end)
+ (let ((inhibit-read-only t)
+ (amount (if (numberp ggtags-global-abbreviate-filename)
+ (- (- end start) ggtags-global-abbreviate-filename)
+ 999))
+ (advance-word (lambda ()
+ "Return the length of the text made invisible."
+ (let ((wend (min end (progn (forward-word 1) (point))))
+ (wbeg (max start (progn (backward-word 1) (point)))))
+ (goto-char wend)
+ (if (<= (- wend wbeg) 1)
+ 0
+ (put-text-property (1+ wbeg) wend 'invisible t)
+ (1- (- wend wbeg)))))))
+ (goto-char start)
+ (while (and (> amount 0) (> end (point)))
+ (cl-decf amount (funcall advance-word)))))
+
+(defun ggtags-abbreviate-files (start end)
+ (goto-char start)
+ (let* ((error-re (cdr (assq (car compilation-error-regexp-alist)
+ ggtags-global-error-regexp-alist-alist)))
+ (sub (cadr error-re)))
+ (when (and ggtags-global-abbreviate-filename error-re)
+ (while (re-search-forward (car error-re) end t)
+ (when (and (or (not (numberp ggtags-global-abbreviate-filename))
+ (> (length (match-string sub))
+ ggtags-global-abbreviate-filename))
+ ;; Ignore bogus file lines such as:
+ ;; Global found 2 matches at Thu Jan 31 13:45:19
+ (get-text-property (match-beginning sub) 'compilation-message))
+ (ggtags-abbreviate-file (match-beginning sub) (match-end sub)))))))
+
+(defvar-local ggtags-global-output-lines 0)
+
+(defun ggtags-global--display-buffer (&optional buffer desired-point)
+ (pcase (let ((buffer (or buffer (current-buffer)))
+ (split-window-preferred-function ggtags-split-window-function))
+ (and (not (get-buffer-window buffer))
+ (display-buffer buffer '(nil (allow-no-window . t)))))
+ ((and (pred windowp) w)
+ (with-selected-window w
+ (compilation-set-window-height w)
+ (and desired-point (goto-char desired-point))))))
+
+(defun ggtags-global-filter ()
+ "Called from `compilation-filter-hook' (which see)."
+ (let ((ansi-color-apply-face-function
+ (lambda (beg end face)
+ (when face
+ (ansi-color-apply-overlay-face beg end face)
+ (put-text-property beg end 'global-color t)))))
+ (ansi-color-apply-on-region compilation-filter-start (point)))
+ ;; Get rid of line "Using config file '/PATH/TO/.globalrc'." or
+ ;; "Using default configuration."
+ (when (re-search-backward
+ "^ *Using \\(?:config file '.*\\|default configuration.\\)\n"
+ compilation-filter-start t)
+ (replace-match ""))
+ (cl-incf ggtags-global-output-lines
+ (count-lines compilation-filter-start (point)))
+ ;; If the number of output lines is small
+ ;; `ggtags-global-handle-exit' takes care of displaying the buffer.
+ (when (and (> ggtags-global-output-lines 30) ggtags-navigation-mode)
+ (ggtags-global--display-buffer nil (or compilation-current-error (point-min))))
+ (when (and (eq ggtags-auto-jump-to-match 'history)
+ (numberp ggtags-auto-jump-to-match-target)
+ (not compilation-current-error)
+ ;; `ggtags-global-output-lines' is imprecise but use it
+ ;; as first approximation.
+ (> (+ 10 ggtags-global-output-lines) ggtags-auto-jump-to-match-target)
+ (> (line-number-at-pos (point-max))
+ ggtags-auto-jump-to-match-target))
+ (ggtags-forward-to-line ggtags-auto-jump-to-match-target)
+ (setq-local ggtags-auto-jump-to-match-target nil)
+ (ggtags-delay-finish-functions
+ (with-display-buffer-no-window
+ (condition-case nil
+ (let ((compilation-auto-jump-to-first-error t))
+ (compilation-auto-jump (current-buffer) (point)))
+ (error (message "\
+ggtags: history match invalid, jump to first match instead")
+ (first-error)))))
+ ;; `compilation-filter' restores point and as a result commands
+ ;; dependent on point such as `ggtags-navigation-next-file' and
+ ;; `ggtags-navigation-previous-file' fail to work.
+ (run-with-idle-timer
+ 0 nil
+ (lambda (buf pt)
+ (and (buffer-live-p buf)
+ (with-current-buffer buf (goto-char pt))))
+ (current-buffer) (point)))
+ (make-local-variable 'ggtags-global-large-output)
+ (when (> ggtags-global-output-lines ggtags-global-large-output)
+ (cl-incf ggtags-global-large-output 500)
+ (ggtags-echo "Output %d lines (Type `C-c C-k' to cancel)"
+ ggtags-global-output-lines)))
+
+(defun ggtags-global-handle-exit (buf how)
+ "A function for `compilation-finish-functions' (which see)."
+ (cond
+ (ggtags-global-continuation
+ (let ((cont (prog1 ggtags-global-continuation
+ (setq ggtags-global-continuation nil))))
+ (funcall cont buf how)))
+ ((string-prefix-p "exited abnormally" how)
+ ;; If exit abnormally display the buffer for inspection.
+ (ggtags-global--display-buffer)
+ (when (save-excursion
+ (goto-char (point-max))
+ (re-search-backward
+ (eval-when-compile
+ (format "^global: %s not found.$"
+ (regexp-opt '("GTAGS" "GRTAGS" "GSYMS" "GPATH"))))
+ nil t))
+ (ggtags-echo "WARNING: Global tag files missing in `%s'"
+ ggtags-project-root)
+ (remhash ggtags-project-root ggtags-projects)))
+ (ggtags-auto-jump-to-match
+ (if (pcase (compilation-next-single-property-change
+ (point-min) 'compilation-message)
+ ((and pt (guard pt))
+ (compilation-next-single-property-change
+ (save-excursion (goto-char pt) (end-of-line) (point))
+ 'compilation-message)))
+ ;; There are multiple matches so pop up the buffer.
+ (and ggtags-navigation-mode (ggtags-global--display-buffer))
+ ;; For the `compilation-auto-jump' in idle timer to run.
+ ;; See also: http://debbugs.gnu.org/13829
+ (sit-for 0)
+ (ggtags-navigation-mode -1)
+ (ggtags-navigation-mode-cleanup buf 0)))))
+
+(defvar ggtags-global-mode-font-lock-keywords
+ '(("^Global \\(exited abnormally\\|interrupt\\|killed\\|terminated\\)\\(?:.*with code \\([0-9]+\\)\\)?.*"
+ (1 'compilation-error)
+ (2 'compilation-error nil t))
+ ("^Global found \\([0-9]+\\)" (1 compilation-info-face))))
+
+(defvar compilation-always-kill) ;new in 24.3
+
+(define-compilation-mode ggtags-global-mode "Global"
+ "A mode for showing outputs from gnu global."
+ ;; Note: Place `ggtags-global-output-format' as first element for
+ ;; `ggtags-abbreviate-files'.
+ (setq-local compilation-error-regexp-alist (list ggtags-global-output-format))
+ (when (markerp ggtags-global-start-marker)
+ (setq ggtags-project-root
+ (buffer-local-value 'ggtags-project-root
+ (marker-buffer ggtags-global-start-marker))))
+ (pcase ggtags-auto-jump-to-match
+ (`history (make-local-variable 'ggtags-auto-jump-to-match-target)
+ (setq-local compilation-auto-jump-to-first-error
+ (not ggtags-auto-jump-to-match-target)))
+ (`nil (setq-local compilation-auto-jump-to-first-error nil))
+ (_ (setq-local compilation-auto-jump-to-first-error t)))
+ (setq-local compilation-scroll-output nil)
+ ;; See `compilation-move-to-column' for details.
+ (setq-local compilation-first-column 0)
+ (setq-local compilation-error-screen-columns nil)
+ (setq-local compilation-disable-input t)
+ (setq-local compilation-always-kill t)
+ (setq-local compilation-error-face 'compilation-info)
+ (setq-local compilation-exit-message-function
+ 'ggtags-global-exit-message-function)
+ ;; See: https://github.com/leoliu/ggtags/issues/26
+ (setq-local find-file-suppress-same-file-warnings t)
+ (setq-local truncate-lines t)
+ (jit-lock-register #'ggtags-abbreviate-files)
+ (add-hook 'compilation-filter-hook 'ggtags-global-filter nil 'local)
+ (add-hook 'compilation-finish-functions 'ggtags-global-handle-exit nil t)
+ (setq-local bookmark-make-record-function #'ggtags-make-bookmark-record)
+ (setq-local ggtags-enable-navigation-keys nil)
+ (add-hook 'kill-buffer-hook (lambda () (ggtags-navigation-mode -1)) nil t))
+
+;; NOTE: Need this to avoid putting menu items in
+;; `emulation-mode-map-alists', which creates double entries. See
+;; http://i.imgur.com/VJJTzVc.png
+(defvar ggtags-navigation-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\M-n" 'next-error)
+ (define-key map "\M-p" 'previous-error)
+ (define-key map "\M-}" 'ggtags-navigation-next-file)
+ (define-key map "\M-{" 'ggtags-navigation-previous-file)
+ (define-key map "\M-=" 'ggtags-navigation-start-file)
+ (define-key map "\M->" 'ggtags-navigation-last-error)
+ (define-key map "\M-<" 'first-error)
+ ;; Note: shadows `isearch-forward-regexp' but it can still be
+ ;; invoked with `C-u C-s'.
+ (define-key map "\C-\M-s" 'ggtags-navigation-isearch-forward)
+ ;; Add an alternative binding because C-M-s is reported not
+ ;; working on some systems.
+ (define-key map "\M-ss" 'ggtags-navigation-isearch-forward)
+ (define-key map "\C-c\C-k"
+ (lambda () (interactive)
+ (ggtags-ensure-global-buffer (kill-compilation))))
+ (define-key map "\M-o" 'ggtags-navigation-visible-mode)
+ (define-key map [return] 'ggtags-navigation-mode-done)
+ (define-key map "\r" 'ggtags-navigation-mode-done)
+ (define-key map [remap pop-tag-mark] 'ggtags-navigation-mode-abort)
+ map))
+
+(defvar ggtags-mode-map-alist
+ `((ggtags-enable-navigation-keys . ,ggtags-navigation-map)))
+
+(defvar ggtags-navigation-mode-map
+ (let ((map (make-sparse-keymap))
+ (menu (make-sparse-keymap "GG-Navigation")))
+ ;; Menu items: (info "(elisp)Extended Menu Items")
+ (define-key map [menu-bar ggtags-navigation] (cons "GG-Navigation" menu))
+ ;; Ordered backwards
+ (define-key menu [visible-mode]
+ '(menu-item "Visible mode" ggtags-navigation-visible-mode
+ :button (:toggle . (ignore-errors
+ (ggtags-ensure-global-buffer
+ visible-mode)))))
+ (define-key menu [done]
+ '(menu-item "Finish navigation" ggtags-navigation-mode-done))
+ (define-key menu [abort]
+ '(menu-item "Abort" ggtags-navigation-mode-abort))
+ (define-key menu [last-match]
+ '(menu-item "Last match" ggtags-navigation-last-error))
+ (define-key menu [first-match] '(menu-item "First match" first-error))
+ (define-key menu [previous-file]
+ '(menu-item "Previous file" ggtags-navigation-previous-file))
+ (define-key menu [next-file]
+ '(menu-item "Next file" ggtags-navigation-next-file))
+ (define-key menu [isearch-forward]
+ '(menu-item "Find match with isearch" ggtags-navigation-isearch-forward))
+ (define-key menu [previous]
+ '(menu-item "Previous match" previous-error))
+ (define-key menu [next]
+ '(menu-item "Next match" next-error))
+ map))
+
+(defun ggtags-move-to-tag (&optional name)
+ "Move to NAME tag in current line."
+ (let ((tag (or name ggtags-current-tag-name)))
+ ;; Do nothing if on the tag already i.e. by `ggtags-global-column'.
+ (unless (or (not tag) (looking-at (concat (regexp-quote tag) "\\_>")))
+ (let ((orig (point))
+ (regexps (mapcar (lambda (fmtstr)
+ (format fmtstr (regexp-quote tag)))
+ '("\\_<%s\\_>" "%s\\_>" "%s"))))
+ (beginning-of-line)
+ (if (cl-loop for re in regexps
+ ;; Note: tag might not agree with current
+ ;; major-mode's symbol, so try harder. For
+ ;; example, in `php-mode' $cacheBackend is a
+ ;; symbol, but cacheBackend is a tag.
+ thereis (re-search-forward re (line-end-position) t))
+ (goto-char (match-beginning 0))
+ (goto-char orig))))))
+
+(defun ggtags-navigation-mode-cleanup (&optional buf time)
+ (let ((buf (or buf ggtags-global-last-buffer)))
+ (and (buffer-live-p buf)
+ (with-current-buffer buf
+ (when (get-buffer-process (current-buffer))
+ (kill-compilation))
+ (when (and (derived-mode-p 'ggtags-global-mode)
+ (get-buffer-window))
+ (quit-windows-on (current-buffer)))
+ (and time (run-with-idle-timer time nil #'kill-buffer buf))))))
+
+(defun ggtags-navigation-mode-done ()
+ (interactive)
+ (ggtags-navigation-mode -1)
+ (setq tags-loop-scan t
+ tags-loop-operate '(ggtags-find-tag-continue))
+ (ggtags-navigation-mode-cleanup))
+
+(defun ggtags-navigation-mode-abort ()
+ "Abort navigation and return to where the search was started."
+ (interactive)
+ (ggtags-navigation-mode -1)
+ (ggtags-navigation-mode-cleanup nil 0)
+ ;; Run after (ggtags-navigation-mode -1) or
+ ;; ggtags-global-start-marker might not have been saved.
+ (when (and ggtags-global-start-marker
+ (not (markerp ggtags-global-start-marker)))
+ (setq ggtags-global-start-marker nil)
+ (pop-tag-mark)))
+
+(defun ggtags-navigation-next-file (n)
+ (interactive "p")
+ (ggtags-ensure-global-buffer
+ (compilation-next-file n)
+ (compile-goto-error)))
+
+(defun ggtags-navigation-previous-file (n)
+ (interactive "p")
+ (ggtags-navigation-next-file (- n)))
+
+(defun ggtags-navigation-start-file ()
+ "Move to the file where navigation session starts."
+ (interactive)
+ (let ((start-file (or ggtags-global-start-file
+ (user-error "Cannot decide start file"))))
+ (ggtags-ensure-global-buffer
+ (pcase (cl-block nil
+ (ggtags-foreach-file
+ (lambda (file)
+ (when (file-equal-p file start-file)
+ (cl-return (point))))))
+ (`nil (user-error "No matches for `%s'" start-file))
+ (n (goto-char n) (compile-goto-error))))))
+
+(defun ggtags-navigation-last-error ()
+ (interactive)
+ (ggtags-ensure-global-buffer
+ (goto-char (point-max))
+ (compilation-previous-error 1)
+ (compile-goto-error)))
+
+(defun ggtags-navigation-isearch-forward (&optional regexp-p)
+ (interactive "P")
+ (ggtags-ensure-global-buffer
+ (let ((saved (if visible-mode 1 -1)))
+ (visible-mode 1)
+ (with-selected-window (get-buffer-window (current-buffer))
+ (isearch-forward regexp-p)
+ (beginning-of-line)
+ (visible-mode saved)
+ (compile-goto-error)))))
+
+(defun ggtags-navigation-visible-mode (&optional arg)
+ (interactive (list (or current-prefix-arg 'toggle)))
+ (ggtags-ensure-global-buffer
+ (visible-mode arg)))
+
+(defvar ggtags-global-line-overlay nil)
+
+(defun ggtags-global-next-error-function ()
+ (when (eq next-error-last-buffer ggtags-global-last-buffer)
+ (ggtags-move-to-tag)
+ (ggtags-global-save-start-marker)
+ (and (ggtags-project-update-mtime-maybe)
+ (message "File `%s' is newer than GTAGS"
+ (file-name-nondirectory buffer-file-name)))
+ (and ggtags-mode-sticky (ggtags-mode 1))
+ (ignore-errors
+ (ggtags-ensure-global-buffer
+ (unless (overlayp ggtags-global-line-overlay)
+ (setq ggtags-global-line-overlay (make-overlay (point) (point)))
+ (overlay-put ggtags-global-line-overlay 'face 'ggtags-global-line))
+ (move-overlay ggtags-global-line-overlay
+ (line-beginning-position) (line-end-position)
+ (current-buffer))
+ ;; Update search history
+ (let ((id (ggtags-global-search-id (car compilation-arguments)
+ default-directory)))
+ (setq ggtags-global-search-history
+ (cl-remove id ggtags-global-search-history :test #'equal :key #'car))
+ (add-to-history 'ggtags-global-search-history
+ (cons id (ggtags-global-current-search))
+ ggtags-global-history-length))))
+ (run-hooks 'ggtags-find-tag-hook)))
+
+(put 'ggtags-navigation-mode-lighter 'risky-local-variable t)
+
+(defvar ggtags-navigation-mode-lighter
+ '(" GG["
+ (:eval
+ (if (not (buffer-live-p ggtags-global-last-buffer))
+ '(:propertize "??" face error help-echo "No Global buffer")
+ (with-current-buffer ggtags-global-last-buffer
+ (pcase (or ggtags-global-exit-info '(0 0 ""))
+ (`(,exit ,count ,db)
+ `((:propertize ,(pcase db
+ (`"GTAGS" "D")
+ (`"GRTAGS" "R")
+ (`"GSYMS" "S")
+ (`"GPATH" "F")
+ (`"ID" "I"))
+ face success)
+ (:propertize
+ ,(pcase (get-text-property (line-beginning-position)
+ 'compilation-message)
+ (`nil "?")
+ ;; Assume the first match appears at line 5
+ (_ (number-to-string (- (line-number-at-pos) 4))))
+ face success)
+ "/"
+ (:propertize ,(number-to-string count) face success)
+ ,(unless (zerop exit)
+ `(":" (:propertize ,(number-to-string exit) face error)))))))))
+ "]")
+ "Ligher for `ggtags-navigation-mode'; set to nil to disable it.")
+
+(define-minor-mode ggtags-navigation-mode nil
+ :lighter ggtags-navigation-mode-lighter
+ :global t
+ (if ggtags-navigation-mode
+ (progn
+ ;; Higher priority for `ggtags-navigation-mode' to avoid being
+ ;; hijacked by modes such as `view-mode'.
+ (add-to-list 'emulation-mode-map-alists 'ggtags-mode-map-alist)
+ (add-hook 'next-error-hook 'ggtags-global-next-error-function)
+ (add-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function))
+ (setq emulation-mode-map-alists
+ (delq 'ggtags-mode-map-alist emulation-mode-map-alists))
+ (remove-hook 'next-error-hook 'ggtags-global-next-error-function)
+ (remove-hook 'minibuffer-setup-hook 'ggtags-minibuffer-setup-function)))
+
+(defun ggtags-minibuffer-setup-function ()
+ ;; Disable ggtags-navigation-mode in minibuffer.
+ (setq-local ggtags-enable-navigation-keys nil))
+
+(defun ggtags-kill-file-buffers (&optional interactive)
+ "Kill all buffers visiting files in current project."
+ (interactive "p")
+ (ggtags-check-project)
+ (let ((directories (cons (ggtags-current-project-root) (ggtags-get-libpath)))
+ (count 0))
+ (dolist (buf (buffer-list))
+ (let ((file (and (buffer-live-p buf)
+ (not (eq buf (current-buffer)))
+ (buffer-file-name buf))))
+ (when (and file (cl-some (lambda (dir)
+ ;; Don't use `file-in-directory-p'
+ ;; to allow symbolic links.
+ (string-prefix-p dir file))
+ directories))
+ (and (kill-buffer buf) (cl-incf count)))))
+ (and interactive
+ (message "%d %s killed" count (if (= count 1) "buffer" "buffers")))))
+
+(defun ggtags-after-save-function ()
+ (when (ggtags-find-project)
+ (ggtags-project-update-mtime-maybe)
+ (and buffer-file-name ggtags-update-on-save
+ (ggtags-update-tags-single buffer-file-name 'nowait))))
+
+(defun ggtags-global-output (buffer cmds callback &optional cutoff)
+ "Asynchronously pipe the output of running CMDS to BUFFER.
+When finished invoke CALLBACK in BUFFER with process exit status."
+ (or buffer (error "Output buffer required"))
+ (when (get-buffer-process (get-buffer buffer))
+ ;; Notice running multiple processes in the same buffer so that we
+ ;; can fix the caller. See for example `ggtags-eldoc-function'.
+ (message "Warning: detected %S already running in %S; interrupting..."
+ (get-buffer-process buffer) buffer)
+ (interrupt-process (get-buffer-process buffer)))
+ (let* ((program (car cmds))
+ (args (cdr cmds))
+ (cutoff (and cutoff (+ cutoff (if (get-buffer buffer)
+ (with-current-buffer buffer
+ (line-number-at-pos (point-max)))
+ 0))))
+ (proc (apply #'start-file-process program buffer program args))
+ (filter (lambda (proc string)
+ (and (buffer-live-p (process-buffer proc))
+ (with-current-buffer (process-buffer proc)
+ (goto-char (process-mark proc))
+ (insert string)
+ (when (and (> (line-number-at-pos (point-max)) cutoff)
+ (process-live-p proc))
+ (interrupt-process (current-buffer)))))))
+ (sentinel (lambda (proc _msg)
+ (when (memq (process-status proc) '(exit signal))
+ (with-current-buffer (process-buffer proc)
+ (set-process-buffer proc nil)
+ (funcall callback (process-exit-status proc)))))))
+ (set-process-query-on-exit-flag proc nil)
+ (and cutoff (set-process-filter proc filter))
+ (set-process-sentinel proc sentinel)
+ proc))
+
+(cl-defun ggtags-fontify-code (code &optional (mode major-mode))
+ (cl-check-type mode function)
+ (cl-typecase code
+ ((not string) code)
+ (string (cl-labels ((prepare-buffer ()
+ (with-current-buffer
+ (get-buffer-create " *Code-Fontify*")
+ (delay-mode-hooks (funcall mode))
+ (setq font-lock-mode t)
+ (funcall font-lock-function font-lock-mode)
+ (setq jit-lock-mode nil)
+ (current-buffer))))
+ (with-current-buffer (prepare-buffer)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert code)
+ (font-lock-default-fontify-region
+ (point-min) (point-max) nil))
+ (buffer-string))))))
+
+(defun ggtags-get-definition-default (defs)
+ (and (caar defs)
+ (concat (ggtags-fontify-code (caar defs))
+ (and (cdr defs) " [guess]"))))
+
+(defun ggtags-show-definition (name)
+ (interactive (list (ggtags-read-tag 'definition current-prefix-arg)))
+ (ggtags-check-project)
+ (let* ((re (cadr (assq 'grep ggtags-global-error-regexp-alist-alist)))
+ (current (current-buffer))
+ (buffer (get-buffer-create " *ggtags-definition*"))
+ ;; Need these bindings so that let-binding
+ ;; `ggtags-print-definition-function' can work see
+ ;; `ggtags-eldoc-function'.
+ (get-fn ggtags-get-definition-function)
+ (print-fn ggtags-print-definition-function)
+ (show (lambda (_status)
+ (goto-char (point-min))
+ (let ((defs (cl-loop while (re-search-forward re nil t)
+ collect (list (buffer-substring (1+ (match-end 2))
+ (line-end-position))
+ name
+ (match-string 1)
+ (string-to-number (match-string 2))))))
+ (kill-buffer buffer)
+ (with-current-buffer current
+ (funcall print-fn (funcall get-fn defs)))))))
+ (ggtags-with-current-project
+ (ggtags-global-output
+ buffer
+ (list (ggtags-program-path "global")
+ "--result=grep" "--path-style=absolute" name)
+ show 100))))
+
+(defvar ggtags-mode-prefix-map
+ (let ((m (make-sparse-keymap)))
+ ;; Globally bound to `M-g p'.
+ ;; (define-key m "\M-'" 'previous-error)
+ (define-key m (kbd "M-DEL") 'ggtags-delete-tags)
+ (define-key m "\M-p" 'ggtags-prev-mark)
+ (define-key m "\M-n" 'ggtags-next-mark)
+ (define-key m "\M-f" 'ggtags-find-file)
+ (define-key m "\M-o" 'ggtags-find-other-symbol)
+ (define-key m "\M-g" 'ggtags-grep)
+ (define-key m "\M-i" 'ggtags-idutils-query)
+ (define-key m "\M-b" 'ggtags-browse-file-as-hypertext)
+ (define-key m "\M-k" 'ggtags-kill-file-buffers)
+ (define-key m "\M-h" 'ggtags-view-tag-history)
+ (define-key m "\M-j" 'ggtags-visit-project-root)
+ (define-key m "\M-/" 'ggtags-view-search-history)
+ (define-key m (kbd "M-SPC") 'ggtags-save-to-register)
+ (define-key m (kbd "M-%") 'ggtags-query-replace)
+ (define-key m "\M-?" 'ggtags-show-definition)
+ m))
+
+(defvar ggtags-mode-map
+ (let ((map (make-sparse-keymap))
+ (menu (make-sparse-keymap "Ggtags")))
+ (define-key map "\M-." 'ggtags-find-tag-dwim)
+ (define-key map (kbd "M-]") 'ggtags-find-reference)
+ (define-key map (kbd "C-M-.") 'ggtags-find-tag-regexp)
+ (define-key map ggtags-mode-prefix-key ggtags-mode-prefix-map)
+ ;; Menu items
+ (define-key map [menu-bar ggtags] (cons "Ggtags" menu))
+ ;; Ordered backwards
+ (define-key menu [report-bugs]
+ `(menu-item "Report bugs"
+ (lambda () (interactive)
+ (browse-url ggtags-bug-url)
+ (message "Please visit %s" ggtags-bug-url))
+ :help ,(format "Visit %s" ggtags-bug-url)))
+ (define-key menu [custom-ggtags]
+ '(menu-item "Customize Ggtags"
+ (lambda () (interactive) (customize-group 'ggtags))))
+ (define-key menu [eldoc-mode]
+ '(menu-item "Toggle eldoc mode" eldoc-mode :button (:toggle . eldoc-mode)))
+ (define-key menu [save-project]
+ '(menu-item "Save project settings" ggtags-save-project-settings))
+ (define-key menu [toggle-read-only]
+ '(menu-item "Toggle project read-only" ggtags-toggle-project-read-only
+ :button (:toggle . buffer-read-only)))
+ (define-key menu [visit-project-root]
+ '(menu-item "Visit project root" ggtags-visit-project-root))
+ (define-key menu [sep2] menu-bar-separator)
+ (define-key menu [browse-hypertext]
+ '(menu-item "Browse as hypertext" ggtags-browse-file-as-hypertext
+ :enable (ggtags-find-project)))
+ (define-key menu [delete-tags]
+ '(menu-item "Delete tags" ggtags-delete-tags
+ :enable (ggtags-find-project)
+ :help "Delete file GTAGS, GRTAGS, GPATH, ID etc."))
+ (define-key menu [kill-buffers]
+ '(menu-item "Kill project file buffers" ggtags-kill-file-buffers
+ :enable (ggtags-find-project)))
+ (define-key menu [view-tag]
+ '(menu-item "View tag history" ggtags-view-tag-history))
+ (define-key menu [pop-mark]
+ '(menu-item "Pop mark" pop-tag-mark
+ :help "Pop to previous mark and destroy it"))
+ (define-key menu [next-mark]
+ '(menu-item "Next mark" ggtags-next-mark))
+ (define-key menu [prev-mark]
+ '(menu-item "Previous mark" ggtags-prev-mark))
+ (define-key menu [sep1] menu-bar-separator)
+ (define-key menu [previous-error]
+ '(menu-item "Previous match" previous-error))
+ (define-key menu [next-error]
+ '(menu-item "Next match" next-error))
+ (define-key menu [rerun-search]
+ '(menu-item "View past searches" ggtags-view-search-history))
+ (define-key menu [save-to-register]
+ '(menu-item "Save search to register" ggtags-save-to-register))
+ (define-key menu [find-file]
+ '(menu-item "Find files" ggtags-find-file))
+ (define-key menu [query-replace]
+ '(menu-item "Query replace" ggtags-query-replace))
+ (define-key menu [idutils]
+ '(menu-item "Query idutils DB" ggtags-idutils-query))
+ (define-key menu [grep]
+ '(menu-item "Grep" ggtags-grep))
+ (define-key menu [find-symbol]
+ '(menu-item "Find other symbol" ggtags-find-other-symbol
+ :help "Find references without definition"))
+ (define-key menu [find-tag-regexp]
+ '(menu-item "Find tag matching regexp" ggtags-find-tag-regexp))
+ (define-key menu [show-definition]
+ '(menu-item "Show definition" ggtags-show-definition))
+ (define-key menu [find-reference]
+ '(menu-item "Find reference" ggtags-find-reference))
+ (define-key menu [find-tag-continue]
+ '(menu-item "Continue find tag" tags-loop-continue))
+ (define-key menu [find-tag]
+ '(menu-item "Find tag" ggtags-find-tag-dwim))
+ (define-key menu [update-tags]
+ '(menu-item "Update tag files" ggtags-update-tags
+ :visible (ggtags-find-project)))
+ (define-key menu [run-gtags]
+ '(menu-item "Run gtags" ggtags-create-tags
+ :visible (not (ggtags-find-project))))
+ map))
+
+(defvar ggtags-mode-line-project-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mode-line mouse-1] 'ggtags-visit-project-root)
+ map))
+
+(put 'ggtags-mode-line-project-name 'risky-local-variable t)
+(defvar ggtags-mode-line-project-name
+ '("[" (:eval (let ((name (if (stringp ggtags-project-root)
+ (file-name-nondirectory
+ (directory-file-name ggtags-project-root))
+ "?")))
+ (propertize
+ name 'face compilation-info-face
+ 'help-echo (if (stringp ggtags-project-root)
+ (concat "mouse-1 to visit " ggtags-project-root)
+ "mouse-1 to set project")
+ 'mouse-face 'mode-line-highlight
+ 'keymap ggtags-mode-line-project-keymap)))
+ "]")
+ "Mode line construct for displaying current project name.
+The value is the name of the project root directory. Setting it
+to nil disables displaying this information.")
+
+;;;###autoload
+(define-minor-mode ggtags-mode nil
+ :lighter (:eval (if ggtags-navigation-mode "" " GG"))
+ (ggtags-setup-highlight-tag-at-point ggtags-highlight-tag)
+ (if ggtags-mode
+ (progn
+ (add-hook 'after-save-hook 'ggtags-after-save-function nil t)
+ ;; Append to serve as a fallback method.
+ (add-hook 'completion-at-point-functions
+ #'ggtags-completion-at-point t t)
+ ;; Work around http://debbugs.gnu.org/19324
+ (or eldoc-documentation-function
+ (setq-local eldoc-documentation-function #'ignore))
+ (add-function :after-until (local 'eldoc-documentation-function)
+ #'ggtags-eldoc-function '((name . ggtags-eldoc-function)
+ (depth . -100)))
+ (unless (memq 'ggtags-mode-line-project-name
+ mode-line-buffer-identification)
+ (setq mode-line-buffer-identification
+ (append mode-line-buffer-identification
+ '(ggtags-mode-line-project-name)))))
+ (remove-hook 'after-save-hook 'ggtags-after-save-function t)
+ (remove-hook 'completion-at-point-functions #'ggtags-completion-at-point t)
+ (remove-function (local 'eldoc-documentation-function) 'ggtags-eldoc-function)
+ (setq mode-line-buffer-identification
+ (delq 'ggtags-mode-line-project-name mode-line-buffer-identification))
+ (ggtags-cancel-highlight-tag-at-point 'keep-timer)))
+
+(defvar ggtags-highlight-tag-map
+ (let ((map (make-sparse-keymap)))
+ ;; Bind down- events so that the global keymap won't ``shine
+ ;; through''. See `mode-line-buffer-identification-keymap' for
+ ;; similar workaround.
+ (define-key map [S-mouse-1] 'ggtags-find-tag-dwim)
+ (define-key map [S-down-mouse-1] 'ignore)
+ (define-key map [S-mouse-3] 'ggtags-find-reference)
+ (define-key map [S-down-mouse-3] 'ignore)
+ map)
+ "Keymap used for valid tag at point.")
+
+(put 'ggtags-active-tag 'face 'ggtags-highlight)
+(put 'ggtags-active-tag 'keymap ggtags-highlight-tag-map)
+;; (put 'ggtags-active-tag 'mouse-face 'match)
+(put 'ggtags-active-tag 'help-echo
+ "S-mouse-1 for definitions\nS-mouse-3 for references")
+
+(defun ggtags-setup-highlight-tag-at-point (flag)
+ (cond ((null flag) (ggtags-cancel-highlight-tag-at-point))
+ ((not (timerp ggtags-highlight-tag-timer))
+ (setq ggtags-highlight-tag-timer
+ (run-with-idle-timer flag t #'ggtags-highlight-tag-at-point)))
+ (t (timer-set-idle-time ggtags-highlight-tag-timer flag t))))
+
+(defun ggtags-cancel-highlight-tag-at-point (&optional keep-timer)
+ (when (and (not keep-timer)
+ (timerp ggtags-highlight-tag-timer))
+ (cancel-timer ggtags-highlight-tag-timer)
+ (setq ggtags-highlight-tag-timer nil))
+ (when ggtags-highlight-tag-overlay
+ (delete-overlay ggtags-highlight-tag-overlay)
+ (setq ggtags-highlight-tag-overlay nil)))
+
+(defun ggtags-highlight-tag-at-point ()
+ (when (and ggtags-mode ggtags-project-root (ggtags-find-project))
+ (unless (overlayp ggtags-highlight-tag-overlay)
+ (setq ggtags-highlight-tag-overlay (make-overlay (point) (point) nil t))
+ (overlay-put ggtags-highlight-tag-overlay 'modification-hooks
+ (list (lambda (o after &rest _args)
+ (and (not after) (delete-overlay o))))))
+ (let ((bounds (funcall ggtags-bounds-of-tag-function))
+ (o ggtags-highlight-tag-overlay))
+ (cond
+ ((and bounds
+ (eq (overlay-buffer o) (current-buffer))
+ (= (overlay-start o) (car bounds))
+ (= (overlay-end o) (cdr bounds)))
+ ;; Overlay matches current tag so do nothing.
+ nil)
+ ((and bounds (let ((completion-ignore-case nil))
+ (test-completion
+ (buffer-substring (car bounds) (cdr bounds))
+ ggtags-completion-table)))
+ (move-overlay o (car bounds) (cdr bounds) (current-buffer))
+ (overlay-put o 'category 'ggtags-active-tag))
+ (t (move-overlay o
+ (or (car bounds) (point))
+ (or (cdr bounds) (point))
+ (current-buffer))
+ (overlay-put o 'category nil))))))
+
+;;; eldoc
+
+(defvar-local ggtags-eldoc-cache nil)
+
+(declare-function eldoc-message "eldoc")
+(defun ggtags-eldoc-function ()
+ "A function suitable for `eldoc-documentation-function' (which see)."
+ (pcase (ggtags-tag-at-point)
+ (`nil nil)
+ (tag (if (equal tag (car ggtags-eldoc-cache))
+ (cadr ggtags-eldoc-cache)
+ (and ggtags-project-root (ggtags-find-project)
+ (let* ((ggtags-print-definition-function
+ (lambda (s)
+ (setq ggtags-eldoc-cache (list tag s))
+ (eldoc-message s))))
+ ;; Prevent multiple runs of ggtags-show-definition
+ ;; for the same tag.
+ (setq ggtags-eldoc-cache (list tag))
+ (condition-case err
+ (ggtags-show-definition tag)
+ (file-error
+ (remove-function (local 'eldoc-documentation-function)
+ 'ggtags-eldoc-function)
+ (message "\
+Function `ggtags-eldoc-function' disabled for eldoc in current buffer: %S" err)))
+ nil))))))
+
+;;; imenu
+
+(defun ggtags-goto-imenu-index (name line &rest _args)
+ (ggtags-forward-to-line line)
+ (ggtags-move-to-tag name))
+
+;;;###autoload
+(defun ggtags-build-imenu-index ()
+ "A function suitable for `imenu-create-index-function'."
+ (let ((file (and buffer-file-name (file-relative-name buffer-file-name))))
+ (and file (with-temp-buffer
+ (when (with-demoted-errors "ggtags-build-imenu-index: %S"
+ (zerop (ggtags-with-current-project
+ (process-file (ggtags-program-path "global")
+ nil t nil "-x" "-f" file))))
+ (goto-char (point-min))
+ (cl-loop while (re-search-forward
+ "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)" nil t)
+ collect (list (match-string 1)
+ (string-to-number (match-string 2))
+ 'ggtags-goto-imenu-index)))))))
+
+;;; hippie-expand
+
+;;;###autoload
+(defun ggtags-try-complete-tag (old)
+ "A function suitable for `hippie-expand-try-functions-list'."
+ (eval-and-compile (require 'hippie-exp))
+ (unless old
+ (he-init-string (or (car (funcall ggtags-bounds-of-tag-function)) (point))
+ (point))
+ (setq he-expand-list
+ (and (not (equal he-search-string ""))
+ (ggtags-find-project)
+ (sort (all-completions he-search-string
+ ggtags-completion-table)
+ #'string-lessp))))
+ (if (null he-expand-list)
+ (progn
+ (if old (he-reset-string))
+ nil)
+ (he-substitute-string (car he-expand-list))
+ (setq he-expand-list (cdr he-expand-list))
+ t))
+
+(defun ggtags-reload (&optional force)
+ (interactive "P")
+ (unload-feature 'ggtags force)
+ (require 'ggtags))
+
+(provide 'ggtags)
+;;; ggtags.el ends here
All commands are available from the `Ggtags' menu in `ggtags-mode'.
-NEWS 0.8.10 (2015-06-12):
+NEWS 0.8.11 (2015-12-15):
-- Tags update on save is configurable by `ggtags-update-on-save'.
-- New command `ggtags-explain-tags' to explain how each file is
- indexed in current project.
-- New user option `ggtags-sort-by-nearness' that sorts matched tags
- by nearness to current directory.
+- `ggtags-highlight-tag-delay' is renamed to `ggtags-highlight-tag'
+- Tag highlighting can be disabled by setting
+ `ggtags-highlight-tag' to nil.
See full NEWS on https://github.com/leoliu/ggtags#news
+++ /dev/null
-;;; helm-gtags-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
-\f
-;;;### (autoloads nil "helm-gtags" "helm-gtags.el" (22057 58110 0
-;;;;;; 0))
-;;; Generated autoloads from helm-gtags.el
-
-(autoload 'helm-gtags-clear-all-cache "helm-gtags" "\
-
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-clear-cache "helm-gtags" "\
-
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-next-history "helm-gtags" "\
-Jump to next position on context stack
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-previous-history "helm-gtags" "\
-Jump to previous position on context stack
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-select "helm-gtags" "\
-
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-select-path "helm-gtags" "\
-
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-tags-in-this-function "helm-gtags" "\
-Show tagnames which are referenced in this function and jump to it.
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-create-tags "helm-gtags" "\
-
-
-\(fn DIR LABEL)" t nil)
-
-(autoload 'helm-gtags-find-tag "helm-gtags" "\
-Jump to definition
-
-\(fn TAG)" t nil)
-
-(autoload 'helm-gtags-find-tag-other-window "helm-gtags" "\
-Jump to definition in other window.
-
-\(fn TAG)" t nil)
-
-(autoload 'helm-gtags-find-rtag "helm-gtags" "\
-Jump to referenced point
-
-\(fn TAG)" t nil)
-
-(autoload 'helm-gtags-find-symbol "helm-gtags" "\
-Jump to the symbol location
-
-\(fn TAG)" t nil)
-
-(autoload 'helm-gtags-find-pattern "helm-gtags" "\
-Grep and jump by gtags tag files.
-
-\(fn PATTERN)" t nil)
-
-(autoload 'helm-gtags-find-files "helm-gtags" "\
-Find file from tagged with gnu global.
-
-\(fn FILE)" t nil)
-
-(autoload 'helm-gtags-find-tag-from-here "helm-gtags" "\
-Jump point by current point information.
-Jump to definition point if cursor is on its reference.
-Jump to reference point if curosr is on its definition
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-dwim "helm-gtags" "\
-Find by context. Here is
-- on include statement then jump to included file
-- on symbol definition then jump to its references
-- on reference point then jump to its definition.
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-parse-file "helm-gtags" "\
-Parse current file with gnu global. This is similar to `imenu'.
-You can jump definitions of functions, symbols in this file.
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-pop-stack "helm-gtags" "\
-Jump to previous point on the context stack and pop it from stack.
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-show-stack "helm-gtags" "\
-Show current context stack.
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-clear-stack "helm-gtags" "\
-Clear current context stack.
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-clear-all-stacks "helm-gtags" "\
-Clear all context stacks.
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-update-tags "helm-gtags" "\
-Update TAG file. Update All files with `C-u' prefix.
-Generate new TAG file in selected directory with `C-u C-u'
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-resume "helm-gtags" "\
-Resurrect previously invoked `helm-gtags` command.
-
-\(fn)" t nil)
-
-(autoload 'helm-gtags-mode "helm-gtags" "\
-Toggle Helm-Gtags mode on or off.
-With a prefix argument ARG, enable Helm-Gtags mode if ARG is
-positive, and disable it otherwise. If called from Lisp, enable
-the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
-\\{helm-gtags-mode-map}
-
-\(fn &optional ARG)" t nil)
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; End:
-;;; helm-gtags-autoloads.el ends here
+++ /dev/null
-(define-package "helm-gtags" "20151016.201" "GNU GLOBAL helm interface" '((helm "1.5.6") (cl-lib "0.5")) :url "https://github.com/syohex/emacs-helm-gtags")
+++ /dev/null
-;;; helm-gtags.el --- GNU GLOBAL helm interface -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2015 by Syohei YOSHIDA
-
-;; Author: Syohei YOSHIDA <syohexNOSPAMgmail.com>
-;; URL: https://github.com/syohex/emacs-helm-gtags
-;; Package-Version: 20151016.201
-;; Version: 1.4.9
-;; Package-Requires: ((helm "1.5.6") (cl-lib "0.5"))
-
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with this program. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;; `helm-gtags.el' is a `helm' interface of GNU Global.
-;; `helm-gtags.el' is not compatible `anything-gtags.el', but `helm-gtags.el'
-;; is designed for fast search.
-
-;;
-;; To use this package, add these lines to your init.el or .emacs file:
-;;
-;; ;; Enable helm-gtags-mode
-;; (add-hook 'c-mode-hook 'helm-gtags-mode)
-;; (add-hook 'c++-mode-hook 'helm-gtags-mode)
-;; (add-hook 'asm-mode-hook 'helm-gtags-mode)
-;;
-;; ;; Set key bindings
-;; (eval-after-load "helm-gtags"
-;; '(progn
-;; (define-key helm-gtags-mode-map (kbd "M-t") 'helm-gtags-find-tag)
-;; (define-key helm-gtags-mode-map (kbd "M-r") 'helm-gtags-find-rtag)
-;; (define-key helm-gtags-mode-map (kbd "M-s") 'helm-gtags-find-symbol)
-;; (define-key helm-gtags-mode-map (kbd "M-g M-p") 'helm-gtags-parse-file)
-;; (define-key helm-gtags-mode-map (kbd "C-c <") 'helm-gtags-previous-history)
-;; (define-key helm-gtags-mode-map (kbd "C-c >") 'helm-gtags-next-history)
-;; (define-key helm-gtags-mode-map (kbd "M-,") 'helm-gtags-pop-stack)))
-;;
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'helm)
-(require 'helm-files)
-(require 'which-func)
-(require 'pulse)
-
-(declare-function helm-comp-read "helm-mode")
-(declare-function cygwin-convert-file-name-from-windows "cygw32.c")
-(declare-function cygwin-convert-file-name-to-windows "cygw32.c")
-
-(defgroup helm-gtags nil
- "GNU GLOBAL for helm"
- :group 'helm)
-
-(defcustom helm-gtags-path-style 'root
- "Style of file path"
- :type '(choice (const :tag "Root of the current project" root)
- (const :tag "Relative from the current directory" relative)
- (const :tag "Absolute Path" absolute))
- :group 'helm-gtags)
-
-(defcustom helm-gtags-ignore-case nil
- "Ignore case in each search."
- :type 'boolean
- :group 'helm-gtags)
-
-(defcustom helm-gtags-read-only nil
- "Gtags read only mode."
- :type 'boolean
- :group 'helm-gtags)
-
-(defcustom helm-gtags-auto-update nil
- "*If non-nil, tag files are updated whenever a file is saved."
- :type 'boolean
- :group 'helm-gtags)
-
-(defcustom helm-gtags-pulse-at-cursor t
- "If non-nil, pulse at point after jumping"
- :type 'boolean
- :group 'helm-gtags)
-
-(defcustom helm-gtags-cache-select-result nil
- "*If non-nil, results of helm-gtags-select and helm-gtags-select-path are cached."
- :type 'boolean
- :group 'helm-gtags)
-
-(defcustom helm-gtags-cache-max-result-size (* 10 1024 1024) ;10M
- "Max size(bytes) to cache for each select result."
- :type 'integer
- :group 'helm-gtags)
-
-(defcustom helm-gtags-update-interval-second 60
- "Tags are updated in `after-save-hook' if this seconds is passed from last update.
-Always update if value of this variable is nil."
- :type '(choice (integer :tag "Update interval seconds")
- (boolean :tag "Update every time" nil))
- :group 'helm-gtags)
-
-(defcustom helm-gtags-highlight-candidate t
- "Highlight candidate or not"
- :type 'boolean
- :group 'helm-gtags)
-
-(defcustom helm-gtags-use-input-at-cursor nil
- "Use input at cursor"
- :type 'boolean
- :group 'helm-gtags)
-
-(defcustom helm-gtags-prefix-key "\C-c"
- "If non-nil, it is used for the prefix key of gtags-xxx command."
- :type 'string
- :group 'helm-gtags)
-
-(defcustom helm-gtags-suggested-key-mapping nil
- "If non-nil, suggested key mapping is enabled."
- :type 'boolean
- :group 'helm-gtags)
-
-(defcustom helm-gtags-preselect nil
- "If non-nil, preselect current file and line."
- :type 'boolean
- :group 'helm-gtags)
-
-(defcustom helm-gtags-display-style nil
- "Style of display result."
- :type '(choice (const :tag "Show in detail" detail)
- (const :tag "Normal style" nil))
- :group 'helm-gtags)
-
-(defcustom helm-gtags-fuzzy-match nil
- "Enable fuzzy match"
- :type 'boolean
- :group 'helm-gtags)
-
-(defcustom helm-gtags-maximum-candidates (if helm-gtags-fuzzy-match 100 9999)
- "Maximum number of helm candidates"
- :type 'integer
- :group 'helm-gtags)
-
-(defcustom helm-gtags-direct-helm-completing nil
- "Use helm mode directly."
- :type 'boolean
- :group 'helm-gtags)
-
-(defface helm-gtags-file
- '((t :inherit font-lock-keyword-face))
- "Face for line numbers in the error list."
- :group 'helm-gtags)
-
-(defface helm-gtags-lineno
- '((t :inherit font-lock-doc-face))
- "Face for line numbers in the error list."
- :group 'helm-gtags)
-
-(defface helm-gtags-match
- '((t :inherit helm-match))
- "Face for word matched against tagname"
- :group 'helm-gtags)
-
-(defvar helm-gtags--tag-location nil)
-(defvar helm-gtags--last-update-time 0)
-(defvar helm-gtags--completing-history nil)
-(defvar helm-gtags--context-stack (make-hash-table :test 'equal))
-(defvar helm-gtags--result-cache (make-hash-table :test 'equal))
-(defvar helm-gtags--saved-context nil)
-(defvar helm-gtags--use-otherwin nil)
-(defvar helm-gtags--local-directory nil)
-(defvar helm-gtags--parsed-file nil)
-(defvar helm-gtags--current-position nil)
-(defvar helm-gtags--real-tag-location nil)
-(defvar helm-gtags--last-input nil)
-(defvar helm-gtags--query nil)
-
-(defconst helm-gtags--buffer "*helm gtags*")
-
-(defconst helm-gtags--include-regexp
- "\\`\\s-*#\\(?:include\\|import\\)\\s-*[\"<]\\(?:[./]*\\)?\\(.*?\\)[\">]")
-
-(defmacro helm-declare-obsolete-variable (old new version)
- `(progn
- (defvaralias ,old ,new)
- (make-obsolete-variable ,old ,new ,version)))
-
-(helm-declare-obsolete-variable
- 'helm-c-gtags-path-style 'helm-gtags-path-style "0.8")
-(helm-declare-obsolete-variable
- 'helm-c-gtags-ignore-case 'helm-gtags-ignore-case "0.8")
-(helm-declare-obsolete-variable
- 'helm-c-gtags-read-only 'helm-gtags-read-only "0.8")
-
-;; completsion function for completing-read.
-(defun helm-gtags--completing-gtags (string predicate code)
- (helm-gtags--complete 'tag string predicate code))
-(defun helm-gtags--completing-pattern (string predicate code)
- (helm-gtags--complete 'pattern string predicate code))
-(defun helm-gtags--completing-grtags (string predicate code)
- (helm-gtags--complete 'rtag string predicate code))
-(defun helm-gtags--completing-gsyms (string predicate code)
- (helm-gtags--complete 'symbol string predicate code))
-(defun helm-gtags--completing-files (string predicate code)
- (helm-gtags--complete 'find-file string predicate code))
-
-(defconst helm-gtags-comp-func-alist
- '((tag . helm-gtags--completing-gtags)
- (pattern . helm-gtags--completing-pattern)
- (rtag . helm-gtags--completing-grtags)
- (symbol . helm-gtags--completing-gsyms)
- (find-file . helm-gtags--completing-files)))
-
-(defconst helm-gtags--search-option-alist
- '((pattern . "-g")
- (rtag . "-r")
- (symbol . "-s")
- (find-file . "-Poa")))
-
-(defsubst helm-gtags--windows-p ()
- (memq system-type '(windows-nt ms-dos)))
-
-;; Work around for GNU global Windows issue
-(defsubst helm-gtags--use-abs-path-p (gtagslibpath)
- (and (helm-gtags--windows-p) gtagslibpath))
-
-(defun helm-gtags--construct-options (type completion)
- (let ((find-file-p (eq type 'find-file))
- (gtagslibpath (getenv "GTAGSLIBPATH"))
- options)
- (unless find-file-p
- (push "--result=grep" options))
- (when completion
- (push "-c" options))
- (helm-aif (assoc-default type helm-gtags--search-option-alist)
- (push it options))
- (when (or (eq helm-gtags-path-style 'absolute)
- (helm-gtags--use-abs-path-p gtagslibpath))
- (push "-a" options))
- (when helm-gtags-ignore-case
- (push "-i" options))
- (when (and current-prefix-arg (not find-file-p))
- (push "-l" options))
- (when gtagslibpath
- (push "-T" options))
- options))
-
-(defun helm-gtags--complete (type string predicate code)
- (let* ((options (helm-gtags--construct-options type t))
- (args (reverse (cons string options)))
- candidates)
- (with-temp-buffer
- (apply 'process-file "global" nil t nil args)
- (goto-char (point-min))
- (while (re-search-forward "^\\(.+\\)$" nil t)
- (push (match-string-no-properties 1) candidates)))
- (if (not code)
- (try-completion string candidates predicate)
- (all-completions string candidates predicate))))
-
-(defun helm-gtags--token-at-point (type)
- (if (not (eq type 'find-file))
- (thing-at-point 'symbol)
- (let ((line (helm-current-line-contents)))
- (when (string-match helm-gtags--include-regexp line)
- (match-string-no-properties 1 line)))))
-
-(defconst helm-gtags--prompt-alist
- '((tag . "Find Definition: ")
- (pattern . "Find Pattern: ")
- (rtag . "Find Reference: ")
- (symbol . "Find Symbol: ")
- (find-file . "Find File: ")))
-
-(defun helm-gtags--read-tagname (type &optional default-tagname)
- (let ((tagname (helm-gtags--token-at-point type))
- (prompt (assoc-default type helm-gtags--prompt-alist))
- (comp-func (assoc-default type helm-gtags-comp-func-alist)))
- (if (and tagname helm-gtags-use-input-at-cursor)
- tagname
- (when (and (not tagname) default-tagname)
- (setq tagname default-tagname))
- (when tagname
- (setq prompt (format "%s(default \"%s\") " prompt tagname)))
- (let ((completion-ignore-case helm-gtags-ignore-case)
- (completing-read-function 'completing-read-default))
- (if helm-gtags-direct-helm-completing
- (helm-comp-read prompt comp-func
- :history 'helm-gtags--completing-history
- :exec-when-only-one t
- :default tagname)
- (completing-read prompt comp-func nil nil nil
- 'helm-gtags--completing-history tagname))))))
-
-(defun helm-gtags--path-libpath-p (tagroot)
- (helm-aif (getenv "GTAGSLIBPATH")
- (cl-loop for path in (parse-colon-path it)
- for libpath = (file-name-as-directory (expand-file-name path))
- thereis (string= tagroot libpath))))
-
-(defun helm-gtags--tag-directory ()
- (with-temp-buffer
- (helm-aif (getenv "GTAGSROOT")
- it
- (unless (zerop (process-file "global" nil t nil "-p"))
- (error "GTAGS not found"))
- (goto-char (point-min))
- (when (looking-at "^\\([^\r\n]+\\)")
- (let ((tag-path (match-string-no-properties 1)))
- (file-name-as-directory
- (if (eq system-type 'cygwin)
- (cygwin-convert-file-name-from-windows tag-path)
- tag-path)))))))
-
-(defun helm-gtags--find-tag-directory ()
- (setq helm-gtags--real-tag-location nil)
- (let ((tagroot (helm-gtags--tag-directory)))
- (if (and (helm-gtags--path-libpath-p tagroot) helm-gtags--tag-location)
- (progn
- (setq helm-gtags--real-tag-location tagroot)
- helm-gtags--tag-location)
- (setq helm-gtags--tag-location tagroot))))
-
-(defun helm-gtags--base-directory ()
- (let ((dir (or helm-gtags--local-directory
- (cl-case helm-gtags-path-style
- (root (or helm-gtags--real-tag-location
- helm-gtags--tag-location))
- (otherwise default-directory))))
- (remote (file-remote-p default-directory)))
- (if (and remote (not (file-remote-p dir)))
- (concat remote dir)
- dir)))
-
-(defsubst helm-gtags--new-context-info (index stack)
- (list :index index :stack stack))
-
-(defun helm-gtags--put-context-stack (tag-location index stack)
- (puthash tag-location (helm-gtags--new-context-info index stack)
- helm-gtags--context-stack))
-
-(defsubst helm-gtags--current-context ()
- (let ((file (buffer-file-name (current-buffer))))
- (list :file file :position (point) :readonly buffer-file-read-only)))
-
-(defsubst helm-gtags--save-current-context ()
- (setq helm-gtags--saved-context (helm-gtags--current-context)))
-
-(defun helm-gtags--open-file (file readonly)
- (if readonly
- (find-file-read-only file)
- (find-file file)))
-
-(defun helm-gtags--open-file-other-window (file readonly)
- (setq helm-gtags--use-otherwin nil)
- (if readonly
- (find-file-read-only-other-window file)
- (find-file-other-window file)))
-
-(defun helm-gtags--get-context-info ()
- (let* ((tag-location (helm-gtags--find-tag-directory))
- (context-info (gethash tag-location helm-gtags--context-stack))
- (context-stack (plist-get context-info :stack)))
- (if (null context-stack)
- (error "Context stack is empty(TAG at %s)" tag-location)
- context-info)))
-
-(defun helm-gtags--get-or-create-context-info ()
- (or (gethash helm-gtags--tag-location helm-gtags--context-stack)
- (helm-gtags--new-context-info -1 nil)))
-
-;;;###autoload
-(defun helm-gtags-clear-all-cache ()
- (interactive)
- (clrhash helm-gtags--result-cache))
-
-;;;###autoload
-(defun helm-gtags-clear-cache ()
- (interactive)
- (helm-gtags--find-tag-directory)
- (let* ((tag-location (or helm-gtags--real-tag-location
- helm-gtags--tag-location))
- (gtags-path (concat tag-location "GTAGS"))
- (gpath-path (concat tag-location "GPATH")))
- (remhash gtags-path helm-gtags--result-cache)
- (remhash gpath-path helm-gtags--result-cache)))
-
-(defun helm-gtags--move-to-context (context)
- (let ((file (plist-get context :file))
- (curpoint (plist-get context :position))
- (readonly (plist-get context :readonly)))
- (helm-gtags--open-file file readonly)
- (goto-char curpoint)
- (recenter)))
-
-;;;###autoload
-(defun helm-gtags-next-history ()
- "Jump to next position on context stack"
- (interactive)
- (let* ((context-info (helm-gtags--get-context-info))
- (current-index (plist-get context-info :index))
- (context-stack (plist-get context-info :stack))
- context)
- (when (<= current-index -1)
- (error "This context is latest in context stack"))
- (setf (nth current-index context-stack) (helm-gtags--current-context))
- (cl-decf current-index)
- (if (= current-index -1)
- (setq context helm-gtags--current-position
- helm-gtags--current-position nil)
- (setq context (nth current-index context-stack)))
- (helm-gtags--put-context-stack helm-gtags--tag-location
- current-index context-stack)
- (helm-gtags--move-to-context context)))
-
-;;;###autoload
-(defun helm-gtags-previous-history ()
- "Jump to previous position on context stack"
- (interactive)
- (let* ((context-info (helm-gtags--get-context-info))
- (current-index (plist-get context-info :index))
- (context-stack (plist-get context-info :stack))
- (context-length (length context-stack)))
- (cl-incf current-index)
- (when (>= current-index context-length)
- (error "This context is last in context stack"))
- (if (= current-index 0)
- (setq helm-gtags--current-position (helm-gtags--current-context))
- (setf (nth (- current-index 1) context-stack) (helm-gtags--current-context)))
- (let ((prev-context (nth current-index context-stack)))
- (helm-gtags--move-to-context prev-context))
- (helm-gtags--put-context-stack helm-gtags--tag-location
- current-index context-stack)))
-
-(defun helm-gtags--get-result-cache (file)
- (helm-gtags--find-tag-directory)
- (let* ((file-path (concat (or helm-gtags--real-tag-location
- helm-gtags--tag-location)
- file))
- (file-mtime (nth 5 (file-attributes file-path)))
- (hash-value (gethash file-path helm-gtags--result-cache))
- (cached-file-mtime (nth 0 hash-value)))
- (if (and cached-file-mtime (equal cached-file-mtime file-mtime))
- (nth 1 hash-value)
- nil)))
-
-(defun helm-gtags--put-result-cache (file cache)
- (helm-gtags--find-tag-directory)
- (let* ((file-path (concat (or helm-gtags--real-tag-location
- helm-gtags--tag-location)
- file))
- (file-mtime (nth 5 (file-attributes file-path)))
- (hash-value (list file-mtime cache)))
- (puthash file-path hash-value helm-gtags--result-cache)))
-
-(defun helm-gtags--referer-function (file ref-line)
- (let ((is-opened (cl-loop with path = (concat default-directory file)
- for buf in (buffer-list)
- when (string= (buffer-file-name buf) path)
- return it))
- retval)
- (with-current-buffer (find-file-noselect file)
- (goto-char (point-min))
- (forward-line (1- ref-line))
- (unless (zerop (current-indentation))
- (setq retval (which-function)))
- (unless is-opened
- (kill-buffer (current-buffer)))
- retval)))
-
-(defun helm-gtags--show-detail ()
- (goto-char (point-min))
- (while (not (eobp))
- (let ((line (helm-current-line-contents)))
- (let* ((file-and-line (helm-gtags--extract-file-and-line line))
- (file (car file-and-line))
- (ref-line (cdr file-and-line))
- (ref-func (helm-gtags--referer-function file ref-line)))
- (when ref-func
- (search-forward ":" nil nil 2)
- (insert " " ref-func "|"))
- (forward-line 1)))))
-
-(defun helm-gtags--print-path-in-gtagslibpath (args)
- (let ((libpath (getenv "GTAGSLIBPATH")))
- (when libpath
- (dolist (path (parse-colon-path libpath))
- (let ((default-directory (file-name-as-directory path)))
- (apply 'process-file "global" nil t nil "-Poa" args))))))
-
-(defun helm-gtags--exec-global-command (type input &optional detail)
- (let ((args (helm-gtags--construct-command type input)))
- (helm-gtags--find-tag-directory)
- (helm-gtags--save-current-context)
- (let ((buf-coding buffer-file-coding-system))
- (with-current-buffer (helm-candidate-buffer 'global)
- (let ((default-directory (helm-gtags--base-directory))
- (input (car (last args)))
- (coding-system-for-read buf-coding)
- (coding-system-for-write buf-coding))
- (unless (zerop (apply 'process-file "global" nil '(t nil) nil args))
- (error (format "%s: not found" input)))
- ;; --path options does not support searching under GTAGSLIBPATH
- (when (eq type 'find-file)
- (helm-gtags--print-path-in-gtagslibpath args))
- (when detail
- (helm-gtags--show-detail)))))))
-
-(defun helm-gtags--construct-command (type &optional in)
- (setq helm-gtags--local-directory nil)
- (let ((dir (helm-attr 'helm-gtags-base-directory (helm-get-current-source))))
- (when (and dir (not (eq type 'find-file)))
- (setq helm-gtags--local-directory dir)))
- (let ((input (or in helm-gtags--query))
- (options (helm-gtags--construct-options type nil)))
- (when (string= input "")
- (error "Input is empty!!"))
- (setq helm-gtags--last-input input)
- (reverse (cons input options))))
-
-(defun helm-gtags--tags-init (&optional input)
- (helm-gtags--exec-global-command 'tag input))
-
-(defun helm-gtags--pattern-init (&optional input)
- (helm-gtags--exec-global-command 'pattern input helm-gtags-display-style))
-
-(defun helm-gtags--rtags-init (&optional input)
- (helm-gtags--exec-global-command 'rtag input helm-gtags-display-style))
-
-(defun helm-gtags--gsyms-init ()
- (helm-gtags--exec-global-command 'symbol nil helm-gtags-display-style))
-
-(defun helm-gtags--files-init ()
- (helm-gtags--exec-global-command 'find-file nil))
-
-(defun helm-gtags--real-file-name ()
- (let ((buffile (buffer-file-name)))
- (unless buffile
- (error "This buffer is not related to file."))
- (if (file-remote-p buffile)
- (tramp-file-name-localname (tramp-dissect-file-name buffile))
- (file-truename buffile))))
-
-(defun helm-gtags--find-tag-from-here-init ()
- (helm-gtags--find-tag-directory)
- (helm-gtags--save-current-context)
- (let ((token (helm-gtags--token-at-point 'from-here)))
- (unless token
- (error "Cursor is not on symbol."))
- (let* ((filename (helm-gtags--real-file-name))
- (from-here-opt (format "--from-here=%d:%s"
- (line-number-at-pos)
- (if (eq system-type 'cygwin)
- (cygwin-convert-file-name-to-windows filename)
- filename))))
- (setq helm-gtags--last-input token)
- (with-current-buffer (helm-candidate-buffer 'global)
- (let* ((default-directory (helm-gtags--base-directory))
- (status (process-file "global" nil '(t nil) nil
- "--result=grep" from-here-opt token)))
- (unless (zerop status)
- (cond ((= status 1)
- (error "Error: %s%s" (buffer-string) filename))
- ((= status 3)
- (error "Error: %s" (buffer-string)))
- (t (error "%s: not found" token)))))))))
-
-(defun helm-gtags--parse-file-init ()
- (with-current-buffer (helm-candidate-buffer 'global)
- (unless (zerop (process-file "global" nil t nil
- "--result=cscope" "-f" helm-gtags--parsed-file))
- (error "Failed: 'global --result=cscope -f %s" helm-gtags--parsed-file))))
-
-(defun helm-gtags--push-context (context)
- (let* ((context-info (helm-gtags--get-or-create-context-info))
- (current-index (plist-get context-info :index))
- (context-stack (plist-get context-info :stack)))
- (unless (= current-index -1)
- (setq context-stack (nthcdr (1+ current-index) context-stack)))
- (setq helm-gtags--current-position nil)
- (push context context-stack)
- (helm-gtags--put-context-stack helm-gtags--tag-location -1 context-stack)))
-
-(defsubst helm-gtags--select-find-file-func ()
- (if helm-gtags--use-otherwin
- 'helm-gtags--open-file-other-window
- 'helm-gtags--open-file))
-
-(defun helm-gtags--do-open-file (open-func file line)
- (funcall open-func file helm-gtags-read-only)
- (goto-char (point-min))
- (forward-line (1- line))
- (back-to-indentation)
- (recenter)
- (helm-gtags--push-context helm-gtags--saved-context)
- (when helm-gtags-pulse-at-cursor
- (pulse-momentary-highlight-one-line (point))))
-
-(defun helm-gtags--find-line-number (cand)
- (if (string-match "\\s-+\\([1-9][0-9]+\\)\\s-+" cand)
- (string-to-number (match-string-no-properties 1 cand))
- (error "Can't find line number in %s" cand)))
-
-(defun helm-gtags--parse-file-action (cand)
- (let ((line (helm-gtags--find-line-number cand))
- (open-func (helm-gtags--select-find-file-func)))
- (helm-gtags--do-open-file open-func helm-gtags--parsed-file line)))
-
-(defsubst helm-gtags--has-drive-letter-p (path)
- (string-match-p "\\`[a-zA-Z]:" path))
-
-(defun helm-gtags--extract-file-and-line (cand)
- (if (and (helm-gtags--windows-p) (helm-gtags--has-drive-letter-p cand))
- (when (string-match "\\(\\`[a-zA-Z]:[^:]+\\):\\([^:]+\\)" cand)
- (cons (match-string-no-properties 1 cand)
- (string-to-number (match-string-no-properties 2 cand))))
- (let ((elems (split-string cand ":")))
- (cons (cl-first elems) (string-to-number (cl-second elems))))))
-
-(defun helm-gtags--action-openfile (cand)
- (let* ((file-and-line (helm-gtags--extract-file-and-line cand))
- (filename (car file-and-line))
- (line (cdr file-and-line))
- (open-func (helm-gtags--select-find-file-func))
- (default-directory (helm-gtags--base-directory)))
- (helm-gtags--do-open-file open-func filename line)))
-
-(defun helm-gtags--action-openfile-other-window (cand)
- (let ((helm-gtags--use-otherwin t))
- (helm-gtags--action-openfile cand)))
-
-(defun helm-gtags--file-content-at-pos (file pos)
- (with-current-buffer (find-file-noselect file)
- (save-excursion
- (goto-char pos)
- (format "%s:%d:%s:%s"
- file (line-number-at-pos)
- (helm-aif (which-function) (format "[%s]" it) "")
- (helm-current-line-contents)))))
-
-(defun helm-gtags--files-candidate-transformer (file)
- (let ((removed-regexp (concat "\\`" helm-gtags--tag-location)))
- (replace-regexp-in-string removed-regexp "" file)))
-
-(defun helm-gtags--show-stack-init ()
- (cl-loop with context-stack = (plist-get (helm-gtags--get-context-info) :stack)
- with stack-length = (length context-stack)
- for context in (reverse context-stack)
- for file = (plist-get context :file)
- for pos = (plist-get context :position)
- for index = (1- stack-length) then (1- index)
- for line = (helm-gtags--file-content-at-pos file pos)
- for cand = (helm-gtags--files-candidate-transformer line)
- collect (cons cand (propertize cand 'index index))))
-
-(defun helm-gtags--persistent-action (cand)
- (let* ((file-and-line (helm-gtags--extract-file-and-line cand))
- (filename (car file-and-line))
- (line (cdr file-and-line))
- (default-directory (helm-gtags--base-directory)))
- (find-file filename)
- (goto-char (point-min))
- (forward-line (1- line))
- (helm-highlight-current-line)))
-
-(defvar helm-gtags--find-file-action
- '(("Open file" . helm-gtags--action-openfile)
- ("Open file other window" . helm-gtags--action-openfile-other-window)))
-
-(defvar helm-source-gtags-tags
- (helm-build-in-buffer-source "Jump to definitions"
- :init 'helm-gtags--tags-init
- :candidate-number-limit helm-gtags-maximum-candidates
- :real-to-display 'helm-gtags--candidate-transformer
- :persistent-action 'helm-gtags--persistent-action
- :fuzzy-match helm-gtags-fuzzy-match
- :action helm-gtags--find-file-action))
-
-(defvar helm-source-gtags-pattern
- (helm-build-in-buffer-source "Find pattern"
- :init 'helm-gtags--pattern-init
- :candidate-number-limit helm-gtags-maximum-candidates
- :real-to-display 'helm-gtags--candidate-transformer
- :persistent-action 'helm-gtags--persistent-action
- :fuzzy-match helm-gtags-fuzzy-match
- :action helm-gtags--find-file-action))
-
-(defvar helm-source-gtags-rtags
- (helm-build-in-buffer-source "Jump to references"
- :init 'helm-gtags--rtags-init
- :candidate-number-limit helm-gtags-maximum-candidates
- :real-to-display 'helm-gtags--candidate-transformer
- :persistent-action 'helm-gtags--persistent-action
- :fuzzy-match helm-gtags-fuzzy-match
- :action helm-gtags--find-file-action))
-
-(defvar helm-source-gtags-gsyms
- (helm-build-in-buffer-source "Jump to symbols"
- :init 'helm-gtags--gsyms-init
- :candidate-number-limit helm-gtags-maximum-candidates
- :real-to-display 'helm-gtags--candidate-transformer
- :persistent-action 'helm-gtags--persistent-action
- :fuzzy-match helm-gtags-fuzzy-match
- :action helm-gtags--find-file-action))
-
-(defun helm-gtags--highlight-candidate (candidate)
- (let ((regexp (concat "\\_<" helm-gtags--last-input "\\_>"))
- (limit (1- (length candidate)))
- (last-pos 0)
- (case-fold-search nil))
- (while (and (< last-pos limit)
- (string-match regexp candidate last-pos))
- (put-text-property (match-beginning 0) (match-end 0)
- 'face 'helm-gtags-match
- candidate)
- (setq last-pos (1+ (match-end 0))))
- candidate))
-
-(defun helm-gtags--transformer-regexp (candidate)
- (if (and (helm-gtags--windows-p) (helm-gtags--has-drive-letter-p candidate))
- "\\`\\([a-zA-Z]:[^:]+\\):\\([^:]+\\):\\(.*\\)"
- "\\`\\([^:]+\\):\\([^:]+\\):\\(.*\\)"))
-
-(defun helm-gtags--candidate-transformer (candidate)
- (if (not helm-gtags-highlight-candidate)
- candidate
- (let ((regexp (helm-gtags--transformer-regexp candidate)))
- (when (string-match regexp candidate)
- (format "%s:%s:%s"
- (propertize (match-string 1 candidate) 'face 'helm-gtags-file)
- (propertize (match-string 2 candidate) 'face 'helm-gtags-lineno)
- (helm-gtags--highlight-candidate (match-string 3 candidate)))))))
-
-(defun helm-gtags--parse-file-candidate-transformer (file)
- (let ((removed-file (replace-regexp-in-string "\\`\\S-+ " "" file)))
- (when (string-match "\\`\\(\\S-+\\) \\(\\S-+\\) \\(.+\\)\\'" removed-file)
- (format "%-25s %-5s %s"
- (match-string-no-properties 1 removed-file)
- (match-string-no-properties 2 removed-file)
- (match-string-no-properties 3 removed-file)))))
-
-(defvar helm-source-gtags-files
- (helm-build-in-buffer-source "Find files"
- :init 'helm-gtags--files-init
- :candidate-number-limit helm-gtags-maximum-candidates
- :real-to-display 'helm-gtags--files-candidate-transformer
- :persistent-action 'helm-gtags--persistent-action
- :fuzzy-match helm-gtags-fuzzy-match
- :action (helm-actions-from-type-file)))
-
-(defvar helm-source-gtags-find-tag-from-here
- (helm-build-in-buffer-source "Find tag from here"
- :init 'helm-gtags--find-tag-from-here-init
- :candidate-number-limit helm-gtags-maximum-candidates
- :real-to-display 'helm-gtags--candidate-transformer
- :persistent-action 'helm-gtags--persistent-action
- :fuzzy-match helm-gtags-fuzzy-match
- :action helm-gtags--find-file-action))
-
-(defvar helm-source-gtags-parse-file
- (helm-build-in-buffer-source "Parse file"
- :init 'helm-gtags--parse-file-init
- :candidate-number-limit helm-gtags-maximum-candidates
- :real-to-display 'helm-gtags--parse-file-candidate-transformer
- :fuzzy-match helm-gtags-fuzzy-match
- :action 'helm-gtags--parse-file-action))
-
-(defun helm-gtags--show-stack-action (cand)
- (let* ((index (get-text-property 0 'index cand))
- (context-info (helm-gtags--get-context-info))
- (context-stack (plist-get context-info :stack)))
- (helm-gtags--put-context-stack helm-gtags--tag-location
- index context-stack)
- (helm-gtags--move-to-context (nth index context-stack))))
-
-(defvar helm-source-gtags-show-stack
- (helm-build-sync-source "Show Context Stack"
- :candidates 'helm-gtags--show-stack-init
- :volatile t
- :candidate-number-limit helm-gtags-maximum-candidates
- :persistent-action 'helm-gtags--persistent-action
- :fuzzy-match helm-gtags-fuzzy-match
- :action 'helm-gtags--show-stack-action))
-
-;;;###autoload
-(defun helm-gtags-select ()
- (interactive)
- (helm-gtags--common '(helm-source-gtags-select) nil))
-
-;;;###autoload
-(defun helm-gtags-select-path ()
- (interactive)
- (helm-gtags--common '(helm-source-gtags-select-path) nil))
-
-(defsubst helm-gtags--beginning-of-defun ()
- (cl-case major-mode
- ((c-mode c++-mode java-mode) 'c-beginning-of-defun)
- (php-mode 'php-beginning-of-defun)
- (otherwise 'beginning-of-defun)))
-
-(defsubst helm-gtags--end-of-defun ()
- (cl-case major-mode
- ((c-mode c++-mode java-mode malabar-mode) 'c-end-of-defun)
- (php-mode 'php-end-of-defun)
- (otherwise 'end-of-defun)))
-
-(defun helm-gtags--current-funcion-bound ()
- (save-excursion
- (let (start)
- (funcall (helm-gtags--beginning-of-defun))
- (setq start (line-number-at-pos))
- (funcall (helm-gtags--end-of-defun))
- (cons start (line-number-at-pos)))))
-
-(defun helm-gtags--tags-refered-from-this-function ()
- (let* ((file (helm-gtags--real-file-name))
- (bound (helm-gtags--current-funcion-bound))
- (start-line (car bound))
- (end-line (cdr bound)))
- (with-temp-buffer
- (unless (process-file "global" nil t nil "-f" "-r" file)
- (error "Failed: global -f -r %s" file))
- (goto-char (point-min))
- (let (tagnames finish)
- (while (and (not finish) (not (eobp)))
- (let* ((cols (split-string (helm-current-line-contents) nil t))
- (lineno (string-to-number (cl-second cols))))
- (if (and (> lineno start-line) (< lineno end-line))
- (let* ((tag (cl-first cols))
- (elm (cl-find tag tagnames :test 'equal)))
- (unless elm
- (push tag tagnames)))
- (when (>= lineno end-line)
- (setq finish t)))
- (forward-line 1)))
- (reverse tagnames)))))
-
-(defun helm-gtags--tag-in-function-persistent-action (cand)
- (let* ((bound (helm-gtags--current-funcion-bound))
- (limit (save-excursion
- (goto-char (point-min))
- (forward-line (cdr bound))
- (goto-char (line-end-position))
- (point))))
- (when (search-forward cand nil limit)
- (helm-highlight-current-line))))
-
-;;;###autoload
-(defun helm-gtags-tags-in-this-function ()
- "Show tagnames which are referenced in this function and jump to it."
- (interactive)
- (let ((tags (helm-gtags--tags-refered-from-this-function)))
- (unless tags
- (error "There are no tags which are refered from this function."))
- (let* ((name (format "Tags in [%s]" (which-function)))
- (tag (helm-comp-read
- "Tagnames: " tags
- :must-match t :name name
- :persistent-action 'helm-gtags--tag-in-function-persistent-action)))
- (helm-gtags-find-tag tag))))
-
-(defun helm-gtags--source-select-tag (candidate)
- (helm-build-in-buffer-source "Select Tag"
- :init (lambda () (helm-gtags--tags-init candidate))
- :candidate-number-limit helm-gtags-maximum-candidates
- :persistent-action 'helm-gtags--persistent-action
- :fuzzy-match helm-gtags-fuzzy-match
- :action helm-gtags--find-file-action))
-
-(defun helm-gtags--source-select-rtag (candidate)
- (helm-build-in-buffer-source "Select Rtag"
- :init (lambda () (helm-gtags--rtags-init candidate))
- :candidate-number-limit helm-gtags-maximum-candidates
- :persistent-action 'helm-gtags--persistent-action
- :fuzzy-match helm-gtags-fuzzy-match
- :action helm-gtags--find-file-action))
-
-(defsubst helm-gtags--action-by-timer (src)
- (run-with-timer 0.1 nil (lambda () (helm-gtags--common (list src) nil))))
-
-(defun helm-gtags--select-tag-action (c)
- (helm-gtags--action-by-timer (helm-gtags--source-select-tag c)))
-
-(defun helm-gtags--select-rtag-action (c)
- (helm-gtags--action-by-timer (helm-gtags--source-select-rtag c)))
-
-(defun helm-gtags--select-cache-init-common (args tagfile)
- (let ((cache (helm-gtags--get-result-cache tagfile)))
- (if cache
- (insert cache)
- (apply 'process-file "global" nil t nil args)
- (let* ((cache (buffer-string))
- (cache-size (length cache)))
- (when (<= cache-size helm-gtags-cache-max-result-size)
- (helm-gtags--put-result-cache tagfile cache))))))
-
-(defun helm-gtags--source-select-init ()
- (with-current-buffer (helm-candidate-buffer 'global)
- (if (not helm-gtags-cache-select-result)
- (process-file "global" nil t nil "-c")
- (helm-gtags--select-cache-init-common '("-c") "GTAGS"))))
-
-(defvar helm-source-gtags-select
- (helm-build-in-buffer-source "Find tag from here"
- :init 'helm-gtags--source-select-init
- :candidate-number-limit helm-gtags-maximum-candidates
- :persistent-action 'helm-gtags--persistent-action
- :fuzzy-match helm-gtags-fuzzy-match
- :action '(("Goto the location" . helm-gtags--select-tag-action)
- ("Goto the location(other buffer)" .
- (lambda (c)
- (setq helm-gtags--use-otherwin t)
- (helm-gtags--select-tag-action c)))
- ("Move to the referenced point" . helm-gtags--select-rtag-action))))
-
-(defun helm-gtags--select-path-init ()
- (with-current-buffer (helm-candidate-buffer 'global)
- (if (not helm-gtags-cache-select-result)
- (process-file "global" nil t nil "-Poa")
- (helm-gtags--select-cache-init-common '("-Poa") "GPATH"))))
-
-(defvar helm-source-gtags-select-path
- (helm-build-in-buffer-source "Select path"
- :init 'helm-gtags--select-path-init
- :candidate-number-limit helm-gtags-maximum-candidates
- :real-to-display 'helm-gtags--files-candidate-transformer
- :persistent-action 'helm-gtags--persistent-action
- :fuzzy-match helm-gtags-fuzzy-match
- :action (helm-actions-from-type-file)))
-
-(defun helm-gtags--searched-directory ()
- (cl-case (prefix-numeric-value current-prefix-arg)
- (4 (let ((dir (read-directory-name "Input Directory: ")))
- (setq helm-gtags--local-directory (file-name-as-directory dir))))
- (16 (file-name-directory (buffer-file-name)))))
-
-(defsubst helm-gtags--using-other-window-p ()
- (< (prefix-numeric-value current-prefix-arg) 0))
-
-(defun helm-gtags--make-gtags-sentinel (action)
- (lambda (process _event)
- (when (eq (process-status process) 'exit)
- (if (zerop (process-exit-status process))
- (message "Success: %s TAGS" action)
- (message "Failed: %s TAGS(%d)" action (process-exit-status process))))))
-
-(defsubst helm-gtags--read-gtagslabel ()
- (let ((labels '("default" "native" "ctags" "pygments")))
- (completing-read "GTAGSLABEL(Default: default): " labels nil t nil nil "default")))
-
-(defsubst helm-gtags--label-option (label)
- (concat "--gtagslabel=" label))
-
-;;;###autoload
-(defun helm-gtags-create-tags (dir label)
- (interactive
- (list (read-directory-name "Root Directory: ")
- (helm-gtags--read-gtagslabel)))
- (let ((default-directory dir)
- (proc-buf (get-buffer-create " *helm-gtags-create*")))
- (let ((proc (start-file-process "helm-gtags-create" proc-buf
- "gtags" "-q" (helm-gtags--label-option label))))
- (set-process-sentinel proc (helm-gtags--make-gtags-sentinel 'create)))))
-
-(defun helm-gtags--find-tag-simple ()
- (or (getenv "GTAGSROOT")
- (locate-dominating-file default-directory "GTAGS")
- (if (not (yes-or-no-p "File GTAGS not found. Run 'gtags'? "))
- (user-error "Abort")
- (let* ((tagroot (read-directory-name "Root Directory: "))
- (label (helm-gtags--read-gtagslabel))
- (default-directory tagroot))
- (message "gtags is generating tags....")
- (unless (zerop (process-file "gtags" nil nil nil
- "-q" (helm-gtags--label-option label)))
- (error "Faild: 'gtags -q'"))
- tagroot))))
-
-(defun helm-gtags--current-file-and-line ()
- (let* ((buffile (buffer-file-name))
- (path (cl-case helm-gtags-path-style
- (absolute buffile)
- (root
- (file-relative-name buffile (helm-gtags--find-tag-directory)))
- (relative
- (file-relative-name buffile (helm-gtags--base-directory))))))
- (format "%s:%d" path (line-number-at-pos))))
-
-(defun helm-gtags--common (srcs tagname)
- (let ((helm-quit-if-no-candidate t)
- (helm-execute-action-at-once-if-one t)
- (dir (helm-gtags--searched-directory))
- (src (car srcs))
- (preselect-regexp (when helm-gtags-preselect
- (regexp-quote (helm-gtags--current-file-and-line)))))
- (when (symbolp src)
- (setq src (symbol-value src)))
- (unless helm-gtags--use-otherwin
- (setq helm-gtags--use-otherwin (helm-gtags--using-other-window-p)))
- (when tagname
- (setq helm-gtags--query tagname))
- (let ((tagroot (helm-gtags--find-tag-simple)))
- (helm-attrset 'helm-gtags-base-directory dir src)
- (helm-attrset 'name (concat "GNU Global at " (or dir tagroot)) src)
- (helm :sources srcs :buffer helm-gtags--buffer
- :preselect preselect-regexp))))
-
-;;;###autoload
-(defun helm-gtags-find-tag (tag)
- "Jump to definition"
- (interactive
- (list (helm-gtags--read-tagname 'tag)))
- (helm-gtags--common '(helm-source-gtags-tags) tag))
-
-;;;###autoload
-(defun helm-gtags-find-tag-other-window (tag)
- "Jump to definition in other window."
- (interactive
- (list (helm-gtags--read-tagname 'tag)))
- (setq helm-gtags--use-otherwin t)
- (helm-gtags-find-tag tag))
-
-;;;###autoload
-(defun helm-gtags-find-rtag (tag)
- "Jump to referenced point"
- (interactive
- (list (helm-gtags--read-tagname 'rtag (which-function))))
- (helm-gtags--common '(helm-source-gtags-rtags) tag))
-
-;;;###autoload
-(defun helm-gtags-find-symbol (tag)
- "Jump to the symbol location"
- (interactive
- (list (helm-gtags--read-tagname 'symbol)))
- (helm-gtags--common '(helm-source-gtags-gsyms) tag))
-
-;;;###autoload
-(defun helm-gtags-find-pattern (pattern)
- "Grep and jump by gtags tag files."
- (interactive
- (list (helm-gtags--read-tagname 'pattern)))
- (helm-gtags--common '(helm-source-gtags-pattern) pattern))
-
-(defun helm-gtags--find-file-after-hook ()
- (helm-gtags--push-context helm-gtags--saved-context))
-
-;;;###autoload
-(defun helm-gtags-find-files (file)
- "Find file from tagged with gnu global."
- (interactive
- (list (helm-gtags--read-tagname 'find-file)))
- (add-hook 'helm-after-action-hook 'helm-gtags--find-file-after-hook)
- (unwind-protect
- (helm-gtags--common '(helm-source-gtags-files) file)
- (remove-hook 'helm-after-action-hook 'helm-gtags--find-file-after-hook)))
-
-;;;###autoload
-(defun helm-gtags-find-tag-from-here ()
- "Jump point by current point information.
-Jump to definition point if cursor is on its reference.
-Jump to reference point if curosr is on its definition"
- (interactive)
- (helm-gtags--common '(helm-source-gtags-find-tag-from-here) nil))
-
-;;;###autoload
-(defun helm-gtags-dwim ()
- "Find by context. Here is
-- on include statement then jump to included file
-- on symbol definition then jump to its references
-- on reference point then jump to its definition."
- (interactive)
- (let ((line (helm-current-line-contents)))
- (if (string-match helm-gtags--include-regexp line)
- (let ((helm-gtags-use-input-at-cursor t))
- (helm-gtags-find-files (match-string-no-properties 1 line)))
- (if (and (buffer-file-name) (thing-at-point 'symbol))
- (helm-gtags-find-tag-from-here)
- (call-interactively 'helm-gtags-find-tag)))))
-
-(defun helm-gtags--set-parsed-file ()
- (let* ((this-file (file-name-nondirectory (buffer-file-name)))
- (file (if current-prefix-arg
- (read-file-name "Parsed File: " nil this-file)
- this-file)))
- (setq helm-gtags--parsed-file (expand-file-name file))))
-
-(defun helm-gtags--find-preselect-line ()
- (let ((defun-bound (bounds-of-thing-at-point 'defun)))
- (if (not defun-bound)
- (line-number-at-pos)
- (let ((defun-begin-line (line-number-at-pos (car defun-bound)))
- (filename (helm-gtags--real-file-name)))
- (with-temp-buffer
- (unless (zerop (process-file "global" nil t nil "-f" filename))
- (error "Failed: global -f"))
- (goto-char (point-min))
- (let (start-line)
- (while (and (not start-line)
- (re-search-forward "^\\S-+\\s-+\\([1-9][0-9]*\\)" nil t))
- (let ((line (string-to-number (match-string-no-properties 1))))
- (when (>= line defun-begin-line)
- (setq start-line line))))
- (or start-line (line-number-at-pos))))))))
-
-;;;###autoload
-(defun helm-gtags-parse-file ()
- "Parse current file with gnu global. This is similar to `imenu'.
-You can jump definitions of functions, symbols in this file."
- (interactive)
- (helm-gtags--find-tag-directory)
- (helm-gtags--save-current-context)
- (setq helm-gtags--use-otherwin (helm-gtags--using-other-window-p))
- (helm-gtags--set-parsed-file)
- (helm-attrset 'name
- (format "Parsed File: %s"
- (file-relative-name helm-gtags--parsed-file
- helm-gtags--tag-location))
- helm-source-gtags-parse-file)
- (let ((presel (when helm-gtags-preselect
- (format "^\\S-+\\s-+%d\\s-+" (helm-gtags--find-preselect-line)))))
- (helm :sources '(helm-source-gtags-parse-file)
- :buffer helm-gtags--buffer :preselect presel)))
-
-;;;###autoload
-(defun helm-gtags-pop-stack ()
- "Jump to previous point on the context stack and pop it from stack."
- (interactive)
- (let* ((context-info (helm-gtags--get-context-info))
- (context-stack (plist-get context-info :stack))
- (context (pop context-stack)))
- (helm-gtags--put-context-stack helm-gtags--tag-location -1 context-stack)
- (helm-gtags--move-to-context context)))
-
-;;;###autoload
-(defun helm-gtags-show-stack ()
- "Show current context stack."
- (interactive)
- (helm-other-buffer 'helm-source-gtags-show-stack
- (get-buffer-create helm-gtags--buffer)))
-
-;;;###autoload
-(defun helm-gtags-clear-stack ()
- "Clear current context stack."
- (interactive)
- (let ((tag-location (helm-gtags--find-tag-directory)))
- (message "Clear '%s' context stack." tag-location)
- (remhash tag-location helm-gtags--context-stack)))
-
-;;;###autoload
-(defun helm-gtags-clear-all-stacks ()
- "Clear all context stacks."
- (interactive)
- (message "Clear all context statks.")
- (setq helm-gtags--context-stack (make-hash-table :test 'equal)))
-
-(defun helm-gtags--read-tag-directory ()
- (let ((dir (read-directory-name "Directory tag generated: " nil nil t)))
- ;; On Windows, "gtags d:/tmp" work, but "gtags d:/tmp/" doesn't
- (directory-file-name (expand-file-name dir))))
-
-(defsubst helm-gtags--how-to-update-tags ()
- (cl-case (prefix-numeric-value current-prefix-arg)
- (4 'entire-update)
- (16 'generate-other-directory)
- (otherwise 'single-update)))
-
-(defun helm-gtags--update-tags-command (how-to)
- (cl-case how-to
- (entire-update '("global" "-u"))
- (generate-other-directory (list "gtags" (helm-gtags--read-tag-directory)))
- (single-update (list "global" "--single-update" (helm-gtags--real-file-name)))))
-
-(defun helm-gtags--update-tags-p (how-to interactive-p current-time)
- (or interactive-p
- (and (eq how-to 'single-update)
- (buffer-file-name)
- (or (not helm-gtags-update-interval-second)
- (>= (- current-time helm-gtags--last-update-time)
- helm-gtags-update-interval-second)))))
-
-;;;###autoload
-(defun helm-gtags-update-tags ()
- "Update TAG file. Update All files with `C-u' prefix.
-Generate new TAG file in selected directory with `C-u C-u'"
- (interactive)
- (let ((how-to (helm-gtags--how-to-update-tags))
- (interactive-p (called-interactively-p 'interactive))
- (current-time (float-time (current-time))))
- (when (helm-gtags--update-tags-p how-to interactive-p current-time)
- (let* ((cmds (helm-gtags--update-tags-command how-to))
- (proc (apply 'start-file-process "helm-gtags-update-tag" nil cmds)))
- (if (not proc)
- (message "Failed: %s" (mapconcat 'identity cmds " "))
- (set-process-sentinel proc (helm-gtags--make-gtags-sentinel 'update))
- (setq helm-gtags--last-update-time current-time))))))
-
-;;;###autoload
-(defun helm-gtags-resume ()
- "Resurrect previously invoked `helm-gtags` command."
- (interactive)
- (unless (get-buffer helm-gtags--buffer)
- (error "Error: helm-gtags buffer is not existed."))
- (helm-resume helm-gtags--buffer))
-
-(defsubst helm-gtags--check-browser-installed (browser)
- (let ((used-browser (or browser "mozilla")))
- (unless (executable-find used-browser)
- (error "Not found browser '%s'" used-browser))))
-
-(defun helm-gtags-display-browser ()
- "Display current screen on hypertext browser.
-`browse-url-generic-program' is used as browser if its value is non-nil.
-`mozilla' is used in other case."
- (interactive)
- (let ((file (buffer-file-name)))
- (if (not file)
- (error "This buffer is not related to file.")
- (let* ((lineopt (concat "+" (number-to-string (line-number-at-pos))))
- (browser (symbol-value 'browse-url-generic-program))
- (args (list lineopt file)))
- (helm-gtags--check-browser-installed browser)
- (when browser
- (setq args (append (list "-b" browser) args)))
- ;; `gozilla' commend never returns error status if command is failed.
- (apply 'process-file "gozilla" nil nil nil args)))))
-
-(defvar helm-gtags-mode-name " HelmGtags")
-(defvar helm-gtags-mode-map (make-sparse-keymap))
-
-;;;###autoload
-(define-minor-mode helm-gtags-mode ()
- "Enable helm-gtags"
- :group 'helm-gtags
- :init-value nil
- :global nil
- :keymap helm-gtags-mode-map
- :lighter helm-gtags-mode-name
- (if helm-gtags-mode
- (when helm-gtags-auto-update
- (add-hook 'after-save-hook 'helm-gtags-update-tags nil t))
- (when helm-gtags-auto-update
- (remove-hook 'after-save-hook 'helm-gtags-update-tags t))))
-
-;; Key mapping of gtags-mode.
-(when helm-gtags-suggested-key-mapping
- ;; Current key mapping.
- (let ((prefix helm-gtags-prefix-key))
- (define-key helm-gtags-mode-map (concat prefix "h") 'helm-gtags-display-browser)
- (define-key helm-gtags-mode-map "\C-]" 'helm-gtags-find-tag-from-here)
- (define-key helm-gtags-mode-map "\C-t" 'helm-gtags-pop-stack)
- (define-key helm-gtags-mode-map (concat prefix "P") 'helm-gtags-find-files)
- (define-key helm-gtags-mode-map (concat prefix "f") 'helm-gtags-parse-file)
- (define-key helm-gtags-mode-map (concat prefix "g") 'helm-gtags-find-pattern)
- (define-key helm-gtags-mode-map (concat prefix "s") 'helm-gtags-find-symbol)
- (define-key helm-gtags-mode-map (concat prefix "r") 'helm-gtags-find-rtag)
- (define-key helm-gtags-mode-map (concat prefix "t") 'helm-gtags-find-tag)
- (define-key helm-gtags-mode-map (concat prefix "d") 'helm-gtags-find-tag)
-
- ;; common
- (define-key helm-gtags-mode-map "\e*" 'helm-gtags-pop-stack)
- (define-key helm-gtags-mode-map "\e." 'helm-gtags-find-tag)
- (define-key helm-gtags-mode-map "\C-x4." 'helm-gtags-find-tag-other-window)))
-
-(provide 'helm-gtags)
-
-;; Local Variables:
-;; coding: utf-8
-;; indent-tabs-mode: nil
-;; End:
-
-;;; helm-gtags.el ends here
--- /dev/null
+;;; helm-gtags-autoloads.el --- automatically extracted autoloads
+;;
+;;; Code:
+(add-to-list 'load-path (or (file-name-directory #$) (car load-path)))
+\f
+;;;### (autoloads nil "helm-gtags" "helm-gtags.el" (22215 7814 0
+;;;;;; 0))
+;;; Generated autoloads from helm-gtags.el
+
+(autoload 'helm-gtags-clear-all-cache "helm-gtags" "\
+
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-clear-cache "helm-gtags" "\
+
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-next-history "helm-gtags" "\
+Jump to next position on context stack
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-previous-history "helm-gtags" "\
+Jump to previous position on context stack
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-select "helm-gtags" "\
+
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-select-path "helm-gtags" "\
+
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-tags-in-this-function "helm-gtags" "\
+Show tagnames which are referenced in this function and jump to it.
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-create-tags "helm-gtags" "\
+
+
+\(fn DIR LABEL)" t nil)
+
+(autoload 'helm-gtags-find-tag "helm-gtags" "\
+Jump to definition
+
+\(fn TAG)" t nil)
+
+(autoload 'helm-gtags-find-tag-other-window "helm-gtags" "\
+Jump to definition in other window.
+
+\(fn TAG)" t nil)
+
+(autoload 'helm-gtags-find-rtag "helm-gtags" "\
+Jump to referenced point
+
+\(fn TAG)" t nil)
+
+(autoload 'helm-gtags-find-symbol "helm-gtags" "\
+Jump to the symbol location
+
+\(fn TAG)" t nil)
+
+(autoload 'helm-gtags-find-pattern "helm-gtags" "\
+Grep and jump by gtags tag files.
+
+\(fn PATTERN)" t nil)
+
+(autoload 'helm-gtags-find-files "helm-gtags" "\
+Find file from tagged with gnu global.
+
+\(fn FILE)" t nil)
+
+(autoload 'helm-gtags-find-tag-from-here "helm-gtags" "\
+Jump point by current point information.
+Jump to definition point if cursor is on its reference.
+Jump to reference point if curosr is on its definition
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-dwim "helm-gtags" "\
+Find by context. Here is
+- on include statement then jump to included file
+- on symbol definition then jump to its references
+- on reference point then jump to its definition.
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-parse-file "helm-gtags" "\
+Parse current file with gnu global. This is similar to `imenu'.
+You can jump definitions of functions, symbols in this file.
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-pop-stack "helm-gtags" "\
+Jump to previous point on the context stack and pop it from stack.
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-show-stack "helm-gtags" "\
+Show current context stack.
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-clear-stack "helm-gtags" "\
+Clear current context stack.
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-clear-all-stacks "helm-gtags" "\
+Clear all context stacks.
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-update-tags "helm-gtags" "\
+Update TAG file. Update All files with `C-u' prefix.
+Generate new TAG file in selected directory with `C-u C-u'
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-resume "helm-gtags" "\
+Resurrect previously invoked `helm-gtags` command.
+
+\(fn)" t nil)
+
+(autoload 'helm-gtags-mode "helm-gtags" "\
+Toggle Helm-Gtags mode on or off.
+With a prefix argument ARG, enable Helm-Gtags mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil, and toggle it if ARG is `toggle'.
+\\{helm-gtags-mode-map}
+
+\(fn &optional ARG)" t nil)
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; End:
+;;; helm-gtags-autoloads.el ends here
--- /dev/null
+(define-package "helm-gtags" "20160202.503" "GNU GLOBAL helm interface" '((emacs "24.3") (helm "1.7.7")) :url "https://github.com/syohex/emacs-helm-gtags")
--- /dev/null
+;;; helm-gtags.el --- GNU GLOBAL helm interface -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2016 by Syohei YOSHIDA
+
+;; Author: Syohei YOSHIDA <syohexNOSPAMgmail.com>
+;; URL: https://github.com/syohex/emacs-helm-gtags
+;; Package-Version: 20160202.503
+;; Version: 1.5.4
+;; Package-Requires: ((emacs "24.3") (helm "1.7.7"))
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; `helm-gtags.el' is a `helm' interface of GNU Global.
+;; `helm-gtags.el' is not compatible `anything-gtags.el', but `helm-gtags.el'
+;; is designed for fast search.
+
+;;
+;; To use this package, add these lines to your init.el or .emacs file:
+;;
+;; ;; Enable helm-gtags-mode
+;; (add-hook 'c-mode-hook 'helm-gtags-mode)
+;; (add-hook 'c++-mode-hook 'helm-gtags-mode)
+;; (add-hook 'asm-mode-hook 'helm-gtags-mode)
+;;
+;; ;; Set key bindings
+;; (eval-after-load "helm-gtags"
+;; '(progn
+;; (define-key helm-gtags-mode-map (kbd "M-t") 'helm-gtags-find-tag)
+;; (define-key helm-gtags-mode-map (kbd "M-r") 'helm-gtags-find-rtag)
+;; (define-key helm-gtags-mode-map (kbd "M-s") 'helm-gtags-find-symbol)
+;; (define-key helm-gtags-mode-map (kbd "M-g M-p") 'helm-gtags-parse-file)
+;; (define-key helm-gtags-mode-map (kbd "C-c <") 'helm-gtags-previous-history)
+;; (define-key helm-gtags-mode-map (kbd "C-c >") 'helm-gtags-next-history)
+;; (define-key helm-gtags-mode-map (kbd "M-,") 'helm-gtags-pop-stack)))
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'helm)
+(require 'helm-files)
+(require 'which-func)
+(require 'pulse)
+
+(declare-function helm-comp-read "helm-mode")
+(declare-function cygwin-convert-file-name-from-windows "cygw32.c")
+(declare-function cygwin-convert-file-name-to-windows "cygw32.c")
+
+(defgroup helm-gtags nil
+ "GNU GLOBAL for helm."
+ :group 'helm)
+
+(defcustom helm-gtags-path-style 'root
+ "Style of file path"
+ :type '(choice (const :tag "Root of the current project" root)
+ (const :tag "Relative from the current directory" relative)
+ (const :tag "Absolute Path" absolute)))
+
+(defcustom helm-gtags-ignore-case nil
+ "Ignore case in each search."
+ :type 'boolean)
+
+(defcustom helm-gtags-read-only nil
+ "Gtags read only mode."
+ :type 'boolean)
+
+(defcustom helm-gtags-auto-update nil
+ "*If non-nil, tag files are updated whenever a file is saved."
+ :type 'boolean)
+
+(defcustom helm-gtags-pulse-at-cursor t
+ "If non-nil, pulse at point after jumping"
+ :type 'boolean)
+
+(defcustom helm-gtags-cache-select-result nil
+ "*If non-nil, results of helm-gtags-select and helm-gtags-select-path are cached."
+ :type 'boolean)
+
+(defcustom helm-gtags-cache-max-result-size (* 10 1024 1024) ;10M
+ "Max size(bytes) to cache for each select result."
+ :type 'integer)
+
+(defcustom helm-gtags-update-interval-second 60
+ "Tags are updated in `after-save-hook' if this seconds is passed from last update.
+Always update if value of this variable is nil."
+ :type '(choice (integer :tag "Update interval seconds")
+ (boolean :tag "Update every time" nil)))
+
+(defcustom helm-gtags-highlight-candidate t
+ "Highlight candidate or not"
+ :type 'boolean)
+
+(defcustom helm-gtags-use-input-at-cursor nil
+ "Use input at cursor"
+ :type 'boolean)
+
+(defcustom helm-gtags-prefix-key "\C-c"
+ "If non-nil, it is used for the prefix key of gtags-xxx command."
+ :type 'string)
+
+(defcustom helm-gtags-suggested-key-mapping nil
+ "If non-nil, suggested key mapping is enabled."
+ :type 'boolean)
+
+(defcustom helm-gtags-preselect nil
+ "If non-nil, preselect current file and line."
+ :type 'boolean)
+
+(defcustom helm-gtags-display-style nil
+ "Style of display result."
+ :type '(choice (const :tag "Show in detail" detail)
+ (const :tag "Normal style" nil)))
+
+(defcustom helm-gtags-fuzzy-match nil
+ "Enable fuzzy match"
+ :type 'boolean)
+
+(defcustom helm-gtags-maximum-candidates (if helm-gtags-fuzzy-match 100 9999)
+ "Maximum number of helm candidates"
+ :type 'integer)
+
+(defcustom helm-gtags-direct-helm-completing nil
+ "Use helm mode directly."
+ :type 'boolean)
+
+(defface helm-gtags-file
+ '((t :inherit font-lock-keyword-face))
+ "Face for line numbers in the error list.")
+
+(defface helm-gtags-lineno
+ '((t :inherit font-lock-doc-face))
+ "Face for line numbers in the error list.")
+
+(defface helm-gtags-match
+ '((t :inherit helm-match))
+ "Face for word matched against tagname")
+
+(defvar helm-gtags--tag-location nil)
+(defvar helm-gtags--last-update-time 0)
+(defvar helm-gtags--completing-history nil)
+(defvar helm-gtags--context-stack (make-hash-table :test 'equal))
+(defvar helm-gtags--result-cache (make-hash-table :test 'equal))
+(defvar helm-gtags--saved-context nil)
+(defvar helm-gtags--use-otherwin nil)
+(defvar helm-gtags--local-directory nil)
+(defvar helm-gtags--parsed-file nil)
+(defvar helm-gtags--current-position nil)
+(defvar helm-gtags--real-tag-location nil)
+(defvar helm-gtags--last-input nil)
+(defvar helm-gtags--query nil)
+(defvar helm-gtags--last-default-directory nil)
+
+(defconst helm-gtags--buffer "*helm gtags*")
+
+(defconst helm-gtags--include-regexp
+ "\\`\\s-*#\\(?:include\\|import\\)\\s-*[\"<]\\(?:[./]*\\)?\\(.*?\\)[\">]")
+
+(defmacro helm-declare-obsolete-variable (old new version)
+ `(progn
+ (defvaralias ,old ,new)
+ (make-obsolete-variable ,old ,new ,version)))
+
+(helm-declare-obsolete-variable
+ 'helm-c-gtags-path-style 'helm-gtags-path-style "0.8")
+(helm-declare-obsolete-variable
+ 'helm-c-gtags-ignore-case 'helm-gtags-ignore-case "0.8")
+(helm-declare-obsolete-variable
+ 'helm-c-gtags-read-only 'helm-gtags-read-only "0.8")
+
+;; completsion function for completing-read.
+(defun helm-gtags--completing-gtags (string predicate code)
+ (helm-gtags--complete 'tag string predicate code))
+(defun helm-gtags--completing-pattern (string predicate code)
+ (helm-gtags--complete 'pattern string predicate code))
+(defun helm-gtags--completing-grtags (string predicate code)
+ (helm-gtags--complete 'rtag string predicate code))
+(defun helm-gtags--completing-gsyms (string predicate code)
+ (helm-gtags--complete 'symbol string predicate code))
+(defun helm-gtags--completing-files (string predicate code)
+ (helm-gtags--complete 'find-file string predicate code))
+
+(defconst helm-gtags-comp-func-alist
+ '((tag . helm-gtags--completing-gtags)
+ (pattern . helm-gtags--completing-pattern)
+ (rtag . helm-gtags--completing-grtags)
+ (symbol . helm-gtags--completing-gsyms)
+ (find-file . helm-gtags--completing-files)))
+
+(defconst helm-gtags--search-option-alist
+ '((pattern . "-g")
+ (rtag . "-r")
+ (symbol . "-s")
+ (find-file . "-Poa")))
+
+(defsubst helm-gtags--windows-p ()
+ (memq system-type '(windows-nt ms-dos)))
+
+(defun helm-gtags--remove-carrige-returns ()
+ (when (helm-gtags--windows-p)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "\xd" nil t)
+ (replace-match "")))))
+
+;; Work around for GNU global Windows issue
+(defsubst helm-gtags--use-abs-path-p (gtagslibpath)
+ (and (helm-gtags--windows-p) gtagslibpath))
+
+(defun helm-gtags--construct-options (type completion)
+ (let ((find-file-p (eq type 'find-file))
+ (gtagslibpath (getenv "GTAGSLIBPATH"))
+ options)
+ (unless find-file-p
+ (push "--result=grep" options))
+ (when completion
+ (push "-c" options))
+ (helm-aif (assoc-default type helm-gtags--search-option-alist)
+ (push it options))
+ (when (or (eq helm-gtags-path-style 'absolute)
+ (helm-gtags--use-abs-path-p gtagslibpath))
+ (push "-a" options))
+ (when helm-gtags-ignore-case
+ (push "-i" options))
+ (when (and current-prefix-arg (not find-file-p))
+ (push "-l" options))
+ (when gtagslibpath
+ (push "-T" options))
+ options))
+
+(defun helm-gtags--complete (type string predicate code)
+ (let* ((options (helm-gtags--construct-options type t))
+ (args (reverse (cons string options)))
+ candidates)
+ (with-temp-buffer
+ (apply #'process-file "global" nil t nil args)
+ (goto-char (point-min))
+ (while (re-search-forward "^\\(.+\\)$" nil t)
+ (push (match-string-no-properties 1) candidates)))
+ (if (not code)
+ (try-completion string candidates predicate)
+ (all-completions string candidates predicate))))
+
+(defun helm-gtags--token-at-point (type)
+ (if (not (eq type 'find-file))
+ (thing-at-point 'symbol)
+ (let ((line (helm-current-line-contents)))
+ (when (string-match helm-gtags--include-regexp line)
+ (match-string-no-properties 1 line)))))
+
+(defconst helm-gtags--prompt-alist
+ '((tag . "Find Definition: ")
+ (pattern . "Find Pattern: ")
+ (rtag . "Find Reference: ")
+ (symbol . "Find Symbol: ")
+ (find-file . "Find File: ")))
+
+(defun helm-gtags--read-tagname (type &optional default-tagname)
+ (let ((tagname (helm-gtags--token-at-point type))
+ (prompt (assoc-default type helm-gtags--prompt-alist))
+ (comp-func (assoc-default type helm-gtags-comp-func-alist)))
+ (if (and tagname helm-gtags-use-input-at-cursor)
+ tagname
+ (when (and (not tagname) default-tagname)
+ (setq tagname default-tagname))
+ (when tagname
+ (setq prompt (format "%s(default \"%s\") " prompt tagname)))
+ (let ((completion-ignore-case helm-gtags-ignore-case)
+ (completing-read-function 'completing-read-default))
+ (if (and helm-gtags-direct-helm-completing (memq type '(tag rtag symbol find-file)))
+ (helm-comp-read prompt comp-func
+ :history 'helm-gtags--completing-history
+ :exec-when-only-one t
+ :default tagname)
+ (completing-read prompt comp-func nil nil nil
+ 'helm-gtags--completing-history tagname))))))
+
+(defun helm-gtags--path-libpath-p (tagroot)
+ (helm-aif (getenv "GTAGSLIBPATH")
+ (cl-loop for path in (parse-colon-path it)
+ for libpath = (file-name-as-directory (expand-file-name path))
+ thereis (string= tagroot libpath))))
+
+(defun helm-gtags--tag-directory ()
+ (with-temp-buffer
+ (helm-aif (getenv "GTAGSROOT")
+ it
+ (unless (zerop (process-file "global" nil t nil "-p"))
+ (error "GTAGS not found"))
+ (goto-char (point-min))
+ (when (looking-at "^\\([^\r\n]+\\)")
+ (let ((tag-path (match-string-no-properties 1)))
+ (file-name-as-directory
+ (if (eq system-type 'cygwin)
+ (cygwin-convert-file-name-from-windows tag-path)
+ tag-path)))))))
+
+(defun helm-gtags--find-tag-directory ()
+ (setq helm-gtags--real-tag-location nil)
+ (let ((tagroot (helm-gtags--tag-directory)))
+ (if (and (helm-gtags--path-libpath-p tagroot) helm-gtags--tag-location)
+ (progn
+ (setq helm-gtags--real-tag-location tagroot)
+ helm-gtags--tag-location)
+ (setq helm-gtags--tag-location tagroot))))
+
+(defun helm-gtags--base-directory ()
+ (let ((dir (or helm-gtags--last-default-directory
+ helm-gtags--local-directory
+ (cl-case helm-gtags-path-style
+ (root (or helm-gtags--real-tag-location
+ helm-gtags--tag-location))
+ (otherwise default-directory))))
+ (remote (file-remote-p default-directory)))
+ (if (and remote (not (file-remote-p dir)))
+ (concat remote dir)
+ dir)))
+
+(defsubst helm-gtags--new-context-info (index stack)
+ (list :index index :stack stack))
+
+(defun helm-gtags--put-context-stack (tag-location index stack)
+ (puthash tag-location (helm-gtags--new-context-info index stack)
+ helm-gtags--context-stack))
+
+(defsubst helm-gtags--current-context ()
+ (let ((file (buffer-file-name (current-buffer))))
+ (list :file file :position (point) :readonly buffer-file-read-only)))
+
+(defsubst helm-gtags--save-current-context ()
+ (setq helm-gtags--saved-context (helm-gtags--current-context)))
+
+(defun helm-gtags--open-file (file readonly)
+ (if readonly
+ (find-file-read-only file)
+ (find-file file)))
+
+(defun helm-gtags--open-file-other-window (file readonly)
+ (setq helm-gtags--use-otherwin nil)
+ (if readonly
+ (find-file-read-only-other-window file)
+ (find-file-other-window file)))
+
+(defun helm-gtags--get-context-info ()
+ (let* ((tag-location (helm-gtags--find-tag-directory))
+ (context-info (gethash tag-location helm-gtags--context-stack))
+ (context-stack (plist-get context-info :stack)))
+ (if (null context-stack)
+ (error "Context stack is empty(TAG at %s)" tag-location)
+ context-info)))
+
+(defun helm-gtags--get-or-create-context-info ()
+ (or (gethash helm-gtags--tag-location helm-gtags--context-stack)
+ (helm-gtags--new-context-info -1 nil)))
+
+;;;###autoload
+(defun helm-gtags-clear-all-cache ()
+ (interactive)
+ (clrhash helm-gtags--result-cache))
+
+;;;###autoload
+(defun helm-gtags-clear-cache ()
+ (interactive)
+ (helm-gtags--find-tag-directory)
+ (let* ((tag-location (or helm-gtags--real-tag-location
+ helm-gtags--tag-location))
+ (gtags-path (concat tag-location "GTAGS"))
+ (gpath-path (concat tag-location "GPATH")))
+ (remhash gtags-path helm-gtags--result-cache)
+ (remhash gpath-path helm-gtags--result-cache)))
+
+(defun helm-gtags--move-to-context (context)
+ (let ((file (plist-get context :file))
+ (curpoint (plist-get context :position))
+ (readonly (plist-get context :readonly)))
+ (helm-gtags--open-file file readonly)
+ (goto-char curpoint)
+ (recenter)))
+
+;;;###autoload
+(defun helm-gtags-next-history ()
+ "Jump to next position on context stack"
+ (interactive)
+ (let* ((context-info (helm-gtags--get-context-info))
+ (current-index (plist-get context-info :index))
+ (context-stack (plist-get context-info :stack))
+ context)
+ (when (<= current-index -1)
+ (error "This context is latest in context stack"))
+ (setf (nth current-index context-stack) (helm-gtags--current-context))
+ (cl-decf current-index)
+ (if (= current-index -1)
+ (setq context helm-gtags--current-position
+ helm-gtags--current-position nil)
+ (setq context (nth current-index context-stack)))
+ (helm-gtags--put-context-stack helm-gtags--tag-location
+ current-index context-stack)
+ (helm-gtags--move-to-context context)))
+
+;;;###autoload
+(defun helm-gtags-previous-history ()
+ "Jump to previous position on context stack"
+ (interactive)
+ (let* ((context-info (helm-gtags--get-context-info))
+ (current-index (plist-get context-info :index))
+ (context-stack (plist-get context-info :stack))
+ (context-length (length context-stack)))
+ (cl-incf current-index)
+ (when (>= current-index context-length)
+ (error "This context is last in context stack"))
+ (if (= current-index 0)
+ (setq helm-gtags--current-position (helm-gtags--current-context))
+ (setf (nth (- current-index 1) context-stack) (helm-gtags--current-context)))
+ (let ((prev-context (nth current-index context-stack)))
+ (helm-gtags--move-to-context prev-context))
+ (helm-gtags--put-context-stack helm-gtags--tag-location
+ current-index context-stack)))
+
+(defun helm-gtags--get-result-cache (file)
+ (helm-gtags--find-tag-directory)
+ (let* ((file-path (concat (or helm-gtags--real-tag-location
+ helm-gtags--tag-location)
+ file))
+ (file-mtime (nth 5 (file-attributes file-path)))
+ (hash-value (gethash file-path helm-gtags--result-cache))
+ (cached-file-mtime (nth 0 hash-value)))
+ (if (and cached-file-mtime (equal cached-file-mtime file-mtime))
+ (nth 1 hash-value)
+ nil)))
+
+(defun helm-gtags--put-result-cache (file cache)
+ (helm-gtags--find-tag-directory)
+ (let* ((file-path (concat (or helm-gtags--real-tag-location
+ helm-gtags--tag-location)
+ file))
+ (file-mtime (nth 5 (file-attributes file-path)))
+ (hash-value (list file-mtime cache)))
+ (puthash file-path hash-value helm-gtags--result-cache)))
+
+(defun helm-gtags--referer-function (file ref-line)
+ (let ((is-opened (cl-loop with path = (concat default-directory file)
+ for buf in (buffer-list)
+ when (string= (buffer-file-name buf) path)
+ return it))
+ retval)
+ (with-current-buffer (find-file-noselect file)
+ (goto-char (point-min))
+ (forward-line (1- ref-line))
+ (unless (zerop (current-indentation))
+ (setq retval (which-function)))
+ (unless is-opened
+ (kill-buffer (current-buffer)))
+ retval)))
+
+(defun helm-gtags--show-detail ()
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let ((line (helm-current-line-contents)))
+ (let* ((file-and-line (helm-gtags--extract-file-and-line line))
+ (file (car file-and-line))
+ (ref-line (cdr file-and-line))
+ (ref-func (helm-gtags--referer-function file ref-line)))
+ (when ref-func
+ (search-forward ":" nil nil 2)
+ (insert " " ref-func "|"))
+ (forward-line 1)))))
+
+(defun helm-gtags--print-path-in-gtagslibpath (args)
+ (let ((libpath (getenv "GTAGSLIBPATH")))
+ (when libpath
+ (dolist (path (parse-colon-path libpath))
+ (let ((default-directory (file-name-as-directory path)))
+ (apply #'process-file "global" nil t nil "-Poa" args))))))
+
+(defun helm-gtags--exec-global-command (type input &optional detail)
+ (let ((args (helm-gtags--construct-command type input)))
+ (helm-gtags--find-tag-directory)
+ (helm-gtags--save-current-context)
+ (let ((buf-coding buffer-file-coding-system))
+ (with-current-buffer (helm-candidate-buffer 'global)
+ (let ((default-directory (helm-gtags--base-directory))
+ (input (car (last args)))
+ (coding-system-for-read buf-coding)
+ (coding-system-for-write buf-coding))
+ (unless (zerop (apply #'process-file "global" nil '(t nil) nil args))
+ (error (format "%s: not found" input)))
+ ;; --path options does not support searching under GTAGSLIBPATH
+ (when (eq type 'find-file)
+ (helm-gtags--print-path-in-gtagslibpath args))
+ (helm-gtags--remove-carrige-returns)
+ (when detail
+ (helm-gtags--show-detail)))))))
+
+(defun helm-gtags--construct-command (type &optional in)
+ (setq helm-gtags--local-directory nil)
+ (let ((dir (helm-attr 'helm-gtags-base-directory (helm-get-current-source))))
+ (when (and dir (not (eq type 'find-file)))
+ (setq helm-gtags--local-directory dir)))
+ (let ((input (or in helm-gtags--query))
+ (options (helm-gtags--construct-options type nil)))
+ (when (string= input "")
+ (error "Input is empty!!"))
+ (setq helm-gtags--last-input input)
+ (reverse (cons input options))))
+
+(defun helm-gtags--tags-init (&optional input)
+ (helm-gtags--exec-global-command 'tag input))
+
+(defun helm-gtags--pattern-init (&optional input)
+ (helm-gtags--exec-global-command 'pattern input helm-gtags-display-style))
+
+(defun helm-gtags--rtags-init (&optional input)
+ (helm-gtags--exec-global-command 'rtag input helm-gtags-display-style))
+
+(defun helm-gtags--gsyms-init ()
+ (helm-gtags--exec-global-command 'symbol nil helm-gtags-display-style))
+
+(defun helm-gtags--files-init ()
+ (helm-gtags--exec-global-command 'find-file nil))
+
+(defun helm-gtags--real-file-name ()
+ (let ((buffile (buffer-file-name)))
+ (unless buffile
+ (error "This buffer is not related to file."))
+ (if (file-remote-p buffile)
+ (tramp-file-name-localname (tramp-dissect-file-name buffile))
+ (file-truename buffile))))
+
+(defun helm-gtags--find-tag-from-here-init ()
+ (helm-gtags--find-tag-directory)
+ (helm-gtags--save-current-context)
+ (let ((token (helm-gtags--token-at-point 'from-here)))
+ (unless token
+ (error "Cursor is not on symbol."))
+ (let* ((filename (helm-gtags--real-file-name))
+ (from-here-opt (format "--from-here=%d:%s"
+ (line-number-at-pos)
+ (if (eq system-type 'cygwin)
+ (cygwin-convert-file-name-to-windows filename)
+ filename))))
+ (setq helm-gtags--last-input token)
+ (with-current-buffer (helm-candidate-buffer 'global)
+ (let* ((default-directory (helm-gtags--base-directory))
+ (status (process-file "global" nil '(t nil) nil
+ "--result=grep" from-here-opt token)))
+ (helm-gtags--remove-carrige-returns)
+ (unless (zerop status)
+ (cond ((= status 1)
+ (error "Error: %s%s" (buffer-string) filename))
+ ((= status 3)
+ (error "Error: %s" (buffer-string)))
+ (t (error "%s: not found" token)))))))))
+
+(defun helm-gtags--parse-file-init ()
+ (with-current-buffer (helm-candidate-buffer 'global)
+ (unless (zerop (process-file "global" nil t nil
+ "--result=cscope" "-f" helm-gtags--parsed-file))
+ (error "Failed: 'global --result=cscope -f %s" helm-gtags--parsed-file))
+ (helm-gtags--remove-carrige-returns)))
+
+(defun helm-gtags--push-context (context)
+ (let* ((context-info (helm-gtags--get-or-create-context-info))
+ (current-index (plist-get context-info :index))
+ (context-stack (plist-get context-info :stack)))
+ (unless (= current-index -1)
+ (setq context-stack (nthcdr (1+ current-index) context-stack)))
+ (setq helm-gtags--current-position nil)
+ (push context context-stack)
+ (helm-gtags--put-context-stack helm-gtags--tag-location -1 context-stack)))
+
+(defsubst helm-gtags--select-find-file-func ()
+ (if helm-gtags--use-otherwin
+ #'helm-gtags--open-file-other-window
+ #'helm-gtags--open-file))
+
+(defun helm-gtags--do-open-file (open-func file line)
+ (funcall open-func file helm-gtags-read-only)
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (back-to-indentation)
+ (recenter)
+ (helm-gtags--push-context helm-gtags--saved-context)
+ (when helm-gtags-pulse-at-cursor
+ (pulse-momentary-highlight-one-line (point))))
+
+(defun helm-gtags--find-line-number (cand)
+ (if (string-match "\\s-+\\([1-9][0-9]+\\)\\s-+" cand)
+ (string-to-number (match-string-no-properties 1 cand))
+ (error "Can't find line number in %s" cand)))
+
+(defun helm-gtags--parse-file-action (cand)
+ (let ((line (helm-gtags--find-line-number cand))
+ (open-func (helm-gtags--select-find-file-func)))
+ (helm-gtags--do-open-file open-func helm-gtags--parsed-file line)))
+
+(defsubst helm-gtags--has-drive-letter-p (path)
+ (string-match-p "\\`[a-zA-Z]:" path))
+
+(defun helm-gtags--extract-file-and-line (cand)
+ (if (and (helm-gtags--windows-p) (helm-gtags--has-drive-letter-p cand))
+ (when (string-match "\\(\\`[a-zA-Z]:[^:]+\\):\\([^:]+\\)" cand)
+ (cons (match-string-no-properties 1 cand)
+ (string-to-number (match-string-no-properties 2 cand))))
+ (let ((elems (split-string cand ":")))
+ (cons (cl-first elems) (string-to-number (cl-second elems))))))
+
+(defun helm-gtags--action-openfile (cand)
+ (let* ((file-and-line (helm-gtags--extract-file-and-line cand))
+ (filename (car file-and-line))
+ (line (cdr file-and-line))
+ (open-func (helm-gtags--select-find-file-func))
+ (default-directory (helm-gtags--base-directory)))
+ (helm-gtags--do-open-file open-func filename line)))
+
+(defun helm-gtags--action-openfile-other-window (cand)
+ (let ((helm-gtags--use-otherwin t))
+ (helm-gtags--action-openfile cand)))
+
+(defun helm-gtags--file-content-at-pos (file pos)
+ (with-current-buffer (find-file-noselect file)
+ (save-excursion
+ (goto-char pos)
+ (format "%s:%d:%s:%s"
+ file (line-number-at-pos)
+ (helm-aif (which-function) (format "[%s]" it) "")
+ (helm-current-line-contents)))))
+
+(defun helm-gtags--files-candidate-transformer (file)
+ (if (eq helm-gtags-path-style 'absolute)
+ file
+ (let ((removed-regexp (concat "\\`" helm-gtags--tag-location)))
+ (replace-regexp-in-string removed-regexp "" file))))
+
+(defun helm-gtags--show-stack-init ()
+ (cl-loop with context-stack = (plist-get (helm-gtags--get-context-info) :stack)
+ with stack-length = (length context-stack)
+ for context in (reverse context-stack)
+ for file = (plist-get context :file)
+ for pos = (plist-get context :position)
+ for index = (1- stack-length) then (1- index)
+ for line = (helm-gtags--file-content-at-pos file pos)
+ for cand = (helm-gtags--files-candidate-transformer line)
+ collect (cons cand (propertize cand 'index index))))
+
+(defun helm-gtags--persistent-action (cand)
+ (let* ((file-and-line (helm-gtags--extract-file-and-line cand))
+ (filename (car file-and-line))
+ (line (cdr file-and-line))
+ (default-directory (helm-gtags--base-directory)))
+ (when (eq helm-gtags-path-style 'relative)
+ (setq helm-gtags--last-default-directory default-directory))
+ (find-file filename)
+ (goto-char (point-min))
+ (forward-line (1- line))
+ (helm-highlight-current-line)))
+
+(defun helm-gtags--file-persistent-action (cand)
+ (let ((default-directory (with-helm-current-buffer
+ default-directory)))
+ (helm-ff-kill-or-find-buffer-fname cand)))
+
+(defvar helm-gtags--find-file-action
+ (helm-make-actions
+ "Open file" #'helm-gtags--action-openfile
+ "Open file other window" #'helm-gtags--action-openfile-other-window))
+
+(defvar helm-source-gtags-tags
+ (helm-build-in-buffer-source "Jump to definitions"
+ :init 'helm-gtags--tags-init
+ :candidate-number-limit helm-gtags-maximum-candidates
+ :real-to-display 'helm-gtags--candidate-transformer
+ :persistent-action 'helm-gtags--persistent-action
+ :fuzzy-match helm-gtags-fuzzy-match
+ :action helm-gtags--find-file-action))
+
+(defvar helm-source-gtags-pattern
+ (helm-build-in-buffer-source "Find pattern"
+ :init 'helm-gtags--pattern-init
+ :candidate-number-limit helm-gtags-maximum-candidates
+ :real-to-display 'helm-gtags--candidate-transformer
+ :persistent-action 'helm-gtags--persistent-action
+ :fuzzy-match helm-gtags-fuzzy-match
+ :action helm-gtags--find-file-action))
+
+(defvar helm-source-gtags-rtags
+ (helm-build-in-buffer-source "Jump to references"
+ :init 'helm-gtags--rtags-init
+ :candidate-number-limit helm-gtags-maximum-candidates
+ :real-to-display 'helm-gtags--candidate-transformer
+ :persistent-action 'helm-gtags--persistent-action
+ :fuzzy-match helm-gtags-fuzzy-match
+ :action helm-gtags--find-file-action))
+
+(defvar helm-source-gtags-gsyms
+ (helm-build-in-buffer-source "Jump to symbols"
+ :init 'helm-gtags--gsyms-init
+ :candidate-number-limit helm-gtags-maximum-candidates
+ :real-to-display 'helm-gtags--candidate-transformer
+ :persistent-action 'helm-gtags--persistent-action
+ :fuzzy-match helm-gtags-fuzzy-match
+ :action helm-gtags--find-file-action))
+
+(defun helm-gtags--highlight-candidate (candidate)
+ (let ((regexp (concat "\\_<" helm-gtags--last-input "\\_>"))
+ (limit (1- (length candidate)))
+ (last-pos 0)
+ (case-fold-search nil))
+ (while (and (< last-pos limit)
+ (string-match regexp candidate last-pos))
+ (put-text-property (match-beginning 0) (match-end 0)
+ 'face 'helm-gtags-match
+ candidate)
+ (setq last-pos (1+ (match-end 0))))
+ candidate))
+
+(defun helm-gtags--transformer-regexp (candidate)
+ (if (and (helm-gtags--windows-p) (helm-gtags--has-drive-letter-p candidate))
+ "\\`\\([a-zA-Z]:[^:]+\\):\\([^:]+\\):\\(.*\\)"
+ "\\`\\([^:]+\\):\\([^:]+\\):\\(.*\\)"))
+
+(defun helm-gtags--candidate-transformer (candidate)
+ (if (not helm-gtags-highlight-candidate)
+ candidate
+ (let ((regexp (helm-gtags--transformer-regexp candidate)))
+ (when (string-match regexp candidate)
+ (format "%s:%s:%s"
+ (propertize (match-string 1 candidate) 'face 'helm-gtags-file)
+ (propertize (match-string 2 candidate) 'face 'helm-gtags-lineno)
+ (helm-gtags--highlight-candidate (match-string 3 candidate)))))))
+
+(defun helm-gtags--parse-file-candidate-transformer (file)
+ (let ((removed-file (replace-regexp-in-string "\\`\\S-+ " "" file)))
+ (when (string-match "\\`\\(\\S-+\\) \\(\\S-+\\) \\(.+\\)\\'" removed-file)
+ (format "%-25s %-5s %s"
+ (match-string-no-properties 1 removed-file)
+ (match-string-no-properties 2 removed-file)
+ (match-string-no-properties 3 removed-file)))))
+
+(defvar helm-source-gtags-files
+ (helm-build-in-buffer-source "Find files"
+ :init 'helm-gtags--files-init
+ :candidate-number-limit helm-gtags-maximum-candidates
+ :real-to-display 'helm-gtags--files-candidate-transformer
+ :persistent-action 'helm-gtags--persistent-action
+ :fuzzy-match helm-gtags-fuzzy-match
+ :action (helm-actions-from-type-file)))
+
+(defvar helm-source-gtags-find-tag-from-here
+ (helm-build-in-buffer-source "Find tag from here"
+ :init 'helm-gtags--find-tag-from-here-init
+ :candidate-number-limit helm-gtags-maximum-candidates
+ :real-to-display 'helm-gtags--candidate-transformer
+ :persistent-action 'helm-gtags--persistent-action
+ :fuzzy-match helm-gtags-fuzzy-match
+ :action helm-gtags--find-file-action))
+
+(defvar helm-source-gtags-parse-file
+ (helm-build-in-buffer-source "Parse file"
+ :init 'helm-gtags--parse-file-init
+ :candidate-number-limit helm-gtags-maximum-candidates
+ :real-to-display 'helm-gtags--parse-file-candidate-transformer
+ :fuzzy-match helm-gtags-fuzzy-match
+ :action 'helm-gtags--parse-file-action))
+
+(defun helm-gtags--show-stack-action (cand)
+ (let* ((index (get-text-property 0 'index cand))
+ (context-info (helm-gtags--get-context-info))
+ (context-stack (plist-get context-info :stack)))
+ (helm-gtags--put-context-stack helm-gtags--tag-location
+ index context-stack)
+ (helm-gtags--move-to-context (nth index context-stack))))
+
+(defvar helm-source-gtags-show-stack
+ (helm-build-sync-source "Show Context Stack"
+ :candidates 'helm-gtags--show-stack-init
+ :volatile t
+ :candidate-number-limit helm-gtags-maximum-candidates
+ :persistent-action 'helm-gtags--persistent-action
+ :fuzzy-match helm-gtags-fuzzy-match
+ :action 'helm-gtags--show-stack-action))
+
+;;;###autoload
+(defun helm-gtags-select ()
+ (interactive)
+ (helm-gtags--common '(helm-source-gtags-select) nil))
+
+;;;###autoload
+(defun helm-gtags-select-path ()
+ (interactive)
+ (helm-gtags--common '(helm-source-gtags-select-path) nil))
+
+(defsubst helm-gtags--beginning-of-defun ()
+ (cl-case major-mode
+ ((c-mode c++-mode java-mode) 'c-beginning-of-defun)
+ (php-mode 'php-beginning-of-defun)
+ (otherwise #'beginning-of-defun)))
+
+(defsubst helm-gtags--end-of-defun ()
+ (cl-case major-mode
+ ((c-mode c++-mode java-mode malabar-mode) 'c-end-of-defun)
+ (php-mode 'php-end-of-defun)
+ (otherwise #'end-of-defun)))
+
+(defun helm-gtags--current-funcion-bound ()
+ (save-excursion
+ (let (start)
+ (funcall (helm-gtags--beginning-of-defun))
+ (setq start (line-number-at-pos))
+ (funcall (helm-gtags--end-of-defun))
+ (cons start (line-number-at-pos)))))
+
+(defun helm-gtags--tags-refered-from-this-function ()
+ (let* ((file (helm-gtags--real-file-name))
+ (bound (helm-gtags--current-funcion-bound))
+ (start-line (car bound))
+ (end-line (cdr bound)))
+ (with-temp-buffer
+ (unless (process-file "global" nil t nil "-f" "-r" file)
+ (error "Failed: global -f -r %s" file))
+ (goto-char (point-min))
+ (let (tagnames finish)
+ (while (and (not finish) (not (eobp)))
+ (let* ((cols (split-string (helm-current-line-contents) nil t))
+ (lineno (string-to-number (cl-second cols))))
+ (if (and (> lineno start-line) (< lineno end-line))
+ (let* ((tag (cl-first cols))
+ (elm (cl-find tag tagnames :test 'equal)))
+ (unless elm
+ (push tag tagnames)))
+ (when (>= lineno end-line)
+ (setq finish t)))
+ (forward-line 1)))
+ (reverse tagnames)))))
+
+(defun helm-gtags--tag-in-function-persistent-action (cand)
+ (let* ((bound (helm-gtags--current-funcion-bound))
+ (limit (save-excursion
+ (goto-char (point-min))
+ (forward-line (cdr bound))
+ (goto-char (line-end-position))
+ (point))))
+ (when (search-forward cand nil limit)
+ (helm-highlight-current-line))))
+
+;;;###autoload
+(defun helm-gtags-tags-in-this-function ()
+ "Show tagnames which are referenced in this function and jump to it."
+ (interactive)
+ (let ((tags (helm-gtags--tags-refered-from-this-function)))
+ (unless tags
+ (error "There are no tags which are refered from this function."))
+ (let* ((name (format "Tags in [%s]" (which-function)))
+ (tag (helm-comp-read
+ "Tagnames: " tags
+ :must-match t :name name
+ :persistent-action 'helm-gtags--tag-in-function-persistent-action)))
+ (helm-gtags-find-tag tag))))
+
+(defun helm-gtags--source-select-tag (candidate)
+ (helm-build-in-buffer-source "Select Tag"
+ :init (lambda () (helm-gtags--tags-init candidate))
+ :candidate-number-limit helm-gtags-maximum-candidates
+ :persistent-action 'helm-gtags--persistent-action
+ :fuzzy-match helm-gtags-fuzzy-match
+ :action helm-gtags--find-file-action))
+
+(defun helm-gtags--source-select-rtag (candidate)
+ (helm-build-in-buffer-source "Select Rtag"
+ :init (lambda () (helm-gtags--rtags-init candidate))
+ :candidate-number-limit helm-gtags-maximum-candidates
+ :persistent-action 'helm-gtags--persistent-action
+ :fuzzy-match helm-gtags-fuzzy-match
+ :action helm-gtags--find-file-action))
+
+(defsubst helm-gtags--action-by-timer (src)
+ (run-with-timer 0.1 nil (lambda () (helm-gtags--common (list src) nil))))
+
+(defun helm-gtags--select-tag-action (c)
+ (helm-gtags--action-by-timer (helm-gtags--source-select-tag c)))
+
+(defun helm-gtags--select-rtag-action (c)
+ (helm-gtags--action-by-timer (helm-gtags--source-select-rtag c)))
+
+(defun helm-gtags--select-cache-init-common (args tagfile)
+ (let ((cache (helm-gtags--get-result-cache tagfile)))
+ (if cache
+ (insert cache)
+ (apply #'process-file "global" nil t nil args)
+ (let* ((cache (buffer-string))
+ (cache-size (length cache)))
+ (when (<= cache-size helm-gtags-cache-max-result-size)
+ (helm-gtags--put-result-cache tagfile cache))))))
+
+(defun helm-gtags--source-select-init ()
+ (with-current-buffer (helm-candidate-buffer 'global)
+ (if (not helm-gtags-cache-select-result)
+ (progn
+ (process-file "global" nil t nil "-c")
+ (helm-gtags--remove-carrige-returns))
+ (helm-gtags--select-cache-init-common '("-c") "GTAGS"))))
+
+(defvar helm-source-gtags-select
+ (helm-build-in-buffer-source "Find tag from here"
+ :init 'helm-gtags--source-select-init
+ :candidate-number-limit helm-gtags-maximum-candidates
+ :persistent-action #'ignore
+ :fuzzy-match helm-gtags-fuzzy-match
+ :action (helm-make-actions
+ "Goto the location" #'helm-gtags--select-tag-action
+ "Goto the location(other buffer)"
+ (lambda (c)
+ (setq helm-gtags--use-otherwin t)
+ (helm-gtags--select-tag-action c))
+ "Move to the referenced point" #'helm-gtags--select-rtag-action)))
+
+(defun helm-gtags--select-path-init ()
+ (helm-gtags--find-tag-directory)
+ (with-current-buffer (helm-candidate-buffer 'global)
+ (let ((options (if (eq helm-gtags-path-style 'relative) "-Po" "-Poa")))
+ (if (not helm-gtags-cache-select-result)
+ (progn
+ (process-file "global" nil t nil options)
+ (helm-gtags--remove-carrige-returns))
+ (helm-gtags--select-cache-init-common options "GPATH")))))
+
+(defvar helm-source-gtags-select-path
+ (helm-build-in-buffer-source "Select path"
+ :init 'helm-gtags--select-path-init
+ :candidate-number-limit helm-gtags-maximum-candidates
+ :real-to-display 'helm-gtags--files-candidate-transformer
+ :persistent-action #'helm-gtags--file-persistent-action
+ :fuzzy-match helm-gtags-fuzzy-match
+ :action (helm-actions-from-type-file)))
+
+(defun helm-gtags--searched-directory ()
+ (cl-case (prefix-numeric-value current-prefix-arg)
+ (4 (let ((dir (read-directory-name "Input Directory: ")))
+ (setq helm-gtags--local-directory (file-name-as-directory dir))))
+ (16 (file-name-directory (buffer-file-name)))))
+
+(defsubst helm-gtags--using-other-window-p ()
+ (< (prefix-numeric-value current-prefix-arg) 0))
+
+(defun helm-gtags--make-gtags-sentinel (action)
+ (lambda (process _event)
+ (when (eq (process-status process) 'exit)
+ (if (zerop (process-exit-status process))
+ (message "Success: %s TAGS" action)
+ (message "Failed: %s TAGS(%d)" action (process-exit-status process))))))
+
+(defsubst helm-gtags--read-gtagslabel ()
+ (let ((labels '("default" "native" "ctags" "pygments")))
+ (completing-read "GTAGSLABEL(Default: default): " labels nil t nil nil "default")))
+
+(defsubst helm-gtags--label-option (label)
+ (concat "--gtagslabel=" label))
+
+;;;###autoload
+(defun helm-gtags-create-tags (dir label)
+ (interactive
+ (list (read-directory-name "Root Directory: ")
+ (helm-gtags--read-gtagslabel)))
+ (let ((default-directory dir)
+ (proc-buf (get-buffer-create " *helm-gtags-create*")))
+ (let ((proc (start-file-process "helm-gtags-create" proc-buf
+ "gtags" "-q" (helm-gtags--label-option label))))
+ (set-process-sentinel proc (helm-gtags--make-gtags-sentinel 'create)))))
+
+(defun helm-gtags--find-tag-simple ()
+ (or (getenv "GTAGSROOT")
+ (locate-dominating-file default-directory "GTAGS")
+ (if (not (yes-or-no-p "File GTAGS not found. Run 'gtags'? "))
+ (user-error "Abort")
+ (let* ((tagroot (read-directory-name "Root Directory: "))
+ (label (helm-gtags--read-gtagslabel))
+ (default-directory tagroot))
+ (message "gtags is generating tags....")
+ (unless (zerop (process-file "gtags" nil nil nil
+ "-q" (helm-gtags--label-option label)))
+ (error "Faild: 'gtags -q'"))
+ tagroot))))
+
+(defun helm-gtags--current-file-and-line ()
+ (let* ((buffile (buffer-file-name))
+ (path (cl-case helm-gtags-path-style
+ (absolute buffile)
+ (root
+ (file-relative-name buffile (helm-gtags--find-tag-directory)))
+ (relative
+ (file-relative-name buffile (helm-gtags--base-directory))))))
+ (format "%s:%d" path (line-number-at-pos))))
+
+(defsubst helm-gtags--clear-variables ()
+ (setq helm-gtags--last-default-directory nil))
+
+(defun helm-gtags--common (srcs tagname)
+ (helm-gtags--clear-variables)
+ (let ((helm-quit-if-no-candidate t)
+ (helm-execute-action-at-once-if-one t)
+ (dir (helm-gtags--searched-directory))
+ (src (car srcs))
+ (preselect-regexp (when helm-gtags-preselect
+ (regexp-quote (helm-gtags--current-file-and-line)))))
+ (when (symbolp src)
+ (setq src (symbol-value src)))
+ (unless helm-gtags--use-otherwin
+ (setq helm-gtags--use-otherwin (helm-gtags--using-other-window-p)))
+ (when tagname
+ (setq helm-gtags--query tagname))
+ (let ((tagroot (helm-gtags--find-tag-simple)))
+ (helm-attrset 'helm-gtags-base-directory dir src)
+ (helm-attrset 'name (format "%s in %s" tagname (or dir tagroot)) src)
+ (helm :sources srcs :buffer helm-gtags--buffer
+ :preselect preselect-regexp))))
+
+;;;###autoload
+(defun helm-gtags-find-tag (tag)
+ "Jump to definition"
+ (interactive
+ (list (helm-gtags--read-tagname 'tag)))
+ (helm-gtags--common '(helm-source-gtags-tags) tag))
+
+;;;###autoload
+(defun helm-gtags-find-tag-other-window (tag)
+ "Jump to definition in other window."
+ (interactive
+ (list (helm-gtags--read-tagname 'tag)))
+ (setq helm-gtags--use-otherwin t)
+ (helm-gtags-find-tag tag))
+
+;;;###autoload
+(defun helm-gtags-find-rtag (tag)
+ "Jump to referenced point"
+ (interactive
+ (list (helm-gtags--read-tagname 'rtag (which-function))))
+ (helm-gtags--common '(helm-source-gtags-rtags) tag))
+
+;;;###autoload
+(defun helm-gtags-find-symbol (tag)
+ "Jump to the symbol location"
+ (interactive
+ (list (helm-gtags--read-tagname 'symbol)))
+ (helm-gtags--common '(helm-source-gtags-gsyms) tag))
+
+;;;###autoload
+(defun helm-gtags-find-pattern (pattern)
+ "Grep and jump by gtags tag files."
+ (interactive
+ (list (helm-gtags--read-tagname 'pattern)))
+ (helm-gtags--common '(helm-source-gtags-pattern) pattern))
+
+(defun helm-gtags--find-file-after-hook ()
+ (helm-gtags--push-context helm-gtags--saved-context))
+
+;;;###autoload
+(defun helm-gtags-find-files (file)
+ "Find file from tagged with gnu global."
+ (interactive
+ (list (helm-gtags--read-tagname 'find-file)))
+ (add-hook 'helm-after-action-hook 'helm-gtags--find-file-after-hook)
+ (unwind-protect
+ (helm-gtags--common '(helm-source-gtags-files) file)
+ (remove-hook 'helm-after-action-hook 'helm-gtags--find-file-after-hook)))
+
+;;;###autoload
+(defun helm-gtags-find-tag-from-here ()
+ "Jump point by current point information.
+Jump to definition point if cursor is on its reference.
+Jump to reference point if curosr is on its definition"
+ (interactive)
+ (helm-gtags--common '(helm-source-gtags-find-tag-from-here) nil))
+
+;;;###autoload
+(defun helm-gtags-dwim ()
+ "Find by context. Here is
+- on include statement then jump to included file
+- on symbol definition then jump to its references
+- on reference point then jump to its definition."
+ (interactive)
+ (let ((line (helm-current-line-contents)))
+ (if (string-match helm-gtags--include-regexp line)
+ (let ((helm-gtags-use-input-at-cursor t))
+ (helm-gtags-find-files (match-string-no-properties 1 line)))
+ (if (and (buffer-file-name) (thing-at-point 'symbol))
+ (helm-gtags-find-tag-from-here)
+ (call-interactively 'helm-gtags-find-tag)))))
+
+(defun helm-gtags--set-parsed-file ()
+ (let* ((this-file (file-name-nondirectory (buffer-file-name)))
+ (file (if current-prefix-arg
+ (read-file-name "Parsed File: " nil this-file)
+ this-file)))
+ (setq helm-gtags--parsed-file (expand-file-name file))))
+
+(defun helm-gtags--find-preselect-line ()
+ (let ((defun-bound (bounds-of-thing-at-point 'defun)))
+ (if (not defun-bound)
+ (line-number-at-pos)
+ (let ((defun-begin-line (line-number-at-pos (car defun-bound)))
+ (filename (helm-gtags--real-file-name)))
+ (with-temp-buffer
+ (unless (zerop (process-file "global" nil t nil "-f" filename))
+ (error "Failed: global -f"))
+ (goto-char (point-min))
+ (let (start-line)
+ (while (and (not start-line)
+ (re-search-forward "^\\S-+\\s-+\\([1-9][0-9]*\\)" nil t))
+ (let ((line (string-to-number (match-string-no-properties 1))))
+ (when (>= line defun-begin-line)
+ (setq start-line line))))
+ (or start-line (line-number-at-pos))))))))
+
+;;;###autoload
+(defun helm-gtags-parse-file ()
+ "Parse current file with gnu global. This is similar to `imenu'.
+You can jump definitions of functions, symbols in this file."
+ (interactive)
+ (helm-gtags--find-tag-directory)
+ (helm-gtags--save-current-context)
+ (setq helm-gtags--use-otherwin (helm-gtags--using-other-window-p))
+ (helm-gtags--set-parsed-file)
+ (helm-attrset 'name
+ (format "Parsed File: %s"
+ (file-relative-name helm-gtags--parsed-file
+ helm-gtags--tag-location))
+ helm-source-gtags-parse-file)
+ (let ((presel (when helm-gtags-preselect
+ (format "^\\S-+\\s-+%d\\s-+" (helm-gtags--find-preselect-line)))))
+ (helm :sources '(helm-source-gtags-parse-file)
+ :buffer helm-gtags--buffer :preselect presel)))
+
+;;;###autoload
+(defun helm-gtags-pop-stack ()
+ "Jump to previous point on the context stack and pop it from stack."
+ (interactive)
+ (let* ((context-info (helm-gtags--get-context-info))
+ (context-stack (plist-get context-info :stack))
+ (context (pop context-stack)))
+ (helm-gtags--put-context-stack helm-gtags--tag-location -1 context-stack)
+ (helm-gtags--move-to-context context)))
+
+;;;###autoload
+(defun helm-gtags-show-stack ()
+ "Show current context stack."
+ (interactive)
+ (helm-other-buffer 'helm-source-gtags-show-stack
+ (get-buffer-create helm-gtags--buffer)))
+
+;;;###autoload
+(defun helm-gtags-clear-stack ()
+ "Clear current context stack."
+ (interactive)
+ (let ((tag-location (helm-gtags--find-tag-directory)))
+ (message "Clear '%s' context stack." tag-location)
+ (remhash tag-location helm-gtags--context-stack)))
+
+;;;###autoload
+(defun helm-gtags-clear-all-stacks ()
+ "Clear all context stacks."
+ (interactive)
+ (message "Clear all context statks.")
+ (setq helm-gtags--context-stack (make-hash-table :test 'equal)))
+
+(defun helm-gtags--read-tag-directory ()
+ (let ((dir (read-directory-name "Directory tag generated: " nil nil t)))
+ ;; On Windows, "gtags d:/tmp" work, but "gtags d:/tmp/" doesn't
+ (directory-file-name (expand-file-name dir))))
+
+(defsubst helm-gtags--how-to-update-tags ()
+ (cl-case (prefix-numeric-value current-prefix-arg)
+ (4 'entire-update)
+ (16 'generate-other-directory)
+ (otherwise 'single-update)))
+
+(defun helm-gtags--update-tags-command (how-to)
+ (cl-case how-to
+ (entire-update '("global" "-u"))
+ (generate-other-directory (list "gtags" (helm-gtags--read-tag-directory)))
+ (single-update (list "global" "--single-update" (helm-gtags--real-file-name)))))
+
+(defun helm-gtags--update-tags-p (how-to interactive-p current-time)
+ (or interactive-p
+ (and (eq how-to 'single-update)
+ (buffer-file-name)
+ (or (not helm-gtags-update-interval-second)
+ (>= (- current-time helm-gtags--last-update-time)
+ helm-gtags-update-interval-second)))))
+
+;;;###autoload
+(defun helm-gtags-update-tags ()
+ "Update TAG file. Update All files with `C-u' prefix.
+Generate new TAG file in selected directory with `C-u C-u'"
+ (interactive)
+ (let ((how-to (helm-gtags--how-to-update-tags))
+ (interactive-p (called-interactively-p 'interactive))
+ (current-time (float-time (current-time))))
+ (when (helm-gtags--update-tags-p how-to interactive-p current-time)
+ (let* ((cmds (helm-gtags--update-tags-command how-to))
+ (proc (apply #'start-file-process "helm-gtags-update-tag" nil cmds)))
+ (if (not proc)
+ (message "Failed: %s" (mapconcat 'identity cmds " "))
+ (set-process-sentinel proc (helm-gtags--make-gtags-sentinel 'update))
+ (setq helm-gtags--last-update-time current-time))))))
+
+;;;###autoload
+(defun helm-gtags-resume ()
+ "Resurrect previously invoked `helm-gtags` command."
+ (interactive)
+ (unless (get-buffer helm-gtags--buffer)
+ (error "Error: helm-gtags buffer is not existed."))
+ (helm-resume helm-gtags--buffer))
+
+(defsubst helm-gtags--check-browser-installed (browser)
+ (let ((used-browser (or browser "mozilla")))
+ (unless (executable-find used-browser)
+ (error "Not found browser '%s'" used-browser))))
+
+(defun helm-gtags-display-browser ()
+ "Display current screen on hypertext browser.
+`browse-url-generic-program' is used as browser if its value is non-nil.
+`mozilla' is used in other case."
+ (interactive)
+ (let ((file (buffer-file-name)))
+ (if (not file)
+ (error "This buffer is not related to file.")
+ (let* ((lineopt (concat "+" (number-to-string (line-number-at-pos))))
+ (browser (symbol-value 'browse-url-generic-program))
+ (args (list lineopt file)))
+ (helm-gtags--check-browser-installed browser)
+ (when browser
+ (setq args (append (list "-b" browser) args)))
+ ;; `gozilla' commend never returns error status if command is failed.
+ (apply #'process-file "gozilla" nil nil nil args)))))
+
+(defvar helm-gtags-mode-name " HelmGtags")
+(defvar helm-gtags-mode-map (make-sparse-keymap))
+
+;;;###autoload
+(define-minor-mode helm-gtags-mode ()
+ "Enable helm-gtags"
+ :init-value nil
+ :global nil
+ :keymap helm-gtags-mode-map
+ :lighter helm-gtags-mode-name
+ (if helm-gtags-mode
+ (when helm-gtags-auto-update
+ (add-hook 'after-save-hook 'helm-gtags-update-tags nil t))
+ (when helm-gtags-auto-update
+ (remove-hook 'after-save-hook 'helm-gtags-update-tags t))))
+
+;; Key mapping of gtags-mode.
+(when helm-gtags-suggested-key-mapping
+ ;; Current key mapping.
+ (let ((prefix helm-gtags-prefix-key))
+ (define-key helm-gtags-mode-map (concat prefix "h") 'helm-gtags-display-browser)
+ (define-key helm-gtags-mode-map "\C-]" 'helm-gtags-find-tag-from-here)
+ (define-key helm-gtags-mode-map "\C-t" 'helm-gtags-pop-stack)
+ (define-key helm-gtags-mode-map (concat prefix "P") 'helm-gtags-find-files)
+ (define-key helm-gtags-mode-map (concat prefix "f") 'helm-gtags-parse-file)
+ (define-key helm-gtags-mode-map (concat prefix "g") 'helm-gtags-find-pattern)
+ (define-key helm-gtags-mode-map (concat prefix "s") 'helm-gtags-find-symbol)
+ (define-key helm-gtags-mode-map (concat prefix "r") 'helm-gtags-find-rtag)
+ (define-key helm-gtags-mode-map (concat prefix "t") 'helm-gtags-find-tag)
+ (define-key helm-gtags-mode-map (concat prefix "d") 'helm-gtags-find-tag)
+
+ ;; common
+ (define-key helm-gtags-mode-map "\e*" 'helm-gtags-pop-stack)
+ (define-key helm-gtags-mode-map "\e." 'helm-gtags-find-tag)
+ (define-key helm-gtags-mode-map "\C-x4." 'helm-gtags-find-tag-other-window)))
+
+(provide 'helm-gtags)
+
+;; Local Variables:
+;; coding: utf-8
+;; indent-tabs-mode: nil
+;; End:
+
+;;; helm-gtags.el ends here
projects / emacsconfig.git / commitdiff