diff --git a/bundle/custom.el b/bundle/custom.el index c5b3eb18..c7741cc0 100644 --- a/bundle/custom.el +++ b/bundle/custom.el @@ -69,7 +69,7 @@ '(package-enable-at-startup t) '(package-selected-packages (quote - (ivy elpy olivetti ace-window graphviz-dot-mode dot-mode plantuml-mode elisp-format elisp-lint flymake-racket google-translate org-pomodoro elm-mode dashboard pickle poet-theme flymake-eslint json-mode darkroom dockerfile-mode ein spacemacs-theme flucui-themes leuven-theme htmlize scss-mode berrys-theme web-mode python-docstring sphinx-doc sphinx-frontend sphinx-mode ox-nikola racket-mode slime gherkin-mode powershell typescript-mode ob-http ob-ipython ob-restclient nord-theme restclient request restclient-test yaml-mode magit))) + (projectile python-django ivy elpy olivetti ace-window graphviz-dot-mode dot-mode plantuml-mode elisp-format elisp-lint flymake-racket google-translate org-pomodoro elm-mode dashboard pickle poet-theme flymake-eslint json-mode darkroom dockerfile-mode ein spacemacs-theme flucui-themes leuven-theme htmlize scss-mode berrys-theme web-mode python-docstring sphinx-doc sphinx-frontend sphinx-mode ox-nikola racket-mode slime gherkin-mode powershell typescript-mode ob-http ob-ipython ob-restclient nord-theme restclient request restclient-test yaml-mode magit))) '(python-shell-interpreter "python3") '(register-preview-delay 2) '(register-separator 43) diff --git a/elpa/archives/gnu/archive-contents.signed b/elpa/archives/gnu/archive-contents.signed index 6b8b41ce..34e3f86b 100644 --- a/elpa/archives/gnu/archive-contents.signed +++ b/elpa/archives/gnu/archive-contents.signed @@ -1 +1 @@ -Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) (trust undefined) created at 2020-04-12T11:05:02+0200 using RSA \ No newline at end of file +Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) (trust undefined) created at 2020-04-13T11:05:02+0200 using RSA \ No newline at end of file diff --git a/elpa/epl-20180205.2049/epl-autoloads.el b/elpa/epl-20180205.2049/epl-autoloads.el new file mode 100644 index 00000000..c6221c54 --- /dev/null +++ b/elpa/epl-20180205.2049/epl-autoloads.el @@ -0,0 +1,22 @@ +;;; epl-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "epl" "epl.el" (0 0 0 0)) +;;; Generated autoloads from epl.el + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "epl" '("epl-"))) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; epl-autoloads.el ends here diff --git a/elpa/epl-20180205.2049/epl-pkg.el b/elpa/epl-20180205.2049/epl-pkg.el new file mode 100644 index 00000000..a977868d --- /dev/null +++ b/elpa/epl-20180205.2049/epl-pkg.el @@ -0,0 +1,2 @@ +;;; -*- no-byte-compile: t -*- +(define-package "epl" "20180205.2049" "Emacs Package Library" '((cl-lib "0.3")) :commit "78ab7a85c08222cd15582a298a364774e3282ce6" :keywords '("convenience") :authors '(("Sebastian Wiesner" . "swiesner@lunaryorn.com")) :maintainer '("Johan Andersson" . "johan.rejeep@gmail.com") :url "http://github.com/cask/epl") diff --git a/elpa/epl-20180205.2049/epl.el b/elpa/epl-20180205.2049/epl.el new file mode 100644 index 00000000..5bbd76a0 --- /dev/null +++ b/elpa/epl-20180205.2049/epl.el @@ -0,0 +1,711 @@ +;;; 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.10-cvs +;; Package-Version: 20180205.2049 +;; 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 &optional min-version) + "Determine whether a PACKAGE, of MIN-VERSION or newer, is installed. + +PACKAGE is either a package name as symbol, or a package object. +When a explicit MIN-VERSION is provided it overwrites the version of the PACKAGE object." + (let ((name (if (epl-package-p package) + (epl-package-name package) + package)) + (min-version (or min-version (and (epl-package-p package) + (epl-package-version package))))) + (package-installed-p name min-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 + +(defun epl-install-file (file) + "Install a package from FILE, like `package-install-file'." + (interactive (advice-eval-interactive-spec + (cadr (interactive-form #'package-install-file)))) + (apply #'package-install-file (list file)) + (let ((package (epl-package-from-file file))) + (unless (epl-package--package-desc-p package) + (epl--kill-autoload-buffer package)))) + +(defun epl--kill-autoload-buffer (package) + "Kill the buffer associated with autoloads for PACKAGE." + (let* ((auto-name (format "%s-autoloads.el" (epl-package-name package))) + (generated-autoload-file (expand-file-name auto-name (epl-package-directory package))) + (buf (find-buffer-visiting generated-autoload-file))) + (when buf (kill-buffer buf)))) + +(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)) + (epl--kill-autoload-buffer 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/epl-20180205.2049/epl.elc b/elpa/epl-20180205.2049/epl.elc new file mode 100644 index 00000000..cd17f238 Binary files /dev/null and b/elpa/epl-20180205.2049/epl.elc differ diff --git a/elpa/pkg-info-20150517.1143/pkg-info-autoloads.el b/elpa/pkg-info-20150517.1143/pkg-info-autoloads.el new file mode 100644 index 00000000..44ce6b58 --- /dev/null +++ b/elpa/pkg-info-20150517.1143/pkg-info-autoloads.el @@ -0,0 +1,127 @@ +;;; pkg-info-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "pkg-info" "pkg-info.el" (0 0 0 0)) +;;; 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) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "pkg-info" '("pkg-info-"))) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; pkg-info-autoloads.el ends here diff --git a/elpa/pkg-info-20150517.1143/pkg-info-pkg.el b/elpa/pkg-info-20150517.1143/pkg-info-pkg.el new file mode 100644 index 00000000..d4b90e1e --- /dev/null +++ b/elpa/pkg-info-20150517.1143/pkg-info-pkg.el @@ -0,0 +1,2 @@ +;;; -*- no-byte-compile: t -*- +(define-package "pkg-info" "20150517.1143" "Information about packages" '((epl "0.8")) :commit "76ba7415480687d05a4353b27fea2ae02b8d9d61" :keywords '("convenience") :authors '(("Sebastian Wiesner" . "swiesner@lunaryorn.com")) :maintainer '("Sebastian Wiesner" . "swiesner@lunaryorn.com") :url "https://github.com/lunaryorn/pkg-info.el") diff --git a/elpa/pkg-info-20150517.1143/pkg-info.el b/elpa/pkg-info-20150517.1143/pkg-info.el new file mode 100644 index 00000000..e6a03a18 --- /dev/null +++ b/elpa/pkg-info-20150517.1143/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.1143 +;; 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/pkg-info-20150517.1143/pkg-info.elc b/elpa/pkg-info-20150517.1143/pkg-info.elc new file mode 100644 index 00000000..bf38ae9d Binary files /dev/null and b/elpa/pkg-info-20150517.1143/pkg-info.elc differ diff --git a/elpa/projectile-20200329.1908/projectile-autoloads.el b/elpa/projectile-20200329.1908/projectile-autoloads.el new file mode 100644 index 00000000..516e9e43 --- /dev/null +++ b/elpa/projectile-20200329.1908/projectile-autoloads.el @@ -0,0 +1,635 @@ +;;; projectile-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "projectile" "projectile.el" (0 0 0 0)) +;;; 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 PROMPT prompts for the name of the project whose cache +to invalidate. + +\(fn PROMPT)" 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-discover-projects-in-directory "projectile" "\ +Discover any projects in DIRECTORY and add them to the projectile cache. +This function is not recursive and only adds projects with roots +at the top level of DIRECTORY. + +\(fn DIRECTORY)" t nil) + +(autoload 'projectile-discover-projects-in-search-path "projectile" "\ +Discover projects in `projectile-project-search-path'. +Invoked automatically when `projectile-mode' is enabled. + +\(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-switch-to-buffer-other-frame "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. +With a prefix argument, show NLINES of context. + +\(fn &optional NLINES)" 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-other-file-other-frame "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 INVALIDATE-CACHE 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-dwim' 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-dwim' 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 INVALIDATE-CACHE)" 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 INVALIDATE-CACHE 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-dwim-other-window' 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-dwim-other-window' 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 INVALIDATE-CACHE)" t nil) + +(autoload 'projectile-find-file-dwim-other-frame "projectile" "\ +Jump to a project's files using completion based on context in other frame. + +With a prefix arg INVALIDATE-CACHE 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-dwim-other-frame' 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-dwim-other-frame' 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 INVALIDATE-CACHE)" t nil) + +(autoload 'projectile-find-file "projectile" "\ +Jump to a project's file using completion. +With a prefix arg INVALIDATE-CACHE invalidates the cache first. + +\(fn &optional INVALIDATE-CACHE)" 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 INVALIDATE-CACHE invalidates the cache first. + +\(fn &optional INVALIDATE-CACHE)" t nil) + +(autoload 'projectile-find-file-other-frame "projectile" "\ +Jump to a project's file using completion and show it in another frame. + +With a prefix arg INVALIDATE-CACHE invalidates the cache first. + +\(fn &optional INVALIDATE-CACHE)" t nil) + +(autoload 'projectile-toggle-project-read-only "projectile" "\ +Toggle project read only. + +\(fn)" t nil) + +(autoload 'projectile-find-dir "projectile" "\ +Jump to a project's directory using completion. + +With a prefix arg INVALIDATE-CACHE invalidates the cache first. + +\(fn &optional INVALIDATE-CACHE)" t nil) + +(autoload 'projectile-find-dir-other-window "projectile" "\ +Jump to a project's directory in other window using completion. + +With a prefix arg INVALIDATE-CACHE invalidates the cache first. + +\(fn &optional INVALIDATE-CACHE)" t nil) + +(autoload 'projectile-find-dir-other-frame "projectile" "\ +Jump to a project's directory in other window using completion. + +With a prefix arg INVALIDATE-CACHE invalidates the cache first. + +\(fn &optional INVALIDATE-CACHE)" t nil) + +(autoload 'projectile-find-test-file "projectile" "\ +Jump to a project's test file using completion. + +With a prefix arg INVALIDATE-CACHE invalidates the cache first. + +\(fn &optional INVALIDATE-CACHE)" t nil) + +(autoload 'projectile-find-related-file-other-window "projectile" "\ +Open related file in other window. + +\(fn)" t nil) + +(autoload 'projectile-find-related-file-other-frame "projectile" "\ +Open related file in other frame. + +\(fn)" t nil) + +(autoload 'projectile-find-related-file "projectile" "\ +Open related file. + +\(fn)" t nil) + +(autoload 'projectile-related-files-fn-groups "projectile" "\ +Generate a related-files-fn which relates as KIND for files in each of GROUPS. + +\(fn KIND GROUPS)" nil nil) + +(autoload 'projectile-related-files-fn-extensions "projectile" "\ +Generate a related-files-fn which relates as KIND for files having EXTENSIONS. + +\(fn KIND EXTENSIONS)" nil nil) + +(autoload 'projectile-related-files-fn-test-with-prefix "projectile" "\ +Generate a related-files-fn which relates tests and impl for files with EXTENSION based on TEST-PREFIX. + +\(fn EXTENSION TEST-PREFIX)" nil nil) + +(autoload 'projectile-related-files-fn-test-with-suffix "projectile" "\ +Generate a related-files-fn which relates tests and impl for files with EXTENSION based on TEST-SUFFIX. + +\(fn EXTENSION TEST-SUFFIX)" nil 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-find-implementation-or-test-other-frame "projectile" "\ +Open matching implementation or test file in other frame. + +\(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-ripgrep "projectile" "\ +Run a Ripgrep search with `SEARCH-TERM' at current project root. + +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-gdb "projectile" "\ +Invoke `gdb' in the project's root. + +\(fn)" t nil) + +(autoload 'projectile-run-shell "projectile" "\ +Invoke `shell' in the project's root. + +Switch to the project specific shell buffer if it already exists. + +Use a prefix argument ARG to indicate creation of a new process instead. + +\(fn ARG)" t nil) + +(autoload 'projectile-run-eshell "projectile" "\ +Invoke `eshell' in the project's root. + +Switch to the project specific eshell buffer if it already exists. + +Use a prefix argument ARG to indicate creation of a new process instead. + +\(fn ARG)" t nil) + +(autoload 'projectile-run-ielm "projectile" "\ +Invoke `ielm' in the project's root. + +Switch to the project specific ielm buffer if it already exists. + +Use a prefix argument ARG to indicate creation of a new process instead. + +\(fn ARG)" t nil) + +(autoload 'projectile-run-term "projectile" "\ +Invoke `term' in the project's root. + +Switch to the project specific term buffer if it already exists. + +Use a prefix argument ARG to indicate creation of a new process instead. + +\(fn ARG)" t nil) + +(autoload 'projectile-run-vterm "projectile" "\ +Invoke `vterm' in the project's root. + +Switch to the project specific term buffer if it already exists. + +Use a prefix argument ARG to indicate creation of a new process instead. + +\(fn &optional ARG)" 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 project buffers. + +The buffer are killed according to the value of +`projectile-kill-buffers-filter'. + +\(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-dired-other-window "projectile" "\ +Open `dired' at the root of the project in another window. + +\(fn)" t nil) + +(autoload 'projectile-dired-other-frame "projectile" "\ +Open `dired' at the root of the project in another frame. + +\(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. + +If PROJECT-ROOT is given, it is opened instead of the project +root directory of the current buffer file. If interactively +called with a prefix argument, the user is prompted for a project +directory to open. + +\(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-configure-project "projectile" "\ +Run project configure 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-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)" 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-repeat-last-command "projectile" "\ +Run last projectile external command. + +External commands are: `projectile-configure-project', +`projectile-compile-project', `projectile-test-project' and +`projectile-run-project'. + +If the prefix argument SHOW_PROMPT is non nil, the command can be edited. + +\(fn SHOW-PROMPT)" 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-add-known-project "projectile" "\ +Add PROJECT-ROOT to the list of known projects. + +\(fn PROJECT-ROOT)" t nil) + +(autoload 'projectile-ibuffer "projectile" "\ +Open an IBuffer window showing all buffers in the current project. + +Let user choose another project when PROMPT-FOR-PROJECT is supplied. + +\(fn PROMPT-FOR-PROJECT)" 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-browse-dirty-projects "projectile" "\ +Browse dirty version controlled projects. + +With a prefix argument, or if CACHED is non-nil, try to use the cached +dirty project list. + +\(fn &optional CACHED)" 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 nil "\ +Non-nil if Projectile mode is enabled. +See the `projectile-mode' command +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-mode'.") + +(custom-autoload 'projectile-mode "projectile" nil) + +(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) + +(define-obsolete-function-alias 'projectile-global-mode 'projectile-mode "1.0") + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "projectile" '("projectile-" "??" "delete-file-projectile-remove-from-cache" "def-projectile-commander-method" "compilation-find-file-projectile-find-compilation-buffer"))) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; projectile-autoloads.el ends here diff --git a/elpa/projectile-20200329.1908/projectile-pkg.el b/elpa/projectile-20200329.1908/projectile-pkg.el new file mode 100644 index 00000000..e6d84b7d --- /dev/null +++ b/elpa/projectile-20200329.1908/projectile-pkg.el @@ -0,0 +1,2 @@ +;;; -*- no-byte-compile: t -*- +(define-package "projectile" "20200329.1908" "Manage and navigate projects in Emacs easily" '((emacs "25.1") (pkg-info "0.4")) :commit "56e18fcefa2f286edfec98853189985823d0e53c" :keywords '("project" "convenience") :authors '(("Bozhidar Batsov" . "bozhidar@batsov.com")) :maintainer '("Bozhidar Batsov" . "bozhidar@batsov.com") :url "https://github.com/bbatsov/projectile") diff --git a/elpa/projectile-20200329.1908/projectile.el b/elpa/projectile-20200329.1908/projectile.el new file mode 100644 index 00000000..47d0e4c9 --- /dev/null +++ b/elpa/projectile-20200329.1908/projectile.el @@ -0,0 +1,4773 @@ +;;; projectile.el --- Manage and navigate projects in Emacs easily -*- lexical-binding: t -*- + +;; Copyright © 2011-2020 Bozhidar Batsov + +;; Author: Bozhidar Batsov +;; URL: https://github.com/bbatsov/projectile +;; Package-Version: 20200329.1908 +;; Keywords: project, convenience +;; Version: 2.2.0-snapshot +;; Package-Requires: ((emacs "25.1") (pkg-info "0.4")) + +;; This file is NOT part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, 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 'cl-lib) +(require 'thingatpt) +(require 'ibuffer) +(require 'ibuf-ext) +(require 'compile) +(require 'grep) +(eval-when-compile + (require 'find-dired) + (require 'subr-x)) + +(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 tags-completion-table "etags") +(declare-function make-term "term") +(declare-function term-mode "term") +(declare-function term-char-mode "term") +(declare-function eshell-search-path "esh-ext") +(declare-function vc-dir "vc-dir") +(declare-function vc-dir-busy "vc-dir") +(declare-function string-trim "subr-x") +(declare-function fileloop-continue "fileloop") +(declare-function fileloop-initialize-replace "fileloop") + +(declare-function ggtags-ensure-project "ext:ggtags") +(declare-function ggtags-update-tags "ext:ggtags") +(declare-function pkg-info-version-info "ext:pkg-info") +(declare-function ripgrep-regexp "ext:ripgrep") +(declare-function vterm "ext:vterm") +(declare-function vterm-send-return "ext:vterm") +(declare-function vterm-send-string "ext:vterm") + +(defvar grep-files-aliases) +(defvar grep-find-ignored-directories) +(defvar grep-find-ignored-files) + + +;;; Customization +(defgroup projectile nil + "Manage and navigate projects easily." + :group 'tools + :group 'convenience + :link '(url-link :tag "GitHub" "https://github.com/bbatsov/projectile") + :link '(url-link :tag "Online Manual" "https://docs.projectile.mx/") + :link '(emacs-commentary-link :tag "Commentary" "projectile")) + +(defcustom projectile-indexing-method (if (eq system-type 'windows-nt) 'native 'alien) + "Specifies the indexing method used by Projectile. + +There are three indexing methods - native, hybrid and alien. + +The native method is implemented in Emacs Lisp (therefore it is +native to Emacs). Its advantage is that it is portable and will +work everywhere that Emacs does. Its disadvantage is that it is a +bit slow (especially for large projects). Generally it's a good +idea to pair the native indexing method with caching. + +The hybrid indexing method uses external tools (e.g. git, find, +etc) to speed up the indexing process. Still, the files will be +post-processed by Projectile for sorting/filtering purposes. +In this sense that approach is a hybrid between native indexing +and alien indexing. + +The alien indexing method optimizes to the limit the speed +of the hybrid indexing method. This means that Projectile will +not do any processing of the files returned by the external +commands and you're going to get the maximum performance +possible. This behaviour makes a lot of sense for most people, +as they'd typically be putting ignores in their VCS config and +won't care about any additional ignores/unignores/sorting that +Projectile might also provide. + +The disadvantage of the hybrid and alien methods is that they are not well +supported on Windows systems. That's why by default alien indexing is the +default on all operating systems, except Windows." + :group 'projectile + :type '(radio + (const :tag "Native" native) + (const :tag "Hybrid" hybrid) + (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-kill-buffers-filter 'kill-all + "Determine which buffers are killed by `projectile-kill-buffers'. + +When the kill-all option is selected, kills each buffer. + +When the kill-only-files option is selected, kill only the buffer +associated to a file. + +Otherwise, it should be a predicate that takes one argument: the buffer to +be killed." + :group 'projectile + :type '(radio + (const :tag "All project buffers" kill-all) + (const :tag "Project file buffers" kill-only-files) + (function :tag "Predicate"))) + +(defcustom projectile-file-exists-local-cache-expire nil + "Number of seconds before the local file existence cache expires. +Local refers to a file on a local file system. + +A value of nil disables this cache. +See `projectile-file-exists-p' for details." + :group 'projectile + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Seconds"))) + +(defcustom projectile-file-exists-remote-cache-expire (* 5 60) + "Number of seconds before the remote file existence cache expires. +Remote refers to a file on a remote file system such as tramp. + +A value of nil disables this cache. +See `projectile-file-exists-p' for details." + :group 'projectile + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Seconds"))) + +(defcustom projectile-files-cache-expire nil + "Number of seconds before project files list cache expires. + +A value of nil means the cache never expires." + :group 'projectile + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Seconds"))) + +(defcustom projectile-auto-update-cache t + "Wether the cache should automatically be updated when files are opened or deleted." + :group 'projectile + :type 'boolean) + +(defcustom projectile-require-project-root 'prompt + "Require the presence of a project root to operate when true. +When set to 'prompt Projectile will ask you to select a project +directory if you're not in a project. + +When nil Projectile will consider the current directory the project root." + :group 'projectile + :type '(choice (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "Prompt for project" prompt))) + +(defcustom projectile-completion-system 'ido + "The completion system to be used by Projectile." + :group 'projectile + :type '(radio + (const :tag "Ido" ido) + (const :tag "Helm" helm) + (const :tag "Ivy" ivy) + (const :tag "Default" default) + (function :tag "Custom function"))) + +(defcustom projectile-keymap-prefix nil + "Projectile keymap prefix." + :group 'projectile + :type 'string) + +(make-obsolete-variable 'projectile-keymap-prefix "Use (define-key projectile-mode-map (kbd ...) 'projectile-command-map) instead." "2.0.0") + +(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 \"%s\"" + "The command Projectile's going to use to generate a TAGS file." + :group 'projectile + :type 'string) + +(defcustom projectile-tags-backend 'auto + "The tag backend that Projectile should use. + +If set to 'auto', `projectile-find-tag' will automatically choose +which backend to use. Preference order is ggtags -> xref +-> etags-select -> `find-tag'. Variable can also be set to specify which +backend to use. If selected backend is unavailable, fall back to +`find-tag'. + +If this variable is set to 'auto' and ggtags is available, or if +set to 'ggtags', then ggtags will be used for +`projectile-regenerate-tags'. For all other settings +`projectile-tags-command' will be used." + :group 'projectile + :type '(radio + (const :tag "auto" auto) + (const :tag "xref" xref) + (const :tag "ggtags" ggtags) + (const :tag "etags" etags-select) + (const :tag "standard" find-tag)) + :package-version '(projectile . "0.14.0")) + +(defcustom projectile-sort-order 'default + "The sort order used for a project's files. + +Note that files aren't sorted if `projectile-indexing-method' +is set to 'alien'." + :group 'projectile + :type '(radio + (const :tag "Default (no sorting)" default) + (const :tag "Recently opened files" recentf) + (const :tag "Recently active buffers, then recently opened files" recently-active) + (const :tag "Access time (atime)" access-time) + (const :tag "Modification time (mtime)" 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 'function) + +(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 'function + :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 + "deps.edn" ; Clojure CLI 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 + ".ensime" ; Ensime configuration file + "Gemfile" ; Bundler file + "requirements.txt" ; Pip file + "setup.py" ; Setuptools file + "pyproject.toml" ; Python project file + "tox.ini" ; Tox 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 + "info.rkt" ; Racket package description file + "DESCRIPTION" ; R package description file + "TAGS" ; etags/ctags are usually in the root of project + "GTAGS" ; GNU Global tags + "configure.in" ; autoconf old style + "configure.ac" ; autoconf new style + "cscope.out" ; cscope + ) + "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 + "_FOSSIL_" ; Fossil VCS root DB on Windows + ".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. + +Regular expressions can be used." + :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" + ".ensime_cache" + ".eunit" + ".git" + ".hg" + ".fslckout" + "_FOSSIL_" + ".bzr" + "_darcs" + ".tox" + ".svn" + ".stack-work") + "A list of directories globally ignored by projectile. + +Regular expressions can be used." + :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. + +You can use either exact buffer names or regular expressions. +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 'function) + +(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) + +(defcustom projectile-related-files-fn-function 'projectile-related-files-fn + "Function to find related files based on PROJECT-TYPE." + :group 'projectile + :type 'function) + +(defcustom projectile-dynamic-mode-line t + "If true, update the mode-line dynamically. +Only file buffers are affected by this, as the update happens via +`find-file-hook'. + +See also `projectile-mode-line-function' and `projectile-update-mode-line'." + :group 'projectile + :type 'boolean + :package-version '(projectile . "2.0.0")) + +(defcustom projectile-mode-line-function 'projectile-default-mode-line + "The function to use to generate project-specific mode-line. +The default function adds the project name and type to the mode-line. +See also `projectile-update-mode-line'." + :group 'projectile + :type 'function + :package-version '(projectile . "2.0.0")) + + +;;; 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) + +(defvar projectile-projects-cache nil + "A hashmap used to cache project file names to speed up related operations.") + +(defvar projectile-projects-cache-time nil + "A hashmap used to record when we populated `projectile-projects-cache'.") + +(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")) + +(defcustom projectile-track-known-projects-automatically t + "Controls whether Projectile will automatically register known projects. + +When set to nil you'll have always add projects explicitly with +`projectile-add-known-project'." + :group 'projectile + :type 'boolean + :package-version '(projectile . "1.0.0")) + +(defcustom projectile-project-search-path nil + "List of folders where projectile is automatically going to look for projects. +You can think of something like $PATH, but for projects instead of executables. +Examples of such paths might be ~/projects, ~/work, etc." + :group 'projectile + :type 'list + :package-version '(projectile . "1.0.0")) + +(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 list submodules of a given git repository. +Set to nil to disable listing submodules contents." + :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 -f -0 -I ." + "Command used by projectile to get the files in a hg project." + :group 'projectile + :type 'string) + +(defcustom projectile-fossil-command (concat "fossil ls | " + (when (string-equal system-type + "windows-nt") + "dos2unix | ") + "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 + (if (executable-find "fd") + "fd . -0 --type f --color=never" + "find . -type f -print0") + "Command used by projectile to get the files in a generic project." + :group 'projectile + :type 'string) + +(defcustom projectile-vcs-dirty-state '("edited" "unregistered" "needs-update" "needs-merge" "unlocked-changes" "conflict") + "List of states checked by `projectile-browse-dirty-projects'. +Possible checked states are: +\"edited\", \"unregistered\", \"needs-update\", \"needs-merge\", +\"unlocked-changes\" and \"conflict\", +as defined in `vc.el'." + :group 'projectile + :type '(repeat (string)) + :package-version '(projectile . "1.0.0")) + +(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" "cc" "cpp" "ipp" "hpp" "cxx" "ixx" "hxx" "m" "mm")) + ("cc" . ("h" "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." + :type 'alist) + +(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) + +(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) + +(defcustom projectile-current-project-on-switch 'remove + "Determines whether to display current project when switching projects. + +When set to 'remove current project is not included, 'move-to-end +will display current project and the end of the list of known +projects, 'keep will leave the current project at the default +position." + :group 'projectile + :type '(radio + (const :tag "Remove" remove) + (const :tag "Move to end" move-to-end) + (const :tag "Keep" keep))) + + +;;; 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 %s" version)) + version) + (error "Cannot determine version without package pkg-info"))) + +;;; Misc utility functions +(defun projectile-difference (list1 list2) + (cl-remove-if + (lambda (x) (member x list2)) + list1)) + +(defun projectile-unixy-system-p () + "Check to see if unixy text utilities are installed." + (cl-every + (lambda (x) (executable-find x)) + '("grep" "cut" "uniq"))) + +(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) ""))) + +(defun projectile-generate-process-name (process make-new) + "Infer the buffer name for PROCESS or generate a new one if MAKE-NEW is true." + (let* ((project (projectile-ensure-project (projectile-project-root))) + (base-name (format "*%s %s*" process (projectile-project-name project)))) + (if make-new + (generate-new-buffer-name base-name) + base-name))) + + +;;; 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)))))) + + +;;; 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 (prompt) + "Remove the current project's files from `projectile-projects-cache'. + +With a prefix argument PROMPT prompts for the name of the project whose cache +to invalidate." + (interactive "P") + (let ((project-root + (if prompt + (completing-read "Remove cache for: " + (hash-table-keys projectile-projects-cache)) + (projectile-ensure-project (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) + (remhash project-root projectile-projects-cache-time) + (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-time-seconds () + "Return the number of seconds since the unix epoch." + (cl-destructuring-bind (high low _usec _psec) (current-time) + (+ (lsh high 16) low))) + +(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) + (puthash project (projectile-time-seconds) projectile-projects-cache-time) + (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 + (cl-remove-if (lambda (str) (string-prefix-p dir str)) 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'." + (let ((project-root (projectile-project-p))) + (when (and projectile-enable-caching + project-root + (not (projectile-ignored-project-p project-root))) + (projectile-cache-current-file)))) + +(defun projectile-track-known-projects-find-file-hook () + "Function for caching projects with `find-file-hook'." + (when (and projectile-track-known-projects-automatically (projectile-project-p)) + (projectile-add-known-project (projectile-project-root)))) + +(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))) + +;;;###autoload +(defun projectile-discover-projects-in-directory (directory) + "Discover any projects in DIRECTORY and add them to the projectile cache. +This function is not recursive and only adds projects with roots +at the top level of DIRECTORY." + (interactive + (list (read-directory-name "Starting directory: "))) + (let ((subdirs (directory-files directory t))) + (mapcar + (lambda (dir) + (when (and (file-directory-p dir) + (not (member (file-name-nondirectory dir) '(".." ".")))) + (when (projectile-project-p dir) + (projectile-add-known-project dir)))) + subdirs))) + +;;;###autoload +(defun projectile-discover-projects-in-search-path () + "Discover projects in `projectile-project-search-path'. +Invoked automatically when `projectile-mode' is enabled." + (interactive) + (mapcar #'projectile-discover-projects-in-directory projectile-project-search-path)) + + +(defun delete-file-projectile-remove-from-cache (filename &optional _trash) + (if (and projectile-enable-caching projectile-auto-update-cache (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) + (cl-find-if (lambda (f) (projectile-file-exists-p (expand-file-name f 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." + (cl-some (lambda (name) (projectile-locate-dominating-file dir name)) + (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." + (cl-some + (lambda (f) + (projectile-locate-dominating-file + dir + (lambda (dir) + (and (projectile-file-exists-p (expand-file-name f dir)) + (or (string-match locate-dominating-stop-dir-regexp (projectile-parent dir)) + (not (projectile-file-exists-p (expand-file-name f (projectile-parent dir))))))))) + (or list projectile-project-root-files-top-down-recurring))) + +(defun projectile-project-root (&optional dir) + "Retrieves the root directory of a project if available. +If DIR is not supplied its set to the current directory by default." + ;; the cached value will be 'none in the case of no project root (this is to + ;; ensure it is not reevaluated each time when not inside a project) so use + ;; cl-subst to replace this 'none value with nil so a nil value is used + ;; instead + (let ((dir (or dir default-directory))) + ;; Back out of any archives, the project will live on the outside and + ;; searching them is slow. + (when (and (fboundp 'tramp-archive-file-name-archive) + (tramp-archive-file-name-p dir)) + (setq dir (file-name-directory (tramp-archive-file-name-archive dir)))) + (cl-subst nil 'none + ;; The `is-local' and `is-connected' variables are + ;; used to fix the behavior where Emacs hangs + ;; because of Projectile when you open a file over + ;; TRAMP. It basically prevents Projectile from + ;; trying to find information about files for which + ;; it's not possible to get that information right + ;; now. + (or (let ((is-local (not (file-remote-p dir))) ;; `true' if the file is local + (is-connected (file-remote-p dir nil t))) ;; `true' if the file is remote AND we are connected to the remote + (when (or is-local is-connected) + (cl-some + (lambda (func) + (let* ((cache-key (format "%s-%s" func dir)) + (cache-value (gethash cache-key projectile-project-root-cache))) + (if (and cache-value (file-exists-p cache-value)) + cache-value + (let ((value (funcall func (file-truename dir)))) + (puthash cache-key value projectile-project-root-cache) + value)))) + projectile-project-root-files-functions))) + ;; set cached to none so is non-nil so we don't try + ;; and look it up again + 'none)))) + +(defun projectile-ensure-project (dir) + "Ensure that DIR is non-nil. +Useful for commands that expect the presence of a project. +Controlled by `projectile-require-project-root'." + (if dir + dir + (cond + ((eq projectile-require-project-root 'prompt) (projectile-completing-read + "Switch to project: " projectile-known-projects)) + (projectile-require-project-root (error "Projectile can't find a project definition in %s" dir)) + (t default-directory)))) + +(defun projectile-project-p (&optional dir) + "Check if DIR is a project. +Defaults to the current directory if not provided +explicitly." + (projectile-project-root (or dir default-directory))) + +(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 (&optional project) + "Return project name. +If PROJECT is not specified acts on the current project." + (or projectile-project-name + (let ((project-root (or project (projectile-project-root)))) + (if project-root + (funcall projectile-project-name-function project-root) + "-")))) + + +;;; Project indexing +(defun projectile-get-project-directories (project-dir) + "Get the list of PROJECT-DIR directories that are of interest to the user." + (mapcar (lambda (subdir) (concat project-dir subdir)) + (or (nth 0 (projectile-parse-dirconfig-file)) '("")))) + +(defun projectile--directory-p (directory) + "Checks if DIRECTORY is a string designating a valid directory." + (and (stringp directory) (file-directory-p directory))) + +(defun projectile-dir-files (directory) + "List the files in DIRECTORY and in its sub-directories. +Files are returned as relative paths to DIRECTORY." + (unless (projectile--directory-p directory) + (error "Directory %S does not exist" directory)) + ;; check for a cache hit first if caching is enabled + (let ((files-list (and projectile-enable-caching + (gethash directory projectile-projects-cache)))) + ;; cache disabled or cache miss + (or files-list + (let ((vcs (projectile-project-vcs directory))) + (pcase projectile-indexing-method + ('native (projectile-dir-files-native directory)) + ;; use external tools to get the project files + ('hybrid (projectile-adjust-files directory vcs (projectile-dir-files-alien directory))) + ('alien (projectile-dir-files-alien directory)) + (_ (user-error "Unsupported indexing method `%S'" projectile-indexing-method))))))) + +;;; Native Project Indexing +;; +;; This corresponds to `projectile-indexing-method' being set to native. +(defun projectile-dir-files-native (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 + (mapcar (lambda (file) (file-relative-name file directory)) + (projectile-index-directory directory (projectile-filtering-patterns) + progress-reporter)))) + +(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." + (apply #'append + (mapcar + (lambda (f) + (unless (or (and patterns (projectile-ignored-rel-p f directory patterns)) + (member (file-name-nondirectory (directory-file-name f)) + '("." ".." ".svn" ".cvs"))) + (progress-reporter-update progress-reporter) + (if (file-directory-p f) + (unless (projectile-ignored-directory-p + (file-name-as-directory f)) + (projectile-index-directory f patterns progress-reporter)) + (unless (projectile-ignored-file-p f) + (list f))))) + (directory-files directory t)))) + +;;; Alien Project Indexing +;; +;; This corresponds to `projectile-indexing-method' being set to hybrid or alien. +;; The only difference between the two methods is that alien doesn't do +;; any post-processing of the files obtained via the external command. +(defun projectile-dir-files-alien (directory) + "Get the files for DIRECTORY using external tools." + (let ((vcs (projectile-project-vcs directory))) + (cond + ((eq vcs 'git) + (nconc (projectile-files-via-ext-command directory (projectile-get-ext-command vcs)) + (projectile-get-sub-projects-files directory vcs))) + (t (projectile-files-via-ext-command directory (projectile-get-ext-command vcs)))))) + +(define-obsolete-function-alias 'projectile-dir-files-external 'projectile-dir-files-alien "2.0.0") +(define-obsolete-function-alias 'projectile-get-repo-files 'projectile-dir-files-alien "2.0.0") + +(defun projectile-get-ext-command (vcs) + "Determine which external command to invoke based on the project's VCS. +Fallback to a generic command when not in a VCS-controlled project." + (pcase vcs + ('git projectile-git-command) + ('hg projectile-hg-command) + ('fossil projectile-fossil-command) + ('bzr projectile-bzr-command) + ('darcs projectile-darcs-command) + ('svn projectile-svn-command) + (_ projectile-generic-command))) + +(defun projectile-get-sub-projects-command (vcs) + "Get the sub-projects command for VCS. +Currently that's supported just for Git (sub-projects being Git +sub-modules there)." + (pcase vcs + ('git projectile-git-submodule-command) + (_ ""))) + +(defun projectile-get-ext-ignored-command (vcs) + "Determine which external command to invoke based on the project's VCS." + (pcase vcs + ('git projectile-git-ignored-command) + ;; TODO: Add support for other VCS + (_ nil))) + +(defun projectile-flatten (lst) + "Take a nested list LST and return its contents as a single, flat list." + (if (and (listp lst) (listp (cdr lst))) + (cl-mapcan 'projectile-flatten lst) + (list lst))) + +(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 (projectile-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* ((vcs (projectile-project-vcs path)) + ;; search for sub-projects under current project `project' + (submodules (mapcar + (lambda (s) + (file-name-as-directory (expand-file-name s path))) + (projectile-files-via-ext-command path (projectile-get-sub-projects-command vcs)))) + (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. + (cl-remove-if-not + (lambda (submodule) + (string-match-p project-child-folder-regex + submodule)) + submodules))) + +(defun projectile-get-sub-projects-files (project-root _vcs) + "Get files from sub-projects for PROJECT-ROOT recursively." + (projectile-flatten + (mapcar (lambda (sub-project) + (let ((project-relative-path + (file-name-as-directory (file-relative-name + sub-project project-root)))) + (mapcar (lambda (file) + (concat project-relative-path file)) + ;; TODO: Seems we forgot git hardcoded here + (projectile-files-via-ext-command sub-project projectile-git-command)))) + (projectile-get-all-sub-projects project-root)))) + +(defun projectile-get-repo-ignored-files (project vcs) + "Get a list of the files ignored in the PROJECT using VCS." + (let ((cmd (projectile-get-ext-ignored-command vcs))) + (when cmd + (projectile-files-via-ext-command project cmd)))) + +(defun projectile-get-repo-ignored-directory (project dir vcs) + "Get a list of the files ignored in the PROJECT in the directory DIR. +VCS is the VCS of the project." + (let ((cmd (projectile-get-ext-ignored-command vcs))) + (when cmd + (projectile-files-via-ext-command project (concat cmd " " dir))))) + +(defun projectile-files-via-ext-command (root command) + "Get a list of relative file names in the project ROOT by executing COMMAND. + +If `command' is nil or an empty string, return nil. +This allows commands to be disabled." + (when (stringp command) + (let ((default-directory root)) + (split-string (shell-command-to-string command) "\0" t)))) + +(defun projectile-adjust-files (project vcs files) + "First remove ignored files from FILES, then add back unignored files." + (projectile-add-unignored project vcs (projectile-remove-ignored files))) + +(defun projectile-remove-ignored (files) + "Remove ignored files and folders from FILES. + +If ignored directory prefixed with '*', then ignore all +directories/subdirectories with matching filename, +otherwise operates relative to project root." + (let ((ignored-files (projectile-ignored-files-rel)) + (ignored-dirs (projectile-ignored-directories-rel))) + (cl-remove-if + (lambda (file) + (or (cl-some + (lambda (f) + (string= f (file-name-nondirectory file))) + ignored-files) + (cl-some + (lambda (dir) + ;; if the directory is prefixed with '*' then ignore all directories matching that name + (if (string-prefix-p "*" dir) + ;; remove '*' and trailing slash from ignored directory name + (let ((d (substring dir 1 (if (equal (substring dir -1) "/") -1 nil)))) + (cl-some + (lambda (p) + (string= d p)) + ;; split path by '/', remove empty strings, and check if any subdirs match name 'd' + (delete "" (split-string (or (file-name-directory file) "") "/")))) + (string-prefix-p dir file))) + ignored-dirs) + (cl-some + (lambda (suf) + (string-suffix-p suf file t)) + projectile-globally-ignored-file-suffixes))) + files))) + +(defun projectile-keep-ignored-files (project vcs files) + "Filter FILES to retain only those that are ignored." + (when files + (cl-remove-if-not + (lambda (file) + (cl-some (lambda (f) (string-prefix-p f file)) files)) + (projectile-get-repo-ignored-files project vcs)))) + +(defun projectile-keep-ignored-directories (project vcs directories) + "Get ignored files within each of DIRECTORIES." + (when directories + (let (result) + (dolist (dir directories result) + (setq result (append result + (projectile-get-repo-ignored-directory project dir vcs)))) + result))) + +(defun projectile-add-unignored (project vcs 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 + project + vcs + (projectile-unignored-files-rel))) + (unignored-paths (projectile-remove-ignored + (projectile-keep-ignored-directories + project + vcs + (projectile-unignored-directories-rel))))) + (append files unignored-files unignored-paths))) + +(defun projectile-buffers-with-file (buffers) + "Return only those BUFFERS backed by files." + (cl-remove-if-not (lambda (b) (buffer-file-name b)) buffers)) + +(defun projectile-buffers-with-file-or-process (buffers) + "Return only those BUFFERS backed by files or processes." + (cl-remove-if-not (lambda (b) (or (buffer-file-name b) + (get-buffer-process b))) buffers)) + +(defun projectile-project-buffers (&optional project) + "Get a list of a project's buffers. +If PROJECT is not specified the command acts on the current project." + (let* ((project-root (or project (projectile-project-root))) + (all-buffers (cl-remove-if-not + (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 (&optional project) + "Get a list of a project's buffer files. +If PROJECT is not specified the command acts on the current project." + (let ((project-root (or project (projectile-project-root)))) + (mapcar + (lambda (buffer) + (file-relative-name + (buffer-file-name buffer) + project-root)) + (projectile-buffers-with-file + (projectile-project-buffers project))))) + +(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)) + default-directory + (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) (eq system-type 'windows-nt))))) + +(defun projectile-ignored-buffer-p (buffer) + "Check if BUFFER should be ignored. + +Regular expressions can be use." + (or + (with-current-buffer buffer + (cl-some + (lambda (name) + (string-match-p name (buffer-name))) + projectile-globally-ignored-buffers)) + (with-current-buffer buffer + (cl-some + (lambda (mode) + (string-match-p (concat "^" mode "$") + (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 + (projectile-difference + (projectile-recentf-files) + project-buffer-files)))) + +(defun projectile-project-buffer-names () + "Get a list of project buffer names." + (mapcar #'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 + (delete (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-switch-to-buffer-other-frame () + "Switch to a project buffer and show it in another window." + (interactive) + (switch-to-buffer-other-frame + (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." + (cl-remove-if-not + (lambda (buffer) + (not (get-buffer-window buffer 'visible))) + (projectile-project-buffers))) + +;;;###autoload +(defun projectile-multi-occur (&optional nlines) + "Do a `multi-occur' in the project's buffers. +With a prefix argument, show NLINES of context." + (interactive "P") + (let ((project (projectile-ensure-project (projectile-project-root)))) + (multi-occur (projectile-project-buffers project) + (car (occur-read-primary-args)) + nlines))) + +(defun projectile-normalise-paths (patterns) + "Remove leading `/' from the elements of PATTERNS." + (delq nil (mapcar (lambda (pat) (and (string-prefix-p "/" pat) + ;; remove the leading / + (substring pat 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))) + (projectile-flatten (mapcar + (lambda (pattern) + (or (file-expand-wildcards pattern t) + (projectile-expand-root pattern))) + paths)))) + +(defun projectile-normalise-patterns (patterns) + "Remove paths from PATTERNS." + (cl-remove-if (lambda (pat) (string-prefix-p "/" pat)) patterns)) + +(defun projectile-make-relative-to-root (files) + "Make FILES relative to the project root." + (let ((project-root (projectile-project-root))) + (mapcar (lambda (f) (file-relative-name f project-root)) files))) + +(defun projectile-ignored-directory-p (directory) + "Check if DIRECTORY should be ignored. + +Regular expressions can be used." + (cl-some + (lambda (name) + (string-match-p name directory)) + (projectile-ignored-directories))) + +(defun projectile-ignored-file-p (file) + "Check if FILE should be ignored. + +Regular expressions can be used." + (cl-some + (lambda (name) + (string-match-p name 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 (cl-some + (lambda (pat) (projectile-check-pattern-p file pat)) + (car patterns)) + (cl-notany + (lambda (pat) (projectile-check-pattern-p file pat)) + (cdr patterns))))) + +(defun projectile-ignored-files () + "Return list of ignored files." + (projectile-difference + (mapcar + #'projectile-expand-root + (append + projectile-globally-ignored-files + (projectile-project-ignored-files))) + (projectile-unignored-files))) + +(defun projectile-ignored-directories () + "Return list of ignored directories." + (projectile-difference + (mapcar + #'file-name-as-directory + (mapcar + #'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." + (cl-remove-if 'file-directory-p (projectile-project-ignored))) + +(defun projectile-project-ignored-directories () + "Return list of project ignored directories. +Unignored directories are not included." + (cl-remove-if-not '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." + (mapcar + #'projectile-expand-root + (append + projectile-globally-unignored-files + (projectile-project-unignored-files)))) + +(defun projectile-unignored-directories () + "Return list of unignored directories." + (mapcar + #'file-name-as-directory + (mapcar + #'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." + (cl-remove-if 'file-directory-p (projectile-project-unignored))) + +(defun projectile-project-unignored-directories () + "Return list of project unignored directories." + (cl-remove-if-not '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 () + (projectile-flatten (mapcar (lambda (pat) (file-expand-wildcards pat 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 (mapcar (lambda (f) (file-name-as-directory (string-trim f))) + (delete "" (reverse keep))) + (mapcar #'string-trim + (delete "" (reverse ignore))) + (mapcar #'string-trim + (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))) + +(cl-defun projectile-completing-read (prompt choices &key initial-input action) + "Present a project tailored PROMPT with CHOICES." + (let ((prompt (projectile-prepend-project-name prompt)) + res) + (setq res + (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 (and (fboundp 'helm) + (fboundp 'helm-make-source)) + (helm :sources + (helm-make-source "Projectile" 'helm-source-sync + :candidates choices + :action (if action + (prog1 action + (setq action nil)) + #'identity)) + :prompt prompt + :input initial-input + :buffer "*helm-projectile*") + (user-error "Please install helm from \ +https://github.com/emacs-helm/helm"))) + ((eq projectile-completion-system 'ivy) + (if (fboundp 'ivy-read) + (ivy-read prompt choices + :initial-input initial-input + :action (prog1 action + (setq action nil)) + :caller 'projectile-completing-read) + (user-error "Please install ivy from \ +https://github.com/abo-abo/swiper"))) + (t (funcall projectile-completion-system prompt choices)))) + (if action + (funcall action res) + res))) + +(defun projectile-project-files (project-root) + "Return a list of files for the PROJECT-ROOT." + (let (files) + ;; If the cache is too stale, don't use it. + (when projectile-files-cache-expire + (let ((cache-time + (gethash project-root projectile-projects-cache-time))) + (when (or (null cache-time) + (< (+ cache-time projectile-files-cache-expire) + (projectile-time-seconds))) + (remhash project-root projectile-projects-cache) + (remhash project-root projectile-projects-cache-time)))) + + ;; Use the cache, if requested and available. + (when projectile-enable-caching + (setq files (gethash project-root projectile-projects-cache))) + + ;; Calculate the list of files. + (when (null files) + (when projectile-enable-caching + (message "Projectile is initializing cache for %s ..." project-root)) + (setq files + (if (eq projectile-indexing-method 'alien) + ;; In alien mode we can just skip reading + ;; .projectile and find all files in the root dir. + (projectile-dir-files-alien project-root) + ;; If a project is defined as a list of subfolders + ;; then we'll have the files returned for each subfolder, + ;; so they are relative to the project root. + ;; + ;; TODO: That's pretty slow and we need to improve it. + ;; One options would be to pass explicitly the subdirs + ;; to commands like `git ls-files` which would return + ;; files paths relative to the project root. + (cl-mapcan + (lambda (dir) + (mapcar (lambda (f) + (file-relative-name (concat dir f) + project-root)) + (projectile-dir-files dir))) + (projectile-get-project-directories project-root)))) + + ;; Save the cached list. + (when projectile-enable-caching + (projectile-cache-project project-root files))) + + ;;; Sorting + ;; + ;; Files can't be cached in sorted order as some sorting schemes + ;; require dynamic data. Sorting is ignored completely when in + ;; alien mode. + (if (eq projectile-indexing-method 'alien) + files + (projectile-sort-files files)))) + +(defun projectile-current-project-files () + "Return a list of the files in the current project." + (projectile-project-files (projectile-project-root))) + +(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-project-dirs (project) + "Return a list of dirs for PROJECT." + (delete-dups + (delq nil + (mapcar #'file-name-directory + (projectile-project-files project))))) + +(defun projectile-current-project-dirs () + "Return a list of dirs for the current project." + (projectile-project-dirs (projectile-ensure-project (projectile-project-root)))) + +(defun projectile-get-other-files (file-name &optional flex-matching) + "Return a list of other files for FILE-NAME. +The list depends on `:related-files-fn' project option and +`projectile-other-file-alist'. For the latter, FLEX-MATCHING can be used +to match any basename." + (if-let ((plist (projectile--related-files-plist-by-kind file-name :other))) + (projectile--related-files-from-plist plist) + (projectile--other-extension-files file-name + (projectile-current-project-files) + flex-matching))) + +(defun projectile--find-other-file (&optional flex-matching ff-variant) + "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'. With FF-VARIANT set to a defun, use that +instead of `find-file'. A typical example of such a defun would be +`find-file-other-window' or `find-file-other-frame'" + (let ((ff (or ff-variant #'find-file)) + (other-files (projectile-get-other-files (buffer-file-name) flex-matching))) + (if other-files + (let ((file-name (projectile--choose-from-candidates other-files))) + (funcall ff (expand-file-name file-name + (projectile-project-root)))) + (error "No other file found")))) + + +;;; Interactive commands +;;;###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") + (projectile--find-other-file flex-matching)) + +;;;###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") + (projectile--find-other-file flex-matching + #'find-file-other-window)) + +;;;###autoload +(defun projectile-find-other-file-other-frame (&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") + (projectile--find-other-file flex-matching + #'find-file-other-frame)) + +(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)) + (let (extensions-start) + (substring file-name + (if (setq 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))) + associated-extensions) + (catch 'break + (while (not (string= "" current-extensions)) + (if (setq 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--other-extension-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 (regexp-quote (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 (cl-remove-if-not + (lambda (project-file) + (string-match filename project-file)) + project-file-list)) + (candidates + (projectile-flatten (mapcar + (lambda (file) + (cl-remove-if-not + (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 + (cl-remove-if-not (lambda (file) (not (backup-file-name-p file))) candidates)) + (candidates + (cl-sort (copy-sequence candidates) + (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)) + +(defun projectile-select-files (project-files &optional invalidate-cache) + "Select a list of files based on filename at point. + +With a prefix arg INVALIDATE-CACHE invalidates the cache first." + (projectile-maybe-invalidate-cache invalidate-cache) + (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 + (cl-remove-if-not + (lambda (project-file) + (string-match file project-file)) + project-files) + nil))) + files)) + +(defun projectile--find-file-dwim (invalidate-cache &optional ff-variant) + "Jump to a project's files using completion based on context. + +With a INVALIDATE-CACHE invalidates the cache first. + +With FF-VARIANT set to a defun, use that instead of `find-file'. +A typical example of such a defun would be `find-file-other-window' or +`find-file-other-frame' + +Subroutine for `projectile-find-file-dwim' and +`projectile-find-file-dwim-other-window'" + (let* ((project-root (projectile-project-root)) + (project-files (projectile-project-files project-root)) + (files (projectile-select-files project-files invalidate-cache)) + (file (cond ((= (length files) 1) + (car files)) + ((> (length files) 1) + (projectile-completing-read "Switch to: " files)) + (t + (projectile-completing-read "Switch to: " project-files)))) + (ff (or ff-variant #'find-file))) + (funcall ff (expand-file-name file project-root)) + (run-hooks 'projectile-find-file-hook))) + +;;;###autoload +(defun projectile-find-file-dwim (&optional invalidate-cache) + "Jump to a project's files using completion based on context. + +With a prefix arg INVALIDATE-CACHE 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-dwim' 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-dwim' 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") + (projectile--find-file-dwim invalidate-cache)) + +;;;###autoload +(defun projectile-find-file-dwim-other-window (&optional invalidate-cache) + "Jump to a project's files using completion based on context in other window. + +With a prefix arg INVALIDATE-CACHE 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-dwim-other-window' 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-dwim-other-window' 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") + (projectile--find-file-dwim invalidate-cache #'find-file-other-window)) + +;;;###autoload +(defun projectile-find-file-dwim-other-frame (&optional invalidate-cache) + "Jump to a project's files using completion based on context in other frame. + +With a prefix arg INVALIDATE-CACHE 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-dwim-other-frame' 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-dwim-other-frame' 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") + (projectile--find-file-dwim invalidate-cache #'find-file-other-frame)) + +(defun projectile--find-file (invalidate-cache &optional ff-variant) + "Jump to a project's file using completion. +With INVALIDATE-CACHE invalidates the cache first. With FF-VARIANT set to a +defun, use that instead of `find-file'. A typical example of such a defun +would be `find-file-other-window' or `find-file-other-frame'" + (interactive "P") + (projectile-maybe-invalidate-cache invalidate-cache) + (let* ((project-root (projectile-ensure-project (projectile-project-root))) + (file (projectile-completing-read "Find file: " + (projectile-project-files project-root))) + (ff (or ff-variant #'find-file))) + (when file + (funcall ff (expand-file-name file project-root)) + (run-hooks 'projectile-find-file-hook)))) + +;;;###autoload +(defun projectile-find-file (&optional invalidate-cache) + "Jump to a project's file using completion. +With a prefix arg INVALIDATE-CACHE invalidates the cache first." + (interactive "P") + (projectile--find-file invalidate-cache)) + +;;;###autoload +(defun projectile-find-file-other-window (&optional invalidate-cache) + "Jump to a project's file using completion and show it in another window. + +With a prefix arg INVALIDATE-CACHE invalidates the cache first." + (interactive "P") + (projectile--find-file invalidate-cache #'find-file-other-window)) + +;;;###autoload +(defun projectile-find-file-other-frame (&optional invalidate-cache) + "Jump to a project's file using completion and show it in another frame. + +With a prefix arg INVALIDATE-CACHE invalidates the cache first." + (interactive "P") + (projectile--find-file invalidate-cache #'find-file-other-frame)) + +;;;###autoload +(defun projectile-toggle-project-read-only () + "Toggle project read only." + (interactive) + (let ((inhibit-read-only t) + (val (not buffer-read-only)) + (default-directory (projectile-ensure-project (projectile-project-root)))) + (add-dir-local-variable nil 'buffer-read-only val) + (save-buffer) + (kill-buffer) + (when buffer-file-name + (read-only-mode (if val +1 -1)) + (message "[%s] read-only-mode is %s" (projectile-project-name) (if val "on" "off"))))) + + +;;;; Sorting project files +(defun projectile-sort-files (files) + "Sort FILES according to `projectile-sort-order'." + (cl-case 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 + (projectile-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 + (projectile-difference files project-recently-active-files)))) + +(defun projectile-sort-by-modification-time (files) + "Sort FILES by modification time." + (let ((default-directory (projectile-project-root))) + (cl-sort + (copy-sequence files) + (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))))))) + +(defun projectile-sort-by-access-time (files) + "Sort FILES by access time." + (let ((default-directory (projectile-project-root))) + (cl-sort + (copy-sequence files) + (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))))))) + + +;;;; Find directory in project functionality +(defun projectile--find-dir (invalidate-cache &optional dired-variant) + "Jump to a project's directory using completion. + +With INVALIDATE-CACHE invalidates the cache first. With DIRED-VARIANT set to a +defun, use that instead of `dired'. A typical example of such a defun would be +`dired-other-window' or `dired-other-frame'" + (projectile-maybe-invalidate-cache invalidate-cache) + (let* ((project (projectile-ensure-project (projectile-project-root))) + (dir (projectile-complete-dir project)) + (dired-v (or dired-variant #'dired))) + (funcall dired-v (expand-file-name dir project)) + (run-hooks 'projectile-find-dir-hook))) + +;;;###autoload +(defun projectile-find-dir (&optional invalidate-cache) + "Jump to a project's directory using completion. + +With a prefix arg INVALIDATE-CACHE invalidates the cache first." + (interactive "P") + (projectile--find-dir invalidate-cache)) + +;;;###autoload +(defun projectile-find-dir-other-window (&optional invalidate-cache) + "Jump to a project's directory in other window using completion. + +With a prefix arg INVALIDATE-CACHE invalidates the cache first." + (interactive "P") + (projectile--find-dir invalidate-cache #'dired-other-window)) + +;;;###autoload +(defun projectile-find-dir-other-frame (&optional invalidate-cache) + "Jump to a project's directory in other window using completion. + +With a prefix arg INVALIDATE-CACHE invalidates the cache first." + (interactive "P") + (projectile--find-dir invalidate-cache #'dired-other-frame)) + +(defun projectile-complete-dir (project) + (let ((project-dirs (projectile-project-dirs project))) + (projectile-completing-read + "Find dir: " + (if projectile-find-dir-includes-top-level + (append '("./") project-dirs) + project-dirs)))) + +;;;###autoload +(defun projectile-find-test-file (&optional invalidate-cache) + "Jump to a project's test file using completion. + +With a prefix arg INVALIDATE-CACHE invalidates the cache first." + (interactive "P") + (projectile-maybe-invalidate-cache invalidate-cache) + (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." + (cl-remove-if-not 'projectile-test-file-p files)) + +(defun projectile--merge-related-files-fns (related-files-fns) + "Merge multiple RELATED-FILES-FNS into one function." + (lambda (path) + (let (merged-plist) + (dolist (fn related-files-fns merged-plist) + (let ((plist (funcall fn path))) + (cl-loop for (key value) on plist by #'cddr + do (let ((values (if (consp value) value (list value)))) + (if (plist-member merged-plist key) + (nconc (plist-get merged-plist key) values) + (setq merged-plist (plist-put merged-plist key values)))))))))) + +(defun projectile--related-files-plist (project-root file) + "Return a plist containing all related files information for FILE in PROJECT-ROOT." + (if-let ((rel-path (if (file-name-absolute-p file) + (file-relative-name file project-root) + file)) + (custom-function (funcall projectile-related-files-fn-function (projectile-project-type)))) + (funcall (cond ((functionp custom-function) + custom-function) + ((consp custom-function) + (projectile--merge-related-files-fns custom-function)) + (t + (error "Unsupported value type of :related-files-fn"))) + rel-path))) + +(defun projectile--related-files-plist-by-kind (file kind) + "Return a plist containing :paths and/or :predicate of KIND for FILE." + (if-let ((project-root (projectile-project-root)) + (plist (projectile--related-files-plist project-root file)) + (has-kind? (plist-member plist kind))) + (let* ((kind-value (plist-get plist kind)) + (values (if (cl-typep kind-value '(or string function)) + (list kind-value) + kind-value)) + (paths (delete-dups (cl-remove-if-not 'stringp values))) + (predicates (delete-dups (cl-remove-if-not 'functionp values)))) + (append + ;; Make sure that :paths exists even with nil if there is no predicates + (when (or paths (null predicates)) + (list :paths (cl-remove-if-not + (lambda (f) + (projectile-file-exists-p (expand-file-name f project-root))) + paths))) + (when predicates + (list :predicate (if (= 1 (length predicates)) + (car predicates) + (lambda (other-file) + (cl-some (lambda (predicate) + (funcall predicate other-file)) + predicates))))))))) + +(defun projectile--related-files-from-plist (plist) + "Return a list of files matching to PLIST from current project files." + (let* ((predicate (plist-get plist :predicate)) + (paths (plist-get plist :paths))) + (delete-dups (append + paths + (when predicate + (cl-remove-if-not predicate (projectile-current-project-files))))))) + +(defun projectile--related-files-kinds(file) + "Return a list o keywords meaning available related kinds for FILE." + (if-let ((project-root (projectile-project-root)) + (plist (projectile--related-files-plist project-root file))) + (cl-loop for key in plist by #'cddr + collect key))) + +(defun projectile--related-files (file kind) + "Return a list of related files of KIND for FILE." + (projectile--related-files-from-plist (projectile--related-files-plist-by-kind file kind))) + +(defun projectile--find-related-file (file &optional kind) + "Choose a file from files related to FILE as KIND. +If KIND is not provided, a list of possible kinds can be chosen." + (unless kind + (if-let ((available-kinds (projectile--related-files-kinds file))) + (setq kind (if (= (length available-kinds) 1) + (car available-kinds) + (intern (projectile-completing-read "Kind :" available-kinds)))) + (error "No related files found"))) + + (if-let ((candidates (projectile--related-files file kind))) + (projectile-expand-root (projectile--choose-from-candidates candidates)) + (error + "No matching related file as `%s' found for project type `%s'" + kind (projectile-project-type)))) + +;;;###autoload +(defun projectile-find-related-file-other-window () + "Open related file in other window." + (interactive) + (find-file-other-window + (projectile--find-related-file (buffer-file-name)))) + +;;;###autoload +(defun projectile-find-related-file-other-frame () + "Open related file in other frame." + (interactive) + (find-file-other-frame + (projectile--find-related-file (buffer-file-name)))) + +;;;###autoload +(defun projectile-find-related-file() + "Open related file." + (interactive) + (find-file + (projectile--find-related-file (buffer-file-name)))) + +;;;###autoload +(defun projectile-related-files-fn-groups(kind groups) + "Generate a related-files-fn which relates as KIND for files in each of GROUPS." + (lambda (path) + (if-let ((group-found (cl-find-if (lambda (group) + (member path group)) + groups))) + (list kind (cl-remove path group-found :test 'equal))))) + +;;;###autoload +(defun projectile-related-files-fn-extensions(kind extensions) + "Generate a related-files-fn which relates as KIND for files having EXTENSIONS." + (lambda (path) + (let* ((ext (file-name-extension path)) + (basename (file-name-base path)) + (basename-regexp (regexp-quote basename))) + (when (member ext extensions) + (list kind (lambda (other-path) + (and (string-match-p basename-regexp other-path) + (equal basename (file-name-base other-path)) + (let ((other-ext (file-name-extension other-path))) + (and (member other-ext extensions) + (not (equal other-ext ext))))))))))) + +;;;###autoload +(defun projectile-related-files-fn-test-with-prefix(extension test-prefix) + "Generate a related-files-fn which relates tests and impl for files with EXTENSION based on TEST-PREFIX." + (lambda (path) + (when (equal (file-name-extension path) extension) + (let* ((file-name (file-name-nondirectory path)) + (find-impl? (string-prefix-p test-prefix file-name)) + (file-name-to-find (if find-impl? + (substring file-name (length test-prefix)) + (concat test-prefix file-name)))) + (list (if find-impl? :impl :test) + (lambda (other-path) + (and (string-suffix-p file-name-to-find other-path) + (equal (file-name-nondirectory other-path) file-name-to-find)))))))) + +;;;###autoload +(defun projectile-related-files-fn-test-with-suffix(extension test-suffix) + "Generate a related-files-fn which relates tests and impl for files with EXTENSION based on TEST-SUFFIX." + (lambda (path) + (when (equal (file-name-extension path) extension) + (let* ((file-name (file-name-nondirectory path)) + (dot-ext (concat "." extension)) + (suffix-ext (concat test-suffix dot-ext)) + (find-impl? (string-suffix-p suffix-ext file-name)) + (file-name-to-find (if find-impl? + (concat (substring file-name 0 (- (length suffix-ext))) + dot-ext) + (concat (substring file-name 0 (- (length dot-ext))) + suffix-ext)))) + (list (if find-impl? :impl :test) + (lambda (other-path) + (and (string-suffix-p file-name-to-find other-path) + (equal (file-name-nondirectory other-path) file-name-to-find)))))))) + +(defun projectile-test-file-p (file) + "Check if FILE is a test file." + (let ((kinds (projectile--related-files-kinds file))) + (cond ((member :impl kinds) t) + ((member :test kinds) nil) + (t (or (cl-some (lambda (pat) (string-prefix-p pat (file-name-nondirectory file))) + (delq nil (list (funcall projectile-test-prefix-function (projectile-project-type))))) + (cl-some (lambda (pat) (string-suffix-p pat (file-name-sans-extension (file-name-nondirectory file)))) + (delq 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 nil + "An alist holding all project types that are known to Projectile. +The project types are symbols and they are linked to plists holding +the properties of the various project types.") + +(cl-defun projectile-register-project-type + (project-type marker-files &key compilation-dir configure compile test run test-suffix test-prefix src-dir test-dir related-files-fn) + "Register a project type with projectile. + +A project type is defined by PROJECT-TYPE, a set of MARKER-FILES, +and optional keyword arguments: +COMPILATION-DIR the directory to run the tests- and compilations in, +CONFIGURE which specifies a command that configures the project + `%s' in the command will be substituted with (projectile-project-root) + before the command is run, +COMPILE which specifies a command that builds the project, +TEST which specified a command that tests the project, +RUN which specifies a command that runs the project, +TEST-SUFFIX which specifies test file suffix, and +TEST-PREFIX which specifies test file prefix. +SRC-DIR which specifies the path to the source relative to the project root. +TEST-DIR which specifies the path to the tests relative to the project root. +RELATED-FILES-FN which specifies a custom function to find the related files such as +test/impl/other files as below: + CUSTOM-FUNCTION accepts FILE as relative path from the project root and returns + a plist containing :test, :impl or :other as key and the relative path/paths or + predicate as value. PREDICATE accepts a relative path as the input." + (let ((project-plist (list 'marker-files marker-files + 'compilation-dir compilation-dir + 'configure-command configure + 'compile-command compile + 'test-command test + 'run-command run))) + ;; There is no way for the function to distinguish between an + ;; explicit argument of nil and an omitted argument. However, the + ;; body of the function is free to consider nil an abbreviation + ;; for some other meaningful value + (when test-suffix + (plist-put project-plist 'test-suffix test-suffix)) + (when test-prefix + (plist-put project-plist 'test-prefix test-prefix)) + (when src-dir + (plist-put project-plist 'src-dir src-dir)) + (when test-dir + (plist-put project-plist 'test-dir test-dir)) + (when related-files-fn + (plist-put project-plist 'related-files-fn related-files-fn)) + + (setq projectile-project-types + (cons `(,project-type . ,project-plist) + projectile-project-types)))) + +(defun projectile-cabal-project-p () + "Check if a project contains *.cabal files but no stack.yaml file." + (and (projectile-verify-file-wildcard "?*.cabal") + (not (projectile-verify-file "stack.yaml")))) + +(defun projectile-dotnet-project-p () + (or (projectile-verify-file-wildcard "?*.csproj") + (projectile-verify-file-wildcard "?*.fsproj"))) + +(defun projectile-go-project-p () + "Check if a project contains Go source files." + (or (projectile-verify-file "go.mod") + (projectile-verify-file-wildcard "*.go"))) + +(define-obsolete-variable-alias 'projectile-go-function 'projectile-go-project-test-function "1.0.0") +(defcustom projectile-go-project-test-function #'projectile-go-project-p + "Function to determine if project's type is go." + :group 'projectile + :type 'function) + +;;; Project type registration +;; +;; Project type detection happens in a reverse order with respect to +;; project type registration (invocations of `projectile-register-project-type'). +;; +;; As function-based project type detection is pretty slow, so it +;; should be tried at the end if everything else failed (meaning here +;; it should be listed first). +;; +;; Ideally common project types should be checked earlier than exotic ones. + +;; Function-based detection project type +(projectile-register-project-type 'haskell-cabal #'projectile-cabal-project-p + :compile "cabal build" + :test "cabal test" + :run "cabal run" + :test-suffix "Spec") +(projectile-register-project-type 'dotnet #'projectile-dotnet-project-p + :compile "dotnet build" + :run "dotnet run" + :test "dotnet test") +(projectile-register-project-type 'go projectile-go-project-test-function + :compile "go build" + :test "go test ./..." + :test-suffix "_test") +;; File-based detection project types + +;; Universal +(projectile-register-project-type 'scons '("SConstruct") + :compile "scons" + :test "scons test" + :test-suffix "test") +(projectile-register-project-type 'meson '("meson.build") + :compilation-dir "build" + :configure "meson %s" + :compile "ninja" + :test "ninja test") +(projectile-register-project-type 'nix '("default.nix") + :compile "nix-build" + :test "nix-build") +;; Make & CMake +(projectile-register-project-type 'make '("Makefile") + :compile "make" + :test "make test") +(projectile-register-project-type 'cmake '("CMakeLists.txt") + :compilation-dir "build" + :configure "cmake %s -B %s" + :compile "cmake --build ." + :test "ctest") +;; PHP +(projectile-register-project-type 'php-symfony '("composer.json" "app" "src" "vendor") + :compile "app/console server:run" + :test "phpunit -c app " + :test-suffix "Test") +;; Erlang & Elixir +(projectile-register-project-type 'rebar '("rebar.config") + :compile "rebar" + :test "rebar eunit" + :test-suffix "_SUITE") +(projectile-register-project-type 'elixir '("mix.exs") + :compile "mix compile" + :src-dir "lib/" + :test "mix test" + :test-suffix "_test") +;; JavaScript +(projectile-register-project-type 'grunt '("Gruntfile.js") + :compile "grunt" + :test "grunt test") +(projectile-register-project-type 'gulp '("gulpfile.js") + :compile "gulp" + :test "gulp test") +(projectile-register-project-type 'npm '("package.json") + :compile "npm install" + :test "npm test" + :test-suffix ".test") +;; Angular +(projectile-register-project-type 'angular '("angular.json" ".angular-cli.json") + :compile "ng build" + :run "ng serve" + :test "ng test") +;; Python +(projectile-register-project-type 'django '("manage.py") + :compile "python manage.py runserver" + :test "python manage.py test" + :test-prefix "test_" + :test-suffix"_test") +(projectile-register-project-type 'python-pip '("requirements.txt") + :compile "python setup.py build" + :test "python -m unittest discover" + :test-prefix "test_" + :test-suffix"_test") +(projectile-register-project-type 'python-pkg '("setup.py") + :compile "python setup.py build" + :test "python -m unittest discover" + :test-prefix "test_" + :test-suffix"_test") +(projectile-register-project-type 'python-tox '("tox.ini") + :compile "tox -r --notest" + :test "tox" + :test-prefix "test_" + :test-suffix"_test") +(projectile-register-project-type 'python-pipenv '("Pipfile") + :compile "pipenv run build" + :test "pipenv run test" + :test-prefix "test_" + :test-suffix "_test") +;; Java & friends +(projectile-register-project-type 'maven '("pom.xml") + :compile "mvn clean install" + :test "mvn test" + :test-suffix "Test" + :src-dir "main/src/" + :test-dir "main/test/") +(projectile-register-project-type 'gradle '("build.gradle") + :compile "gradle build" + :test "gradle test" + :test-suffix "Spec") +(projectile-register-project-type 'gradlew '("gradlew") + :compile "./gradlew build" + :test "./gradlew test" + :test-suffix "Spec") +(projectile-register-project-type 'grails '("application.properties" "grails-app") + :compile "grails package" + :test "grails test-app" + :test-suffix "Spec") +(projectile-register-project-type 'sbt '("build.sbt") + :compile "sbt compile" + :test "sbt test" + :test-suffix "Spec") +(projectile-register-project-type 'lein-test '("project.clj") + :compile "lein compile" + :test "lein test" + :test-suffix "_test") +(projectile-register-project-type 'lein-midje '("project.clj" ".midje.clj") + :compile "lein compile" + :test "lein midje" + :test-prefix "t_") +(projectile-register-project-type 'boot-clj '("build.boot") + :compile "boot aot" + :test "boot test" + :test-suffix "_test") +(projectile-register-project-type 'clojure-cli '("deps.edn") + :test-suffix "_test") +(projectile-register-project-type 'bloop '(".bloop") + :compile "bloop compile root" + :test "bloop test --propagate --reporter scalac root" + :src-dir "src/main/" + :test-dir "src/test/" + :test-suffix "Spec") +;; Ruby +(projectile-register-project-type 'ruby-rspec '("Gemfile" "lib" "spec") + :compile "bundle exec rake" + :src-dir "lib/" + :test "bundle exec rspec" + :test-dir "spec/" + :test-suffix "_spec") +(projectile-register-project-type 'ruby-test '("Gemfile" "lib" "test") + :compile"bundle exec rake" + :src-dir "lib/" + :test "bundle exec rake test" + :test-suffix "_test") +;; Rails needs to be registered after npm, otherwise `package.json` makes it `npm`. +;; https://github.com/bbatsov/projectile/pull/1191 +(projectile-register-project-type 'rails-test '("Gemfile" "app" "lib" "db" "config" "test") + :compile "bundle exec rails server" + :src-dir "lib/" + :test "bundle exec rake test" + :test-suffix "_test") +(projectile-register-project-type 'rails-rspec '("Gemfile" "app" "lib" "db" "config" "spec") + :compile "bundle exec rails server" + :src-dir "lib/" + :test "bundle exec rspec" + :test-dir "spec/" + :test-suffix "_spec") +;; Crystal +(projectile-register-project-type 'crystal-spec '("shard.yml") + :src-dir "src/" + :test "crystal spec" + :test-dir "spec/" + :test-suffix "_spec") + +;; Emacs +(projectile-register-project-type 'emacs-cask '("Cask") + :compile "cask install" + :test-prefix "test-" + :test-suffix "-test") + +;; R +(projectile-register-project-type 'r '("DESCRIPTION") + :compile "R CMD INSTALL --with-keep.source ." + :test (concat "R CMD check -o " temporary-file-directory " .")) + +;; Haskell +(projectile-register-project-type 'haskell-stack '("stack.yaml") + :compile "stack build" + :test "stack build --test" + :test-suffix "Spec") + +;; Rust +(projectile-register-project-type 'rust-cargo '("Cargo.toml") + :compile "cargo build" + :test "cargo test" + :run "cargo run") + +;; Racket +(projectile-register-project-type 'racket '("info.rkt") + :test "raco test .") + + +(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.") +(put 'projectile-project-type 'safe-local-variable #'symbolp) + +(defun projectile-detect-project-type () + "Detect the type of the current project. +Fallsback to a generic project type when the type can't be determined." + (let ((project-type + (or (car (cl-find-if + (lambda (project-type-record) + (let ((project-type (car project-type-record)) + (marker (plist-get (cdr project-type-record) 'marker-files))) + (if (listp marker) + (and (projectile-verify-files marker) project-type) + (and (funcall marker) project-type)))) + projectile-project-types)) + 'generic))) + (puthash (projectile-project-root) project-type projectile-project-type-cache) + project-type)) + +(defun projectile-project-type (&optional dir) + "Determine a project's type based on its structure. +When DIR is specified it checks it, otherwise it acts +on the current project. + +The project type is cached for improved performance." + (if projectile-project-type + projectile-project-type + (let* ((dir (or dir default-directory)) + (project-root (projectile-project-root dir))) + (if project-root + (or (gethash project-root projectile-project-type-cache) + (projectile-detect-project-type)) + ;; if we're not in a project we just return nil + nil)))) + +;;;###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." + (cl-every #'projectile-verify-file files)) + +(defun projectile-verify-file (file) + "Check whether FILE exists in the current project." + (file-exists-p (projectile-expand-root file))) + +(defun projectile-verify-file-wildcard (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 ".fslckout" project-root)) 'fossil) + ((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 ".fslckout") 'fossil) + ((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) + "Determine the name of the test file for 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 `%s' not supported!" project-type))))) + +(defun projectile-create-test-file-for (impl-file-path) + "Create a test file for IMPL-FILE-PATH." + (let* ((test-file (projectile--test-name-for-impl-name impl-file-path)) + (project-root (projectile-project-root)) + (relative-dir (file-name-directory (file-relative-name impl-file-path project-root))) + (src-dir-name (projectile-src-directory (projectile-project-type))) + (test-dir-name (projectile-test-directory (projectile-project-type))) + (test-dir (expand-file-name (replace-regexp-in-string src-dir-name test-dir-name relative-dir) project-root)) + (test-path (expand-file-name test-file test-dir))) + (unless (file-exists-p test-path) + (progn (unless (file-exists-p test-dir) + (make-directory test-dir :create-parents)) + test-path)))) + +(defun projectile-find-implementation-or-test (file-name) + "Given a FILE-NAME return the matching implementation or test filename. + +If `projectile-create-missing-test-files' is non-nil, create the missing +test file." + (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 for project type `%s'" + (projectile-project-type)))) + ;; 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 for project type `%s'" + (projectile-project-type))))))) + +;;;###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-find-implementation-or-test-other-frame () + "Open matching implementation or test file in other frame." + (interactive) + (find-file-other-frame + (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-project-type-attribute (project-type key &optional default-value) + "Return the value of some PROJECT-TYPE attribute identified by KEY. +Fallback to DEFAULT-VALUE for missing attributes." + (let ((project (alist-get project-type projectile-project-types))) + (if (and project (plist-member project key)) + (plist-get project key) + default-value))) + +(defun projectile-test-prefix (project-type) + "Find default test files prefix based on PROJECT-TYPE." + (projectile-project-type-attribute project-type 'test-prefix)) + +(defun projectile-test-suffix (project-type) + "Find default test files suffix based on PROJECT-TYPE." + (projectile-project-type-attribute project-type 'test-suffix)) + +(defun projectile-related-files-fn (project-type) + "Find relative file based on PROJECT-TYPE." + (projectile-project-type-attribute project-type 'related-files-fn)) + +(defun projectile-src-directory (project-type) + "Find default src directory based on PROJECT-TYPE." + (projectile-project-type-attribute project-type 'src-dir "src/")) + +(defun projectile-test-directory (project-type) + "Find default test directory based on PROJECT-TYPE." + (projectile-project-type-attribute project-type 'test-dir "test/")) + +(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." + (cl-sort (copy-sequence + (let (value result) + (while (setq value (pop candidates)) + (let* ((key (projectile-dirname-matching-count file value)) + (kv (assoc key result))) + (if kv + (setcdr kv (cons value (cdr kv))) + (push (list key value) result)))) + (mapcar (lambda (x) + (cons (car x) (nreverse (cdr x)))) + (nreverse result)))) + (lambda (a b) (> (car a) (car b))))) + +(defun projectile--best-or-all-candidates-based-on-parents-dirs (file candidates) + "Return a list containing the best one one for FILE from CANDIDATES or all CANDIDATES." + (let ((grouped-candidates (projectile-group-file-candidates file candidates))) + (if (= (length (car grouped-candidates)) 2) + (list (car (last (car grouped-candidates)))) + (apply #'append (mapcar #'cdr grouped-candidates))))) + +(defun projectile--impl-to-test-predicate (impl-file) + "Return a predicate, which returns t for any test files for IMPL-FILE." + (let* ((basename (file-name-sans-extension (file-name-nondirectory impl-file))) + (test-prefix (funcall projectile-test-prefix-function (projectile-project-type))) + (test-suffix (funcall projectile-test-suffix-function (projectile-project-type))) + (prefix-name (when test-prefix (concat test-prefix basename))) + (suffix-name (when test-suffix (concat basename test-suffix)))) + (lambda (current-file) + (let ((name (file-name-sans-extension (file-name-nondirectory current-file)))) + (or (string-equal prefix-name name) + (string-equal suffix-name name)))))) + +(defun projectile--find-matching-test (impl-file) + "Return a list of test files for IMPL-FILE." + (if-let ((plist (projectile--related-files-plist-by-kind impl-file :test))) + (projectile--related-files-from-plist plist) + (if-let ((predicate (projectile--impl-to-test-predicate impl-file))) + (projectile--best-or-all-candidates-based-on-parents-dirs + impl-file (cl-remove-if-not predicate (projectile-current-project-files)))))) + +(defun projectile--test-to-impl-predicate (test-file) + "Return a predicate, which returns t for any impl files for TEST-FILE." + (let* ((basename (file-name-sans-extension (file-name-nondirectory test-file))) + (test-prefix (funcall projectile-test-prefix-function (projectile-project-type))) + (test-suffix (funcall projectile-test-suffix-function (projectile-project-type)))) + (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))))))) + +(defun projectile--find-matching-file (test-file) + "Return a list of impl files tested by TEST-FILE." + (if-let ((plist (projectile--related-files-plist-by-kind test-file :impl))) + (projectile--related-files-from-plist plist) + (if-let ((predicate (projectile--test-to-impl-predicate test-file))) + (projectile--best-or-all-candidates-based-on-parents-dirs + test-file (cl-remove-if-not predicate (projectile-current-project-files)))))) + +(defun projectile--choose-from-candidates (candidates) + "Choose one item from CANDIDATES." + (if (= (length candidates) 1) + (car candidates) + (projectile-completing-read "Switch to: " candidates))) + +(defun projectile-find-matching-test (impl-file) + "Compute the name of the test matching IMPL-FILE." + (if-let ((candidates (projectile--find-matching-test impl-file))) + (projectile--choose-from-candidates candidates))) + +(defun projectile-find-matching-file (test-file) + "Compute the name of a file matching TEST-FILE." + (if-let ((candidates (projectile--find-matching-file test-file))) + (projectile--choose-from-candidates 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." + (mapcar (lambda (pat) (concat "*" pat)) projectile-globally-ignored-file-suffixes)) + +(defun projectile--read-search-string-with-default (prefix-label) + (let* ((prefix-label (projectile-prepend-project-name prefix-label)) + (default-value (projectile-symbol-or-selection-at-point)) + (default-label (if (or (not default-value) + (string= default-value "")) + "" + (format " (default %s)" default-value)))) + (read-string (format "%s%s: " prefix-label default-label) nil nil default-value))) + +(defvar projectile-grep-find-ignored-paths) +(defvar projectile-grep-find-unignored-paths) +(defvar projectile-grep-find-ignored-patterns) +(defvar projectile-grep-find-unignored-patterns) + +(defun projectile-rgrep-default-command (regexp files dir) + "Compute the command for \\[rgrep] to use by default. + +Extension of the Emacs 25.1 implementation of `rgrep-default-command', with +which it shares its arglist." + (require 'find-dired) ; for `find-name-arg' + (grep-expand-template + grep-find-template + regexp + (concat (shell-quote-argument "(") + " " find-name-arg " " + (mapconcat + #'shell-quote-argument + (split-string files) + (concat " -o " find-name-arg " ")) + " " + (shell-quote-argument ")")) + dir + (concat + (and grep-find-ignored-directories + (concat "-type d " + (shell-quote-argument "(") + ;; we should use shell-quote-argument here + " -path " + (mapconcat + #'identity + (delq nil (mapcar + #'(lambda (ignore) + (cond ((stringp ignore) + (shell-quote-argument + (concat "*/" ignore))) + ((consp ignore) + (and (funcall (car ignore) dir) + (shell-quote-argument + (concat "*/" + (cdr ignore))))))) + grep-find-ignored-directories)) + " -o -path ") + " " + (shell-quote-argument ")") + " -prune -o ")) + (and grep-find-ignored-files + (concat (shell-quote-argument "!") " -type d " + (shell-quote-argument "(") + ;; we should use shell-quote-argument here + " -name " + (mapconcat + #'(lambda (ignore) + (cond ((stringp ignore) + (shell-quote-argument ignore)) + ((consp ignore) + (and (funcall (car ignore) dir) + (shell-quote-argument + (cdr ignore)))))) + grep-find-ignored-files + " -o -name ") + " " + (shell-quote-argument ")") + " -prune -o ")) + (and projectile-grep-find-ignored-paths + (concat (shell-quote-argument "(") + " -path " + (mapconcat + (lambda (ignore) (shell-quote-argument + (concat "./" ignore))) + projectile-grep-find-ignored-paths + " -o -path ") + " " + (shell-quote-argument ")") + " -prune -o ")) + (and projectile-grep-find-ignored-patterns + (concat (shell-quote-argument "(") + (and (or projectile-grep-find-unignored-paths + projectile-grep-find-unignored-patterns) + (concat " " + (shell-quote-argument "("))) + " -path " + (mapconcat + (lambda (ignore) + (shell-quote-argument + (if (string-prefix-p "*" ignore) ignore + (concat "*/" ignore)))) + projectile-grep-find-ignored-patterns + " -o -path ") + (and (or projectile-grep-find-unignored-paths + projectile-grep-find-unignored-patterns) + (concat " " + (shell-quote-argument ")") + " -a " + (shell-quote-argument "!") + " " + (shell-quote-argument "(") + (and projectile-grep-find-unignored-paths + (concat " -path " + (mapconcat + (lambda (ignore) (shell-quote-argument + (concat "./" ignore))) + projectile-grep-find-unignored-paths + " -o -path "))) + (and projectile-grep-find-unignored-paths + projectile-grep-find-unignored-patterns + " -o") + (and projectile-grep-find-unignored-patterns + (concat " -path " + (mapconcat + (lambda (ignore) + (shell-quote-argument + (if (string-prefix-p "*" ignore) ignore + (concat "*/" ignore)))) + projectile-grep-find-unignored-patterns + " -o -path "))) + " " + (shell-quote-argument ")"))) + " " + (shell-quote-argument ")") + " -prune -o "))))) + +;;;###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 (projectile-project-root))) + (search-regexp (or regexp + (projectile--read-search-string-with-default "Grep for"))) + (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-files + (cl-union (projectile--globally-ignored-file-suffixes-glob) + grep-find-ignored-files)) + (projectile-grep-find-ignored-paths + (append (mapcar (lambda (f) (directory-file-name (file-relative-name f root-dir))) + (projectile-ignored-directories)) + (mapcar (lambda (file) + (file-relative-name file root-dir)) + (projectile-ignored-files)))) + (projectile-grep-find-unignored-paths + (append (mapcar (lambda (f) (directory-file-name (file-relative-name f root-dir))) + (projectile-unignored-directories)) + (mapcar (lambda (file) + (file-relative-name file root-dir)) + (projectile-unignored-files)))) + (projectile-grep-find-ignored-patterns (projectile-patterns-to-ignore)) + (projectile-grep-find-unignored-patterns (projectile-patterns-to-ensure))) + (grep-compute-defaults) + (cl-letf (((symbol-function 'rgrep-default-command) #'projectile-rgrep-default-command)) + (rgrep search-regexp (or files "* .*") root-dir) + (when (get-buffer "*grep*") + ;; When grep is using a global *grep* buffer rename it to be + ;; scoped to the current root to allow multiple concurrent grep + ;; operations, one per root + (with-current-buffer "*grep*" + (rename-buffer (concat "*grep <" 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 (projectile--read-search-string-with-default + (format "Ag %ssearch for" (if current-prefix-arg "regexp " ""))) + current-prefix-arg)) + (if (require 'ag nil 'noerror) + (let ((ag-command (if arg 'ag-regexp 'ag)) + (ag-ignore-list (delq nil + (delete-dups + (append + ag-ignore-list + (projectile--globally-ignored-file-suffixes-glob) + ;; ag supports git ignore files directly + (unless (eq (projectile-project-vcs) 'git) + (append (projectile-ignored-files-rel) + (projectile-ignored-directories-rel) + 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"))) + +;;;###autoload +(defun projectile-ripgrep (search-term &optional arg) + "Run a Ripgrep search with `SEARCH-TERM' at current project root. + +With an optional prefix argument ARG SEARCH-TERM is interpreted as a +regular expression." + (interactive + (list (projectile--read-search-string-with-default + (format "Ripgrep %ssearch for" (if current-prefix-arg "regexp " ""))) + current-prefix-arg)) + (if (require 'ripgrep nil 'noerror) + (let ((args (mapcar (lambda (val) (concat "--glob !" val)) + (append projectile-globally-ignored-files + projectile-globally-ignored-directories)))) + (ripgrep-regexp search-term + (projectile-project-root) + (if arg + args + (cons "--fixed-strings" args)))) + (error "Package `ripgrep' 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 (and (boundp 'ggtags-mode) + (memq projectile-tags-backend '(auto ggtags))) + (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 default-directory)) + shell-output exit-code) + (with-temp-buffer + (setq exit-code + (call-process-shell-command command nil (current-buffer)) + shell-output (string-trim + (buffer-substring (point-min) (point-max))))) + (unless (zerop exit-code) + (error shell-output)) + (visit-tags-table tags-file) + (message "Regenerated %s" 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)))))) + +(defun projectile-determine-find-tag-fn () + "Determine which function to use for a call to `projectile-find-tag'." + (or + (cond + ((eq projectile-tags-backend 'auto) + (cond + ((fboundp 'ggtags-find-tag-dwim) + 'ggtags-find-tag-dwim) + ((fboundp 'xref-find-definitions) + 'xref-find-definitions) + ((fboundp 'etags-select-find-tag) + 'etags-select-find-tag))) + ((eq projectile-tags-backend 'xref) + (when (fboundp 'xref-find-definitions) + 'xref-find-definitions)) + ((eq projectile-tags-backend 'ggtags) + (when (fboundp 'ggtags-find-tag-dwim) + 'ggtags-find-tag-dwim)) + ((eq projectile-tags-backend 'etags-select) + (when (fboundp 'etags-select-find-tag) + 'etags-select-find-tag))) + 'find-tag)) + +;;;###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 (projectile-determine-find-tag-fn))) + (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-ensure-project (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-ensure-project (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-ensure-project (projectile-project-root)) + (call-interactively #'async-shell-command))) + +;;;###autoload +(defun projectile-run-gdb () + "Invoke `gdb' in the project's root." + (interactive) + (projectile-with-default-dir (projectile-ensure-project (projectile-project-root)) + (call-interactively 'gdb))) + +;;;###autoload +(defun projectile-run-shell (arg) + "Invoke `shell' in the project's root. + +Switch to the project specific shell buffer if it already exists. + +Use a prefix argument ARG to indicate creation of a new process instead." + (interactive "P") + (projectile-with-default-dir (projectile-ensure-project (projectile-project-root)) + (shell (projectile-generate-process-name "shell" arg)))) + +;;;###autoload +(defun projectile-run-eshell (arg) + "Invoke `eshell' in the project's root. + +Switch to the project specific eshell buffer if it already exists. + +Use a prefix argument ARG to indicate creation of a new process instead." + (interactive "P") + (projectile-with-default-dir (projectile-ensure-project (projectile-project-root)) + (let ((eshell-buffer-name (projectile-generate-process-name "eshell" arg))) + (eshell)))) + +;;;###autoload +(defun projectile-run-ielm (arg) + "Invoke `ielm' in the project's root. + +Switch to the project specific ielm buffer if it already exists. + +Use a prefix argument ARG to indicate creation of a new process instead." + (interactive "P") + (let* ((project (projectile-ensure-project (projectile-project-root))) + (ielm-buffer-name (projectile-generate-process-name "ielm" arg))) + (if (get-buffer ielm-buffer-name) + (switch-to-buffer ielm-buffer-name) + (projectile-with-default-dir project + (ielm)) + ;; ielm's buffer name is hardcoded, so we have to rename it after creation + (rename-buffer ielm-buffer-name)))) + +;;;###autoload +(defun projectile-run-term (arg) + "Invoke `term' in the project's root. + +Switch to the project specific term buffer if it already exists. + +Use a prefix argument ARG to indicate creation of a new process instead." + (interactive "P") + (let ((project (projectile-ensure-project (projectile-project-root))) + (buffer-name (projectile-generate-process-name "term" arg)) + (default-program (or explicit-shell-file-name + (getenv "ESHELL") + (getenv "SHELL") + "/bin/sh"))) + (unless (get-buffer buffer-name) + (require 'term) + (let ((program (read-from-minibuffer "Run program: " default-program))) + (projectile-with-default-dir project + (set-buffer (term-ansi-make-term buffer-name program)) + (term-mode) + (term-char-mode)))) + (switch-to-buffer buffer-name))) + +;;;###autoload +(defun projectile-run-vterm (&optional arg) + "Invoke `vterm' in the project's root. + +Switch to the project specific term buffer if it already exists. + +Use a prefix argument ARG to indicate creation of a new process instead." + (interactive "P") + (let* ((project (projectile-ensure-project (projectile-project-root))) + (buffer (projectile-generate-process-name "vterm" arg))) + (unless (buffer-live-p (get-buffer buffer)) + (unless (require 'vterm nil 'noerror) + (error "Package 'vterm' is not available")) + (projectile-with-default-dir project + (vterm buffer))) + (switch-to-buffer buffer))) + +(defun projectile-files-in-project-directory (directory) + "Return a list of files in DIRECTORY." + (let* ((project (projectile-ensure-project (projectile-project-root))) + (dir (file-relative-name (expand-file-name directory) + project))) + (cl-remove-if-not + (lambda (f) (string-prefix-p dir f)) + (projectile-project-files project)))) + +(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)) + (mapcar (lambda (str) + (concat directory + (if (string-prefix-p "./" str) + (substring str 2) + str))) + (split-string + (string-trim (shell-command-to-string cmd)) + "\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 + (cl-remove-if + #'file-directory-p + (mapcar #'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* ((directory (if arg + (file-name-as-directory + (read-directory-name "Replace in directory: ")) + (projectile-ensure-project (projectile-project-root)))) + (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)))) + (files (projectile-files-with-string old-text directory))) + (if (fboundp #'fileloop-continue) + ;; Emacs 27+ + (progn (fileloop-initialize-replace old-text new-text files 'default) + (fileloop-continue)) + ;; Emacs 25 and 26 + ;; + ;; 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* ((directory (if arg + (file-name-as-directory + (read-directory-name "Replace regexp in directory: ")) + (projectile-ensure-project (projectile-project-root)))) + (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)))) + (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. + (cl-remove-if + #'file-directory-p + (mapcar #'projectile-expand-root (projectile-dir-files directory))))) + (tags-query-replace old-text new-text nil (cons 'list files)))) + +;;;###autoload +(defun projectile-kill-buffers () + "Kill project buffers. + +The buffer are killed according to the value of +`projectile-kill-buffers-filter'." + (interactive) + (let* ((project (projectile-ensure-project (projectile-project-root))) + (project-name (projectile-project-name project)) + (buffers (projectile-project-buffers project))) + (when (yes-or-no-p + (format "Are you sure you want to kill %s buffers for '%s'? " + (length buffers) project-name)) + (dolist (buffer buffers) + (when (and + ;; we take care not to kill indirect buffers directly + ;; as we might encounter them after their base buffers are killed + (not (buffer-base-buffer buffer)) + (if (functionp projectile-kill-buffers-filter) + (funcall projectile-kill-buffers-filter buffer) + (pcase projectile-kill-buffers-filter + ('kill-all t) + ('kill-only-files (buffer-file-name buffer)) + (_ (user-error "Invalid projectile-kill-buffers-filter value: %S" projectile-kill-buffers-filter))))) + (kill-buffer buffer)))))) + +;;;###autoload +(defun projectile-save-project-buffers () + "Save all project buffers." + (interactive) + (let* ((project (projectile-ensure-project (projectile-project-root))) + (project-name (projectile-project-name project)) + (modified-buffers (cl-remove-if-not (lambda (buf) + (and (buffer-file-name buf) + (buffer-modified-p buf))) + (projectile-project-buffers project)))) + (if (null modified-buffers) + (message "[%s] No buffers need saving" project-name) + (dolist (buf modified-buffers) + (with-current-buffer buf + (save-buffer))) + (message "[%s] Saved %d buffers" project-name (length modified-buffers))))) + +;;;###autoload +(defun projectile-dired () + "Open `dired' at the root of the project." + (interactive) + (dired (projectile-ensure-project (projectile-project-root)))) + +;;;###autoload +(defun projectile-dired-other-window () + "Open `dired' at the root of the project in another window." + (interactive) + (dired-other-window (projectile-ensure-project (projectile-project-root)))) + +;;;###autoload +(defun projectile-dired-other-frame () + "Open `dired' at the root of the project in another frame." + (interactive) + (dired-other-frame (projectile-ensure-project (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. + +If PROJECT-ROOT is given, it is opened instead of the project +root directory of the current buffer file. If interactively +called with a prefix argument, the user is prompted for a project +directory to open." + (interactive (and current-prefix-arg + (list + (projectile-completing-read + "Open project VC in: " + projectile-known-projects)))) + (or project-root (setq project-root (projectile-project-root))) + (let ((vcs (projectile-project-vcs project-root))) + (cl-case 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))) + (t (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-ensure-project (projectile-project-root)))) + (mapcar + (lambda (f) (file-relative-name f project-root)) + (cl-remove-if-not + (lambda (f) (string-prefix-p project-root (expand-file-name f))) + recentf-list))))) + +(defun projectile-serialize-cache () + "Serializes the memory cache to the hard drive." + (projectile-serialize projectile-projects-cache projectile-cache-file)) + +(defvar projectile-configure-cmd-map + (make-hash-table :test 'equal) + "A mapping between projects and the last configure command used on them.") + +(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-configure-cmd nil + "The command to use with `projectile-configure-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-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-generic-command (project-type command-type) + "Generic retrieval of COMMAND-TYPEs default cmd-value for PROJECT-TYPE. + +If found, checks if value is symbol or string. In case of symbol +resolves to function `funcall's. Return value of function MUST +be string to be executed as command." + (let ((command (plist-get (alist-get project-type projectile-project-types) command-type))) + (cond + ((not command) nil) + ((stringp command) command) + ((functionp command) + (if (fboundp command) + (funcall (symbol-function command)))) + (t + (error "The value for: %s in project-type: %s was neither a function nor a string" command-type project-type))))) + +(defun projectile-default-configure-command (project-type) + "Retrieve default configure command for PROJECT-TYPE." + (projectile-default-generic-command project-type 'configure-command)) + +(defun projectile-default-compilation-command (project-type) + "Retrieve default compilation command for PROJECT-TYPE." + (projectile-default-generic-command project-type 'compile-command)) + +(defun projectile-default-compilation-dir (project-type) + "Retrieve default compilation directory for PROJECT-TYPE." + (projectile-default-generic-command project-type 'compilation-dir)) + +(defun projectile-default-test-command (project-type) + "Retrieve default test command for PROJECT-TYPE." + (projectile-default-generic-command project-type 'test-command)) + +(defun projectile-default-run-command (project-type) + "Retrieve default run command for PROJECT-TYPE." + (projectile-default-generic-command project-type 'run-command)) + +(defun projectile-configure-command (compile-dir) + "Retrieve the configure command for COMPILE-DIR. + +The command is determined like this: + +- first we check `projectile-configure-cmd-map' for the last +configure command that was invoked on the project + +- then we check for `projectile-project-configure-cmd' supplied +via .dir-locals.el + +- finally we check for the default configure command for a +project of that type" + (or (gethash compile-dir projectile-configure-cmd-map) + projectile-project-configure-cmd + (let ((cmd-format-string (projectile-default-configure-command (projectile-project-type)))) + (when cmd-format-string + (format cmd-format-string (projectile-project-root) compile-dir))))) + +(defun projectile-compilation-command (compile-dir) + "Retrieve the compilation command for COMPILE-DIR. + +The command is determined like this: + +- first we check `projectile-compilation-cmd-map' for the last +compile command that was invoked on the project + +- then we check for `projectile-project-compilation-cmd' supplied +via .dir-locals.el + +- finally we check for the default compilation command for a +project of that type" + (or (gethash compile-dir projectile-compilation-cmd-map) + projectile-project-compilation-cmd + (projectile-default-compilation-command (projectile-project-type)))) + +(defun projectile-test-command (compile-dir) + "Retrieve the test command for COMPILE-DIR. + +The command is determined like this: + +- first we check `projectile-test-cmd-map' for the last +test command that was invoked on the project + +- then we check for `projectile-project-test-cmd' supplied +via .dir-locals.el + +- finally we check for the default test command for a +project of that type" + (or (gethash compile-dir projectile-test-cmd-map) + projectile-project-test-cmd + (projectile-default-test-command (projectile-project-type)))) + +(defun projectile-run-command (compile-dir) + "Retrieve the run command for COMPILE-DIR. + +The command is determined like this: + +- first we check `projectile-run-cmd-map' for the last +run command that was invoked on the project + +- then we check for `projectile-project-run-cmd' supplied +via .dir-locals.el + +- finally we check for the default run command for a +project of that type" + (or (gethash compile-dir 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 () + "Retrieve the compilation directory for this project." + (let* ((type (projectile-project-type)) + (directory (or projectile-project-compilation-dir + (projectile-default-compilation-dir type)))) + (if directory + (file-truename + (concat (file-name-as-directory (projectile-project-root)) + (file-name-as-directory directory))) + (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) + (compile cmd))) + +(defvar projectile-project-command-history (make-hash-table :test 'equal) + "The history of last executed project commands, per project. + +Projects are indexed by their project-root value.") + +(defun projectile--get-command-history (project-root) + (or (gethash project-root projectile-project-command-history) + (puthash project-root + (make-ring 16) + projectile-project-command-history))) + +(cl-defun projectile--run-project-cmd + (command command-map &key show-prompt prompt-prefix save-buffers) + "Run a project COMMAND, typically a test- or compile command. + +Cache the COMMAND for later use inside the hash-table COMMAND-MAP. + +Normally you'll be prompted for a compilation command, unless +variable `compilation-read-command'. You can force the prompt +by setting SHOW-PROMPT. The prompt will be prefixed with PROMPT-PREFIX. + +If SAVE-BUFFERS is non-nil save all projectile buffers before +running the command. + +The command actually run is returned." + (let* ((project-root (projectile-project-root)) + (default-directory (projectile-compilation-dir)) + (command (projectile-maybe-read-command show-prompt + command + prompt-prefix))) + (when command-map + (puthash default-directory command command-map) + (ring-insert (projectile--get-command-history project-root) command)) + (when save-buffers + (save-some-buffers (not compilation-ask-about-save) + (lambda () + (projectile-project-buffer-p (current-buffer) + project-root)))) + (unless (file-directory-p default-directory) + (mkdir default-directory)) + (projectile-run-compilation command) + command)) + +;;;###autoload +(defun projectile-configure-project (arg) + "Run project configure 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 ((command (projectile-configure-command (projectile-compilation-dir)))) + (projectile--run-project-cmd command projectile-configure-cmd-map + :show-prompt arg + :prompt-prefix "Configure command: " + :save-buffers t))) + +;;;###autoload +(defun projectile-compile-project (arg) + "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 ((command (projectile-compilation-command (projectile-compilation-dir)))) + (projectile--run-project-cmd command projectile-compilation-cmd-map + :show-prompt arg + :prompt-prefix "Compile command: " + :save-buffers t))) + +;;;###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 ((command (projectile-test-command (projectile-compilation-dir)))) + (projectile--run-project-cmd command projectile-test-cmd-map + :show-prompt arg + :prompt-prefix "Test command: " + :save-buffers t))) + +;;;###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 ((command (projectile-run-command (projectile-compilation-dir)))) + (projectile--run-project-cmd command projectile-run-cmd-map + :show-prompt arg + :prompt-prefix "Run command: "))) + +;;;###autoload +(defun projectile-repeat-last-command (show-prompt) + "Run last projectile external command. + +External commands are: `projectile-configure-project', +`projectile-compile-project', `projectile-test-project' and +`projectile-run-project'. + +If the prefix argument SHOW_PROMPT is non nil, the command can be edited." + (interactive "P") + (let* ((project-root + (projectile-ensure-project (projectile-project-root))) + (command-history (projectile--get-command-history project-root)) + (command (car-safe (ring-elements command-history))) + (compilation-read-command show-prompt) + executed-command) + (unless command + (user-error "No command has been run yet for this project")) + (setq executed-command + (projectile--run-project-cmd command + nil + :save-buffers t + :prompt-prefix "Execute command: ")) + (unless (string= command executed-command) + (ring-insert command-history executed-command)))) + +(defun compilation-find-file-projectile-find-compilation-buffer (orig-fun marker filename directory &rest formats) + "Try to find a buffer for FILENAME, if we cannot find it, +fallback to the original function." + (when (and (not (file-exists-p (expand-file-name filename))) + (projectile-project-p)) + (let* ((root (projectile-project-root)) + (dirs (cons "" (projectile-current-project-dirs))) + (new-filename (car (cl-remove-if-not + #'file-exists-p + (mapcar + (lambda (f) + (expand-file-name + filename + (expand-file-name f root))) + dirs))))) + (when new-filename + (setq filename new-filename)))) + + (apply orig-fun `(,marker ,filename ,directory ,@formats))) + +(defun projectile-open-projects () + "Return a list of all open projects. +An open project is a project with any open buffers." + (delete-dups + (delq nil + (mapcar (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-let ((project (projectile-project-root))) + (projectile-difference projects + (list (abbreviate-file-name project))) + projects)) + +(defun projectile--move-current-project-to-end (projects) + "Move current project (if any) to the end of list in the list of PROJECTS." + (if-let ((project (projectile-project-root))) + (append + (projectile--remove-current-project projects) + (list (abbreviate-file-name project))) + projects)) + +(defun projectile-relevant-known-projects () + "Return a list of known projects." + (pcase projectile-current-project-on-switch + ('remove (projectile--remove-current-project projectile-known-projects)) + ('move-to-end (projectile--move-current-project-to-end projectile-known-projects)) + ('keep projectile-known-projects))) + +(defun projectile-relevant-open-projects () + "Return a list of open projects." + (let ((open-projects (projectile-open-projects))) + (pcase projectile-current-project-on-switch + ('remove (projectile--remove-current-project open-projects)) + ('move-to-end (projectile--move-current-project-to-end open-projects)) + ('keep 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") + (let ((projects (projectile-relevant-known-projects))) + (if projects + (projectile-completing-read + "Switch to project: " projects + :action (lambda (project) + (projectile-switch-project-by-name project arg))) + (user-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") + (let ((projects (projectile-relevant-open-projects))) + (if projects + (projectile-completing-read + "Switch to open project: " projects + :action (lambda (project) + (projectile-switch-project-by-name project arg))) + (user-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.'" + (unless (projectile-project-p project-to-switch) + (projectile-remove-known-project project-to-switch) + (error "Directory %s is not a project" project-to-switch)) + (let ((switch-project-action (if arg + 'projectile-commander + projectile-switch-project-action))) + (run-hooks 'projectile-before-switch-project-hook) + (let ((default-directory project-to-switch)) + ;; use a temporary buffer to load PROJECT-TO-SWITCH's dir-locals before calling SWITCH-PROJECT-ACTION + (with-temp-buffer + (hack-dir-local-variables-non-file-buffer)) + ;; Normally the project name is determined from the current + ;; buffer. However, when we're switching projects, we want to + ;; show the name of the project being switched to, rather than + ;; the current project, in the minibuffer. This is a simple hack + ;; to tell the `projectile-project-name' function to ignore the + ;; current buffer and the caching mechanism, and just return the + ;; value of the `projectile-project-name' variable. + (let ((projectile-project-name (funcall projectile-project-name-function + project-to-switch))) + (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: ") + (unless (projectile--directory-p directory) + (user-error "Directory %S does not exist" directory)) + (let ((default-directory directory)) + (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 directory)) + (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." + (cl-mapcan + (lambda (project) + (when (file-exists-p project) + (mapcar (lambda (file) + (expand-file-name file project)) + (projectile-project-files project)))) + projectile-known-projects)) + +;;;###autoload +(defun projectile-find-file-in-known-projects () + "Jump to a file in any of the known projects." + (interactive) + (find-file (projectile-completing-read "Find file in projects: " (projectile-all-project-files)))) + +(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)))) + +(defun projectile--cleanup-known-projects () + "Remove known projects that don't exist anymore and return a list of projects removed." + (projectile-merge-known-projects) + (let ((projects-kept (cl-remove-if-not #'projectile-keep-project-p projectile-known-projects)) + (projects-removed (cl-remove-if #'projectile-keep-project-p projectile-known-projects))) + (setq projectile-known-projects projects-kept) + (projectile-merge-known-projects) + projects-removed)) + +;;;###autoload +(defun projectile-cleanup-known-projects () + "Remove known projects that don't exist anymore." + (interactive) + (if-let ((projects-removed (projectile--cleanup-known-projects))) + (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 + :action 'projectile-remove-known-project))) + (unless (called-interactively-p 'any) + (setq projectile-known-projects + (cl-remove-if + (lambda (proj) (string= project proj)) + 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'." + (mapcar #'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)))) + +;;;###autoload +(defun projectile-add-known-project (project-root) + "Add PROJECT-ROOT to the list of known projects." + (interactive (list (read-directory-name "Add to known projects: "))) + (unless (projectile-ignored-project-p project-root) + (setq projectile-known-projects + (delete-dups + (cons (file-name-as-directory (abbreviate-file-name project-root)) + projectile-known-projects))) + (projectile-merge-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)))) + +(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 (projectile-difference known-on-last-sync known-now)) + (removed-in-other-process + (projectile-difference known-on-last-sync known-on-file)) + (result (delete-dups + (projectile-difference + (append known-now known-on-file) + (append removed-after-sync removed-in-other-process))))) + (setq projectile-known-projects result) + (projectile-save-known-projects))) + + +;;; IBuffer integration +(define-ibuffer-filter projectile-files + "Show Ibuffer with all buffers in the current project." + (:reader (read-directory-name "Project root: " (projectile-project-root)) + :description nil) + (with-current-buffer buf + (equal (file-name-as-directory (expand-file-name qualifier)) + (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 (prompt-for-project) + "Open an IBuffer window showing all buffers in the current project. + +Let user choose another project when PROMPT-FOR-PROJECT is supplied." + (interactive "P") + (let ((project-root (if prompt-for-project + (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 "*Projectile 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 (mapcar #'car projectile-commander-methods)) + (prompt (concat "Select Projectile command [" choices "]: ")) + (ch (read-char-choice prompt choices)) + (fn (nth 2 (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 + (cl-sort (copy-sequence + (cons (list ,key ,description ,method) + (assq-delete-all ,key projectile-commander-methods))) + (lambda (a b) (< (car a) (car b))))))) + +(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") + (dolist (met projectile-commander-methods) + (insert (format "%c:\t%s\n" (car met) (cadr met)))) + (goto-char (point-min)) + (help-mode) + (display-buffer (current-buffer) t)) + (projectile-commander)) + +(defun projectile-commander-bindings () + "Setup the keybindings for the Projectile Commander." + (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 ?V + "Browse dirty projects" + (projectile-browse-dirty-projects)) + + (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 ?a + "Run ag on project." + (call-interactively #'projectile-ag)) + + (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))) + + +;;; Dirty (modified) project check related functionality +(defun projectile-check-vcs-status (&optional project-path) + "Check the status of the current project. +If PROJECT-PATH is a project, check this one instead." + (let ((project-path (or project-path (projectile-project-root))) + (project-status nil)) + (save-excursion + (vc-dir project-path) + ;; wait until vc-dir is done + (while (vc-dir-busy) (sleep-for 0 100)) + ;; check for status + (save-excursion + (save-match-data + (dolist (check projectile-vcs-dirty-state) + (goto-char (point-min)) + (when (search-forward check nil t) + (setq project-status (cons check project-status)))))) + (kill-buffer) + project-status))) + +(defvar projectile-cached-dirty-projects-status nil + "Cache of the last dirty projects check.") + +(defun projectile-check-vcs-status-of-known-projects () + "Return the list of dirty projects. +The list is composed of sublists~: (project-path, project-status). +Raise an error if their is no dirty project." + (save-window-excursion + (message "Checking for modifications in known projects...") + (let ((projects projectile-known-projects) + (status ())) + (dolist (project projects) + (when (and (projectile-keep-project-p project) (not (string= 'none (projectile-project-vcs project)))) + (let ((tmp-status (projectile-check-vcs-status project))) + (when tmp-status + (setq status (cons (list project tmp-status) status)))))) + (when (= (length status) 0) + (message "No dirty projects have been found")) + (setq projectile-cached-dirty-projects-status status) + status))) + +;;;###autoload +(defun projectile-browse-dirty-projects (&optional cached) + "Browse dirty version controlled projects. + +With a prefix argument, or if CACHED is non-nil, try to use the cached +dirty project list." + (interactive "P") + (let ((status (if (and cached projectile-cached-dirty-projects-status) + projectile-cached-dirty-projects-status + (projectile-check-vcs-status-of-known-projects))) + (mod-proj nil)) + (while (not (= (length status) 0)) + (setq mod-proj (cons (car (pop status)) mod-proj))) + (projectile-completing-read "Select project: " mod-proj + :action 'projectile-vc))) + + +;;; Find next/previous project buffer +(defun projectile--repeat-until-project-buffer (orig-fun &rest args) + "Repeat ORIG-FUN with ARGS until the current buffer is a project buffer." + (if (projectile-project-root) + (let* ((other-project-buffers (make-hash-table :test 'eq)) + (projectile-project-buffers (projectile-project-buffers)) + (max-iterations (length (buffer-list))) + (counter 0)) + (dolist (buffer projectile-project-buffers) + (unless (eq buffer (current-buffer)) + (puthash buffer t other-project-buffers))) + (when (cdr-safe projectile-project-buffers) + (while (and (< counter max-iterations) + (not (gethash (current-buffer) other-project-buffers))) + (apply orig-fun args) + (cl-incf counter)))) + (apply orig-fun args))) + +(defun projectile-next-project-buffer () + "In selected window switch to the next project buffer. + +If the current buffer does not belong to a project, call `next-buffer'." + (interactive) + (projectile--repeat-until-project-buffer #'next-buffer)) + +(defun projectile-previous-project-buffer () + "In selected window switch to the previous project buffer. + +If the current buffer does not belong to a project, call `previous-buffer'." + (interactive) + (projectile--repeat-until-project-buffer #'previous-buffer)) + + +;;; Editing a project's .dir-locals +(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))))) + + +;;; Projectile Minor mode +(define-obsolete-variable-alias 'projectile-mode-line-lighter 'projectile-mode-line-prefix) +(defcustom projectile-mode-line-prefix + " Projectile" + "Mode line lighter prefix for Projectile. +It's used by `projectile-default-mode-line' +when using dynamic mode line lighter and is the only +thing shown in the mode line otherwise." + :group 'projectile + :type 'string + :package-version '(projectile . "0.12.0")) + +(defvar-local projectile--mode-line projectile-mode-line-prefix) + +(defun projectile-default-mode-line () + "Report project name and type in the modeline." + (let ((project-name (projectile-project-name)) + (project-type (projectile-project-type))) + (format "%s[%s%s]" + projectile-mode-line-prefix + (or project-name "-") + (if project-type + (format ":%s" project-type) + "")))) + +(defun projectile-update-mode-line () + "Update the Projectile mode-line." + (let ((mode-line (funcall projectile-mode-line-function))) + (setq projectile--mode-line mode-line)) + (force-mode-line-update)) + +(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 D") #'projectile-dired-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 "5 a") #'projectile-find-other-file-other-frame) + (define-key map (kbd "5 b") #'projectile-switch-to-buffer-other-frame) + (define-key map (kbd "5 d") #'projectile-find-dir-other-frame) + (define-key map (kbd "5 D") #'projectile-dired-other-frame) + (define-key map (kbd "5 f") #'projectile-find-file-other-frame) + (define-key map (kbd "5 g") #'projectile-find-file-dwim-other-frame) + (define-key map (kbd "5 t") #'projectile-find-implementation-or-test-other-frame) + (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-configure-project) + (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 r") #'projectile-ripgrep) + (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 "V") #'projectile-browse-dirty-projects) + (define-key map (kbd "x e") #'projectile-run-eshell) + (define-key map (kbd "x i") #'projectile-run-ielm) + (define-key map (kbd "x t") #'projectile-run-term) + (define-key map (kbd "x s") #'projectile-run-shell) + (define-key map (kbd "x g") #'projectile-run-gdb) + (define-key map (kbd "x v") #'projectile-run-vterm) + (define-key map (kbd "z") #'projectile-cache-current-file) + (define-key map (kbd "") #'projectile-previous-project-buffer) + (define-key map (kbd "") #'projectile-next-project-buffer) + (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))) + (when projectile-keymap-prefix + (define-key map projectile-keymap-prefix 'projectile-command-map)) + (easy-menu-define projectile-mode-menu map + "Menu for Projectile" + '("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] + ["Save project buffers" projectile-save-project-buffers] + ["Recent files" projectile-recentf] + ["Previous buffer" projectile-previous-project-buffer] + ["Next buffer" projectile-next-project-buffer] + "--" + ["Toggle project wide read-only" projectile-toggle-project-read-only] + ["Edit .dir-locals.el" projectile-edit-dir-locals] + "--" + ["Switch to project" projectile-switch-project] + ["Switch to open project" projectile-switch-open-project] + ["Discover projects in directory" projectile-discover-projects-in-directory] + ["Browse dirty projects" projectile-browse-dirty-projects] + ["Open project in dired" projectile-dired] + "--" + ["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 GDB" projectile-run-gdb] + "--" + ["Run shell" projectile-run-shell] + ["Run eshell" projectile-run-eshell] + ["Run ielm" projectile-run-ielm] + ["Run term" projectile-run-term] + "--" + ["Cache current file" projectile-cache-current-file] + ["Invalidate cache" projectile-invalidate-cache] + ["Regenerate [e|g]tags" projectile-regenerate-tags] + "--" + ["Configure project" projectile-configure-project] + ["Compile project" projectile-compile-project] + ["Test project" projectile-test-project] + ["Run project" projectile-run-project] + ["Repeat last external command" projectile-repeat-last-command] + "--" + ["Project info" projectile-project-info] + ["About" projectile-version])) + map) + "Keymap for Projectile mode.") + +(defun projectile-find-file-hook-function () + "Called by `find-file-hook' when `projectile-mode' is on. + +The function does pretty much nothing when triggered on remote files +as all the operations it normally performs are extremely slow over +tramp." + (unless (file-remote-p default-directory) + (when projectile-dynamic-mode-line + (projectile-update-mode-line)) + (when projectile-auto-update-cache + (projectile-cache-files-find-file-hook)) + (projectile-track-known-projects-find-file-hook) + (projectile-visit-project-tags-table))) + +;;;###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 + :global t + (cond + (projectile-mode + ;; setup the commander bindings + (projectile-commander-bindings) + ;; 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)))) + (unless projectile-projects-cache-time + (setq projectile-projects-cache-time + (make-hash-table :test 'equal))) + ;; load the known projects + (projectile-load-known-projects) + ;; update the list of known projects + (projectile--cleanup-known-projects) + (projectile-discover-projects-in-search-path) + (add-hook 'find-file-hook 'projectile-find-file-hook-function) + (add-hook 'projectile-find-dir-hook #'projectile-track-known-projects-find-file-hook t) + (add-hook 'dired-before-readin-hook #'projectile-track-known-projects-find-file-hook t t) + (advice-add 'compilation-find-file :around #'compilation-find-file-projectile-find-compilation-buffer) + (advice-add 'delete-file :before #'delete-file-projectile-remove-from-cache)) + (t + (remove-hook 'find-file-hook #'projectile-find-file-hook-function) + (remove-hook 'dired-before-readin-hook #'projectile-track-known-projects-find-file-hook t) + (advice-remove 'compilation-find-file #'compilation-find-file-projectile-find-compilation-buffer) + (advice-remove 'delete-file #'delete-file-projectile-remove-from-cache)))) + +;;;###autoload +(define-obsolete-function-alias 'projectile-global-mode 'projectile-mode "1.0") + +(provide 'projectile) + +;;; projectile.el ends here diff --git a/elpa/projectile-20200329.1908/projectile.elc b/elpa/projectile-20200329.1908/projectile.elc new file mode 100644 index 00000000..d8b1411b Binary files /dev/null and b/elpa/projectile-20200329.1908/projectile.elc differ diff --git a/elpa/python-django-20150822.404/python-django-autoloads.el b/elpa/python-django-20150822.404/python-django-autoloads.el new file mode 100644 index 00000000..d8b891b6 --- /dev/null +++ b/elpa/python-django-20150822.404/python-django-autoloads.el @@ -0,0 +1,47 @@ +;;; python-django-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + +(add-to-list 'load-path (directory-file-name + (or (file-name-directory #$) (car load-path)))) + + +;;;### (autoloads nil "python-django" "python-django.el" (0 0 0 0)) +;;; Generated autoloads from python-django.el + +(autoload 'python-django-open-project "python-django" "\ +Open a Django project at given DIRECTORY using SETTINGS. +Optional argument EXISTING is internal and should not be used. + +The recommended way to chose your project root, is to use the +directory containing your settings module; for instance if your +settings module is in /path/django/settings.py, use /path/django/ +as your project path and django.settings as your settings module. + +When called with no `prefix-arg', this function will try to find +an opened project-buffer, if current buffer is already a project +buffer it will cycle to next opened project. If no project +buffers are found, then the user prompted for the project path +and settings module unless `python-django-project-root' and +`python-django-project-settings' are somehow set, normally via +directory local variables. If none of the above matched or the +function is called with one `prefix-arg' and there are projects +defined in the `python-django-known-projects' variable the user +is prompted for any of those known projects, if the variable +turns to be nil the user will be prompted for project-path and +settings module (the same happens when called with two or more +`prefix-arg'). + +\(fn DIRECTORY SETTINGS &optional EXISTING)" t nil) + +(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "python-django" '("python-django-"))) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; python-django-autoloads.el ends here diff --git a/elpa/python-django-20150822.404/python-django-pkg.el b/elpa/python-django-20150822.404/python-django-pkg.el new file mode 100644 index 00000000..ef0fb0cd --- /dev/null +++ b/elpa/python-django-20150822.404/python-django-pkg.el @@ -0,0 +1,2 @@ +;;; -*- no-byte-compile: t -*- +(define-package "python-django" "20150822.404" "A Jazzy package for managing Django projects" 'nil :commit "fc54ad74f0309670359b939f64d0f1fff68aeac4" :keywords '("languages") :authors '(("Fabián E. Gallina" . "fabian@anue.biz")) :maintainer '("FSF") :url "https://github.com/fgallina/python-django.el") diff --git a/elpa/python-django-20150822.404/python-django.el b/elpa/python-django-20150822.404/python-django.el new file mode 100644 index 00000000..d9be1287 --- /dev/null +++ b/elpa/python-django-20150822.404/python-django.el @@ -0,0 +1,2558 @@ +;;; python-django.el --- A Jazzy package for managing Django projects + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Fabián E. Gallina +;; URL: https://github.com/fgallina/python-django.el +;; Package-Version: 20150822.404 +;; Version: 0.1 +;; Maintainer: FSF +;; Created: Jul 2011 +;; Keywords: languages + +;; This file is NOT part of GNU Emacs. + +;; python-django.el 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. + +;; python-django.el 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 python-django.el. If not, see +;; . + +;;; Commentary: + +;; Django project management package with the goodies you would expect +;; and then some. The project buffer workings is pretty much inspired +;; by the good ol' `magit-status' buffer. + +;; This package relies heavily in fgallina's `python.el' available in +;; stock Emacs>=24.3 (or https://github.com/fgallina/python.el). + +;; Implements File navigation (per app, STATIC_ROOT, MEDIA_ROOT and +;; TEMPLATE_DIRS), Etag building, Grep in project, Quick jump (to +;; settings, project root, virtualenv and docs), Management commands +;; and Quick management commands. + +;; File navigation: After opening a project, a directory tree for each +;; installed app, the STATIC_ROOT, the MEDIA_ROOT and each +;; TEMPLATE_DIRS is created. Several commands are provided to work +;; with the current directory at point. + +;; Etags building: Provides a simple wrapper to create etags for +;; current opened project. + +;; Grep in project: Provides a simple way to grep relevant project +;; directories using `rgrep'. You can override the use of `rgrep' by +;; tweaking the `python-django-cmd-grep-function'. + +;; Quick jump: fast key bindings to jump to the settings module, the +;; project root, the current virtualenv and Django official web docs +;; are provided. + +;; Management commands: You can run any management command from the +;; project buffer via `python-django-mgmt-run-command' or via the +;; quick management commands accesible from the Django menu. +;; Completion is provided for all arguments and you can cycle through +;; opened management command process buffers very easily. Another +;; cool feature is that comint processes are spiced up with special +;; processing, for instance if are using runserver and get a +;; breakpoint via pdb or ipdb the pdb-tracking provided by +;; `python-mode' will trigger or if you enter dbshell the proper +;; `sql-mode' will be used. + +;; Quick management commands: This mode provides quick management +;; commands (management commands with sane defaults, smart prompt +;; completion and process extra processing) defined to work with the +;; most used Django built-in management commands like syncdb, shell, +;; runserver, test; several good ones from `django-extensions' like +;; shell_plus, clean_pyc; and `south' ones like convert_to_south, +;; migrate, schemamigration. You can define new quick commands via +;; the `python-django-qmgmt-define' and define ways to handle when +;; it's finished by defining a callback function. + +;;; Usage: + +;; The main entry point is the `python-django-open-project' +;; interactive function, see its documentation for more info on its +;; behavior. Mainly this function requires two things, a project path +;; and a settings module. How you chose them really depends on your +;; project's directory layout. The recommended way to chose your +;; project root, is to use the directory containing your settings +;; module; for instance if your settings module is in +;; /path/django/settings.py, use /path/django/ as your project path +;; and django.settings as your settings module. Remember to always +;; set `python-shell-interpreter' to either python or python2 and +;; never use iPython directly as Django enables it automatically when +;; the shell is started. + +;;; Installation: + +;; Add this to your .emacs: + +;; (add-to-list 'load-path "/folder/containing/file") +;; (require 'python-django) + +;;; Code: + +(require 'hippie-exp) +(require 'json) +(require 'python) +(require 'sql) +(require 'tree-widget) +(require 'wid-edit) +(require 'widget) + +;; Avoid compiler warnings +(defvar view-return-to-alist) + +(defgroup python-django nil + "Python Django project goodies." + :group 'convenience + :version "24.2") + + +;;; keymaps + +(defvar python-django-mode-map + (let ((map (make-keymap))) + (suppress-keymap map t) + (define-key map [remap next-line] 'python-django-ui-widget-forward) + (define-key map [remap previous-line] 'python-django-ui-widget-backward) + (define-key map [remap forward-char] 'widget-forward) + (define-key map [remap backward-char] 'widget-backward) + (define-key map [remap beginning-of-buffer] + 'python-django-ui-beginning-of-widgets) + (define-key map [remap newline] 'python-django-ui-safe-button-press) + (define-key map (kbd "^") 'python-django-ui-move-up-tree) + (define-key map (kbd "p") 'python-django-ui-widget-backward) + (define-key map (kbd "n") 'python-django-ui-widget-forward) + (define-key map (kbd "b") 'widget-backward) + (define-key map (kbd "f") 'widget-forward) + (define-key map (kbd "d") 'python-django-cmd-dired-at-point) + (define-key map (kbd "w") 'python-django-cmd-directory-at-point) + (define-key map (kbd "ja") 'python-django-cmd-jump-to-app) + (define-key map (kbd "jm") 'python-django-cmd-jump-to-media) + (define-key map (kbd "jt") 'python-django-cmd-jump-to-template-dir) + (define-key map (kbd "vs") 'python-django-cmd-visit-settings) + (define-key map (kbd "vr") 'python-django-cmd-visit-project-root) + (define-key map (kbd "vv") 'python-django-cmd-visit-virtualenv) + (define-key map (kbd "t") 'python-django-cmd-build-etags) + (define-key map (kbd "s") 'python-django-cmd-grep) + (define-key map (kbd "o") 'python-django-cmd-open-docs) + (define-key map (kbd "h") 'python-django-help) + (define-key map (kbd "m") 'python-django-mgmt-run-command) + (define-key map (kbd "g") 'python-django-refresh-project) + (define-key map (kbd "q") 'python-django-close-project) + (define-key map (kbd "k") 'python-django-mgmt-kill) + (define-key map (kbd "K") 'python-django-mgmt-kill-all) + (define-key map (kbd "u") 'universal-argument) + (define-key map (kbd "$") 'python-django-mgmt-cycle-buffers-forward) + (define-key map (kbd "#") 'python-django-mgmt-cycle-buffers-backward) + (easy-menu-define python-django-menu map "Python Django Mode menu" + `("Django" + :help "Django project tools" + ["Run management command" + python-django-mgmt-run-command + :help "Run management command in current project"] + ["Kill all running commands" + python-django-mgmt-kill-all + :help "Kill all running commands for current project"] + ["Get command help" python-django-help + :help "Get help for any project's management commands"] + ["Cycle to next running management command" + python-django-mgmt-cycle-buffers-forward + :help "Cycle to next running management command"] + ["Cycle to previous running management command" + python-django-mgmt-cycle-buffers-backward + :help "Cycle to previous running management command"] + "--" + ;; Reserved for quick management commands + "---" + ["Browse Django documentation" + python-django-cmd-open-docs + :help "Open a Browser with Django's documentation"] + ["Build Tags" + python-django-cmd-build-etags + :help "Build TAGS file for python source in project"] + ["Dired at point" + python-django-cmd-dired-at-point + :help "Open dired at current tree node"] + ["Grep in project directories" + python-django-cmd-grep + :help "Grep in project directories"] + ["Refresh project" + python-django-refresh-project + :help "Refresh project"] + "--" + ["Visit settings file" + python-django-cmd-visit-settings + :help "Visit settings file"] + ["Visit virtualenv directory" + python-django-cmd-visit-virtualenv + :help "Visit virtualenv directory"] + ["Visit project root directory" + python-django-cmd-visit-project-root + :help "Visit project root directory"] + "--" + ["Jump to app's directory" + python-django-cmd-jump-to-app + :help "Jump to app's directory"] + ["Jump to a media directory" + python-django-cmd-jump-to-media + :help "Jump to a media directory"] + ["Jump to a template directory" + python-django-cmd-jump-to-template-dir + :help "Jump to a template directory"])) + map) + "Keymap for `python-django-mode'.") + + +;;; Main vars + +(defvar python-django-project-root nil + "Django project root directory.") + +(defvar python-django-project-manage.py nil + "Django project manage.py path.") + +(defvar python-django-project-settings nil + "Django project settings module.") + +(defvar python-django-project-name nil + "Django project name.") + +(define-obsolete-variable-alias + 'python-django-settings-module + 'python-django-project-settings + "24.2") + +(define-obsolete-variable-alias + 'python-django-info-project-name + 'python-django-project-name + "24.2") + + +;;; Faces + +(defgroup python-django-faces nil + "Customize the appearance of Django buffers." + :prefix "python-django-" + :group 'faces + :group 'python-django) + +(defface python-django-face-header + '((t :inherit font-lock-function-name-face)) + "Face for generic header lines. + +Many Django faces inherit from this one by default." + :group 'python-django-faces) + +(defface python-django-face-path + '((t :inherit font-lock-type-face)) + "Face for paths." + :group 'python-django-faces) + +(defface python-django-face-title + '((t :inherit font-lock-keyword-face)) + "Face for titles." + :group 'python-django-faces) + +(defface python-django-face-django-version + '((t :inherit python-django-face-header)) + "Face for project's Django version." + :group 'python-django-faces) + +(defface python-django-face-project-root + '((t :inherit python-django-face-path)) + "Face for project path." + :group 'python-django-faces) + +(defface python-django-face-settings-module + '((t :inherit python-django-face-header)) + "Face for project settings module." + :group 'python-django-faces) + +(defface python-django-face-virtualenv-path + '((t :inherit python-django-face-header)) + "Face for project settings module." + :group 'python-django-faces) + + +;;; Dev tools + +(font-lock-add-keywords + 'emacs-lisp-mode + `(("(\\(python-django-qmgmt-define\\)\\>[ \t]\\([^ \t]+\\)" + (1 'font-lock-keyword-face) + (2 'font-lock-function-name-face)))) + + +;;; Error logging + +(defvar python-django-error-log-formatter + #'python-django-error-default-formatter) + +(defun python-django-error-default-formatter (error-string) + "Formats ERROR-STRING to be placed in the error log." + (format + (concat + "An error occurred retrieving project information.\n" + "Check your project settings and try again:\n\n" + "Current values:\n" + " + python-django-project-root: %s\n" + " + python-django-project-settings: %s\n" + " + python-shell-interpreter: %s\n" + " - found in %s\n\n" + "Details: \n\n%s\n") + python-django-project-root + python-django-project-settings + python-shell-interpreter + (let* ((process-environment + (python-django-info-calculate-process-environment)) + (exec-path (python-shell-calculate-exec-path))) + (executable-find python-shell-interpreter)) + error-string)) + +(defun python-django-error-log (error-string) + "Log ERROR-STRING by calling `user-error'." + (user-error "%s" (funcall python-django-error-log-formatter error-string))) + + +;;; Utility functions + +(defun python-django-util-clone-local-variables () + "Clone local variables from manage.py file. +This function is intended to be used so the project buffer gets +the same variables of python files." + (let* ((file-name + (expand-file-name + python-django-project-manage.py)) + (manage.py-exists (get-file-buffer file-name)) + (flymake-start-syntax-check-on-find-file nil) + (manage.py-buffer + (or manage.py-exists + (prog1 + (find-file-noselect file-name t) + (message nil))))) + ;; TODO: Add a predicate parameter to + ;; `python-util-clone-local-variables' itself to handle vars not + ;; intended to be changed by the variable cloning and replace the + ;; following code with that. + (mapc + (lambda (pair) + (and (symbolp (car pair)) + (string-match "^python-" (symbol-name (car pair))) + (not (memq (car pair) + '(python-django-project-root + python-django-project-settings + python-django-project-name + python-django-project-manage.py))) + (set (make-local-variable (car pair)) + (cdr pair)))) + (buffer-local-variables manage.py-buffer)) + (when (not manage.py-exists) + (kill-buffer manage.py-buffer)))) + +(defmacro python-django-util-alist-add (key value alist) + "Update for KEY the VALUE in ALIST." + `(let* ((k (if (bufferp ,key) + (buffer-name ,key) + ,key)) + (v (if (bufferp ,value) + (buffer-name ,value) + ,value)) + (elt (assoc k ,alist))) + (if (not elt) + (setq ,alist (cons (list k v) ,alist)) + (and (not (member v (cdr elt))) + (setf (cdr elt) + (cons v (cdr elt))))))) + +(defmacro python-django-util-alist-del (key value alist) + "Remove for KEY the VALUE in ALIST." + `(let* ((k (if (bufferp ,key) + (buffer-name ,key) + ,key)) + (v (if (bufferp ,value) + (buffer-name ,value) + ,value)) + (elt (assoc k ,alist))) + (and elt (setf (cdr elt) (remove v (cdr elt)))))) + +(defmacro python-django-util-alist-del-key (key alist) + "Empty KEY in ALIST." + `(let* ((k (if (bufferp ,key) + (buffer-name ,key) + ,key)) + (elt (assoc k ,alist))) + (and elt (setf (cdr elt) nil)))) + +(defun python-django-util-alist-get (key alist) + "Get values for KEY in ALIST." + (and (bufferp key) (setq key (buffer-name key))) + (cdr (assoc key alist))) + +;; Based on `file-name-extension' +(defun python-django-util-file-name-extension (filename) + "Return FILENAME's final \"extension\" sans dot." + (save-match-data + (let ((file (file-name-nondirectory filename))) + (if (and (string-match "\\.[^.]*\\'" file) + (not (eq 0 (match-beginning 0)))) + (substring file (+ (match-beginning 0) 1)))))) + +(defun python-django-util-shell-command-to-string (command) + "Execute shell COMMAND and return its output as a string. +Returns a cons cell where the car is the exit status and the cdr +is the captured output." + (with-temp-buffer + (cons + (apply 'call-process shell-file-name + nil t nil (list shell-command-switch command)) + (buffer-string)))) + +(defun python-django-util-shell-command-or-error (command) + "Execute shell COMMAND and return its output as a string. +If the exit status is an error `python-django-error-log' is used +to display command output." + (let* ((result (python-django-util-shell-command-to-string command)) + (status (car result)) + (output (cdr result))) + (if (zerop status) + output + (python-django-error-log + (concat "Error executing: " command "\n\n" output))))) + +(defun python-django-util-shorten-settings (&optional settings) + "Return a shorter SETTINGS module string. +Optional Argument SETTINGS defaults to the value of +`python-django-project-settings'." + (or settings (setq settings python-django-project-settings)) + (let ((beg (string-match "settings\\." settings))) + (if beg + (substring + settings + (+ beg (length (match-string-no-properties 0 settings)))) + settings))) + + +;;; Help + +(defun python-django--help-get (&optional command) + "Get help for COMMAND." + (let* ((process-environment + (python-django-info-calculate-process-environment)) + (exec-path (python-shell-calculate-exec-path))) + (python-django-util-shell-command-or-error + ;; "--help" is better than "help" because it won't make the command end + ;; with failure on Django<1.4. + (format "%s %s %s--help" + (executable-find python-shell-interpreter) + python-django-project-manage.py + (if command (format "%s " command) ""))))) + +(defun python-django-help (&optional command show-help) + "Get help for given COMMAND. +Optional argument SHOW-HELP when non-nil causes the help buffer to pop." + (interactive + (list + (python-django-minibuffer-read-command))) + (if (or show-help (called-interactively-p 'interactive)) + (with-help-window (help-buffer) + (princ (python-django--help-get command))) + (python-django--help-get command))) + +(defun python-django-help-close () + "Close help window if visible." + (let ((win (get-buffer-window (help-buffer)))) + (and win + (delete-window win)))) + + +;;; Project info + +(defun python-django-info-calculate-process-environment () + "Calculate process environment given current Django project." + (let* ((process-environment (python-shell-calculate-process-environment)) + (pythonpath (getenv "PYTHONPATH")) + (project-pythonpath + (mapconcat + 'identity + (list (expand-file-name python-django-project-root) + (expand-file-name "../" python-django-project-root)) + path-separator))) + (setenv "PYTHONPATH" (if (not pythonpath) + project-pythonpath + (format "%s%s%s" + pythonpath + path-separator + project-pythonpath))) + (setenv "DJANGO_SETTINGS_MODULE" + python-django-project-settings) + process-environment)) + +(defun python-django-info-find-manage.py (&optional dir) + "Find manage.py script starting from DIR." + (let ((dir (expand-file-name (or dir default-directory)))) + (if (not (directory-files dir nil "^manage\\.py$")) + (and + ;; Check dir is not directory root. + (not (string-equal "/" dir)) + (not + (and (memq system-type '(windows-nt ms-dos)) + (string-match "\\`[a-zA-Z]:[/\\]\\'" dir))) + (python-django-info-find-manage.py + (expand-file-name + (file-name-as-directory "..") dir))) + (expand-file-name "manage.py" dir)))) + +(defvar python-django-info-prefetched-settings + '("INSTALLED_APPS" "DATABASES" "MEDIA_ROOT" "STATIC_ROOT" "TEMPLATE_DIRS" + "STATICFILES_DIRS")) + +(defvar python-django-info--get-setting-cache nil + "Alist with cached list of settings.") + +(defvar python-django-info--get-version-cache nil + "Alist with cached list of settings.") + +(defun python-django-info-get-version (&optional force) + "Get current Django version path. +Values retrieved by this function are cached so when FORCE is +non-nil the cached value is invalidated." + (or + (and (not force) python-django-info--get-version-cache)) + (setq + python-django-info--get-version-cache + (let* ((process-environment + (python-django-info-calculate-process-environment)) + (exec-path (python-shell-calculate-exec-path))) + (python-django-util-shell-command-or-error + (format + "%s -c \"%s\"" + (executable-find python-shell-interpreter) + (concat + "from __future__ import print_function\n" + "import django\n" + "print(django.get_version(), end='')")))))) + +(defvar python-django-info-imports-code + (concat "\n" + "from __future__ import print_function\n" + "import os\n" + "import sys\n" + "from os.path import dirname, abspath\n" + "stdout = sys.stdout; stderr = sys.stderr\n" + "sys.stdout = sys.stderr = open(os.devnull, 'w')\n" + "from django.conf import settings\n" + "# Try to import json really hard\n" + "try:\n" + " import json\n" + "except ImportError:\n" + " from django.utils import simplejson as json\n" + "# Force settings loading so all output is sent to devnull.\n" + "settings.DEBUG\n" + "sys.stdout = stdout; sys.stderr = stderr\n\n") + "All imports code used to get info. +It contains output redirecting features so settings import +doesn't break the JSON output.") + +(defun python-django-info-get-settings (&optional force) + "Prefretch most common used settings for project. +Values retrieved by this function are cached so when FORCE is +non-nil the cached value is invalidated." + (let ((cached + (mapcar + #'(lambda (setting) + (assq (intern setting) + python-django-info--get-setting-cache)) + python-django-info-prefetched-settings))) + (if (and (not force) + (catch 'exit + (dolist (elt cached) + (when (null elt) + (throw 'exit nil))) + t)) + cached + (let* ((process-environment + (python-django-info-calculate-process-environment)) + (exec-path (python-shell-calculate-exec-path)) + (settings-list-string + (concat "[" + (mapconcat + #'(lambda (str) (concat "'" str "'")) + python-django-info-prefetched-settings + ", ") + "]")) + (value + (json-read-from-string + (python-django-util-shell-command-or-error + (format "%s -c \"%s%s\"" + (executable-find python-shell-interpreter) + python-django-info-imports-code + (concat + "acc = {}\n" + "for name in " settings-list-string ":\n" + " acc[name] = getattr(settings, name, None)\n" + "print(json.dumps(acc), end='')")))))) + (mapc + (lambda (elt) + (let ((cached-val + (assq (car elt) python-django-info--get-setting-cache))) + (if cached-val + (setcdr cached-val (cdr elt)) + (setq python-django-info--get-setting-cache + (cons elt python-django-info--get-setting-cache))))) + value))))) + +(defun python-django-info-get-setting (setting &optional force) + "Get SETTING value from django.conf.settings in JSON format. +Values retrieved by this function are cached so when FORCE is +non-nil the cached value is invalidated." + (let ((cached + (or (and + (member setting python-django-info-prefetched-settings) + (assq (intern setting) (python-django-info-get-settings force))) + (assq (intern setting) + python-django-info--get-setting-cache)))) + (if (and (not force) cached) + (cdr cached) + (let* ((process-environment + (python-django-info-calculate-process-environment)) + (exec-path (python-shell-calculate-exec-path)) + (value + (json-read-from-string + (python-django-util-shell-command-or-error + (format + "%s -c \"%s%s\"" + (executable-find python-shell-interpreter) + python-django-info-imports-code + (format + (concat + "print(json.dumps(" + "getattr(settings, '%s', None)), end='')") + setting))))) + (already-cached (assq (intern setting) + python-django-info--get-setting-cache))) + (if already-cached + (setcdr already-cached value) + (setq python-django-info--get-setting-cache + (cons (cons (intern setting) value) + python-django-info--get-setting-cache))) + value)))) + +(defvar python-django-info--get-app-paths-cache nil + "Cached list of apps and paths.") + +(defun python-django-info-get-app-paths (&optional force) + "Get project paths path. +Values retrieved by this function are cached so when FORCE is +non-nil the cached value is invalidated." + (if (or force (not python-django-info--get-app-paths-cache)) + (setq + python-django-info--get-app-paths-cache + (let* ((process-environment + (python-django-info-calculate-process-environment)) + (exec-path (python-shell-calculate-exec-path))) + (json-read-from-string + (python-django-util-shell-command-or-error + (format "%s -c \"%s%s\"" + (executable-find python-shell-interpreter) + python-django-info-imports-code + " +try: + from django.apps import apps +except ImportError: + # Django<1.7 app loading. + import os.path + from django.utils.importlib import import_module + app_paths = {} + for app_string in settings.INSTALLED_APPS: + app_module = import_module(app_string) + app_path = os.path.dirname(app_module.__file__) + # Keep the last part (e.g: 'django.contrib.admin' -> 'admin') + app_label = app_string.rpartition('.')[2] + app_paths[app_label] = app_path +else: + # Django>=1.7 app loading. + apps.populate(installed_apps=settings.INSTALLED_APPS) + app_paths = {app.label: app.path for app in apps.get_app_configs()} +print(json.dumps(app_paths), end='')"))))) + python-django-info--get-app-paths-cache)) + +(defun python-django-info-get-app-path (app &optional force) + "Get APP's path. +Values retrieved by this function are cached so when FORCE is +non-nil the cached value is invalidated." + (cdr (assq (intern app) (python-django-info-get-app-paths force)))) + +(defun python-django-info-get-installed-apps (&optional force) + "Get list of strings of installed app labels. +Values retrieved by this function are cached so when FORCE is +non-nil the cached value is invalidated." + (mapcar + (lambda (elt) + (symbol-name (car elt))) + (python-django-info-get-app-paths force))) + +(defun python-django-info-get-app-migrations (app) + "Get APP's list of migrations." + (mapcar (lambda (file) + file) + (ignore-errors + (directory-files + (expand-file-name + "migrations" + (python-django-info-get-app-path app)) + nil "^[0-9]\\{4\\}_.*\\.py$")))) + +(defun python-django-info-module-path (module) + "Get MODULE's path." + (let* ((process-environment + (python-django-info-calculate-process-environment)) + (exec-path (python-shell-calculate-exec-path))) + (python-django-util-shell-command-or-error + (format "%s -c \"%s%s%s\"" + (executable-find python-shell-interpreter) + python-django-info-imports-code + (format "import %s\n" module) + (format + "print(%s.__file__.replace('.pyc', '.py'), end='')" module))))) + +(defun python-django-info-directory-basename (&optional dir) + "Get innermost directory name for given DIR." + (car (last (split-string dir "/" t)))) + + +;;; Hippie expand completion + +(defun python-django-minibuffer-try-complete-args (old) + "Try to complete word as a management command argument. +The argument OLD has to be nil the first call of this function, and t +for subsequent calls (for further possible completions of the same +string). It returns t if a new completion is found, nil otherwise." + (save-excursion + (unless old + (he-init-string (he-dabbrev-beg) (point)) + (when (not (equal he-search-string "")) + (setq he-expand-list + (sort (all-completions + he-search-string + minibuffer-completion-table) + 'string<)))) + (while (and he-expand-list + (he-string-member (car he-expand-list) he-tried-table)) + (setq he-expand-list (cdr he-expand-list))) + (if (null he-expand-list) + (progn (if old (he-reset-string)) ()) + (progn + (he-substitute-string (car he-expand-list)) + (setq he-tried-table (cons (car he-expand-list) + (cdr he-tried-table))) + t)))) + +(defun python-django-minibuffer-try-complete-filenames (old) + "Try to complete filenames in command arguments. +The argument OLD has to be nil the first call of this function, and t +for subsequent calls (for further possible completions of the same +string). It returns t if a new completion is found, nil otherwise." + (if (not old) + (progn + (he-init-string (let ((max-point (point))) + (save-excursion + (goto-char (he-file-name-beg)) + (re-search-forward "--?[a-z0-9_-]+=?" max-point t) + (point))) + (point)) + (let ((name-part (file-name-nondirectory he-search-string)) + (dir-part (expand-file-name (or (file-name-directory + he-search-string) "")))) + (if (not (he-string-member name-part he-tried-table)) + (setq he-tried-table (cons name-part he-tried-table))) + (if (and (not (equal he-search-string "")) + (file-directory-p dir-part)) + (setq he-expand-list (sort (file-name-all-completions + name-part + dir-part) + 'string-lessp)) + (setq he-expand-list ()))))) + (while (and he-expand-list + (he-string-member (car he-expand-list) he-tried-table)) + (setq he-expand-list (cdr he-expand-list))) + (if (null he-expand-list) + (progn + (if old (he-reset-string)) + ()) + (let ((filename (he-concat-directory-file-name + (file-name-directory he-search-string) + (car he-expand-list)))) + (he-substitute-string filename) + (setq he-tried-table (cons (car he-expand-list) (cdr he-tried-table))) + (setq he-expand-list (cdr he-expand-list)) + t))) + + +;;; Minibuffer + +(defvar python-django-minibuffer-complete-command-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-must-match-map) + map) + "Keymap used for completing commands in minibuffer.") + +(defvar python-django-minibuffer-complete-command-args-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "\t" 'hippie-expand) + (define-key map [remap scroll-other-window] + 'python-django-minibuffer-scroll-help-window) + (define-key map [remap scroll-other-window-down] + 'python-django-minibuffer-scroll-help-window-down) + map) + "Keymap used for completing command args in minibuffer.") + +(defun python-django-minibuffer-read-command (&optional trigger-help) + "Read django management command from minibuffer. +Optional argument TRIGGER-HELP sets if help buffer with commmand +details should be displayed." + (let* ((current-buffer (current-buffer)) + (command + (minibuffer-with-setup-hook + (lambda () + (python-util-clone-local-variables current-buffer) + (setq minibuffer-completion-table + (python-django-mgmt-list-commands))) + (read-from-minibuffer + "./manage.py: " nil + python-django-minibuffer-complete-command-map)))) + (when trigger-help + (python-django-help command t)) + command)) + +(defun python-django-minibuffer-read-command-args (command) + "Read django management arguments for command from minibuffer. +Arguments are parsed for especific COMMAND." + (let* ((current-buffer (current-buffer))) + (minibuffer-with-setup-hook + (lambda () + (python-util-clone-local-variables current-buffer) + (setq minibuffer-completion-table + (python-django-mgmt-list-command-args command)) + (set (make-local-variable 'hippie-expand-try-functions-list) + '(python-django-minibuffer-try-complete-args + python-django-minibuffer-try-complete-filenames))) + (read-from-minibuffer + (format "./manage.py %s (args): " command) + nil python-django-minibuffer-complete-command-args-map)))) + +(defun python-django-minibuffer-read-list (thing &rest args) + "Helper function to read list of THING from minibuffer. +Optional argument ARGS are the args passed to the THING." + (let ((objs)) + (catch 'exit + (while t + (add-to-list + 'objs + (apply thing args) t) + (when (not (y-or-n-p "Add another? ")) + (throw 'exit (mapconcat 'identity objs " "))))))) + +(defun python-django-minibuffer-read-file-name (prompt) + "Read a single file name from minibuffer. +PROMPT is a string to prompt user for filenames." + (let ((use-dialog-box nil)) + ;; Lets make shell expansion work. + (replace-regexp-in-string + "[\\]\\*" "*" + (shell-quote-argument + (let ((func + (if ido-mode + 'ido-read-file-name + 'read-file-name))) + (funcall func prompt python-django-project-root + python-django-project-root nil)))))) + +(defun python-django-minibuffer-read-file-names (prompt) + "Read a list of file names from minibuffer. +PROMPT is a string to prompt user for filenames." + (python-django-minibuffer-read-list + 'python-django-minibuffer-read-file-name prompt)) + +(defun python-django-minibuffer-read-app (prompt &optional initial-input) + "Read django app from minibuffer. +PROMPT is a string to prompt user for app. Optional argument +INITIAL-INPUT is the initial prompted value." + (let ((apps (python-django-info-get-installed-apps)) + (current-buffer (current-buffer))) + (minibuffer-with-setup-hook + (lambda () + (python-util-clone-local-variables current-buffer) + (setq minibuffer-completion-table apps)) + (catch 'app + (while t + (let ((app (read-from-minibuffer + prompt initial-input minibuffer-local-must-match-map))) + (when (> (length app) 0) + (throw 'app app)))))))) + +(defun python-django-minibuffer-read-apps (prompt &optional initial-input) + "Read django apps from minibuffer. +PROMPT is a string to prompt user for app. Optional argument +INITIAL-INPUT is the initial prompted value." + (python-django-minibuffer-read-list + 'python-django-minibuffer-read-app prompt)) + +(defun python-django-minibuffer-read-database (prompt &optional initial-input) + "Read django database router name from minibuffer. +PROMPT is a string to prompt user for database. +Optional argument INITIAL-INPUT is the initial prompted value." + (let ((databases (mapcar (lambda (router) + (format "%s" (car router))) + (python-django-info-get-setting "DATABASES"))) + (current-buffer (current-buffer))) + (minibuffer-with-setup-hook + (lambda () + (python-util-clone-local-variables current-buffer) + (setq minibuffer-completion-table databases)) + (catch 'db + (while t + (let ((db (read-from-minibuffer + prompt initial-input minibuffer-local-must-match-map))) + (when (> (length db) 0) + (throw 'db db)))))))) + +(defun python-django-minibuffer-read-migration (prompt app) + "Read south migration number for given app from minibuffer. +PROMPT is a string to prompt user for database. APP is the app +to read migrations from." + (let* ((migrations (python-django-info-get-app-migrations app))) + (minibuffer-with-setup-hook + (lambda () + (setq minibuffer-completion-table migrations)) + (let ((migration (read-from-minibuffer + prompt nil minibuffer-local-must-match-map))) + (when (not (string= migration "")) + (substring migration 0 4)))))) + +(defun python-django-minibuffer-read-from-list (prompt lst &optional default) + "Read a value from a list from minibuffer. +PROMPT is a string to prompt user. LST is the list containing +the values to choose from. Optional argument DEFAULT is the +default value." + (minibuffer-with-setup-hook + (lambda () + (setq minibuffer-completion-table lst)) + (read-from-minibuffer prompt default minibuffer-local-must-match-map))) + + +;;; Management commands + +(defvar python-django-mgmt--available-commands nil + "Alist with cached list of management commands for each project.") + +(defun python-django-mgmt-list-commands (&optional force) + "List available management commands. +Optional argument FORCE makes the function to recalculate the +list of command for current project instead of getting it from +the `python-django-mgmt--available-commands' cache." + (and force + (set (make-local-variable 'python-django-mgmt--available-commands) nil)) + (cdr + (or python-django-mgmt--available-commands + (let ((help-string (python-django-help)) + (commands)) + (set (make-local-variable 'python-django-mgmt--available-commands) + (with-temp-buffer + (insert help-string) + (goto-char (point-min)) + (re-search-forward "Available subcommands:\n") + (delete-region (point-min) (point)) + (while (re-search-forward " +\\([a-z0-9_]+\\)\n" nil t) + (setq commands + (cons (match-string-no-properties 1) commands))) + (reverse commands))))))) + +(defun python-django-mgmt-list-command-args (command) + "List available arguments for COMMAND." + (let ((help-string (python-django-help command)) + (args)) + (with-temp-buffer + (insert help-string) + (goto-char (point-min)) + (when (re-search-forward "^Options:\n" nil t) + (while (re-search-forward "--[a-z0-9_-]+=?" nil t) + (setq args (cons (match-string 0) args)) + (append args (match-string 0))) + (sort args 'string<))))) + +(defun python-django-mgmt-make-comint (command process-name) + "Run COMMAND with PROCESS-NAME in generic Comint buffer." + (apply 'make-comint process-name + (executable-find python-shell-interpreter) nil + (split-string-and-unquote command))) + +(defun python-django-mgmt-make-comint-for-shell (command process-name) + "Run COMMAND with PROCESS-NAME in generic Comint buffer." + (let ((python-shell-interpreter-args command)) + (python-shell-make-comint (python-shell-parse-command) process-name))) + +(defun python-django-mgmt-make-comint-for-runserver (command process-name) + "Run COMMAND with PROCESS-NAME in generic Comint buffer." + (let ((python-shell-enable-font-lock nil)) + (python-django-mgmt-make-comint-for-shell command process-name))) + +(defun python-django-mgmt-make-comint-for-dbshell (command process-name) + "Run COMMAND with PROCESS-NAME in generic Comint buffer." + (let* ((dbsetting (python-django-info-get-setting "DATABASES")) + (dbengine (cdr (assoc 'ENGINE (assoc 'default dbsetting)))) + (sql-interactive-product-1 + (cond ((string= dbengine "django.db.backends.mysql") + 'mysql) + ((string= dbengine "django.db.backends.oracle") + 'oracle) + ((string= dbengine "django.db.backends.postgresql") + 'postgres) + ((string= dbengine "django.db.backends.sqlite3") + 'sqlite) + (t nil))) + (buffer + (python-django-mgmt-make-comint command process-name))) + (with-current-buffer buffer + (setq sql-buffer (current-buffer) + sql-interactive-product sql-interactive-product-1) + (sql-interactive-mode)) + buffer)) + +(defcustom python-django-mgmt-buffer-switch-function 'display-buffer + "Function for switching to the process buffer. +The function receives one argument, the management command +process buffer." + :group 'python-django + :type '(radio (function-item switch-to-buffer) + (function-item pop-to-buffer) + (function-item display-buffer) + (function :tag "Other"))) + +(defvar python-django-mgmt--previous-window-configuration nil + "Snapshot of previous window configuration before executing command. +This variable is for internal purposes, don't use it directly.") + +(defun python-django-mgmt-restore-window-configuration () + "Restore window configuration after running a management command." + (and python-django-mgmt--previous-window-configuration + (set-window-configuration + python-django-mgmt--previous-window-configuration))) + +(defvar python-django-mgmt-parent-buffer nil + "Parent project buffer for current process.") + +(defvar python-django-mgmt--opened-buffers nil + "Alist of currently opened process buffers.") + +(defun python-django-mgmt-buffer-list (&optional parent-buffer) + "Return all opened buffer names for PARENT-BUFFER. +Optional Argument PARENT-BUFFER defaults to the current buffer." + (python-django-util-alist-get + (or parent-buffer (current-buffer)) + python-django-mgmt--opened-buffers)) + +(defvar python-django-mgmt--buffer-index 0) + +(defun python-django-mgmt-buffer-get (&optional index) + "Get management buffer by INDEX. +Optional Argument INDEX defaults to the value of +`python-django-mgmt--buffer-index'." + (let ((buffer-list (python-django-mgmt-buffer-list))) + (and buffer-list + (nth (mod (or index python-django-mgmt--buffer-index) + (length buffer-list)) buffer-list)))) + +(defun python-django-mgmt-cycle-buffers-forward (&optional arg) + "Cycle opened process buffers forward. +With Optional Argument ARG cycle that many buffers." + (interactive "p") + (setq arg (or arg 1)) + (let ((buffers (python-django-mgmt-buffer-list))) + (and buffers + (let ((newindex + (mod (+ python-django-mgmt--buffer-index arg) + (length buffers)))) + (set (make-local-variable + 'python-django-mgmt--buffer-index) newindex) + (display-buffer (nth newindex buffers)))))) + +(defun python-django-mgmt-cycle-buffers-backward (&optional arg) + "Cycle opened process buffers backward. +With Optional Argument ARG cycle that many buffers." + (interactive "p") + (python-django-mgmt-cycle-buffers-forward (- (or arg 1)))) + +(defun python-django-mgmt-run-command (command + &optional args capture-ouput no-pop + make-comint-function) + "Run management COMMAND with given ARGS. +When optional argument CAPTURE-OUPUT is non-nil process output is +not truncated by the `comint-truncate-buffer' output filter. If +optional argument NO-POP is provided the process buffer is not +displayed automatically. When optional argument +MAKE-COMINT-FUNCTION is non-nil use that function to create the +comint process, defaults to `python-django-mgmt-make-comint'." + (interactive + (list + (setq command + (python-django-minibuffer-read-command t)) + (python-django-minibuffer-read-command-args command))) + (python-django-help-close) + (when (not (member command (python-django-mgmt-list-commands))) + (error + "Management command %s is not available in current project" command)) + (let* ((args (or args "")) + (process-environment + (python-django-info-calculate-process-environment)) + (exec-path (python-shell-calculate-exec-path)) + (process-name + (replace-regexp-in-string + "[\t ]+$" "" + (format "[Django: %s (%s)] ./manage.py %s %s" + python-django-project-name + (python-django-util-shorten-settings) + command args))) + (buffer-name (format "*%s*" process-name)) + (current-buffer (current-buffer)) + (make-comint-function (or make-comint-function + #'python-django-mgmt-make-comint)) + (full-command + (format "%s %s %s" + python-django-project-manage.py + command args))) + (funcall make-comint-function full-command process-name) + (with-current-buffer buffer-name + (python-util-clone-local-variables current-buffer) + (and (not capture-ouput) + (add-hook 'comint-output-filter-functions + 'comint-truncate-buffer nil t)) + (set (make-local-variable + 'python-django-mgmt-parent-buffer) current-buffer) + (python-django-util-alist-add + current-buffer (current-buffer) + python-django-mgmt--opened-buffers) + (add-hook + 'kill-buffer-hook + (lambda () + (python-django-util-alist-del + python-django-mgmt-parent-buffer (current-buffer) + python-django-mgmt--opened-buffers)) + nil t)) + (unless no-pop + (funcall python-django-mgmt-buffer-switch-function buffer-name) + (with-current-buffer buffer-name + (and (get-buffer-process (current-buffer)) + (comint-goto-process-mark)))) + buffer-name)) + +(add-to-list 'debug-ignored-errors + "^Management command .* is not available in current project.") + +(defun python-django-mgmt-kill (&optional buffer) + "Kill current command's BUFFER." + (interactive) + (setq buffer (or buffer (python-django-mgmt-buffer-get))) + (when (and buffer (or (not (called-interactively-p 'any)) + (y-or-n-p + (format "Kill %s? " buffer)))) + (let ((win (get-buffer-window buffer 0)) + (proc (get-buffer-process buffer))) + (and win (delete-window win)) + (and proc (set-process-query-on-exit-flag proc nil)) + (kill-buffer buffer) + (python-django-mgmt-cycle-buffers-forward)))) + +(defun python-django-mgmt-kill-all (&optional command) + "Kill all running commands for current project after CONFIRM. +When called with universal argument you can filter the COMMAND to kill." + (interactive + (list + (and current-prefix-arg + (python-django-minibuffer-read-command nil)))) + (when (or (not (called-interactively-p 'any)) + (y-or-n-p + (format "Do you want to kill all running commands for %s? " + python-django-project-name))) + (dolist (buffer + (python-django-mgmt-buffer-list (current-buffer))) + (when (or (not command) + (string-match + (format "\\./manage.py %s" (or command "")) buffer)) + (let ((win (get-buffer-window buffer 0)) + (proc (get-buffer-process buffer))) + (and win (delete-window win)) + (and proc (set-process-query-on-exit-flag proc nil))) + (kill-buffer buffer))))) + + +;;; Management shortcuts + +(eval-and-compile + (defun python-django-qmgmt--make-fn-symbol (name) + "Return a quick management command defun symbol from NAME." + (intern (format "python-django-qmgmt-%s" name))) + + (defun python-django-qmgmt--make-functions-symbol (name) + "Return a quick management command functions symbol from NAME." + (intern (format "python-django-qmgmt-%s-functions" name))) + + (defun python-django-qmgmt--make-spec + (command &optional switches interactive-switches) + "Return human readable spec for COMMAND. + +The spec is the shell command with placeholders in it. Example: + + ./manage.py cmd --all --database= --app= + +Where \"--all\" is SWITCHES value, while database and app are +generated from INTERACTIVE-SWITCHES." + (concat + (format "./manage.py %s " command) + (unless (zerop (length switches)) + (format "%s " switches)) + (when interactive-switches + (mapconcat + (lambda (arg) + (let* ((switch (nth 3 arg)) + (switch + (cond + ((eq (length switch) 0) + "") + ((eq ?= (car (last (append switch nil)))) + switch) + (t (format "%s " switch)))) + (varname (symbol-name (nth 0 arg)))) + (format "%s<%s>" switch varname))) + interactive-switches + " ")))) + + (defun python-django-qmgmt--make-docstring + (command &optional switches interactive-switches docstring) + "Return documentation string for auto-generated command. +Arguments COMMAND, SWITCHES, INTERACTIVE-SWITCHES and DOCSTRING +are used to generate the string." + (format + "%s\n\n%s" + ;; Show either the spec, or the docstring *and* the spec. + (concat + (unless (zerop (length docstring)) + (concat docstring "\n\n")) + "Run: " + (python-django-qmgmt--make-spec + command switches interactive-switches)) + (concat + "This is an interactive command defined via " + "`python-django-qmgmt-define' macro.\n" + "Parameter defaults can be overriden by " + "calling this command with `prefix-arg' .\n\n" + (when switches + (format "Default switches: \n\n * %s\n\n" switches)) + (when interactive-switches + (format + "Arguments: \n\n%s" + (mapconcat + (lambda (arg) + (let* ((default (nth 2 arg)) + (switch (nth 3 arg)) + (switch + (cond + ((eq (length switch) 0) + nil) + ((eq ?= (car (last (append switch nil)))) + switch) + (t (format "%s " switch)))) + (force-ask (nth 4 arg))) + (concat + (format " * %s:\n" + (upcase (symbol-name (car arg)))) + (format " + Switch: %s\n" switch) + (format " + Defaults: %s\n" + (prin1-to-string default)) + (format " + Read SPEC: %s\n" + (prin1-to-string (nth 1 arg))) + (format " + Force prompt: %s\n" + force-ask) + (format " + Requires user interaction?: %s" + (if (or force-ask (not default)) + "yes" "no"))))) + interactive-switches "\n\n")))))) + + (defun python-django-qmgmt--make-functions-docstring + (fn-symbol) + "Return documentation string for auto-generated functions variable. +Argument FN-SYMBOL is the symbol of the command." + (format + "A function or list of called after `%s's bound process finishes. +Functions defined here are called in order and must receive two +arguments: The first must be a STATUS-OK which is non-nil if the +process exited successfully and ARGS which is a plist with the +switches and arguments given to it. See +`python-django-qmgmt-define' docstring for details." fn-symbol)) + + (defun python-django-qmgmt--make-interactive-form (interactive-switches) + "Return interactive form from INTERACTIVE-SWITCHES." + (mapcar + (lambda (arg) + ;; Interactive switch form: (VARNAME PROMPT DEFAULT SWITCH FORCE-ASK) + (let* ((default (nth 2 arg)) + (switch (nth 3 arg)) + (switch + (cond ((zerop (length switch)) + ;; This is a positional argument. Skip prefix. + "") + ((eq ?= (car (last (append switch nil)))) + ;; Long switch (e.g "--database="), keep it as prefix. + switch) + ;; Shor switch (e.g "-d"), add space suffix. + (t (format "%s " switch)))) + (force-ask (nth 4 arg)) + (read-func + (if (stringp (nth 1 arg)) + ;; Use string as prompt. + `(read-string ,(nth 1 arg) default) + ;; Execute form to read argument value. + (nth 1 arg)))) + `(concat + ,switch + (setq ,(car arg) + (let ((default ,default)) + (if (or ,force-ask + current-prefix-arg + (not default)) + ,read-func + default)))))) + interactive-switches)) + + (defun python-django-qmgmt--add-binding (symbol &optional binding) + "Add keybinding to SYMBOL using BINDING." + (when binding + (ignore-errors + (define-key python-django-mode-map (concat "c" binding) symbol)))) + + (defun python-django-qmgmt--add-menu-item + (symbol submenu command &optional switches interactive-switches docstring) + "Add menu item for SYMBOL in SUBMENU to execute mangament COMMAND. +Arguments SWITCHES, INTERACTIVE-SWITCHES and DOCSTRING are used +to generate a descriptive item." + (let* ((spec (python-django-qmgmt--make-spec + command switches interactive-switches)) + (help (if (zerop (length docstring)) ; also handle empty string + (format "Run ./manage.py %s" spec) + (car (split-string docstring "\n"))))) + (easy-menu-add-item + 'python-django-menu nil (list submenu) "---") + (easy-menu-add-item + 'python-django-menu (list submenu) + `[,spec + ,symbol + :help ,help + :active (member ,command (python-django-mgmt-list-commands))] + "---")))) + +(defmacro python-django-qmgmt-define (name doc-or-args + &optional args &rest interactive-switches) + "Define a quick management command. +Argument NAME is a symbol and it is used to calculate the +management command this command will execute, so it should have +the form cmdname[-rest]. Argument DOC-OR-ARGS might be the +docstring for the defined command or the list of arguments, when +a docstring is supplied ARGS is used as the list of arguments +instead. The rest INTERACTIVE-SWITCHES is a list of interactive +switches the user will be prompted for. + +This is a full example that will define how to execute Django's +dumpdata for the current application quickly: + + (python-django-qmgmt-define dumpdata-app + \"Run dumpdata for current application.\" + (:submenu \"Database\" :switches \"--format=json\" :binding \"dda\") + (database \"Database\" \"default\" \"--database=\") + (app \"App\")) + +When that's is evaled a command called +`python-django-qmgmt-dumpdata-app' is created and will react +depending on the arguments passed to this macro. + +All commands defined by this macro, when called with `prefix-arg' +will ask the user for values instead of using defaults. + +ARGS is a property list. Valid keys are (all optional): + + + :binding, when defined, the new command is bound to the + default prefix for quick management commands plus this value. + + + :capture-output, when non-nil, the command output is not + truncated by the `comint-truncate-buffer' output filter. + + + :msg, when defined, commands that use the + `python-django-qmgmt-kill-and-msg-function' show this instead + of the buffer contents. + + + :no-pop, when non-nil, causes the process buffer to not be + displayed. + + + :submenu, when defined, the quick management command is + added within that submenu tree. If omitted the item is added + to the root. + + + :switches, when defined, the new command is executed with + these fixed switches. + + + :make-comint-function, a function to be used to create the + comint process, defaults to `python-django-mgmt-make-comint'. + + + :functions, If the value is a function, it is called with + two arguments. If it is a list, the elements are called, in + order, with same two arguments each. The first argument is + non-nil if the process ended successfully; the second + argument is a property-list containing passed ARGS and + INTERACTIVE-SWITCHES with symbols as keys. E.g: '(app + \"auth\" :command \"test\"). + +If you define any extra keys they will not be taken into account +by this macro but you may well use them in your command's +callback. + +INTERACTIVE-SWITCHES have the form (VARNAME PROMPT DEFAULT SWITCH +FORCE-ASK), you can add 0 or more INTERACTIVE-SWITCHES depending +on the number of parameters you need to pass to the management +command. The description for each element of the list are: + + + VARNAME must be a unique symbol not used in other switch. + + + PROMPT must be a string for the prompt that will be shown + when user is asked for a value using `read-string' or it can + be a expresion that will be used to read the value for + VARNAME. When you need to use the calculated value of + DEFAULT in the provided expression you can just use that + variable like this: + + (read-file-name \"Fixture: \" nil default) + + + DEFAULT is an expression to be executed in order to + calculate the default value for VARNAME. This is optional + and in the case is not provided or returns nil after executed + the user will be prompted to insert a value for VARNAME. + + + SWITCH is a string that represents the switch used to pass + the VARNAME's value to Django's management command. + + + FORCE-ASK might be nil or non-nil, when is non-nil the user + will be asked to insert a value for VARNAME even if a default + value is available. + +Each command defined via this macro may have a callback to be +executed when the process finishes correctly. The way to define +callbacks is to append -callback to the defined name, for +instance if you defined a quick management command called syncdb, +then you need to create a function named +`python-django-qmgmt-syncdb-callback' and it will be called with +an alist containing all INTERACTIVE-SWITCHES and ARGS with the +additional :command key holding the executed command. See the +`python-django-qmgmt-kill-and-msg-function' function for a nice +example of a callback." + (declare (indent defun)) + (let* ((docstring (when (stringp doc-or-args) doc-or-args)) + (args (if docstring args doc-or-args)) + (args (if (eq ?: (string-to-char (symbol-name (car args)))) + args + ;; args is not a plist, append it to interactive-switches and + ;; set args to nil. + (setq interactive-switches (cons args interactive-switches)) + nil)) + (fn-symbol (python-django-qmgmt--make-fn-symbol name)) + (callback (intern (format "%s-callback" fn-symbol))) + (command (car (split-string (format "%s" name) "-"))) + (binding (plist-get args :binding)) + (capture-output (plist-get args :capture-output)) + (functions (plist-get args :functions)) + (no-pop (plist-get args :no-pop)) + (submenu (plist-get args :submenu)) + (switches (plist-get args :switches)) + (make-comint-function (plist-get args :make-comint-function)) + (defargs (mapcar 'car interactive-switches)) + ;; Abnormal hooks AKA functions + (functions-symbol (python-django-qmgmt--make-functions-symbol name)) + (functions-docstring + (python-django-qmgmt--make-functions-docstring fn-symbol))) + `(progn + (defvar ,functions-symbol nil + ,functions-docstring) + (setq ,functions-symbol ,functions) + (defun ,fn-symbol ,defargs + ,(python-django-qmgmt--make-docstring + command switches interactive-switches docstring) + (interactive + (list ,@(python-django-qmgmt--make-interactive-form + interactive-switches))) + (setq python-django-mgmt--previous-window-configuration + (current-window-configuration)) + (let* ((cmd-args (concat ,switches (and ,switches " ") + (mapconcat #'symbol-value ',defargs " "))) + (process (get-buffer-process + (python-django-mgmt-run-command + ,command cmd-args + ,capture-output ,no-pop + ,make-comint-function)))) + (message "Running: ./manage.py %s %s" ,command cmd-args) + (set-process-sentinel + process + (lambda (process status) + (when (and (not (process-live-p process)) + (buffer-live-p (process-buffer process))) + (with-current-buffer (process-buffer process) + (run-hook-with-args + ',functions-symbol + (string= status "finished\n") + (let ((plist ',args)) + (plist-put plist :command ,command) + (mapc + #'(lambda (sym) + (message "[%s]" sym) + (let* ((cmd-switch (symbol-value sym)) + (value + (cond + ((string-match "^--" cmd-switch) + (substring + cmd-switch + (1+ (string-match "=" cmd-switch)))) + ((string-match "^-" cmd-switch) + (substring cmd-switch 3)) + (t cmd-switch)))) + (plist-put plist sym value))) + ',defargs) + plist)))))))) + (python-django-qmgmt--add-binding #',fn-symbol ,binding) + (python-django-qmgmt--add-menu-item + #',fn-symbol ,submenu ,command ,switches ',interactive-switches ,docstring) + ;; Just like defun, return the defined function. + #',fn-symbol))) + +(defun python-django-qmgmt-kill-and-msg-function (status-ok args) + "Kill the process buffer and show message or output. +Argument STATUS-OK is non-nil if process exited successfully. +Argument ARGS is a plist with the switches and arguments passed +to the command. See `python-django-qmgmt-define' docstring for +details." + (when status-ok + (let ((msg (or (plist-get args :msg) + (buffer-substring-no-properties + (point-min) (point-max)))) + (buffer-name (buffer-name))) + (kill-buffer) + (python-django-mgmt-restore-window-configuration) + (display-message-or-buffer msg buffer-name)))) + +(python-django-qmgmt-define collectstatic + "Collect static files." + (:submenu "Tools" :binding "ocs" + :functions #'python-django-qmgmt-kill-and-msg-function)) + +(python-django-qmgmt-define clean_pyc + "Remove all python compiled files from the project." + (:submenu "Tools" :binding "ocp" :no-pop t + :msg "All *.pyc and *.pyo cleaned." + :functions #'python-django-qmgmt-kill-and-msg-function)) + +(defun python-django-qmgmt-create_command-function (status-ok args) + "Callback for create_command quick management command. +Argument STATUS-OK is non-nil if process exited successfully. +Argument ARGS is a plist with the switches and arguments passed +to the command. See `python-django-qmgmt-define' docstring for +details." + (when status-ok + (let* ((appname (plist-get args 'app)) + (manage-directory + (file-name-directory + (with-current-buffer + python-django-mgmt-parent-buffer + python-django-project-manage.py))) + (default-app-dir + (expand-file-name appname manage-directory)) + (default-create-dir + (expand-file-name "management" default-app-dir)) + (delete-safe + (and (file-exists-p default-app-dir) + (equal (directory-files default-app-dir) + '("." ".." "management"))))) + ;; TODO: cleanup. Do not offer moving, the command does the right thing. + (when (y-or-n-p + (format "Created in app %s. Move it? " default-app-dir)) + (let ((newdir + (read-directory-name + "Move app to: " manage-directory nil t))) + (if (not (file-exists-p + (expand-file-name "management" newdir))) + (rename-file default-create-dir newdir) + (message + "Directory structure already exists in %s" appname)) + (and delete-safe (delete-directory default-app-dir t))))) + (kill-buffer) + (python-django-mgmt-restore-window-configuration))) + +(python-django-qmgmt-define create_command + "Create management commands directory structure for app." + (:submenu "Tools" :binding "occ" :no-pop t + :functions #'python-django-qmgmt-create_command-function) + (app (python-django-minibuffer-read-app "App name: "))) + +(defun python-django-qmgmt-startapp-function (status-ok args) + "Callback for clean_pyc quick management command. +Argument STATUS-OK is non-nil if process exited successfully. +Argument ARGS is a plist with the switches and arguments passed +to the command. See `python-django-qmgmt-define' docstring for +details." + (when status-ok + (let ((appname (plist-get args 'app)) + (manage-directory + (file-name-directory + (with-current-buffer + python-django-mgmt-parent-buffer + python-django-project-manage.py)))) + (when (y-or-n-p + (format + "App created in %s. Do you want to move it? " + manage-directory)) + (rename-file + (expand-file-name appname manage-directory) + (read-directory-name + "Move app to: " manage-directory nil t)))) + (kill-buffer) + (python-django-mgmt-restore-window-configuration))) + +(python-django-qmgmt-define startapp + "Create new Django app for current project." + (:submenu "Tools" :binding "osa" :no-pop t + :functions #'python-django-qmgmt-startapp-function) + (app "App name: ")) + +;; Shell + +(python-django-qmgmt-define shell + "Run a Python interpreter for this project." + (:submenu "Shell" :binding "ss" + :make-comint-function #'python-django-mgmt-make-comint-for-shell)) + +(python-django-qmgmt-define shell_plus + "Like the 'shell' but autoloads all models." + (:submenu "Shell" :binding "sp" + :make-comint-function #'python-django-mgmt-make-comint-for-shell)) + +;; Database + +(python-django-qmgmt-define syncdb + "Sync database tables for all INSTALLED_APPS." + (:submenu "Database" :binding "dsy" :no-pop t + :functions #'python-django-qmgmt-kill-and-msg-function) + (database (python-django-minibuffer-read-database "Database: " default) + "default" "--database=")) + +(python-django-qmgmt-define dbshell + "Run the command-line client for specified database." + (:submenu "Database" :binding "dsh" + :make-comint-function #'python-django-mgmt-make-comint-for-dbshell) + (database (python-django-minibuffer-read-database "Database: " default) + "default" "--database=")) + +(defvar python-django-qmgmt-dumpdata-formats '("json" "xml" "yaml") + "Valid formats for dumpdata management command.") + +(defcustom python-django-qmgmt-dumpdata-default-format "json" + "Default format for quick dumpdata." + :group 'python-django + :type `(choice + ,@(mapcar (lambda (fmt) + `(string :tag ,fmt ,fmt)) + python-django-qmgmt-dumpdata-formats)) + :safe 'stringp) + +(defcustom python-django-qmgmt-dumpdata-default-indent 4 + "Default indent value quick dumpdata." + :group 'python-django + :type 'integer + :safe 'integerp) + +(defun python-django-qmgmt-dumpdata-function (status-ok args) + "Callback executed after dumpdata finishes. +Argument STATUS-OK is non-nil if process exited successfully. +Argument ARGS is a plist with the switches and arguments passed +to the command. See `python-django-qmgmt-define' docstring for +details." + (when status-ok + (let ((file-name + (catch 'file-name + (while t + (let ((file-name + (read-file-name + "Save fixture to file: " + (expand-file-name + (with-current-buffer + python-django-mgmt-parent-buffer + python-django-project-root)) nil nil nil))) + (if (not (file-exists-p file-name)) + (throw 'file-name file-name) + (when (y-or-n-p + (format "File `%s' exists; overwrite? " file-name)) + (throw 'file-name file-name))))))) + (output-buffer (buffer-substring-no-properties + (point-min) (point-max)))) + (with-temp-buffer + (set (make-local-variable 'require-final-newline) t) + (insert output-buffer) + ;; Ensure there's a final newline + (and (> (point-max) (point-min)) + (not (= (char-after (1- (point-max))) ?\n)) + (insert "\n")) + (write-region + (progn + ;; Remove possible logs from output. + (goto-char (point-min)) + (re-search-forward + "^\\[\\|^<\\?xml +version=\"\\|^- +fields: " nil t) + (beginning-of-line 1) + (point)) + (point-max) + file-name)) + (kill-buffer) + (python-django-mgmt-restore-window-configuration) + (message "Fixture saved to file `%s'." file-name)))) + +(python-django-qmgmt-define dumpdata-all + "Save the contents of the database as a fixture for all apps." + (:submenu "Database" :binding "ddp" :no-pop t :capture-output t + :functions #'python-django-qmgmt-dumpdata-function) + (database (python-django-minibuffer-read-database "Database: " default) + "default" "--database=") + (indent (number-to-string + (read-number "Indent Level: " + (string-to-number default))) + (number-to-string python-django-qmgmt-dumpdata-default-indent) + "--indent=") + (format (python-django-minibuffer-read-from-list + "Dump to format: " python-django-qmgmt-dumpdata-formats default) + "json" "--format=")) + +(python-django-qmgmt-define dumpdata-app + "Save the contents of the database as a fixture for the specified app." + (:submenu "Database" :binding "dda" :no-pop t :capture-output t + :functions #'python-django-qmgmt-dumpdata-function) + (database (python-django-minibuffer-read-database "Database: " default) + "default" "--database=") + (indent (number-to-string + (read-number "Indent Level: " + (string-to-number default))) "4" "--indent=") + (format (python-django-minibuffer-read-from-list + "Dump to format: " python-django-qmgmt-dumpdata-formats default) + "json" "--format=") + (app (python-django-minibuffer-read-app "Dumpdata for App: "))) + +(python-django-qmgmt-define flush + "Execute 'sqlflush' on the given database." + (:submenu "Database" :binding "df" :msg "Flushed database" + :functions #'python-django-qmgmt-kill-and-msg-function) + (database (python-django-minibuffer-read-database "Database: " default) + "default" "--database=")) + +(python-django-qmgmt-define loaddata + "Install the named fixture(s) in the database." + (:submenu "Database" :binding "dl" + :functions #'python-django-qmgmt-kill-and-msg-function) + (database (python-django-minibuffer-read-database "Database: " default) + "default" "--database=") + (fixtures (python-django-minibuffer-read-file-names "Fixtures: "))) + +(python-django-qmgmt-define validate + "Validate all installed models." + (:submenu "Database" :binding "dv" + :functions #'python-django-qmgmt-kill-and-msg-function)) + +(defun python-django-qmgmt-graph_models-function (status-ok args) + "Callback for graph_model quick management command. +Argument STATUS-OK is non-nil if process exited successfully. +Argument ARGS is a plist with the switches and arguments passed +to the command. See `python-django-qmgmt-define' docstring for +details." + (when status-ok + (let ((open (y-or-n-p "Open generated graph? "))) + (kill-buffer) + (python-django-mgmt-restore-window-configuration) + (when open + (find-file (plist-get args 'filename)))))) + +(python-django-qmgmt-define graph_models-all + "Creates a Graph of models for all project apps." + (:submenu "Database" :switches "-ag" :binding "dgg" + :functions #'python-django-qmgmt-graph_models-function) + (filename + (expand-file-name + (read-file-name "Filename for generated Graph: " + default default)) + (expand-file-name + "graph_all.png" python-django-project-root) + "--output=" t)) + +(python-django-qmgmt-define graph_models-apps + "Creates a Graph of models for given apps." + (:submenu "Database" :binding "dga" + :functions #'python-django-qmgmt-graph_models-function) + (apps (python-django-minibuffer-read-apps "Graph for App: ")) + (filename + (expand-file-name + (read-file-name "Filename for generated Graph: " default default)) + (expand-file-name + (format "graph_%s.png" (replace-regexp-in-string " " "_" apps)) + python-django-project-root) + "--output=" t)) + +;; i18n + +(python-django-qmgmt-define makemessages-all + "Create/Update translation string files." + (:submenu "i18n" :switches "--all" :binding "im" + :functions #'python-django-qmgmt-kill-and-msg-function)) + +(python-django-qmgmt-define compilemessages-all + "Compile project .po files to .mo." + (:submenu "i18n" :binding "ic" + :functions #'python-django-qmgmt-kill-and-msg-function)) + +;; Dev Server + +(defcustom python-django-qmgmt-runserver-default-bindaddr "localhost:8000" + "Default binding address for quick runserver." + :group 'python-django + :type 'string + :safe 'stringp) + +(defcustom python-django-qmgmt-testserver-default-bindaddr "localhost:8000" + "Default binding address for quick testserver." + :group 'python-django + :type 'string + :safe 'stringp) + +(defcustom python-django-qmgmt-mail_debug-default-bindaddr "localhost:1025" + "Default binding address for quick mail_debug." + :group 'python-django + :type 'string + :safe 'stringp) + +(python-django-qmgmt-define runserver + "Start development Web server." + (:submenu "Server" :binding "rr" + :make-comint-function #'python-django-mgmt-make-comint-for-runserver) + (bindaddr "Serve on [ip]:[port]: " + python-django-qmgmt-runserver-default-bindaddr)) + +(python-django-qmgmt-define runserver_plus + "Start extended development Web server." + (:submenu "Server" :binding "rp" + :make-comint-function #'python-django-mgmt-make-comint-for-runserver) + (bindaddr "Serve on [ip]:[port]: " + python-django-qmgmt-runserver-default-bindaddr)) + +(python-django-qmgmt-define testserver + "Start development server with data from the given fixture(s)." + (:submenu "Server" :binding "rt") + (bindaddr "Serve on [ip]:[port]: " + python-django-qmgmt-testserver-default-bindaddr) + (fixtures (python-django-minibuffer-read-file-names "Fixtures: "))) + +(python-django-qmgmt-define mail_debug + "Start a test mail server for development." + (:submenu "Server" :binding "rm") + (bindaddr "Serve on [ip]:[port]: " + python-django-qmgmt-mail_debug-default-bindaddr)) + +;; Testing + +(python-django-qmgmt-define test-all + "Run the test suite for the entire project." + (:submenu "Test" :binding "tp" + :functions #'python-django-qmgmt-kill-and-msg-function)) + +(python-django-qmgmt-define test-app + "Run the test suite for the specified app." + (:submenu "Test" :binding "ta" + :functions #'python-django-qmgmt-kill-and-msg-function) + (app (python-django-minibuffer-read-app "Test App: "))) + +;; South integration + +(defun python-django-qmgmt-open-migration-function (status-ok args) + "Callback for commands that create migrations. +Argument STATUS-OK is non-nil if process exited successfully. +Argument ARGS is a plist with the switches and arguments passed +to the command. See `python-django-qmgmt-define' docstring for +details." + (when status-ok + (let ((app (cdr (assq 'app args)))) + (python-django-qmgmt-kill-and-msg-function status-ok args) + (and (y-or-n-p "Open the created migration? ") + (find-file + (expand-file-name + (car (last (python-django-info-get-app-migrations app))) + (expand-file-name + "migrations" + (python-django-info-get-app-path app)))))))) + +(python-django-qmgmt-define convert_to_south + "Convert given app to South." + (:submenu "South" :binding "soc" + :functions #'python-django-qmgmt-kill-and-msg-function) + (app (python-django-minibuffer-read-app "Convert App: "))) + +(python-django-qmgmt-define datamigration + "Create a new datamigration for the given app." + (:submenu "South" :binding "sod" + :functions #'python-django-qmgmt-open-migration-function) + (app (python-django-minibuffer-read-app "Datamigration for App: ")) + (name "Datamigration name: ")) + +(python-django-qmgmt-define migrate-all + "Run all migrations for all apps." + (:submenu "South" :switches "--all" :binding "somp" + :functions #'python-django-qmgmt-kill-and-msg-function) + (database (python-django-minibuffer-read-database "Database: " default) + "default" "--database=")) + +(python-django-qmgmt-define migrate-app + "Run all migrations for given app." + (:submenu "South" :binding "soma" + :functions #'python-django-qmgmt-kill-and-msg-function) + (database (python-django-minibuffer-read-database "Database: " default) + "default" "--database=") + (app (python-django-minibuffer-read-app "Migrate App: "))) + +(python-django-qmgmt-define migrate-list + "Run all migrations for all apps." + (:submenu "South" :switches "--list" :binding "soml" + :functions #'python-django-qmgmt-kill-and-msg-function) + (database (python-django-minibuffer-read-database "Database: " default) + "default" "--database=")) + +(python-django-qmgmt-define migrate-app-to + "Run migrations for given app [up|down]-to given number." + (:submenu "South" :binding "somt" + :functions #'python-django-qmgmt-kill-and-msg-function) + (database (python-django-minibuffer-read-database "Database: " default) + "default" "--database=") + (app (python-django-minibuffer-read-app "Migrate App: ")) + (migration (python-django-minibuffer-read-migration "To migration: " app))) + +(python-django-qmgmt-define schemamigration-initial + "Create the initial schemamigration for the given app." + (:submenu "South" :switches "--initial" :binding "sosi" + :functions #'python-django-qmgmt-kill-and-msg-function) + (app (python-django-minibuffer-read-app + "Initial schemamigration for App: "))) + +(python-django-qmgmt-define schemamigration + "Create new empty schemamigration for the given app." + (:submenu "South" :switches "--empty" :binding "soss" + :functions #'python-django-qmgmt-open-migration-function) + (app (python-django-minibuffer-read-app + "Initial schemamigration for App: ")) + (name "Schemamigration name: ")) + +(python-django-qmgmt-define schemamigration-auto + "Create an automatic schemamigration for the given app." + (:submenu "South" :switches "--auto" :binding "sosa" + :functions #'python-django-qmgmt-open-migration-function) + (app (python-django-minibuffer-read-app + "Auto schemamigration for App: "))) + + +;;; Fast commands + +(defcustom python-django-cmd-etags-command + "etags `find -name \"*.py\"`" + "Command used to build tags tables." + :group 'python-django + :type 'string) + +(defcustom python-django-cmd-grep-function nil + "Function to grep on a directory. +The function receives no args, however `default-directory' will +default to a sane value." + :group 'python-django + :type 'function) + +(defun python-django-cmd-build-etags () + "Build tags for current project." + (interactive) + (let ((current-dir default-directory)) + (cd + (file-name-directory + python-django-project-manage.py)) + (if (eq 0 + (shell-command + python-django-cmd-etags-command)) + (message "Tags created sucessfully") + (message "Tags creation failed")) + (cd current-dir))) + +(defun python-django-cmd-grep () + "Grep in project directories." + (interactive) + (let ((default-directory + (or (python-django-ui-directory-at-point) + (file-name-directory + python-django-project-manage.py)))) + (if (not python-django-cmd-grep-function) + (call-interactively #'rgrep) + (funcall + python-django-cmd-grep-function default-directory)))) + +(defun python-django-cmd-open-docs () + "Open Django documentation in a browser." + (interactive) + (browse-url + (format + "https://docs.djangoproject.com/en/%s/" + (substring (python-django-info-get-version) 0 3)))) + +(defun python-django-cmd-visit-settings () + "Visit settings file." + (interactive) + (find-file (python-django-info-module-path + python-django-project-settings))) + +(defun python-django-cmd-visit-virtualenv () + "Visit virtualenv directory." + (interactive) + (and python-shell-virtualenv-path + (dired python-shell-virtualenv-path))) + +(defun python-django-cmd-visit-project-root () + "Visit project root directory." + (interactive) + (dired python-django-project-root)) + +(defun python-django-cmd-dired-at-point () + "Open dired at current tree node." + (interactive) + (let ((dir (python-django-ui-directory-at-point))) + (and dir (dired dir)))) + +(defun python-django-cmd-directory-at-point () + "Message the current directory at point." + (interactive) + (message (or (python-django-ui-directory-at-point) ""))) + +(defun python-django-cmd-jump-to-app (app) + "Jump to APP's directory." + (interactive + (list + (python-django-minibuffer-read-app "Jump to app: "))) + (when (python-django-info-get-app-path app) + (goto-char (point-min)) + (re-search-forward (format " %s" app)) + (python-django-ui-move-to-closest-icon))) + +(defun python-django-cmd-jump-to-media (which) + "Jump to a WHICH media directory." + (interactive + (list + (python-django-minibuffer-read-from-list + "Jump to: " '("MEDIA_ROOT" "STATIC_ROOT")))) + (goto-char (point-min)) + (re-search-forward (format " %s" which)) + (python-django-ui-move-to-closest-icon)) + +(defun python-django-cmd-jump-to-template-dir (which) + "Jump to a WHICH template directory." + (interactive + (list + (python-django-minibuffer-read-from-list + "Jump to: " + (mapcar 'identity (python-django-info-get-setting "TEMPLATE_DIRS"))))) + (goto-char (point-min)) + (re-search-forward (format " %s" which)) + (python-django-ui-move-to-closest-icon)) + + + +;;; UI stuff + +(defvar python-django-ui-ignored-dirs + '("." ".." ".bzr" ".cdv" "~.dep" "~.dot" "~.nib" "~.plst" ".git" ".hg" ".pc" + ".svn" "_MTN" "blib" "CVS" "RCS" "SCCS" "_darcs" "_sgbak" "autom4te.cache" + "cover_db" "_build" ".ropeproject" "__pycache__") + "Directories ignored when scanning project files.") + +(defvar python-django-ui-allowed-extensions + '("css" "gif" "htm" "html" "jpg" "js" "json" "mo" "png" "po" "py" "txt" "xml" + "yaml" "scss" "less") + "Allowed extensions when scanning project files.") + +(defcustom python-django-ui-image-enable t + "Enable images for widgets?" + :group 'python-django + :type 'boolean + :safe 'booleanp) + +(defcustom python-django-ui-theme "folder" + "Default theme for widgets." + :group 'python-django + :type 'boolean + :safe 'stringp) + +(defcustom python-django-ui-buffer-switch-function 'switch-to-buffer + "Function for switching to the project buffer. +The function receives one argument, the status buffer." + :group 'python-django + :type '(radio (function-item switch-to-buffer) + (function-item pop-to-buffer) + (function-item display-buffer) + (function :tag "Other"))) + +(defun python-django-ui-show-buffer (buffer) + "Show the Project BUFFER." + (funcall python-django-ui-buffer-switch-function buffer)) + +(defun python-django-ui-clean () + "Empty current UI buffer." + (let ((inhibit-read-only t)) + (erase-buffer))) + +(defun python-django-ui-insert-header () + "Draw header information." + (insert + (format "%s\t\t%s\n" + (propertize + "Django Version:" + 'face 'python-django-face-title) + (propertize + (python-django-info-get-version) + 'face 'python-django-face-django-version)) + (format "%s\t\t%s\n" + (propertize + "Project:" + 'face 'python-django-face-title) + (propertize + python-django-project-root + 'face 'python-django-face-project-root)) + (format "%s\t\t%s\n" + (propertize + "Settings:" + 'face 'python-django-face-title) + (propertize + python-django-project-settings + 'face 'python-django-face-settings-module)) + (format "%s\t\t%s" + (propertize + "Virtualenv:" + 'face 'python-django-face-title) + (propertize + (or python-shell-virtualenv-path "None") + 'face 'python-django-face-virtualenv-path)) + "\n\n\n")) + +(defun python-django-ui-build-section-alist () + "Create section Alist for current project." + (list + (cons + "Apps" + (mapcar + (lambda (app) + (cons app (python-django-info-get-app-path app))) + (python-django-info-get-installed-apps))) + (cons + "Media" + (list + (cons "MEDIA_ROOT" (python-django-info-get-setting "MEDIA_ROOT")) + (cons "STATIC_ROOT" (python-django-info-get-setting "STATIC_ROOT")))) + (cons + "Static Content" (mapcar + (lambda (dir) + ;; STATICFILES_DIRS elements can be either a + ;; string or a size-two tuple with the first + ;; element being the prefix and the latter + ;; being the path: http://bit.ly/16Fw9xW + (if (stringp dir) + (cons dir dir) + (cons (aref dir 0) (aref dir 1)))) + (python-django-info-get-setting "STATICFILES_DIRS"))) + (cons + "Templates" (mapcar + (lambda (dir) + (cons dir dir)) + (python-django-info-get-setting "TEMPLATE_DIRS"))))) + +;; Many kudos to Ye Wenbin since dirtree.el was of great help when +;; looking for examples of `tree-widget': +;; https://github.com/zkim/emacs-dirtree/blob/master/ +(define-widget 'python-django-ui-tree-section-widget 'tree-widget + "Tree widget for sections of Django Project buffer." + :expander 'python-django-ui-tree-section-widget-expand + :help-echo 'ignore + :has-children t) + +(define-widget 'python-django-ui-tree-section-node-widget 'push-button + "Widget for a nodes of `python-django-ui-tree-section-widget'." + :format "%[%t%]\n" + :button-face 'default + :notify 'python-django-ui-tree-section-widget-expand) + +(define-widget 'python-django-ui-tree-dir-widget 'tree-widget + "Tree widget for directories of Django Project." + :expander 'python-django-ui-tree-dir-widget-expand + :help-echo 'ignore + :has-children t) + +(define-widget 'python-django-ui-tree-file-widget 'push-button + "Widget for a files inside the `python-django-ui-tree-dir-widget'." + :format "%[%t%]\n" + :button-face 'default + :notify 'python-django-ui-tree-file-widget-select) + +(defun python-django-ui-tree-section-widget-expand (tree &rest ignore) + "Expand directory for given section TREE widget. +Optional argument IGNORE is there for compatibility." + (or (widget-get tree :args) + (let ((section-alist (widget-get tree :section-alist))) + (mapcar (lambda (section) + (let ((name (car section)) + (dir (cdr section))) + `(python-django-ui-tree-dir-widget + :node (python-django-ui-tree-file-widget + :tag ,name + :file ,dir) + :file ,dir + :open nil + :indent 0))) + section-alist)))) + +(defun python-django-ui-tree-dir-widget-expand (tree) + "Expand directory for given TREE widget." + (or (widget-get tree :args) + (let* ((dir (widget-get tree :file)) + dir-list file-list) + (when (and dir (file-exists-p dir)) + (dolist (file (directory-files dir t)) + (let ((basename (file-name-nondirectory file))) + (if (file-directory-p file) + (when (not (member basename python-django-ui-ignored-dirs)) + (setq dir-list (cons basename dir-list))) + (when (member (python-django-util-file-name-extension file) + python-django-ui-allowed-extensions) + (setq file-list (cons basename file-list)))))) + (setq dir-list (sort dir-list 'string<)) + (setq file-list (sort file-list 'string<)) + (append + (mapcar (lambda (file) + `(python-django-ui-tree-dir-widget + :file ,(expand-file-name file dir) + :node (python-django-ui-tree-file-widget + :tag ,file + :file ,(expand-file-name file dir)))) + dir-list) + (mapcar (lambda (file) + `(python-django-ui-tree-file-widget + :file ,(and file (not (string= file "")) + (expand-file-name file dir)) + :tag ,file)) + file-list)))))) + +(defun python-django-ui-tree-file-widget-select (node &rest ignore) + "Open file in other window. +Argument NODE and IGNORE are just for compatibility." + (let ((file (widget-get node :file))) + (and file (find-file-other-window file)))) + +(defun python-django-ui-tree-section-insert (name section-alist) + "Create tree widget for NAME and SECTION-ALIST." + (apply 'widget-create + `(python-django-ui-tree-section-widget + :node (python-django-ui-tree-section-node-widget + :tag ,name) + :section-alist ,section-alist + :open t))) + +(defun python-django-ui-widget-move (arg) + "Move between widgets sensibly in the project buffer. +Movement between widgets of the tree happen line by line, leaving +point next to the closest icon available. With positive ARG move +forward that many times, else backwards." + (let* ((success-moves 0) + (forward (> arg 0)) + (func (if forward + 'widget-forward + 'widget-backward)) + (abs-arg (abs arg))) + (catch 'nowidget + (while (> abs-arg success-moves) + (if (memq (widget-type (widget-at (point))) + '(tree-widget-close-icon + tree-widget-empty-icon + tree-widget-leaf-icon + tree-widget-open-icon)) + (ignore-errors (funcall func 2)) + (ignore-errors (funcall func 1))) + (when (not (widget-at (point))) + (throw 'nowidget t)) + (setq success-moves (1+ success-moves)))) + (python-django-ui-move-to-closest-icon) + (setq default-directory + (or (python-django-ui-directory-at-point) + (file-name-directory python-django-project-manage.py))))) + +(defun python-django-ui-widget-forward (arg) + "Move point to the next line's main widget. +With optional ARG, move across that many fields." + (interactive "p") + (python-django-ui-widget-move arg)) + +(defun python-django-ui-widget-backward (arg) + "Move point to the previous line's main widget. +With optional ARG, move across that many fields." + (interactive "p") + (python-django-ui-widget-move (- arg))) + +(defun python-django-ui-move-up-tree (arg) + "Move point to the parent widget of the tree. +With optional ARG, move across that many fields." + (interactive "p") + (and (< arg 0) (setq arg (- arg))) + (python-django-ui-move-to-closest-icon) + (let ((start-depth (- (point) (line-beginning-position)))) + (when (not (= 0 start-depth)) + (while (<= start-depth (- (point) (line-beginning-position))) + (python-django-ui-widget-backward 1))))) + +(defun python-django-ui-beginning-of-widgets () + "Move to the first widget. +With optional ARG, move across that many fields." + (interactive) + (goto-char (point-min)) + (python-django-ui-widget-forward 1)) + +(defun python-django-ui-end-of-widgets () + "Move point to last widget. +With optional ARG, move across that many fields." + (interactive) + (goto-char (point-max)) + (python-django-ui-widget-backward 1)) + +(defun python-django-ui-move-to-closest-icon () + "Move to closest button from point." + (interactive) + (if (and + (not (widget-at (point))) + (not (widget-at (1- (point))))) + (progn + (widget-backward 1) + (beginning-of-line 1) + (widget-forward 1)) + (beginning-of-line 1) + (and (not (widget-at (point))) + (widget-forward 1)))) + +(defun python-django-ui-safe-button-press () + "Move to closest button from point and press it." + (interactive) + (and (not (widget-at (point))) + (python-django-ui-move-to-closest-icon)) + (widget-button-press (point))) + +(defun python-django-ui-widget-type-at-point () + "Return the node type for current position." + (let* ((widget (widget-at (point))) + (file-p (widget-get + (tree-widget-node widget) + :tree-widget--guide-flags))) + (and widget (if file-p 'file 'dir)))) + +(defun python-django-ui-directory-at-point () + "Return the node type for current position." + (widget-get + (widget-get (tree-widget-node (widget-at (point))) :parent) :file)) + + +;;;Main functions + +(defcustom python-django-known-projects nil + "Alist of known projects." + :group 'python-django + :type '(repeat (list string string string)) + :safe (lambda (val) + (and + (stringp (car val)) + (stringp (nth 1 val)) + (stringp (nth 2 val))))) + +(defun python-django-mode-find-next-buffer () + "Find the next Django project buffer available." + (let ((current-buffer (current-buffer))) + (catch 'buffer + (dolist (buf (buffer-list)) + (and (with-current-buffer buf + (and (eq major-mode 'python-django-mode) + (not (equal buf current-buffer)))) + (throw 'buffer buf)))))) + +(defun python-django-mode-on-kill-buffer () + "Hook run on `buffer-kill-hook'." + (and (python-django-mgmt-buffer-list (current-buffer)) + (call-interactively 'python-django-mgmt-kill-all))) + +(define-derived-mode python-django-mode special-mode "Django" + "Major mode to manage Django projects. + +\\{python-django-mode-map}") + +;;;###autoload +(defun python-django-open-project (directory settings &optional existing) + "Open a Django project at given DIRECTORY using SETTINGS. +Optional argument EXISTING is internal and should not be used. + +The recommended way to chose your project root, is to use the +directory containing your settings module; for instance if your +settings module is in /path/django/settings.py, use /path/django/ +as your project path and django.settings as your settings module. + +When called with no `prefix-arg', this function will try to find +an opened project-buffer, if current buffer is already a project +buffer it will cycle to next opened project. If no project +buffers are found, then the user prompted for the project path +and settings module unless `python-django-project-root' and +`python-django-project-settings' are somehow set, normally via +directory local variables. If none of the above matched or the +function is called with one `prefix-arg' and there are projects +defined in the `python-django-known-projects' variable the user +is prompted for any of those known projects, if the variable +turns to be nil the user will be prompted for project-path and +settings module (the same happens when called with two or more +`prefix-arg')." + (interactive + (let ((buf + ;; Get an existing project buffer that's not the current. + (python-django-mode-find-next-buffer))) + (cond + ((and (not current-prefix-arg) + (not buf) + python-django-project-root + python-django-project-settings) + ;; There's no existing buffer but project variables are + ;; set, so use them to open the project. + (list python-django-project-root + python-django-project-settings + ;; if the user happens to be in the project buffer + ;; itself, do nothing. + (and (eq major-mode 'python-django-mode) + (current-buffer)))) + ((and (not current-prefix-arg) buf) + ;; there's an existing buffer move/cycle to it. + (with-current-buffer buf + (list + python-django-project-root + python-django-project-settings + buf))) + ((or (and python-django-known-projects + (<= (prefix-numeric-value current-prefix-arg) 4))) + ;; When there are known projects and called at most with one + ;; prefix arg try opening a known project. + (cdr + (assoc + (python-django-minibuffer-read-from-list + "Project: " python-django-known-projects) + python-django-known-projects))) + (t + (let ((root)) + ;; When called with two or more prefix arguments or all + ;; input methods failed. + (list + (setq root (read-directory-name + "Project Root: " python-django-project-root nil t)) + (read-string + "Settings module: " + (or python-django-project-settings + (format "%s.settings" + (python-django-info-directory-basename root)))))))))) + (if (not existing) + (let* ((directory (expand-file-name directory)) + (project-name (python-django-info-directory-basename directory)) + (buffer-name + (format "*Django: %s (%s)*" + project-name + (python-django-util-shorten-settings settings))) + (success t)) + (with-current-buffer (get-buffer-create buffer-name) + (let ((inhibit-read-only t)) + (python-django-mode) + (python-django-ui-clean) + (set (make-local-variable + 'python-django-info--get-setting-cache) nil) + (set (make-local-variable + 'python-django-info--get-version-cache) nil) + (set (make-local-variable + 'python-django-info--get-app-paths-cache) nil) + (set (make-local-variable + 'python-django-project-root) directory) + (set (make-local-variable + 'python-django-project-settings) settings) + (set (make-local-variable + 'python-django-project-name) project-name) + (set (make-local-variable + 'python-django-project-manage.py) + (python-django-info-find-manage.py directory)) + (set (make-local-variable 'default-directory) + (file-name-directory + python-django-project-manage.py)) + (python-django-util-clone-local-variables) + (set (make-local-variable 'tree-widget-image-enable) + python-django-ui-image-enable) + (tree-widget-set-theme python-django-ui-theme) + (condition-case err + (progn + (python-django-ui-insert-header) + (mapc (lambda (section) + (python-django-ui-tree-section-insert + (car section) (cdr section)) + (insert "\n")) + (python-django-ui-build-section-alist))) + (user-error + (setq success nil) + (insert (error-message-string err)) + (goto-char (point-min))))) + (when success + (add-hook 'kill-buffer-hook + #'python-django-mode-on-kill-buffer nil t) + (python-django-ui-beginning-of-widgets)) + (python-django-ui-show-buffer (current-buffer)))) + (python-django-ui-show-buffer existing))) + +;; Stolen from magit. +(defun python-django-close-project (&optional kill-buffer) + "Bury the buffer and delete its window. +With a prefix argument, KILL-BUFFER instead." + (interactive "P") + (quit-window kill-buffer (selected-window))) + +(defun python-django-refresh-project () + "Refresh Django project." + (interactive) + (python-django-open-project + python-django-project-root + python-django-project-settings)) + +(provide 'python-django) + +;; Local Variables: +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; python-django.el ends here diff --git a/elpa/python-django-20150822.404/python-django.elc b/elpa/python-django-20150822.404/python-django.elc new file mode 100644 index 00000000..635771fa Binary files /dev/null and b/elpa/python-django-20150822.404/python-django.elc differ diff --git a/elpa/racket-mode-20200411.1959/dir b/elpa/racket-mode-20200412.1611/dir similarity index 100% rename from elpa/racket-mode-20200411.1959/dir rename to elpa/racket-mode-20200412.1611/dir diff --git a/elpa/racket-mode-20200411.1959/racket-bug-report.el b/elpa/racket-mode-20200412.1611/racket-bug-report.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-bug-report.el rename to elpa/racket-mode-20200412.1611/racket-bug-report.el diff --git a/elpa/racket-mode-20200411.1959/racket-bug-report.elc b/elpa/racket-mode-20200412.1611/racket-bug-report.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-bug-report.elc rename to elpa/racket-mode-20200412.1611/racket-bug-report.elc diff --git a/elpa/racket-mode-20200411.1959/racket-cmd.el b/elpa/racket-mode-20200412.1611/racket-cmd.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-cmd.el rename to elpa/racket-mode-20200412.1611/racket-cmd.el diff --git a/elpa/racket-mode-20200411.1959/racket-cmd.elc b/elpa/racket-mode-20200412.1611/racket-cmd.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-cmd.elc rename to elpa/racket-mode-20200412.1611/racket-cmd.elc diff --git a/elpa/racket-mode-20200411.1959/racket-collection.el b/elpa/racket-mode-20200412.1611/racket-collection.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-collection.el rename to elpa/racket-mode-20200412.1611/racket-collection.el diff --git a/elpa/racket-mode-20200411.1959/racket-collection.elc b/elpa/racket-mode-20200412.1611/racket-collection.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-collection.elc rename to elpa/racket-mode-20200412.1611/racket-collection.elc diff --git a/elpa/racket-mode-20200411.1959/racket-common.el b/elpa/racket-mode-20200412.1611/racket-common.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-common.el rename to elpa/racket-mode-20200412.1611/racket-common.el diff --git a/elpa/racket-mode-20200411.1959/racket-common.elc b/elpa/racket-mode-20200412.1611/racket-common.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-common.elc rename to elpa/racket-mode-20200412.1611/racket-common.elc diff --git a/elpa/racket-mode-20200411.1959/racket-complete.el b/elpa/racket-mode-20200412.1611/racket-complete.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-complete.el rename to elpa/racket-mode-20200412.1611/racket-complete.el diff --git a/elpa/racket-mode-20200411.1959/racket-complete.elc b/elpa/racket-mode-20200412.1611/racket-complete.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-complete.elc rename to elpa/racket-mode-20200412.1611/racket-complete.elc diff --git a/elpa/racket-mode-20200411.1959/racket-custom.el b/elpa/racket-mode-20200412.1611/racket-custom.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-custom.el rename to elpa/racket-mode-20200412.1611/racket-custom.el diff --git a/elpa/racket-mode-20200411.1959/racket-custom.elc b/elpa/racket-mode-20200412.1611/racket-custom.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-custom.elc rename to elpa/racket-mode-20200412.1611/racket-custom.elc diff --git a/elpa/racket-mode-20200411.1959/racket-debug.el b/elpa/racket-mode-20200412.1611/racket-debug.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-debug.el rename to elpa/racket-mode-20200412.1611/racket-debug.el diff --git a/elpa/racket-mode-20200411.1959/racket-debug.elc b/elpa/racket-mode-20200412.1611/racket-debug.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-debug.elc rename to elpa/racket-mode-20200412.1611/racket-debug.elc diff --git a/elpa/racket-mode-20200411.1959/racket-describe.el b/elpa/racket-mode-20200412.1611/racket-describe.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-describe.el rename to elpa/racket-mode-20200412.1611/racket-describe.el diff --git a/elpa/racket-mode-20200411.1959/racket-describe.elc b/elpa/racket-mode-20200412.1611/racket-describe.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-describe.elc rename to elpa/racket-mode-20200412.1611/racket-describe.elc diff --git a/elpa/racket-mode-20200411.1959/racket-edit.el b/elpa/racket-mode-20200412.1611/racket-edit.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-edit.el rename to elpa/racket-mode-20200412.1611/racket-edit.el diff --git a/elpa/racket-mode-20200411.1959/racket-edit.elc b/elpa/racket-mode-20200412.1611/racket-edit.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-edit.elc rename to elpa/racket-mode-20200412.1611/racket-edit.elc diff --git a/elpa/racket-mode-20200411.1959/racket-eldoc.el b/elpa/racket-mode-20200412.1611/racket-eldoc.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-eldoc.el rename to elpa/racket-mode-20200412.1611/racket-eldoc.el diff --git a/elpa/racket-mode-20200411.1959/racket-eldoc.elc b/elpa/racket-mode-20200412.1611/racket-eldoc.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-eldoc.elc rename to elpa/racket-mode-20200412.1611/racket-eldoc.elc diff --git a/elpa/racket-mode-20200411.1959/racket-font-lock.el b/elpa/racket-mode-20200412.1611/racket-font-lock.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-font-lock.el rename to elpa/racket-mode-20200412.1611/racket-font-lock.el diff --git a/elpa/racket-mode-20200411.1959/racket-font-lock.elc b/elpa/racket-mode-20200412.1611/racket-font-lock.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-font-lock.elc rename to elpa/racket-mode-20200412.1611/racket-font-lock.elc diff --git a/elpa/racket-mode-20200411.1959/racket-imenu.el b/elpa/racket-mode-20200412.1611/racket-imenu.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-imenu.el rename to elpa/racket-mode-20200412.1611/racket-imenu.el diff --git a/elpa/racket-mode-20200411.1959/racket-imenu.elc b/elpa/racket-mode-20200412.1611/racket-imenu.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-imenu.elc rename to elpa/racket-mode-20200412.1611/racket-imenu.elc diff --git a/elpa/racket-mode-20200411.1959/racket-indent.el b/elpa/racket-mode-20200412.1611/racket-indent.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-indent.el rename to elpa/racket-mode-20200412.1611/racket-indent.el diff --git a/elpa/racket-mode-20200411.1959/racket-indent.elc b/elpa/racket-mode-20200412.1611/racket-indent.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-indent.elc rename to elpa/racket-mode-20200412.1611/racket-indent.elc diff --git a/elpa/racket-mode-20200411.1959/racket-keywords-and-builtins.el b/elpa/racket-mode-20200412.1611/racket-keywords-and-builtins.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-keywords-and-builtins.el rename to elpa/racket-mode-20200412.1611/racket-keywords-and-builtins.el diff --git a/elpa/racket-mode-20200411.1959/racket-keywords-and-builtins.elc b/elpa/racket-mode-20200412.1611/racket-keywords-and-builtins.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-keywords-and-builtins.elc rename to elpa/racket-mode-20200412.1611/racket-keywords-and-builtins.elc diff --git a/elpa/racket-mode-20200411.1959/racket-logger.el b/elpa/racket-mode-20200412.1611/racket-logger.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-logger.el rename to elpa/racket-mode-20200412.1611/racket-logger.el diff --git a/elpa/racket-mode-20200411.1959/racket-logger.elc b/elpa/racket-mode-20200412.1611/racket-logger.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-logger.elc rename to elpa/racket-mode-20200412.1611/racket-logger.elc diff --git a/elpa/racket-mode-20200411.1959/racket-mode-autoloads.el b/elpa/racket-mode-20200412.1611/racket-mode-autoloads.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-mode-autoloads.el rename to elpa/racket-mode-20200412.1611/racket-mode-autoloads.el diff --git a/elpa/racket-mode-20200411.1959/racket-mode-pkg.el b/elpa/racket-mode-20200412.1611/racket-mode-pkg.el similarity index 79% rename from elpa/racket-mode-20200411.1959/racket-mode-pkg.el rename to elpa/racket-mode-20200412.1611/racket-mode-pkg.el index 3f310738..88ab706f 100644 --- a/elpa/racket-mode-20200411.1959/racket-mode-pkg.el +++ b/elpa/racket-mode-20200412.1611/racket-mode-pkg.el @@ -1,4 +1,4 @@ -(define-package "racket-mode" "20200411.1959" "Major mode for Racket language." +(define-package "racket-mode" "20200412.1611" "Major mode for Racket language." '((emacs "25.1") (faceup "0.0.2") (pos-tip "20191127.1028")) diff --git a/elpa/racket-mode-20200411.1959/racket-mode.el b/elpa/racket-mode-20200412.1611/racket-mode.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-mode.el rename to elpa/racket-mode-20200412.1611/racket-mode.el diff --git a/elpa/racket-mode-20200411.1959/racket-mode.elc b/elpa/racket-mode-20200412.1611/racket-mode.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-mode.elc rename to elpa/racket-mode-20200412.1611/racket-mode.elc diff --git a/elpa/racket-mode-20200411.1959/racket-mode.info b/elpa/racket-mode-20200412.1611/racket-mode.info similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-mode.info rename to elpa/racket-mode-20200412.1611/racket-mode.info diff --git a/elpa/racket-mode-20200411.1959/racket-parens.el b/elpa/racket-mode-20200412.1611/racket-parens.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-parens.el rename to elpa/racket-mode-20200412.1611/racket-parens.el diff --git a/elpa/racket-mode-20200411.1959/racket-parens.elc b/elpa/racket-mode-20200412.1611/racket-parens.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-parens.elc rename to elpa/racket-mode-20200412.1611/racket-parens.elc diff --git a/elpa/racket-mode-20200411.1959/racket-ppss.el b/elpa/racket-mode-20200412.1611/racket-ppss.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-ppss.el rename to elpa/racket-mode-20200412.1611/racket-ppss.el diff --git a/elpa/racket-mode-20200411.1959/racket-ppss.elc b/elpa/racket-mode-20200412.1611/racket-ppss.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-ppss.elc rename to elpa/racket-mode-20200412.1611/racket-ppss.elc diff --git a/elpa/racket-mode-20200411.1959/racket-profile.el b/elpa/racket-mode-20200412.1611/racket-profile.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-profile.el rename to elpa/racket-mode-20200412.1611/racket-profile.el diff --git a/elpa/racket-mode-20200411.1959/racket-profile.elc b/elpa/racket-mode-20200412.1611/racket-profile.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-profile.elc rename to elpa/racket-mode-20200412.1611/racket-profile.elc diff --git a/elpa/racket-mode-20200411.1959/racket-repl-buffer-name.el b/elpa/racket-mode-20200412.1611/racket-repl-buffer-name.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-repl-buffer-name.el rename to elpa/racket-mode-20200412.1611/racket-repl-buffer-name.el diff --git a/elpa/racket-mode-20200411.1959/racket-repl-buffer-name.elc b/elpa/racket-mode-20200412.1611/racket-repl-buffer-name.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-repl-buffer-name.elc rename to elpa/racket-mode-20200412.1611/racket-repl-buffer-name.elc diff --git a/elpa/racket-mode-20200411.1959/racket-repl.el b/elpa/racket-mode-20200412.1611/racket-repl.el similarity index 98% rename from elpa/racket-mode-20200411.1959/racket-repl.el rename to elpa/racket-mode-20200412.1611/racket-repl.el index 6d8f270f..d3e4859b 100644 --- a/elpa/racket-mode-20200411.1959/racket-repl.el +++ b/elpa/racket-mode-20200412.1611/racket-repl.el @@ -172,8 +172,16 @@ end of an interactive expression/statement." (not (or (equal beg end) blankp))) (scan-error nil))) +(defun racket-repl-break () + "Send a break to the REPL program's main thread." + (interactive) + (cond ((racket--cmd-open-p) ;don't auto-start the back end + (racket--cmd/async (racket--repl-session-id) `(break break))) + (t + (user-error "Back end is not running")))) + (defun racket-repl-exit (&optional killp) - "End the Racket REPL process. + "Send a terminate break to the REPL program's main thread. Effectively the same as entering `(exit)` at the prompt, but works even when the module language doesn't provide any binding @@ -186,7 +194,7 @@ server and all REPL sessions." (message "Killing entire Racket Mode back end process") (racket--cmd-close)) ((racket--cmd-open-p) ;don't auto-start the back end - (racket--cmd/async (racket--repl-session-id) `(exit))) + (racket--cmd/async (racket--repl-session-id) `(break terminate))) (t (user-error "Back end is not running")))) @@ -893,6 +901,7 @@ instead of looking at point." ("M-," racket-unvisit) ("C-c C-z" racket-repl-switch-to-edit) ("C-c C-l" racket-logger) + ("C-c C-c" racket-repl-break) ("C-c C-\\" racket-repl-exit) ((")" "]" "}") racket-insert-closing))) "Keymap for Racket REPL mode.") @@ -900,7 +909,7 @@ instead of looking at point." (easy-menu-define racket-repl-mode-menu racket-repl-mode-map "Menu for Racket REPL mode." '("Racket-REPL" - ["Break" comint-interrupt-subjob] + ["Break" racket-repl-break] ["Exit" racket-repl-exit] "---" ["Insert Lambda" racket-insert-lambda] ;λ in string breaks menu diff --git a/elpa/racket-mode-20200411.1959/racket-repl.elc b/elpa/racket-mode-20200412.1611/racket-repl.elc similarity index 91% rename from elpa/racket-mode-20200411.1959/racket-repl.elc rename to elpa/racket-mode-20200412.1611/racket-repl.elc index 3693d7eb..ff90ec39 100644 Binary files a/elpa/racket-mode-20200411.1959/racket-repl.elc and b/elpa/racket-mode-20200412.1611/racket-repl.elc differ diff --git a/elpa/racket-mode-20200411.1959/racket-show.el b/elpa/racket-mode-20200412.1611/racket-show.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-show.el rename to elpa/racket-mode-20200412.1611/racket-show.el diff --git a/elpa/racket-mode-20200411.1959/racket-show.elc b/elpa/racket-mode-20200412.1611/racket-show.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-show.elc rename to elpa/racket-mode-20200412.1611/racket-show.elc diff --git a/elpa/racket-mode-20200411.1959/racket-smart-open.el b/elpa/racket-mode-20200412.1611/racket-smart-open.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-smart-open.el rename to elpa/racket-mode-20200412.1611/racket-smart-open.el diff --git a/elpa/racket-mode-20200411.1959/racket-smart-open.elc b/elpa/racket-mode-20200412.1611/racket-smart-open.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-smart-open.elc rename to elpa/racket-mode-20200412.1611/racket-smart-open.elc diff --git a/elpa/racket-mode-20200411.1959/racket-stepper.el b/elpa/racket-mode-20200412.1611/racket-stepper.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-stepper.el rename to elpa/racket-mode-20200412.1611/racket-stepper.el diff --git a/elpa/racket-mode-20200411.1959/racket-stepper.elc b/elpa/racket-mode-20200412.1611/racket-stepper.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-stepper.elc rename to elpa/racket-mode-20200412.1611/racket-stepper.elc diff --git a/elpa/racket-mode-20200411.1959/racket-unicode-input-method.el b/elpa/racket-mode-20200412.1611/racket-unicode-input-method.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-unicode-input-method.el rename to elpa/racket-mode-20200412.1611/racket-unicode-input-method.el diff --git a/elpa/racket-mode-20200411.1959/racket-unicode-input-method.elc b/elpa/racket-mode-20200412.1611/racket-unicode-input-method.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-unicode-input-method.elc rename to elpa/racket-mode-20200412.1611/racket-unicode-input-method.elc diff --git a/elpa/racket-mode-20200411.1959/racket-util.el b/elpa/racket-mode-20200412.1611/racket-util.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-util.el rename to elpa/racket-mode-20200412.1611/racket-util.el diff --git a/elpa/racket-mode-20200411.1959/racket-util.elc b/elpa/racket-mode-20200412.1611/racket-util.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-util.elc rename to elpa/racket-mode-20200412.1611/racket-util.elc diff --git a/elpa/racket-mode-20200411.1959/racket-visit.el b/elpa/racket-mode-20200412.1611/racket-visit.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-visit.el rename to elpa/racket-mode-20200412.1611/racket-visit.el diff --git a/elpa/racket-mode-20200411.1959/racket-visit.elc b/elpa/racket-mode-20200412.1611/racket-visit.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-visit.elc rename to elpa/racket-mode-20200412.1611/racket-visit.elc diff --git a/elpa/racket-mode-20200411.1959/racket-wsl.el b/elpa/racket-mode-20200412.1611/racket-wsl.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-wsl.el rename to elpa/racket-mode-20200412.1611/racket-wsl.el diff --git a/elpa/racket-mode-20200411.1959/racket-wsl.elc b/elpa/racket-mode-20200412.1611/racket-wsl.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-wsl.elc rename to elpa/racket-mode-20200412.1611/racket-wsl.elc diff --git a/elpa/racket-mode-20200411.1959/racket-xp-complete.el b/elpa/racket-mode-20200412.1611/racket-xp-complete.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-xp-complete.el rename to elpa/racket-mode-20200412.1611/racket-xp-complete.el diff --git a/elpa/racket-mode-20200411.1959/racket-xp-complete.elc b/elpa/racket-mode-20200412.1611/racket-xp-complete.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-xp-complete.elc rename to elpa/racket-mode-20200412.1611/racket-xp-complete.elc diff --git a/elpa/racket-mode-20200411.1959/racket-xp.el b/elpa/racket-mode-20200412.1611/racket-xp.el similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-xp.el rename to elpa/racket-mode-20200412.1611/racket-xp.el diff --git a/elpa/racket-mode-20200411.1959/racket-xp.elc b/elpa/racket-mode-20200412.1611/racket-xp.elc similarity index 100% rename from elpa/racket-mode-20200411.1959/racket-xp.elc rename to elpa/racket-mode-20200412.1611/racket-xp.elc diff --git a/elpa/racket-mode-20200411.1959/racket/command-server.rkt b/elpa/racket-mode-20200412.1611/racket/command-server.rkt similarity index 98% rename from elpa/racket-mode-20200411.1959/racket/command-server.rkt rename to elpa/racket-mode-20200412.1611/racket/command-server.rkt index 4d695b9d..5cfb2b20 100644 --- a/elpa/racket-mode-20200411.1959/racket/command-server.rkt +++ b/elpa/racket-mode-20200412.1611/racket/command-server.rkt @@ -156,7 +156,7 @@ [`(debug-eval ,src ,l ,c ,p ,code) (debug-eval src l c p code)] [`(debug-resume ,v) (debug-resume v)] [`(debug-disable) (debug-disable)] - [`(exit) (exit-repl-session (current-session-id))])) + [`(break ,kind) (break-repl-thread (current-session-id) kind)])) ;;; A few commands defined here diff --git a/elpa/racket-mode-20200411.1959/racket/commands/check-syntax.rkt b/elpa/racket-mode-20200412.1611/racket/commands/check-syntax.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/commands/check-syntax.rkt rename to elpa/racket-mode-20200412.1611/racket/commands/check-syntax.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/commands/coverage.rkt b/elpa/racket-mode-20200412.1611/racket/commands/coverage.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/commands/coverage.rkt rename to elpa/racket-mode-20200412.1611/racket/commands/coverage.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/commands/describe.rkt b/elpa/racket-mode-20200412.1611/racket/commands/describe.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/commands/describe.rkt rename to elpa/racket-mode-20200412.1611/racket/commands/describe.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/commands/find-module.rkt b/elpa/racket-mode-20200412.1611/racket/commands/find-module.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/commands/find-module.rkt rename to elpa/racket-mode-20200412.1611/racket/commands/find-module.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/commands/help.rkt b/elpa/racket-mode-20200412.1611/racket/commands/help.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/commands/help.rkt rename to elpa/racket-mode-20200412.1611/racket/commands/help.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/commands/macro.rkt b/elpa/racket-mode-20200412.1611/racket/commands/macro.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/commands/macro.rkt rename to elpa/racket-mode-20200412.1611/racket/commands/macro.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/commands/module-names.rkt b/elpa/racket-mode-20200412.1611/racket/commands/module-names.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/commands/module-names.rkt rename to elpa/racket-mode-20200412.1611/racket/commands/module-names.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/commands/profile.rkt b/elpa/racket-mode-20200412.1611/racket/commands/profile.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/commands/profile.rkt rename to elpa/racket-mode-20200412.1611/racket/commands/profile.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/commands/requires.rkt b/elpa/racket-mode-20200412.1611/racket/commands/requires.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/commands/requires.rkt rename to elpa/racket-mode-20200412.1611/racket/commands/requires.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/debug-annotator.rkt b/elpa/racket-mode-20200412.1611/racket/debug-annotator.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/debug-annotator.rkt rename to elpa/racket-mode-20200412.1611/racket/debug-annotator.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/debug.rkt b/elpa/racket-mode-20200412.1611/racket/debug.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/debug.rkt rename to elpa/racket-mode-20200412.1611/racket/debug.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/elisp.rkt b/elpa/racket-mode-20200412.1611/racket/elisp.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/elisp.rkt rename to elpa/racket-mode-20200412.1611/racket/elisp.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/error.rkt b/elpa/racket-mode-20200412.1611/racket/error.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/error.rkt rename to elpa/racket-mode-20200412.1611/racket/error.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/example/example.rkt b/elpa/racket-mode-20200412.1611/racket/example/example.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/example/example.rkt rename to elpa/racket-mode-20200412.1611/racket/example/example.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/example/example.rkt.faceup b/elpa/racket-mode-20200412.1611/racket/example/example.rkt.faceup similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/example/example.rkt.faceup rename to elpa/racket-mode-20200412.1611/racket/example/example.rkt.faceup diff --git a/elpa/racket-mode-20200411.1959/racket/example/indent.rkt b/elpa/racket-mode-20200412.1611/racket/example/indent.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/example/indent.rkt rename to elpa/racket-mode-20200412.1611/racket/example/indent.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/example/indent.rkt.faceup b/elpa/racket-mode-20200412.1611/racket/example/indent.rkt.faceup similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/example/indent.rkt.faceup rename to elpa/racket-mode-20200412.1611/racket/example/indent.rkt.faceup diff --git a/elpa/racket-mode-20200411.1959/racket/find-module-path-completions.rkt b/elpa/racket-mode-20200412.1611/racket/find-module-path-completions.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/find-module-path-completions.rkt rename to elpa/racket-mode-20200412.1611/racket/find-module-path-completions.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/find.rkt b/elpa/racket-mode-20200412.1611/racket/find.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/find.rkt rename to elpa/racket-mode-20200412.1611/racket/find.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/fresh-line.rkt b/elpa/racket-mode-20200412.1611/racket/fresh-line.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/fresh-line.rkt rename to elpa/racket-mode-20200412.1611/racket/fresh-line.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/gui.rkt b/elpa/racket-mode-20200412.1611/racket/gui.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/gui.rkt rename to elpa/racket-mode-20200412.1611/racket/gui.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/identifier.rkt b/elpa/racket-mode-20200412.1611/racket/identifier.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/identifier.rkt rename to elpa/racket-mode-20200412.1611/racket/identifier.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/image.rkt b/elpa/racket-mode-20200412.1611/racket/image.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/image.rkt rename to elpa/racket-mode-20200412.1611/racket/image.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/imports.rkt b/elpa/racket-mode-20200412.1611/racket/imports.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/imports.rkt rename to elpa/racket-mode-20200412.1611/racket/imports.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/instrument.rkt b/elpa/racket-mode-20200412.1611/racket/instrument.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/instrument.rkt rename to elpa/racket-mode-20200412.1611/racket/instrument.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/interactions.rkt b/elpa/racket-mode-20200412.1611/racket/interactions.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/interactions.rkt rename to elpa/racket-mode-20200412.1611/racket/interactions.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/keywords.rkt b/elpa/racket-mode-20200412.1611/racket/keywords.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/keywords.rkt rename to elpa/racket-mode-20200412.1611/racket/keywords.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/logger.rkt b/elpa/racket-mode-20200412.1611/racket/logger.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/logger.rkt rename to elpa/racket-mode-20200412.1611/racket/logger.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/main.rkt b/elpa/racket-mode-20200412.1611/racket/main.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/main.rkt rename to elpa/racket-mode-20200412.1611/racket/main.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/mod.rkt b/elpa/racket-mode-20200412.1611/racket/mod.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/mod.rkt rename to elpa/racket-mode-20200412.1611/racket/mod.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/print.rkt b/elpa/racket-mode-20200412.1611/racket/print.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/print.rkt rename to elpa/racket-mode-20200412.1611/racket/print.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/repl.rkt b/elpa/racket-mode-20200412.1611/racket/repl.rkt similarity index 86% rename from elpa/racket-mode-20200411.1959/racket/repl.rkt rename to elpa/racket-mode-20200412.1611/racket/repl.rkt index 5e9f90bb..5029ce49 100644 --- a/elpa/racket-mode-20200411.1959/racket/repl.rkt +++ b/elpa/racket-mode-20200412.1611/racket/repl.rkt @@ -19,27 +19,36 @@ (provide start-repl-session-server run call-with-session-context - exit-repl-session + break-repl-thread current-session-id current-session-maybe-mod current-session-submit-pred) ;;; REPL session "housekeeping" +;; Session IDs are strings based on a number (define next-session-number 0) -(define drracket:submit-predicate/c (-> input-port? boolean? boolean?)) +;; Each REPL session has an entry in this hash-table. +(define sessions (make-hash)) ;string? => (or/c base-session? session?) -(define-struct/contract session - ([thread thread?] ;the repl manager thread - [repl-msg-chan channel?] ;see repl-message structs - [interaction-chan channel?] - [ns namespace?] - [maybe-mod (or/c #f mod?)] - [submit-pred (or/c #f drracket:submit-predicate/c)]) +;; Before module->namespace has returned, this is what we have in the +;; `sessions` hash-table. Most importantly, knowing the repl thread +;; allows us to break-thread it even while module->namespace is still +;; running; see the command break-repl-thread, below. +(struct base-session + (thread ;thread? the repl manager thread + repl-msg-chan ;channel? + interaction-chan ;channel? + maybe-mod) ;(or/c #f mod?) #:transparent) -(define sessions (make-hash)) +;; After module->namespace has returned, we can update the `sessions` +;; hash-table to include more information. +(struct session base-session + (ns ;namespace? + submit-pred) ;(or/c #f drracket:submit-predicate/c) + #:transparent) (define current-session-id (make-parameter #f)) (define current-repl-msg-chan (make-parameter #f)) @@ -99,19 +108,27 @@ ;;; Functionality provided for commands ;; A way to parameterize commands that need to work with a specific -;; REPL session. Called from command-server thread. +;; REPL session. Called from a command-server thread. (define (call-with-session-context sid proc . args) (match (hash-ref sessions sid #f) - [(and (session _thd msg-ch int-ch ns maybe-mod submit-pred) s) + [(and (session _thd msg-ch int-ch maybe-mod ns submit-pred) s) (log-racket-mode-debug "call-with-session-context: ~v => ~v" sid s) - (parameterize ([current-repl-msg-chan msg-ch] + (parameterize ([current-session-id sid] + [current-repl-msg-chan msg-ch] [current-interaction-chan int-ch] - [current-namespace ns] - [current-session-id sid] [current-session-maybe-mod maybe-mod] + [current-namespace ns] [current-session-submit-pred submit-pred]) (apply proc args))] + [(and (base-session _thd msg-ch int-ch maybe-mod) s) + (log-racket-mode-debug "call-with-session-context: ~v => ~v" + sid s) + (parameterize ([current-session-id sid] + [current-repl-msg-chan msg-ch] + [current-interaction-chan int-ch] + [current-session-maybe-mod maybe-mod]) + (apply proc args))] [_ (if (equal? sid '()) (log-racket-mode-debug "call-with-session-context: no specific session") @@ -119,15 +136,16 @@ sid sessions)) (apply proc args)])) -;; Command. Called from command-server thread -(define (exit-repl-session sid) +;; Command. Called from a command-server thread +(define/contract (break-repl-thread sid kind) + (-> any/c (or/c 'break 'hang-up 'terminate) any) (match (hash-ref sessions sid #f) - [(struct* session ([thread t])) - (log-racket-mode-debug "exit-repl: break-thread for ~v" sid) - (break-thread t 'terminate)] - [_ (log-racket-mode-error "exit-repl: ~v not in `sessions`" sid)])) + [(struct* base-session ([thread t])) + (log-racket-mode-debug "break-repl-thread: ~v ~v" sid kind) + (break-thread t (case kind [(hang-up terminate) kind] [else #f]))] + [_ (log-racket-mode-error "break-repl-thread: ~v not in `sessions`" sid)])) -;; Command. Called from command-server thread +;; Command. Called from a command-server thread (define/contract (run what mem pp ctx args dbgs) (-> list? number? elisp-bool/c context-level? list? (listof path-string?) list?) @@ -270,7 +288,15 @@ ;; 1. Set print hooks and output handlers (set-print-parameters pretty-print?) (set-output-handlers) - ;; 2. If module, require and enter its namespace, etc. + ;; 2. Record as much info about our session as we can, before + ;; possibly entering module->namespace. + (hash-set! sessions + (current-session-id) + (base-session (current-thread) + (current-repl-msg-chan) + (current-interaction-chan) + maybe-mod)) + ;; 3. If module, require and enter its namespace, etc. (with-expanded-syntax-caching-evaluator maybe-mod (when (and maybe-mod mod-path) (parameterize ([current-module-name-resolver module-name-resolver-for-run]) @@ -298,23 +324,25 @@ (module->namespace mod-path))) (maybe-warn-about-submodules mod-path context-level) (check-#%top-interaction))))) - ;; 3. Record information about our session + ;; 4. Record full information about our session, now that + ;; current-namespace is definitely the appropriate value, + ;; and it is OK to call get-repl-submit-predicate. (hash-set! sessions (current-session-id) (session (current-thread) (current-repl-msg-chan) (current-interaction-chan) - (current-namespace) maybe-mod + (current-namespace) (get-repl-submit-predicate maybe-mod))) (log-racket-mode-debug "sessions: ~v" sessions) - ;; 4. Now that the program has run, and `sessions` is updated, + ;; 5. Now that the program has run, and `sessions` is updated, ;; call the ready-thunk. On REPL startup this lets us wait ;; sending the repl-session-id until `sessions` is updated. ;; And for subsequent run commands, this lets us it wait to ;; send a response. (ready-thunk) - ;; 5. read-eval-print-loop + ;; 6. read-eval-print-loop (parameterize ([current-prompt-read (make-prompt-read maybe-mod)] [current-module-name-resolver module-name-resolver-for-repl]) ;; Note that read-eval-print-loop catches all non-break @@ -355,6 +383,7 @@ (next-break 'all))) ;; +(define drracket:submit-predicate/c (-> input-port? boolean? boolean?)) (define/contract (get-repl-submit-predicate m) (-> (or/c #f mod?) (or/c #f drracket:submit-predicate/c)) (define-values (dir file rmp) (maybe-mod->dir/file/rmp m)) diff --git a/elpa/racket-mode-20200411.1959/racket/scribble.rkt b/elpa/racket-mode-20200412.1611/racket/scribble.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/scribble.rkt rename to elpa/racket-mode-20200412.1611/racket/scribble.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/syntax.rkt b/elpa/racket-mode-20200412.1611/racket/syntax.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/syntax.rkt rename to elpa/racket-mode-20200412.1611/racket/syntax.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/test/find-examples.rkt b/elpa/racket-mode-20200412.1611/racket/test/find-examples.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/test/find-examples.rkt rename to elpa/racket-mode-20200412.1611/racket/test/find-examples.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/test/find.rkt b/elpa/racket-mode-20200412.1611/racket/test/find.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/test/find.rkt rename to elpa/racket-mode-20200412.1611/racket/test/find.rkt diff --git a/elpa/racket-mode-20200411.1959/racket/util.rkt b/elpa/racket-mode-20200412.1611/racket/util.rkt similarity index 100% rename from elpa/racket-mode-20200411.1959/racket/util.rkt rename to elpa/racket-mode-20200412.1611/racket/util.rkt diff --git a/elpa/yasnippet-20200405.47/yasnippet-pkg.el b/elpa/yasnippet-20200405.47/yasnippet-pkg.el deleted file mode 100644 index 80ebeb9a..00000000 --- a/elpa/yasnippet-20200405.47/yasnippet-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; -*- no-byte-compile: t -*- -(define-package "yasnippet" "20200405.47" "Yet another snippet extension for Emacs" '((cl-lib "0.5")) :commit "291873ee13543c962bfc69cde330c8704a7dcfde" :keywords '("convenience" "emulation") :maintainer '("Noam Postavsky" . "npostavs@gmail.com") :url "http://github.com/joaotavora/yasnippet") diff --git a/elpa/yasnippet-20200405.47/yasnippet-autoloads.el b/elpa/yasnippet-20200412.2350/yasnippet-autoloads.el similarity index 100% rename from elpa/yasnippet-20200405.47/yasnippet-autoloads.el rename to elpa/yasnippet-20200412.2350/yasnippet-autoloads.el diff --git a/elpa/yasnippet-20200412.2350/yasnippet-pkg.el b/elpa/yasnippet-20200412.2350/yasnippet-pkg.el new file mode 100644 index 00000000..d367c95e --- /dev/null +++ b/elpa/yasnippet-20200412.2350/yasnippet-pkg.el @@ -0,0 +1,2 @@ +;;; -*- no-byte-compile: t -*- +(define-package "yasnippet" "20200412.2350" "Yet another snippet extension for Emacs" '((cl-lib "0.5")) :commit "1cc1996074bdd8fa4e94a51171f5f4ae35f6600b" :keywords '("convenience" "emulation") :maintainer '("Noam Postavsky" . "npostavs@gmail.com") :url "http://github.com/joaotavora/yasnippet") diff --git a/elpa/yasnippet-20200405.47/yasnippet.el b/elpa/yasnippet-20200412.2350/yasnippet.el similarity index 99% rename from elpa/yasnippet-20200405.47/yasnippet.el rename to elpa/yasnippet-20200412.2350/yasnippet.el index bb1c6104..b6992809 100644 --- a/elpa/yasnippet-20200405.47/yasnippet.el +++ b/elpa/yasnippet-20200412.2350/yasnippet.el @@ -6,7 +6,7 @@ ;; Noam Postavsky ;; Maintainer: Noam Postavsky ;; Version: 0.14.0 -;; Package-Version: 20200405.47 +;; Package-Version: 20200412.2350 ;; X-URL: http://github.com/joaotavora/yasnippet ;; Keywords: convenience, emulation ;; URL: http://github.com/joaotavora/yasnippet @@ -4169,21 +4169,26 @@ Returns the newly created snippet." (yas--letenv expand-env ;; Put a single undo action for the expanded snippet's ;; content. - (let ((buffer-undo-list t) - (inhibit-modification-hooks t)) - ;; Some versions of cc-mode fail when inserting snippet - ;; content in a narrowed buffer, so make sure to insert - ;; before narrowing. Furthermore, call before and after - ;; change functions manually, otherwise cc-mode's cache can - ;; get messed up. + (let ((buffer-undo-list t)) (goto-char begin) - (run-hook-with-args 'before-change-functions begin begin) - (insert content) - (setq end (+ end (length content))) - (narrow-to-region begin end) - (goto-char (point-min)) - (yas--snippet-parse-create snippet) - (run-hook-with-args 'after-change-functions (point-min) (point-max) 0)) + ;; Call before and after change functions manually, + ;; otherwise cc-mode's cache can get messed up. Don't use + ;; `inhibit-modification-hooks' for that, that blocks + ;; overlay and text property hooks as well! FIXME: Maybe + ;; use `combine-change-calls'? (Requires Emacs 27+ though.) + (run-hook-with-args 'before-change-functions begin end) + (let ((before-change-functions nil) + (after-change-functions nil)) + ;; Some versions of cc-mode fail when inserting snippet + ;; content in a narrowed buffer, so make sure to insert + ;; before narrowing. + (insert content) + (narrow-to-region begin (point)) + (goto-char (point-min)) + (yas--snippet-parse-create snippet)) + (run-hook-with-args 'after-change-functions + (point-min) (point-max) + (- (point-max) (point-min)))) (when (listp buffer-undo-list) (push (cons (point-min) (point-max)) buffer-undo-list)) diff --git a/elpa/yasnippet-20200405.47/yasnippet.elc b/elpa/yasnippet-20200412.2350/yasnippet.elc similarity index 99% rename from elpa/yasnippet-20200405.47/yasnippet.elc rename to elpa/yasnippet-20200412.2350/yasnippet.elc index bcaae129..b17ccbb9 100644 Binary files a/elpa/yasnippet-20200405.47/yasnippet.elc and b/elpa/yasnippet-20200412.2350/yasnippet.elc differ diff --git a/kitty.conf b/kitty.conf index 1a383274..43080d88 100644 --- a/kitty.conf +++ b/kitty.conf @@ -463,7 +463,7 @@ background #2E3440 #: The foreground and background colors -background_opacity 1.0 +background_opacity 0.95 #: The opacity of the background. A number between 0 and 1, where 1 is #: opaque and 0 is fully transparent. This will only work if