From 1a1779161d627e4951d2c8dcb7a99f888480350f Mon Sep 17 00:00:00 2001 From: Andreas Gerler Date: Fri, 23 Oct 2015 15:08:34 +0200 Subject: [PATCH] added ggtags helm-gtags puppet-mode --- elpa/ggtags-20150814.842/ggtags-autoloads.el | 51 + elpa/ggtags-20150814.842/ggtags-pkg.el | 1 + elpa/ggtags-20150814.842/ggtags.el | 2363 +++++++++++++++++ elpa/ggtags-readme.txt | 21 + .../helm-gtags-autoloads.el | 148 ++ .../helm-gtags-20151016.201/helm-gtags-pkg.el | 1 + elpa/helm-gtags-20151016.201/helm-gtags.el | 1278 +++++++++ .../puppet-mode-autoloads.el | 24 + .../puppet-mode-pkg.el | 1 + elpa/puppet-mode-20150730.1208/puppet-mode.el | 1140 ++++++++ elpa/puppet-mode-readme.txt | 28 + 11 files changed, 5056 insertions(+) create mode 100644 elpa/ggtags-20150814.842/ggtags-autoloads.el create mode 100644 elpa/ggtags-20150814.842/ggtags-pkg.el create mode 100644 elpa/ggtags-20150814.842/ggtags.el create mode 100644 elpa/ggtags-readme.txt create mode 100644 elpa/helm-gtags-20151016.201/helm-gtags-autoloads.el create mode 100644 elpa/helm-gtags-20151016.201/helm-gtags-pkg.el create mode 100644 elpa/helm-gtags-20151016.201/helm-gtags.el create mode 100644 elpa/puppet-mode-20150730.1208/puppet-mode-autoloads.el create mode 100644 elpa/puppet-mode-20150730.1208/puppet-mode-pkg.el create mode 100644 elpa/puppet-mode-20150730.1208/puppet-mode.el create mode 100644 elpa/puppet-mode-readme.txt diff --git a/elpa/ggtags-20150814.842/ggtags-autoloads.el b/elpa/ggtags-20150814.842/ggtags-autoloads.el new file mode 100644 index 00000000..c094eb8f --- /dev/null +++ b/elpa/ggtags-20150814.842/ggtags-autoloads.el @@ -0,0 +1,51 @@ +;;; ggtags-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (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) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; ggtags-autoloads.el ends here diff --git a/elpa/ggtags-20150814.842/ggtags-pkg.el b/elpa/ggtags-20150814.842/ggtags-pkg.el new file mode 100644 index 00000000..b4845fe2 --- /dev/null +++ b/elpa/ggtags-20150814.842/ggtags-pkg.el @@ -0,0 +1 @@ +(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")) diff --git a/elpa/ggtags-20150814.842/ggtags.el b/elpa/ggtags-20150814.842/ggtags.el new file mode 100644 index 00000000..ac29b0f0 --- /dev/null +++ b/elpa/ggtags-20150814.842/ggtags.el @@ -0,0 +1,2363 @@ +;;; 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 +;; 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 . + +;;; 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 diff --git a/elpa/ggtags-readme.txt b/elpa/ggtags-readme.txt new file mode 100644 index 00000000..9b0edca5 --- /dev/null +++ b/elpa/ggtags-readme.txt @@ -0,0 +1,21 @@ +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 diff --git a/elpa/helm-gtags-20151016.201/helm-gtags-autoloads.el b/elpa/helm-gtags-20151016.201/helm-gtags-autoloads.el new file mode 100644 index 00000000..9aed4d92 --- /dev/null +++ b/elpa/helm-gtags-20151016.201/helm-gtags-autoloads.el @@ -0,0 +1,148 @@ +;;; helm-gtags-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (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) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; helm-gtags-autoloads.el ends here diff --git a/elpa/helm-gtags-20151016.201/helm-gtags-pkg.el b/elpa/helm-gtags-20151016.201/helm-gtags-pkg.el new file mode 100644 index 00000000..f4ff00cc --- /dev/null +++ b/elpa/helm-gtags-20151016.201/helm-gtags-pkg.el @@ -0,0 +1 @@ +(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") diff --git a/elpa/helm-gtags-20151016.201/helm-gtags.el b/elpa/helm-gtags-20151016.201/helm-gtags.el new file mode 100644 index 00000000..f86b1fdb --- /dev/null +++ b/elpa/helm-gtags-20151016.201/helm-gtags.el @@ -0,0 +1,1278 @@ +;;; helm-gtags.el --- GNU GLOBAL helm interface -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 by Syohei YOSHIDA + +;; Author: Syohei YOSHIDA +;; 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 . + +;;; 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 diff --git a/elpa/puppet-mode-20150730.1208/puppet-mode-autoloads.el b/elpa/puppet-mode-20150730.1208/puppet-mode-autoloads.el new file mode 100644 index 00000000..8585de74 --- /dev/null +++ b/elpa/puppet-mode-20150730.1208/puppet-mode-autoloads.el @@ -0,0 +1,24 @@ +;;; puppet-mode-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "puppet-mode" "puppet-mode.el" (22030 19516 +;;;;;; 0 0)) +;;; Generated autoloads from puppet-mode.el + +(autoload 'puppet-mode "puppet-mode" "\ + + +\(fn)" t nil) + +(add-to-list 'auto-mode-alist '("\\.pp\\'" . puppet-mode)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; puppet-mode-autoloads.el ends here diff --git a/elpa/puppet-mode-20150730.1208/puppet-mode-pkg.el b/elpa/puppet-mode-20150730.1208/puppet-mode-pkg.el new file mode 100644 index 00000000..f6177417 --- /dev/null +++ b/elpa/puppet-mode-20150730.1208/puppet-mode-pkg.el @@ -0,0 +1 @@ +(define-package "puppet-mode" "20150730.1208" "Major mode for Puppet manifests" '((emacs "24.1") (pkg-info "0.4")) :url "https://github.com/lunaryorn/puppet-mode" :keywords '("languages")) diff --git a/elpa/puppet-mode-20150730.1208/puppet-mode.el b/elpa/puppet-mode-20150730.1208/puppet-mode.el new file mode 100644 index 00000000..2a28f418 --- /dev/null +++ b/elpa/puppet-mode-20150730.1208/puppet-mode.el @@ -0,0 +1,1140 @@ +;;; puppet-mode.el --- Major mode for Puppet manifests -*- lexical-binding: t; -*- + +;; Copyright (C) 2013, 2014 Sebastian Wiesner +;; Copyright (C) 2013, 2014 Bozhidar Batsov +;; Copyright (C) 2011 Puppet Labs Inc + +;; Author: Bozhidar Batsov +;; Sebastian Wiesner +;; Russ Allbery +;; Maintainer: Bozhidar Batsov +;; Sebastian Wiesner +;; URL: https://github.com/lunaryorn/puppet-mode +;; Package-Version: 20150730.1208 +;; Keywords: languages +;; Version: 0.4-cvs +;; Package-Requires: ((emacs "24.1") (pkg-info "0.4")) + +;; This file is not part of GNU Emacs. + +;; 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 . + +;; This file incorporates work covered by the following copyright and +;; permission notice: + +;; Licensed under the Apache License, Version 2.0 (the "License"); you may not +;; use this file except in compliance with the License. You may obtain a copy +;; of the License at +;; +;; http://www.apache.org/licenses/LICENSE-2.0 +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, WITHOUT +;; WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the +;; License for the specific language governing permissions and limitations +;; under the License. + +;;; Commentary: + +;; GNU Emacs 24 major mode for editing Puppet manifests. + +;; Provides syntax highlighting, indentation, alignment, movement, Imenu and +;; code checking. + +;; Syntax highlighting: Fontification upports all of Puppet 3 syntax, including +;; variable expansion in strings. + +;; Indentation: Indent expressions automatically. + +;; Alignment: Provide alignment rules for common Puppet expressions, and align +;; the current block with `puppet-align-block' on C-c C-a. + +;; Movement: Move to the beginning or end of the current block with +;; `beginning-of-defun' (C-M-a) and `end-of-defun' (C-M-e) respectively. + +;; Imenu: Jump to a tag in the current buffer with `imenu' on C-c C-j. Index +;; variables, resource defaults, classes, nodes, defined types and resource +;; declarations. + +;; Code checking: Validate the syntax of the current buffer with +;; `puppet-validate' on C-c C-v. Lint the current buffer for semantic errors +;; with `puppet-lint' on C-c C-l. Apply the current buffer with `puppet-apply' +;; on C-c C-c. + +;; Flymake: Flymake support is _not_ provided. See Flycheck at +;; http://flycheck.readthedocs.org/en/latest/ for on-the-fly validation and +;; liniting of Puppet manifests. + +;;; Code: + + +;;; Compatibility +(eval-and-compile + ;; `defvar-local' for Emacs 24.2 and below + (unless (fboundp 'defvar-local) + (defmacro defvar-local (var val &optional docstring) + "Define VAR as a buffer-local variable with default value VAL. +Like `defvar' but additionally marks the variable as being automatically +buffer-local wherever it is set." + (declare (debug defvar) (doc-string 3)) + `(progn + (defvar ,var ,val ,docstring) + (make-variable-buffer-local ',var)))) + + ;; `setq-local' for Emacs 24.2 and below + (unless (fboundp 'setq-local) + (defmacro setq-local (var val) + "Set variable VAR to value VAL in current buffer." + `(set (make-local-variable ',var) ,val)))) + + +;;; Requirements +(declare-function pkg-info-version-info "pkg-info" (library)) + +(eval-when-compile + (require 'rx)) + +(require 'align) + + +;;; Customization +(defgroup puppet nil + "Puppet mastering in Emacs" + :prefix "puppet-" + :group 'languages + :link '(url-link :tag "Github" "https://github.com/lunaryorn/puppet-mode") + :link '(emacs-commentary-link :tag "Commentary" "puppet-mode")) + +(defcustom puppet-indent-level 2 + "Indentation of Puppet statements." + :type 'integer + :group 'puppet + :safe 'integerp) + +(defcustom puppet-include-indent 2 + "Indentation of continued Puppet include statements." + :type 'integer + :group 'puppet + :safe 'integerp) + +(defcustom puppet-indent-tabs-mode nil + "Indentation can insert tabs in puppet mode if this is non-nil." + :type 'boolean + :group 'puppet + :safe 'booleanp) + +(defcustom puppet-comment-column 32 + "Indentation column of comments." + :type 'integer + :group 'puppet + :safe 'integerp) + +(defcustom puppet-fontify-variables-in-comments nil + "When non-nil, fontify variable references in comments." + :type 'boolean + :group 'puppet + :safe 'booleanp + :package-version '(puppet-mode . "0.3")) + +(defcustom puppet-validate-command "puppet parser validate --color=false" + "Command to validate the syntax of a Puppet manifest." + :type 'string + :group 'puppet) + +(defcustom puppet-lint-command + (concat + "puppet-lint --with-context " + "--log-format \"%{path}:%{linenumber}: %{kind}: %{message} (%{check})\"") + "Command to lint a Puppet manifest." + :type 'string + :group 'puppet + :package-version '(puppet-mode . "0.3")) + +(defcustom puppet-apply-command "puppet apply --verbose --noop" + "Command to apply a Puppet manifest." + :type 'string + :group 'puppet + :package-version '(puppet-mode . "0.3")) + +(defface puppet-regular-expression-literal + '((t :inherit font-lock-constant-face)) + "Face for regular expression literals in Puppet." + :group 'puppet + :package-version '(puppet-mode . "0.3")) + +(defface puppet-escape-sequence + '((t :inherit font-lock-constant-face)) + "Face for escape sequences in double-quoted strings-consed literals in Puppet." + :group 'puppet + :package-version '(puppet-mode . "0.3")) + + +;;; Version information +(defun puppet-version (&optional show-version) + "Get the Puppet Mode version as string. + +If called interactively or if SHOW-VERSION is non-nil, show the +version in the echo area and the messages buffer. + +The returned string includes both, the version from package.el +and the library version, if both a present and different. + +If the version number could not be determined, signal an error, +if called interactively, or if SHOW-VERSION is non-nil, otherwise +just return nil." + (interactive (list t)) + (let ((version (pkg-info-version-info 'puppet-mode))) + (when show-version + (message "Puppet Mode version: %s" version)) + version)) + + +;;; Utilities + +(defun puppet-syntax-context (&optional pos) + "Determine the syntax context at POS, defaulting to point. + +Return nil, if there is no special context at POS, or one of + +`comment' + POS is inside a comment + +`single-quoted' + POS is inside a single-quoted string + +`double-quoted' + POS is inside a double-quoted string" + (let ((state (save-excursion (syntax-ppss pos)))) + (if (nth 4 state) + 'comment + (pcase (nth 3 state) + (`?\' 'single-quoted) + (`?\" 'double-quoted))))) + +(defun puppet-in-string-or-comment-p (&optional pos) + "Determine whether POS is inside a string or comment." + (not (null (puppet-syntax-context pos)))) + + +;;; Specialized rx + +(eval-when-compile + (defun puppet-rx-symbol (form) + "Translate FORM into a regular expression." + (let ((body (cdr form))) + (rx-to-string `(and symbol-start ,@body symbol-end) 'no-group))) + + (defconst puppet-rx-constituents + `((symbol puppet-rx-symbol 0 nil) + ;; http://docs.puppetlabs.com/puppet/3/reference/lang_datatypes.html#regular-expressions + (regexp-literal . ,(rx (zero-or-more + (or + ;; Not the end of a regexp + (not (any "/" "\\" "\n")) + ;; Any escaped character + (and "\\" not-newline))))) + ;; http://docs.puppetlabs.com/puppet/latest/reference/lang_reserved.html#reserved-words + (keyword . ,(rx (or "and" "case" "class" "default" "define" "else" "elsif" + "false" "if" "in" "import" "inherits" "node" "or" + "true" "undef" "unless"))) + ;; http://docs.puppetlabs.com/references/latest/function.html + (builtin-function . ,(rx (or "alert" "collect" "contain" + "create_resources" "crit" "debug" "defined" + "each" "emerg" "err" "extlookup" "fail" + "file" "filter" "fqdn_rand" "generate" + "hiera" "hiera_array" "hiera_hash" + "hiera_include" "include" "info" + "inline_template" "lookup" "map" "md5" + "notice" "realize" "reduce" "regsubst" + "require" "search" "select" "sha1" + "shellquote" "slice" "split" "sprintf" "tag" + "tagged" "template" "versioncmp" "warning"))) + ;; http://docs.puppetlabs.com/references/latest/type.html + (builtin-type . ,(rx (or "augeas" "computer" "cron" "exec" "file" + "filebucket" "group" "host" "interface" "k5login" + "macauthorization" "mailalias" "maillist" "mcx" + "mount" "nagios_command" "nagios_contact" + "nagios_contactgroup" "nagios_host" + "nagios_hostdependency" "nagios_hostescalation" + "nagios_hostextinfo" "nagios_hostgroup" + "nagios_service" "nagios_servicedependency" + "nagios_serviceescalation" "nagios_serviceextinfo" + "nagios_servicegroup" "nagios_timeperiod" "notify" + "package" "resources" "router" "schedule" + "scheduled_task" "selboolean" "selmodule" + "service" "ssh_authorized_key" "sshkey" "stage" + "tidy" "user" "vlan" "yumrepo" "zfs" "zone" + "zpool"))) + ;; http://docs.puppetlabs.com/references/stable/metaparameter.html. + ;; Strictly speaking, this is no meta parameter, but it's so common that + ;; it got a mention in the docs, see + ;; http://docs.puppetlabs.com/puppet/latest/reference/lang_resources.html#ensure, + ;; so we'll consider it as metaparameter anyway + (builtin-metaparam . ,(rx (or "alias" "audit" "before" "loglevel" "noop" + "notify" "require" "schedule" "stage" + "subscribe" "tag" + ;; Because it's so common and important + "ensure"))) + ;; http://docs.puppetlabs.com/puppet/latest/reference/lang_reserved.html#classes-and-types + (resource-name . ,(rx + ;; Optional top-level scope + (optional "::") + (zero-or-more (any "a-z") + (zero-or-more (any "a-z" "0-9" "_")) + "::") + ;; Nested sub-scopes + (any "a-z") + (zero-or-more (any "a-z" "0-9" "_")))) + (cap-resource-name . ,(rx + ;; Top-scope indicator + (optional "::") + (zero-or-more (any "A-Z") + (zero-or-more + (any "a-z" "0-9" "_")) + "::") + ;; Nested sub-scopes + (any "A-Z") + (zero-or-more (any "a-z" "0-9" "_")))) + ;; http://docs.puppetlabs.com/puppet/latest/reference/lang_reserved.html#nodes + (node-name . ,(rx (one-or-more (any "a-z" "0-9" ?. ?_ ?-)))) + ;; http://docs.puppetlabs.com/puppet/latest/reference/lang_reserved.html#variables + (simple-variable-name . ,(rx (one-or-more (any "A-Z" "a-z" "0-9" "_")))) + (variable-name . ,(rx + ;; The optional scope designation + (optional "::") + (zero-or-more (any "a-z") + (zero-or-more + (any "A-Z" "a-z" "0-9" "_")) + "::") + ;; The final variable name + (one-or-more (any "A-Z" "a-z" "0-9" "_")))) + ;; http://docs.puppetlabs.com/puppet/latest/reference/lang_datatypes.html#double-quoted-strings + (dq-escape . ,(rx (or line-start (not (any "\\"))) + (zero-or-more "\\\\") + ;; We do not include \n and \', because these are + ;; available in single-quoted strings as well + (group "\\" (any ?\" ?$ ?n ?r ?t ?s))))) + "Additional special sexps for `puppet-rx'") + + (defmacro puppet-rx (&rest sexps) + "Specialized `rx' variant for Puppet Mode. + +In addition to the standard forms of `rx', the following forms +are available: + +`(symbol SEXP …)' + Match SEXPs inside symbol boundaries only + +`regexp-literal' + A Puppet regexp literal, *without* surrounding slashes + +`keyword' + Any valid Puppet keyword + +`builtin-function' + Any built-in Puppet function + +`builtin-type' + Any built-in Puppet type + +`builtin-metaparam' + Any built-in meta-parameter, and `ensure' + +`resource-name' + Any valid resource name, including scopes + +`cap-resource-name' + Any capitalized resource name, including capitalized scopes + +`node-name' + Any valid node name + +`simple-variable-name' + Any variable name without scopes, without leading dollar sign + +`variable-name' + Any variable name including scopes, without a leading dollar sign + +`dq-escape' + Special escape sequences for double-quoted strings" + (let ((rx-constituents (append puppet-rx-constituents rx-constituents))) + (cond ((null sexps) + (error "No regexp")) + ((cdr sexps) + (rx-to-string `(and ,@sexps) t)) + (t + (rx-to-string (car sexps) t)))))) + + +;;; Checking + +(defvar-local puppet-last-validate-command nil + "The last command used for validation.") + +(defvar-local puppet-last-lint-command nil + "The last command used for linting.") + +(defvar-local puppet-last-apply-command nil + "The last command used to apply a manifest.") + +(defun puppet-run-check-command (command buffer-name-template) + "Run COMMAND to check the current buffer." + (save-some-buffers (not compilation-ask-about-save) nil) + (compilation-start command nil (lambda (_) + (format buffer-name-template command)))) + +(defun puppet-read-command (prompt previous-command default-command) + "Read a command from minibuffer with PROMPT." + (let* ((buffer-file-name (or (buffer-file-name) "")) + (filename (or (file-remote-p buffer-file-name 'localname) + buffer-file-name))) + (read-string prompt (or previous-command + (concat default-command " " + (shell-quote-argument filename)))))) + +(defun puppet-validate (command) + "Validate the syntax of the current buffer with COMMAND. + +When called interactively, prompt for COMMAND." + (interactive (list (puppet-read-command "Validate command: " + puppet-last-validate-command + puppet-validate-command))) + (setq puppet-last-validate-command command) + (puppet-run-check-command command "*Puppet Validate: %s*")) + +(defun puppet-lint (command) + "Lint the current buffer with COMMAND. + +When called interactively, prompt for COMMAND." + (interactive (list (puppet-read-command "Lint command: " + puppet-last-lint-command + puppet-lint-command))) + (setq puppet-last-lint-command command) + (puppet-run-check-command command "*Puppet Lint: %s*")) + +(defun puppet-apply (command) + "Apply the current manifest with COMMAND. + +When called interactively, prompt for COMMAND." + (interactive (list (puppet-read-command "Apply command: " + puppet-last-apply-command + puppet-apply-command))) + (setq puppet-last-apply-command command) + (puppet-run-check-command command "*Puppet Apply: %s*")) + + +;;; Navigation +;; TODO: Check which of these are still needed for SMIE + +(defun puppet-beginning-of-defun-function (&optional arg) + "Move to the ARG'th beginning of a block." + (let* ((arg (or arg 1)) + (search (if (< arg 0) #'search-forward #'search-backward)) + (steps (abs arg))) + (while (> steps 0) + (let ((pos (funcall search "{" nil 'no-error))) + ;; Skip over strings and comments + (while (and pos (puppet-in-string-or-comment-p pos)) + (setq pos (funcall search "{" nil 'no-error))) + (if pos + (setq steps (1- steps)) + ;; Drop out of outer loop + (setq steps 0)))) + (when (< arg 0) + (backward-char)))) + + +;;; Indentation code +(defun puppet-block-indent () + "If point is in a block, return the indentation of the first line of that +block (the line containing the opening brace). Used to set the indentation +of the closing brace of a block." + (save-excursion + (save-match-data + (let ((opoint (point)) + (apoint (search-backward "{" nil t))) + (when apoint + ;; This is a bit of a hack and doesn't allow for strings. We really + ;; want to parse by sexps at some point. + (let ((close-braces (count-matches "}" apoint opoint)) + (open-braces 0)) + (while (and apoint (> close-braces open-braces)) + (setq apoint (search-backward "{" nil t)) + (when apoint + (setq close-braces (count-matches "}" apoint opoint)) + (setq open-braces (1+ open-braces))))) + (if apoint + (current-indentation) + nil)))))) + +(defun puppet-in-array () + "If point is in an array, return the position of the opening '[' of +that array, else return nil." + (save-excursion + (save-match-data + (let ((opoint (point)) + (apoint (search-backward "[" nil t))) + (when apoint + ;; This is a bit of a hack and doesn't allow for strings. We really + ;; want to parse by sexps at some point. + (let ((close-brackets (count-matches "]" apoint opoint)) + (open-brackets 0)) + (while (and apoint (> close-brackets open-brackets)) + (setq apoint (search-backward "[" nil t)) + (when apoint + (setq close-brackets (count-matches "]" apoint opoint)) + (setq open-brackets (1+ open-brackets))))) + apoint))))) + +(defun puppet-in-include () + "If point is in a continued list of include statements, return the position +of the initial include plus puppet-include-indent." + (save-excursion + (save-match-data + (let ((include-column nil) + (not-found t)) + (while not-found + (forward-line -1) + (cond + ((bobp) + (setq not-found nil)) + ((looking-at "^\\s-*include\\s-+.*,\\s-*$") + (setq include-column + (+ (current-indentation) puppet-include-indent)) + (setq not-found nil)) + ((not (looking-at ".*,\\s-*$")) + (setq not-found nil)))) + include-column)))) + +(defun puppet-indent-line () + "Indent current line as puppet code." + (interactive) + (beginning-of-line) + (if (bobp) + (indent-line-to 0) ; First line is always non-indented + (let ((not-indented t) + (array-start (puppet-in-array)) + (include-start (puppet-in-include)) + (block-indent (puppet-block-indent)) + cur-indent) + (cond + (array-start + ;; This line probably starts with an element from an array. + ;; Indent the line to the same indentation as the first + ;; element in that array. That is, this... + ;; + ;; exec { + ;; "add_puppetmaster_mongrel_startup_links": + ;; command => "string1", + ;; creates => [ "string2", "string3", + ;; "string4", "string5", + ;; "string6", "string7", + ;; "string3" ], + ;; refreshonly => true, + ;; } + ;; + ;; ...should instead look like this: + ;; + ;; exec { + ;; "add_puppetmaster_mongrel_startup_links": + ;; command => "string1", + ;; creates => [ "string2", "string3", + ;; "string4", "string5", + ;; "string6", "string7", + ;; "string8" ], + ;; refreshonly => true, + ;; } + (save-excursion + (if (looking-at "^\\s-*],*") + ;; If a closing bracket is on a line by itself, align it with the + ;; opening bracket. + (progn + (goto-char array-start) + (setq cur-indent (current-indentation))) + + (goto-char array-start) + (forward-char 1) + + ;; If the point is at the end of the line, use normal indentation. + ;; + ;; For example: + ;; exec { 'foo': + ;; creates => [ + ;; 'foo', + ;; 'bar', + ;; ] + ;; } + ;; + (if (eolp) + (setq cur-indent (+ (current-indentation) puppet-indent-level)) + ;; Otherwise, attempt to align as described above. + (re-search-forward "\\S-") + (forward-char -1) + (setq cur-indent (current-column)))))) + (include-start + (setq cur-indent include-start)) + ((and (looking-at "^\\s-*},?\\s-*$") block-indent) + ;; This line contains a closing brace or a closing brace followed by a + ;; comma and we're at the inner block, so we should indent it matching + ;; the indentation of the opening brace of the block. + (setq cur-indent block-indent)) + (t + ;; Otherwise, we did not start on a block-ending-only line. + (save-excursion + ;; Iterate backwards until we find an indentation hint + (while not-indented + (forward-line -1) + (cond + ;; Comment lines are ignored unless we're at the start of the + ;; buffer. + ((eq (puppet-syntax-context) 'comment) + (if (bobp) + (setq not-indented nil))) + + ;; Brace or paren on a line by itself will already be indented to + ;; the right level, so we can cheat and stop there. + ((looking-at "^\\s-*[\)}]\\s-*") + (setq cur-indent (current-indentation)) + (setq not-indented nil)) + + ;; Brace (possibly followed by a comma) or paren not on a line by + ;; itself will be indented one level too much, but don't catch + ;; cases where the block is started and closed on the same line. + ((looking-at "^[^\n\({]*[\)}],?\\s-*$") + (setq cur-indent (- (current-indentation) puppet-indent-level)) + (setq not-indented nil)) + + ;; Indent by one level more than the start of our block. We lose + ;; if there is more than one block opened and closed on the same + ;; line but it's still unbalanced; hopefully people don't do that. + ((looking-at "^.*{[^\n}]*$") + (setq cur-indent (+ (current-indentation) puppet-indent-level)) + (setq not-indented nil)) + + ;; Indent by one level if the line ends with an open paren. + ((looking-at "^.*\(\\s-*$") + (setq cur-indent (+ (current-indentation) puppet-indent-level)) + (setq not-indented nil)) + + ;; Semicolon ends a block for a resource when multiple resources + ;; are defined in the same block, but try not to get the case of + ;; a complete resource on a single line wrong. + ((looking-at "^\\([^'\":\n]\\|\"[^\n\"]*\"\\|'[^\n']*'\\)*;\\s-*$") + (setq cur-indent (- (current-indentation) puppet-indent-level)) + (setq not-indented nil)) + + ;; Indent an extra level after : since it introduces a resource. + ((looking-at "^.*:\\s-*$") + (setq cur-indent (+ (current-indentation) puppet-indent-level)) + (setq not-indented nil)) + + ;; Start of buffer. + ((bobp) + (setq not-indented nil))))) + + ;; If this line contains only a closing paren, we should lose one + ;; level of indentation. + (if (looking-at "^\\s-*\)\\s-*$") + (setq cur-indent (- cur-indent puppet-indent-level))))) + + ;; We've figured out the indentation, so do it. + (if (and cur-indent (> cur-indent 0)) + (indent-line-to cur-indent) + (indent-line-to 0))))) + + +;;; Font locking + +(defvar puppet-mode-syntax-table + (let ((table (make-syntax-table))) + ;; Our strings + (modify-syntax-entry ?\' "\"'" table) + (modify-syntax-entry ?\" "\"\"" table) + ;; C-style comments. Yes, Puppet has these! + (modify-syntax-entry ?/ ". 14b" table) + (modify-syntax-entry ?* ". 23b" table) + ;; Line comments + (modify-syntax-entry ?# "<" table) + (modify-syntax-entry ?\n ">" table) + ;; The backslash is our escape character + (modify-syntax-entry ?\\ "\\" table) + ;; The dollar sign is an expression prefix for variables + (modify-syntax-entry ?$ "'" table) + ;; Fix various operators and punctionation. + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?% "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?\; "." table) + ;; Our parenthesis, braces and brackets + (modify-syntax-entry ?\( "()" table) + (modify-syntax-entry ?\) ")(" table) + (modify-syntax-entry ?\{ "(}" table) + (modify-syntax-entry ?\} "){" table) + (modify-syntax-entry ?\[ "(]" table) + (modify-syntax-entry ?\] ")[" table) + table) + "Syntax table in use in `puppet-mode' buffers.") + +(defvar puppet-font-lock-keywords + `( + ;; Keywords + (,(puppet-rx (symbol keyword)) 0 font-lock-keyword-face) + ;; Variables + (,(puppet-rx "$" (symbol variable-name)) 0 font-lock-variable-name-face) + ;; Class and type declarations + (,(puppet-rx (symbol (or "class" "define")) + (one-or-more space) + (group (symbol resource-name))) + 1 font-lock-type-face) + ;; Node declarations + (,(puppet-rx (symbol "node") + (one-or-more space) + (group node-name)) + 1 font-lock-type-face) + ;; Resource usage, see + ;; http://docs.puppetlabs.com/puppet/latest/reference/lang_resources.html + (,(puppet-rx (group (repeat 0 2 "@") ; Virtual and exported resources + (symbol resource-name)) + (zero-or-more space) "{") + 1 font-lock-type-face) + ;; Resource defaults, see + ;; http://docs.puppetlabs.com/puppet/latest/reference/lang_defaults.html + (,(puppet-rx (group (symbol cap-resource-name)) (zero-or-more space) "{") + 1 font-lock-type-face) + ;; Resource references, see + ;; http://docs.puppetlabs.com/puppet/latest/reference/lang_datatypes.html#resource-references + (,(puppet-rx (group (symbol cap-resource-name)) (zero-or-more space) "[") + 1 font-lock-type-face) + ;; Resource collectors, see + ;; http://docs.puppetlabs.com/puppet/latest/reference/lang_collectors.html + (,(puppet-rx (group (symbol cap-resource-name)) (zero-or-more space) + (optional "<") ; Exported collector + "<|") + 1 font-lock-type-face) + ;; Negation + ("!" 0 font-lock-negation-char-face) + ;; Builtin meta parameters + (,(puppet-rx (group (symbol builtin-metaparam)) (zero-or-more space) "=>") + 1 font-lock-builtin-face) + ;; Built-in functions + (,(puppet-rx (symbol builtin-function)) 0 font-lock-builtin-face) + ;; Type arguments to some special built-in functions + (,(puppet-rx (symbol (or "contain" "include" "require")) + (one-or-more space) + (group (symbol resource-name))) + 1 font-lock-type-face) + ;; Variable expansions in strings and comments + (puppet-match-valid-expansion 1 font-lock-variable-name-face t) + (puppet-match-invalid-expansion 1 font-lock-warning-face t) + ;; Escape sequences in strings + (puppet-match-valid-escape 1 'puppet-escape-sequence t) + ;; Regexp literals + (puppet-match-regexp-literal (1 'puppet-regular-expression-literal t) + (2 'puppet-regular-expression-literal t) + (3 'puppet-regular-expression-literal t))) + "Font lock keywords for Puppet Mode.") + +(defun puppet-match-property (property context limit) + "Match a PROPERTY in CONTEXT before LIMIT. + +PROPERTY is the text property to look for. CONTEXT is one of +`single-quoted', `double-quoted', `comment' or nil, or a list +with any of these symbols. The expansion will only match if it +is in any given CONTEXT. nil means no specific syntactic context." + (when (symbolp context) + (setq context (list context))) + (let* ((pos (next-single-char-property-change (point) property nil limit))) + (when (and pos (> pos (point))) + (goto-char pos) + (let* ((value (get-text-property pos property))) + (if (and value (memq (car value) context)) + (progn (set-match-data (cdr value)) t) + (puppet-match-property property context limit)))))) + +(defun puppet-match-valid-expansion (limit) + "Match a valid expansion before LIMIT. + +A valid expansion is a variable expansion in a double-quoted +string." + (let ((valid-contexts '(double-quoted))) + (when puppet-fontify-variables-in-comments + (push 'comment valid-contexts)) + (puppet-match-property 'puppet-expansion valid-contexts limit))) + +(defun puppet-match-invalid-expansion (limit) + "Match an invalid expansion before LIMIT. + +An invalid expansion is a variable expansion in a single-quoted +string." + (puppet-match-property 'puppet-expansion 'single-quoted limit)) + +(defun puppet-match-valid-escape (limit) + "Match a valid escape sequence before LIMIT." + (puppet-match-property 'puppet-escape 'double-quoted limit)) + +(defun puppet-match-regexp-literal (limit) + "Match a regular expression literal before LIMIT." + (puppet-match-property 'puppet-regexp-literal nil limit)) + +(defun puppet-syntax-propertize-match (property &optional group) + "Propertize a match with PROPERTY at GROUP's beginning. + +When in a special syntax context, add PROPERTY to the first +character of the given GROUP of the current `match-data'. GROUP +defaults to the first group. + +The value of PROPERTY is `(CONTEXT . MATCH-DATA)', where CONTEXT +is one of nil, `single-quoted', `double-quoted' or `comment' and +denotes the surrounding context, and MATCH-DATA is the original +match data from propertization." + (let* ((beg (match-beginning (or group 1))) + ;; Syntax functions can modify the match data, so we must preserve it + (context (save-match-data (puppet-syntax-context beg)))) + (put-text-property beg (1+ beg) property + (cons context (match-data))))) + +(defun puppet-syntax-propertize-scope-operator (beg end) + "Mark all scope operators between BEG and END as symbols." + (save-match-data + (save-excursion + (goto-char beg) + (while (search-forward "::" end 'no-error) + (put-text-property (match-beginning 0) (match-end 0) + 'syntax-table (string-to-syntax "_")))))) + +(defun puppet-syntax-propertize-function (start end) + "Propertize text between START and END. + +Used as `syntax-propertize-function' in Puppet Mode." + (let ((case-fold-search nil)) + (goto-char start) + (remove-text-properties start end '(puppet-expansion + puppet-escape + puppet-regexp-literal)) + (funcall + (syntax-propertize-rules + ;; Make double colons part of the surrounding symbol. We can't put the + ;; colon into symbol syntax, because the colon can appear as non-symbol + ;; character as well (e.g. "package { $foo:"), but we want the + ;; double-colon as part of the symbol to make symbol navigation move + ;; across it, and to make stuff like `thing-at-point' behave reasonably + ((rx "::" symbol-start) (0 "_")) + ;; Mark regular expression literals in proper contexts (nodes, cases, + ;; selectors and match operators) as strings, to make them play nicely + ;; with sexp navigation and SMIE. Also propertize them for use in font + ;; lock keywords, since we want to apply our own + ;; puppet-regular-expression-literal face instead of the generic string + ;; face. + ((puppet-rx (group "/") + (group regexp-literal) + (group "/") + (zero-or-more space) + (or ":" "=>")) + ;; We propertize the body of the regexp literal, not its delimiters, to + ;; make sure that font lock keywords kick in when the literal gets moved + ;; with point on separator. The separator is propertized by syntactic + ;; font lock (since we marked it as string delimiter), so font lock + ;; keywords will start in the body of the literal. If we'd propertize + ;; the separator, font lock keywords would miss the property + (0 (ignore (puppet-syntax-propertize-match 'puppet-regexp-literal 2))) + (1 "|") (3 "|")) + ((puppet-rx (or "=~" "!~" (symbol "node")) (zero-or-more space) + (group "/") + (group regexp-literal) + (group "/")) + (0 (ignore (puppet-syntax-propertize-match 'puppet-regexp-literal 2))) + (1 "|") (3 "|")) + ;; Find escape sequences and variable expansions. + ((puppet-rx dq-escape) + (1 (ignore (puppet-syntax-propertize-match 'puppet-escape)))) + ((puppet-rx (or line-start (not (any "\\"))) + (zero-or-more "\\\\") + ;; We can't use symbol boundaries here, because + ;; `syntax-propertize-rules' applies all rules at the same + ;; time, so the double-colon scope separator isn't yet part of + ;; the symbol at this point. + (group "$" (or (and "{" variable-name "}") variable-name))) + (1 (ignore (progn + (puppet-syntax-propertize-match 'puppet-expansion) + ;; Propertize all scope operators in the current variable + (puppet-syntax-propertize-scope-operator + (match-beginning 0) (match-end 0))))))) + start end))) + + +;;; Alignment + +;; Configure alignment +(add-to-list 'align-sq-string-modes 'puppet-mode) +(add-to-list 'align-dq-string-modes 'puppet-mode) +(add-to-list 'align-open-comment-modes 'puppet-mode) + +(defconst puppet-mode-align-rules + '((puppet-resource-arrow + (regexp . "\\(\\s-*\\)=>\\(\\s-*\\)") + (group . (1 2)) + (modes . '(puppet-mode)) + (separate . entire))) + "Align rules for Puppet Mode.") + +(defun puppet-align-block () + "Align the current block." + (interactive) + (save-excursion + (save-match-data + (let ((beg (search-backward "{" nil 'no-error))) + ;; Skip backwards over strings and comments + (while (and beg (puppet-in-string-or-comment-p beg)) + (setq beg (search-backward "{" nil 'no-error))) + (when beg + (forward-list) + (align beg (point))))))) + + +;;; Dealing with strings +(defun puppet-looking-around (back at) + "Check if looking backwards at BACK and forward at AT." + (and (looking-at-p at) (looking-back back))) + +(defun puppet-string-at-point-p () + "Check if cursor is at a string or not." + (puppet-string-region)) + +(defun puppet-string-region () + "Return region for string at point." + (let ((orig-point (point)) (regex "'\\(\\(\\\\'\\)\\|[^']\\)*'\\|\"\\(\\(\\\\\"\\)\\|[^\"]\\)*\"") beg end) + (save-excursion + (goto-char (line-beginning-position)) + (while (and (re-search-forward regex (line-end-position) t) (not (and beg end))) + (let ((match-beg (match-beginning 0)) (match-end (match-end 0))) + (when (and + (> orig-point match-beg) + (< orig-point match-end)) + (setq beg match-beg) + (setq end match-end)))) + (and beg end (list beg end))))) + +(defun puppet-interpolate (suppress) + "Interpolate with ${} in double quoted strings. + +With a prefix argument SUPPRESS it simply inserts $." + (interactive "P") + (if (and mark-active (equal (point) (region-end))) + (exchange-point-and-mark)) + (insert "$") + (when (and + (not suppress) + (or + (puppet-looking-around "\"[^\"\n]*" "[^\"\n]*\"") + (puppet-looking-around "`[^`\n]*" "[^`\n]*`") + (puppet-looking-around "%([^(\n]*" "[^)\n]*)"))) + (cond (mark-active + (goto-char (region-beginning)) + (insert "{") + (goto-char (region-end)) + (insert "}")) + (t + (insert "{}") + (forward-char -1))))) + +(defun puppet-toggle-string-quotes () + "Toggle string literal quoting between single and double." + (interactive) + (when (puppet-string-at-point-p) + (let* ((region (puppet-string-region)) + (min (nth 0 region)) + (max (nth 1 region)) + (string-quote (puppet--inverse-string-quote (buffer-substring-no-properties min (1+ min)))) + (content + (buffer-substring-no-properties (1+ min) (1- max)))) + (setq content + (if (equal string-quote "\"") + (replace-regexp-in-string "\\\\\"" "\"" (replace-regexp-in-string "\\([^\\\\]\\)'" "\\1\\\\'" content)) + (replace-regexp-in-string "\\\\\'" "'" (replace-regexp-in-string "\\([^\\\\]\\)\"" "\\1\\\\\"" content)))) + (let ((orig-point (point))) + (delete-region min max) + (insert + (format "%s%s%s" string-quote content string-quote)) + (goto-char orig-point))))) + +(defun puppet--inverse-string-quote (string-quote) + "Get the inverse string quoting for STRING-QUOTE." + (if (equal string-quote "\"") "'" "\"")) + +(defun puppet-clear-string () + "Clear string at point." + (interactive) + (when (puppet-string-at-point-p) + (let* ((region (puppet-string-region)) + (min (nth 0 region)) + (max (nth 1 region))) + (delete-region (+ min 1) (- max 1))))) + + + +;;; Imenu + +(defun puppet-imenu-collect-entries (pattern) + "Collect all index entries matching PATTERN. + +The first matching group of PATTERN is used as title and position +for each entry." + (goto-char (point-min)) + (let ((case-fold-search nil) + entries) + (while (re-search-forward pattern nil 'no-error) + (let ((entry (cons (match-string 1) (match-beginning 1)))) + (unless (puppet-in-string-or-comment-p (match-beginning 0)) + ;; Skip this match if it's inside a string or comment + (push entry entries)))) + (nreverse entries))) + +(defun puppet-imenu-create-index () + "Create an IMenu index for the current buffer." + (let ((case-fold-search nil) + ;; Variable assignments + (variables (puppet-imenu-collect-entries + (puppet-rx (group "$" (symbol simple-variable-name)) + (zero-or-more space) "="))) + ;; Resource defaults + (defaults (puppet-imenu-collect-entries + (puppet-rx (group (symbol cap-resource-name)) + (zero-or-more space) "{"))) + ;; Nodes, classes and defines + (nodes (puppet-imenu-collect-entries + (puppet-rx (symbol "node") + (one-or-more space) + (group (symbol node-name))))) + (classes (puppet-imenu-collect-entries + (puppet-rx (symbol "class") + (one-or-more space) + (group (symbol resource-name))))) + (defines (puppet-imenu-collect-entries + (puppet-rx (symbol "define") + (one-or-more space) + (group (symbol resource-name))))) + resources) + ;; Resources are a little more complicated since we need to extract the type + ;; and the name + (goto-char (point-min)) + (while (re-search-forward + (puppet-rx (group (repeat 0 2 "@") ; Virtual and exported resources + (symbol resource-name)) + (zero-or-more space) "{" + ;; FIXME: Support condensed forms + (zero-or-more space) + (group (one-or-more not-newline)) ":") + nil 'no-error) + ;; FIXME: Doesn't work for any condensed forms, see + ;; http://docs.puppetlabs.com/puppet/latest/reference/lang_resources.html#condensed-forms + ;; We probably need to be more clever here + (push (cons (concat (match-string 1) " " (match-string 2)) + (match-beginning 1)) + resources)) + (let (index + ;; Keep this in reversed order, for `push' + (parts (list (cons "Variables" variables) + (cons "Defaults" defaults) + (cons "Definitions" defines) + (cons "Classes" classes) + (cons "Nodes" nodes)))) + (dolist (part parts) + (when (cdr part) + (push part index))) + (append index (nreverse resources))))) + + +;;; Major mode definition + +(defvar puppet-mode-map + (let ((map (make-sparse-keymap))) + ;; Editing + (define-key map (kbd "C-c C-a") #'puppet-align-block) + (define-key map (kbd "C-c C-'") #'puppet-toggle-string-quotes) + (define-key map (kbd "C-c C-;") #'puppet-clear-string) + (define-key map (kbd "$") #'puppet-interpolate) + ;; Navigation + (define-key map (kbd "C-c C-j") #'imenu) + ;; Apply manifests + (define-key map (kbd "C-c C-c") #'puppet-apply) + ;; Linting and validation + (define-key map (kbd "C-c C-v") #'puppet-validate) + (define-key map (kbd "C-c C-l") #'puppet-lint) + ;; The menu bar + (easy-menu-define puppet-menu map "Puppet Mode menu" + `("Puppet" + :help "Puppet-specific Features" + ["Align the current block" puppet-align-block + :help "Align parameters in the current block"] + ["Clear string" puppet-clear-string + :help "Clear the string at point"] + ["Toggle string quotes" puppet-toggle-string-quotes + :help "Toggle the string at point quotes between single and double"] + "-" + ["Jump to resource/variable" imenu + :help "Jump to a resource or variable"] + "-" + ["Apply manifest" puppet-apply :help "Apply a Puppet manifest"] + "-" + ["Validate file syntax" puppet-validate + :help "Validate the syntax of this file"] + ["Lint file" puppet-lint + :help "Check the file for semantic issues"])) + map) + "Key map for Puppet Mode buffers.") + +;;;###autoload +(define-derived-mode puppet-mode prog-mode "Puppet" () + "Major mode for editing Puppet manifests. + +\\{puppet-mode-map}" + ;; Comment setup + (setq-local comment-start "# ") + (setq-local comment-start-skip "#+ *") + (setq-local comment-use-syntax t) + (setq-local comment-end "") + (setq-local comment-auto-fill-only-comments t) + (setq comment-column puppet-comment-column) + ;; Navigation (TODO: Will we still need this with SMIE?) + (setq-local beginning-of-defun-function #'puppet-beginning-of-defun-function) + ;; Indentation + (setq-local indent-line-function #'puppet-indent-line) + (setq indent-tabs-mode puppet-indent-tabs-mode) + ;; Paragaphs + (setq-local paragraph-ignore-fill-prefix t) + (setq-local paragraph-start "\f\\|[ \t]*$\\|#$") + (setq-local paragraph-separate "\\([ \t\f]*\\|#\\)$") + ;; Font locking + (setq font-lock-defaults '((puppet-font-lock-keywords) nil nil)) + (setq-local syntax-propertize-function #'puppet-syntax-propertize-function) + ;; Alignment + (setq align-mode-rules-list puppet-mode-align-rules) + ;; IMenu + (setq imenu-create-index-function #'puppet-imenu-create-index)) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.pp\\'" . puppet-mode)) + +(provide 'puppet-mode) + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: + +;;; puppet-mode.el ends here diff --git a/elpa/puppet-mode-readme.txt b/elpa/puppet-mode-readme.txt new file mode 100644 index 00000000..37c3a09a --- /dev/null +++ b/elpa/puppet-mode-readme.txt @@ -0,0 +1,28 @@ +GNU Emacs 24 major mode for editing Puppet manifests. + +Provides syntax highlighting, indentation, alignment, movement, Imenu and +code checking. + +Syntax highlighting: Fontification upports all of Puppet 3 syntax, including +variable expansion in strings. + +Indentation: Indent expressions automatically. + +Alignment: Provide alignment rules for common Puppet expressions, and align +the current block with `puppet-align-block' on C-c C-a. + +Movement: Move to the beginning or end of the current block with +`beginning-of-defun' (C-M-a) and `end-of-defun' (C-M-e) respectively. + +Imenu: Jump to a tag in the current buffer with `imenu' on C-c C-j. Index +variables, resource defaults, classes, nodes, defined types and resource +declarations. + +Code checking: Validate the syntax of the current buffer with +`puppet-validate' on C-c C-v. Lint the current buffer for semantic errors +with `puppet-lint' on C-c C-l. Apply the current buffer with `puppet-apply' +on C-c C-c. + +Flymake: Flymake support is _not_ provided. See Flycheck at +http://flycheck.readthedocs.org/en/latest/ for on-the-fly validation and +liniting of Puppet manifests. -- 2.47.3