diff --git a/elpa/coffee-mode-20160419.1947/coffee-mode-autoloads.el b/elpa/coffee-mode-20160419.1947/coffee-mode-autoloads.el new file mode 100644 index 0000000..f8889e9 --- /dev/null +++ b/elpa/coffee-mode-20160419.1947/coffee-mode-autoloads.el @@ -0,0 +1,32 @@ +;;; coffee-mode-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "coffee-mode" "coffee-mode.el" (22297 53349 +;;;;;; 494925 803000)) +;;; Generated autoloads from coffee-mode.el + +(autoload 'coffee-mode "coffee-mode" "\ +Major mode for editing CoffeeScript. + +\(fn)" t nil) + +(add-to-list 'auto-mode-alist '("\\.coffee\\'" . coffee-mode)) + +(add-to-list 'auto-mode-alist '("\\.iced\\'" . coffee-mode)) + +(add-to-list 'auto-mode-alist '("Cakefile\\'" . coffee-mode)) + +(add-to-list 'auto-mode-alist '("\\.cson\\'" . coffee-mode)) + +(add-to-list 'interpreter-mode-alist '("coffee" . coffee-mode)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; coffee-mode-autoloads.el ends here diff --git a/elpa/coffee-mode-20160419.1947/coffee-mode-pkg.el b/elpa/coffee-mode-20160419.1947/coffee-mode-pkg.el new file mode 100644 index 0000000..6c64a50 --- /dev/null +++ b/elpa/coffee-mode-20160419.1947/coffee-mode-pkg.el @@ -0,0 +1 @@ +(define-package "coffee-mode" "20160419.1947" "Major mode for CoffeeScript code" '((emacs "24.1") (cl-lib "0.5")) :url "http://github.com/defunkt/coffee-mode" :keywords '("coffeescript" "major" "mode")) diff --git a/elpa/coffee-mode-20160419.1947/coffee-mode.el b/elpa/coffee-mode-20160419.1947/coffee-mode.el new file mode 100644 index 0000000..ba0a6d2 --- /dev/null +++ b/elpa/coffee-mode-20160419.1947/coffee-mode.el @@ -0,0 +1,1348 @@ +;;; coffee-mode.el --- Major mode for CoffeeScript code -*- lexical-binding: t; -*- + +;; Copyright (C) 2010 Chris Wanstrath + +;; Version: 0.6.3 +;; Package-Version: 20160419.1947 +;; Keywords: CoffeeScript major mode +;; Author: Chris Wanstrath +;; URL: http://github.com/defunkt/coffee-mode +;; Package-Requires: ((emacs "24.1") (cl-lib "0.5")) + +;; 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 2, 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, write to the Free Software +;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; Provides syntax highlighting, indentation support, imenu support, +;; compiling to JavaScript, REPL, a menu bar, and a few cute commands. + +;;; Code: + +(require 'comint) +(require 'easymenu) +(require 'font-lock) +(require 'rx) + +(require 'cl-lib) + +(declare-function tramp-file-name-localname "tramp") +(declare-function tramp-dissect-file-name "tramp") + +;; +;; Customizable Variables +;; + +(defconst coffee-mode-version "0.6.3" + "The version of `coffee-mode'.") + +(defgroup coffee nil + "A CoffeeScript major mode." + :group 'languages) + +(defcustom coffee-tab-width tab-width + "The tab width to use when indenting." + :type 'integer + :safe 'integerp) + +(defcustom coffee-command "coffee" + "The CoffeeScript command used for evaluating code." + :type 'string) + +(defcustom coffee-js-directory "" + "The directory for compiled JavaScript files output. This can +be an absolute path starting with a `/`, or it can be path +relative to the directory containing the coffeescript sources to +be compiled." + :type 'string) + +(defcustom js2coffee-command "js2coffee" + "The js2coffee command used for evaluating code." + :type 'string) + +(defcustom coffee-args-repl '("-i") + "The arguments to pass to `coffee-command' to start a REPL." + :type '(repeat string)) + +(defcustom coffee-args-compile '("-c" "--no-header") + "The arguments to pass to `coffee-command' to compile a file." + :type '(repeat string)) + +(defcustom coffee-compiled-buffer-name "*coffee-compiled*" + "The name of the scratch buffer used for compiled CoffeeScript." + :type 'string) + +(defcustom coffee-repl-buffer "*CoffeeREPL*" + "The name of the CoffeeREPL buffer." + :type 'string) + +(defcustom coffee-compile-jump-to-error t + "Whether to jump to the first error if compilation fails. +Since the coffee compiler does not always include a line number in +its error messages, this is not always possible." + :type 'boolean) + +(defcustom coffee-watch-buffer-name "*coffee-watch*" + "The name of the scratch buffer used when using the --watch flag +with CoffeeScript." + :type 'string) + +(defcustom coffee-mode-hook nil + "Hook called by `coffee-mode'. Examples: + + ;; Compile '.coffee' files on every save + (and (file-exists-p (buffer-file-name)) + (file-exists-p (coffee-compiled-file-name)) + (coffee-cos-mode t)))" + :type 'hook) + +(defcustom coffee-indent-tabs-mode nil + "Indentation can insert tabs if this is t." + :type 'boolean) + +(defcustom coffee-after-compile-hook nil + "Hook called after compile to Javascript" + :type 'hook) + +(defcustom coffee-indent-like-python-mode nil + "Indent like python-mode." + :type 'boolean) + +(defcustom coffee-switch-to-compile-buffer nil + "Switch to compilation buffer `coffee-compiled-buffer-name' after compiling +a buffer or region." + :type 'boolean) + +(defvar coffee-mode-map + (let ((map (make-sparse-keymap))) + ;; key bindings + (define-key map (kbd "A-r") 'coffee-compile-buffer) + (define-key map (kbd "C-c C-k") 'coffee-compile-buffer) + (define-key map (kbd "A-R") 'coffee-compile-region) + (define-key map (kbd "A-M-r") 'coffee-repl) + (define-key map (kbd "C-c C-z") 'coffee-repl) + (define-key map [remap comment-dwim] 'coffee-comment-dwim) + (define-key map [remap newline-and-indent] 'coffee-newline-and-indent) + (define-key map "\C-m" 'coffee-newline-and-indent) + (define-key map "\C-c\C-o\C-s" 'coffee-cos-mode) + (define-key map "\177" 'coffee-dedent-line-backspace) + (define-key map (kbd "C-c C-<") 'coffee-indent-shift-left) + (define-key map (kbd "C-c C->") 'coffee-indent-shift-right) + (define-key map (kbd "C-c C-l") 'coffee-send-line) + (define-key map (kbd "C-c C-r") 'coffee-send-region) + (define-key map (kbd "C-c C-b") 'coffee-send-buffer) + (define-key map (kbd "") 'coffee-indent-shift-left) + (define-key map (kbd "C-M-a") 'coffee-beginning-of-defun) + (define-key map (kbd "C-M-e") 'coffee-end-of-block) + (define-key map (kbd "C-M-h") 'coffee-mark-defun) + map) + "Keymap for CoffeeScript major mode.") + +(defvar coffee--process nil) + +;; +;; Commands +;; + +(defun coffee-comint-filter (string) + (ansi-color-apply + (replace-regexp-in-string + "\uFF00" "\n" + (replace-regexp-in-string "\x1b\\[.[GJK]" "" string)))) + +(defun coffee-repl () + "Launch a CoffeeScript REPL using `coffee-command' as an inferior mode." + (interactive) + + (unless (comint-check-proc coffee-repl-buffer) + (set-buffer + (apply 'make-comint "CoffeeREPL" + "env" + nil + "NODE_NO_READLINE=1" + coffee-command + coffee-args-repl)) + ;; Workaround for ansi colors + (add-hook 'comint-preoutput-filter-functions 'coffee-comint-filter nil t)) + + (pop-to-buffer coffee-repl-buffer)) + +(defun coffee-compiled-file-name (&optional filename) + ;; Returns the name of the JavaScript file compiled from a CoffeeScript file. + ;; If FILENAME is omitted, the current buffer's file name is used. + (let ((input (expand-file-name (or filename (buffer-file-name))))) + (unless (string= coffee-js-directory "") + (setq input + (expand-file-name + (concat (unless (file-name-absolute-p coffee-js-directory) + (file-name-directory input)) + (file-name-as-directory coffee-js-directory) + (file-name-nondirectory input))))) + (concat (file-name-sans-extension input) ".js"))) + +(defun coffee-revert-buffer-compiled-file (file-name) + "Revert a buffer of compiled file when the buffer exist and is not modified." + (let ((buffer (find-buffer-visiting file-name))) + (when (and buffer (not (buffer-modified-p buffer))) + (with-current-buffer buffer + (revert-buffer nil t))))) + +(defun coffee-parse-error-output (compiler-errstr) + (let* ((msg (car (split-string compiler-errstr "[\n\r]+"))) + line column) + (message msg) + (when (or (string-match "on line \\([0-9]+\\)" msg) + (string-match ":\\([0-9]+\\):\\([0-9]+\\): error:" msg)) + (setq line (string-to-number (match-string 1 msg))) + (when (match-string 2 msg) + (setq column (string-to-number (match-string 2 msg)))) + + (when coffee-compile-jump-to-error + (goto-char (point-min)) + (forward-line (1- line)) + (when column + (move-to-column (1- column))))))) + +(defun coffee-compile-file () + "Compiles and saves the current file to disk in a file of the same +base name, with extension `.js'. Subsequent runs will overwrite the +file. + +If there are compilation errors, point is moved to the first +See `coffee-compile-jump-to-error'." + (interactive) + (let* ((input (buffer-file-name)) + (basename (file-name-sans-extension input)) + (output (when (string-match-p "\\.js\\'" basename) ;; for Rails '.js.coffee' file + basename)) + (compile-args (coffee-command-compile input output)) + (compiler-output (with-temp-buffer + (unless (zerop (apply #'process-file coffee-command nil t nil compile-args)) + (error "Failed: %s %s" coffee-command compile-args)) + (buffer-substring-no-properties (point-min) (point-max))))) + (if (string= compiler-output "") + (let ((file-name (coffee-compiled-file-name (buffer-file-name)))) + (message "Compiled and saved %s" (or output (concat basename ".js"))) + (coffee-revert-buffer-compiled-file file-name)) + (coffee-parse-error-output compiler-output)))) + +(defun coffee-compile-buffer () + "Compiles the current buffer and displays the JavaScript in a buffer +called `coffee-compiled-buffer-name'." + (interactive) + (coffee-compile-region (point-min) (point-max))) + +(defsubst coffee-generate-sourcemap-p () + (cl-find-if (lambda (opt) (member opt '("-m" "--map"))) coffee-args-compile)) + +(defun coffee--coffeescript-version () + (with-temp-buffer + (unless (zerop (process-file coffee-command nil t nil "--version")) + (error "Failed: 'coffee --version'")) + (goto-char (point-min)) + (let ((line (buffer-substring-no-properties (point) (line-end-position)))) + (when (string-match "[0-9.]+\\'" line) + (match-string-no-properties 0 line))))) + +(defun coffee--map-file-name (coffee-file) + (let* ((version (coffee--coffeescript-version)) + (extension (if (version<= "1.8" version) ".js.map" ".map"))) + ;; foo.js: foo.js.map(>= 1.8), foo.map(< 1.8) + (concat (file-name-sans-extension coffee-file) extension))) + +(defmacro coffee-save-window-if (bool &rest body) + `(if ,bool (save-selected-window ,@body) ,@body)) +(put 'coffee-save-window-if 'lisp-indent-function 1) + +(defun coffee-compile-sentinel (buffer file line column) + (lambda (proc _event) + (when (eq (process-status proc) 'exit) + (setq coffee--process nil) + (coffee-save-window-if (not coffee-switch-to-compile-buffer) + (pop-to-buffer (get-buffer coffee-compiled-buffer-name)) + (ansi-color-apply-on-region (point-min) (point-max)) + (goto-char (point-min)) + (if (not (= (process-exit-status proc) 0)) + (let ((compile-output (buffer-string))) + (with-current-buffer buffer + (coffee-parse-error-output compile-output))) + (let ((props (list :sourcemap (coffee--map-file-name file) + :line line :column column :source file))) + (let ((buffer-file-name "tmp.js")) + (setq buffer-read-only t) + (set-auto-mode) + (run-hook-with-args 'coffee-after-compile-hook props)))))))) + +(defun coffee-start-compile-process (curbuf line column) + (lambda (start end) + (let ((proc (apply 'start-file-process "coffee-mode" + (get-buffer-create coffee-compiled-buffer-name) + coffee-command (append coffee-args-compile '("-s" "-p")))) + (curfile (buffer-file-name curbuf))) + (set-process-query-on-exit-flag proc nil) + (set-process-sentinel + proc (coffee-compile-sentinel curbuf curfile line column)) + (with-current-buffer curbuf + (process-send-region proc start end)) + (process-send-string proc "\n") + (process-send-eof proc) + (setq coffee--process proc)))) + +(defun coffee-start-generate-sourcemap-process (start end) + ;; so that sourcemap generation reads from the current buffer + (save-buffer) + (let* ((file (buffer-file-name)) + (sourcemap-buf (get-buffer-create "*coffee-sourcemap*")) + (proc (start-file-process "coffee-sourcemap" sourcemap-buf + coffee-command "-m" file)) + (curbuf (current-buffer)) + (line (line-number-at-pos)) + (column (current-column))) + (setq coffee--process proc) + (set-process-query-on-exit-flag proc nil) + (set-process-sentinel + proc + (lambda (proc _event) + (when (eq (process-status proc) 'exit) + (setq coffee--process nil) + (if (not (= (process-exit-status proc) 0)) + (let ((sourcemap-output + (with-current-buffer sourcemap-buf (buffer-string)))) + (with-current-buffer curbuf + (coffee-parse-error-output sourcemap-output))) + (kill-buffer sourcemap-buf) + (funcall (coffee-start-compile-process curbuf line column) start end))))))) + +(defun coffee-cleanup-compile-buffer () + (let ((buffer (get-buffer coffee-compiled-buffer-name))) + (when buffer + (with-current-buffer buffer + (setq buffer-read-only nil) + (erase-buffer))))) + +(defun coffee-compile-region (start end) + "Compiles a region and displays the JavaScript in a buffer called +`coffee-compiled-buffer-name'." + (interactive "r") + (coffee-cleanup-compile-buffer) + (if (coffee-generate-sourcemap-p) + (coffee-start-generate-sourcemap-process start end) + (funcall (coffee-start-compile-process + (current-buffer) (line-number-at-pos) (current-column)) + start end))) + +(defun coffee-get-repl-proc () + (unless (comint-check-proc coffee-repl-buffer) + (coffee-repl) + ;; see issue #332 + (sleep-for 0 100)) + (get-buffer-process coffee-repl-buffer)) + +(defun coffee-send-line () + "Send the current line to the inferior Coffee process." + (interactive) + (coffee-send-region (line-beginning-position) (line-end-position))) + +(defun coffee-send-region (start end) + "Send the current region to the inferior Coffee process." + (interactive "r") + (deactivate-mark t) + (let* ((string (buffer-substring-no-properties start end)) + (proc (coffee-get-repl-proc)) + (multiline-escaped-string + (replace-regexp-in-string "\n" "\uFF00" string))) + (comint-simple-send proc multiline-escaped-string))) + +(defun coffee-send-buffer () + "Send the current buffer to the inferior Coffee process." + (interactive) + (coffee-send-region (point-min) (point-max))) + +(defun coffee-js2coffee-replace-region (start end) + "Convert JavaScript in the region into CoffeeScript." + (interactive "r") + + (let ((buffer (get-buffer coffee-compiled-buffer-name))) + (when buffer + (kill-buffer buffer))) + + (call-process-region start end + js2coffee-command t + (current-buffer))) + +(defun coffee-version () + "Show the `coffee-mode' version in the echo area." + (interactive) + (message (concat "coffee-mode version " coffee-mode-version))) + +(defun coffee-watch (dir-or-file) + "Run `coffee-run-cmd' with the --watch flag on a directory or file." + (interactive "fDirectory or File: ") + (let ((coffee-compiled-buffer-name coffee-watch-buffer-name) + (args (mapconcat 'identity (append coffee-args-compile (list "--watch" (expand-file-name dir-or-file))) " "))) + (coffee-run-cmd args))) + +;; +;; Menubar +;; + +(easy-menu-define coffee-mode-menu coffee-mode-map + "Menu for CoffeeScript mode" + '("CoffeeScript" + ["Compile File" coffee-compile-file] + ["Compile Buffer" coffee-compile-buffer] + ["Compile Region" coffee-compile-region] + ["REPL" coffee-repl] + "---" + ["Version" coffee-version] + )) + +;; +;; Define Language Syntax +;; + +;; Instance variables (implicit this) +(defvar coffee-this-regexp "\\(?:@[_[:word:]]+\\|\\") + +;; Prototype::access +(defvar coffee-prototype-regexp "[_[:word:].$]+?::") + +;; Assignment +(defvar coffee-assign-regexp "\\(@?[_[:word:].$]+?\\)\\s-*:") + +;; Local Assignment +(defvar coffee-local-assign-regexp "\\s-*\\([_[:word:].$]+\\)\\s-*\\??=\\(?:[^>=]\\|$\\)") + +;; Lambda +(defvar coffee-lambda-regexp "\\(?:([^)]*)\\)?\\s-*\\(->\\|=>\\)") + +;; Namespaces +(defvar coffee-namespace-regexp "\\b\\(?:class\\s-+\\(\\S-+\\)\\)\\b") + +;; Booleans +(defvar coffee-boolean-regexp + (rx (or bol (not (any "."))) + (group symbol-start + (or "true" "false" "yes" "no" "on" "off" "null" "undefined") + symbol-end))) + +;; Regular expressions +(eval-and-compile + (defvar coffee-regexp-regexp "\\s/\\(\\(?:\\\\/\\|[^/\n\r]\\)*\\)\\s/")) + +;; JavaScript Keywords +(defvar coffee-js-keywords + '("if" "else" "new" "return" "try" "catch" + "finally" "throw" "break" "continue" "for" "in" "while" + "delete" "instanceof" "typeof" "switch" "super" "extends" + "class" "until" "loop" "yield")) + +;; Reserved keywords either by JS or CS. +(defvar coffee-js-reserved + '("case" "default" "do" "function" "var" "void" "with" + "const" "let" "debugger" "enum" "export" "import" "native" + "__extends" "__hasProp")) + +;; CoffeeScript keywords. +(defvar coffee-cs-keywords + '("then" "unless" "and" "or" "is" "own" + "isnt" "not" "of" "by" "when")) + +;; Iced CoffeeScript keywords +(defvar iced-coffee-cs-keywords + '("await" "defer")) + +;; Regular expression combining the above three lists. +(defvar coffee-keywords-regexp + ;; keywords can be member names. + (concat "\\(?:^\\|[^.]\\)" + (regexp-opt (append coffee-js-reserved + coffee-js-keywords + coffee-cs-keywords + iced-coffee-cs-keywords) 'symbols))) + +;; Create the list for font-lock. Each class of keyword is given a +;; particular face. +(defvar coffee-font-lock-keywords + ;; *Note*: order below matters. `coffee-keywords-regexp' goes last + ;; because otherwise the keyword "state" in the function + ;; "state_entry" would be highlighted. + `((,coffee-regexp-regexp . font-lock-constant-face) + (,coffee-this-regexp . font-lock-variable-name-face) + (,coffee-prototype-regexp . font-lock-type-face) + (,coffee-assign-regexp . font-lock-type-face) + (,coffee-local-assign-regexp 1 font-lock-variable-name-face) + (,coffee-boolean-regexp 1 font-lock-constant-face) + (,coffee-lambda-regexp 1 font-lock-function-name-face) + (,coffee-keywords-regexp 1 font-lock-keyword-face) + (,(lambda (limit) + (let ((res nil) + start) + (while (and (not res) (search-forward "#{" limit t)) + (let ((restart-pos (match-end 0))) + (setq start (match-beginning 0)) + (let (finish) + (while (and (not finish) (search-forward "}" limit t)) + (let ((end-pos (point))) + (save-excursion + (when (and (ignore-errors (backward-list 1)) + (= start (1- (point)))) + (setq res end-pos finish t))))) + (unless finish + (goto-char restart-pos))))) + (when (and res start) + (set-match-data (list start res))) + res)) + (0 font-lock-variable-name-face t)))) + +;; +;; Helper Functions +;; + +(defun coffee-comment-dwim (arg) + "Comment or uncomment current line or region in a smart way. +For details, see `comment-dwim'." + (interactive "*P") + (require 'newcomment) + (let ((deactivate-mark nil) (comment-start "#") (comment-end "")) + (comment-dwim arg) + (deactivate-mark t))) + +(defsubst coffee-command-compile-options (output) + (if output + (append coffee-args-compile (list "-j" output)) + coffee-args-compile)) + +(defun coffee-command-compile (input output) + "Run `coffee-command' to compile FILE-NAME to file with default +.js output file, or optionally to OUTPUT-FILE-NAME." + (let* ((expanded (expand-file-name input)) + (filename (if (file-remote-p expanded) + (tramp-file-name-localname (tramp-dissect-file-name expanded)) + (file-truename expanded))) + (output-file (coffee-compiled-file-name filename)) + (output-dir (file-name-directory output-file))) + (unless (file-directory-p output-dir) + (make-directory output-dir t)) + (append (coffee-command-compile-options output) + (list "-o" output-dir filename)))) + +(defun coffee-run-cmd (args) + "Run `coffee-command' with the given arguments, and display the +output in a compilation buffer." + (interactive "sArguments: ") + (let ((compilation-buffer-name-function + (lambda (_this-mode) + (generate-new-buffer-name coffee-compiled-buffer-name)))) + (compile (concat coffee-command " " args)))) + +(defun coffee-toggle-fatness () + "Toggle fatness of a coffee function arrow." + (interactive) + (save-excursion + (when (re-search-backward "[-=]>" nil t) + (cond ((looking-at "=") (replace-match "-")) + ((looking-at "-") (replace-match "=")))))) + +;; +;; imenu support +;; + +(defconst coffee-imenu-index-regexp + (concat "^\\(\\s-*\\)" ; $1 + "\\(?:" + coffee-assign-regexp ; $2 + "\\s-*" + coffee-lambda-regexp + "\\|" + coffee-namespace-regexp ; $4 + "\\|" + "\\(@?[_[:word:]:.$]+\\)\\s-*=\\(?:[^>]\\|$\\)" ; $5 match prototype access too + "\\(?:" "\\s-*" "\\(" coffee-lambda-regexp "\\)" "\\)?" ; $6 + "\\)")) + +(defun coffee-imenu-create-index () + "Create an imenu index of all methods in the buffer." + (interactive) + + ;; This function is called within a `save-excursion' so we're safe. + (goto-char (point-min)) + + (let ((index-alist '()) + (ns-indent 0) + ns-name) + ;; Go through every assignment that includes -> or => on the same + ;; line or starts with `class'. + (while (re-search-forward coffee-imenu-index-regexp nil t) + (let ((current-indent (- (match-end 1) (match-beginning 1))) + (property-name (match-string-no-properties 2)) + (class-name (match-string-no-properties 4)) + (variable-name (match-string-no-properties 5)) + (func-assign (match-string-no-properties 6))) + + ;; If this is the start of a new namespace, save the namespace's + ;; indentation level and name. + (if class-name + (setq ns-name (concat class-name "::") + ns-indent current-indent) + (when (and variable-name (<= current-indent ns-indent)) + (setq ns-name (concat variable-name ".") + ns-indent current-indent))) + + (if func-assign + (push (cons variable-name (match-beginning 5)) index-alist) + (when (and ns-name property-name) + (let ((index-pos (match-beginning 2))) + (if (<= current-indent ns-indent) + ;; Clear the namespace if we're no longer indented deeper + (setq ns-name nil ns-indent nil) + ;; Register as index-name if we are within the context of a namespace + (push (cons (concat ns-name property-name) index-pos) index-alist))))))) + index-alist)) + +;; +;; Indentation +;; + +(defsubst coffee-insert-spaces (count) + (if coffee-indent-tabs-mode + (insert-char (string-to-char "\t") (floor count coffee-tab-width)) + (insert-char ? count))) + +;;; The theory is explained in the README. + +(defsubst coffee--in-string-or-comment-p () + (nth 8 (syntax-ppss))) + +(defun coffee--block-type () + (save-excursion + (back-to-indentation) + (unless (coffee--in-string-or-comment-p) + (cond ((looking-at-p "else\\(\\s-+if\\)?\\_>") 'if-else) + ((looking-at-p "\\(?:catch\\|finally\\)\\_>") 'try-catch))))) + +(defun coffee--closed-if-else-p (curindent if-indent) + (let (else-if-p else-p) + (when (looking-at "else\\(?:\\s-+\\(if\\)\\)?\\_>") + (if (string= (match-string 1) "if") + (setq else-if-p t) + (setq else-p t))) + (or (and (not (or else-p else-if-p)) (<= curindent if-indent)) + (and else-p (= curindent if-indent))))) + +(defun coffee--closed-try-catch-p (curindent if-indent) + (and (not (looking-at-p "\\(?:finally\\|catch\\)\\_>")) + (<= curindent if-indent))) + +(defun coffee--closed-block-p (type if-indent limit) + (let ((limit-line (line-number-at-pos limit)) + (closed-pred (cl-case type + (if-else 'coffee--closed-if-else-p) + (try-catch 'coffee--closed-try-catch-p))) + finish) + (save-excursion + (while (and (not finish) (< (point) limit)) + (forward-line 1) + (when (< (line-number-at-pos) limit-line) + (let ((curindent (current-indentation))) + (unless (coffee--in-string-or-comment-p) + (back-to-indentation) + (when (funcall closed-pred curindent if-indent) + (setq finish t)))))) + finish))) + +(defun coffee--find-if-else-indents (limit cmpfn) + (let (indents) + (while (re-search-forward "^\\s-*if\\_>" limit t) + (let ((indent (current-indentation))) + (unless (coffee--closed-block-p 'if-else indent limit) + (push indent indents)))) + (sort indents cmpfn))) + +(defun coffee--find-try-catch-indents (limit cmpfn) + (let (indents) + (while (re-search-forward "^\\s-*try\\_>" limit t) + (let ((indent (current-indentation))) + (unless (coffee--closed-block-p 'try-catch indent limit) + (push indent indents)))) + (sort indents cmpfn))) + +(defun coffee--find-indents (type limit cmpfn) + (save-excursion + (coffee-beginning-of-defun 1) + (cl-case type + (if-else (coffee--find-if-else-indents limit cmpfn)) + (try-catch (coffee--find-try-catch-indents limit cmpfn))))) + +(defsubst coffee--decide-indent (curindent if-indents cmpfn) + (cl-loop for if-indent in if-indents + when (funcall cmpfn if-indent curindent) + return if-indent + finally + return (car if-indents))) + +(defun coffee--indent-insert-spaces (indent-size) + (unless (= (current-indentation) indent-size) + (save-excursion + (goto-char (line-beginning-position)) + (delete-horizontal-space) + (coffee-insert-spaces indent-size))) + (when (< (current-column) (current-indentation)) + (back-to-indentation))) + +(defun coffee--indent-line-like-python-mode (prev-indent repeated) + (let ((next-indent (- (current-indentation) coffee-tab-width)) + (indent-p (coffee-line-wants-indent))) + (if repeated + (if (< next-indent 0) + (+ prev-indent (if indent-p coffee-tab-width 0)) + next-indent) + (+ prev-indent (if indent-p coffee-tab-width 0))))) + +(defun coffee-indent-line () + "Indent current line as CoffeeScript." + (interactive) + (let* ((curindent (current-indentation)) + (limit (+ (line-beginning-position) curindent)) + (type (coffee--block-type)) + indent-size + begin-indents) + (if (and type (setq begin-indents (coffee--find-indents type limit '<))) + (setq indent-size (coffee--decide-indent curindent begin-indents '>)) + (if coffee-indent-like-python-mode + (setq indent-size + (coffee--indent-line-like-python-mode + (coffee-previous-indent) (eq last-command this-command))) + (let ((prev-indent (coffee-previous-indent)) + (next-indent-size (+ curindent coffee-tab-width))) + (if (> (- next-indent-size prev-indent) coffee-tab-width) + (setq indent-size 0) + (setq indent-size (+ curindent coffee-tab-width)))))) + (coffee--indent-insert-spaces indent-size))) + +(defun coffee-previous-indent () + "Return the indentation level of the previous non-blank line." + (save-excursion + (forward-line -1) + (while (and (looking-at "^[ \t]*$") (not (bobp))) + (forward-line -1)) + (current-indentation))) + +(defun coffee-newline-and-indent () + "Insert a newline and indent it to the same level as the previous line." + (interactive) + + ;; Remember the current line indentation level, + ;; insert a newline, and indent the newline to the same + ;; level as the previous line. + (let ((prev-indent (current-indentation))) + (when (< (current-column) (current-indentation)) + (move-to-column (current-indentation))) + (delete-horizontal-space t) + (newline) + + (if (coffee-line-wants-indent) + ;; We need to insert an additional tab because the last line was special. + (coffee-insert-spaces (+ (coffee-previous-indent) coffee-tab-width)) + ;; otherwise keep at the same indentation level + (coffee-insert-spaces prev-indent)) + + ;; Last line was a comment so this one should probably be, + ;; too. Makes it easy to write multi-line comments (like the one I'm + ;; writing right now). + (unless (and auto-fill-function comment-auto-fill-only-comments) + (when (coffee-previous-line-is-single-line-comment) + (insert "# "))))) + +(defun coffee-dedent-line-backspace (arg) + "Unindent to increment of `coffee-tab-width' with ARG==1 when +called from first non-blank char of line. + +Delete ARG spaces if ARG!=1." + (interactive "*p") + (if (use-region-p) + (delete-region (region-beginning) (region-end)) + (if (and (= 1 arg) + (= (point) (save-excursion + (back-to-indentation) + (point))) + (not (bolp))) + (let* ((extra-space-count (% (current-column) coffee-tab-width)) + (deleted-chars (if (zerop extra-space-count) + coffee-tab-width + extra-space-count))) + (backward-delete-char-untabify deleted-chars)) + (backward-delete-char-untabify arg)))) + +;; Indenters help determine whether the current line should be +;; indented further based on the content of the previous line. If a +;; line starts with `class', for instance, you're probably going to +;; want to indent the next line. + +(defvar coffee-indenters-bol '("class" "for" "if" "else" "unless" "while" "until" + "try" "catch" "finally" "switch" "when") + "Keywords or syntax whose presence at the start of a line means the +next line should probably be indented.") + +(defun coffee-indenters-bol-regexp () + "Builds a regexp out of `coffee-indenters-bol' words." + (regexp-opt coffee-indenters-bol 'words)) + +(defvar coffee-indenters-eol '(?> ?{ ?\[ ?:) + "Single characters at the end of a line that mean the next line +should probably be indented.") + +(defun coffee-line-wants-indent () + "Return t if the current line should be indented relative to the +previous line." + (save-excursion + (back-to-indentation) + (skip-chars-backward "\r\n\t ") + (let ((char-of-eol (char-before (line-end-position)))) + (or (and char-of-eol (memq char-of-eol coffee-indenters-eol)) + (progn + (back-to-indentation) + (looking-at (coffee-indenters-bol-regexp))))))) + +(defun coffee-previous-line-is-single-line-comment () + "Return t if the previous line is a CoffeeScript single line comment." + (save-excursion + (forward-line -1) + (back-to-indentation) + (and (looking-at "#") + (not (looking-at "###\\(?:\\s-+.*\\)?$")) + (progn + (goto-char (line-end-position)) + (nth 4 (syntax-ppss)))))) + +(defun coffee-indent-shift-amount (start end dir) + "Compute distance to the closest increment of `coffee-tab-width'." + (let ((min most-positive-fixnum)) + (save-excursion + (goto-char start) + (while (< (point) end) + (let ((current (current-indentation))) + (when (< current min) + (setq min current))) + (forward-line)) + (let ((rem (% min coffee-tab-width))) + (if (zerop rem) + coffee-tab-width + (cond ((eq dir 'left) rem) + ((eq dir 'right) (- coffee-tab-width rem)) + (t 0))))))) + +(defun coffee-indent-shift-left (start end &optional count) + "Shift lines contained in region START END by COUNT columns to the left. +If COUNT is not given, indents to the closest increment of +`coffee-tab-width'. If region isn't active, the current line is +shifted. The shifted region includes the lines in which START and +END lie. An error is signaled if any lines in the region are +indented less than COUNT columns." + (interactive + (if (use-region-p) + (list (region-beginning) (region-end) current-prefix-arg) + (list (line-beginning-position) (line-end-position) current-prefix-arg))) + (let ((amount (if count (* coffee-tab-width (prefix-numeric-value count)) + (coffee-indent-shift-amount start end 'left)))) + (when (> amount 0) + (let (deactivate-mark) + (save-excursion + (goto-char start) + ;; Check that all lines can be shifted enough + (while (< (point) end) + (if (and (< (current-indentation) amount) + (not (looking-at "[ \t]*$"))) + (error "Can't shift all lines enough")) + (forward-line)) + (indent-rigidly start end (- amount))))))) + +(add-to-list 'debug-ignored-errors "^Can't shift all lines enough") + +(defun coffee-indent-shift-right (start end &optional count) + "Shift lines contained in region START END by COUNT columns to the right. +if COUNT is not given, indents to the closest increment of +`coffee-tab-width'. If region isn't active, the current line is +shifted. The shifted region includes the lines in which START and +END lie." + (interactive + (if (use-region-p) + (list (region-beginning) (region-end) current-prefix-arg) + (list (line-beginning-position) (line-end-position) current-prefix-arg))) + (let (deactivate-mark + (amount (if count (* coffee-tab-width (prefix-numeric-value count)) + (coffee-indent-shift-amount start end 'right)))) + (indent-rigidly start end amount))) + +(defun coffee-indent-region (start end) + (interactive "r") + (save-excursion + (goto-char start) + (forward-line 1) + (while (and (not (eobp)) (< (point) end)) + (let ((prev-indent (coffee-previous-indent)) + (curindent (current-indentation)) + indent-size) + (if (coffee-line-wants-indent) + (let ((expected (+ prev-indent coffee-tab-width))) + (when (/= curindent expected) + (setq indent-size expected))) + (when (> curindent prev-indent) + (setq indent-size prev-indent))) + (when indent-size + (save-excursion + (goto-char (line-beginning-position)) + (delete-horizontal-space) + (coffee-insert-spaces indent-size)))) + (forward-line 1)))) + +;; +;; Fill +;; + +(defun coffee-fill-forward-paragraph-function (&optional count) + "`fill-forward-paragraph-function' which correctly handles block +comments such as the following: + + class Klass + method: -> + ### + This is a method doc comment that spans multiple lines. + If `fill-paragraph' is applied to this paragraph, the comment + should preserve its format, with the delimiters on separate lines. + ### + ..." + (let ((ret (forward-paragraph count))) + (when (and (= count -1) + (looking-at "[[:space:]]*###[[:space:]]*$")) + (forward-line)) + ret)) + +;; +;; Define navigation functions +;; + +(defconst coffee-defun-regexp + (concat "^\\s-*\\(?:" + coffee-assign-regexp + "\\s-*" + coffee-lambda-regexp + "\\|" + coffee-namespace-regexp + "\\|" + "@?[_[:word:]:.$]+\\s-*=\\(?:[^>]\\|$\\)" + "\\s-*" + coffee-lambda-regexp + "\\)")) + +(defun coffee-in-comment-p () + (unless (eobp) + (save-excursion + (back-to-indentation) + (when (eq (char-after) ?#) + (forward-char 1)) + (nth 4 (syntax-ppss))))) + +(defsubst coffee-current-line-empty-p () + (let ((line (buffer-substring-no-properties + (line-beginning-position) (line-end-position)))) + (string-match-p "^\\s-*$" line))) + +(defun coffee-current-line-is-defun () + (save-excursion + (goto-char (line-end-position)) + (re-search-backward coffee-defun-regexp (line-beginning-position) t))) + +(defun coffee-current-line-is-assignment () + (save-excursion + (goto-char (line-end-position)) + (re-search-backward "^[_[:word:].$]+\\s-*=\\(?:[^>]\\|$\\)" + (line-beginning-position) t))) + +(defun coffee-curline-defun-type (parent-indent start-is-defun) + (save-excursion + (goto-char (line-end-position)) + (if (not (re-search-backward coffee-defun-regexp (line-beginning-position) t)) + (when (and (zerop parent-indent) (coffee-current-line-is-assignment)) + 'other) + (if (not start-is-defun) + 'other + (if (< parent-indent (current-indentation)) + 'child + 'other))))) + +(defun coffee-same-block-p (block-indent start-is-defun) + (let ((type (coffee-curline-defun-type block-indent start-is-defun))) + (cond ((eq type 'child) t) + ((eq type 'other) nil) + (t (>= (current-indentation) block-indent))))) + +(defsubst coffee-skip-line-p () + (or (coffee-in-comment-p) (coffee-current-line-empty-p))) + +(defun coffee-skip-forward-lines (arg) + (let ((pred (if (> arg 0) + (lambda () (not (eobp))) + (lambda () (not (bobp)))))) + (while (and (funcall pred) (coffee-skip-line-p)) + (forward-line arg)))) + +(defun coffee-beginning-of-defun (&optional count) + (interactive "p") + (unless count + (setq count 1)) + (let ((next-indent nil)) + (when (coffee-skip-line-p) + (save-excursion + (coffee-skip-forward-lines +1) + (setq next-indent (current-indentation)))) + (coffee-skip-forward-lines -1) + (let ((start-indent (or next-indent (current-indentation)))) + (when (and (not (eq this-command 'coffee-mark-defun)) (looking-back "^\\s-*" (line-beginning-position))) + (forward-line -1)) + (let ((finish nil)) + (goto-char (line-end-position)) + (while (and (not finish) (re-search-backward coffee-defun-regexp nil 'move)) + (let ((cur-indent (current-indentation))) + (when (<= cur-indent start-indent) + (setq start-indent cur-indent) + (cl-decf count))) + (when (<= count 0) + (back-to-indentation) + (setq finish t))))))) + +(defun coffee-end-of-block (&optional count) + "Move point to the end of the block." + (interactive "p") + (unless count + (setq count 1)) + (dotimes (_i count) + (let* ((curline-is-defun (coffee-current-line-is-defun)) + start-indent) + (coffee-skip-forward-lines 1) + (setq start-indent (current-indentation)) + (when (and (zerop start-indent) (not curline-is-defun)) + (when (re-search-forward coffee-defun-regexp nil 'move) + (back-to-indentation) + (setq curline-is-defun t))) + (let ((finish nil)) + (while (not finish) + (forward-line 1) + (coffee-skip-forward-lines 1) + (when (or (not (coffee-same-block-p start-indent curline-is-defun)) + (eobp)) + (setq finish t))) + (forward-line -1) + (coffee-skip-forward-lines -1) + (forward-line 1))))) + +(defun coffee-mark-defun () + (interactive) + (let ((be-actived transient-mark-mode)) + (push-mark (point)) + (let ((cur-indent (current-indentation))) + (coffee-beginning-of-defun) + (push-mark (point)) + (coffee-end-of-block) + (push-mark (point) nil be-actived) + (let ((next-indent nil)) + (when (coffee-skip-line-p) + (save-excursion + (coffee-skip-forward-lines +1) + (setq next-indent (current-indentation)))) + (when (and next-indent (< next-indent cur-indent)) + (coffee-skip-forward-lines -1)) + (coffee-beginning-of-defun))))) + +;; +;; hs-minor-mode +;; + +;; support for hs-minor-mode +(add-to-list 'hs-special-modes-alist + '(coffee-mode "\\s-*\\(?:class\\|.+[-=]>$\\)" nil "#" + coffee-end-of-block nil)) + +;; +;; Based on triple quote of python.el +;; +(eval-and-compile + (defconst coffee-block-strings-delimiter + (rx (and + ;; Match even number of backslashes. + (or (not (any ?\\ ?\' ?\" ?/)) + point + ;; Quotes might be preceded by a escaped quote. + (and (or (not (any ?\\)) point) + ?\\ + (* ?\\ ?\\) + (any ?\' ?\" ?/))) + (* ?\\ ?\\) + ;; Match single or triple quotes of any kind. + (group (or "'''" "\"\"\"" "///")))))) + +(defsubst coffee-syntax-count-quotes (quote-char start-point limit) + (let ((i 0)) + (while (and (< i 3) + (< (+ start-point i) limit) + (eq (char-after (+ start-point i)) quote-char)) + (cl-incf i)) + i)) + +(defun coffee-syntax-block-strings-stringify () + (let* ((ppss (prog2 + (backward-char 3) + (syntax-ppss) + (forward-char 3))) + (string-start (and (not (nth 4 ppss)) (nth 8 ppss))) + (quote-starting-pos (- (point) 3)) + (quote-ending-pos (point)) + (num-closing-quotes + (and string-start + (coffee-syntax-count-quotes + (char-before) string-start quote-starting-pos)))) + (cond ((and string-start (= num-closing-quotes 0)) + ;; This set of quotes doesn't match the string starting + ;; kind. Do nothing. + nil) + ((not string-start) + ;; This set of quotes delimit the start of a string. + (put-text-property quote-starting-pos (1+ quote-starting-pos) + 'syntax-table (string-to-syntax "|"))) + ((= num-closing-quotes 3) + ;; This set of quotes delimit the end of a string. + (put-text-property (1- quote-ending-pos) quote-ending-pos + 'syntax-table (string-to-syntax "|")))))) + +(defun coffee-syntax-propertize-block-comment () + (let ((curpoint (point)) + (inhibit-changing-match-data t)) + (let* ((valid-comment-start nil) + (valid-comment-end (looking-at-p "#\\{0,2\\}\\s-*$")) + (ppss (prog2 + (backward-char 3) + (syntax-ppss) + (setq valid-comment-start (looking-back "^\\s-*" (line-beginning-position))) + (forward-char 3))) + (in-comment (nth 4 ppss)) + (in-string (nth 3 ppss))) + (when (or (and (not in-comment) (not in-string) valid-comment-start) + (and in-comment valid-comment-end)) + (put-text-property (- curpoint 3) curpoint + 'syntax-table (string-to-syntax "!")))))) + +(defsubst coffee--in-string-p () + (nth 3 (syntax-ppss))) + +(defun coffee-syntax-string-interpolation () + (let ((start (match-beginning 0)) + (end (point))) + (if (not (coffee--in-string-p)) + (put-text-property start (1+ start) + 'syntax-table (string-to-syntax "< b")) + (goto-char start) + (let (finish res) + (while (and (not finish) (search-forward "}" nil t)) + (let ((end-pos (match-end 0))) + (save-excursion + (when (and (ignore-errors (backward-list 1)) + (= start (1- (point)))) + (setq res end-pos finish t))))) + (goto-char end) + (when res + (while (re-search-forward "[\"'#]" res t) + (put-text-property (match-beginning 0) (match-end 0) + 'syntax-table (string-to-syntax "_"))) + (goto-char (1- res))))))) + +(defun coffee-syntax-propertize-function (start end) + (goto-char start) + (funcall + (syntax-propertize-rules + (coffee-block-strings-delimiter + (0 (ignore (coffee-syntax-block-strings-stringify)))) + ("/" + (0 (ignore + (let ((curpoint (point)) + (start (match-beginning 0)) + (end (match-end 0))) + (goto-char start) + (let ((ppss (syntax-ppss))) + (cond ((nth 8 ppss) + (put-text-property start end + 'syntax-table (string-to-syntax "_")) + (goto-char curpoint)) + ((looking-at coffee-regexp-regexp) + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table (string-to-syntax "_")) + (goto-char (match-end 0))) + (t (goto-char curpoint)))))))) + ("#{" (0 (ignore (coffee-syntax-string-interpolation)))) + ("###" + (0 (ignore (coffee-syntax-propertize-block-comment))))) + (point) end)) + +(defun coffee-get-comment-info () + (let* ((syntax (syntax-ppss)) + (commentp (nth 4 syntax)) + (comment-start-kinda (nth 8 syntax))) + (when commentp + (save-excursion + (if (and + (> comment-start-kinda 2) (< comment-start-kinda (point-max)) + (string= + "###" (buffer-substring + (- comment-start-kinda 2) (1+ comment-start-kinda)))) + 'multiple-line + 'single-line))))) + +(defun coffee-comment-line-break-fn (&optional _) + (let ((comment-type (coffee-get-comment-info)) + (coffee-indent-like-python-mode t)) + (comment-indent-new-line) + (cond ((eq comment-type 'multiple-line) + (save-excursion + (beginning-of-line) + (when (looking-at "[[:space:]]*\\(#\\)") + (replace-match "" nil nil nil 1)))) + ((eq comment-type 'single-line) + (coffee-indent-line))))) + +(defun coffee-auto-fill-fn () + (let ((comment-type (coffee-get-comment-info)) + (fill-result (do-auto-fill)) + (coffee-indent-like-python-mode t)) + (when (and fill-result (eq comment-type 'single-line)) + (save-excursion + (beginning-of-line) + (when (looking-at "[[:space:]]*#") + (replace-match "#"))) + (coffee-indent-line)))) + +;; +;; Define Major Mode +;; + +;;;###autoload +(define-derived-mode coffee-mode prog-mode "Coffee" + "Major mode for editing CoffeeScript." + + ;; code for syntax highlighting + (setq font-lock-defaults '((coffee-font-lock-keywords))) + + ;; fix comment filling function + (set (make-local-variable 'comment-line-break-function) + #'coffee-comment-line-break-fn) + (set (make-local-variable 'normal-auto-fill-function) #'coffee-auto-fill-fn) + ;; perl style comment: "# ..." + (modify-syntax-entry ?# "< b" coffee-mode-syntax-table) + (modify-syntax-entry ?\n "> b" coffee-mode-syntax-table) + + ;; Treat slashes as paired delimiters; useful for finding regexps. + (modify-syntax-entry ?/ "/" coffee-mode-syntax-table) + + (set (make-local-variable 'comment-start) "#") + + ;; single quote strings + (modify-syntax-entry ?' "\"" coffee-mode-syntax-table) + + ;; indentation + (make-local-variable 'coffee-tab-width) + (make-local-variable 'coffee-indent-tabs-mode) + (set (make-local-variable 'indent-line-function) 'coffee-indent-line) + (set (make-local-variable 'indent-region-function) 'coffee-indent-region) + (set (make-local-variable 'tab-width) coffee-tab-width) + + (set (make-local-variable 'syntax-propertize-function) + 'coffee-syntax-propertize-function) + + ;; fill + (set (make-local-variable 'fill-forward-paragraph-function) + 'coffee-fill-forward-paragraph-function) + + (set (make-local-variable 'beginning-of-defun-function) + 'coffee-beginning-of-defun) + (set (make-local-variable 'end-of-defun-function) + 'coffee-end-of-block) + + ;; imenu + (set (make-local-variable 'imenu-create-index-function) + 'coffee-imenu-create-index) + + ;; Don't let electric-indent-mode break coffee-mode. + (set (make-local-variable 'electric-indent-functions) + (list (lambda (_arg) 'no-indent))) + + ;; no tabs + (setq indent-tabs-mode coffee-indent-tabs-mode)) + +;; +;; Compile-on-Save minor mode +;; + +(defcustom coffee-cos-mode-line " CoS" + "Lighter of `coffee-cos-mode'" + :type 'string) + +(define-minor-mode coffee-cos-mode + "Toggle compile-on-save for coffee-mode. + +Add `'(lambda () (coffee-cos-mode t))' to `coffee-mode-hook' to turn +it on by default." + :lighter coffee-cos-mode-line + (if coffee-cos-mode + (add-hook 'after-save-hook 'coffee-compile-file nil t) + (remove-hook 'after-save-hook 'coffee-compile-file t))) + +;; +;; Live compile minor mode +;; + +(defun coffee--live-compile (&rest _unused) + (when (or (not coffee--process) + (not (eq (process-status coffee--process) 'run))) + (coffee-compile-buffer))) + +(defcustom coffee-live-compile-mode-line " LiveCS" + "Lighter of `coffee-live-compile-mode'" + :type 'string) + +(define-minor-mode coffee-live-compile-mode + "Compile current buffer in real time" + :lighter coffee-live-comp-mode-line + (if coffee-live-compile-mode + (add-hook 'after-change-functions 'coffee--live-compile nil t) + (remove-hook 'after-change-functions 'coffee--live-compile t))) + +(provide 'coffee-mode) + +;; +;; On Load +;; + +;; Run coffee-mode for files ending in .coffee. +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.coffee\\'" . coffee-mode)) +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.iced\\'" . coffee-mode)) +;;;###autoload +(add-to-list 'auto-mode-alist '("Cakefile\\'" . coffee-mode)) +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.cson\\'" . coffee-mode)) +;;;###autoload +(add-to-list 'interpreter-mode-alist '("coffee" . coffee-mode)) + +;;; coffee-mode.el ends here diff --git a/elpa/company-c-headers-20150801.901/company-c-headers-autoloads.el b/elpa/company-c-headers-20150801.901/company-c-headers-autoloads.el new file mode 100644 index 0000000..e009390 --- /dev/null +++ b/elpa/company-c-headers-20150801.901/company-c-headers-autoloads.el @@ -0,0 +1,22 @@ +;;; company-c-headers-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "company-c-headers" "company-c-headers.el" +;;;;;; (22297 53348 894925 450000)) +;;; Generated autoloads from company-c-headers.el + +(autoload 'company-c-headers "company-c-headers" "\ +Company backend for C/C++ header files. + +\(fn COMMAND &optional ARG &rest IGNORED)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; company-c-headers-autoloads.el ends here diff --git a/elpa/company-c-headers-20150801.901/company-c-headers-pkg.el b/elpa/company-c-headers-20150801.901/company-c-headers-pkg.el new file mode 100644 index 0000000..aa629c4 --- /dev/null +++ b/elpa/company-c-headers-20150801.901/company-c-headers-pkg.el @@ -0,0 +1 @@ +(define-package "company-c-headers" "20150801.901" "Company mode backend for C/C++ header files" '((emacs "24.1") (company "0.8")) :keywords '("development" "company")) diff --git a/elpa/company-c-headers-20150801.901/company-c-headers.el b/elpa/company-c-headers-20150801.901/company-c-headers.el new file mode 100644 index 0000000..569e07a --- /dev/null +++ b/elpa/company-c-headers-20150801.901/company-c-headers.el @@ -0,0 +1,188 @@ +;;; company-c-headers.el --- Company mode backend for C/C++ header files -*- lexical-binding: t -*- + +;; Copyright (C) 2014 Alastair Rankine + +;; Author: Alastair Rankine +;; Keywords: development company +;; Package-Version: 20150801.901 +;; Package-Requires: ((emacs "24.1") (company "0.8")) + +;; This file is not part of GNU Emacs. + +;; This file 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 file 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 file. If not, see . + +;;; Commentary: + +;; This library enables the completion of C/C++ header file names using Company. +;; +;; To initialize it, just add it to `company-backends': +;; +;; (add-to-list 'company-backends 'company-c-headers) +;; +;; When you type an #include declaration within a supported major mode (see +;; `company-c-headers-modes'), company-c-headers will search for header files +;; within predefined search paths. company-c-headers can search "system" and +;; "user" paths, depending on the type of #include declaration you type. +;; +;; You will probably want to customize the `company-c-headers-path-user' and +;; `company-c-headers-path-system' variables for your specific needs. + +;;; Code: + +(require 'company) +(require 'rx) +(require 'cl-lib) + +(defgroup company-c-headers nil + "Completion back-end for C/C++ header files." + :group 'company) + +(defcustom company-c-headers-path-system + '("/usr/include/" "/usr/local/include/") + "List of paths to search for system (i.e. angle-bracket +delimited) header files. Alternatively, a function can be +supplied which returns the path list." + :type '(choice (repeat directory) + function) + ) + +(defcustom company-c-headers-path-user + '(".") + "List of paths to search for user (i.e. double-quote delimited) +header files. Alternatively, a function can be supplied which +returns the path list. Note that paths in +`company-c-headers-path-system' are implicitly appended." + :type '(choice (repeat directory) + function) + ) + +(defvar company-c-headers-include-declaration + (rx + line-start + "#" (zero-or-more blank) (or "include" "import") + (one-or-more blank) + (submatch + (in "<\"") + (zero-or-more (not (in ">\"")))) + ) + "Prefix matching C/C++/ObjC include directives.") + +(defvar company-c-headers-modes + `( + (c-mode . ,(rx ".h" line-end)) + (c++-mode . ,(rx (or (: line-start (one-or-more (in "A-Za-z0-9_"))) + (or ".h" ".hpp" ".hxx" ".hh")) + line-end)) + (objc-mode . ,(rx ".h" line-end)) + ) + "Assoc list of supported major modes and associated header file names.") + +(defun call-if-function (path) + "If PATH is bound to a function, return the result of calling it. +Otherwise just return the value." + (if (functionp path) + (funcall path) + path)) + +(defun company-c-headers--candidates-for (prefix dir) + "Return a list of candidates for PREFIX in directory DIR. +Filters on the appropriate regex for the current major mode." + (let* ((delim (substring prefix 0 1)) + (fileprefix (substring prefix 1)) + (prefixdir (file-name-directory fileprefix)) + (subdir (and prefixdir (concat (file-name-as-directory dir) prefixdir))) + (hdrs (cdr (assoc major-mode company-c-headers-modes))) + candidates) + + ;; If we need to complete inside a subdirectory, use that + (when (and subdir (file-directory-p subdir)) + (setq dir subdir) + (setq fileprefix (file-name-nondirectory fileprefix)) + (setq delim (concat delim prefixdir)) + ) + + ;; Using a list of completions for this directory, remove those that a) don't match the + ;; headers regexp, and b) are not directories (except for "." and ".." which ARE removed) + (setq candidates (cl-remove-if + (lambda (F) (and (not (string-match-p hdrs F)) + (or (cl-member (directory-file-name F) '("." "..") :test 'equal) + (not (file-directory-p (concat (file-name-as-directory dir) F)))))) + (file-name-all-completions fileprefix dir))) + + ;; We want to see candidates in alphabetical order per directory + (setq candidates (sort candidates #'string<)) + + ;; Add the delimiter and metadata + (mapcar (lambda (C) (propertize (concat delim C) 'directory dir)) candidates) + )) + +(defun company-c-headers--candidates (prefix) + "Return candidates for PREFIX." + (let ((p (if (equal (aref prefix 0) ?\") + (call-if-function company-c-headers-path-user) + (call-if-function company-c-headers-path-system))) + (next (when (equal (aref prefix 0) ?\") + (call-if-function company-c-headers-path-system))) + candidates) + (while p + (when (file-directory-p (car p)) + (setq candidates (append candidates (company-c-headers--candidates-for prefix (car p))))) + + (setq p (or (cdr p) + (let ((tmp next)) + (setq next nil) + tmp))) + ) + candidates + )) + +(defun company-c-headers--meta (candidate) + "Return the metadata associated with CANDIDATE. Currently just the directory." + (get-text-property 0 'directory candidate)) + +(defun company-c-headers--location (candidate) + "Return the location associated with CANDIDATE." + (cons (concat (file-name-as-directory (get-text-property 0 'directory candidate)) + (file-name-nondirectory (substring candidate 1))) + 1)) + +;;;###autoload +(defun company-c-headers (command &optional arg &rest ignored) + "Company backend for C/C++ header files." + (interactive (list 'interactive)) + (pcase command + (`interactive (company-begin-backend 'company-c-headers)) + (`prefix + (when (and (assoc major-mode company-c-headers-modes) + (looking-back company-c-headers-include-declaration (line-beginning-position))) + (match-string-no-properties 1))) + (`sorted t) + (`candidates (company-c-headers--candidates arg)) + (`meta (company-c-headers--meta arg)) + (`location (company-c-headers--location arg)) + (`post-completion + (when (looking-back company-c-headers-include-declaration (line-beginning-position)) + (let ((matched (match-string-no-properties 1))) + ;; Add a terminating delimiter unless we've completed a directory name + ;; If pre-existing terminating delimiter already exist, move cursor + ;; to end of line. + (unless (equal matched (file-name-as-directory matched)) + (pcase (aref matched 0) + (?\" (if (looking-at "\"") (end-of-line) (insert "\""))) + (?< (if (looking-at ">") (end-of-line) (insert ">")))))))) + )) + +(provide 'company-c-headers) + +;;; company-c-headers.el ends here diff --git a/elpa/company-quickhelp-20160211.718/company-quickhelp-autoloads.el b/elpa/company-quickhelp-20160211.718/company-quickhelp-autoloads.el new file mode 100644 index 0000000..0939619 --- /dev/null +++ b/elpa/company-quickhelp-20160211.718/company-quickhelp-autoloads.el @@ -0,0 +1,31 @@ +;;; company-quickhelp-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "company-quickhelp" "company-quickhelp.el" +;;;;;; (22297 53348 410925 167000)) +;;; Generated autoloads from company-quickhelp.el + +(defvar company-quickhelp-mode nil "\ +Non-nil if Company-Quickhelp mode is enabled. +See the command `company-quickhelp-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `company-quickhelp-mode'.") + +(custom-autoload 'company-quickhelp-mode "company-quickhelp" nil) + +(autoload 'company-quickhelp-mode "company-quickhelp" "\ +Provides documentation popups for `company-mode' using `pos-tip'. + +\(fn &optional ARG)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; company-quickhelp-autoloads.el ends here diff --git a/elpa/company-quickhelp-20160211.718/company-quickhelp-pkg.el b/elpa/company-quickhelp-20160211.718/company-quickhelp-pkg.el new file mode 100644 index 0000000..f220fe6 --- /dev/null +++ b/elpa/company-quickhelp-20160211.718/company-quickhelp-pkg.el @@ -0,0 +1 @@ +(define-package "company-quickhelp" "20160211.718" "Popup documentation for completion candidates" '((emacs "24.4") (company "0.8.9") (pos-tip "0.4.6")) :url "https://www.github.com/expez/company-quickhelp" :keywords '("company" "popup" "documentation" "quickhelp")) diff --git a/elpa/company-quickhelp-20160211.718/company-quickhelp.el b/elpa/company-quickhelp-20160211.718/company-quickhelp.el new file mode 100644 index 0000000..c287b69 --- /dev/null +++ b/elpa/company-quickhelp-20160211.718/company-quickhelp.el @@ -0,0 +1,210 @@ +;;; company-quickhelp.el --- Popup documentation for completion candidates + +;; Copyright (C) 2015, Lars Andersen + +;; Author: Lars Andersen +;; URL: https://www.github.com/expez/company-quickhelp +;; Package-Version: 20160211.718 +;; Keywords: company popup documentation quickhelp +;; Version: 1.3.0 +;; Package-Requires: ((emacs "24.4") (company "0.8.9") (pos-tip "0.4.6")) + +;; 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 . + +;;; Commentary: + +;; When idling on a completion candidate the documentation for the +;; candidate will pop up after `company-quickhelp-idle-delay' seconds. + +;;; Usage: +;; put (company-quickhelp-mode 1) in you init.el to activate +;; `company-quickhelp-mode'. + +;; You can adjust the time it takes for the documentation to pop up by +;; changing `company-quickhelp-delay' + +;;; Code: +(require 'company) +(require 'pos-tip) +(require 'cl-lib) + +(defgroup company-quickhelp nil + "Documentation popups for `company-mode'" + :group 'company) + +(defcustom company-quickhelp-delay 0.5 + "Delay, in seconds, before the quickhelp popup appears. + +If set to nil the popup won't automatically appear, but can still +be triggered manually using `company-quickhelp-show'." + :type '(choice (number :tag "Delay in seconds") + (const :tag "Don't popup help automatically" nil)) + :group 'company-quickhelp) + +(defcustom company-quickhelp-max-lines nil + "When not NIL, limits the number of lines in the popup." + :type '(choice (integer :tag "Max lines to show in popup") + (const :tag "Don't limit the number of lines shown" nil)) + :group 'company-quickhelp) + +(defvar company-quickhelp-mode-map + (let ((keymap (make-sparse-keymap))) + (define-key keymap (kbd "M-h") #'company-quickhelp-manual-begin) + keymap) + "The keymap used by `company-quickhelp'.") + +(defvar company-quickhelp--timer nil + "Quickhelp idle timer.") + +(defvar company-quickhelp--original-tooltip-width company-tooltip-minimum-width + "The documentation popup breaks inexplicably when we transition + from a large pseudo-tooltip to a small one. We solve this by + overriding `company-tooltip-minimum-width' and save the + original value here so we can restore it.") + +(defun company-quickhelp-frontend (command) + "`company-mode' front-end showing documentation in a `pos-tip' popup." + (pcase command + (`post-command (when company-quickhelp-delay + (company-quickhelp--set-timer))) + (`hide + (when company-quickhelp-delay + (company-quickhelp--cancel-timer)) + (pos-tip-hide)))) + +(defun company-quickhelp--doc-and-meta (doc) + ;; The company backend can either return a buffer with the doc or a + ;; cons containing the doc buffer and a position at which to start + ;; reading. + (let ((doc-buffer (if (consp doc) (car doc) doc)) + (doc-begin (when (consp doc) (cdr doc)))) + (with-current-buffer doc-buffer + (let ((truncated t)) + (goto-char (or doc-begin (point-min))) + (if company-quickhelp-max-lines + (forward-line company-quickhelp-max-lines) + (goto-char (point-max))) + (beginning-of-line) + (when (= (line-number-at-pos) + (save-excursion (goto-char (point-max)) (line-number-at-pos))) + (setq truncated nil)) + (while (and (not (= (line-number-at-pos) 1)) + (or + ;; [back] appears at the end of the help elisp help buffer + (looking-at-p "\\[back\\]") + ;; [source] cider's help buffer contains a link to source + (looking-at-p "\\[source\\]") + (looking-at-p "^\\s-*$"))) + (forward-line -1)) + (list :doc (buffer-substring-no-properties (point-min) (point-at-eol)) + :truncated truncated))))) + +(defun company-quickhelp--completing-read (prompt candidates &rest rest) + "`cider', and probably other libraries, prompt the user to +resolve ambiguous documentation requests. Instead of failing we +just grab the first candidate and press forward." + (car candidates)) + +(defun company-quickhelp--doc (selected) + (cl-letf (((symbol-function 'completing-read) + #'company-quickhelp--completing-read)) + (let* ((doc (company-call-backend 'doc-buffer selected)) + (doc-and-meta (when doc + (company-quickhelp--doc-and-meta doc))) + (truncated (plist-get doc-and-meta :truncated)) + (doc (plist-get doc-and-meta :doc))) + (unless (string= doc "") + (if truncated + (concat doc "\n\n[...]") + doc))))) + +(defun company-quickhelp-manual-begin () + "Manually trigger the `company-quickhelp' popup for the +currently active `company' completion candidate." + (interactive) + ;; This might seem a bit roundabout, but when I attempted to call + ;; `company-quickhelp--show' in a more direct manner it triggered a + ;; redisplay of company's list of completion candidates which looked + ;; quite weird. + (let ((company-quickhelp-delay 0.01)) + (company-quickhelp--set-timer))) + +(defun company-quickhelp--show () + (company-quickhelp--ensure-compatibility) + (company-quickhelp--cancel-timer) + (let* ((selected (nth company-selection company-candidates)) + (doc (company-quickhelp--doc selected)) + (ovl company-pseudo-tooltip-overlay) + (overlay-width (* (frame-char-width) + (if ovl (overlay-get ovl 'company-width) 0))) + (overlay-position (* (frame-char-width) + (- (if ovl (overlay-get ovl 'company-column) 1) 1))) + (x-gtk-use-system-tooltips nil)) + (when (and ovl doc) + (with-no-warnings + (pos-tip-show doc nil (overlay-start ovl) nil 300 80 nil + (+ overlay-width overlay-position) 1))))) + +(defun company-quickhelp--set-timer () + (when (null company-quickhelp--timer) + (setq company-quickhelp--timer + (run-with-idle-timer company-quickhelp-delay nil + 'company-quickhelp--show)))) + +(defun company-quickhelp--cancel-timer () + (when (timerp company-quickhelp--timer) + (cancel-timer company-quickhelp--timer) + (setq company-quickhelp--timer nil))) + +(defun company-quickhelp-hide () + (company-cancel)) + +(defun company-quickhelp--ensure-compatibility () + ;; Originally this code was in `company-quickhelp-enable' but that + ;; caused trouble for --daemon users reported in #16. + (cond + ((or (not (fboundp 'x-hide-tip)) + (not (fboundp 'x-show-tip))) + (user-error "Company-quickhelp doesn't work on your system. +Most likely this means you're on a mac with an Emacs build using Cocoa instead of X")) + ((or (null window-system) + (eq window-system 'pc)) + (user-error "Company-quickhelp doesn't work in the terminal")))) + +(defun company-quickhelp--enable () + (add-hook 'focus-out-hook #'company-quickhelp-hide) + (setq company-quickhelp--original-tooltip-width company-tooltip-minimum-width + company-tooltip-minimum-width (max company-tooltip-minimum-width 40)) + (add-to-list 'company-frontends 'company-quickhelp-frontend :append)) + +(defun company-quickhelp--disable () + (remove-hook 'focus-out-hook #'company-quickhelp-hide) + (company-quickhelp--cancel-timer) + (setq company-tooltip-minimum-width company-quickhelp--original-tooltip-width + company-frontends + (delq 'company-quickhelp-frontend company-frontends))) + +;;;###autoload +(define-minor-mode company-quickhelp-mode + "Provides documentation popups for `company-mode' using `pos-tip'." + :global t :keymap company-quickhelp-mode-map + (if company-quickhelp-mode + (company-quickhelp--enable) + (company-quickhelp--disable))) + +(provide 'company-quickhelp) + +;;; company-quickhelp.el ends here diff --git a/elpa/company-shell-20160212.1139/company-shell-autoloads.el b/elpa/company-shell-20160212.1139/company-shell-autoloads.el new file mode 100644 index 0000000..3ce4d0e --- /dev/null +++ b/elpa/company-shell-20160212.1139/company-shell-autoloads.el @@ -0,0 +1,32 @@ +;;; company-shell-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "company-shell" "company-shell.el" (22297 53347 +;;;;;; 354924 555000)) +;;; Generated autoloads from company-shell.el + +(autoload 'company-shell-rebuild-cache "company-shell" "\ +Builds the cache of all completions found on the $PATH and all fish functions. + +\(fn)" t nil) + +(autoload 'company-fish-shell "company-shell" "\ +Company backend for fish shell functions. + +\(fn COMMAND &optional ARG &rest IGNORED)" t nil) + +(autoload 'company-shell "company-shell" "\ +Company mode backend for binaries found on the $PATH. + +\(fn COMMAND &optional ARG &rest IGNORED)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; company-shell-autoloads.el ends here diff --git a/elpa/company-shell-20160212.1139/company-shell-pkg.el b/elpa/company-shell-20160212.1139/company-shell-pkg.el new file mode 100644 index 0000000..e62640b --- /dev/null +++ b/elpa/company-shell-20160212.1139/company-shell-pkg.el @@ -0,0 +1 @@ +(define-package "company-shell" "20160212.1139" "Company mode backend for shell functions" '((company "0.8.12") (dash "2.12.0") (cl-lib "0.5")) :url "https://github.com/Alexander-Miller/company-shell" :keywords '("company" "shell")) diff --git a/elpa/company-shell-20160212.1139/company-shell.el b/elpa/company-shell-20160212.1139/company-shell.el new file mode 100644 index 0000000..b65a41a --- /dev/null +++ b/elpa/company-shell-20160212.1139/company-shell.el @@ -0,0 +1,181 @@ +;;; company-shell.el --- Company mode backend for shell functions + +;; Copyright (C) 2015 Alexander Miller + +;; Author: Alexander Miller +;; Package-Requires: ((company "0.8.12") (dash "2.12.0") (cl-lib "0.5")) +;; Homepage: https://github.com/Alexander-Miller/company-shell +;; Version: 1.0 +;; Package-Version: 20160212.1139 +;; Keywords: company, shell + +;; 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: + +;; Backend for company mode to complete binaries found on your $PATH +;; and fish shell functions. + +;;; Code: + +(require 'company) +(require 'dash) +(require 'cl-lib) + +(defvar company-shell--cache nil + "Cache of all possible $PATH completions. Automatically built when nil. Invoke `company-shell-rebuild-cache' to rebuild manually.") + +(defvar company-shell--fish-cache nil + "Cache of all possible fish shell function completions. Automatically built when nil. Invoke `company-shell-rebuild-cache' to rebuild manually.") + +(defvar company-shell-delete-duplicates t + "If non-nil the list of completions will be purged of duplicates. Duplicates in this context means any two +string-equal entries, regardless where they have been found. This would prevent a completion candidate +appearing twice because it is found in both /usr/bin/ and /usr/local/bin. + +For a change to this variable to take effect the cache needs to be rebuilt via `company-shell-rebuild-cache'.") + +(defvar company-shell-modes '(sh-mode fish-mode shell-mode eshell-mode) + "List of major modes where `company-shell' will be providing completions if it is part of `company-backends'. +All modes not on this list will be ignored. Set value to nil to enable company-shell regardless of current major-mode.") + +(defvar company-fish-shell-modes '(fish-mode shell-mode) + "List of major modes where `company-fish-shell' will be providing completions if it is part of `company-backends'. +All modes not on this list will be ignored. Set value to nil to enable company-fish-shell regardless of current major-mode.") + +(defvar company-shell-use-help-arg nil + "SETTING THIS TO t IS POTENTIALLY UNSAFE. + +If non-nil company-(fish)-shell will try and find a doc-string by running `arg --help' +if `man arg' did not produce any valid results. This is not completely safe since +company-shell does not and can not know whether it is safe to run a command in this +fashion. Some applications may simply ignore or misinterpret the command flag, with +unpredictable results. Usually this just means that instead of any actual documentation +you'll see an error message telling you the program doesn't know what to do with the +--help arg or that it was started with invalid input. In rare cases a program may simple +ignore the --help arg and directly spawn a GUI like xfce4-notes-settings does. + +To mitigate any such issues company-shell will run the --help attempt on a timer of +1 second. This is more than enough to fetch the doc output if it is available, but will +quickly close any process that may accidentally have been spawned. In addition the command +will run in a restricted shell (via $(which sh) --restricted) to further avoid any unwanted +side effects. + +Despite these precautions company-shell will nonetheless need to sometimes run completely unknown +binaries, which is why this option is turned off by default. You need to consciously enable +it in the understanding that you do this AT YOUR OWN RISK.") + +(defun company-shell--fetch-candidates () + (unless company-shell--cache (company-shell--build-cache)) + company-shell--cache) + +(defun company-shell--fetch-fish-candidates () + (unless company-shell--fish-cache (company-shell--build-fish-cache)) + company-shell--fish-cache) + +(defun company-shell--build-cache () + (let ((completions (-mapcat + (lambda (dir) + (-map + (lambda (file) (propertize file 'origin dir)) + (directory-files dir))) + (-filter 'file-readable-p exec-path)))) + (setq company-shell--cache (sort + (if company-shell-delete-duplicates + (delete-dups completions) + completions) + 'string-lessp)))) + +(defun company-shell--build-fish-cache () + (when (executable-find "fish") + (setq company-shell--fish-cache + (-> (shell-command-to-string "fish -c \"functions -a\"") + (split-string "\n") + (sort 'string-lessp))))) + +(defun company-shell--prefix (mode-list) + (when (or (null mode-list) + (-contains? mode-list major-mode)) + (company-grab-symbol))) + +(defun company-shell--doc-buffer (arg) + (company-doc-buffer + (let ((man-page (shell-command-to-string (format "man %s" arg)))) + (if (or + (null man-page) + (string= man-page "") + (string-prefix-p "No manual entry" man-page)) + (company-shell--help-page arg) + man-page)))) + +(defun company-shell--help-page (arg) + (when company-shell-use-help-arg + (shell-command-to-string + (format "echo \"timeout 1 %s --help\" | %s --restricted" + arg + (string-trim (shell-command-to-string "which sh")))))) + +(defun company-shell--meta-string (arg) + (-some-> (format "whatis %s" arg) + (shell-command-to-string) + (split-string "\n") + (first) + (split-string " - ") + (second))) + +;;;###autoload +(defun company-shell-rebuild-cache () + "Builds the cache of all completions found on the $PATH and all fish functions." + (interactive) + (company-shell--build-cache) + (company-shell--build-fish-cache)) + +;;;###autoload +(defun company-fish-shell (command &optional arg &rest ignored) + "Company backend for fish shell functions." + (interactive (list 'interactive)) + (cl-case command + (interactive (company-begin-backend 'company-fish-shell)) + (prefix (company-shell--prefix company-fish-shell-modes)) + (sorted t) + (duplicates nil) + (ignore-case nil) + (no-cache nil) + (annotation "Fish Function") + (doc-buffer (company-shell--doc-buffer arg)) + (meta (company-shell--meta-string arg)) + (candidates (cl-remove-if-not + (lambda (candidate) (string-prefix-p arg candidate)) + (company-shell--fetch-fish-candidates))))) + +;;;###autoload +(defun company-shell (command &optional arg &rest ignored) + "Company mode backend for binaries found on the $PATH." + (interactive (list 'interactive)) + (cl-case command + (interactive (company-begin-backend 'company-shell)) + (prefix (company-shell--prefix company-shell-modes)) + (sorted t) + (duplicates nil) + (ignore-case nil) + (no-cache nil) + (annotation (get-text-property 0 'origin arg)) + (doc-buffer (company-shell--doc-buffer arg)) + (meta (company-shell--meta-string arg)) + (candidates (cl-remove-if-not + (lambda (candidate) (string-prefix-p arg candidate)) + (company-shell--fetch-candidates))))) + +(provide 'company-shell) +;;; company-shell.el ends here diff --git a/elpa/epl-20150517.433/epl-autoloads.el b/elpa/epl-20150517.433/epl-autoloads.el new file mode 100644 index 0000000..3831efb --- /dev/null +++ b/elpa/epl-20150517.433/epl-autoloads.el @@ -0,0 +1,15 @@ +;;; epl-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil nil ("epl.el") (22297 53343 513795 651000)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; epl-autoloads.el ends here diff --git a/elpa/epl-20150517.433/epl-pkg.el b/elpa/epl-20150517.433/epl-pkg.el new file mode 100644 index 0000000..f50c375 --- /dev/null +++ b/elpa/epl-20150517.433/epl-pkg.el @@ -0,0 +1 @@ +(define-package "epl" "20150517.433" "Emacs Package Library" '((cl-lib "0.3")) :url "http://github.com/cask/epl" :keywords '("convenience")) diff --git a/elpa/epl-20150517.433/epl.el b/elpa/epl-20150517.433/epl.el new file mode 100644 index 0000000..a06c8dc --- /dev/null +++ b/elpa/epl-20150517.433/epl.el @@ -0,0 +1,695 @@ +;;; epl.el --- Emacs Package Library -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2015 Sebastian Wiesner +;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2015 Free Software + +;; Author: Sebastian Wiesner +;; Maintainer: Johan Andersson +;; Sebastian Wiesner +;; Version: 0.9-cvs +;; Package-Version: 20150517.433 +;; Package-Requires: ((cl-lib "0.3")) +;; Keywords: convenience +;; URL: http://github.com/cask/epl + +;; 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 . + +;;; Commentary: + +;; A package management library for Emacs, based on package.el. + +;; The purpose of this library is to wrap all the quirks and hassle of +;; package.el into a sane API. + +;; The following functions comprise the public interface of this library: + +;;; Package directory selection + +;; `epl-package-dir' gets the directory of packages. + +;; `epl-default-package-dir' gets the default package directory. + +;; `epl-change-package-dir' changes the directory of packages. + +;;; Package system management + +;; `epl-initialize' initializes the package system and activates all +;; packages. + +;; `epl-reset' resets the package system. + +;; `epl-refresh' refreshes all package archives. + +;; `epl-add-archive' adds a new package archive. + +;;; Package objects + +;; Struct `epl-requirement' describes a requirement of a package with `name' and +;; `version' slots. + +;; `epl-requirement-version-string' gets a requirement version as string. + +;; Struct `epl-package' describes an installed or installable package with a +;; `name' and some internal `description'. + +;; `epl-package-version' gets the version of a package. + +;; `epl-package-version-string' gets the version of a package as string. + +;; `epl-package-summary' gets the summary of a package. + +;; `epl-package-requirements' gets the requirements of a package. + +;; `epl-package-directory' gets the installation directory of a package. + +;; `epl-package-from-buffer' creates a package object for the package contained +;; in the current buffer. + +;; `epl-package-from-file' creates a package object for a package file, either +;; plain lisp or tarball. + +;; `epl-package-from-descriptor-file' creates a package object for a package +;; description (i.e. *-pkg.el) file. + +;;; Package database access + +;; `epl-package-installed-p' determines whether a package is installed, either +;; built-in or explicitly installed. + +;; `epl-package-outdated-p' determines whether a package is outdated, that is, +;; whether a package with a higher version number is available. + +;; `epl-built-in-packages', `epl-installed-packages', `epl-outdated-packages' +;; and `epl-available-packages' get all packages built-in, installed, outdated, +;; or available for installation respectively. + +;; `epl-find-built-in-package', `epl-find-installed-packages' and +;; `epl-find-available-packages' find built-in, installed and available packages +;; by name. + +;; `epl-find-upgrades' finds all upgradable packages. + +;; `epl-built-in-p' return true if package is built-in to Emacs. + +;;; Package operations + +;; `epl-install-file' installs a package file. + +;; `epl-package-install' installs a package. + +;; `epl-package-delete' deletes a package. + +;; `epl-upgrade' upgrades packages. + +;;; Code: + +(require 'cl-lib) +(require 'package) + + +(unless (fboundp #'define-error) + ;; `define-error' for 24.3 and earlier, copied from subr.el + (defun define-error (name message &optional parent) + "Define NAME as a new error signal. +MESSAGE is a string that will be output to the echo area if such an error +is signaled without being caught by a `condition-case'. +PARENT is either a signal or a list of signals from which it inherits. +Defaults to `error'." + (unless parent (setq parent 'error)) + (let ((conditions + (if (consp parent) + (apply #'append + (mapcar (lambda (parent) + (cons parent + (or (get parent 'error-conditions) + (error "Unknown signal `%s'" parent)))) + parent)) + (cons parent (get parent 'error-conditions))))) + (put name 'error-conditions + (delete-dups (copy-sequence (cons name conditions)))) + (when message (put name 'error-message message))))) + +(defsubst epl--package-desc-p (package) + "Whether PACKAGE is a `package-desc' object. + +Like `package-desc-p', but return nil, if `package-desc-p' is not +defined as function." + (and (fboundp 'package-desc-p) (package-desc-p package))) + + +;;; EPL errors +(define-error 'epl-error "EPL error") + +(define-error 'epl-invalid-package "Invalid EPL package" 'epl-error) + +(define-error 'epl-invalid-package-file "Invalid EPL package file" + 'epl-invalid-package) + + +;;; Package directory +(defun epl-package-dir () + "Get the directory of packages." + package-user-dir) + +(defun epl-default-package-dir () + "Get the default directory of packages." + (eval (car (get 'package-user-dir 'standard-value)))) + +(defun epl-change-package-dir (directory) + "Change the directory of packages to DIRECTORY." + (setq package-user-dir directory) + (epl-initialize)) + + +;;; Package system management +(defvar epl--load-path-before-initialize nil + "Remember the load path for `epl-reset'.") + +(defun epl-initialize (&optional no-activate) + "Load Emacs Lisp packages and activate them. + +With NO-ACTIVATE non-nil, do not activate packages." + (setq epl--load-path-before-initialize load-path) + (package-initialize no-activate)) + +(defalias 'epl-refresh 'package-refresh-contents) + +(defun epl-add-archive (name url) + "Add a package archive with NAME and URL." + (add-to-list 'package-archives (cons name url))) + +(defun epl-reset () + "Reset the package system. + +Clear the list of installed and available packages, the list of +package archives and reset the package directory." + (setq package-alist nil + package-archives nil + package-archive-contents nil + load-path epl--load-path-before-initialize) + (when (boundp 'package-obsolete-alist) ; Legacy package.el + (setq package-obsolete-alist nil)) + (epl-change-package-dir (epl-default-package-dir))) + + +;;; Package structures +(cl-defstruct (epl-requirement + (:constructor epl-requirement-create)) + "Structure describing a requirement. + +Slots: + +`name' The name of the required package, as symbol. + +`version' The version of the required package, as version list." + name + version) + +(defun epl-requirement-version-string (requirement) + "The version of a REQUIREMENT, as string." + (package-version-join (epl-requirement-version requirement))) + +(cl-defstruct (epl-package (:constructor epl-package-create)) + "Structure representing a package. + +Slots: + +`name' The package name, as symbol. + +`description' The package description. + +The format package description varies between package.el +variants. For `package-desc' variants, it is simply the +corresponding `package-desc' object. For legacy variants, it is +a vector `[VERSION REQS DOCSTRING]'. + +Do not access `description' directly, but instead use the +`epl-package' accessors." + name + description) + +(defmacro epl-package-as-description (var &rest body) + "Cast VAR to a package description in BODY. + +VAR is a symbol, bound to an `epl-package' object. This macro +casts this object to the `description' object, and binds the +description to VAR in BODY." + (declare (indent 1)) + (unless (symbolp var) + (signal 'wrong-type-argument (list #'symbolp var))) + `(if (epl-package-p ,var) + (let ((,var (epl-package-description ,var))) + ,@body) + (signal 'wrong-type-argument (list #'epl-package-p ,var)))) + +(defsubst epl-package--package-desc-p (package) + "Whether the description of PACKAGE is a `package-desc'." + (epl--package-desc-p (epl-package-description package))) + +(defun epl-package-version (package) + "Get the version of PACKAGE, as version list." + (epl-package-as-description package + (cond + ((fboundp 'package-desc-version) (package-desc-version package)) + ;; Legacy + ((fboundp 'package-desc-vers) + (let ((version (package-desc-vers package))) + (if (listp version) version (version-to-list version)))) + (:else (error "Cannot get version from %S" package))))) + +(defun epl-package-version-string (package) + "Get the version from a PACKAGE, as string." + (package-version-join (epl-package-version package))) + +(defun epl-package-summary (package) + "Get the summary of PACKAGE, as string." + (epl-package-as-description package + (cond + ((fboundp 'package-desc-summary) (package-desc-summary package)) + ((fboundp 'package-desc-doc) (package-desc-doc package)) ; Legacy + (:else (error "Cannot get summary from %S" package))))) + +(defsubst epl-requirement--from-req (req) + "Create a `epl-requirement' from a `package-desc' REQ." + (let ((version (cadr req))) + (epl-requirement-create :name (car req) + :version (if (listp version) version + (version-to-list version))))) + +(defun epl-package-requirements (package) + "Get the requirements of PACKAGE. + +The requirements are a list of `epl-requirement' objects." + (epl-package-as-description package + (mapcar #'epl-requirement--from-req (package-desc-reqs package)))) + +(defun epl-package-directory (package) + "Get the directory PACKAGE is installed to. + +Return the absolute path of the installation directory of +PACKAGE, or nil, if PACKAGE is not installed." + (cond + ((fboundp 'package-desc-dir) + (package-desc-dir (epl-package-description package))) + ((fboundp 'package--dir) + (package--dir (symbol-name (epl-package-name package)) + (epl-package-version-string package))) + (:else (error "Cannot get package directory from %S" package)))) + +(defun epl-package-->= (pkg1 pkg2) + "Determine whether PKG1 is before PKG2 by version." + (not (version-list-< (epl-package-version pkg1) + (epl-package-version pkg2)))) + +(defun epl-package--from-package-desc (package-desc) + "Create an `epl-package' from a PACKAGE-DESC. + +PACKAGE-DESC is a `package-desc' object, from recent package.el +variants." + (if (and (fboundp 'package-desc-name) + (epl--package-desc-p package-desc)) + (epl-package-create :name (package-desc-name package-desc) + :description package-desc) + (signal 'wrong-type-argument (list 'epl--package-desc-p package-desc)))) + +(defun epl-package--parse-info (info) + "Parse a package.el INFO." + (if (epl--package-desc-p info) + (epl-package--from-package-desc info) + ;; For legacy package.el, info is a vector [NAME REQUIRES DESCRIPTION + ;; VERSION COMMENTARY]. We need to re-shape this vector into the + ;; `package-alist' format [VERSION REQUIRES DESCRIPTION] to attach it to the + ;; new `epl-package'. + (let ((name (intern (aref info 0))) + (info (vector (aref info 3) (aref info 1) (aref info 2)))) + (epl-package-create :name name :description info)))) + +(defun epl-package-from-buffer (&optional buffer) + "Create an `epl-package' object from BUFFER. + +BUFFER defaults to the current buffer. + +Signal `epl-invalid-package' if the buffer does not contain a +valid package file." + (let ((info (with-current-buffer (or buffer (current-buffer)) + (condition-case err + (package-buffer-info) + (error (signal 'epl-invalid-package (cdr err))))))) + (epl-package--parse-info info))) + +(defun epl-package-from-lisp-file (file-name) + "Parse the package headers the file at FILE-NAME. + +Return an `epl-package' object with the header metadata." + (with-temp-buffer + (insert-file-contents file-name) + (condition-case err + (epl-package-from-buffer (current-buffer)) + ;; Attach file names to invalid package errors + (epl-invalid-package + (signal 'epl-invalid-package-file (cons file-name (cdr err)))) + ;; Forward other errors + (error (signal (car err) (cdr err)))))) + +(defun epl-package-from-tar-file (file-name) + "Parse the package tarball at FILE-NAME. + +Return a `epl-package' object with the meta data of the tarball +package in FILE-NAME." + (condition-case nil + ;; In legacy package.el, `package-tar-file-info' takes the name of the tar + ;; file to parse as argument. In modern package.el, it has no arguments + ;; and works on the current buffer. Hence, we just try to call the legacy + ;; version, and if that fails because of a mismatch between formal and + ;; actual arguments, we use the modern approach. To avoid spurious + ;; signature warnings by the byte compiler, we suppress warnings when + ;; calling the function. + (epl-package--parse-info (with-no-warnings + (package-tar-file-info file-name))) + (wrong-number-of-arguments + (with-temp-buffer + (insert-file-contents-literally file-name) + ;; Switch to `tar-mode' to enable extraction of the file. Modern + ;; `package-tar-file-info' relies on `tar-mode', and signals an error if + ;; called in a buffer with a different mode. + (tar-mode) + (epl-package--parse-info (with-no-warnings + (package-tar-file-info))))))) + +(defun epl-package-from-file (file-name) + "Parse the package at FILE-NAME. + +Return an `epl-package' object with the meta data of the package +at FILE-NAME." + (if (string-match-p (rx ".tar" string-end) file-name) + (epl-package-from-tar-file file-name) + (epl-package-from-lisp-file file-name))) + +(defun epl-package--parse-descriptor-requirement (requirement) + "Parse a REQUIREMENT in a package descriptor." + ;; This function is only called on legacy package.el. On package-desc + ;; package.el, we just let package.el do the work. + (cl-destructuring-bind (name version-string) requirement + (list name (version-to-list version-string)))) + +(defun epl-package-from-descriptor-file (descriptor-file) + "Load a `epl-package' from a package DESCRIPTOR-FILE. + +A package descriptor is a file defining a new package. Its name +typically ends with -pkg.el." + (with-temp-buffer + (insert-file-contents descriptor-file) + (goto-char (point-min)) + (let ((sexp (read (current-buffer)))) + (unless (eq (car sexp) 'define-package) + (error "%S is no valid package descriptor" descriptor-file)) + (if (and (fboundp 'package-desc-from-define) + (fboundp 'package-desc-name)) + ;; In Emacs snapshot, we can conveniently call a function to parse the + ;; descriptor + (let ((desc (apply #'package-desc-from-define (cdr sexp)))) + (epl-package-create :name (package-desc-name desc) + :description desc)) + ;; In legacy package.el, we must manually deconstruct the descriptor, + ;; because the load function has eval's the descriptor and has a lot of + ;; global side-effects. + (cl-destructuring-bind + (name version-string summary requirements) (cdr sexp) + (epl-package-create + :name (intern name) + :description + (vector (version-to-list version-string) + (mapcar #'epl-package--parse-descriptor-requirement + ;; Strip the leading `quote' from the package list + (cadr requirements)) + summary))))))) + + +;;; Package database access +(defun epl-package-installed-p (package) + "Determine whether a PACKAGE is installed. + +PACKAGE is either a package name as symbol, or a package object." + (let ((name (if (epl-package-p package) + (epl-package-name package) + package)) + (version (when (epl-package-p package) + (epl-package-version package)))) + (package-installed-p name version))) + +(defun epl--parse-built-in-entry (entry) + "Parse an ENTRY from the list of built-in packages. + +Return the corresponding `epl-package' object." + (if (fboundp 'package--from-builtin) + ;; In package-desc package.el, convert the built-in package to a + ;; `package-desc' and convert that to an `epl-package' + (epl-package--from-package-desc (package--from-builtin entry)) + (epl-package-create :name (car entry) :description (cdr entry)))) + +(defun epl-built-in-packages () + "Get all built-in packages. + +Return a list of `epl-package' objects." + ;; This looks mighty strange, but it's the only way to force package.el to + ;; build the list of built-in packages. Without this, `package--builtins' + ;; might be empty. + (package-built-in-p 'foo) + (mapcar #'epl--parse-built-in-entry package--builtins)) + +(defun epl-find-built-in-package (name) + "Find a built-in package with NAME. + +NAME is a package name, as symbol. + +Return the built-in package as `epl-package' object, or nil if +there is no built-in package with NAME." + (when (package-built-in-p name) + ;; We must call `package-built-in-p' *before* inspecting + ;; `package--builtins', because otherwise `package--builtins' might be + ;; empty. + (epl--parse-built-in-entry (assq name package--builtins)))) + +(defun epl-package-outdated-p (package) + "Determine whether a PACKAGE is outdated. + +A package is outdated, if there is an available package with a +higher version. + +PACKAGE is either a package name as symbol, or a package object. +In the former case, test the installed or built-in package with +the highest version number, in the later case, test the package +object itself. + +Return t, if the package is outdated, or nil otherwise." + (let* ((package (if (epl-package-p package) + package + (or (car (epl-find-installed-packages package)) + (epl-find-built-in-package package)))) + (available (car (epl-find-available-packages + (epl-package-name package))))) + (and package available (version-list-< (epl-package-version package) + (epl-package-version available))))) + +(defun epl--parse-package-list-entry (entry) + "Parse a list of packages from ENTRY. + +ENTRY is a single entry in a package list, e.g. `package-alist', +`package-archive-contents', etc. Typically it is a cons cell, +but the exact format varies between package.el versions. This +function tries to parse all known variants. + +Return a list of `epl-package' objects parsed from ENTRY." + (let ((descriptions (cdr entry))) + (cond + ((listp descriptions) + (sort (mapcar #'epl-package--from-package-desc descriptions) + #'epl-package-->=)) + ;; Legacy package.el has just a single package in an entry, which is a + ;; standard description vector + ((vectorp descriptions) + (list (epl-package-create :name (car entry) + :description descriptions))) + (:else (error "Cannot parse entry %S" entry))))) + +(defun epl-installed-packages () + "Get all installed packages. + +Return a list of package objects." + (apply #'append (mapcar #'epl--parse-package-list-entry package-alist))) + +(defsubst epl--filter-outdated-packages (packages) + "Filter outdated packages from PACKAGES." + (let (res) + (dolist (package packages) + (when (epl-package-outdated-p package) + (push package res))) + (nreverse res))) + +(defun epl-outdated-packages () + "Get all outdated packages, as in `epl-package-outdated-p'. + +Return a list of package objects." + (epl--filter-outdated-packages (epl-installed-packages))) + +(defsubst epl--find-package-in-list (name list) + "Find a package by NAME in a package LIST. + +Return a list of corresponding `epl-package' objects." + (let ((entry (assq name list))) + (when entry + (epl--parse-package-list-entry entry)))) + +(defun epl-find-installed-package (name) + "Find the latest installed package by NAME. + +NAME is a package name, as symbol. + +Return the installed package with the highest version number as +`epl-package' object, or nil, if no package with NAME is +installed." + (car (epl-find-installed-packages name))) +(make-obsolete 'epl-find-installed-package 'epl-find-installed-packages "0.7") + +(defun epl-find-installed-packages (name) + "Find all installed packages by NAME. + +NAME is a package name, as symbol. + +Return a list of all installed packages with NAME, sorted by +version number in descending order. Return nil, if there are no +packages with NAME." + (epl--find-package-in-list name package-alist)) + +(defun epl-available-packages () + "Get all packages available for installation. + +Return a list of package objects." + (apply #'append (mapcar #'epl--parse-package-list-entry + package-archive-contents))) + +(defun epl-find-available-packages (name) + "Find available packages for NAME. + +NAME is a package name, as symbol. + +Return a list of available packages for NAME, sorted by version +number in descending order. Return nil, if there are no packages +for NAME." + (epl--find-package-in-list name package-archive-contents)) + +(cl-defstruct (epl-upgrade + (:constructor epl-upgrade-create)) + "Structure describing an upgradable package. +Slots: + +`installed' The installed package + +`available' The package available for installation." + installed + available) + +(defun epl-find-upgrades (&optional packages) + "Find all upgradable PACKAGES. + +PACKAGES is a list of package objects to upgrade, defaulting to +all installed packages. + +Return a list of `epl-upgrade' objects describing all upgradable +packages." + (let ((packages (or packages (epl-installed-packages))) + upgrades) + (dolist (pkg packages) + (let* ((version (epl-package-version pkg)) + (name (epl-package-name pkg)) + ;; Find the latest available package for NAME + (available-pkg (car (epl-find-available-packages name))) + (available-version (when available-pkg + (epl-package-version available-pkg)))) + (when (and available-version (version-list-< version available-version)) + (push (epl-upgrade-create :installed pkg + :available available-pkg) + upgrades)))) + (nreverse upgrades))) + +(defalias 'epl-built-in-p 'package-built-in-p) + + +;;; Package operations + +(defalias 'epl-install-file 'package-install-file) + +(defun epl-package-install (package &optional force) + "Install a PACKAGE. + +PACKAGE is a `epl-package' object. If FORCE is given and +non-nil, install PACKAGE, even if it is already installed." + (when (or force (not (epl-package-installed-p package))) + (if (epl-package--package-desc-p package) + (package-install (epl-package-description package)) + ;; The legacy API installs by name. We have no control over versioning, + ;; etc. + (package-install (epl-package-name package))))) + +(defun epl-package-delete (package) + "Delete a PACKAGE. + +PACKAGE is a `epl-package' object to delete." + ;; package-delete allows for packages being trashed instead of fully deleted. + ;; Let's prevent his silly behavior + (let ((delete-by-moving-to-trash nil)) + ;; The byte compiler will warn us that we are calling `package-delete' with + ;; the wrong number of arguments, since it can't infer that we guarantee to + ;; always call the correct version. Thus we suppress all warnings when + ;; calling `package-delete'. I wish there was a more granular way to + ;; disable just that specific warning, but it is what it is. + (if (epl-package--package-desc-p package) + (with-no-warnings + (package-delete (epl-package-description package))) + ;; The legacy API deletes by name (as string!) and version instead by + ;; descriptor. Hence `package-delete' takes two arguments. For some + ;; insane reason, the arguments are strings here! + (let ((name (symbol-name (epl-package-name package))) + (version (epl-package-version-string package))) + (with-no-warnings + (package-delete name version)) + ;; Legacy package.el does not remove the deleted package + ;; from the `package-alist', so we do it manually here. + (let ((pkg (assq (epl-package-name package) package-alist))) + (when pkg + (setq package-alist (delq pkg package-alist)))))))) + +(defun epl-upgrade (&optional packages preserve-obsolete) + "Upgrade PACKAGES. + +PACKAGES is a list of package objects to upgrade, defaulting to +all installed packages. + +The old versions of the updated packages are deleted, unless +PRESERVE-OBSOLETE is non-nil. + +Return a list of all performed upgrades, as a list of +`epl-upgrade' objects." + (let ((upgrades (epl-find-upgrades packages))) + (dolist (upgrade upgrades) + (epl-package-install (epl-upgrade-available upgrade) 'force) + (unless preserve-obsolete + (epl-package-delete (epl-upgrade-installed upgrade)))) + upgrades)) + +(provide 'epl) + +;;; epl.el ends here diff --git a/elpa/helm-ag-20160411.417/helm-ag-autoloads.el b/elpa/helm-ag-20160411.417/helm-ag-autoloads.el new file mode 100644 index 0000000..ad8bd00 --- /dev/null +++ b/elpa/helm-ag-20160411.417/helm-ag-autoloads.el @@ -0,0 +1,75 @@ +;;; helm-ag-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "helm-ag" "helm-ag.el" (22297 53346 754924 +;;;;;; 211000)) +;;; Generated autoloads from helm-ag.el + +(autoload 'helm-ag-pop-stack "helm-ag" "\ + + +\(fn)" t nil) + +(autoload 'helm-ag-clear-stack "helm-ag" "\ + + +\(fn)" t nil) + +(autoload 'helm-ag-mode "helm-ag" "\ +Major mode to provide actions in helm grep saved buffer. + +Special commands: +\\{helm-ag-mode-map} + +\(fn)" t nil) + +(autoload 'helm-ag-this-file "helm-ag" "\ + + +\(fn)" t nil) + +(autoload 'helm-ag "helm-ag" "\ + + +\(fn &optional BASEDIR)" t nil) + +(autoload 'helm-do-ag-this-file "helm-ag" "\ + + +\(fn)" t nil) + +(autoload 'helm-do-ag "helm-ag" "\ + + +\(fn &optional BASEDIR TARGETS)" t nil) + +(autoload 'helm-ag-project-root "helm-ag" "\ + + +\(fn)" t nil) + +(autoload 'helm-do-ag-project-root "helm-ag" "\ + + +\(fn)" t nil) + +(autoload 'helm-ag-buffers "helm-ag" "\ + + +\(fn)" t nil) + +(autoload 'helm-do-ag-buffers "helm-ag" "\ + + +\(fn)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; helm-ag-autoloads.el ends here diff --git a/elpa/helm-ag-20160411.417/helm-ag-pkg.el b/elpa/helm-ag-20160411.417/helm-ag-pkg.el new file mode 100644 index 0000000..2db8163 --- /dev/null +++ b/elpa/helm-ag-20160411.417/helm-ag-pkg.el @@ -0,0 +1 @@ +(define-package "helm-ag" "20160411.417" "the silver searcher with helm interface" '((emacs "24.3") (helm "1.7.7")) :url "https://github.com/syohex/emacs-helm-ag") diff --git a/elpa/helm-ag-20160411.417/helm-ag.el b/elpa/helm-ag-20160411.417/helm-ag.el new file mode 100644 index 0000000..b1067c2 --- /dev/null +++ b/elpa/helm-ag-20160411.417/helm-ag.el @@ -0,0 +1,1113 @@ +;;; helm-ag.el --- the silver searcher with helm interface -*- lexical-binding: t; -*- + +;; Copyright (C) 2016 by Syohei YOSHIDA + +;; Author: Syohei YOSHIDA +;; URL: https://github.com/syohex/emacs-helm-ag +;; Package-Version: 20160411.417 +;; Version: 0.53 +;; Package-Requires: ((emacs "24.3") (helm "1.7.7")) + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; helm-ag provides interfaces of the silver searcher(Other search programs can be used +;; such as the platinum searcher, ack). And helm-ag provides wgrep like features which +;; users can edit from searched result. + +;;; Code: + +(eval-when-compile + (require 'grep) + (defvar helm-help-message)) + +(require 'cl-lib) +(require 'helm) +(require 'helm-grep) +(require 'helm-utils) +(require 'compile) + +(declare-function helm-read-file-name "helm-mode") +(declare-function helm-grep-get-file-extensions "helm-grep") +(declare-function helm-help "helm-help") + +(defgroup helm-ag nil + "the silver searcher with helm interface" + :group 'helm) + +(defsubst helm-ag--windows-p () + (memq system-type '(ms-dos windows-nt))) + +(defcustom helm-ag-base-command + (if (helm-ag--windows-p) + "ag --vimgrep" + "ag --nocolor --nogroup") + "Base command of `ag'" + :type 'string) + +(defcustom helm-ag-command-option nil + "Command line option of `ag'. This is appended after `helm-ag-base-command'" + :type 'string) + +(defcustom helm-ag-insert-at-point nil + "Insert thing at point as search pattern. + You can set value same as `thing-at-point'" + :type 'symbol) + +(defcustom helm-ag-ignore-patterns nil + "Ignore patterns for `ag'. This parameters are specified as --ignore" + :type '(repeat string)) + +(defcustom helm-ag-use-grep-ignore-list nil + "Use `grep-find-ignored-files' and `grep-find-ignored-directories' as ignore pattern. +They are specified to `--ignore' options." + :type 'boolean) + +(defcustom helm-ag-always-set-extra-option nil + "Always set `ag' options of `helm-do-ag'." + :type 'boolean) + +(defcustom helm-ag-fuzzy-match nil + "Enable fuzzy match" + :type 'boolean) + +(defcustom helm-ag-edit-save t + "Save buffers you edit at completed." + :type 'boolean) + +(defcustom helm-ag-use-emacs-lisp-regexp nil + "[Experimental] Use Emacs Lisp regexp instead of PCRE." + :type 'boolean) + +(defcustom helm-ag-use-agignore nil + "Use .agignore where is at project root if it exists." + :type 'boolean) + +(defcustom helm-ag-use-temp-buffer nil + "Use temporary buffer for persistent action." + :type 'boolean) + +(defcustom helm-ag-show-status-function 'helm-ag-show-status-default-mode-line + "Function called after that `ag' process is finished after `helm-do-ag'. +Default behaviour shows finish and result in mode-line." + :type 'function) + +(defface helm-ag-edit-deleted-line + '((t (:inherit font-lock-comment-face :strike-through t))) + "Face of deleted line in edit mode.") + +(defvar helm-ag--command-history '()) +(defvar helm-ag--context-stack nil) +(defvar helm-ag--default-directory nil) +(defvar helm-ag--last-default-directory nil) +(defvar helm-ag--last-query nil) +(defvar helm-ag--last-command nil) +(defvar helm-ag--elisp-regexp-query nil) +(defvar helm-ag--valid-regexp-for-emacs nil) +(defvar helm-ag--extra-options nil) +(defvar helm-ag--extra-options-history nil) +(defvar helm-ag--original-window nil) +(defvar helm-ag--search-this-file-p nil) +(defvar helm-ag--default-target nil) +(defvar helm-ag--buffer-search nil) +(defvar helm-ag--command-feature nil) +(defvar helm-ag--ignore-case nil) +(defvar helm-do-ag--extensions nil) +(defvar helm-do-ag--commands nil) + +(defun helm-ag--ignore-case-p (cmds input) + (cl-loop for cmd in cmds + when (member cmd '("-i" "--ignore-case")) + return t + + when (member cmd '("-s" "--case-sensitive")) + return nil + + finally + return (let ((case-fold-search nil)) + (not (string-match-p "[A-Z]" input))))) + +(defun helm-ag--save-current-context () + (let ((curpoint (with-helm-current-buffer + (point)))) + (helm-aif (buffer-file-name helm-current-buffer) + (push (list :file it :point curpoint) helm-ag--context-stack) + (push (list :buffer helm-current-buffer :point curpoint) helm-ag--context-stack)))) + +(defsubst helm-ag--insert-thing-at-point (thing) + (helm-aif (thing-at-point thing) + (substring-no-properties it) + "")) + +(defun helm-ag--searched-word () + (if helm-ag-insert-at-point + (helm-ag--insert-thing-at-point helm-ag-insert-at-point) + "")) + +(defun helm-ag--construct-ignore-option (pattern) + (concat "--ignore=" pattern)) + +(defun helm-ag--grep-ignore-list-to-options () + (require 'grep) + (cl-loop for ignore in (append grep-find-ignored-files + grep-find-ignored-directories) + collect (helm-ag--construct-ignore-option ignore))) + +(defun helm-ag--parse-options-and-query (input) + (with-temp-buffer + (insert input) + (let (end options) + (goto-char (point-min)) + (when (re-search-forward "\\s-*--\\s-+" nil t) + (setq end (match-end 0))) + (goto-char (point-min)) + (while (re-search-forward "\\(?:^\\|\\s-+\\)\\(-\\S-+\\)\\(?:\\s-+\\|$\\)" end t) + (push (match-string-no-properties 1) options) + (when end + (cl-decf end (- (match-end 0) (match-beginning 0)))) + (replace-match "")) + (cons options (buffer-string))))) + +(defun helm-ag--parse-query (input) + (let* ((parsed (helm-ag--parse-options-and-query input)) + (options (car parsed)) + (query (cdr parsed))) + (when helm-ag-use-emacs-lisp-regexp + (setq query (helm-ag--elisp-regexp-to-pcre query))) + (setq helm-ag--last-query query + helm-ag--elisp-regexp-query (helm-ag--pcre-to-elisp-regexp query)) + (setq helm-ag--valid-regexp-for-emacs + (helm-ag--validate-regexp helm-ag--elisp-regexp-query)) + (if (not options) + (list query) + (nconc (nreverse options) (list query))))) + +(defsubst helm-ag--file-visited-buffers () + (cl-loop for buf in (buffer-list) + when (buffer-file-name buf) + collect it)) + +(defun helm-ag--construct-targets (targets) + (let ((default-directory helm-ag--default-directory)) + (cl-loop for target in targets + collect (file-relative-name target)))) + +(defun helm-ag--root-agignore () + (let ((root (helm-ag--project-root))) + (when root + (let ((default-directory root)) + (when (file-exists-p ".agignore") + (expand-file-name (concat default-directory ".agignore"))))))) + +(defun helm-ag--construct-command (this-file) + (let* ((commands (split-string helm-ag-base-command nil t)) + (command (car commands)) + (args (cdr commands))) + (when helm-ag-command-option + (let ((ag-options (split-string helm-ag-command-option nil t))) + (setq args (append args ag-options)))) + (when helm-ag-use-agignore + (helm-aif (helm-ag--root-agignore) + (setq args (append args (list "-p" it))))) + (when helm-ag-ignore-patterns + (setq args (append args (mapcar 'helm-ag--construct-ignore-option + helm-ag-ignore-patterns)))) + (when helm-ag-use-grep-ignore-list + (setq args (append args (helm-ag--grep-ignore-list-to-options)))) + (setq args (append args (helm-ag--parse-query helm-ag--last-query))) + (when this-file + (setq args (append args (list this-file)))) + (when helm-ag--buffer-search + (setq args (append args (helm-ag--file-visited-buffers)))) + (when helm-ag--default-target + (setq args (append args (helm-ag--construct-targets helm-ag--default-target)))) + (cons command args))) + +(defun helm-ag--remove-carrige-returns () + (when (helm-ag--windows-p) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\xd" nil t) + (replace-match ""))))) + +(defun helm-ag--init () + (let ((buf-coding buffer-file-coding-system)) + (helm-attrset 'recenter t) + (with-current-buffer (helm-candidate-buffer 'global) + (let* ((default-directory (or helm-ag--default-directory + default-directory)) + (cmds (helm-ag--construct-command (helm-attr 'search-this-file))) + (coding-system-for-read buf-coding) + (coding-system-for-write buf-coding)) + (setq helm-ag--ignore-case (helm-ag--ignore-case-p cmds helm-ag--last-query) + helm-ag--last-command cmds) + (let ((ret (apply #'process-file (car cmds) nil t nil (cdr cmds)))) + (if (zerop (length (buffer-string))) + (error "No ag output: '%s'" helm-ag--last-query) + (unless (zerop ret) + (unless (executable-find (car cmds)) + (error "'ag' is not installed.")) + (error "Failed: '%s'" helm-ag--last-query)))) + (helm-ag--remove-carrige-returns) + (helm-ag--save-current-context))))) + +(add-to-list 'debug-ignored-errors "^No ag output: ") + +(defun helm-ag--search-only-one-file-p () + (when (and helm-ag--default-target (= (length helm-ag--default-target) 1)) + (let ((target (car helm-ag--default-target))) + (unless (file-directory-p target) + target)))) + +(defun helm-ag--find-file-action (candidate find-func this-file &optional persistent) + (when helm-ag--command-feature + ;; 'pt' always show filename if matched file is only one. + (setq this-file nil)) + (let* ((file-line (helm-grep-split-line candidate)) + (filename (or this-file (cl-first file-line))) + (line (if this-file + (cl-first (split-string candidate ":")) + (cl-second file-line))) + (default-directory (or helm-ag--default-directory + helm-ag--last-default-directory + default-directory))) + (unless persistent + (setq helm-ag--last-default-directory default-directory)) + (funcall find-func filename) + (goto-char (point-min)) + (when line + (forward-line (1- (string-to-number line)))))) + +(defun helm-ag--open-file-with-temp-buffer (filename) + (switch-to-buffer (get-buffer-create " *helm-ag persistent*")) + (fundamental-mode) + (erase-buffer) + (insert-file-contents filename) + (let ((buffer-file-name filename)) + (set-auto-mode) + (font-lock-fontify-region (point-min) (point-max)))) + +(defsubst helm-ag--vimgrep-option () + (member "--vimgrep" helm-ag--last-command)) + +(defun helm-ag--search-this-file-p () + (unless (helm-ag--vimgrep-option) + (if (eq (helm-get-current-source) 'helm-source-do-ag) + (helm-ag--search-only-one-file-p) + (helm-attr 'search-this-file)))) + +(defun helm-ag--persistent-action (candidate) + (let ((find-func (if helm-ag-use-temp-buffer + #'helm-ag--open-file-with-temp-buffer + #'find-file))) + (helm-ag--find-file-action candidate find-func (helm-ag--search-this-file-p) t) + (helm-highlight-current-line))) + +(defun helm-ag--validate-regexp (regexp) + (condition-case nil + (progn + (string-match-p regexp "") + t) + (invalid-regexp nil))) + +(defun helm-ag--pcre-to-elisp-regexp (pcre) + ;; This is very simple conversion + (with-temp-buffer + (insert pcre) + (goto-char (point-min)) + ;; convert (, ), {, }, | + (while (re-search-forward "[(){}|]" nil t) + (backward-char 1) + (cond ((looking-back "\\\\\\\\" nil)) + ((looking-back "\\\\" nil) + (delete-char -1)) + (t + (insert "\\"))) + (forward-char 1)) + ;; convert \s and \S -> \s- \S- + (goto-char (point-min)) + (while (re-search-forward "\\(\\\\s\\)" nil t) + (unless (looking-back "\\\\\\\\s" nil) + (insert "-"))) + (buffer-string))) + +(defun helm-ag--elisp-regexp-to-pcre (regexp) + (with-temp-buffer + (insert regexp) + (goto-char (point-min)) + (while (re-search-forward "[(){}|]" nil t) + (backward-char 1) + (cond ((looking-back "\\\\\\\\" nil)) + ((looking-back "\\\\" nil) + (delete-char -1)) + (t + (insert "\\"))) + (forward-char 1)) + (buffer-string))) + +(defun helm-ag--highlight-candidate (candidate) + (let ((limit (1- (length candidate))) + (last-pos 0) + (case-fold-search helm-ag--ignore-case)) + (when helm-ag--valid-regexp-for-emacs + (while (and (< last-pos limit) + (string-match helm-ag--elisp-regexp-query candidate last-pos)) + (let ((start (match-beginning 0)) + (end (match-end 0))) + (if (= start end) + (cl-incf last-pos) + (put-text-property start end 'face 'helm-match candidate) + (setq last-pos (1+ (match-end 0))))))) + candidate)) + +(defun helm-ag--candidate-transform-for-this-file (candidate) + (when (string-match "\\`\\([^:]+\\):\\(.*\\)" candidate) + (format "%s:%s" + (propertize (match-string 1 candidate) 'face 'helm-grep-lineno) + (helm-ag--highlight-candidate (match-string 2 candidate))))) + +(defun helm-ag--candidate-transform-for-files (candidate) + (helm-aif (helm-grep-split-line candidate) + (format "%s:%s:%s" + (propertize (cl-first it) 'face 'helm-moccur-buffer) + (propertize (cl-second it) 'face 'helm-grep-lineno) + (helm-ag--highlight-candidate (cl-third it))))) + +(defun helm-ag--candidate-transformer (candidate) + (or (if (helm-attr 'search-this-file) + (helm-ag--candidate-transform-for-this-file candidate) + (helm-ag--candidate-transform-for-files candidate)) + candidate)) + +(defun helm-ag--action-find-file (candidate) + (helm-ag--find-file-action candidate 'find-file (helm-ag--search-this-file-p))) + +(defun helm-ag--action-find-file-other-window (candidate) + (helm-ag--find-file-action candidate 'find-file-other-window (helm-ag--search-this-file-p))) + +(defvar helm-ag--actions + (helm-make-actions + "Open file" #'helm-ag--action-find-file + "Open file other window" #'helm-ag--action-find-file-other-window + "Save results in buffer" #'helm-ag--action-save-buffer)) + +(defvar helm-ag-source + (helm-build-in-buffer-source "The Silver Searcher" + :init 'helm-ag--init + :real-to-display 'helm-ag--candidate-transformer + :persistent-action 'helm-ag--persistent-action + :fuzzy-match helm-ag-fuzzy-match + :action helm-ag--actions + :candidate-number-limit 9999 + :follow (and helm-follow-mode-persistent 1))) + +;;;###autoload +(defun helm-ag-pop-stack () + (interactive) + (let ((context (pop helm-ag--context-stack))) + (unless context + (error "Context stack is empty !")) + (helm-aif (plist-get context :file) + (find-file it) + (let ((buf (plist-get context :buffer))) + (if (buffer-live-p buf) + (switch-to-buffer buf) + (error "The buffer is already killed.")))) + (goto-char (plist-get context :point)))) + +;;;###autoload +(defun helm-ag-clear-stack () + (interactive) + (setq helm-ag--context-stack nil)) + +(defsubst helm-ag--marked-input () + (when (use-region-p) + (buffer-substring-no-properties (region-beginning) (region-end)))) + +(defun helm-ag--query () + (let* ((searched-word (helm-ag--searched-word)) + (marked-word (helm-ag--marked-input)) + (query (read-string "Pattern: " (or marked-word searched-word) 'helm-ag--command-history))) + (when (string= query "") + (error "Input is empty!!")) + (setq helm-ag--last-query query))) + +(defsubst helm-ag--init-state () + (setq helm-ag--original-window (selected-window) + helm-ag--last-default-directory nil)) + +(defun helm-ag--get-default-directory () + (let ((prefix-val (and current-prefix-arg (abs (prefix-numeric-value current-prefix-arg))))) + (cond ((not prefix-val) default-directory) + ((= prefix-val 4) + (file-name-as-directory + (read-directory-name "Search directory: " nil nil t))) + ((= prefix-val 16) + (let ((dirs (list (read-directory-name "Search directory: " nil nil t)))) + (while (y-or-n-p "More directories ?") + (push (read-directory-name "Search directory: " nil nil t) dirs)) + (reverse dirs)))))) + +(defsubst helm-ag--helm-header (dir) + (if helm-ag--buffer-search + "Search Buffers" + (concat "Search at " (abbreviate-file-name dir)))) + +(defun helm-ag--run-other-window-action () + (interactive) + (with-helm-alive-p + (helm-exit-and-execute-action #'helm-ag--action-find-file-other-window))) + +(defun helm-ag--exit-from-edit-mode () + (when (window-live-p helm-ag--original-window) + (select-window helm-ag--original-window)) + (kill-buffer (get-buffer "*helm-ag-edit*"))) + +(defun helm-ag--match-line-regexp () + ;; $1: file name + ;; $2: line + ;; $3: match body + ;; $4: file attributes part(filename, line, column) + (cond ((helm-ag--vimgrep-option) + "^\\(?4:\\(?1:[^:]+\\):\\(?2:[1-9][0-9]*\\):[^:]+:\\)\\(?3:.*\\)$") + (helm-ag--search-this-file-p + "^\\(?4:\\(?2:[1-9][0-9]*\\)[:-]\\)\\(?3:.*\\)$") + (t + "^\\(?4:\\(?1:[^:]+\\):\\(?2:[1-9][0-9]*\\)[:-]\\)\\(?3:.*\\)$"))) + +(defun helm-ag--edit-commit () + (interactive) + (goto-char (point-min)) + (let ((read-only-files 0) + (saved-buffers nil) + (regexp (helm-ag--match-line-regexp)) + (default-directory helm-ag--default-directory) + (line-deletes (make-hash-table :test #'equal))) + (while (re-search-forward regexp nil t) + (let* ((file (or (match-string-no-properties 1) helm-ag--search-this-file-p)) + (line (string-to-number (match-string-no-properties 2))) + (body (match-string-no-properties 3)) + (ovs (overlays-at (line-beginning-position)))) + (with-current-buffer (find-file-noselect file) + (if buffer-read-only + (cl-incf read-only-files) + (goto-char (point-min)) + (let ((deleted-lines (gethash file line-deletes 0)) + (deleted (and ovs (overlay-get (car ovs) 'helm-ag-deleted)))) + (forward-line (- line 1 deleted-lines)) + (delete-region (line-beginning-position) (line-end-position)) + (if (not deleted) + (insert body) + (let ((beg (point))) + (forward-line 1) + (delete-region beg (point)) + (puthash file (1+ deleted-lines) line-deletes))) + (cl-pushnew (current-buffer) saved-buffers)))))) + (when helm-ag-edit-save + (dolist (buf saved-buffers) + (with-current-buffer buf + (save-buffer)))) + (helm-ag--exit-from-edit-mode) + (if (not (zerop read-only-files)) + (message "%d files are read-only and not editable." read-only-files) + (message "Success update")))) + +(defun helm-ag--edit-abort () + (interactive) + (when (y-or-n-p "Discard changes ?") + (helm-ag--exit-from-edit-mode) + (message "Abort edit"))) + +(defun helm-ag--mark-line-deleted () + (interactive) + (let* ((beg (line-beginning-position)) + (end (line-end-position)) + (ov (make-overlay beg end))) + (overlay-put ov 'face 'helm-ag-edit-deleted-line) + (overlay-put ov 'helm-ag-deleted t))) + +(defun helm-ag--unmark () + (interactive) + (dolist (ov (overlays-in (line-beginning-position) (line-end-position))) + (when (overlay-get ov 'helm-ag-deleted) + (delete-overlay ov)))) + +(defvar helm-ag-edit-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-c") 'helm-ag--edit-commit) + (define-key map (kbd "C-c C-k") 'helm-ag--edit-abort) + (define-key map (kbd "C-c C-d") 'helm-ag--mark-line-deleted) + (define-key map (kbd "C-c C-u") 'helm-ag--unmark) + map)) + +(defun helm-ag--edit (_candidate) + (let ((default-directory helm-ag--default-directory)) + (with-current-buffer (get-buffer-create "*helm-ag-edit*") + (erase-buffer) + (setq-local helm-ag--default-directory helm-ag--default-directory) + (unless (helm-ag--vimgrep-option) + (setq-local helm-ag--search-this-file-p + (assoc-default 'search-this-file (helm-get-current-source)))) + (let (buf-content) + (with-current-buffer (get-buffer "*helm-ag*") + (goto-char (point-min)) + (forward-line 1) + (let* ((body-start (point)) + (marked-lines (cl-loop for ov in (overlays-in body-start (point-max)) + when (eq 'helm-visible-mark (overlay-get ov 'face)) + return (helm-marked-candidates)))) + (if (not marked-lines) + (setq buf-content (buffer-substring-no-properties + body-start (point-max))) + (setq buf-content (concat (mapconcat 'identity marked-lines "\n") "\n"))))) + (insert buf-content) + (add-text-properties (point-min) (point-max) + '(read-only t rear-nonsticky t front-sticky t)) + (let ((inhibit-read-only t) + (regexp (helm-ag--match-line-regexp))) + (setq header-line-format + (format "[%s] C-c C-c: Commit, C-c C-k: Abort" + (abbreviate-file-name helm-ag--default-directory))) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let ((file-line-begin (match-beginning 4)) + (file-line-end (match-end 4)) + (body-begin (match-beginning 3)) + (body-end (match-end 3))) + (add-text-properties file-line-begin file-line-end + '(face font-lock-function-name-face + intangible t)) + (remove-text-properties body-begin body-end '(read-only t)) + (set-text-properties body-end (1+ body-end) + '(read-only t rear-nonsticky t)))))))) + (other-window 1) + (switch-to-buffer (get-buffer "*helm-ag-edit*")) + (goto-char (point-min)) + (setq next-error-function 'compilation-next-error-function) + (setq-local compilation-locs (make-hash-table :test 'equal :weakness 'value)) + (use-local-map helm-ag-edit-map)) + +(defun helm-ag-edit () + (interactive) + (helm-exit-and-execute-action 'helm-ag--edit)) + +(defconst helm-ag--help-message + "\n* Helm Ag\n + +\n** Specific commands for Helm Ag:\n +\\ +\\[helm-ag--run-other-window-action]\t\t-> Open result in other buffer +\\[helm-ag--up-one-level]\t\t-> Search in parent directory. +\\[helm-ag-edit]\t\t-> Edit search results. +\\[helm-ag-help]\t\t-> Show this help. +\n** Helm Ag Map\n +\\{helm-map}") + +(defun helm-ag-help () + (interactive) + (let ((helm-help-message helm-ag--help-message)) + (helm-help))) + +(defun helm-ag-mode-jump () + (interactive) + (let ((line (helm-current-line-contents))) + (helm-ag--find-file-action line 'find-file helm-ag--search-this-file-p))) + +(defun helm-ag-mode-jump-other-window () + (interactive) + (let ((line (helm-current-line-contents))) + (helm-ag--find-file-action line 'find-file-other-window helm-ag--search-this-file-p))) + +(defvar helm-ag-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'helm-ag-mode-jump) + (define-key map (kbd "C-o") 'helm-ag-mode-jump-other-window) + (define-key map (kbd "g") 'helm-ag--update-save-results) + map)) + +;;;###autoload +(define-derived-mode helm-ag-mode special-mode "helm-ag" + "Major mode to provide actions in helm grep saved buffer. + +Special commands: +\\{helm-ag-mode-map}") + +(defun helm-ag--put-result-in-save-buffer (result search-this-file-p) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert "-*- mode: helm-ag -*-\n\n" + (format "Ag Results for `%s':\n\n" helm-ag--last-query)) + (save-excursion + (insert result))) + (helm-ag-mode) + (unless (helm-ag--vimgrep-option) + (setq-local helm-ag--search-this-file-p search-this-file-p)) + (setq-local helm-ag--default-directory default-directory)) + +(defun helm-ag--save-results (use-other-buf) + (let* ((search-this-file-p nil) + (result (with-current-buffer helm-buffer + (goto-char (point-min)) + (forward-line 1) + (buffer-substring (point) (point-max)))) + (default-directory helm-ag--default-directory) + (buf (if use-other-buf + (read-string "Results buffer name: " + (format "*helm ag results for '%s'*" helm-ag--last-query)) + "*helm ag results*"))) + (when (buffer-live-p (get-buffer buf)) + (kill-buffer buf)) + (with-current-buffer (get-buffer-create buf) + (helm-ag--put-result-in-save-buffer result search-this-file-p) + (pop-to-buffer buf) + (message "Helm Ag Results saved in `%s' buffer" buf)))) + +(defun helm-ag--update-save-results () + (interactive) + (let* ((default-directory helm-ag--default-directory) + (result (with-temp-buffer + (apply #'process-file (car helm-ag--last-command) nil t nil + (cdr helm-ag--last-command)) + (helm-ag--remove-carrige-returns) + (helm-ag--propertize-candidates helm-ag--last-query) + (buffer-string)))) + (helm-ag--put-result-in-save-buffer result helm-ag--search-this-file-p) + (message "Update Results"))) + +(defun helm-ag--action-save-buffer (_arg) + (helm-ag--save-results nil)) + +(defun helm-ag--run-save-buffer () + (interactive) + (let ((use-other-buf-p current-prefix-arg)) + (with-helm-alive-p + (helm-exit-and-execute-action + (lambda (_arg) + (helm-ag--save-results use-other-buf-p)))))) + +(defun helm-ag--file-of-current-file () + (let ((line (helm-current-line-contents))) + (when (string-match helm-grep-split-line-regexp line) + (match-string-no-properties 1 line)))) + +(defun helm-ag--move-file-common (pred move-fn wrap-fn) + (with-helm-window + (let ((file (helm-ag--file-of-current-file))) + (funcall move-fn) + (while (and (not (funcall pred)) (string= file (helm-ag--file-of-current-file))) + (funcall move-fn)) + (when (funcall pred) + (funcall wrap-fn))))) + +(defun helm-ag--previous-file () + (interactive) + (helm-ag--move-file-common + #'helm-beginning-of-source-p #'helm-previous-line #'helm-end-of-buffer)) + +(defun helm-ag--next-file () + (interactive) + (helm-ag--move-file-common + #'helm-end-of-source-p #'helm-next-line #'helm-beginning-of-buffer)) + +(defvar helm-ag-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c o") 'helm-ag--run-other-window-action) + (define-key map (kbd "C-l") 'helm-ag--up-one-level) + (define-key map (kbd "C-c C-e") 'helm-ag-edit) + (define-key map (kbd "C-x C-s") 'helm-ag--run-save-buffer) + (define-key map (kbd "C-c ?") 'helm-ag-help) + (define-key map (kbd "C-c >") 'helm-ag--next-file) + (define-key map (kbd "") 'helm-ag--next-file) + (define-key map (kbd "C-c <") 'helm-ag--previous-file) + (define-key map (kbd "") 'helm-ag--previous-file) + map) + "Keymap for `helm-ag'.") + +(defsubst helm-ag--root-directory-p () + (cl-loop for dir in '(".git/" ".hg/") + thereis (file-directory-p dir))) + +(defun helm-ag--up-one-level () + (interactive) + (if (or (not (helm-ag--root-directory-p)) + (y-or-n-p "Current directory might be the project root. \ +Continue searching the parent directory? ")) + (let ((parent (file-name-directory (directory-file-name default-directory)))) + (helm-run-after-exit + (lambda () + (let* ((default-directory parent) + (helm-ag--default-directory parent)) + (setq helm-ag--last-default-directory default-directory) + (helm-attrset 'name (helm-ag--helm-header default-directory) helm-ag-source) + (helm :sources '(helm-ag-source) :buffer "*helm-ag*" :keymap helm-ag-map))))) + (message nil))) + +;;;###autoload +(defun helm-ag-this-file () + (interactive) + (helm-ag--init-state) + (let ((filename (file-name-nondirectory (buffer-file-name))) + (helm-ag--default-directory default-directory)) + (helm-ag--query) + (helm-ag--set-command-feature) + (helm-attrset 'search-this-file (file-relative-name (buffer-file-name)) + helm-ag-source) + (helm-attrset 'name (format "Search at %s" filename) helm-ag-source) + (helm :sources '(helm-ag-source) :buffer "*helm-ag*" :keymap helm-ag-map))) + +;;;###autoload +(defun helm-ag (&optional basedir) + (interactive) + (helm-ag--init-state) + (let ((dir (helm-ag--get-default-directory)) + targets) + (when (listp dir) + (setq basedir default-directory + targets dir)) + (let ((helm-ag--default-directory (or basedir dir)) + (helm-ag--default-target targets)) + (helm-ag--query) + (helm-attrset 'search-this-file nil helm-ag-source) + (helm-attrset 'name (helm-ag--helm-header helm-ag--default-directory) helm-ag-source) + (helm :sources '(helm-ag-source) :buffer "*helm-ag*" :keymap helm-ag-map)))) + +(defun helm-ag--split-string (str) + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (let ((prev (point)) + patterns) + (while (search-forward " " nil 'move) + (cond ((looking-back "\\\\\\\\ " nil) + (push (buffer-substring-no-properties prev (1- (point))) patterns) + (skip-chars-forward " ") + (setq prev (point))) + ((looking-back "\\\\ " nil) + (replace-match " ")) + (t (push (buffer-substring-no-properties prev (1- (point))) patterns) + (skip-chars-forward " ") + (setq prev (point))))) + (push (buffer-substring-no-properties prev (point)) patterns) + (reverse (cl-loop for p in patterns unless (string= p "") collect p))))) + +(defsubst helm-ag--convert-invert-pattern (pattern) + (when (and (not helm-ag--command-feature) + (string-prefix-p "!" pattern) (> (length pattern) 1)) + (concat "^(?!.*" (substring pattern 1) ").+$"))) + +(defun helm-ag--join-patterns (input) + (let ((patterns (helm-ag--split-string input))) + (if (= (length patterns) 1) + (or (helm-ag--convert-invert-pattern (car patterns)) + (car patterns)) + (cl-case helm-ag--command-feature + (pt input) + (pt-regexp (mapconcat 'identity patterns ".*")) + (otherwise (cl-loop for s in patterns + if (helm-ag--convert-invert-pattern s) + concat (concat "(?=" it ")") + else + concat (concat "(?=.*" s ".*)"))))))) + +(defun helm-ag--do-ag-highlight-patterns (input) + (if helm-ag--command-feature + (list (helm-ag--join-patterns input)) + (cl-loop with regexp = (helm-ag--pcre-to-elisp-regexp input) + for pattern in (helm-ag--split-string regexp) + when (helm-ag--validate-regexp pattern) + collect pattern))) + +(defun helm-ag--propertize-candidates (input) + (goto-char (point-min)) + (forward-line 1) + (let ((patterns (helm-ag--do-ag-highlight-patterns input))) + (cl-loop with one-file-p = (and (not (helm-ag--vimgrep-option)) + (helm-ag--search-only-one-file-p)) + while (not (eobp)) + for num = 1 then (1+ num) + do + (progn + (let ((start (point)) + (bound (line-end-position))) + (if (and one-file-p (search-forward ":" bound t)) + (set-text-properties (line-beginning-position) (1- (point)) + '(face helm-grep-lineno)) + (when (re-search-forward helm-grep-split-line-regexp bound t) + (set-text-properties (match-beginning 1) (match-end 1) '(face helm-moccur-buffer)) + (set-text-properties (match-beginning 2) (match-end 2) '(face helm-grep-lineno)) + (goto-char (match-beginning 3)))) + (let ((curpoint (point)) + (case-fold-search helm-ag--ignore-case)) + (dolist (pattern patterns) + (let ((last-point (point))) + (while (re-search-forward pattern bound t) + (set-text-properties (match-beginning 0) (match-end 0) + '(face helm-match)) + (when (= last-point (point)) + (forward-char 1)) + (setq last-point (point))) + (goto-char curpoint)))) + (put-text-property start bound 'helm-cand-num num)) + (forward-line 1))))) + +(defun helm-ag-show-status-default-mode-line () + (setq mode-line-format + '(" " mode-line-buffer-identification " " + (:eval (propertize + (format + "[AG process finished - (%s results)] " + (helm-get-candidate-number)) + 'face 'helm-grep-finish))))) + +(defun helm-ag--do-ag-propertize (input) + (with-helm-window + (helm-ag--remove-carrige-returns) + (helm-ag--propertize-candidates input) + (goto-char (point-min)) + (when helm-ag-show-status-function + (funcall helm-ag-show-status-function) + (force-mode-line-update)))) + +(defun helm-ag--construct-extension-options () + (cl-loop for ext in helm-do-ag--extensions + unless (string= ext "*") + collect + (concat "-G" (replace-regexp-in-string + "\\*" "" + (replace-regexp-in-string "\\." "\\\\." ext))))) + +(defun helm-ag--construct-do-ag-command (pattern) + (let* ((opt-query (helm-ag--parse-options-and-query pattern)) + (options (car opt-query)) + (query (cdr opt-query))) + (when helm-ag-use-emacs-lisp-regexp + (setq query (helm-ag--elisp-regexp-to-pcre query))) + (unless (string= query "") + (append (car helm-do-ag--commands) + (cl-remove-if (lambda (x) (string= "--" x)) options) + (list "--" (helm-ag--join-patterns query)) + (cdr helm-do-ag--commands))))) + +(defun helm-ag--do-ag-set-command () + (let ((cmd-opts (split-string helm-ag-base-command nil t))) + (when helm-ag-command-option + (setq cmd-opts (append cmd-opts (split-string helm-ag-command-option nil t)))) + (when helm-ag--extra-options + (setq cmd-opts (append cmd-opts (split-string helm-ag--extra-options)))) + (when helm-ag-ignore-patterns + (setq cmd-opts + (append cmd-opts + (mapcar #'helm-ag--construct-ignore-option + helm-ag-ignore-patterns)))) + (when helm-ag-use-agignore + (helm-aif (helm-ag--root-agignore) + (setq cmd-opts (append cmd-opts (list "-p" it))))) + (when helm-do-ag--extensions + (setq cmd-opts (append cmd-opts (helm-ag--construct-extension-options)))) + (let (targets) + (when helm-ag--buffer-search + (setq targets (helm-ag--file-visited-buffers))) + (setq helm-do-ag--commands + (cons cmd-opts + (if helm-ag--default-target + (append targets (helm-ag--construct-targets helm-ag--default-target)) + targets)))))) + +(defun helm-ag--do-ag-candidate-process () + (let* ((non-essential nil) + (default-directory (or helm-ag--default-directory + helm-ag--last-default-directory + default-directory)) + (cmd-args (helm-ag--construct-do-ag-command helm-pattern))) + (when cmd-args + (let ((proc (apply #'start-file-process "helm-do-ag" nil cmd-args))) + (setq helm-ag--last-query helm-pattern + helm-ag--last-command cmd-args + helm-ag--ignore-case (helm-ag--ignore-case-p cmd-args helm-pattern) + helm-ag--last-default-directory default-directory) + (prog1 proc + (set-process-sentinel + proc + (lambda (process event) + (helm-process-deferred-sentinel-hook + process event (helm-default-directory)) + (when (string= event "finished\n") + (helm-ag--do-ag-propertize helm-input))))))))) + +(defconst helm-do-ag--help-message + "\n* Helm Do Ag\n + +\n** Specific commands for Helm Ag:\n +\\ +\\[helm-ag--run-other-window-action]\t\t-> Open result in other buffer +\\[helm-ag--do-ag-up-one-level]\t\t-> Search in parent directory. +\\[helm-ag-edit]\t\t-> Edit search results. +\\[helm-ag--do-ag-help]\t\t-> Show this help. +\n** Helm Ag Map\n +\\{helm-map}") + +(defun helm-ag--do-ag-help () + (interactive) + (let ((helm-help-message helm-do-ag--help-message)) + (helm-help))) + +(defvar helm-do-ag-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-ag-map) + (define-key map (kbd "C-l") 'helm-ag--do-ag-up-one-level) + (define-key map (kbd "C-c ?") 'helm-ag--do-ag-help) + map) + "Keymap for `helm-do-ag'.") + +(defvar helm-source-do-ag + (helm-build-async-source "The Silver Searcher" + :init 'helm-ag--do-ag-set-command + :candidates-process 'helm-ag--do-ag-candidate-process + :persistent-action 'helm-ag--persistent-action + :action helm-ag--actions + :nohighlight t + :requires-pattern 3 + :candidate-number-limit 9999 + :follow (and helm-follow-mode-persistent 1))) + +(defun helm-ag--do-ag-up-one-level () + (interactive) + (if (or (not (helm-ag--root-directory-p)) + (y-or-n-p "Current directory might be the project root. \ +Continue searching the parent directory? ")) + (let ((parent (file-name-directory (directory-file-name default-directory))) + (initial-input helm-input)) + (helm-run-after-exit + (lambda () + (let ((default-directory parent) + (helm-ag--default-directory parent)) + (setq helm-ag--last-default-directory default-directory) + (helm-attrset 'name (helm-ag--helm-header parent) + helm-source-do-ag) + (helm :sources '(helm-source-do-ag) :buffer "*helm-ag*" + :input initial-input :keymap helm-do-ag-map))))) + (message nil))) + +(defun helm-ag--set-do-ag-option () + (when (or (< (prefix-numeric-value current-prefix-arg) 0) + helm-ag-always-set-extra-option) + (let ((option (read-string "Extra options: " (or helm-ag--extra-options "") + 'helm-ag--extra-options-history))) + (setq helm-ag--extra-options option)))) + +(defun helm-ag--set-command-feature () + (setq helm-ag--command-feature + (when (string-prefix-p "pt" helm-ag-base-command) + (if (string-match-p "-e" helm-ag-base-command) + 'pt-regexp + 'pt)))) + +(defun helm-ag--do-ag-searched-extensions () + (when (and current-prefix-arg (= (abs (prefix-numeric-value current-prefix-arg)) 4)) + (helm-grep-get-file-extensions helm-ag--default-target))) + +(defsubst helm-do-ag--target-one-directory-p (targets) + (and (listp targets) (= (length targets) 1) (file-directory-p (car targets)))) + +(defun helm-do-ag--helm () + (let ((search-dir (if (not (helm-ag--windows-p)) + helm-ag--default-directory + (if (helm-do-ag--target-one-directory-p helm-ag--default-target) + (car helm-ag--default-target) + helm-ag--default-directory)))) + (helm-attrset 'name (helm-ag--helm-header search-dir) + helm-source-do-ag) + (helm :sources '(helm-source-do-ag) :buffer "*helm-ag*" + :input (helm-ag--insert-thing-at-point helm-ag-insert-at-point) + :keymap helm-do-ag-map))) + +;;;###autoload +(defun helm-do-ag-this-file () + (interactive) + (helm-aif (buffer-file-name) + (helm-do-ag default-directory (list it)) + (error "Error: This buffer is not visited file."))) + +;;;###autoload +(defun helm-do-ag (&optional basedir targets) + (interactive) + (require 'helm-mode) + (helm-ag--init-state) + (let* ((helm-ag--default-directory (or basedir default-directory)) + (helm-ag--default-target (cond (targets targets) + ((and (helm-ag--windows-p) basedir) (list basedir)) + (t + (when (and (not basedir) (not helm-ag--buffer-search)) + (helm-read-file-name + "Search in file(s): " + :default default-directory + :marked-candidates t :must-match t))))) + (helm-do-ag--extensions (when helm-ag--default-target + (helm-ag--do-ag-searched-extensions))) + (one-directory-p (helm-do-ag--target-one-directory-p + helm-ag--default-target))) + (helm-ag--set-do-ag-option) + (helm-ag--set-command-feature) + (helm-ag--save-current-context) + (helm-attrset 'search-this-file + (and (= (length helm-ag--default-target) 1) + (not (file-directory-p (car helm-ag--default-target))) + (car helm-ag--default-target)) + helm-source-do-ag) + (if (or (helm-ag--windows-p) (not one-directory-p)) ;; Path argument must be specified on Windows + (helm-do-ag--helm) + (let* ((helm-ag--default-directory + (file-name-as-directory (car helm-ag--default-target))) + (helm-ag--default-target nil)) + (helm-do-ag--helm))))) + +(defun helm-ag--project-root () + (cl-loop for dir in '(".git/" ".hg/" ".svn/") + when (locate-dominating-file default-directory dir) + return it)) + +;;;###autoload +(defun helm-ag-project-root () + (interactive) + (let ((rootdir (helm-ag--project-root))) + (unless rootdir + (error "Could not find the project root. Create a git, hg, or svn repository there first. ")) + (helm-ag rootdir))) + +;;;###autoload +(defun helm-do-ag-project-root () + (interactive) + (let ((rootdir (helm-ag--project-root))) + (unless rootdir + (error "Could not find the project root. Create a git, hg, or svn repository there first. ")) + (helm-do-ag rootdir))) + +;;;###autoload +(defun helm-ag-buffers () + (interactive) + (let ((helm-ag--buffer-search t)) + (helm-ag))) + +;;;###autoload +(defun helm-do-ag-buffers () + (interactive) + (let ((helm-ag--buffer-search t)) + (helm-do-ag))) + +(provide 'helm-ag) + +;;; helm-ag.el ends here diff --git a/elpa/helm-flyspell-20151026.912/helm-flyspell-autoloads.el b/elpa/helm-flyspell-20151026.912/helm-flyspell-autoloads.el new file mode 100644 index 0000000..b86f96f --- /dev/null +++ b/elpa/helm-flyspell-20151026.912/helm-flyspell-autoloads.el @@ -0,0 +1,23 @@ +;;; helm-flyspell-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "helm-flyspell" "helm-flyspell.el" (22297 53346 +;;;;;; 154923 870000)) +;;; Generated autoloads from helm-flyspell.el + +(autoload 'helm-flyspell-correct "helm-flyspell" "\ +Use helm for flyspell correction. +Adapted from `flyspell-correct-word-before-point'. + +\(fn)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; helm-flyspell-autoloads.el ends here diff --git a/elpa/helm-flyspell-20151026.912/helm-flyspell-pkg.el b/elpa/helm-flyspell-20151026.912/helm-flyspell-pkg.el new file mode 100644 index 0000000..b341fcf --- /dev/null +++ b/elpa/helm-flyspell-20151026.912/helm-flyspell-pkg.el @@ -0,0 +1 @@ +(define-package "helm-flyspell" "20151026.912" "Helm extension for correcting words with flyspell" '((helm "1.6.5"))) diff --git a/elpa/helm-flyspell-20151026.912/helm-flyspell.el b/elpa/helm-flyspell-20151026.912/helm-flyspell.el new file mode 100644 index 0000000..fb47666 --- /dev/null +++ b/elpa/helm-flyspell-20151026.912/helm-flyspell.el @@ -0,0 +1,146 @@ +;;; helm-flyspell.el --- Helm extension for correcting words with flyspell +;; Package-Version: 20151026.912 + +;; Copyright (C) 2014 Andrzej Pronobis + +;; Package-Requires: ((helm "1.6.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: +;; To use, just put your cursor on or after the misspelled word and +;; run helm-flyspell-correct. You can of course bind it to a key as +;; well by adding this to your `~/.emacs` file: +;; (define-key flyspell-mode-map (kbd "C-;") 'helm-flyspell-correct) +;; +;; When invoked, it will show the list of corrections suggested by +;; Flyspell and options to save the word in your personal dictionary +;; or accept it in the buffer or the session. If a pattern is typed, +;; it will be used to filter the corrections. It can also be directly +;; saved to the dictionary, even if it is different from the initial +;; word. The new typed word will also replace the word typed in the +;; buffer. + +;;; Code: + +;; For lexical-let +(eval-when-compile + (require 'cl)) + +;; Requires +(require 'helm) +(require 'flyspell) + + +(defun helm-flyspell--always-match (candidate) + "Return true for any CANDIDATE." + t + ) + + +(defun helm-flyspell--option-candidates (word) + "Return a set of options for the given WORD." + (let ((opts (list (cons (format "Save \"%s\"" word) (cons 'save word)) + (cons (format "Accept (session) \"%s\"" word) (cons 'session word)) + (cons (format "Accept (buffer) \"%s\"" word) (cons 'buffer word))))) + (unless (string= helm-pattern "") + (setq opts (append opts (list (cons (format "Save \"%s\"" helm-pattern) (cons 'save helm-pattern)) + (cons (format "Accept (session) \"%s\"" helm-pattern) (cons 'session helm-pattern)) + (cons (format "Accept (buffer) \"%s\"" helm-pattern) (cons 'buffer helm-pattern)))))) + opts + )) + + +(defun helm-flyspell (candidates word) + "Run helm for the given CANDIDATES given by flyspell for the WORD. +Return a selected word to use as a replacement or +a tuple of (command, word) to be used by flyspell-do-correct." + (helm :sources (list (helm-build-sync-source (format "Suggestions for \"%s\" in dictionary \"%s\"" + word (or ispell-local-dictionary + ispell-dictionary + "Default")) + :candidates candidates + :action 'identity + :candidate-number-limit 9999 + :fuzzy-match t + ) + (helm-build-sync-source "Options" + :candidates '(lambda () + (lexical-let ((tmp word)) + (helm-flyspell--option-candidates tmp))) + :action 'identity + :candidate-number-limit 9999 + :match 'helm-flyspell--always-match + :volatile t + ) + ) + :buffer "*Helm Flyspell*" + :prompt "Correction: ")) + + +;;;###autoload +(defun helm-flyspell-correct () + "Use helm for flyspell correction. +Adapted from `flyspell-correct-word-before-point'." + (interactive) + ;; use the correct dictionary + (flyspell-accept-buffer-local-defs) + (let ((cursor-location (point)) + (word (flyspell-get-word)) + (opoint (point))) + (if (consp word) + (let ((start (car (cdr word))) + (end (car (cdr (cdr word)))) + (word (car word)) + poss ispell-filter) + ;; now check spelling of word. + (ispell-send-string "%\n") ;put in verbose mode + (ispell-send-string (concat "^" word "\n")) + ;; wait until ispell has processed word + (while (progn + (accept-process-output ispell-process) + (not (string= "" (car ispell-filter))))) + ;; Remove leading empty element + (setq ispell-filter (cdr ispell-filter)) + ;; ispell process should return something after word is sent. + ;; Tag word as valid (i.e., skip) otherwise + (or ispell-filter + (setq ispell-filter '(*))) + (if (consp ispell-filter) + (setq poss (ispell-parse-output (car ispell-filter)))) + (cond + ((or (eq poss t) (stringp poss)) + ;; don't correct word + t) + ((null poss) + ;; ispell error + (error "Ispell: error in Ispell process")) + (t + ;; The word is incorrect, we have to propose a replacement. + (let ((res (helm-flyspell (third poss) word))) + (cond ((stringp res) + (flyspell-do-correct res poss word cursor-location start end opoint)) + (t + (let ((cmd (car res)) + (wrd (cdr res))) + (if (string= wrd word) + (flyspell-do-correct cmd poss wrd cursor-location start end opoint) + (progn + (flyspell-do-correct cmd poss wrd cursor-location start end opoint) + (flyspell-do-correct wrd poss word cursor-location start end opoint))))))))) + (ispell-pdict-save t))))) + + +(provide 'helm-flyspell) +;;; helm-flyspell.el ends here diff --git a/elpa/helm-make-20160331.754/helm-make-autoloads.el b/elpa/helm-make-20160331.754/helm-make-autoloads.el new file mode 100644 index 0000000..ca8dc71 --- /dev/null +++ b/elpa/helm-make-20160331.754/helm-make-autoloads.el @@ -0,0 +1,39 @@ +;;; helm-make-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "helm-make" "helm-make.el" (22297 53345 558923 +;;;;;; 533000)) +;;; Generated autoloads from helm-make.el + +(autoload 'helm-make "helm-make" "\ +Call \"make -j ARG target\". Target is selected with completion. + +\(fn &optional ARG)" t nil) + +(autoload 'helm-make-reset-cache "helm-make" "\ +Reset cache, see `helm-make-cache-targets'. + +\(fn)" t nil) + +(autoload 'helm-make-projectile "helm-make" "\ +Call `helm-make' for `projectile-project-root'. +ARG specifies the number of cores. + +By default `helm-make-projectile' will look in `projectile-project-root' +followed by `projectile-project-root'/build, for a makefile. + +You can specify an additional directory to search for a makefile by +setting the buffer local variable `helm-make-build-dir'. + +\(fn &optional ARG)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; helm-make-autoloads.el ends here diff --git a/elpa/helm-make-20160331.754/helm-make-pkg.el b/elpa/helm-make-20160331.754/helm-make-pkg.el new file mode 100644 index 0000000..6ce8fe4 --- /dev/null +++ b/elpa/helm-make-20160331.754/helm-make-pkg.el @@ -0,0 +1 @@ +(define-package "helm-make" "20160331.754" "Select a Makefile target with helm" '((helm "1.5.3") (projectile "0.11.0")) :url "https://github.com/abo-abo/helm-make" :keywords '("makefile")) diff --git a/elpa/helm-make-20160331.754/helm-make.el b/elpa/helm-make-20160331.754/helm-make.el new file mode 100644 index 0000000..40bd9ce --- /dev/null +++ b/elpa/helm-make-20160331.754/helm-make.el @@ -0,0 +1,294 @@ +;;; helm-make.el --- Select a Makefile target with helm + +;; Copyright (C) 2014 Oleh Krehel + +;; Author: Oleh Krehel +;; URL: https://github.com/abo-abo/helm-make +;; Package-Version: 20160331.754 +;; Version: 0.2.0 +;; Package-Requires: ((helm "1.5.3") (projectile "0.11.0")) +;; Keywords: makefile + +;; This file is not part of GNU Emacs + +;; This file 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, 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. + +;; For a full copy of the GNU General Public License +;; see . + +;;; Commentary: +;; +;; A call to `helm-make' will give you a `helm' selection of this directory +;; Makefile's targets. Selecting a target will call `compile' on it. + +;;; Code: + +(require 'helm) +(require 'helm-multi-match) + +(declare-function ivy-read "ext:ivy") + +(defgroup helm-make nil + "Select a Makefile target with helm." + :group 'convenience) + +(defcustom helm-make-do-save nil + "If t, save all open buffers visiting files from Makefile's directory." + :type 'boolean + :group 'helm-make) + +(defcustom helm-make-build-dir "" + "Specify a build directory for an out of source build. +The path should be relative to the project root. + +When non-nil `helm-make-projectile' will first look in that directory for a +makefile." + :type '(string) + :group 'helm-make) +(make-variable-buffer-local 'helm-make-build-dir) + +(defcustom helm-make-sort-targets nil + "Whether targets shall be sorted. +If t, targets will be sorted as a final step before calling the +completion method. + +HINT: If you are facing performance problems set this to nil. +This might be the case, if there are thousand of targets." + :type 'boolean + :group 'helm-make) + +(defcustom helm-make-cache-targets nil + "Whether to cache the targets or not. + +If t, cache targets of Makefile. If `helm-make' or `helm-make-projectile' +gets called for the same Makefile again, and the Makefile hasn't changed +meanwhile, i.e. the modification time is `equal' to the cached one, reuse +the cached targets, instead of recomputing them. If nil do nothing. + +You can reset the cache by calling `helm-make-reset-db'." + :type 'boolean + :group 'helm-make) + +(defcustom helm-make-executable "make" + "Store the name of make executable." + :type 'string + :group 'helm-make) + +(defcustom helm-make-require-match t + "When non-nil, don't allow selecting a target that's not on the list." + :type 'boolean) + +(defvar helm-make-command nil + "Store the make command.") + +(defvar helm-make-target-history nil + "Holds the recently used targets.") + +(defvar helm-make-makefile-names '("Makefile" "makefile" "GNUmakefile") + "List of Makefile names which make recognizes. +An exception is \"GNUmakefile\", only GNU make unterstand it.") + +(defun helm--make-action (target) + "Make TARGET." + (compile (format helm-make-command target))) + +(defcustom helm-make-completion-method 'helm + "Method to select a candidate from a list of strings." + :type '(choice + (const :tag "Helm" helm) + (const :tag "Ido" ido) + (const :tag "Ivy" ivy))) + +;;;###autoload +(defun helm-make (&optional arg) + "Call \"make -j ARG target\". Target is selected with completion." + (interactive "p") + (setq helm-make-command (format "%s -j%d %%s" helm-make-executable arg)) + (let ((makefile (helm--make-makefile-exists default-directory))) + (if makefile + (helm--make makefile) + (error "No Makefile in %s" default-directory)))) + +(defun helm--make-target-list-qp (makefile) + "Return the target list for MAKEFILE by parsing the output of \"make -nqp\"." + (let ((default-directory (file-name-directory + (expand-file-name makefile))) + targets target) + (with-temp-buffer + (insert + (shell-command-to-string + "make -nqp __BASH_MAKE_COMPLETION__=1 .DEFAULT 2>/dev/null")) + (goto-char (point-min)) + (unless (re-search-forward "^# Files" nil t) + (error "Unexpected \"make -nqp\" output")) + (while (re-search-forward "^\\([^%$:#\n\t ]+\\):\\([^=]\\|$\\)" nil t) + (setq target (match-string 1)) + (unless (or (save-excursion + (goto-char (match-beginning 0)) + (forward-line -1) + (looking-at "^# Not a target:")) + (string-match "^\\([/a-zA-Z0-9_. -]+/\\)?\\." target)) + (push target targets)))) + targets)) + +(defun helm--make-target-list-default (makefile) + "Return the target list for MAKEFILE by parsing it." + (let (targets) + (with-temp-buffer + (insert-file-contents makefile) + (goto-char (point-min)) + (while (re-search-forward "^\\([^: \n]+\\):" nil t) + (let ((str (match-string 1))) + (unless (string-match "^\\." str) + (push str targets))))) + targets)) + +(defcustom helm-make-list-target-method 'default + "Method of obtaining the list of Makefile targets." + :type '(choice + (const :tag "Default" default) + (const :tag "make -qp" qp))) + +(defun helm--make-makefile-exists (base-dir &optional dir-list) + "Check if one of `helm-make-makefile-names' exist in BASE-DIR. + +Returns the absolute filename to the Makefile, if one exists, +otherwise nil. + +If DIR-LIST is non-nil, also search for `helm-make-makefile-names'." + (let* ((default-directory (file-truename base-dir)) + (makefiles + (progn + (unless (and dir-list (listp dir-list)) + (setq dir-list (list ""))) + (let (result) + (dolist (dir dir-list) + (dolist (makefile helm-make-makefile-names) + (push (expand-file-name makefile dir) result))) + (reverse result))))) + (cl-find-if 'file-exists-p makefiles))) + +(defvar helm-make-db (make-hash-table :test 'equal) + "An alist of Makefile and corresponding targets.") + +(cl-defstruct helm-make-dbfile + targets + modtime + sorted) + +(defun helm--make-cached-targets (makefile) + "Return cached targets of MAKEFILE. + +If there are no cached targets for MAKEFILE, the MAKEFILE modification +time has changed, or `helm-make-cache-targets' is nil, parse the MAKEFILE, +and cache targets of MAKEFILE, if `helm-make-cache-targets' is t." + (let* ((att (file-attributes makefile 'integer)) + (modtime (if att (nth 5 att) nil)) + (entry (gethash makefile helm-make-db nil)) + (new-entry (make-helm-make-dbfile)) + (targets (cond + ((and helm-make-cache-targets + entry + (equal modtime (helm-make-dbfile-modtime entry)) + (helm-make-dbfile-targets entry)) + (helm-make-dbfile-targets entry)) + (t + (delete-dups (if (eq helm-make-list-target-method 'default) + (helm--make-target-list-default makefile) + (helm--make-target-list-qp makefile))))))) + (when helm-make-sort-targets + (unless (and helm-make-cache-targets + entry + (helm-make-dbfile-sorted entry)) + (setq targets (sort targets 'string<))) + (setf (helm-make-dbfile-sorted new-entry) t)) + + (when helm-make-cache-targets + (setf (helm-make-dbfile-targets new-entry) targets + (helm-make-dbfile-modtime new-entry) modtime) + (puthash makefile new-entry helm-make-db)) + targets)) + +;;;###autoload +(defun helm-make-reset-cache () + "Reset cache, see `helm-make-cache-targets'." + (interactive) + (clrhash helm-make-db)) + +(defun helm--make (makefile) + "Call make for MAKEFILE." + (when helm-make-do-save + (let* ((regex (format "^%s" default-directory)) + (buffers + (cl-remove-if-not + (lambda (b) + (let ((name (buffer-file-name b))) + (and name + (string-match regex (expand-file-name name))))) + (buffer-list)))) + (mapc + (lambda (b) + (with-current-buffer b + (save-buffer))) + buffers))) + (let ((targets (helm--make-cached-targets makefile)) + (default-directory (file-name-directory makefile))) + (delete-dups helm-make-target-history) + (cl-case helm-make-completion-method + (helm + (helm :sources + `((name . "Targets") + (candidates . ,targets) + (action . helm--make-action)) + :history 'helm-make-target-history + :preselect (when helm-make-target-history + (format "^%s$" (car helm-make-target-history))))) + (ivy + (ivy-read "Target: " + targets + :history 'helm-make-target-history + :preselect (car helm-make-target-history) + :action 'helm--make-action + :require-match helm-make-require-match)) + (ido + (let ((target (ido-completing-read + "Target: " targets + nil nil nil + 'helm-make-target-history))) + (when target + (helm--make-action target))))))) + +;;;###autoload +(defun helm-make-projectile (&optional arg) + "Call `helm-make' for `projectile-project-root'. +ARG specifies the number of cores. + +By default `helm-make-projectile' will look in `projectile-project-root' +followed by `projectile-project-root'/build, for a makefile. + +You can specify an additional directory to search for a makefile by +setting the buffer local variable `helm-make-build-dir'." + (interactive "p") + (require 'projectile) + (setq helm-make-command (format "%s -j%d %%s" helm-make-executable arg)) + (let ((makefile (helm--make-makefile-exists + (projectile-project-root) + (if (and (stringp helm-make-build-dir) + (not (string-match-p "\\`[ \t\n\r]*\\'" helm-make-build-dir))) + `(,helm-make-build-dir "" "build") + `(,@helm-make-build-dir "" "build"))))) + (if makefile + (helm--make makefile) + (error "No Makefile found for project %s" (projectile-project-root))))) + +(provide 'helm-make) + +;;; helm-make.el ends here diff --git a/elpa/magit-rockstar-readme.txt b/elpa/magit-rockstar-readme.txt deleted file mode 100644 index c23787f..0000000 --- a/elpa/magit-rockstar-readme.txt +++ /dev/null @@ -1,34 +0,0 @@ -This package provides two commands which manipulate author and -committer dates. You could use it to make yourself look like -a rockstar programmer who hammers out commits at one commit per -minute. But the real purpose is to recover from heavy -re-arrangements of commits, that have causes the existing author -and committer dates to become meaningless. - -I add these commands to the appropriate popups like this: - - (magit-define-popup-action 'magit-rebase-popup - ?R "Rockstar" 'magit-rockstar) - - (magit-define-popup-action 'magit-commit-popup - ?n "Reshelve" 'magit-reshelve) - -Also included are tools that are either only useful for people -working on Magit itself and/or that aren't ready to be added to -Magit yet. These tools might change at any time, without prior -notice or way to appeal. This is a staging ground. It's okay -if things ain't perfect, or if they only do what *I currently* -need but not what you (or I) think they should (eventually) be -doing instead. - -Currently my init file also contains this: - - (magit-define-popup-action 'magit-fetch-popup - ?P "Pull request" 'magit-branch-pull-request) - -To use the "anti-stage" feature add this: - - (setq magit-unstage-use-anti-stage t) - - (magit-define-popup-action 'magit-revert-popup - ?e "Revert & edit HEAD" 'magit-uncommit-extend) diff --git a/elpa/pkg-info-20150517.443/pkg-info-autoloads.el b/elpa/pkg-info-20150517.443/pkg-info-autoloads.el new file mode 100644 index 0000000..620164e --- /dev/null +++ b/elpa/pkg-info-20150517.443/pkg-info-autoloads.el @@ -0,0 +1,122 @@ +;;; pkg-info-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "pkg-info" "pkg-info.el" (22297 53343 954922 +;;;;;; 640000)) +;;; Generated autoloads from pkg-info.el + +(autoload 'pkg-info-library-original-version "pkg-info" "\ +Get the original version in the header of LIBRARY. + +The original version is stored in the X-Original-Version header. +This header is added by the MELPA package archive to preserve +upstream version numbers. + +LIBRARY is either a symbol denoting a named feature, or a library +name as string. + +If SHOW is non-nil, show the version in the minibuffer. + +Return the version from the header of LIBRARY as list. Signal an +error if the LIBRARY was not found or had no X-Original-Version +header. + +See Info node `(elisp)Library Headers' for more information +about library headers. + +\(fn LIBRARY &optional SHOW)" t nil) + +(autoload 'pkg-info-library-version "pkg-info" "\ +Get the version in the header of LIBRARY. + +LIBRARY is either a symbol denoting a named feature, or a library +name as string. + +If SHOW is non-nil, show the version in the minibuffer. + +Return the version from the header of LIBRARY as list. Signal an +error if the LIBRARY was not found or had no proper header. + +See Info node `(elisp)Library Headers' for more information +about library headers. + +\(fn LIBRARY &optional SHOW)" t nil) + +(autoload 'pkg-info-defining-library-original-version "pkg-info" "\ +Get the original version of the library defining FUNCTION. + +The original version is stored in the X-Original-Version header. +This header is added by the MELPA package archive to preserve +upstream version numbers. + +If SHOW is non-nil, show the version in mini-buffer. + +This function is mainly intended to find the version of a major +or minor mode, i.e. + + (pkg-info-defining-library-version 'flycheck-mode) + +Return the version of the library defining FUNCTION. Signal an +error if FUNCTION is not a valid function, if its defining +library was not found, or if the library had no proper version +header. + +\(fn FUNCTION &optional SHOW)" t nil) + +(autoload 'pkg-info-defining-library-version "pkg-info" "\ +Get the version of the library defining FUNCTION. + +If SHOW is non-nil, show the version in mini-buffer. + +This function is mainly intended to find the version of a major +or minor mode, i.e. + + (pkg-info-defining-library-version 'flycheck-mode) + +Return the version of the library defining FUNCTION. Signal an +error if FUNCTION is not a valid function, if its defining +library was not found, or if the library had no proper version +header. + +\(fn FUNCTION &optional SHOW)" t nil) + +(autoload 'pkg-info-package-version "pkg-info" "\ +Get the version of an installed PACKAGE. + +If SHOW is non-nil, show the version in the minibuffer. + +Return the version as list, or nil if PACKAGE is not installed. + +\(fn PACKAGE &optional SHOW)" t nil) + +(autoload 'pkg-info-version-info "pkg-info" "\ +Obtain complete version info for LIBRARY and PACKAGE. + +LIBRARY is a symbol denoting a named feature, or a library name +as string. PACKAGE is a symbol denoting an ELPA package. If +omitted or nil, default to LIBRARY. + +If SHOW is non-nil, show the version in the minibuffer. + +When called interactively, prompt for LIBRARY. When called +interactively with prefix argument, prompt for PACKAGE as well. + +Return a string with complete version information for LIBRARY. +This version information contains the version from the headers of +LIBRARY, and the version of the installed PACKAGE, the LIBRARY is +part of. If PACKAGE is not installed, or if the PACKAGE version +is the same as the LIBRARY version, do not include a package +version. + +\(fn LIBRARY &optional PACKAGE SHOW)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; pkg-info-autoloads.el ends here diff --git a/elpa/pkg-info-20150517.443/pkg-info-pkg.el b/elpa/pkg-info-20150517.443/pkg-info-pkg.el new file mode 100644 index 0000000..9ddb4aa --- /dev/null +++ b/elpa/pkg-info-20150517.443/pkg-info-pkg.el @@ -0,0 +1 @@ +(define-package "pkg-info" "20150517.443" "Information about packages" '((epl "0.8")) :url "https://github.com/lunaryorn/pkg-info.el" :keywords '("convenience")) diff --git a/elpa/pkg-info-20150517.443/pkg-info.el b/elpa/pkg-info-20150517.443/pkg-info.el new file mode 100644 index 0000000..98ecc15 --- /dev/null +++ b/elpa/pkg-info-20150517.443/pkg-info.el @@ -0,0 +1,331 @@ +;;; pkg-info.el --- Information about packages -*- lexical-binding: t; -*- + +;; Copyright (C) 2013-2015 Sebastian Wiesner + +;; Author: Sebastian Wiesner +;; URL: https://github.com/lunaryorn/pkg-info.el +;; Package-Version: 20150517.443 +;; Keywords: convenience +;; Version: 0.7-cvs +;; Package-Requires: ((epl "0.8")) + +;; 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 . + +;;; Commentary: + +;; This library extracts information from installed packages. + +;;;; Functions: + +;; `pkg-info-library-version' extracts the version from the header of a library. +;; +;; `pkg-info-defining-library-version' extracts the version from the header of a +;; library defining a function. +;; +;; `pkg-info-package-version' gets the version of an installed package. +;; +;; `pkg-info-format-version' formats a version list as human readable string. +;; +;; `pkg-info-version-info' returns complete version information for a specific +;; package. +;; +;; `pkg-info-get-melpa-recipe' gets the MELPA recipe for a package. +;; +;; `pkg-info-get-melpa-fetcher' gets the fetcher used to build a package on +;; MELPA. +;; +;; `pkg-info-wiki-package-p' determines whether a package was build from +;; EmacsWiki on MELPA. + +;;; Code: + +(require 'epl) + +(require 'lisp-mnt) +(require 'find-func) +(require 'json) ; `json-read' +(require 'url-http) ; `url-http-parse-response' + +(defvar url-http-end-of-headers) + + +;;; Version information +(defun pkg-info-format-version (version) + "Format VERSION as human-readable string. + +Return a human-readable string representing VERSION." + ;; XXX: Find a better, more flexible way of formatting? + (package-version-join version)) + +(defsubst pkg-info--show-version-and-return (version show) + "Show and return VERSION. + +When SHOW is non-nil, show VERSION in minibuffer. + +Return VERSION." + (when show + (message (if (listp version) (pkg-info-format-version version) version))) + version) + +(defun pkg-info--read-library () + "Read a library from minibuffer." + (completing-read "Load library: " + (apply-partially 'locate-file-completion-table + load-path + (get-load-suffixes)))) + +(defun pkg-info--read-function () + "Read a function name from minibuffer." + (let ((input (completing-read "Function: " obarray #'boundp :require-match))) + (if (string= input "") nil (intern input)))) + +(defun pkg-info--read-package () + "Read a package name from minibuffer." + (let* ((installed (epl-installed-packages)) + (names (sort (mapcar (lambda (pkg) + (symbol-name (epl-package-name pkg))) + installed) + #'string<)) + (default (car names))) + (completing-read "Installed package: " names nil 'require-match + nil nil default))) + +(defun pkg-info-library-source (library) + "Get the source file of LIBRARY. + +LIBRARY is either a symbol denoting a named feature, or a library +name as string. + +Return the source file of LIBRARY as string." + (find-library-name (if (symbolp library) (symbol-name library) library))) + +(defun pkg-info-defining-library (function) + "Get the source file of the library defining FUNCTION. + +FUNCTION is a function symbol. + +Return the file name of the library as string. Signal an error +if the library does not exist, or if the definition of FUNCTION +was not found." + (unless (functionp function) + (signal 'wrong-type-argument (list 'functionp function))) + (let ((library (symbol-file function 'defun))) + (unless library + (error "Can't find definition of %s" function)) + library)) + +(defun pkg-info-x-original-version (file) + "Read the X-Original-Version header from FILE. + +Return the value as version list, or return nil if FILE lacks +this header. Signal an error, if the value of the header is not +a valid version." + (let ((version-str (with-temp-buffer + (insert-file-contents file) + (lm-header "X-Original-Version")))) + (when version-str + (version-to-list version-str)))) + +;;;###autoload +(defun pkg-info-library-original-version (library &optional show) + "Get the original version in the header of LIBRARY. + +The original version is stored in the X-Original-Version header. +This header is added by the MELPA package archive to preserve +upstream version numbers. + +LIBRARY is either a symbol denoting a named feature, or a library +name as string. + +If SHOW is non-nil, show the version in the minibuffer. + +Return the version from the header of LIBRARY as list. Signal an +error if the LIBRARY was not found or had no X-Original-Version +header. + +See Info node `(elisp)Library Headers' for more information +about library headers." + (interactive (list (pkg-info--read-library) t)) + (let ((version (pkg-info-x-original-version + (pkg-info-library-source library)))) + (if version + (pkg-info--show-version-and-return version show) + (error "Library %s has no original version" library)))) + +;;;###autoload +(defun pkg-info-library-version (library &optional show) + "Get the version in the header of LIBRARY. + +LIBRARY is either a symbol denoting a named feature, or a library +name as string. + +If SHOW is non-nil, show the version in the minibuffer. + +Return the version from the header of LIBRARY as list. Signal an +error if the LIBRARY was not found or had no proper header. + +See Info node `(elisp)Library Headers' for more information +about library headers." + (interactive (list (pkg-info--read-library) t)) + (let* ((source (pkg-info-library-source library)) + (version (epl-package-version (epl-package-from-file source)))) + (pkg-info--show-version-and-return version show))) + +;;;###autoload +(defun pkg-info-defining-library-original-version (function &optional show) + "Get the original version of the library defining FUNCTION. + +The original version is stored in the X-Original-Version header. +This header is added by the MELPA package archive to preserve +upstream version numbers. + +If SHOW is non-nil, show the version in mini-buffer. + +This function is mainly intended to find the version of a major +or minor mode, i.e. + + (pkg-info-defining-library-version 'flycheck-mode) + +Return the version of the library defining FUNCTION. Signal an +error if FUNCTION is not a valid function, if its defining +library was not found, or if the library had no proper version +header." + (interactive (list (pkg-info--read-function) t)) + (pkg-info-library-original-version (pkg-info-defining-library function) show)) + +;;;###autoload +(defun pkg-info-defining-library-version (function &optional show) + "Get the version of the library defining FUNCTION. + +If SHOW is non-nil, show the version in mini-buffer. + +This function is mainly intended to find the version of a major +or minor mode, i.e. + + (pkg-info-defining-library-version 'flycheck-mode) + +Return the version of the library defining FUNCTION. Signal an +error if FUNCTION is not a valid function, if its defining +library was not found, or if the library had no proper version +header." + (interactive (list (pkg-info--read-function) t)) + (pkg-info-library-version (pkg-info-defining-library function) show)) + +;;;###autoload +(defun pkg-info-package-version (package &optional show) + "Get the version of an installed PACKAGE. + +If SHOW is non-nil, show the version in the minibuffer. + +Return the version as list, or nil if PACKAGE is not installed." + (interactive (list (pkg-info--read-package) t)) + (let* ((name (if (stringp package) (intern package) package)) + (package (car (epl-find-installed-packages name)))) + (unless package + (error "Can't find installed package %s" name)) + (pkg-info--show-version-and-return (epl-package-version package) show))) + +;;;###autoload +(defun pkg-info-version-info (library &optional package show) + "Obtain complete version info for LIBRARY and PACKAGE. + +LIBRARY is a symbol denoting a named feature, or a library name +as string. PACKAGE is a symbol denoting an ELPA package. If +omitted or nil, default to LIBRARY. + +If SHOW is non-nil, show the version in the minibuffer. + +When called interactively, prompt for LIBRARY. When called +interactively with prefix argument, prompt for PACKAGE as well. + +Return a string with complete version information for LIBRARY. +This version information contains the version from the headers of +LIBRARY, and the version of the installed PACKAGE, the LIBRARY is +part of. If PACKAGE is not installed, or if the PACKAGE version +is the same as the LIBRARY version, do not include a package +version." + (interactive (list (pkg-info--read-library) + (when current-prefix-arg + (pkg-info--read-package)) + t)) + (let* ((package (or package (if (stringp library) (intern library) library))) + (orig-version (condition-case nil + (pkg-info-library-original-version library) + (error nil))) + ;; If we have X-Original-Version, we assume that MELPA replaced the + ;; library version with its generated version, so we use the + ;; X-Original-Version header instead, and ignore the library version + ;; header + (lib-version (or orig-version (pkg-info-library-version library))) + (pkg-version (condition-case nil + (pkg-info-package-version package) + (error nil))) + (version (if (and pkg-version + (not (version-list-= lib-version pkg-version))) + (format "%s (package: %s)" + (pkg-info-format-version lib-version) + (pkg-info-format-version pkg-version)) + (pkg-info-format-version lib-version)))) + (pkg-info--show-version-and-return version show))) + +(defconst pkg-info-melpa-recipe-url "http://melpa.org/recipes.json" + "The URL from which to fetch MELPA recipes.") + +(defvar pkg-info-melpa-recipes nil + "An alist of MELPA recipes.") + +(defun pkg-info-retrieve-melpa-recipes () + "Retrieve MELPA recipes from MELPA archive." + (let ((buffer (url-retrieve-synchronously pkg-info-melpa-recipe-url))) + (with-current-buffer buffer + (unwind-protect + (let ((response-code (url-http-parse-response))) + (unless (equal response-code 200) + (error "Failed to retrieve MELPA recipes from %s (code %s)" + pkg-info-melpa-recipe-url response-code)) + (goto-char url-http-end-of-headers) + (json-read)) + (when (and buffer (buffer-live-p buffer)) + (kill-buffer buffer)))))) + +(defun pkg-info-get-melpa-recipes () + "Get MELPA recipes." + (setq pkg-info-melpa-recipes + (or pkg-info-melpa-recipes + (pkg-info-retrieve-melpa-recipes)))) + +(defun pkg-info-get-melpa-recipe (package) + "Get the MELPA recipe for PACKAGE. + +Return nil if PACKAGE is not on MELPA." + (cdr (assq package (pkg-info-get-melpa-recipes)))) + +(defun pkg-info-get-melpa-fetcher (package) + "Get the MELPA fetcher for PACKAGE." + (cdr (assq 'fetcher (pkg-info-get-melpa-recipe package)))) + +(defun pkg-info-wiki-package-p (package) + "Determine whether PACKAGE is build from the EmacsWiki." + (equal (pkg-info-get-melpa-fetcher package) "wiki")) + +(provide 'pkg-info) + +;; Local Variables: +;; indent-tabs-mode: nil +;; coding: utf-8 +;; End: + +;;; pkg-info.el ends here diff --git a/elpa/pos-tip-20150318.813/pos-tip-autoloads.el b/elpa/pos-tip-20150318.813/pos-tip-autoloads.el new file mode 100644 index 0000000..fecedac --- /dev/null +++ b/elpa/pos-tip-20150318.813/pos-tip-autoloads.el @@ -0,0 +1,15 @@ +;;; pos-tip-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil nil ("pos-tip.el") (22297 53347 971569 117000)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; pos-tip-autoloads.el ends here diff --git a/elpa/pos-tip-20150318.813/pos-tip-pkg.el b/elpa/pos-tip-20150318.813/pos-tip-pkg.el new file mode 100644 index 0000000..d3536ea --- /dev/null +++ b/elpa/pos-tip-20150318.813/pos-tip-pkg.el @@ -0,0 +1 @@ +(define-package "pos-tip" "20150318.813" "Show tooltip at point" 'nil :keywords '("tooltip")) diff --git a/elpa/pos-tip-20150318.813/pos-tip.el b/elpa/pos-tip-20150318.813/pos-tip.el new file mode 100644 index 0000000..62d8c70 --- /dev/null +++ b/elpa/pos-tip-20150318.813/pos-tip.el @@ -0,0 +1,980 @@ +;;; pos-tip.el --- Show tooltip at point -*- coding: utf-8 -*- + +;; Copyright (C) 2010 S. Irie + +;; Author: S. Irie +;; Maintainer: S. Irie +;; Keywords: Tooltip +;; Package-Version: 20150318.813 + +(defconst pos-tip-version "0.4.6") + +;; 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 2, or +;; (at your option) any later version. + +;; It 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, write to the Free +;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, +;; MA 02110-1301 USA + +;;; Commentary: + +;; The standard library tooltip.el provides the function for displaying +;; a tooltip at mouse position which allows users to easily show it. +;; However, locating tooltip at arbitrary buffer position in window +;; is not easy. This program provides such function to be used by other +;; frontend programs. + +;; This program is tested on GNU Emacs 22, 23 under X window system and +;; Emacs 23 for MS-Windows. + +;; +;; Installation: +;; +;; First, save this file as pos-tip.el and byte-compile in +;; a directory that is listed in load-path. +;; +;; Put the following in your .emacs file: +;; +;; (require 'pos-tip) +;; +;; To use the full features of this program on MS-Windows, +;; put the additional setting in .emacs file: +;; +;; (pos-tip-w32-max-width-height) ; Maximize frame temporarily +;; +;; or +;; +;; (pos-tip-w32-max-width-height t) ; Keep frame maximized + +;; +;; Examples: +;; +;; We can display a tooltip at the current position by the following: +;; +;; (pos-tip-show "foo bar") +;; +;; If you'd like to specify the tooltip color, use an expression as: +;; +;; (pos-tip-show "foo bar" '("white" . "red")) +;; +;; Here, "white" and "red" are the foreground color and background +;; color, respectively. + + +;;; History: +;; 2013-07-16 P. Kalinowski +;; * Adjusted `pos-tip-show' to correctly set tooltip text foreground +;; color when using custom color themes. +;; * Version 0.4.6 +;; +;; 2010-09-27 S. Irie +;; * Simplified implementation of `pos-tip-window-system' +;; * Version 0.4.5 +;; +;; 2010-08-20 S. Irie +;; * Changed to use `window-line-height' to calculate tooltip position +;; * Changed `pos-tip-string-width-height' to ignore last empty line +;; * Version 0.4.4 +;; +;; 2010-07-25 S. Irie +;; * Bug fix +;; * Version 0.4.3 +;; +;; 2010-06-09 S. Irie +;; * Bug fix +;; * Version 0.4.2 +;; +;; 2010-06-04 S. Irie +;; * Added support for text-scale-mode +;; * Version 0.4.1 +;; +;; 2010-05-04 S. Irie +;; * Added functions: +;; `pos-tip-x-display-width', `pos-tip-x-display-height' +;; `pos-tip-normalize-natnum', `pos-tip-frame-relative-position' +;; * Fixed the supports for multi-displays and multi-frames +;; * Version 0.4.0 +;; +;; 2010-04-29 S. Irie +;; * Modified to avoid byte-compile warning +;; * Bug fix +;; * Version 0.3.6 +;; +;; 2010-04-29 S. Irie +;; * Renamed argument MAX-HEIGHT of `pos-tip-fill-string' to MAX-ROWS +;; * Modified old FSF address +;; * Version 0.3.5 +;; +;; 2010-04-29 S. Irie +;; * Modified `pos-tip-show' to truncate string exceeding display size +;; * Added function `pos-tip-truncate-string' +;; * Added optional argument MAX-ROWS to `pos-tip-split-string' +;; * Added optional argument MAX-HEIGHT to `pos-tip-fill-string' +;; * Version 0.3.4 +;; +;; 2010-04-16 S. Irie +;; * Changed `pos-tip-show' not to fill paragraph unless exceeding WIDTH +;; * Version 0.3.3 +;; +;; 2010-04-08 S. Irie +;; * Bug fix +;; * Version 0.3.2 +;; +;; 2010-03-31 S. Irie +;; * Bug fix +;; * Version 0.3.1 +;; +;; 2010-03-30 S. Irie +;; * Added support for MS-Windows +;; * Added option `pos-tip-use-relative-coordinates' +;; * Bug fixes +;; * Version 0.3.0 +;; +;; 2010-03-23 S. Irie +;; * Changed argument WORD-WRAP to JUSTIFY +;; * Added optional argument SQUEEZE +;; * Added function `pos-tip-fill-string' +;; * Added option `pos-tip-tab-width' used to expand tab characters +;; * Bug fixes +;; * Version 0.2.0 +;; +;; 2010-03-22 S. Irie +;; * Added optional argument WORD-WRAP to `pos-tip-split-string' +;; * Changed `pos-tip-show' to perform word wrap or kinsoku shori +;; * Version 0.1.8 +;; +;; 2010-03-20 S. Irie +;; * Added optional argument DY +;; * Bug fix +;; * Modified docstrings +;; * Version 0.1.7 +;; +;; 2010-03-18 S. Irie +;; * Added/modifed docstrings +;; * Changed working buffer name to " *xwininfo*" +;; * Version 0.1.6 +;; +;; 2010-03-17 S. Irie +;; * Fixed typos in docstrings +;; * Version 0.1.5 +;; +;; 2010-03-16 S. Irie +;; * Added support for multi-display environment +;; * Bug fix +;; * Version 0.1.4 +;; +;; 2010-03-16 S. Irie +;; * Bug fix +;; * Changed calculation for `x-max-tooltip-size' +;; * Modified docstring +;; * Version 0.1.3 +;; +;; 2010-03-11 S. Irie +;; * Modified commentary +;; * Version 0.1.2 +;; +;; 2010-03-11 S. Irie +;; * Re-implemented `pos-tip-string-width-height' +;; * Added indicator variable `pos-tip-upperside-p' +;; * Version 0.1.1 +;; +;; 2010-03-09 S. Irie +;; * Re-implemented `pos-tip-show' (*incompatibly changed*) +;; - Use frame default font +;; - Automatically calculate tooltip pixel size +;; - Added optional arguments: TIP-COLOR, MAX-WIDTH +;; * Added utility functions: +;; `pos-tip-split-string', `pos-tip-string-width-height' +;; * Bug fixes +;; * Version 0.1.0 +;; +;; 2010-03-08 S. Irie +;; * Added optional argument DX +;; * Version 0.0.4 +;; +;; 2010-03-08 S. Irie +;; * Bug fix +;; * Version 0.0.3 +;; +;; 2010-03-08 S. Irie +;; * Modified to move out mouse pointer +;; * Version 0.0.2 +;; +;; 2010-03-07 S. Irie +;; * First release +;; * Version 0.0.1 + +;; ToDo: + +;;; Code: +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Settings +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defgroup pos-tip nil + "Show tooltip at point" + :group 'faces + :prefix "pos-tip-") + +(defcustom pos-tip-border-width 1 + "Outer border width of pos-tip's tooltip." + :type 'integer + :group 'pos-tip) + +(defcustom pos-tip-internal-border-width 2 + "Text margin of pos-tip's tooltip." + :type 'integer + :group 'pos-tip) + +(defcustom pos-tip-foreground-color nil + "Default foreground color of pos-tip's tooltip. +When `nil', look up the foreground color of the `tooltip' face." + :type '(choice (const :tag "Default" nil) + string) + :group 'pos-tip) + +(defcustom pos-tip-background-color nil + "Default background color of pos-tip's tooltip. +When `nil', look up the background color of the `tooltip' face." + :type '(choice (const :tag "Default" nil) + string) + :group 'pos-tip) + +(defcustom pos-tip-tab-width nil + "Tab width used for `pos-tip-split-string' and `pos-tip-fill-string' +to expand tab characters. nil means use default value of `tab-width'." + :type '(choice (const :tag "Default" nil) + integer) + :group 'pos-tip) + +(defcustom pos-tip-use-relative-coordinates nil + "Non-nil means tooltip location is calculated as a coordinates +relative to the top left corner of frame. In this case the tooltip +will always be displayed within the frame. + +Note that this variable is automatically set to non-nil if absolute +coordinates can't be obtained by `pos-tip-compute-pixel-position'." + :type 'boolean + :group 'pos-tip) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun pos-tip-window-system (&optional frame) + "The name of the window system that FRAME is displaying through. +The value is a symbol---for instance, 'x' for X windows. +The value is nil if Emacs is using a text-only terminal. + +FRAME defaults to the currently selected frame." + (let ((type (framep (or frame (selected-frame))))) + (if type + (and (not (eq type t)) + type) + (signal 'wrong-type-argument (list 'framep frame))))) + +(defun pos-tip-normalize-natnum (object &optional n) + "Return a Nth power of 2 if OBJECT is a positive integer. +Otherwise return 0. Omitting N means return 1 for a positive integer." + (ash (if (and (natnump object) (> object 0)) 1 0) + (or n 0))) + +(defvar pos-tip-saved-frame-coordinates '(0 . 0) + "The latest result of `pos-tip-frame-top-left-coordinates'.") + +(defvar pos-tip-frame-offset nil + "The latest result of `pos-tip-calibrate-frame-offset'. This value +is used for non-X graphical environment.") + +(defvar pos-tip-frame-offset-array [nil nil nil nil] + "Array of the results of `pos-tip-calibrate-frame-offset'. They are +recorded only when `pos-tip-frame-top-left-coordinates' is called for a +non-X but graphical frame. + +The 2nd and 4th elements are the values for frames having a menu bar. +The 3rd and 4th elements are the values for frames having a tool bar.") + +(defun pos-tip-frame-top-left-coordinates (&optional frame) + "Return the pixel coordinates of FRAME as a cons cell (LEFT . TOP), +which are relative to top left corner of screen. + +Return nil if failing to acquire the coordinates. + +If FRAME is omitted, use selected-frame. + +Users can also get the frame coordinates by referring the variable +`pos-tip-saved-frame-coordinates' just after calling this function." + (let ((winsys (pos-tip-window-system frame))) + (cond + ((null winsys) + (error "text-only frame: %S" frame)) + ((eq winsys 'x) + (condition-case nil + (with-current-buffer (get-buffer-create " *xwininfo*") + (let ((case-fold-search nil)) + (buffer-disable-undo) + (erase-buffer) + (call-process shell-file-name nil t nil shell-command-switch + (format "xwininfo -display %s -id %s" + (frame-parameter frame 'display) + (frame-parameter frame 'window-id))) + (goto-char (point-min)) + (search-forward "\n Absolute") + (setq pos-tip-saved-frame-coordinates + (cons (string-to-number (buffer-substring-no-properties + (search-forward "X: ") + (line-end-position))) + (string-to-number (buffer-substring-no-properties + (search-forward "Y: ") + (line-end-position))))))) + (error nil))) + (t + (let* ((index (+ (pos-tip-normalize-natnum + (frame-parameter frame 'menu-bar-lines) 0) + (pos-tip-normalize-natnum + (frame-parameter frame 'tool-bar-lines) 1))) + (offset (or (aref pos-tip-frame-offset-array index) + (aset pos-tip-frame-offset-array index + (pos-tip-calibrate-frame-offset frame))))) + (if offset + (setq pos-tip-saved-frame-coordinates + (cons (+ (eval (frame-parameter frame 'left)) + (car offset)) + (+ (eval (frame-parameter frame 'top)) + (cdr offset)))))))))) + +(defun pos-tip-frame-relative-position + (frame1 frame2 &optional w32-frame frame-coord1 frame-coord2) + "Return the pixel coordinates of FRAME1 relative to FRAME2 +as a cons cell (LEFT . TOP). + +W32-FRAME non-nil means both of frames are under `w32' window system. + +FRAME-COORD1 and FRAME-COORD2, if given, specify the absolute +coordinates of FRAME1 and FRAME2, respectively, which make the +calculations faster if the frames have different heights of menu bars +and tool bars." + (if (and (eq (pos-tip-normalize-natnum + (frame-parameter frame1 'menu-bar-lines)) + (pos-tip-normalize-natnum + (frame-parameter frame2 'menu-bar-lines))) + (or w32-frame + (eq (pos-tip-normalize-natnum + (frame-parameter frame1 'tool-bar-lines)) + (pos-tip-normalize-natnum + (frame-parameter frame2 'tool-bar-lines))))) + (cons (- (eval (frame-parameter frame1 'left)) + (eval (frame-parameter frame2 'left))) + (- (eval (frame-parameter frame1 'top)) + (eval (frame-parameter frame2 'top)))) + (unless frame-coord1 + (setq frame-coord1 (let (pos-tip-saved-frame-coordinates) + (pos-tip-frame-top-left-coordinates frame1)))) + (unless frame-coord2 + (setq frame-coord2 (let (pos-tip-saved-frame-coordinates) + (pos-tip-frame-top-left-coordinates frame2)))) + (cons (- (car frame-coord1) (car frame-coord2)) + (- (cdr frame-coord1) (cdr frame-coord2))))) + +(defvar pos-tip-upperside-p nil + "Non-nil indicates the latest result of `pos-tip-compute-pixel-position' +was upper than the location specified by the arguments.") + +(defvar pos-tip-w32-saved-max-width-height nil + "Display pixel size effective for showing tooltip in MS-Windows desktop. +This doesn't include the taskbar area, so isn't same as actual display size.") + +(defun pos-tip-compute-pixel-position + (&optional pos window pixel-width pixel-height frame-coordinates dx dy) + "Return pixel position of POS in WINDOW like (X . Y), which indicates +the absolute or relative coordinates of bottom left corner of the object. + +Omitting POS and WINDOW means use current position and selected window, +respectively. + +If PIXEL-WIDTH and PIXEL-HEIGHT are given, this function assumes these +values as the size of small window like tooltip which is located around the +object at POS. These values are used to adjust the location in order that +the tooltip won't disappear by sticking out of the display. By referring +the variable `pos-tip-upperside-p' after calling this function, user can +examine whether the tooltip will be located above the specified position. + +If FRAME-COORDINATES is omitted or nil, automatically obtain the absolute +coordinates of the top left corner of frame which WINDOW is on. Here, +`top left corner of frame' represents the origin of `window-pixel-edges' +and its coordinates are essential for calculating the return value as +absolute coordinates. If a cons cell like (LEFT . TOP), specifies the +frame absolute location and makes the calculation slightly faster, but can +be used only when it's clear that frame is in the specified position. Users +can get the latest values of frame coordinates for using in the next call +by referring the variable `pos-tip-saved-frame-coordinates' just after +calling this function. Otherwise, FRAME-COORDINATES `relative' means return +pixel coordinates of the object relative to the top left corner of the frame. +This is the same effect as `pos-tip-use-relative-coordinates' is non-nil. + +DX specifies horizontal offset in pixel. + +DY specifies vertical offset in pixel. This makes the calculations done +without considering the height of object at POS, so the object might be +hidden by the tooltip." + (let* ((frame (window-frame (or window (selected-window)))) + (w32-frame (eq (pos-tip-window-system frame) 'w32)) + (relative (or pos-tip-use-relative-coordinates + (eq frame-coordinates 'relative) + (and w32-frame + (null pos-tip-w32-saved-max-width-height)))) + (frame-coord (or (and relative '(0 . 0)) + frame-coordinates + (pos-tip-frame-top-left-coordinates frame) + (progn + (setq relative t + pos-tip-use-relative-coordinates t) + '(0 . 0)))) + (posn (posn-at-point (or pos (window-point window)) window)) + (line (cdr (posn-actual-col-row posn))) + (line-height (and line + (or (window-line-height line window) + (and (redisplay t) + (window-line-height line window))))) + (x-y (or (posn-x-y posn) + (let ((geom (pos-visible-in-window-p + (or pos (window-point window)) window t))) + (and geom (cons (car geom) (cadr geom)))) + '(0 . 0))) + (x (+ (car frame-coord) + (car (window-inside-pixel-edges window)) + (car x-y) + (or dx 0))) + (y0 (+ (cdr frame-coord) + (cadr (window-pixel-edges window)) + (or (nth 2 line-height) (cdr x-y)))) + (y (+ y0 + (or dy + (car line-height) + (with-current-buffer (window-buffer window) + (cond + ;; `posn-object-width-height' returns an incorrect value + ;; when the header line is displayed (Emacs bug #4426). + ((and posn + (null header-line-format)) + (cdr (posn-object-width-height posn))) + ((and (bound-and-true-p text-scale-mode) + (not (zerop (with-no-warnings + text-scale-mode-amount)))) + (round (* (frame-char-height frame) + (with-no-warnings + (expt text-scale-mode-step + text-scale-mode-amount))))) + (t + (frame-char-height frame))))))) + xmax ymax) + (cond + (relative + (setq xmax (frame-pixel-width frame) + ymax (frame-pixel-height frame))) + (w32-frame + (setq xmax (car pos-tip-w32-saved-max-width-height) + ymax (cdr pos-tip-w32-saved-max-width-height))) + (t + (setq xmax (x-display-pixel-width frame) + ymax (x-display-pixel-height frame)))) + (setq pos-tip-upperside-p (> (+ y (or pixel-height 0)) + ymax)) + (cons (max 0 (min x (- xmax (or pixel-width 0)))) + (max 0 (if pos-tip-upperside-p + (- (if dy ymax y0) (or pixel-height 0)) + y))))) + +(defun pos-tip-cancel-timer () + "Cancel timeout of tooltip." + (mapc (lambda (timer) + (if (eq (aref timer 5) 'x-hide-tip) + (cancel-timer timer))) + timer-list)) + +(defun pos-tip-avoid-mouse (left right top bottom &optional frame) + "Move out mouse pointer if it is inside region (LEFT RIGHT TOP BOTTOM) +in FRAME. Return new mouse position like (FRAME . (X . Y))." + (unless frame + (setq frame (selected-frame))) + (let* ((mpos (with-selected-window (frame-selected-window frame) + (mouse-pixel-position))) + (mframe (pop mpos)) + (mx (car mpos)) + (my (cdr mpos))) + (when (and (eq mframe frame) + (numberp mx)) + (let* ((large-number (+ (frame-pixel-width frame) (frame-pixel-height frame))) + (dl (if (> left 2) + (1+ (- mx left)) + large-number)) + (dr (if (< (1+ right) (frame-pixel-width frame)) + (- right mx) + large-number)) + (dt (if (> top 2) + (1+ (- my top)) + large-number)) + (db (if (< (1+ bottom) (frame-pixel-height frame)) + (- bottom my) + large-number)) + (d (min dl dr dt db))) + (when (> d -2) + (cond + ((= d dl) + (setq mx (- left 2))) + ((= d dr) + (setq mx (1+ right))) + ((= d dt) + (setq my (- top 2))) + (t + (setq my (1+ bottom)))) + (set-mouse-pixel-position frame mx my) + (sit-for 0.0001)))) + (cons mframe (and mpos (cons mx my))))) + +(defun pos-tip-compute-foreground-color (tip-color) + "Compute the foreground color to use for tooltip. + +TIP-COLOR is a face or a cons cell like (FOREGROUND-COLOR . BACKGROUND-COLOR). +If it is nil, use `pos-tip-foreground-color' or the foreground color of the +`tooltip' face." + (or (and (facep tip-color) + (face-attribute tip-color :foreground)) + (car-safe tip-color) + pos-tip-foreground-color + (face-foreground 'tooltip))) + +(defun pos-tip-compute-background-color (tip-color) + "Compute the background color to use for tooltip. + +TIP-COLOR is a face or a cons cell like (FOREGROUND-COLOR . BACKGROUND-COLOR). +If it is nil, use `pos-tip-background-color' or the background color of the +`tooltip' face." + (or (and (facep tip-color) + (face-attribute tip-color :background)) + (cdr-safe tip-color) + pos-tip-background-color + (face-background 'tooltip))) + +(defun pos-tip-show-no-propertize + (string &optional tip-color pos window timeout pixel-width pixel-height frame-coordinates dx dy) + "Show STRING in a tooltip at POS in WINDOW. +Analogous to `pos-tip-show' except don't propertize STRING by `pos-tip' face. + +PIXEL-WIDTH and PIXEL-HEIGHT specify the size of tooltip, if given. These +are used to adjust the tooltip position in order that it doesn't disappear by +sticking out of the display, and also used to prevent it from vanishing by +overlapping with mouse pointer. + +Note that this function itself doesn't calculate tooltip size because the +character width and height specified by faces are unknown. So users should +calculate PIXEL-WIDTH and PIXEL-HEIGHT by using `pos-tip-tooltip-width' and +`pos-tip-tooltip-height', or use `pos-tip-show' instead, which can +automatically calculate tooltip size. + +See `pos-tip-show' for details. + +Example: + +\(defface my-tooltip + '((t + :background \"gray85\" + :foreground \"black\" + :inherit variable-pitch)) + \"Face for my tooltip.\") + +\(defface my-tooltip-highlight + '((t + :background \"blue\" + :foreground \"white\" + :inherit my-tooltip)) + \"Face for my tooltip highlighted.\") + +\(let ((str (propertize \" foo \\n bar \\n baz \" 'face 'my-tooltip))) + (put-text-property 6 11 'face 'my-tooltip-highlight str) + (pos-tip-show-no-propertize str 'my-tooltip))" + (unless window + (setq window (selected-window))) + (let* ((frame (window-frame window)) + (winsys (pos-tip-window-system frame)) + (x-frame (eq winsys 'x)) + (w32-frame (eq winsys 'w32)) + (relative (or pos-tip-use-relative-coordinates + (eq frame-coordinates 'relative) + (and w32-frame + (null pos-tip-w32-saved-max-width-height)))) + (x-y (prog1 + (pos-tip-compute-pixel-position pos window + pixel-width pixel-height + frame-coordinates dx dy) + (if pos-tip-use-relative-coordinates + (setq relative t)))) + (ax (car x-y)) + (ay (cdr x-y)) + (rx (if relative ax (- ax (car pos-tip-saved-frame-coordinates)))) + (ry (if relative ay (- ay (cdr pos-tip-saved-frame-coordinates)))) + (retval (cons rx ry)) + (fg (pos-tip-compute-foreground-color tip-color)) + (bg (pos-tip-compute-background-color tip-color)) + (use-dxdy (or relative + (not x-frame))) + (spacing (frame-parameter frame 'line-spacing)) + (border (ash (+ pos-tip-border-width + pos-tip-internal-border-width) + 1)) + (x-max-tooltip-size + (cons (+ (if x-frame 1 0) + (/ (- (or pixel-width + (cond + (relative + (frame-pixel-width frame)) + (w32-frame + (car pos-tip-w32-saved-max-width-height)) + (t + (x-display-pixel-width frame)))) + border) + (frame-char-width frame))) + (/ (- (or pixel-height + (x-display-pixel-height frame)) + border) + (frame-char-height frame)))) + (mpos (with-selected-window window (mouse-pixel-position))) + (mframe (car mpos)) + default-frame-alist) + (if (or relative + (and use-dxdy + (null (cadr mpos)))) + (unless (and (cadr mpos) + (eq mframe frame)) + (let* ((edges (window-inside-pixel-edges (cadr (window-list frame)))) + (mx (ash (+ (pop edges) (cadr edges)) -1)) + (my (ash (+ (pop edges) (cadr edges)) -1))) + (setq mframe frame) + (set-mouse-pixel-position mframe mx my) + (sit-for 0.0001))) + (when (and (cadr mpos) + (not (eq mframe frame))) + (let ((rel-coord (pos-tip-frame-relative-position frame mframe w32-frame + frame-coordinates))) + (setq rx (+ rx (car rel-coord)) + ry (+ ry (cdr rel-coord)))))) + (and pixel-width pixel-height + (setq mpos (pos-tip-avoid-mouse rx (+ rx pixel-width + (if w32-frame 3 0)) + ry (+ ry pixel-height) + mframe))) + (x-show-tip string mframe + `((border-width . ,pos-tip-border-width) + (internal-border-width . ,pos-tip-internal-border-width) + ,@(and (not use-dxdy) `((left . ,ax) + (top . ,ay))) + (font . ,(frame-parameter frame 'font)) + ,@(and spacing `((line-spacing . ,spacing))) + ,@(and (stringp fg) `((foreground-color . ,fg))) + ,@(and (stringp bg) `((background-color . ,bg)))) + (and timeout (> timeout 0) timeout) + (and use-dxdy (- rx (cadr mpos))) + (and use-dxdy (- ry (cddr mpos)))) + (if (and timeout (<= timeout 0)) + (pos-tip-cancel-timer)) + retval)) + +(defun pos-tip-split-string (string &optional width margin justify squeeze max-rows) + "Split STRING into fixed width strings. Return a list of these strings. + +WIDTH specifies the width of filling each paragraph. WIDTH nil means use +the width of currently selected frame. Note that this function doesn't add any +padding characters at the end of each row. + +MARGIN, if non-nil, specifies left margin width which is the number of spece +characters to add at the beginning of each row. + +The optional fourth argument JUSTIFY specifies which kind of justification +to do: `full', `left', `right', `center', or `none'. A value of t means handle +each paragraph as specified by its text properties. Omitting JUSTIFY means +don't perform justification, word wrap and kinsoku shori (禁則処理). + +SQUEEZE nil means leave whitespaces other than line breaks untouched. + +MAX-ROWS, if given, specifies maximum number of elements of return value. +The elements exceeding this number are discarded." + (with-temp-buffer + (let* ((tab-width (or pos-tip-tab-width tab-width)) + (fill-column (or width (frame-width))) + (left-margin (or margin 0)) + (kinsoku-limit 1) + indent-tabs-mode + row rows) + (insert string) + (untabify (point-min) (point-max)) + (if justify + (fill-region (point-min) (point-max) justify (not squeeze)) + (setq margin (make-string left-margin ?\s))) + (goto-char (point-min)) + (while (prog2 + (let ((line (buffer-substring + (point) (progn (end-of-line) (point))))) + (if justify + (push line rows) + (while (progn + (setq line (concat margin line) + row (truncate-string-to-width line fill-column)) + (push row rows) + (if (not (= (length row) (length line))) + (setq line (substring line (length row)))))))) + (< (point) (point-max)) + (beginning-of-line 2))) + (nreverse (if max-rows + (last rows max-rows) + rows))))) + +(defun pos-tip-fill-string (string &optional width margin justify squeeze max-rows) + "Fill each of the paragraphs in STRING. + +WIDTH specifies the width of filling each paragraph. WIDTH nil means use +the width of currently selected frame. Note that this function doesn't add any +padding characters at the end of each row. + +MARGIN, if non-nil, specifies left margin width which is the number of spece +characters to add at the beginning of each row. + +The optional fourth argument JUSTIFY specifies which kind of justification +to do: `full', `left', `right', `center', or `none'. A value of t means handle +each paragraph as specified by its text properties. Omitting JUSTIFY means +don't perform justification, word wrap and kinsoku shori (禁則処理). + +SQUEEZE nil means leave whitespaces other than line breaks untouched. + +MAX-ROWS, if given, specifies maximum number of rows. The rows exceeding +this number are discarded." + (if justify + (with-temp-buffer + (let* ((tab-width (or pos-tip-tab-width tab-width)) + (fill-column (or width (frame-width))) + (left-margin (or margin 0)) + (kinsoku-limit 1) + indent-tabs-mode) + (insert string) + (untabify (point-min) (point-max)) + (fill-region (point-min) (point-max) justify (not squeeze)) + (if max-rows + (buffer-substring (goto-char (point-min)) + (line-end-position max-rows)) + (buffer-string)))) + (mapconcat 'identity + (pos-tip-split-string string width margin nil nil max-rows) + "\n"))) + +(defun pos-tip-truncate-string (string width height) + "Truncate each line of STRING to WIDTH and discard lines exceeding HEIGHT." + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (let ((nrow 0) + rows) + (while (and (< nrow height) + (prog2 + (push (truncate-string-to-width + (buffer-substring (point) (progn (end-of-line) (point))) + width) + rows) + (< (point) (point-max)) + (beginning-of-line 2) + (setq nrow (1+ nrow))))) + (mapconcat 'identity (nreverse rows) "\n")))) + +(defun pos-tip-string-width-height (string) + "Count columns and rows of STRING. Return a cons cell like (WIDTH . HEIGHT). +The last empty line of STRING is ignored. + +Example: + +\(pos-tip-string-width-height \"abc\\nあいう\\n123\") +;; => (6 . 3)" + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (end-of-line) + (let ((width (current-column)) + (height (if (eq (char-before (point-max)) ?\n) 0 1))) + (while (< (point) (point-max)) + (end-of-line 2) + (setq width (max (current-column) width) + height (1+ height))) + (cons width height)))) + +(defun pos-tip-x-display-width (&optional frame) + "Return maximum column number in tooltip which occupies the full width +of display. Omitting FRAME means use display that selected frame is in." + (1+ (/ (x-display-pixel-width frame) (frame-char-width frame)))) + +(defun pos-tip-x-display-height (&optional frame) + "Return maximum row number in tooltip which occupies the full height +of display. Omitting FRAME means use display that selected frame is in." + (1+ (/ (x-display-pixel-height frame) (frame-char-height frame)))) + +(defun pos-tip-tooltip-width (width char-width) + "Calculate tooltip pixel width." + (+ (* width char-width) + (ash (+ pos-tip-border-width + pos-tip-internal-border-width) + 1))) + +(defun pos-tip-tooltip-height (height char-height &optional frame) + "Calculate tooltip pixel height." + (let ((spacing (or (default-value 'line-spacing) + (frame-parameter frame 'line-spacing)))) + (+ (* height (+ char-height + (cond + ((integerp spacing) + spacing) + ((floatp spacing) + (truncate (* (frame-char-height frame) + spacing))) + (t 0)))) + (ash (+ pos-tip-border-width + pos-tip-internal-border-width) + 1)))) + +(defun pos-tip-show + (string &optional tip-color pos window timeout width frame-coordinates dx dy) + "Show STRING in a tooltip, which is a small X window, at POS in WINDOW +using frame's default font with TIP-COLOR. + +Return pixel position of tooltip relative to top left corner of frame as +a cons cell like (X . Y). + +TIP-COLOR is a face or a cons cell like (FOREGROUND-COLOR . BACKGROUND-COLOR) +used to specify *only* foreground-color and background-color of tooltip. If +omitted, use `pos-tip-foreground-color' and `pos-tip-background-color' or the +foreground and background color of the `tooltip' face instead. + +Omitting POS and WINDOW means use current position and selected window, +respectively. + +Automatically hide the tooltip after TIMEOUT seconds. Omitting TIMEOUT means +use the default timeout of 5 seconds. Non-positive TIMEOUT means don't hide +tooltip automatically. + +WIDTH, if non-nil, specifies the width of filling each paragraph. + +If FRAME-COORDINATES is omitted or nil, automatically obtain the absolute +coordinates of the top left corner of frame which WINDOW is on. Here, +`top left corner of frame' represents the origin of `window-pixel-edges' +and its coordinates are essential for calculating the absolute coordinates +of the tooltip. If a cons cell like (LEFT . TOP), specifies the frame +absolute location and makes the calculation slightly faster, but can be +used only when it's clear that frame is in the specified position. Users +can get the latest values of frame coordinates for using in the next call +by referring the variable `pos-tip-saved-frame-coordinates' just after +calling this function. Otherwise, FRAME-COORDINATES `relative' means use +the pixel coordinates relative to the top left corner of the frame for +displaying the tooltip. This is the same effect as +`pos-tip-use-relative-coordinates' is non-nil. + +DX specifies horizontal offset in pixel. + +DY specifies vertical offset in pixel. This makes the calculations done +without considering the height of object at POS, so the object might be +hidden by the tooltip. + +See also `pos-tip-show-no-propertize'." + (unless window + (setq window (selected-window))) + (let* ((frame (window-frame window)) + (max-width (pos-tip-x-display-width frame)) + (max-height (pos-tip-x-display-height frame)) + (w-h (pos-tip-string-width-height string)) + (fg (pos-tip-compute-foreground-color tip-color)) + (bg (pos-tip-compute-background-color tip-color)) + (frame-font (find-font (font-spec :name (frame-parameter frame 'font)))) + (tip-face-attrs (list :font frame-font :foreground fg :background bg))) + (cond + ((and width + (> (car w-h) width)) + (setq string (pos-tip-fill-string string width nil 'none nil max-height) + w-h (pos-tip-string-width-height string))) + ((or (> (car w-h) max-width) + (> (cdr w-h) max-height)) + (setq string (pos-tip-truncate-string string max-width max-height) + w-h (pos-tip-string-width-height string)))) + (pos-tip-show-no-propertize + (propertize string 'face tip-face-attrs) + tip-color pos window timeout + (pos-tip-tooltip-width (car w-h) (frame-char-width frame)) + (pos-tip-tooltip-height (cdr w-h) (frame-char-height frame) frame) + frame-coordinates dx dy))) + +(defalias 'pos-tip-hide 'x-hide-tip + "Hide pos-tip's tooltip.") + +(defun pos-tip-calibrate-frame-offset (&optional frame) + "Return coordinates of FRAME orign relative to the top left corner of +the FRAME extent, like (LEFT . TOP). The return value is recorded to +`pos-tip-frame-offset'. + +Note that this function does't correctly work for X frame and Emacs 22." + (setq pos-tip-frame-offset nil) + (let* ((window (frame-first-window frame)) + (delete-frame-functions + '((lambda (frame) + (if (equal (frame-parameter frame 'name) "tooltip") + (setq pos-tip-frame-offset + (cons (eval (frame-parameter frame 'left)) + (eval (frame-parameter frame 'top)))))))) + (pos-tip-border-width 0) + (pos-tip-internal-border-width 1) + (rpos (pos-tip-show "" + `(nil . ,(frame-parameter frame 'background-color)) + (window-start window) window + nil nil 'relative nil 0))) + (sit-for 0) + (pos-tip-hide) + (and pos-tip-frame-offset + (setq pos-tip-frame-offset + (cons (- (car pos-tip-frame-offset) + (car rpos) + (eval (frame-parameter frame 'left))) + (- (cdr pos-tip-frame-offset) + (cdr rpos) + (eval (frame-parameter frame 'top)))))))) + +(defun pos-tip-w32-max-width-height (&optional keep-maximize) + "Maximize the currently selected frame temporarily and set +`pos-tip-w32-saved-max-width-height' the effective display size in order +to become possible to calculate the absolute location of tooltip. + +KEEP-MAXIMIZE non-nil means leave the frame maximized. + +Note that this function is usable only in Emacs 23 for MS-Windows." + (interactive) + (unless (eq window-system 'w32) + (error "`pos-tip-w32-max-width-height' can be used only in w32 frame.")) + ;; Maximize frame + (with-no-warnings (w32-send-sys-command 61488)) + (sit-for 0) + (let ((offset (pos-tip-calibrate-frame-offset))) + (prog1 + (setq pos-tip-w32-saved-max-width-height + (cons (frame-pixel-width) + (+ (frame-pixel-height) + (- (cdr offset) (car offset))))) + (if (called-interactively-p 'interactive) + (message "%S" pos-tip-w32-saved-max-width-height)) + (unless keep-maximize + ;; Restore frame + (with-no-warnings (w32-send-sys-command 61728)))))) + + +(provide 'pos-tip) + +;;; +;;; pos-tip.el ends here diff --git a/elpa/projectile-20160420.1508/projectile-autoloads.el b/elpa/projectile-20160420.1508/projectile-autoloads.el new file mode 100644 index 0000000..33130e6 --- /dev/null +++ b/elpa/projectile-20160420.1508/projectile-autoloads.el @@ -0,0 +1,447 @@ +;;; projectile-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "projectile" "projectile.el" (22297 53344 702923 +;;;;;; 54000)) +;;; Generated autoloads from projectile.el + +(autoload 'projectile-version "projectile" "\ +Get the Projectile 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. + +\(fn &optional SHOW-VERSION)" t nil) + +(autoload 'projectile-invalidate-cache "projectile" "\ +Remove the current project's files from `projectile-projects-cache'. + +With a prefix argument ARG prompts for the name of the project whose cache +to invalidate. + +\(fn ARG)" t nil) + +(autoload 'projectile-purge-file-from-cache "projectile" "\ +Purge FILE from the cache of the current project. + +\(fn FILE)" t nil) + +(autoload 'projectile-purge-dir-from-cache "projectile" "\ +Purge DIR from the cache of the current project. + +\(fn DIR)" t nil) + +(autoload 'projectile-cache-current-file "projectile" "\ +Add the currently visited file to the cache. + +\(fn)" t nil) + +(autoload 'projectile-switch-to-buffer "projectile" "\ +Switch to a project buffer. + +\(fn)" t nil) + +(autoload 'projectile-switch-to-buffer-other-window "projectile" "\ +Switch to a project buffer and show it in another window. + +\(fn)" t nil) + +(autoload 'projectile-display-buffer "projectile" "\ +Display a project buffer in another window without selecting it. + +\(fn)" t nil) + +(autoload 'projectile-project-buffers-other-buffer "projectile" "\ +Switch to the most recently selected buffer project buffer. +Only buffers not visible in windows are returned. + +\(fn)" t nil) + +(autoload 'projectile-multi-occur "projectile" "\ +Do a `multi-occur' in the project's buffers. + +\(fn)" t nil) + +(autoload 'projectile-find-other-file "projectile" "\ +Switch between files with the same name but different extensions. +With FLEX-MATCHING, match any file that contains the base name of current file. +Other file extensions can be customized with the variable `projectile-other-file-alist'. + +\(fn &optional FLEX-MATCHING)" t nil) + +(autoload 'projectile-find-other-file-other-window "projectile" "\ +Switch between files with the same name but different extensions in other window. +With FLEX-MATCHING, match any file that contains the base name of current file. +Other file extensions can be customized with the variable `projectile-other-file-alist'. + +\(fn &optional FLEX-MATCHING)" t nil) + +(autoload 'projectile-find-file-dwim "projectile" "\ +Jump to a project's files using completion based on context. + +With a prefix ARG invalidates the cache first. + +If point is on a filename, Projectile first tries to search for that +file in project: + +- If it finds just a file, it switches to that file instantly. This works even +if the filename is incomplete, but there's only a single file in the current project +that matches the filename at point. For example, if there's only a single file named +\"projectile/projectile.el\" but the current filename is \"projectile/proj\" (incomplete), +`projectile-find-file' still switches to \"projectile/projectile.el\" immediately + because this is the only filename that matches. + +- If it finds a list of files, the list is displayed for selecting. A list of +files is displayed when a filename appears more than one in the project or the +filename at point is a prefix of more than two files in a project. For example, +if `projectile-find-file' is executed on a filepath like \"projectile/\", it lists +the content of that directory. If it is executed on a partial filename like + \"projectile/a\", a list of files with character 'a' in that directory is presented. + +- If it finds nothing, display a list of all files in project for selecting. + +\(fn &optional ARG)" t nil) + +(autoload 'projectile-find-file-dwim-other-window "projectile" "\ +Jump to a project's files using completion based on context in other window. + +With a prefix ARG invalidates the cache first. + +If point is on a filename, Projectile first tries to search for that +file in project: + +- If it finds just a file, it switches to that file instantly. This works even +if the filename is incomplete, but there's only a single file in the current project +that matches the filename at point. For example, if there's only a single file named +\"projectile/projectile.el\" but the current filename is \"projectile/proj\" (incomplete), +`projectile-find-file' still switches to \"projectile/projectile.el\" +immediately because this is the only filename that matches. + +- If it finds a list of files, the list is displayed for selecting. A list of +files is displayed when a filename appears more than one in the project or the +filename at point is a prefix of more than two files in a project. For example, +if `projectile-find-file' is executed on a filepath like \"projectile/\", it lists +the content of that directory. If it is executed on a partial filename +like \"projectile/a\", a list of files with character 'a' in that directory +is presented. + +- If it finds nothing, display a list of all files in project for selecting. + +\(fn &optional ARG)" t nil) + +(autoload 'projectile-find-file "projectile" "\ +Jump to a project's file using completion. +With a prefix ARG invalidates the cache first. + +\(fn &optional ARG)" t nil) + +(autoload 'projectile-find-file-other-window "projectile" "\ +Jump to a project's file using completion and show it in another window. + +With a prefix ARG invalidates the cache first. + +\(fn &optional ARG)" t nil) + +(autoload 'projectile-find-dir "projectile" "\ +Jump to a project's directory using completion. + +With a prefix ARG invalidates the cache first. + +\(fn &optional ARG)" t nil) + +(autoload 'projectile-find-dir-other-window "projectile" "\ +Jump to a project's directory in other window using completion. + +With a prefix ARG invalidates the cache first. + +\(fn &optional ARG)" t nil) + +(autoload 'projectile-find-test-file "projectile" "\ +Jump to a project's test file using completion. + +With a prefix ARG invalidates the cache first. + +\(fn &optional ARG)" t nil) + +(autoload 'projectile-project-info "projectile" "\ +Display info for current project. + +\(fn)" t nil) + +(autoload 'projectile-find-implementation-or-test-other-window "projectile" "\ +Open matching implementation or test file in other window. + +\(fn)" t nil) + +(autoload 'projectile-toggle-between-implementation-and-test "projectile" "\ +Toggle between an implementation file and its test file. + +\(fn)" t nil) + +(autoload 'projectile-grep "projectile" "\ +Perform rgrep in the project. + +With a prefix ARG asks for files (globbing-aware) which to grep in. +With prefix ARG of `-' (such as `M--'), default the files (without prompt), +to `projectile-grep-default-files'. + +With REGEXP given, don't query the user for a regexp. + +\(fn &optional REGEXP ARG)" t nil) + +(autoload 'projectile-ag "projectile" "\ +Run an ag search with SEARCH-TERM in the project. + +With an optional prefix argument ARG SEARCH-TERM is interpreted as a +regular expression. + +\(fn SEARCH-TERM &optional ARG)" t nil) + +(autoload 'projectile-regenerate-tags "projectile" "\ +Regenerate the project's [e|g]tags. + +\(fn)" t nil) + +(autoload 'projectile-find-tag "projectile" "\ +Find tag in project. + +\(fn)" t nil) + +(autoload 'projectile-run-command-in-root "projectile" "\ +Invoke `execute-extended-command' in the project's root. + +\(fn)" t nil) + +(autoload 'projectile-run-shell-command-in-root "projectile" "\ +Invoke `shell-command' in the project's root. + +\(fn)" t nil) + +(autoload 'projectile-run-async-shell-command-in-root "projectile" "\ +Invoke `async-shell-command' in the project's root. + +\(fn)" t nil) + +(autoload 'projectile-run-shell "projectile" "\ +Invoke `shell' in the project's root. + +\(fn)" t nil) + +(autoload 'projectile-run-eshell "projectile" "\ +Invoke `eshell' in the project's root. + +\(fn)" t nil) + +(autoload 'projectile-run-term "projectile" "\ +Invoke `term' in the project's root. + +\(fn PROGRAM)" t nil) + +(autoload 'projectile-replace "projectile" "\ +Replace literal string in project using non-regexp `tags-query-replace'. + +With a prefix argument ARG prompts you for a directory on which +to run the replacement. + +\(fn &optional ARG)" t nil) + +(autoload 'projectile-replace-regexp "projectile" "\ +Replace a regexp in the project using `tags-query-replace'. + +With a prefix argument ARG prompts you for a directory on which +to run the replacement. + +\(fn &optional ARG)" t nil) + +(autoload 'projectile-kill-buffers "projectile" "\ +Kill all project buffers. + +\(fn)" t nil) + +(autoload 'projectile-save-project-buffers "projectile" "\ +Save all project buffers. + +\(fn)" t nil) + +(autoload 'projectile-dired "projectile" "\ +Open `dired' at the root of the project. + +\(fn)" t nil) + +(autoload 'projectile-vc "projectile" "\ +Open `vc-dir' at the root of the project. + +For git projects `magit-status-internal' is used if available. +For hg projects `monky-status' is used if available. + +\(fn &optional PROJECT-ROOT)" t nil) + +(autoload 'projectile-recentf "projectile" "\ +Show a list of recently visited files in a project. + +\(fn)" t nil) + +(autoload 'projectile-compile-project "projectile" "\ +Run project compilation command. + +Normally you'll be prompted for a compilation command, unless +variable `compilation-read-command'. You can force the prompt +with a prefix ARG. + +\(fn ARG &optional DIR)" t nil) + +(autoload 'projectile-test-project "projectile" "\ +Run project test command. + +Normally you'll be prompted for a compilation command, unless +variable `compilation-read-command'. You can force the prompt +with a prefix ARG. + +\(fn ARG)" t nil) + +(autoload 'projectile-run-project "projectile" "\ +Run project run command. + +Normally you'll be prompted for a compilation command, unless +variable `compilation-read-command'. You can force the prompt +with a prefix ARG. + +\(fn ARG)" t nil) + +(autoload 'projectile-switch-project "projectile" "\ +Switch to a project we have visited before. +Invokes the command referenced by `projectile-switch-project-action' on switch. +With a prefix ARG invokes `projectile-commander' instead of +`projectile-switch-project-action.' + +\(fn &optional ARG)" t nil) + +(autoload 'projectile-switch-open-project "projectile" "\ +Switch to a project we have currently opened. +Invokes the command referenced by `projectile-switch-project-action' on switch. +With a prefix ARG invokes `projectile-commander' instead of +`projectile-switch-project-action.' + +\(fn &optional ARG)" t nil) + +(autoload 'projectile-find-file-in-directory "projectile" "\ +Jump to a file in a (maybe regular) DIRECTORY. + +This command will first prompt for the directory the file is in. + +\(fn &optional DIRECTORY)" t nil) + +(autoload 'projectile-find-file-in-known-projects "projectile" "\ +Jump to a file in any of the known projects. + +\(fn)" t nil) + +(autoload 'projectile-cleanup-known-projects "projectile" "\ +Remove known projects that don't exist anymore. + +\(fn)" t nil) + +(autoload 'projectile-clear-known-projects "projectile" "\ +Clear both `projectile-known-projects' and `projectile-known-projects-file'. + +\(fn)" t nil) + +(autoload 'projectile-remove-known-project "projectile" "\ +Remove PROJECT from the list of known projects. + +\(fn &optional PROJECT)" t nil) + +(autoload 'projectile-remove-current-project-from-known-projects "projectile" "\ +Remove the current project from the list of known projects. + +\(fn)" t nil) + +(autoload 'projectile-ibuffer "projectile" "\ +Open an IBuffer window showing all buffers in the current project. + +Let user choose another project when PREFIX is supplied. + +\(fn PREFIX)" t nil) + +(autoload 'projectile-commander "projectile" "\ +Execute a Projectile command with a single letter. +The user is prompted for a single character indicating the action to invoke. +The `?' character describes then +available actions. + +See `def-projectile-commander-method' for defining new methods. + +\(fn)" t nil) + +(autoload 'projectile-edit-dir-locals "projectile" "\ +Edit or create a .dir-locals.el file of the project. + +\(fn)" t nil) + +(defvar projectile-mode-line '(:eval (if (file-remote-p default-directory) " Projectile" (format " Projectile[%s]" (projectile-project-name)))) "\ +Mode line lighter for Projectile. + +The value of this variable is a mode line template as in +`mode-line-format'. See Info Node `(elisp)Mode Line Format' for +details about mode line templates. + +Customize this variable to change how Projectile displays its +status in the mode line. The default value displays the project +name. Set this variable to nil to disable the mode line +entirely.") + +(custom-autoload 'projectile-mode-line "projectile" t) + +(autoload 'projectile-mode "projectile" "\ +Minor mode to assist project management and navigation. + +When called interactively, toggle `projectile-mode'. With prefix +ARG, enable `projectile-mode' if ARG is positive, otherwise disable +it. + +When called from Lisp, enable `projectile-mode' if ARG is omitted, +nil or positive. If ARG is `toggle', toggle `projectile-mode'. +Otherwise behave as if called interactively. + +\\{projectile-mode-map} + +\(fn &optional ARG)" t nil) + +(defvar projectile-global-mode nil "\ +Non-nil if Projectile-Global mode is enabled. +See the command `projectile-global-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `projectile-global-mode'.") + +(custom-autoload 'projectile-global-mode "projectile" nil) + +(autoload 'projectile-global-mode "projectile" "\ +Toggle Projectile mode in all buffers. +With prefix ARG, enable Projectile-Global mode if ARG is positive; +otherwise, disable it. If called from Lisp, enable the mode if +ARG is omitted or nil. + +Projectile mode is enabled in all buffers where +`projectile-mode' would do it. +See `projectile-mode' for more information on Projectile mode. + +\(fn &optional ARG)" t nil) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; projectile-autoloads.el ends here diff --git a/elpa/projectile-20160420.1508/projectile-pkg.el b/elpa/projectile-20160420.1508/projectile-pkg.el new file mode 100644 index 0000000..1d569da --- /dev/null +++ b/elpa/projectile-20160420.1508/projectile-pkg.el @@ -0,0 +1 @@ +(define-package "projectile" "20160420.1508" "Manage and navigate projects in Emacs easily" '((dash "2.11.0") (pkg-info "0.4")) :url "https://github.com/bbatsov/projectile" :keywords '("project" "convenience")) diff --git a/elpa/projectile-20160420.1508/projectile.el b/elpa/projectile-20160420.1508/projectile.el new file mode 100644 index 0000000..a0bc8cf --- /dev/null +++ b/elpa/projectile-20160420.1508/projectile.el @@ -0,0 +1,3174 @@ +;;; projectile.el --- Manage and navigate projects in Emacs easily -*- lexical-binding: t -*- + +;; Copyright © 2011-2016 Bozhidar Batsov + +;; Author: Bozhidar Batsov +;; URL: https://github.com/bbatsov/projectile +;; Package-Version: 20160420.1508 +;; Keywords: project, convenience +;; Version: 0.14.0-cvs +;; Package-Requires: ((dash "2.11.0") (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, 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 GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: +;; +;; This library provides easy project management and navigation. The +;; concept of a project is pretty basic - just a folder containing +;; special file. Currently git, mercurial and bazaar repos are +;; considered projects by default. If you want to mark a folder +;; manually as a project just create an empty .projectile file in +;; it. See the README for more details. +;; +;;; Code: + +(require 'thingatpt) +(require 'dash) +(require 'ibuffer) +(require 'ibuf-ext) +(require 'compile) +(require 'grep) + +(eval-when-compile + (defvar ag-ignore-list) + (defvar ggtags-completion-table) + (defvar tags-completion-table) + (defvar tags-loop-scan) + (defvar tags-loop-operate) + (defvar eshell-buffer-name) + (defvar explicit-shell-file-name)) + +(declare-function ggtags-ensure-project "ggtags") +(declare-function ggtags-update-tags "ggtags") +(declare-function pkg-info-version-info "pkg-info") +(declare-function tags-completion-table "etags") +(declare-function make-term "term") +(declare-function term-mode "term") +(declare-function term-char-mode "term") + +(defvar grep-files-aliases) +(defvar grep-find-ignored-directories) +(defvar grep-find-ignored-files) + +;;;; Compatibility +(eval-and-compile + ;; Added in Emacs 24.3. + (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)))) + + ;; Added in Emacs 24.4 + (unless (fboundp 'string-suffix-p) + (defun string-suffix-p (suffix string &optional ignore-case) + "Return non-nil if SUFFIX is a suffix of STRING. +If IGNORE-CASE is non-nil, the comparison is done without paying +attention to case differences." + (let ((start-pos (- (length string) (length suffix)))) + (and (>= start-pos 0) + (eq t (compare-strings suffix nil nil + string start-pos nil ignore-case)))))) + + ;; Improved (no more stack overflows) in Emacs 24.5 + (eval-after-load 'etags + '(when (< emacs-major-version 25) + (defvar etags--table-line-limit 500) + (defun etags-tags-completion-table () + (let ((table (make-vector 511 0)) + (progress-reporter + (make-progress-reporter + (format "Making tags completion table for %s..." buffer-file-name) + (point-min) (point-max)))) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (if (not (re-search-forward + "[\f\t\n\r()=,; ]?\177\\\(?:\\([^\n\001]+\\)\001\\)?" + (+ (point) etags--table-line-limit) t)) + (forward-line 1) + (intern (prog1 (if (match-beginning 1) + (buffer-substring (match-beginning 1) (match-end 1)) + (goto-char (match-beginning 0)) + (skip-chars-backward "^\f\t\n\r()=,; ") + (prog1 + (buffer-substring (point) (match-beginning 0)) + (goto-char (match-end 0)))) + (progress-reporter-update progress-reporter (point))) + table)))) + table)))) + + ) + +(defun projectile-trim-string (string) + "Remove whitespace at the beginning and end of STRING." + (->> string + (replace-regexp-in-string "\\`[ \t\n\r]+" "") + (replace-regexp-in-string "[ \t\n\r]+\\'" ""))) + + +;;; Customization +(defgroup projectile nil + "Manage and navigate projects easily." + :group 'tools + :group 'convenience) + +(defcustom projectile-indexing-method (if (eq system-type 'windows-nt) 'native 'alien) + "Specifies the indexing method used by Projectile. + +There are two indexing methods - native and alien. + +The native method is implemented in Emacs Lisp (therefore it is +native to Emacs). It's advantage is that is portable and will +work everywhere that Emacs does. It's disadvantage is that is a +bit slow (especially for large projects). Generally it's a good +idea to pair the native indexing method with caching. + +The alien indexing method uses external tools (e.g. git, find, +etc) to speed up the indexing process. The disadvantage of this +method is that it's not well supported on Windows systems. + +By default alien indexing is the default on all operating +systems, except Windows." + :group 'projectile + :type '(radio + (const :tag "Native" native) + (const :tag "Alien" alien))) + +(defcustom projectile-enable-caching (eq projectile-indexing-method 'native) + "When t enables project files caching. + +Project caching is automatically enabled by default if you're +using the native indexing method." + :group 'projectile + :type 'boolean) + +(defcustom projectile-file-exists-local-cache-expire nil + "Number of seconds before file existence cache expires for a +file on a local file system. + + A value of nil disables this cache." + + :group 'projectile + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Seconds"))) + +(defcustom projectile-file-exists-remote-cache-expire (* 5 60) + "Number of seconds before file existence cache expires for a +file on a remote file system such as tramp. + + A value of nil disables this cache." + :group 'projectile + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Seconds"))) + +(defcustom projectile-require-project-root t + "Require the presence of a project root to operate when true. +Otherwise consider the current directory the project root." + :group 'projectile + :type 'boolean) + +(defcustom projectile-completion-system 'ido + "The completion system to be used by Projectile." + :group 'projectile + :type '(radio + (const :tag "Ido" ido) + (const :tag "Grizzl" grizzl) + (const :tag "Helm" helm) + (const :tag "Ivy" ivy) + (const :tag "Default" default) + (function :tag "Custom function"))) + +(defcustom projectile-keymap-prefix (kbd "C-c p") + "Projectile keymap prefix." + :group 'projectile + :type 'string) + +(defcustom projectile-cache-file + (expand-file-name "projectile.cache" user-emacs-directory) + "The name of Projectile's cache file." + :group 'projectile + :type 'string) + +(defcustom projectile-tags-file-name "TAGS" + "The tags filename Projectile's going to use." + :group 'projectile + :type 'string) + +(defcustom projectile-tags-command "ctags -Re -f \"%s\" %s" + "The command Projectile's going to use to generate a TAGS file." + :group 'projectile + :type 'string) + +(defcustom projectile-sort-order 'default + "The sort order used for a project's files." + :group 'projectile + :type '(radio + (const :tag "default" default) + (const :tag "recentf" recentf) + (const :tag "recently active" recently-active) + (const :tag "access time" access-time) + (const :tag "modification time" modification-time))) + +(defcustom projectile-verbose t + "Echo messages that are not errors." + :group 'projectile + :type 'boolean) + +(defcustom projectile-buffers-filter-function nil + "A function used to filter the buffers in `projectile-project-buffers'. + +The function should accept and return a list of Emacs buffers. +Two example filter functions are shipped by default - +`projectile-buffers-with-file' and +`projectile-buffers-with-file-or-process'." + :group 'projectile + :type 'symbol) + +(defcustom projectile-project-name nil + "If this value is non-nil, it will be used as project name. + +It has precedence over function `projectile-project-name-function'." + :group 'projectile + :type 'string + :package-version '(projectile . "0.14.0")) + +(defcustom projectile-project-name-function 'projectile-default-project-name + "A function that receives the project-root and returns the project name. + +If variable `projectile-project-name' is non-nil, this function will not be used." + :group 'projectile + :type 'symbol + :package-version '(projectile . "0.14.0")) + +(defcustom projectile-project-root-files + '("rebar.config" ; Rebar project file + "project.clj" ; Leiningen project file + "build.boot" ; Boot-clj project file + "SConstruct" ; Scons project file + "pom.xml" ; Maven project file + "build.sbt" ; SBT project file + "gradlew" ; Gradle wrapper script + "build.gradle" ; Gradle project file + "Gemfile" ; Bundler file + "requirements.txt" ; Pip file + "setup.py" ; Setuptools file + "tox.ini" ; Tox file + "package.json" ; npm package file + "gulpfile.js" ; Gulp build file + "Gruntfile.js" ; Grunt project file + "bower.json" ; Bower project file + "composer.json" ; Composer project file + "Cargo.toml" ; Cargo project file + "mix.exs" ; Elixir mix project file + "stack.yaml" ; Haskell's stack tool based project + "TAGS" ; etags/ctags are usually in the root of project + "GTAGS" ; GNU Global tags + ) + "A list of files considered to mark the root of a project. +The topmost match has precedence." + :group 'projectile + :type '(repeat string)) + +(defcustom projectile-project-root-files-bottom-up + '(".projectile" ; projectile project marker + ".git" ; Git VCS root dir + ".hg" ; Mercurial VCS root dir + ".fslckout" ; Fossil VCS root dir + ".bzr" ; Bazaar VCS root dir + "_darcs" ; Darcs VCS root dir + ) + "A list of files considered to mark the root of a project. +The bottommost (parentmost) match has precedence." + :group 'projectile + :type '(repeat string)) + +(defcustom projectile-project-root-files-top-down-recurring + '(".svn" ; Svn VCS root dir + "CVS" ; Csv VCS root dir + "Makefile") + "A list of files considered to mark the root of a project. +The search starts at the top and descends down till a directory +that contains a match file but its parent does not. Thus, it's a +bottommost match in the topmost sequence of directories +containing a root file." + :group 'projectile + :type '(repeat string)) + +(defcustom projectile-project-root-files-functions + '(projectile-root-local + projectile-root-bottom-up + projectile-root-top-down + projectile-root-top-down-recurring) + "A list of functions for finding project roots." + :group 'projectile + :type '(repeat function)) + +(defcustom projectile-globally-ignored-files + (list projectile-tags-file-name) + "A list of files globally ignored by projectile." + :group 'projectile + :type '(repeat string)) + +(defcustom projectile-globally-unignored-files nil + "A list of files globally unignored by projectile." + :group 'projectile + :type '(repeat string) + :package-version '(projectile "0.14.0")) + +(defcustom projectile-globally-ignored-file-suffixes + nil + "A list of file suffixes globally ignored by projectile." + :group 'projectile + :type '(repeat string)) + +(defcustom projectile-globally-ignored-directories + '(".idea" + ".eunit" + ".git" + ".hg" + ".fslckout" + ".bzr" + "_darcs" + ".tox" + ".svn" + ".stack-work") + "A list of directories globally ignored by projectile." + :safe (lambda (x) (not (remq t (mapcar #'stringp x)))) + :group 'projectile + :type '(repeat string)) + +(defcustom projectile-globally-unignored-directories nil + "A list of directories globally unignored by projectile." + :group 'projectile + :type '(repeat string) + :package-version '(projectile "0.14.0")) + +(defcustom projectile-globally-ignored-modes + '("erc-mode" + "help-mode" + "completion-list-mode" + "Buffer-menu-mode" + "gnus-.*-mode" + "occur-mode") + "A list of regular expressions for major modes ignored by projectile. + +If a buffer is using a given major mode, projectile will ignore +it for functions working with buffers." + :group 'projectile + :type '(repeat string)) + +(defcustom projectile-globally-ignored-buffers nil + "A list of buffer-names ignored by projectile. + +If a buffer is in the list projectile will ignore +it for functions working with buffers." + :group 'projectile + :type '(repeat string) + :package-version '(projectile . "0.12.0")) + +(defcustom projectile-find-file-hook nil + "Hooks run when a file is opened with `projectile-find-file'." + :group 'projectile + :type 'hook) + +(defcustom projectile-find-dir-hook nil + "Hooks run when a directory is opened with `projectile-find-dir'." + :group 'projectile + :type 'hook) + +(defcustom projectile-switch-project-action 'projectile-find-file + "Action invoked after switching projects with `projectile-switch-project'. + +Any function that does not take arguments will do." + :group 'projectile + :type 'symbol) + +(defcustom projectile-find-dir-includes-top-level nil + "If true, add top-level dir to options offered by `projectile-find-dir'." + :group 'projectile + :type 'boolean) + +(defcustom projectile-use-git-grep nil + "If true, use `vc-git-grep' in git projects." + :group 'projectile + :type 'boolean) + +(defcustom projectile-grep-finished-hook nil + "Hooks run when `projectile-grep' finishes." + :group 'projectile + :type 'hook + :package-version '(projectile . "0.14.0")) + +(defcustom projectile-test-prefix-function 'projectile-test-prefix + "Function to find test files prefix based on PROJECT-TYPE." + :group 'projectile + :type 'function) + +(defcustom projectile-test-suffix-function 'projectile-test-suffix + "Function to find test files suffix based on PROJECT-TYPE." + :group 'projectile + :type 'function) + + +;;; Idle Timer +(defvar projectile-idle-timer nil + "The timer object created when `projectile-enable-idle-timer' is non-nil.") + +(defcustom projectile-idle-timer-seconds 30 + "The idle period to use when `projectile-enable-idle-timer' is non-nil." + :group 'projectile + :type 'number) + +(defcustom projectile-idle-timer-hook '(projectile-regenerate-tags) + "The hook run when `projectile-enable-idle-timer' is non-nil." + :group 'projectile + :type '(repeat symbol)) + +(defcustom projectile-enable-idle-timer nil + "Enables idle timer hook `projectile-idle-timer-functions'. + +When `projectile-enable-idle-timer' is non-nil, the hook +`projectile-idle-timer-hook' is run each time Emacs has been idle +for `projectile-idle-timer-seconds' seconds and we're in a +project." + :group 'projectile + :set (lambda (symbol value) + (set symbol value) + (when projectile-idle-timer + (cancel-timer projectile-idle-timer)) + (setq projectile-idle-timer nil) + (when projectile-enable-idle-timer + (setq projectile-idle-timer (run-with-idle-timer + projectile-idle-timer-seconds t + (lambda () + (when (projectile-project-p) + (run-hooks 'projectile-idle-timer-hook))))))) + :type 'boolean) + +;;; Serialization +(defun projectile-serialize (data filename) + "Serialize DATA to FILENAME. + +The saved data can be restored with `projectile-unserialize'." + (when (file-writable-p filename) + (with-temp-file filename + (insert (let (print-length) (prin1-to-string data)))))) + +(defun projectile-unserialize (filename) + "Read data serialized by `projectile-serialize' from FILENAME." + (with-demoted-errors + "Error during file deserialization: %S" + (when (file-exists-p filename) + (with-temp-buffer + (insert-file-contents filename) + ;; this will blow up if the contents of the file aren't + ;; lisp data structures + (read (buffer-string)))))) + +(defvar projectile-projects-cache nil + "A hashmap used to cache project file names to speed up related operations.") + +(defvar projectile-project-root-cache (make-hash-table :test 'equal) + "Cached value of function `projectile-project-root`.") + +(defvar projectile-project-type-cache (make-hash-table :test 'equal) + "A hashmap used to cache project type to speed up related operations.") + +(defvar projectile-known-projects nil + "List of locations where we have previously seen projects. +The list of projects is ordered by the time they have been accessed. + +See also `projectile-remove-known-project', +`projectile-cleanup-known-projects' and `projectile-clear-known-projects'.") + +(defvar projectile-known-projects-on-file nil + "List of known projects reference point. + +Contains a copy of `projectile-known-projects' when it was last +synchronized with `projectile-known-projects-file'.") + +(defcustom projectile-known-projects-file + (expand-file-name "projectile-bookmarks.eld" + user-emacs-directory) + "Name and location of the Projectile's known projects file." + :group 'projectile + :type 'string) + +(defcustom projectile-ignored-projects nil + "A list of projects not to be added to `projectile-known-projects'." + :group 'projectile + :type '(repeat :tag "Project list" directory) + :package-version '(projectile . "0.11.0")) + +(defcustom projectile-ignored-project-function nil + "Function to decide if a project is added to `projectile-known-projects'. + +Can be either nil, or a function that takes the truename of the +project root as argument and returns non-nil if the project is to +be ignored or nil otherwise. + +This function is only called if the project is not listed in +`projectile-ignored-projects'. + +A suitable candidate would be `file-remote-p' to ignore remote +projects." + :group 'projectile + :type '(choice + (const :tag "Nothing" nil) + (const :tag "Remote files" file-remote-p) + function) + :package-version '(projectile . "0.13.0")) + + +;;; Version information + +;;;###autoload +(defun projectile-version (&optional show-version) + "Get the Projectile 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)) + (if (require 'pkg-info nil t) + (let ((version (pkg-info-version-info 'projectile))) + (when show-version + (message "Projectile version: %s" version)) + version) + (error "Cannot determine version without package pkg-info"))) + + +;;; Caching +(defvar projectile-file-exists-cache + (make-hash-table :test 'equal) + "Cached `projectile-file-exists-p' results.") + +(defvar projectile-file-exists-cache-timer nil + "Timer for scheduling`projectile-file-exists-cache-cleanup'.") + +(defun projectile-file-exists-cache-cleanup () + "Removed timed out cache entries and reschedules or remove the +timer if no more items are in the cache." + (let ((now (current-time))) + (maphash (lambda (key value) + (if (time-less-p (cdr value) now) + (remhash key projectile-file-exists-cache))) + projectile-file-exists-cache) + (setq projectile-file-exists-cache-timer + (if (> (hash-table-count projectile-file-exists-cache) 0) + (run-with-timer 10 nil 'projectile-file-exists-cache-cleanup))))) + +(defun projectile-file-exists-p (filename) + "Return t if file FILENAME exist. +A wrapper around `file-exists-p' with additional caching support." + (let* ((file-remote (file-remote-p filename)) + (expire-seconds + (if file-remote + (and projectile-file-exists-remote-cache-expire + (> projectile-file-exists-remote-cache-expire 0) + projectile-file-exists-remote-cache-expire) + (and projectile-file-exists-local-cache-expire + (> projectile-file-exists-local-cache-expire 0) + projectile-file-exists-local-cache-expire))) + (remote-file-name-inhibit-cache (if expire-seconds + expire-seconds + remote-file-name-inhibit-cache))) + (if (not expire-seconds) + (file-exists-p filename) + (let* ((current-time (current-time)) + (cached (gethash filename projectile-file-exists-cache)) + (cached-value (if cached (car cached))) + (cached-expire (if cached (cdr cached))) + (cached-expired (if cached (time-less-p cached-expire current-time) t)) + (value (or (and (not cached-expired) cached-value) + (if (file-exists-p filename) 'found 'notfound)))) + (when (or (not cached) cached-expired) + (puthash filename + (cons value (time-add current-time (seconds-to-time expire-seconds))) + projectile-file-exists-cache)) + (unless projectile-file-exists-cache-timer + (setq projectile-file-exists-cache-timer + (run-with-timer 10 nil 'projectile-file-exists-cache-cleanup))) + (equal value 'found))))) + +;;;###autoload +(defun projectile-invalidate-cache (arg) + "Remove the current project's files from `projectile-projects-cache'. + +With a prefix argument ARG prompts for the name of the project whose cache +to invalidate." + (interactive "P") + (let ((project-root + (if arg + (completing-read "Remove cache for: " + (projectile-hash-keys projectile-projects-cache)) + (projectile-project-root)))) + (setq projectile-project-root-cache (make-hash-table :test 'equal)) + (remhash project-root projectile-project-type-cache) + (remhash project-root projectile-projects-cache) + (projectile-serialize-cache) + (when projectile-verbose + (message "Invalidated Projectile cache for %s." + (propertize project-root 'face 'font-lock-keyword-face)))) + (when (fboundp 'recentf-cleanup) + (recentf-cleanup))) + +(defun projectile-cache-project (project files) + "Cache PROJECTs FILES. +The cache is created both in memory and on the hard drive." + (when projectile-enable-caching + (puthash project files projectile-projects-cache) + (projectile-serialize-cache))) + +;;;###autoload +(defun projectile-purge-file-from-cache (file) + "Purge FILE from the cache of the current project." + (interactive + (list (projectile-completing-read + "Remove file from cache: " + (projectile-current-project-files)))) + (let* ((project-root (projectile-project-root)) + (project-cache (gethash project-root projectile-projects-cache))) + (if (projectile-file-cached-p file project-root) + (progn + (puthash project-root (remove file project-cache) projectile-projects-cache) + (projectile-serialize-cache) + (when projectile-verbose + (message "%s removed from cache" file))) + (error "%s is not in the cache" file)))) + +;;;###autoload +(defun projectile-purge-dir-from-cache (dir) + "Purge DIR from the cache of the current project." + (interactive + (list (projectile-completing-read + "Remove directory from cache: " + (projectile-current-project-dirs)))) + (let* ((project-root (projectile-project-root)) + (project-cache (gethash project-root projectile-projects-cache))) + (puthash project-root + (--filter (string-prefix-p dir it) project-cache) + projectile-projects-cache))) + +(defun projectile-file-cached-p (file project) + "Check if FILE is already in PROJECT cache." + (member file (gethash project projectile-projects-cache))) + +;;;###autoload +(defun projectile-cache-current-file () + "Add the currently visited file to the cache." + (interactive) + (let ((current-project (projectile-project-root))) + (when (and (buffer-file-name) (gethash (projectile-project-root) projectile-projects-cache)) + (let* ((abs-current-file (file-truename (buffer-file-name))) + (current-file (file-relative-name abs-current-file current-project))) + (unless (or (projectile-file-cached-p current-file current-project) + (projectile-ignored-directory-p (file-name-directory abs-current-file)) + (projectile-ignored-file-p abs-current-file)) + (puthash current-project + (cons current-file (gethash current-project projectile-projects-cache)) + projectile-projects-cache) + (projectile-serialize-cache) + (message "File %s added to project %s cache." + (propertize current-file 'face 'font-lock-keyword-face) + (propertize current-project 'face 'font-lock-keyword-face))))))) + +;; cache opened files automatically to reduce the need for cache invalidation +(defun projectile-cache-files-find-file-hook () + "Function for caching files with `find-file-hook'." + (when (and projectile-enable-caching (projectile-project-p)) + (projectile-cache-current-file))) + +(defun projectile-cache-projects-find-file-hook () + "Function for caching projects with `find-file-hook'." + (when (projectile-project-p) + (let ((known-projects (and (sequencep projectile-known-projects) + (copy-sequence projectile-known-projects)))) + (projectile-add-known-project (projectile-project-root)) + (unless (equal known-projects projectile-known-projects) + (projectile-merge-known-projects))))) + + +(defun projectile-maybe-invalidate-cache (force) + "Invalidate if FORCE or project's dirconfig newer than cache." + (when (or force (file-newer-than-file-p (projectile-dirconfig-file) + projectile-cache-file)) + (projectile-invalidate-cache nil))) + + +(defadvice delete-file (before purge-from-projectile-cache (filename &optional trash)) + (if (and projectile-enable-caching (projectile-project-p)) + (let* ((project-root (projectile-project-root)) + (true-filename (file-truename filename)) + (relative-filename (file-relative-name true-filename project-root))) + (if (projectile-file-cached-p relative-filename project-root) + (projectile-purge-file-from-cache relative-filename))))) + + +;;; Project root related utilities +(defun projectile-parent (path) + "Return the parent directory of PATH. +PATH may be a file or directory and directory paths may end with a slash." + (directory-file-name (file-name-directory (directory-file-name (expand-file-name path))))) + +(defun projectile-locate-dominating-file (file name) + "Look up the directory hierarchy from FILE for a directory containing NAME. +Stop at the first parent directory containing a file NAME, +and return the directory. Return nil if not found. +Instead of a string, NAME can also be a predicate taking one argument +\(a directory) and returning a non-nil value if that directory is the one for +which we're looking." + ;; copied from files.el (stripped comments) emacs-24 bzr branch 2014-03-28 10:20 + (setq file (abbreviate-file-name file)) + (let ((root nil) + try) + (while (not (or root + (null file) + (string-match locate-dominating-stop-dir-regexp file))) + (setq try (if (stringp name) + (projectile-file-exists-p (expand-file-name name file)) + (funcall name file))) + (cond (try (setq root file)) + ((equal file (setq file (file-name-directory + (directory-file-name file)))) + (setq file nil)))) + (and root (expand-file-name (file-name-as-directory root))))) + +(defvar-local projectile-project-root nil + "Defines a custom Projectile project root. +This is intended to be used as a file local variable.") + +(defun projectile-root-local (_dir) + "A simple wrapper around `projectile-project-root'." + projectile-project-root) + +(defun projectile-root-top-down (dir &optional list) + "Identify a project root in DIR by top-down search for files in LIST. +If LIST is nil, use `projectile-project-root-files' instead. +Return the first (topmost) matched directory or nil if not found." + (projectile-locate-dominating-file + dir + (lambda (dir) + (--first (projectile-file-exists-p (expand-file-name it dir)) + (or list projectile-project-root-files))))) + +(defun projectile-root-bottom-up (dir &optional list) + "Identify a project root in DIR by bottom-up search for files in LIST. +If LIST is nil, use `projectile-project-root-files-bottom-up' instead. +Return the first (bottommost) matched directory or nil if not found." + (--some (projectile-locate-dominating-file dir it) + (or list projectile-project-root-files-bottom-up))) + +(defun projectile-root-top-down-recurring (dir &optional list) + "Identify a project root in DIR by recurring top-down search for files in LIST. +If LIST is nil, use `projectile-project-root-files-top-down-recurring' +instead. Return the last (bottommost) matched directory in the +topmost sequence of matched directories. Nil otherwise." + (--some (projectile-locate-dominating-file + dir + (lambda (dir) + (and (projectile-file-exists-p (expand-file-name it dir)) + (or (string-match locate-dominating-stop-dir-regexp (projectile-parent dir)) + (not (projectile-file-exists-p (expand-file-name it (projectile-parent dir)))))))) + (or list projectile-project-root-files-top-down-recurring))) + +(defun projectile-project-root () + "Retrieves the root directory of a project if available. +The current directory is assumed to be the project's root otherwise." + (let ((dir default-directory)) + (or (--some (let* ((cache-key (format "%s-%s" it dir)) + (cache-value (gethash cache-key projectile-project-root-cache))) + (if (and cache-value (file-exists-p cache-value)) + cache-value + (let ((value (funcall it (file-truename dir)))) + (puthash cache-key value projectile-project-root-cache) + value))) + projectile-project-root-files-functions) + (if projectile-require-project-root + (error "You're not in a project") + default-directory)))) + +(defun projectile-file-truename (file-name) + "Return the truename of FILE-NAME. +A thin wrapper around `file-truename' that handles nil." + (when file-name + (file-truename file-name))) + +(defun projectile-project-p () + "Check if we're in a project." + (condition-case nil + (projectile-project-root) + (error nil))) + +(defun projectile-default-project-name (project-root) + "Default function used create project name to be displayed based on the value of PROJECT-ROOT." + (file-name-nondirectory (directory-file-name project-root))) + +(defun projectile-project-name () + "Return project name." + (if projectile-project-name + projectile-project-name + (let ((project-root + (condition-case nil + (projectile-project-root) + (error nil)))) + (if project-root + (funcall projectile-project-name-function project-root) + "-")))) + + +;;; Project indexing +(defun projectile-get-project-directories () + "Get the list of project directories that are of interest to the user." + (-map (lambda (subdir) (concat (projectile-project-root) subdir)) + (or (nth 0 (projectile-parse-dirconfig-file)) '("")))) + +(defun projectile-dir-files (directory) + "List the files in DIRECTORY and in its sub-directories. +Files are returned as relative paths to the project root." + ;; check for a cache hit first if caching is enabled + (let ((files-list (and projectile-enable-caching + (gethash directory projectile-projects-cache))) + (root (projectile-project-root))) + ;; cache disabled or cache miss + (or files-list + (if (eq projectile-indexing-method 'native) + (projectile-dir-files-native root directory) + ;; use external tools to get the project files + (projectile-adjust-files (projectile-dir-files-external root directory)))))) + +(defun projectile-dir-files-native (root directory) + "Get the files for ROOT under DIRECTORY using just Emacs Lisp." + (let ((progress-reporter + (make-progress-reporter + (format "Projectile is indexing %s" + (propertize directory 'face 'font-lock-keyword-face))))) + ;; we need the files with paths relative to the project root + (-map (lambda (file) (file-relative-name file root)) + (projectile-index-directory directory (projectile-filtering-patterns) + progress-reporter)))) + +(defun projectile-dir-files-external (root directory) + "Get the files for ROOT under DIRECTORY using external tools." + (let ((default-directory directory)) + (-map (lambda (file) + (file-relative-name (expand-file-name file directory) root)) + (projectile-get-repo-files)))) + +(defcustom projectile-git-command "git ls-files -zco --exclude-standard" + "Command used by projectile to get the files in a git project." + :group 'projectile + :type 'string) + +(defcustom projectile-git-submodule-command "git submodule --quiet foreach 'echo $path' | tr '\\n' '\\0'" + "Command used by projectile to get the files in git submodules." + :group 'projectile + :type 'string) + +(defcustom projectile-git-ignored-command "git ls-files -zcoi --exclude-standard" + "Command used by projectile to get the ignored files in a git project." + :group 'projectile + :type 'string + :package-version '(projectile "0.14.0")) + +(defcustom projectile-hg-command "hg locate -0 -I ." + "Command used by projectile to get the files in a hg project." + :group 'projectile + :type 'string) + +(defcustom projectile-fossil-command "fossil ls | tr '\\n' '\\0'" + "Command used by projectile to get the files in a fossil project." + :group 'projectile + :type 'string) + +(defcustom projectile-bzr-command "bzr ls -R --versioned -0" + "Command used by projectile to get the files in a bazaar project." + :group 'projectile + :type 'string) + +(defcustom projectile-darcs-command "darcs show files -0 . " + "Command used by projectile to get the files in a darcs project." + :group 'projectile + :type 'string) + +(defcustom projectile-svn-command "svn list -R . | grep -v '$/' | tr '\\n' '\\0'" + "Command used by projectile to get the files in a svn project." + :group 'projectile + :type 'string) + +(defcustom projectile-generic-command "find . -type f -print0" + "Command used by projectile to get the files in a generic project." + :group 'projectile + :type 'string) + +(defun projectile-get-ext-command () + "Determine which external command to invoke based on the project's VCS." + (let ((vcs (projectile-project-vcs))) + (cond + ((eq vcs 'git) projectile-git-command) + ((eq vcs 'hg) projectile-hg-command) + ((eq vcs 'fossil) projectile-fossil-command) + ((eq vcs 'bzr) projectile-bzr-command) + ((eq vcs 'darcs) projectile-darcs-command) + ((eq vcs 'svn) projectile-svn-command) + (t projectile-generic-command)))) + +(defun projectile-get-sub-projects-command () + (let ((vcs (projectile-project-vcs))) + (cond + ((eq vcs 'git) projectile-git-submodule-command) + (t "")))) + +(defun projectile-get-ext-ignored-command () + "Determine which external command to invoke based on the project's VCS." + (let ((vcs (projectile-project-vcs))) + (cond + ((eq vcs 'git) projectile-git-ignored-command) + (t (error "VCS command for ignored files not implemented yet"))))) + +(defun projectile-get-all-sub-projects (project) + "Get all sub-projects for a given project. + +PROJECT is base directory to start search recursively." + (let ((submodules (projectile-get-immediate-sub-projects project))) + (cond + ((null submodules) + nil) + (t + (nconc submodules (-flatten + ;; recursively get sub-projects of each sub-project + (mapcar (lambda (s) + (projectile-get-all-sub-projects s)) submodules))))))) + +(defun projectile-get-immediate-sub-projects (path) + "Get immediate sub-projects for a given project without recursing. + +PATH is the vcs root or project root from which to start +searching, and should end with an appropriate path delimiter, such as +'/' or a '\\'. + +If the vcs get-sub-projects query returns results outside of path, +they are excluded from the results of this function." + (let* ((default-directory path) + ;; search for sub-projects under current project `project' + (submodules (mapcar + (lambda (s) + (file-name-as-directory (expand-file-name s default-directory))) + (projectile-files-via-ext-command (projectile-get-sub-projects-command)))) + (project-child-folder-regex + (concat "\\`" + (regexp-quote path)))) + + ;; If project root is inside of an VCS folder, but not actually an + ;; VCS root itself, submodules external to the project will be + ;; included in the VCS get sub-projects result. Let's remove them. + (-filter (lambda (submodule) + (string-match-p project-child-folder-regex + submodule)) + submodules))) + +(defun projectile-get-sub-projects-files () + "Get files from sub-projects recursively." + (-flatten + (mapcar (lambda (s) + (let ((default-directory s)) + (mapcar (lambda (f) + (concat s f)) + (projectile-files-via-ext-command projectile-git-command)))) + (condition-case nil + (projectile-get-all-sub-projects (projectile-project-root)) + (error nil))))) + +(defun projectile-get-repo-files () + "Get a list of the files in the project, including sub-projects." + (cond + ((eq (projectile-project-vcs) 'git) + (nconc (projectile-files-via-ext-command (projectile-get-ext-command)) + (projectile-get-sub-projects-files))) + (t (projectile-files-via-ext-command (projectile-get-ext-command))))) + +(defun projectile-get-repo-ignored-files () + "Get a list of the files ignored in the project." + (let ((cmd (projectile-get-ext-ignored-command))) + (projectile-files-via-ext-command cmd))) + +(defun projectile-files-via-ext-command (command) + "Get a list of relative file names in the project root by executing COMMAND." + (split-string (shell-command-to-string command) "\0" t)) + +(defun projectile-index-directory (directory patterns progress-reporter) + "Index DIRECTORY taking into account PATTERNS. +The function calls itself recursively until all sub-directories +have been indexed. The PROGRESS-REPORTER is updated while the +function is executing." + (--mapcat + (unless (or (and patterns (projectile-ignored-rel-p it directory patterns)) + (member (file-name-nondirectory (directory-file-name it)) + '("." ".." ".svn" ".cvs"))) + (progress-reporter-update progress-reporter) + (if (file-directory-p it) + (unless (projectile-ignored-directory-p + (file-name-as-directory it)) + (projectile-index-directory it patterns progress-reporter)) + (unless (projectile-ignored-file-p it) + (list it)))) + (directory-files directory t))) + +(defun projectile-adjust-files (files) + "First remove ignored files from FILES, then add back unignored files." + (projectile-add-unignored (projectile-remove-ignored files))) + +(defun projectile-remove-ignored (files &optional subdirectories) + "Remove ignored files and folders from FILES. + +Operates on filenames relative to the project root. Optionally, +you can filter ignored files in subdirectories by setting +SUBDIRECTORIES to a non-nil value." + (let ((ignored (append (projectile-ignored-files-rel) + (projectile-ignored-directories-rel)))) + (-remove (lambda (file) + (or (--any-p (string-prefix-p it (if subdirectories + (file-name-nondirectory file) + file)) + ignored) + (--any-p (string-suffix-p it file) projectile-globally-ignored-file-suffixes))) + files))) + +(defun projectile-keep-ignored-files (files) + "Filter FILES to retain only those that are ignored." + (when files + (-filter (lambda (file) + (--some (string-prefix-p it file) files)) + (projectile-get-repo-ignored-files)))) + +(defun projectile-add-unignored (files) + "This adds unignored files to FILES. + +Useful because the VCS may not return ignored files at all. In +this case unignored files will be absent from FILES." + (let ((unignored-files (projectile-keep-ignored-files + (projectile-unignored-files-rel))) + (unignored-paths (projectile-remove-ignored + (projectile-keep-ignored-files + (projectile-unignored-directories-rel)) + 'subdirectories))) + (append files unignored-files unignored-paths))) + +(defun projectile-buffers-with-file (buffers) + "Return only those BUFFERS backed by files." + (--filter (buffer-file-name it) buffers)) + +(defun projectile-buffers-with-file-or-process (buffers) + "Return only those BUFFERS backed by files or processes." + (--filter (or (buffer-file-name it) + (get-buffer-process it)) buffers)) + +(defun projectile-project-buffers () + "Get a list of project buffers." + (let* ((project-root (projectile-project-root)) + (all-buffers (-filter (lambda (buffer) + (projectile-project-buffer-p buffer project-root)) + (buffer-list)))) + (if projectile-buffers-filter-function + (funcall projectile-buffers-filter-function all-buffers) + all-buffers))) + +(defun projectile-process-current-project-buffers (action) + "Process the current project's buffers using ACTION." + (let ((project-buffers (projectile-project-buffers))) + (dolist (buffer project-buffers) + (funcall action buffer)))) + +(defun projectile-project-buffer-files () + "Get a list of project buffer files." + (let ((project-root (projectile-project-root))) + (->> (projectile-buffers-with-file (projectile-project-buffers)) + (-map (lambda (buffer) + (file-relative-name (buffer-file-name buffer) project-root)))))) + +(defun projectile-project-buffer-p (buffer project-root) + "Check if BUFFER is under PROJECT-ROOT." + (with-current-buffer buffer + (and (not (string-prefix-p " " (buffer-name buffer))) + (not (projectile-ignored-buffer-p buffer)) + (string-equal (file-remote-p default-directory) + (file-remote-p project-root)) + (not (string-match-p "^http\\(s\\)?://" default-directory)) + (string-prefix-p project-root (file-truename default-directory))))) + +(defun projectile-ignored-buffer-p (buffer) + "Check if BUFFER should be ignored." + (or + (member (buffer-name buffer) projectile-globally-ignored-buffers) + (with-current-buffer buffer + (--any-p (string-match-p (concat "^" it "$") + (symbol-name major-mode)) + projectile-globally-ignored-modes)))) + +(defun projectile-recently-active-files () + "Get list of recently active files. + +Files are ordered by recently active buffers, and then recently +opened through use of recentf." + (let ((project-buffer-files (projectile-project-buffer-files))) + (append project-buffer-files + (-difference (projectile-recentf-files) + project-buffer-files)))) + +(defun projectile-project-buffer-names () + "Get a list of project buffer names." + (-map #'buffer-name (projectile-project-buffers))) + +(defun projectile-prepend-project-name (string) + "Prepend the current project's name to STRING." + (format "[%s] %s" (projectile-project-name) string)) + +(defun projectile-read-buffer-to-switch (prompt) + "Read the name of a buffer to switch to, prompting with PROMPT. + +This function excludes the current buffer from the offered +choices." + (projectile-completing-read + prompt + (-remove-item (buffer-name (current-buffer)) + (projectile-project-buffer-names)))) + +;;;###autoload +(defun projectile-switch-to-buffer () + "Switch to a project buffer." + (interactive) + (switch-to-buffer + (projectile-read-buffer-to-switch "Switch to buffer: "))) + +;;;###autoload +(defun projectile-switch-to-buffer-other-window () + "Switch to a project buffer and show it in another window." + (interactive) + (switch-to-buffer-other-window + (projectile-read-buffer-to-switch "Switch to buffer: "))) + +;;;###autoload +(defun projectile-display-buffer () + "Display a project buffer in another window without selecting it." + (interactive) + (display-buffer + (projectile-completing-read + "Display buffer: " + (projectile-project-buffer-names)))) + +;;;###autoload +(defun projectile-project-buffers-other-buffer () + "Switch to the most recently selected buffer project buffer. +Only buffers not visible in windows are returned." + (interactive) + (switch-to-buffer (car (projectile-project-buffers-non-visible))) nil t) + +(defun projectile-project-buffers-non-visible () + "Get a list of non visible project buffers." + (-filter (lambda (buffer) + (not (get-buffer-window buffer 'visible))) + (projectile-project-buffers))) + +;;;###autoload +(defun projectile-multi-occur () + "Do a `multi-occur' in the project's buffers." + (interactive) + (multi-occur (projectile-project-buffers) + (car (occur-read-primary-args)))) + +(defun projectile-normalise-paths (patterns) + "Remove leading `/' from the elements of PATTERNS." + (-non-nil (--map (and (string-prefix-p "/" it) + ;; remove the leading / + (substring it 1)) + patterns))) + +(defun projectile-expand-paths (paths) + "Expand the elements of PATHS. + +Elements containing wildcards are expanded and spliced into the +resulting paths. The returned PATHS are absolute, based on the +projectile project root." + (let ((default-directory (projectile-project-root))) + (-flatten (-map + (lambda (pattern) + (or (file-expand-wildcards pattern t) + (projectile-expand-root pattern))) + paths)))) + +(defun projectile-normalise-patterns (patterns) + "Remove paths from PATTERNS." + (--remove (string-prefix-p "/" it) patterns)) + +(defun projectile-make-relative-to-root (files) + "Make FILES relative to the project root." + (let ((project-root (projectile-project-root))) + (--map (file-relative-name it project-root) files))) + +(defun projectile-ignored-directory-p (directory) + "Check if DIRECTORY should be ignored." + (member directory (projectile-ignored-directories))) + +(defun projectile-ignored-file-p (file) + "Check if FILE should be ignored." + (member file (projectile-ignored-files))) + +(defun projectile-check-pattern-p (file pattern) + "Check if FILE meets PATTERN." + (or (string-suffix-p (directory-file-name pattern) + (directory-file-name file)) + (member file (file-expand-wildcards pattern t)))) + +(defun projectile-ignored-rel-p (file directory patterns) + "Check if FILE should be ignored relative to DIRECTORY +according to PATTERNS: (ignored . unignored)" + (let ((default-directory directory)) + (and (--any-p (projectile-check-pattern-p file it) (car patterns)) + (--none-p (projectile-check-pattern-p file it) (cdr patterns))))) + +(defun projectile-ignored-files () + "Return list of ignored files." + (-difference + (-map + #'projectile-expand-root + (append + projectile-globally-ignored-files + (projectile-project-ignored-files))) + (projectile-unignored-files))) + +(defun projectile-ignored-directories () + "Return list of ignored directories." + (-difference + (-map + #'file-name-as-directory + (-map + #'projectile-expand-root + (append + projectile-globally-ignored-directories + (projectile-project-ignored-directories)))) + (projectile-unignored-directories))) + +(defun projectile-ignored-directories-rel () + "Return list of ignored directories, relative to the root." + (projectile-make-relative-to-root (projectile-ignored-directories))) + +(defun projectile-ignored-files-rel () + "Return list of ignored files, relative to the root." + (projectile-make-relative-to-root (projectile-ignored-files))) + +(defun projectile-project-ignored-files () + "Return list of project ignored files. Unignored files are not +included." + (-remove 'file-directory-p (projectile-project-ignored))) + +(defun projectile-project-ignored-directories () + "Return list of project ignored directories. Unignored +directories are not included." + (-filter 'file-directory-p (projectile-project-ignored))) + +(defun projectile-paths-to-ignore () + "Return a list of ignored project paths." + (projectile-normalise-paths (nth 1 (projectile-parse-dirconfig-file)))) + +(defun projectile-patterns-to-ignore () + "Return a list of relative file patterns." + (projectile-normalise-patterns (nth 1 (projectile-parse-dirconfig-file)))) + +(defun projectile-project-ignored () + "Return list of project ignored files/directories. Unignored +files/directories are not included." + (let ((paths (projectile-paths-to-ignore))) + (projectile-expand-paths paths))) + +(defun projectile-unignored-files () + "Return list of unignored files." + (-map + #'projectile-expand-root + (append + projectile-globally-unignored-files + (projectile-project-unignored-files)))) + +(defun projectile-unignored-directories () + "Return list of unignored directories." + (-map + #'file-name-as-directory + (-map + #'projectile-expand-root + (append + projectile-globally-unignored-directories + (projectile-project-unignored-directories))))) + +(defun projectile-unignored-directories-rel () + "Return list of unignored directories, relative to the root." + (projectile-make-relative-to-root (projectile-unignored-directories))) + +(defun projectile-unignored-files-rel () + "Return list of unignored files, relative to the root." + (projectile-make-relative-to-root (projectile-unignored-files))) + +(defun projectile-project-unignored-files () + "Return list of project unignored files." + (-remove 'file-directory-p (projectile-project-unignored))) + +(defun projectile-project-unignored-directories () + "Return list of project unignored directories." + (-filter 'file-directory-p (projectile-project-unignored))) + +(defun projectile-paths-to-ensure () + "Return a list of unignored project paths." + (projectile-normalise-paths (nth 2 (projectile-parse-dirconfig-file)))) + +(defun projectile-files-to-ensure () + (-flatten (--map (file-expand-wildcards it t) + (projectile-patterns-to-ensure)))) + +(defun projectile-patterns-to-ensure () + "Return a list of relative file patterns." + (projectile-normalise-patterns (nth 2 (projectile-parse-dirconfig-file)))) + +(defun projectile-filtering-patterns () + (cons (projectile-patterns-to-ignore) + (projectile-patterns-to-ensure))) + +(defun projectile-project-unignored () + "Return list of project ignored files/directories." + (delete-dups (append (projectile-expand-paths (projectile-paths-to-ensure)) + (projectile-expand-paths (projectile-files-to-ensure))))) + + +(defun projectile-dirconfig-file () + "Return the absolute path to the project's dirconfig file." + (expand-file-name ".projectile" (projectile-project-root))) + +(defun projectile-parse-dirconfig-file () + "Parse project ignore file and return directories to ignore and keep. + +The return value will be a list of three elements, the car being +the list of directories to keep, the cadr being the list of files +or directories to ignore, and the caddr being the list of files +or directories to ensure. + +Strings starting with + will be added to the list of directories +to keep, and strings starting with - will be added to the list of +directories to ignore. For backward compatibility, without a +prefix the string will be assumed to be an ignore string." + (let (keep ignore ensure (dirconfig (projectile-dirconfig-file))) + (when (projectile-file-exists-p dirconfig) + (with-temp-buffer + (insert-file-contents dirconfig) + (while (not (eobp)) + (pcase (char-after) + (?+ (push (buffer-substring (1+ (point)) (line-end-position)) keep)) + (?- (push (buffer-substring (1+ (point)) (line-end-position)) ignore)) + (?! (push (buffer-substring (1+ (point)) (line-end-position)) ensure)) + (_ (push (buffer-substring (point) (line-end-position)) ignore))) + (forward-line))) + (list (--map (file-name-as-directory (projectile-trim-string it)) + (delete "" (reverse keep))) + (-map #'projectile-trim-string + (delete "" (reverse ignore))) + (-map #'projectile-trim-string + (delete "" (reverse ensure))))))) + +(defun projectile-expand-root (name) + "Expand NAME to project root. + +Never use on many files since it's going to recalculate the +project-root for every file." + (expand-file-name name (projectile-project-root))) + +(defun projectile-completing-read (prompt choices &optional initial-input) + "Present a project tailored PROMPT with CHOICES." + (let ((prompt (projectile-prepend-project-name prompt))) + (cond + ((eq projectile-completion-system 'ido) + (ido-completing-read prompt choices nil nil initial-input)) + ((eq projectile-completion-system 'default) + (completing-read prompt choices nil nil initial-input)) + ((eq projectile-completion-system 'helm) + (if (fboundp 'helm-comp-read) + (helm-comp-read prompt choices + :initial-input initial-input + :candidates-in-buffer t + :must-match 'confirm) + (user-error "Please install helm from \ +https://github.com/emacs-helm/helm"))) + ((eq projectile-completion-system 'grizzl) + (if (and (fboundp 'grizzl-completing-read) + (fboundp 'grizzl-make-index)) + (grizzl-completing-read prompt (grizzl-make-index choices)) + (user-error "Please install grizzl from \ +https://github.com/d11wtq/grizzl"))) + ((eq projectile-completion-system 'ivy) + (if (fboundp 'ivy-read) + (ivy-read prompt choices + :initial-input initial-input + :caller 'projectile-completing-read) + (user-error "Please install ivy from \ +https://github.com/abo-abo/swiper"))) + (t (funcall projectile-completion-system prompt choices))))) + +(defun projectile-current-project-files () + "Return a list of files for the current project." + (let ((files (and projectile-enable-caching + (gethash (projectile-project-root) projectile-projects-cache)))) + ;; nothing is cached + (unless files + (when projectile-enable-caching + (message "Empty cache. Projectile is initializing cache...")) + (setq files (-mapcat #'projectile-dir-files + (projectile-get-project-directories))) + ;; cache the resulting list of files + (when projectile-enable-caching + (projectile-cache-project (projectile-project-root) files))) + (projectile-sort-files files))) + +(defun projectile-process-current-project-files (action) + "Process the current project's files using ACTION." + (let ((project-files (projectile-current-project-files)) + (default-directory (projectile-project-root))) + (dolist (filename project-files) + (funcall action filename)))) + +(defun projectile-current-project-dirs () + "Return a list of dirs for the current project." + (-remove #'null (-distinct + (-map #'file-name-directory + (projectile-current-project-files))))) + +(defun projectile-hash-keys (hash) + "Return a list of all HASH keys." + (let (allkeys) + (maphash (lambda (k _v) (setq allkeys (cons k allkeys))) hash) + allkeys)) + + +;;; Interactive commands +(defcustom projectile-other-file-alist + '(;; handle C/C++ extensions + ("cpp" . ("h" "hpp" "ipp")) + ("ipp" . ("h" "hpp" "cpp")) + ("hpp" . ("h" "ipp" "cpp" "cc")) + ("cxx" . ("h" "hxx" "ixx")) + ("ixx" . ("h" "hxx" "cxx")) + ("hxx" . ("h" "ixx" "cxx")) + ("c" . ("h")) + ("m" . ("h")) + ("mm" . ("h")) + ("h" . ("c" "cpp" "ipp" "hpp" "cxx" "ixx" "hxx" "m" "mm")) + ("cc" . ("hh" "hpp")) + ("hh" . ("cc")) + + ;; vertex shader and fragment shader extensions in glsl + ("vert" . ("frag")) + ("frag" . ("vert")) + + ;; handle files with no extension + (nil . ("lock" "gpg")) + ("lock" . ("")) + ("gpg" . ("")) + ) + "Alist of extensions for switching to file with the same name, using other extensions based on the extension of current file.") + +;;;###autoload +(defun projectile-find-other-file (&optional flex-matching) + "Switch between files with the same name but different extensions. +With FLEX-MATCHING, match any file that contains the base name of current file. +Other file extensions can be customized with the variable `projectile-other-file-alist'." + (interactive "P") + (-if-let (other-files (projectile-get-other-files (buffer-file-name) (projectile-current-project-files) flex-matching)) + (if (= (length other-files) 1) + (find-file (expand-file-name (car other-files) (projectile-project-root))) + (find-file (expand-file-name (projectile-completing-read "Switch to: " other-files) (projectile-project-root)))) + (error "No other file found"))) + +;;;###autoload +(defun projectile-find-other-file-other-window (&optional flex-matching) + "Switch between files with the same name but different extensions in other window. +With FLEX-MATCHING, match any file that contains the base name of current file. +Other file extensions can be customized with the variable `projectile-other-file-alist'." + (interactive "P") + (-if-let (other-files (projectile-get-other-files (buffer-file-name) (projectile-current-project-files) flex-matching)) + (if (= (length other-files) 1) + (find-file-other-window (expand-file-name (car other-files) (projectile-project-root))) + (find-file-other-window (expand-file-name (projectile-completing-read "Switch to: " other-files) (projectile-project-root)))) + (error "No other file found"))) + +(defun projectile--file-name-sans-extensions (file-name) + "Return FILE-NAME sans any extensions. +The extensions, in a filename, are what follows the first '.', with the exception of a leading '.'" + (setq file-name (file-name-nondirectory file-name)) + (substring file-name 0 (string-match "\\..*" file-name 1))) + +(defun projectile--file-name-extensions (file-name) + "Return FILE-NAME's extensions. +The extensions, in a filename, are what follows the first '.', with the exception of a leading '.'" + ;;would it make sense to return nil instead of an empty string if no extensions are found? + (setq file-name (file-name-nondirectory file-name)) + (substring file-name (-if-let (extensions-start (string-match "\\..*" file-name 1)) (1+ extensions-start) (length file-name)))) + +(defun projectile-associated-file-name-extensions (file-name) + "Return projectile-other-file-extensions associated to FILE-NAME's extensions. +If no associated other-file-extensions for the complete (nested) extension are found, remove subextensions from FILENAME's extensions until a match is found." + (let ((current-extensions (projectile--file-name-extensions (file-name-nondirectory file-name)))) + (catch 'break + (while (not (string= "" current-extensions)) + (-if-let (associated-extensions (cdr (assoc current-extensions projectile-other-file-alist))) + (throw 'break associated-extensions)) + (setq current-extensions (projectile--file-name-extensions current-extensions)))))) + +(defun projectile-get-other-files (current-file project-file-list &optional flex-matching) + "Narrow to files with the same names but different extensions. +Returns a list of possible files for users to choose. + +With FLEX-MATCHING, match any file that contains the base name of current file" + (let* ((file-ext-list (projectile-associated-file-name-extensions current-file)) + (fulldirname (if (file-name-directory current-file) + (file-name-directory current-file) "./")) + (dirname (file-name-nondirectory (directory-file-name fulldirname))) + (filename (projectile--file-name-sans-extensions current-file)) + (file-list (mapcar (lambda (ext) + (if flex-matching + (concat ".*" filename ".*" "\." ext "\\'") + (concat "^" filename + (unless (equal ext "") + (concat "\." ext)) + "\\'"))) + file-ext-list)) + (candidates (-filter (lambda (project-file) + (string-match filename project-file)) + project-file-list)) + (candidates + (-flatten (mapcar + (lambda (file) + (-filter (lambda (project-file) + (string-match file + (concat (file-name-base project-file) + (unless (equal (file-name-extension project-file) nil) + (concat "\." (file-name-extension project-file)))))) + candidates)) + file-list))) + (candidates + (-sort (lambda (file _) + (let ((candidate-dirname (file-name-nondirectory (directory-file-name (file-name-directory file))))) + (unless (equal fulldirname (file-name-directory file)) + (equal dirname candidate-dirname)))) + candidates))) + candidates)) + +(defun projectile-select-files (project-files &optional arg) + "Select a list of files based on filename at point. + +With a prefix ARG invalidates the cache first." + (projectile-maybe-invalidate-cache arg) + (let* ((file (if (region-active-p) + (buffer-substring (region-beginning) (region-end)) + (or (thing-at-point 'filename) ""))) + (file (if (string-match "\\.?\\./" file) + (file-relative-name (file-truename file) (projectile-project-root)) + file)) + (files (if file + (-filter (lambda (project-file) + (string-match file project-file)) + project-files) + nil))) + files)) + +;;;###autoload +(defun projectile-find-file-dwim (&optional arg) + "Jump to a project's files using completion based on context. + +With a prefix ARG invalidates the cache first. + +If point is on a filename, Projectile first tries to search for that +file in project: + +- If it finds just a file, it switches to that file instantly. This works even +if the filename is incomplete, but there's only a single file in the current project +that matches the filename at point. For example, if there's only a single file named +\"projectile/projectile.el\" but the current filename is \"projectile/proj\" (incomplete), +`projectile-find-file' still switches to \"projectile/projectile.el\" immediately + because this is the only filename that matches. + +- If it finds a list of files, the list is displayed for selecting. A list of +files is displayed when a filename appears more than one in the project or the +filename at point is a prefix of more than two files in a project. For example, +if `projectile-find-file' is executed on a filepath like \"projectile/\", it lists +the content of that directory. If it is executed on a partial filename like + \"projectile/a\", a list of files with character 'a' in that directory is presented. + +- If it finds nothing, display a list of all files in project for selecting." + (interactive "P") + (let* ((project-files (projectile-current-project-files)) + (files (projectile-select-files project-files arg))) + (cond + ((= (length files) 1) + (find-file (expand-file-name (car files) (projectile-project-root)))) + ((> (length files) 1) + (find-file (expand-file-name (projectile-completing-read "Switch to: " files) (projectile-project-root)))) + (t (find-file (expand-file-name (projectile-completing-read "Switch to: " project-files) (projectile-project-root))))) + (run-hooks 'projectile-find-file-hook))) + +;;;###autoload +(defun projectile-find-file-dwim-other-window (&optional arg) + "Jump to a project's files using completion based on context in other window. + +With a prefix ARG invalidates the cache first. + +If point is on a filename, Projectile first tries to search for that +file in project: + +- If it finds just a file, it switches to that file instantly. This works even +if the filename is incomplete, but there's only a single file in the current project +that matches the filename at point. For example, if there's only a single file named +\"projectile/projectile.el\" but the current filename is \"projectile/proj\" (incomplete), +`projectile-find-file' still switches to \"projectile/projectile.el\" +immediately because this is the only filename that matches. + +- If it finds a list of files, the list is displayed for selecting. A list of +files is displayed when a filename appears more than one in the project or the +filename at point is a prefix of more than two files in a project. For example, +if `projectile-find-file' is executed on a filepath like \"projectile/\", it lists +the content of that directory. If it is executed on a partial filename +like \"projectile/a\", a list of files with character 'a' in that directory +is presented. + +- If it finds nothing, display a list of all files in project for selecting." + (interactive "P") + (let* ((project-files (projectile-current-project-files)) + (files (projectile-select-files project-files arg))) + (cond + ((= (length files) 1) + (find-file-other-window (expand-file-name (car files) (projectile-project-root)))) + ((> (length files) 1) + (find-file-other-window (expand-file-name (projectile-completing-read "Switch to: " files) (projectile-project-root)))) + (t (find-file-other-window (expand-file-name (projectile-completing-read "Switch to: " project-files) (projectile-project-root))))) + (run-hooks 'projectile-find-file-hook))) + +;;;###autoload +(defun projectile-find-file (&optional arg) + "Jump to a project's file using completion. +With a prefix ARG invalidates the cache first." + (interactive "P") + (projectile-maybe-invalidate-cache arg) + (let ((file (projectile-completing-read "Find file: " + (projectile-current-project-files)))) + (find-file (expand-file-name file (projectile-project-root))) + (run-hooks 'projectile-find-file-hook))) + +;;;###autoload +(defun projectile-find-file-other-window (&optional arg) + "Jump to a project's file using completion and show it in another window. + +With a prefix ARG invalidates the cache first." + (interactive "P") + (projectile-maybe-invalidate-cache arg) + (let ((file (projectile-completing-read "Find file: " + (projectile-current-project-files)))) + (find-file-other-window (expand-file-name file (projectile-project-root))) + (run-hooks 'projectile-find-file-hook))) + +(defun projectile-sort-files (files) + "Sort FILES according to `projectile-sort-order'." + (pcase projectile-sort-order + (`default files) + (`recentf (projectile-sort-by-recentf-first files)) + (`recently-active (projectile-sort-by-recently-active-first files)) + (`modification-time (projectile-sort-by-modification-time files)) + (`access-time (projectile-sort-by-access-time files)))) + +(defun projectile-sort-by-recentf-first (files) + "Sort FILES by a recent first scheme." + (let ((project-recentf-files (projectile-recentf-files))) + (append project-recentf-files + (-difference files project-recentf-files)))) + +(defun projectile-sort-by-recently-active-first (files) + "Sort FILES by most recently active buffers or opened files." + (let ((project-recently-active-files (projectile-recently-active-files))) + (append project-recently-active-files + (-difference files project-recently-active-files)))) + +(defun projectile-sort-by-modification-time (files) + "Sort FILES by modification time." + (let ((default-directory (projectile-project-root))) + (-sort (lambda (file1 file2) + (let ((file1-mtime (nth 5 (file-attributes file1))) + (file2-mtime (nth 5 (file-attributes file2)))) + (not (time-less-p file1-mtime file2-mtime)))) + files))) + +(defun projectile-sort-by-access-time (files) + "Sort FILES by access time." + (let ((default-directory (projectile-project-root))) + (-sort (lambda (file1 file2) + (let ((file1-atime (nth 4 (file-attributes file1))) + (file2-atime (nth 4 (file-attributes file2)))) + (not (time-less-p file1-atime file2-atime)))) + files))) + +;;;###autoload +(defun projectile-find-dir (&optional arg) + "Jump to a project's directory using completion. + +With a prefix ARG invalidates the cache first." + (interactive "P") + (projectile-maybe-invalidate-cache arg) + (let ((dir (projectile-complete-dir))) + (dired (expand-file-name dir (projectile-project-root))) + (run-hooks 'projectile-find-dir-hook))) + +;;;###autoload +(defun projectile-find-dir-other-window (&optional arg) + "Jump to a project's directory in other window using completion. + +With a prefix ARG invalidates the cache first." + (interactive "P") + (when arg + (projectile-invalidate-cache nil)) + (let ((dir (projectile-complete-dir))) + (dired-other-window (expand-file-name dir (projectile-project-root))) + (run-hooks 'projectile-find-dir-hook))) + +(defun projectile-complete-dir () + (projectile-completing-read + "Find dir: " + (if projectile-find-dir-includes-top-level + (append '("./") (projectile-current-project-dirs)) + (projectile-current-project-dirs)))) + +;;;###autoload +(defun projectile-find-test-file (&optional arg) + "Jump to a project's test file using completion. + +With a prefix ARG invalidates the cache first." + (interactive "P") + (projectile-maybe-invalidate-cache arg) + (let ((file (projectile-completing-read "Find test file: " + (projectile-current-project-test-files)))) + (find-file (expand-file-name file (projectile-project-root))))) + +(defun projectile-test-files (files) + "Return only the test FILES." + (-filter 'projectile-test-file-p files)) + +(defun projectile-test-file-p (file) + "Check if FILE is a test file." + (or (--any? (string-prefix-p it (file-name-nondirectory file)) + (-non-nil (list (funcall projectile-test-prefix-function (projectile-project-type))))) + (--any? (string-suffix-p it (file-name-sans-extension (file-name-nondirectory file))) + (-non-nil (list (funcall projectile-test-suffix-function (projectile-project-type))))))) + +(defun projectile-current-project-test-files () + "Return a list of test files for the current project." + (projectile-test-files (projectile-current-project-files))) + +(defvar projectile-project-types (make-hash-table) + "A hash table holding all project types that are known to Projectile.") + +(defun projectile-register-project-type + (project-type marker-files &optional compile-cmd test-cmd run-cmd) + "Register a project type with projectile. + +A project type is defined by PROJECT-TYPE, a set of MARKER-FILES, +a COMPILE-CMD, a TEST-CMD, and a RUN-CMD." + (puthash project-type (list 'marker-files marker-files + 'compile-command compile-cmd + 'test-command test-cmd + 'run-command run-cmd) + projectile-project-types)) + +(projectile-register-project-type 'emacs-cask '("Cask") "cask install") +(projectile-register-project-type 'rails-rspec '("Gemfile" "app" "lib" "db" "config" "spec") "bundle exec rails server" "bundle exec rspec") +(projectile-register-project-type 'rails-test '("Gemfile" "app" "lib" "db" "config" "test") "bundle exec rails server" "bundle exec rake test") +(projectile-register-project-type 'symfony '("composer.json" "app" "src" "vendor") "app/console server:run" "phpunit -c app ") +(projectile-register-project-type 'ruby-rspec '("Gemfile" "lib" "spec") "bundle exec rake" "bundle exec rspec") +(projectile-register-project-type 'ruby-test '("Gemfile" "lib" "test") "bundle exec rake" "bundle exec rake test") +(projectile-register-project-type 'django '("manage.py") "python manage.py runserver" "python manage.py test") +(projectile-register-project-type 'python-pip '("requirements.txt") "python setup.by build" "python -m unittest discover") +(projectile-register-project-type 'python-pkg '("setup.py") "python setup.py build" "python -m unittest discover") +(projectile-register-project-type 'python-tox '("tox.ini") nil "tox") +(projectile-register-project-type 'scons '("SConstruct") "scons" "scons test") +(projectile-register-project-type 'maven '("pom.xml") "mvn clean install" "mvn test") +(projectile-register-project-type 'gradle '("build.gradle") "gradle build" "gradle test") +(projectile-register-project-type 'gradlew '("gradlew") "./gradlew build" "./gradlew test") +(projectile-register-project-type 'grails '("application.properties" "grails-app") "grails package" "grails test-app") +(projectile-register-project-type 'lein-test '("project.clj") "lein compile" "lein test") +(projectile-register-project-type 'lein-midje '("project.clj" ".midje.clj") "lein compile" "lein midje") +(projectile-register-project-type 'boot-clj '("build.boot") "boot aot" "boot test") +(projectile-register-project-type 'rebar '("rebar.config") "rebar" "rebar eunit") +(projectile-register-project-type 'sbt '("build.sbt") "sbt compile" "sbt test") +(projectile-register-project-type 'make '("Makefile") "make" "make test") +(projectile-register-project-type 'grunt '("Gruntfile.js") "grunt" "grunt test") +(projectile-register-project-type 'gulp '("gulpfile.js") "gulp" "gulp test") +(projectile-register-project-type 'haskell-stack '("stack.yaml") "stack build" "stack build --test") +(projectile-register-project-type 'haskell-cabal #'projectile-cabal "cabal build" "cabal test") +(projectile-register-project-type 'rust-cargo '("Cargo.toml") "cargo build" "cargo test") +(projectile-register-project-type 'r '("DESCRIPTION") "R CMD INSTALL ." (concat "R CMD check -o " temporary-file-directory " .")) +(projectile-register-project-type 'go #'projectile-go "go build ./..." "go test ./...") + +(defun projectile-cabal () + "Check if a project contains *.cabal files but no stack.yaml file." + (and (projectile-verify-file "*.cabal") + (not (projectile-verify-file "stack.yaml")))) + +(defun projectile-go () + "Check if a project contains Go source files." + (-any? (lambda (file) + (string= (file-name-extension file) "go")) + (projectile-current-project-files))) + +(defcustom projectile-go-function 'projectile-go + "Function to determine if project's type is go." + :group 'projectile + :type 'function) + +(defvar-local projectile-project-type nil + "Buffer local var for overriding the auto-detected project type. +Normally you'd set this from .dir-locals.el.") + +(defun projectile-detect-project-type () + "Detect the type of the current project." + (let ((project-type (-first (lambda (project-type) + (let ((marker (plist-get (gethash project-type projectile-project-types) 'marker-files))) + (if (listp marker) + (and (projectile-verify-files marker) project-type) + (and (funcall marker) project-type)))) + (projectile-hash-keys projectile-project-types)))) + (when project-type + (puthash (projectile-project-root) project-type projectile-project-type-cache)) + project-type)) + +(defun projectile-project-type () + "Determine the project's type based on its structure." + (if projectile-project-type + projectile-project-type + (or (gethash (projectile-project-root) projectile-project-type-cache) + (projectile-detect-project-type) + 'generic))) + +;;;###autoload +(defun projectile-project-info () + "Display info for current project." + (interactive) + (message "Project dir: %s ## Project VCS: %s ## Project type: %s" + (projectile-project-root) + (projectile-project-vcs) + (projectile-project-type))) + +(defun projectile-verify-files (files) + "Check whether all FILES exist in the current project." + (-all? 'projectile-verify-file files)) + +(defun projectile-verify-file (file) + "Check whether FILE exists in the current project. +Expands wildcards using `file-expand-wildcards' before checking." + (file-expand-wildcards (projectile-expand-root file))) + +(defun projectile-project-vcs (&optional project-root) + "Determine the VCS used by the project if any. +PROJECT-ROOT is the targeted directory. If nil, use +`projectile-project-root'." + (or project-root (setq project-root (projectile-project-root))) + (cond + ((projectile-file-exists-p (expand-file-name ".git" project-root)) 'git) + ((projectile-file-exists-p (expand-file-name ".hg" project-root)) 'hg) + ((projectile-file-exists-p (expand-file-name ".fossil" project-root)) 'fossil) + ((projectile-file-exists-p (expand-file-name ".bzr" project-root)) 'bzr) + ((projectile-file-exists-p (expand-file-name "_darcs" project-root)) 'darcs) + ((projectile-file-exists-p (expand-file-name ".svn" project-root)) 'svn) + ((projectile-locate-dominating-file project-root ".git") 'git) + ((projectile-locate-dominating-file project-root ".hg") 'hg) + ((projectile-locate-dominating-file project-root ".fossil") 'fossil) + ((projectile-locate-dominating-file project-root ".bzr") 'bzr) + ((projectile-locate-dominating-file project-root "_darcs") 'darcs) + ((projectile-locate-dominating-file project-root ".svn") 'svn) + (t 'none))) + +(defun projectile--test-name-for-impl-name (impl-file-path) + (let* ((project-type (projectile-project-type)) + (impl-file-name (file-name-sans-extension (file-name-nondirectory impl-file-path))) + (impl-file-ext (file-name-extension impl-file-path)) + (test-prefix (funcall projectile-test-prefix-function project-type)) + (test-suffix (funcall projectile-test-suffix-function project-type))) + (cond + (test-prefix (concat test-prefix impl-file-name "." impl-file-ext)) + (test-suffix (concat impl-file-name test-suffix "." impl-file-ext)) + (t (error "Project type not supported!"))))) + +(defun projectile-create-test-file-for (impl-file-path) + (let* ((test-file (projectile--test-name-for-impl-name impl-file-path)) + (test-dir (replace-regexp-in-string "src/" "test/" (file-name-directory impl-file-path)))) + (unless (file-exists-p (expand-file-name test-file test-dir)) + (progn (unless (file-exists-p test-dir) + (make-directory test-dir :create-parents)) + (concat test-dir test-file))))) + +(defcustom projectile-create-missing-test-files nil + "During toggling, if non-nil enables creating test files if not found. + +When not-nil, every call to projectile-find-implementation-or-test-* +creates test files if not found on the file system. Defaults to nil. +It assumes the test/ folder is at the same level as src/." + :group 'projectile + :type 'boolean) + +(defun projectile-find-implementation-or-test (file-name) + "Given a FILE-NAME return the matching implementation or test filename." + (unless file-name (error "The current buffer is not visiting a file")) + (if (projectile-test-file-p file-name) + ;; find the matching impl file + (let ((impl-file (projectile-find-matching-file file-name))) + (if impl-file + (projectile-expand-root impl-file) + (error "No matching source file found"))) + ;; find the matching test file + (let ((test-file (projectile-find-matching-test file-name))) + (if test-file + (projectile-expand-root test-file) + (if projectile-create-missing-test-files + (projectile-create-test-file-for file-name) + (error "No matching test file found")))))) + +;;;###autoload +(defun projectile-find-implementation-or-test-other-window () + "Open matching implementation or test file in other window." + (interactive) + (find-file-other-window + (projectile-find-implementation-or-test (buffer-file-name)))) + +;;;###autoload +(defun projectile-toggle-between-implementation-and-test () + "Toggle between an implementation file and its test file." + (interactive) + (find-file + (projectile-find-implementation-or-test (buffer-file-name)))) + +(defun projectile-test-prefix (project-type) + "Find default test files prefix based on PROJECT-TYPE." + (cond + ((member project-type '(django python-pip python-pkg python-tox)) "test_") + ((member project-type '(emacs-cask)) "test-") + ((member project-type '(lein-midje)) "t_"))) + +(defun projectile-test-suffix (project-type) + "Find default test files suffix based on PROJECT-TYPE." + (cond + ((member project-type '(rebar)) "_SUITE") + ((member project-type '(emacs-cask)) "-test") + ((member project-type '(rails-rspec ruby-rspec)) "_spec") + ((member project-type '(rails-test ruby-test lein-test boot-clj go)) "_test") + ((member project-type '(scons)) "test") + ((member project-type '(maven symfony)) "Test") + ((member project-type '(gradle gradlew grails)) "Spec"))) + +(defun projectile-dirname-matching-count (a b) + "Count matching dirnames ascending file paths." + (setq a (reverse (split-string (or (file-name-directory a) "") "/" t)) + b (reverse (split-string (or (file-name-directory b) "") "/" t))) + (let ((common 0)) + (while (and a b (string-equal (pop a) (pop b))) + (setq common (1+ common))) + common)) + +(defun projectile-group-file-candidates (file candidates) + "Group file candidates by dirname matching count." + (--sort (> (car it) (car other)) + (--group-by (projectile-dirname-matching-count file it) candidates))) + +(defun projectile-find-matching-test (file) + "Compute the name of the test matching FILE." + (let* ((basename (file-name-nondirectory (file-name-sans-extension file))) + (test-prefix (funcall projectile-test-prefix-function (projectile-project-type))) + (test-suffix (funcall projectile-test-suffix-function (projectile-project-type))) + (candidates + (-filter (lambda (current-file) + (let ((name (file-name-nondirectory + (file-name-sans-extension current-file)))) + (or (when test-prefix + (string-equal name (concat test-prefix basename))) + (when test-suffix + (string-equal name (concat basename test-suffix)))))) + (projectile-current-project-files)))) + (cond + ((null candidates) nil) + ((= (length candidates) 1) (car candidates)) + (t (let ((grouped-candidates (projectile-group-file-candidates file candidates))) + (if (= (length (car grouped-candidates)) 2) + (-last-item (car grouped-candidates)) + (projectile-completing-read "Switch to: " (--mapcat (cdr it) grouped-candidates)))))))) + +(defun projectile-find-matching-file (test-file) + "Compute the name of a file matching TEST-FILE." + (let* ((basename (file-name-nondirectory (file-name-sans-extension test-file))) + (test-prefix (funcall projectile-test-prefix-function (projectile-project-type))) + (test-suffix (funcall projectile-test-suffix-function (projectile-project-type))) + (candidates + (-filter (lambda (current-file) + (let ((name (file-name-nondirectory + (file-name-sans-extension current-file)))) + (or (when test-prefix + (string-equal (concat test-prefix name) basename)) + (when test-suffix + (string-equal (concat name test-suffix) basename))))) + (projectile-current-project-files)))) + (cond + ((null candidates) nil) + ((= (length candidates) 1) (car candidates)) + (t (let ((grouped-candidates (projectile-group-file-candidates test-file candidates))) + (if (= (length (car grouped-candidates)) 2) + (-last-item (car grouped-candidates)) + (projectile-completing-read "Switch to: " (--mapcat (cdr it) grouped-candidates)))))))) + +(defun projectile-grep-default-files () + "Try to find a default pattern for `projectile-grep'. +This is a subset of `grep-read-files', where either a matching entry from +`grep-files-aliases' or file name extension pattern is returned." + (when buffer-file-name + (let* ((fn (file-name-nondirectory buffer-file-name)) + (default-alias + (let ((aliases (remove (assoc "all" grep-files-aliases) + grep-files-aliases)) + alias) + (while aliases + (setq alias (car aliases) + aliases (cdr aliases)) + (if (string-match (mapconcat + #'wildcard-to-regexp + (split-string (cdr alias) nil t) + "\\|") + fn) + (setq aliases nil) + (setq alias nil))) + (cdr alias))) + (default-extension + (let ((ext (file-name-extension fn))) + (and ext (concat "*." ext))))) + (or default-alias default-extension)))) + +(defun projectile--globally-ignored-file-suffixes-glob () + "Return ignored file suffixes as a list of glob patterns." + (--map (concat "*" it) projectile-globally-ignored-file-suffixes)) + +;;;###autoload +(defun projectile-grep (&optional regexp arg) + "Perform rgrep in the project. + +With a prefix ARG asks for files (globbing-aware) which to grep in. +With prefix ARG of `-' (such as `M--'), default the files (without prompt), +to `projectile-grep-default-files'. + +With REGEXP given, don't query the user for a regexp." + (interactive "i\nP") + (require 'grep) ;; for `rgrep' + (let* ((roots (projectile-get-project-directories)) + (search-regexp (or regexp + (read-string (projectile-prepend-project-name "Grep for: ") + (projectile-symbol-or-selection-at-point)))) + (files (and arg (or (and (equal current-prefix-arg '-) + (projectile-grep-default-files)) + (read-string (projectile-prepend-project-name "Grep in: ") + (projectile-grep-default-files)))))) + (dolist (root-dir roots) + (require 'vc-git) ;; for `vc-git-grep' + ;; in git projects users have the option to use `vc-git-grep' instead of `rgrep' + (if (and (eq (projectile-project-vcs) 'git) + projectile-use-git-grep + (fboundp 'vc-git-grep)) + (vc-git-grep search-regexp (or files "") root-dir) + ;; paths for find-grep should relative and without trailing / + (let ((grep-find-ignored-directories + (-union (--map (directory-file-name (file-relative-name it root-dir)) + (projectile-ignored-directories)) + grep-find-ignored-directories)) + (grep-find-ignored-files + (-union (append (-map (lambda (file) + (file-relative-name file root-dir)) + (projectile-ignored-files)) + (projectile--globally-ignored-file-suffixes-glob)) + grep-find-ignored-files))) + (grep-compute-defaults) + (rgrep search-regexp (or files "* .*") root-dir)))) + (run-hooks 'projectile-grep-finished-hook))) + +;;;###autoload +(defun projectile-ag (search-term &optional arg) + "Run an ag search with SEARCH-TERM in the project. + +With an optional prefix argument ARG SEARCH-TERM is interpreted as a +regular expression." + (interactive + (list (read-from-minibuffer + (projectile-prepend-project-name (format "Ag %ssearch for: " (if current-prefix-arg "regexp " ""))) + (projectile-symbol-or-selection-at-point)) + current-prefix-arg)) + (if (require 'ag nil 'noerror) + (let ((ag-command (if arg 'ag-regexp 'ag)) + (ag-ignore-list (unless (eq (projectile-project-vcs) 'git) + ;; ag supports git ignore files + (-union ag-ignore-list + (append + (projectile-ignored-files-rel) (projectile-ignored-directories-rel) + (projectile--globally-ignored-file-suffixes-glob) + grep-find-ignored-files grep-find-ignored-directories)))) + ;; reset the prefix arg, otherwise it will affect the ag-command + (current-prefix-arg nil)) + (funcall ag-command search-term (projectile-project-root))) + (error "Package 'ag' is not available"))) + +(defun projectile-tags-exclude-patterns () + "Return a string with exclude patterns for ctags." + (mapconcat (lambda (pattern) (format "--exclude=\"%s\"" + (directory-file-name pattern))) + (projectile-ignored-directories-rel) " ")) + +;;;###autoload +(defun projectile-regenerate-tags () + "Regenerate the project's [e|g]tags." + (interactive) + (if (boundp 'ggtags-mode) + (progn + (let* ((ggtags-project-root (projectile-project-root)) + (default-directory ggtags-project-root)) + (ggtags-ensure-project) + (ggtags-update-tags t))) + (let* ((project-root (projectile-project-root)) + (tags-exclude (projectile-tags-exclude-patterns)) + (default-directory project-root) + (tags-file (expand-file-name projectile-tags-file-name)) + (command (format projectile-tags-command tags-file tags-exclude)) + shell-output exit-code) + (with-temp-buffer + (setq exit-code + (call-process-shell-command command nil (current-buffer)) + shell-output (projectile-trim-string + (buffer-substring (point-min) (point-max))))) + (unless (zerop exit-code) + (error shell-output)) + (visit-tags-table tags-file)))) + +(defun projectile-visit-project-tags-table () + "Visit the current project's tags table." + (when (projectile-project-p) + (let ((tags-file (projectile-expand-root projectile-tags-file-name))) + (when (file-exists-p tags-file) + (with-demoted-errors "Error loading tags-file: %s" + (visit-tags-table tags-file t)))))) + +;;;###autoload +(defun projectile-find-tag () + "Find tag in project." + (interactive) + (projectile-visit-project-tags-table) + ;; Auto-discover the user's preference for tags + (let ((find-tag-fn (cond + ((fboundp 'ggtags-find-tag-dwim) + 'ggtags-find-tag-dwim) + ((fboundp 'etags-select-find-tag) + 'etags-select-find-tag) + (t + 'find-tag)))) + (call-interactively find-tag-fn))) + +(defmacro projectile-with-default-dir (dir &rest body) + "Invoke in DIR the BODY." + (declare (debug t) (indent 1)) + `(let ((default-directory ,dir)) + ,@body)) + +;;;###autoload +(defun projectile-run-command-in-root () + "Invoke `execute-extended-command' in the project's root." + (interactive) + (projectile-with-default-dir (projectile-project-root) + (call-interactively 'execute-extended-command))) + +;;;###autoload +(defun projectile-run-shell-command-in-root () + "Invoke `shell-command' in the project's root." + (interactive) + (projectile-with-default-dir (projectile-project-root) + (call-interactively 'shell-command))) + +;;;###autoload +(defun projectile-run-async-shell-command-in-root () + "Invoke `async-shell-command' in the project's root." + (interactive) + (projectile-with-default-dir (projectile-project-root) + (call-interactively 'async-shell-command))) + +;;;###autoload +(defun projectile-run-shell () + "Invoke `shell' in the project's root." + (interactive) + (projectile-with-default-dir (projectile-project-root) + (shell (concat "*shell " (projectile-project-name) "*")))) + +;;;###autoload +(defun projectile-run-eshell () + "Invoke `eshell' in the project's root." + (interactive) + (let ((eshell-buffer-name (concat "*eshell " (projectile-project-name) "*"))) + (projectile-with-default-dir (projectile-project-root) + (eshell)))) + +;;;###autoload +(defun projectile-run-term (program) + "Invoke `term' in the project's root." + (interactive (list nil)) + (let* ((term (concat "term " (projectile-project-name))) + (buffer (concat "*" term "*"))) + (unless (get-buffer buffer) + (require 'term) + (let ((program (or program + (read-from-minibuffer "Run program: " + (or explicit-shell-file-name + (getenv "ESHELL") + (getenv "SHELL") + "/bin/sh"))))) + (projectile-with-default-dir (projectile-project-root) + (set-buffer (make-term term program)) + (term-mode) + (term-char-mode)))) + (switch-to-buffer buffer))) + +(defun projectile-files-in-project-directory (directory) + "Return a list of files in DIRECTORY." + (let ((dir (file-relative-name (expand-file-name directory) + (projectile-project-root)))) + (--filter (string-prefix-p dir it) + (projectile-current-project-files)))) + +(defun projectile-unixy-system-p () + "Check to see if unixy text utilities are installed." + (--all? (executable-find it) '("grep" "cut" "uniq"))) + +(defun projectile-files-from-cmd (cmd directory) + "Use a grep-like CMD to search for files within DIRECTORY. + +CMD should include the necessary search params and should output +equivalently to grep -HlI (only unique matching filenames). +Returns a list of expanded filenames." + (let ((default-directory directory)) + (--map (concat directory + (if (string-prefix-p "./" it) (substring it 2) it)) + (-> (shell-command-to-string cmd) + projectile-trim-string + (split-string "\n+" t))))) + +(defun projectile-files-with-string (string directory) + "Return a list of all files containing STRING in DIRECTORY. + +Tries to use ag, ack, git-grep, and grep in that order. If those +are impossible (for instance on Windows), returns a list of all +files in the project." + (if (projectile-unixy-system-p) + (let* ((search-term (shell-quote-argument string)) + (cmd (cond ((executable-find "ag") + (concat "ag --literal --nocolor --noheading -l -- " + search-term)) + ((executable-find "ack") + (concat "ack --literal --noheading --nocolor -l -- " + search-term)) + ((and (executable-find "git") + (eq (projectile-project-vcs) 'git)) + (concat "git grep -HlI " search-term)) + (t + ;; -r: recursive + ;; -H: show filename for each match + ;; -l: show only file names with matches + ;; -I: no binary files + (format "grep -rHlI %s ." search-term))))) + (projectile-files-from-cmd cmd directory)) + ;; we have to reject directories as a workaround to work with git submodules + (-reject #'file-directory-p + (-map #'projectile-expand-root (projectile-dir-files directory))))) + +;;;###autoload +(defun projectile-replace (&optional arg) + "Replace literal string in project using non-regexp `tags-query-replace'. + +With a prefix argument ARG prompts you for a directory on which +to run the replacement." + (interactive "P") + (let* ((old-text (read-string + (projectile-prepend-project-name "Replace: ") + (projectile-symbol-or-selection-at-point))) + (new-text (read-string + (projectile-prepend-project-name + (format "Replace %s with: " old-text)))) + (directory (if arg + (file-name-as-directory + (read-directory-name "Replace in directory: ")) + (projectile-project-root))) + (files (projectile-files-with-string old-text directory))) + ;; Adapted from `tags-query-replace' for literal strings (not regexp) + (setq tags-loop-scan `(let ,(unless (equal old-text (downcase old-text)) + '((case-fold-search nil))) + (if (search-forward ',old-text nil t) + ;; When we find a match, move back to + ;; the beginning of it so + ;; perform-replace will see it. + (goto-char (match-beginning 0)))) + tags-loop-operate `(perform-replace ',old-text ',new-text t nil nil + nil multi-query-replace-map)) + (tags-loop-continue (or (cons 'list files) t)))) + +;;;###autoload +(defun projectile-replace-regexp (&optional arg) + "Replace a regexp in the project using `tags-query-replace'. + +With a prefix argument ARG prompts you for a directory on which +to run the replacement." + (interactive "P") + (let* ((old-text (read-string + (projectile-prepend-project-name "Replace regexp: ") + (projectile-symbol-or-selection-at-point))) + (new-text (read-string + (projectile-prepend-project-name + (format "Replace regexp %s with: " old-text)))) + (directory (if arg + (file-name-as-directory + (read-directory-name "Replace regexp in directory: ")) + (projectile-project-root))) + (files + ;; We have to reject directories as a workaround to work with git submodules. + ;; + ;; We can't narrow the list of files with + ;; `projectile-files-with-string' because those regexp tools + ;; don't support Emacs regular expressions. + (-reject #'file-directory-p + (-map #'projectile-expand-root (projectile-dir-files directory))))) + (tags-query-replace old-text new-text nil (cons 'list files)))) + +(defun projectile-symbol-or-selection-at-point () + "Get the symbol or selected text at point." + (if (use-region-p) + (buffer-substring-no-properties (region-beginning) (region-end)) + (projectile-symbol-at-point))) + +(defun projectile-symbol-at-point () + "Get the symbol at point and strip its properties." + (substring-no-properties (or (thing-at-point 'symbol) ""))) + +;;;###autoload +(defun projectile-kill-buffers () + "Kill all project buffers." + (interactive) + (let ((name (projectile-project-name)) + (buffers (projectile-project-buffers))) + (if (yes-or-no-p + (format "Are you sure you want to kill %d buffer(s) for '%s'? " + (length buffers) name)) + ;; we take care not to kill indirect buffers directly + ;; as we might encounter them after their base buffers are killed + (mapc #'kill-buffer (-remove 'buffer-base-buffer buffers))))) + +;;;###autoload +(defun projectile-save-project-buffers () + "Save all project buffers." + (interactive) + (--each (projectile-project-buffers) + (with-current-buffer it + (when buffer-file-name + (save-buffer))))) + +;;;###autoload +(defun projectile-dired () + "Open `dired' at the root of the project." + (interactive) + (dired (projectile-project-root))) + +;;;###autoload +(defun projectile-vc (&optional project-root) + "Open `vc-dir' at the root of the project. + +For git projects `magit-status-internal' is used if available. +For hg projects `monky-status' is used if available." + (interactive) + (or project-root (setq project-root (projectile-project-root))) + (let ((vcs (projectile-project-vcs project-root))) + (pcase vcs + (`git + (cond ((fboundp 'magit-status-internal) + (magit-status-internal project-root)) + ((fboundp 'magit-status) + (with-no-warnings (magit-status project-root))) + (t + (vc-dir project-root)))) + (`hg + (if (fboundp 'monky-status) + (monky-status project-root) + (vc-dir project-root))) + (_ (vc-dir project-root))))) + +;;;###autoload +(defun projectile-recentf () + "Show a list of recently visited files in a project." + (interactive) + (if (boundp 'recentf-list) + (find-file (projectile-expand-root (projectile-completing-read "Recently visited files: " (projectile-recentf-files)))) + (message "recentf is not enabled"))) + +(defun projectile-recentf-files () + "Return a list of recently visited files in a project." + (and (boundp 'recentf-list) + (let ((project-root (projectile-project-root))) + (->> recentf-list + (--filter (string-prefix-p project-root it)) + (--map (file-relative-name it project-root)))))) + +(defun projectile-serialize-cache () + "Serializes the memory cache to the hard drive." + (projectile-serialize projectile-projects-cache projectile-cache-file)) + +(defvar projectile-compilation-cmd-map + (make-hash-table :test 'equal) + "A mapping between projects and the last compilation command used on them.") + +(defvar projectile-test-cmd-map + (make-hash-table :test 'equal) + "A mapping between projects and the last test command used on them.") + +(defvar projectile-run-cmd-map + (make-hash-table :test 'equal) + "A mapping between projects and the last run command used on them.") + +(defvar projectile-project-compilation-cmd nil + "The command to use with `projectile-compile-project'. +It takes precedence over the default command for the project type when set. +Should be set via .dir-locals.el.") + +(defvar projectile-project-compilation-dir nil + "The directory to use with `projectile-compile-project'. +The directory path is relative to the project root. +Should be set via .dir-locals.el.") + +(defvar projectile-project-test-cmd nil + "The command to use with `projectile-test-project'. +It takes precedence over the default command for the project type when set. +Should be set via .dir-locals.el.") + +(defvar projectile-project-run-cmd nil + "The command to use with `projectile-run-project'. +It takes precedence over the default command for the project type when set. +Should be set via .dir-locals.el.") + +(defun projectile-default-compilation-command (project-type) + "Retrieve default compilation command for PROJECT-TYPE." + (plist-get (gethash project-type projectile-project-types) 'compile-command)) + +(defun projectile-default-test-command (project-type) + "Retrieve default test command for PROJECT-TYPE." + (plist-get (gethash project-type projectile-project-types) 'test-command)) + +(defun projectile-default-run-command (project-type) + "Retrieve default run command for PROJECT-TYPE." + (plist-get (gethash project-type projectile-project-types) 'run-command)) + +(defun projectile-compilation-command (compile-dir) + "Retrieve the compilation command for COMPILE-DIR." + (or (gethash compile-dir projectile-compilation-cmd-map) + projectile-project-compilation-cmd + (projectile-default-compilation-command (projectile-project-type)))) + +(defun projectile-test-command (project) + "Retrieve the test command for PROJECT." + (or (gethash project projectile-test-cmd-map) + projectile-project-test-cmd + (projectile-default-test-command (projectile-project-type)))) + +(defun projectile-run-command (project) + "Retrieve the run command for PROJECT." + (or (gethash project projectile-run-cmd-map) + projectile-project-run-cmd + (projectile-default-run-command (projectile-project-type)))) + +(defun projectile-read-command (prompt command) + "Adapted from `compilation-read-command'." + (read-shell-command prompt command + (if (equal (car compile-history) command) + '(compile-history . 1) + 'compile-history))) + +(defun projectile-compilation-dir () + "Choose the directory to use for project compilation." + (if projectile-project-compilation-dir + (file-truename + (concat (file-name-as-directory (projectile-project-root)) + (file-name-as-directory projectile-project-compilation-dir))) + (projectile-project-root))) + +(defun projectile-maybe-read-command (arg default-cmd prompt) + "Prompt user for command unless DEFAULT-CMD is an Elisp function." + (if (and (or (stringp default-cmd) (null default-cmd)) + (or compilation-read-command arg)) + (projectile-read-command prompt default-cmd) + default-cmd)) + +(defun projectile-run-compilation (cmd) + "Run external or Elisp compilation command CMD." + (if (functionp cmd) + (funcall cmd) + (compilation-start cmd))) + +;;;###autoload +(defun projectile-compile-project (arg &optional dir) + "Run project compilation command. + +Normally you'll be prompted for a compilation command, unless +variable `compilation-read-command'. You can force the prompt +with a prefix ARG." + (interactive "P") + (let* ((project-root (projectile-project-root)) + (default-directory (or dir (projectile-compilation-dir))) + (default-cmd (projectile-compilation-command default-directory)) + (compilation-cmd (projectile-maybe-read-command arg default-cmd "Compile command: "))) + (puthash default-directory compilation-cmd projectile-compilation-cmd-map) + (save-some-buffers (not compilation-ask-about-save) + (lambda () + (projectile-project-buffer-p (current-buffer) + project-root))) + (projectile-run-compilation compilation-cmd))) + +(defadvice compilation-find-file (around projectile-compilation-find-file) + "Try to find a buffer for FILENAME, if we cannot find it, +fallback to the original function." + (let ((filename (ad-get-arg 1))) + (ad-set-arg 1 + (or + (if (file-exists-p (expand-file-name filename)) + filename) + ;; Try to find the filename using projectile + (and (projectile-project-p) + (let ((root (projectile-project-root)) + (dirs (cons "" (projectile-current-project-dirs)))) + (-when-let (full-filename (->> dirs + (--map (expand-file-name filename (expand-file-name it root))) + (-filter #'file-exists-p) + (-first-item))) + full-filename))) + ;; Fall back to the old argument + filename)) + ad-do-it)) + +;; TODO - factor this duplication out +;;;###autoload +(defun projectile-test-project (arg) + "Run project test command. + +Normally you'll be prompted for a compilation command, unless +variable `compilation-read-command'. You can force the prompt +with a prefix ARG." + (interactive "P") + (let* ((project-root (projectile-project-root)) + (default-cmd (projectile-test-command project-root)) + (test-cmd (projectile-maybe-read-command arg default-cmd "Test command: ")) + (default-directory project-root)) + (puthash project-root test-cmd projectile-test-cmd-map) + (projectile-run-compilation test-cmd))) + +;;;###autoload +(defun projectile-run-project (arg) + "Run project run command. + +Normally you'll be prompted for a compilation command, unless +variable `compilation-read-command'. You can force the prompt +with a prefix ARG." + (interactive "P") + (let* ((project-root (projectile-project-root)) + (default-cmd (projectile-run-command project-root)) + (run-cmd (projectile-maybe-read-command arg default-cmd "Run command: ")) + (default-directory project-root)) + (puthash project-root run-cmd projectile-run-cmd-map) + (projectile-run-compilation run-cmd))) + +(defun projectile-open-projects () + "Return a list of all open projects. +An open project is a project with any open buffers." + (-distinct + (-non-nil + (-map (lambda (buffer) + (with-current-buffer buffer + (when (projectile-project-p) + (abbreviate-file-name (projectile-project-root))))) + (buffer-list))))) + +(defun projectile--remove-current-project (projects) + "Remove the current project (if any) from the list of PROJECTS." + (if (projectile-project-p) + (-difference projects + (list (abbreviate-file-name (projectile-project-root)))) + projects)) + +(defun projectile-relevant-known-projects () + "Return a list of known projects except the current one (if present)." + (projectile--remove-current-project projectile-known-projects)) + +(defun projectile-relevant-open-projects () + "Return a list of open projects except the current one (if present)." + (projectile--remove-current-project (projectile-open-projects))) + +;;;###autoload +(defun projectile-switch-project (&optional arg) + "Switch to a project we have visited before. +Invokes the command referenced by `projectile-switch-project-action' on switch. +With a prefix ARG invokes `projectile-commander' instead of +`projectile-switch-project-action.'" + (interactive "P") + (-if-let (projects (projectile-relevant-known-projects)) + (projectile-switch-project-by-name + (projectile-completing-read "Switch to project: " projects) + arg) + (error "There are no known projects"))) + +;;;###autoload +(defun projectile-switch-open-project (&optional arg) + "Switch to a project we have currently opened. +Invokes the command referenced by `projectile-switch-project-action' on switch. +With a prefix ARG invokes `projectile-commander' instead of +`projectile-switch-project-action.'" + (interactive "P") + (-if-let (projects (projectile-relevant-open-projects)) + (projectile-switch-project-by-name + (projectile-completing-read "Switch to open project: " projects) + arg) + (error "There are no open projects"))) + +(defun projectile-switch-project-by-name (project-to-switch &optional arg) + "Switch to project by project name PROJECT-TO-SWITCH. +Invokes the command referenced by `projectile-switch-project-action' on switch. +With a prefix ARG invokes `projectile-commander' instead of +`projectile-switch-project-action.'" + (let* ((default-directory project-to-switch) + (switch-project-action (if arg + 'projectile-commander + projectile-switch-project-action))) + (run-hooks 'projectile-before-switch-project-hook) + (funcall switch-project-action) + (run-hooks 'projectile-after-switch-project-hook))) + +;;;###autoload +(defun projectile-find-file-in-directory (&optional directory) + "Jump to a file in a (maybe regular) DIRECTORY. + +This command will first prompt for the directory the file is in." + (interactive "DFind file in directory: ") + (let ((default-directory directory) + (projectile-require-project-root nil)) + (if (projectile-project-p) + ;; target directory is in a project + (let ((file (projectile-completing-read "Find file: " + (projectile-dir-files directory)))) + (find-file (expand-file-name file (projectile-project-root))) + (run-hooks 'projectile-find-file-hook)) + ;; target directory is not in a project + (projectile-find-file)))) + +(defun projectile-all-project-files () + "Get a list of all files in all projects." + (-mapcat (lambda (project) + (when (file-exists-p project) + (let ((default-directory project)) + (-map (lambda (file) + (expand-file-name file project)) + (projectile-current-project-files))))) + projectile-known-projects)) + +;;;###autoload +(defun projectile-find-file-in-known-projects () + "Jump to a file in any of the known projects." + (interactive) + (let ((projectile-require-project-root nil)) + (find-file (projectile-completing-read "Find file in projects: " (projectile-all-project-files))))) + +(defcustom projectile-after-switch-project-hook nil + "Hooks run right after project is switched." + :group 'projectile + :type 'hook) + +(defcustom projectile-before-switch-project-hook nil + "Hooks run when right before project is switched." + :group 'projectile + :type 'hook) + +(defun projectile-keep-project-p (project) + "Determine whether we should cleanup (remove) PROJECT or not. + +It handles the case of remote projects as well. +See `projectile-cleanup-known-projects'." + ;; Taken from from `recentf-keep-default-predicate' + (cond + ((file-remote-p project nil t) (file-readable-p project)) + ((file-remote-p project)) + ((file-readable-p project)))) + +;;;###autoload +(defun projectile-cleanup-known-projects () + "Remove known projects that don't exist anymore." + (interactive) + (projectile-merge-known-projects) + (let* ((separated-projects + (-separate #'projectile-keep-project-p projectile-known-projects)) + (projects-kept (car separated-projects)) + (projects-removed (cadr separated-projects))) + (setq projectile-known-projects projects-kept) + (projectile-merge-known-projects) + (if projects-removed + (message "Projects removed: %s" + (mapconcat #'identity projects-removed ", ")) + (message "No projects needed to be removed.")))) + +;;;###autoload +(defun projectile-clear-known-projects () + "Clear both `projectile-known-projects' and `projectile-known-projects-file'." + (interactive) + (setq projectile-known-projects nil) + (projectile-save-known-projects)) + +;;;###autoload +(defun projectile-remove-known-project (&optional project) + "Remove PROJECT from the list of known projects." + (interactive (list (projectile-completing-read "Remove from known projects: " + projectile-known-projects))) + (setq projectile-known-projects + (--reject (string= project it) projectile-known-projects)) + (projectile-merge-known-projects) + (when projectile-verbose + (message "Project %s removed from the list of known projects." project))) + +;;;###autoload +(defun projectile-remove-current-project-from-known-projects () + "Remove the current project from the list of known projects." + (interactive) + (projectile-remove-known-project (abbreviate-file-name (projectile-project-root)))) + +(defun projectile-ignored-projects () + "A list of projects that should not be save in `projectile-known-projects'." + (-map #'file-truename projectile-ignored-projects)) + +(defun projectile-ignored-project-p (project-root) + "Return t if PROJECT-ROOT should not be added to `projectile-known-projects'." + (or (member project-root (projectile-ignored-projects)) + (and (functionp projectile-ignored-project-function) + (funcall projectile-ignored-project-function project-root)))) + +(defun projectile-add-known-project (project-root) + "Add PROJECT-ROOT to the list of known projects." + (unless (projectile-ignored-project-p project-root) + (setq projectile-known-projects + (-distinct + (cons (abbreviate-file-name project-root) + projectile-known-projects))))) + +(defun projectile-load-known-projects () + "Load saved projects from `projectile-known-projects-file'. +Also set `projectile-known-projects'." + (setq projectile-known-projects + (projectile-unserialize projectile-known-projects-file)) + (setq projectile-known-projects-on-file + (and (sequencep projectile-known-projects) + (copy-sequence projectile-known-projects)))) + +;; load the known projects +(projectile-load-known-projects) + +(defun projectile-save-known-projects () + "Save PROJECTILE-KNOWN-PROJECTS to PROJECTILE-KNOWN-PROJECTS-FILE." + (projectile-serialize projectile-known-projects + projectile-known-projects-file) + (setq projectile-known-projects-on-file + (and (sequencep projectile-known-projects) + (copy-sequence projectile-known-projects)))) + +(defun projectile-merge-known-projects () + "Merge any change from `projectile-known-projects-file' and save to disk. + +This enables multiple Emacs processes to make changes without +overwriting each other's changes." + (let* ((known-now projectile-known-projects) + (known-on-last-sync projectile-known-projects-on-file) + (known-on-file + (projectile-unserialize projectile-known-projects-file)) + (removed-after-sync (-difference known-on-last-sync known-now)) + (removed-in-other-process + (-difference known-on-last-sync known-on-file)) + (result (-distinct + (-difference + (-concat known-now known-on-file) + (-concat removed-after-sync removed-in-other-process))))) + (setq projectile-known-projects result) + (projectile-save-known-projects))) + +(define-ibuffer-filter projectile-files + "Show Ibuffer with all buffers in the current project." + (:reader (read-directory-name "Project root: " (ignore-errors (projectile-project-root))) + :description nil) + (with-current-buffer buf + (equal (file-name-as-directory (expand-file-name qualifier)) + (ignore-errors (projectile-project-root))))) + +(defun projectile-ibuffer-by-project (project-root) + "Open an IBuffer window showing all buffers in PROJECT-ROOT." + (let ((project-name (funcall projectile-project-name-function project-root))) + (ibuffer nil (format "*%s Buffers*" project-name) + (list (cons 'projectile-files project-root))))) + +;;;###autoload +(defun projectile-ibuffer (prefix) + "Open an IBuffer window showing all buffers in the current project. + +Let user choose another project when PREFIX is supplied." + (interactive "p") + (let ((project-root (if (= prefix 4) + (projectile-completing-read + "Project name: " + (projectile-relevant-known-projects)) + (projectile-project-root)))) + + (projectile-ibuffer-by-project project-root))) + +;;;; projectile-commander + +(defconst projectile-commander-help-buffer "*Commander Help*") + +(defvar projectile-commander-methods nil + "List of file-selection methods for the `projectile-commander' command. +Each element is a list (KEY DESCRIPTION FUNCTION). +DESCRIPTION is a one-line description of what the key selects.") + +;;;###autoload +(defun projectile-commander () + "Execute a Projectile command with a single letter. +The user is prompted for a single character indicating the action to invoke. +The `?' character describes then +available actions. + +See `def-projectile-commander-method' for defining new methods." + (interactive) + (-let* ((choices (-map #'car projectile-commander-methods)) + (prompt (concat "Commander [" choices "]: ")) + (ch (read-char-choice prompt choices)) + ((_ _ fn) (assq ch projectile-commander-methods))) + (funcall fn))) + +(defmacro def-projectile-commander-method (key description &rest body) + "Define a new `projectile-commander' method. + +KEY is the key the user will enter to choose this method. + +DESCRIPTION is a one-line sentence describing how the method. + +BODY is a series of forms which are evaluated when the find +is chosen." + (let ((method `(lambda () + ,@body))) + `(setq projectile-commander-methods + (--sort (< (car it) (car other)) + (cons (list ,key ,description ,method) + (assq-delete-all ,key projectile-commander-methods)))))) + +(def-projectile-commander-method ?? "Commander help buffer." + (ignore-errors (kill-buffer projectile-commander-help-buffer)) + (with-current-buffer (get-buffer-create projectile-commander-help-buffer) + (insert "Projectile Commander Methods:\n\n") + (--each projectile-commander-methods + (-let [(key line _) it] + (insert (format "%c:\t%s\n" key line)))) + (goto-char (point-min)) + (help-mode) + (display-buffer (current-buffer) t)) + (projectile-commander)) + +(defun projectile-commander-bindings () + (def-projectile-commander-method ?A + "Find ag on project." + (call-interactively 'projectile-ag)) + + (def-projectile-commander-method ?f + "Find file in project." + (projectile-find-file)) + + (def-projectile-commander-method ?T + "Find test file in project." + (projectile-find-test-file)) + + (def-projectile-commander-method ?b + "Switch to project buffer." + (projectile-switch-to-buffer)) + + (def-projectile-commander-method ?d + "Find directory in project." + (projectile-find-dir)) + + (def-projectile-commander-method ?D + "Open project root in dired." + (projectile-dired)) + + (def-projectile-commander-method ?v + "Open project root in vc-dir or magit." + (projectile-vc)) + + (def-projectile-commander-method ?r + "Replace a string in the project." + (projectile-replace)) + + (def-projectile-commander-method ?R + "Regenerate the project's [e|g]tags." + (projectile-regenerate-tags)) + + (def-projectile-commander-method ?g + "Run grep on project." + (projectile-grep)) + + (def-projectile-commander-method ?s + "Switch project." + (projectile-switch-project)) + + (def-projectile-commander-method ?o + "Run multi-occur on project buffers." + (projectile-multi-occur)) + + (def-projectile-commander-method ?j + "Find tag in project." + (projectile-find-tag)) + + (def-projectile-commander-method ?k + "Kill all project buffers." + (projectile-kill-buffers)) + + (def-projectile-commander-method ?e + "Find recently visited file in project." + (projectile-recentf))) + +(projectile-commander-bindings) + +(defun projectile-read-variable () + "Prompt for a variable and return its name." + (completing-read "Variable: " + obarray + '(lambda (v) + (and (boundp v) (not (keywordp v)))) + t)) + +(define-skeleton projectile-skel-variable-cons + "Insert a variable-name and a value in a cons-cell." + "Value: " + "(" + (projectile-read-variable) + " . " + str + ")") + +(define-skeleton projectile-skel-dir-locals + "Insert a .dir-locals.el template." + nil + "((nil . (" + ("" '(projectile-skel-variable-cons) \n) + resume: + ")))") + +;;;###autoload +(defun projectile-edit-dir-locals () + "Edit or create a .dir-locals.el file of the project." + (interactive) + (let ((file (expand-file-name ".dir-locals.el" (projectile-project-root)))) + (find-file file) + (when (not (file-exists-p file)) + (unwind-protect + (projectile-skel-dir-locals) + (save-buffer))))) + +;;; Minor mode +(defvar projectile-command-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "4 a") #'projectile-find-other-file-other-window) + (define-key map (kbd "4 b") #'projectile-switch-to-buffer-other-window) + (define-key map (kbd "4 C-o") #'projectile-display-buffer) + (define-key map (kbd "4 d") #'projectile-find-dir-other-window) + (define-key map (kbd "4 f") #'projectile-find-file-other-window) + (define-key map (kbd "4 g") #'projectile-find-file-dwim-other-window) + (define-key map (kbd "4 t") #'projectile-find-implementation-or-test-other-window) + (define-key map (kbd "!") #'projectile-run-shell-command-in-root) + (define-key map (kbd "&") #'projectile-run-async-shell-command-in-root) + (define-key map (kbd "a") #'projectile-find-other-file) + (define-key map (kbd "b") #'projectile-switch-to-buffer) + (define-key map (kbd "c") #'projectile-compile-project) + (define-key map (kbd "d") #'projectile-find-dir) + (define-key map (kbd "D") #'projectile-dired) + (define-key map (kbd "e") #'projectile-recentf) + (define-key map (kbd "E") #'projectile-edit-dir-locals) + (define-key map (kbd "f") #'projectile-find-file) + (define-key map (kbd "g") #'projectile-find-file-dwim) + (define-key map (kbd "F") #'projectile-find-file-in-known-projects) + (define-key map (kbd "i") #'projectile-invalidate-cache) + (define-key map (kbd "I") #'projectile-ibuffer) + (define-key map (kbd "j") #'projectile-find-tag) + (define-key map (kbd "k") #'projectile-kill-buffers) + (define-key map (kbd "l") #'projectile-find-file-in-directory) + (define-key map (kbd "m") #'projectile-commander) + (define-key map (kbd "o") #'projectile-multi-occur) + (define-key map (kbd "p") #'projectile-switch-project) + (define-key map (kbd "q") #'projectile-switch-open-project) + (define-key map (kbd "P") #'projectile-test-project) + (define-key map (kbd "r") #'projectile-replace) + (define-key map (kbd "R") #'projectile-regenerate-tags) + (define-key map (kbd "s g") #'projectile-grep) + (define-key map (kbd "s s") #'projectile-ag) + (define-key map (kbd "S") #'projectile-save-project-buffers) + (define-key map (kbd "t") #'projectile-toggle-between-implementation-and-test) + (define-key map (kbd "T") #'projectile-find-test-file) + (define-key map (kbd "u") #'projectile-run-project) + (define-key map (kbd "v") #'projectile-vc) + (define-key map (kbd "x e") #'projectile-run-eshell) + (define-key map (kbd "x t") #'projectile-run-term) + (define-key map (kbd "x s") #'projectile-run-shell) + (define-key map (kbd "z") #'projectile-cache-current-file) + (define-key map (kbd "ESC") #'projectile-project-buffers-other-buffer) + map) + "Keymap for Projectile commands after `projectile-keymap-prefix'.") +(fset 'projectile-command-map projectile-command-map) + +(defvar projectile-mode-map + (let ((map (make-sparse-keymap))) + (define-key map projectile-keymap-prefix 'projectile-command-map) + map) + "Keymap for Projectile mode.") + +(easy-menu-change + '("Tools") "Projectile" + '(["Find file" projectile-find-file] + ["Find file in known projects" projectile-find-file-in-known-projects] + ["Find test file" projectile-find-test-file] + ["Find directory" projectile-find-dir] + ["Find file in directory" projectile-find-file-in-directory] + ["Find other file" projectile-find-other-file] + ["Switch to buffer" projectile-switch-to-buffer] + ["Jump between implementation file and test file" projectile-toggle-between-implementation-and-test] + ["Kill project buffers" projectile-kill-buffers] + ["Recent files" projectile-recentf] + ["Edit .dir-locals.el" projectile-edit-dir-locals] + "--" + ["Open project in dired" projectile-dired] + ["Switch to project" projectile-switch-project] + ["Switch to open project" projectile-switch-open-project] + ["Search in project (grep)" projectile-grep] + ["Search in project (ag)" projectile-ag] + ["Replace in project" projectile-replace] + ["Multi-occur in project" projectile-multi-occur] + "--" + ["Run shell" projectile-run-shell] + ["Run eshell" projectile-run-eshell] + ["Run term" projectile-run-term] + "--" + ["Cache current file" projectile-cache-current-file] + ["Invalidate cache" projectile-invalidate-cache] + ["Regenerate [e|g]tags" projectile-regenerate-tags] + "--" + ["Compile project" projectile-compile-project] + ["Test project" projectile-test-project] + ["Run project" projectile-run-project] + "--" + ["Project info" projectile-project-info] + ["About" projectile-version]) + "Search Files (Grep)...") + +(easy-menu-change '("Tools") "--" nil "Search Files (Grep)...") + +;;;###autoload +(defcustom projectile-mode-line + '(:eval (if (file-remote-p default-directory) + " Projectile" + (format " Projectile[%s]" (projectile-project-name)))) + "Mode line lighter for Projectile. + +The value of this variable is a mode line template as in +`mode-line-format'. See Info Node `(elisp)Mode Line Format' for +details about mode line templates. + +Customize this variable to change how Projectile displays its +status in the mode line. The default value displays the project +name. Set this variable to nil to disable the mode line +entirely." + :group 'projectile + :type 'sexp + :risky t + :package-version '(projectile "0.12.0")) + +;;;###autoload +(define-minor-mode projectile-mode + "Minor mode to assist project management and navigation. + +When called interactively, toggle `projectile-mode'. With prefix +ARG, enable `projectile-mode' if ARG is positive, otherwise disable +it. + +When called from Lisp, enable `projectile-mode' if ARG is omitted, +nil or positive. If ARG is `toggle', toggle `projectile-mode'. +Otherwise behave as if called interactively. + +\\{projectile-mode-map}" + :lighter projectile-mode-line + :keymap projectile-mode-map + :group 'projectile + :require 'projectile + (cond + (projectile-mode + ;; initialize the projects cache if needed + (unless projectile-projects-cache + (setq projectile-projects-cache + (or (projectile-unserialize projectile-cache-file) + (make-hash-table :test 'equal)))) + (add-hook 'find-file-hook #'projectile-cache-files-find-file-hook t t) + (add-hook 'find-file-hook #'projectile-cache-projects-find-file-hook t t) + (add-hook 'projectile-find-dir-hook #'projectile-cache-projects-find-file-hook) + (add-hook 'find-file-hook #'projectile-visit-project-tags-table t t) + (add-hook 'dired-before-readin-hook #'projectile-cache-projects-find-file-hook t t) + (ad-activate 'compilation-find-file) + (ad-activate 'delete-file)) + (t + (remove-hook 'find-file-hook #'projectile-cache-files-find-file-hook t) + (remove-hook 'find-file-hook #'projectile-cache-projects-find-file-hook t) + (remove-hook 'find-file-hook #'projectile-visit-project-tags-table t) + (remove-hook 'dired-before-readin-hook #'projectile-cache-projects-find-file-hook t) + (ad-deactivate 'compilation-find-file) + (ad-deactivate 'delete-file)))) + +;;;###autoload +(define-globalized-minor-mode projectile-global-mode + projectile-mode + projectile-mode) + +(provide 'projectile) + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: + +;;; projectile.el ends here