diff --git a/code/elpa/transpose-frame-20220913.1749/transpose-frame-autoloads.el b/code/elpa/transpose-frame-20220913.1749/transpose-frame-autoloads.el deleted file mode 100644 index cae870d..0000000 --- a/code/elpa/transpose-frame-20220913.1749/transpose-frame-autoloads.el +++ /dev/null @@ -1,59 +0,0 @@ -;;; transpose-frame-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "transpose-frame" "transpose-frame.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from transpose-frame.el - -(autoload 'transpose-frame "transpose-frame" "\ -Transpose windows arrangement at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'flip-frame "transpose-frame" "\ -Flip windows arrangement vertically at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'flop-frame "transpose-frame" "\ -Flop windows arrangement horizontally at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'rotate-frame "transpose-frame" "\ -Rotate windows arrangement 180 degrees at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'rotate-frame-clockwise "transpose-frame" "\ -Rotate windows arrangement 90 degrees clockwise at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'rotate-frame-anticlockwise "transpose-frame" "\ -Rotate windows arrangement 90 degrees anti-clockwise at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(register-definition-prefixes "transpose-frame" '("transpose-frame-")) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; transpose-frame-autoloads.el ends here diff --git a/code/elpa/transpose-frame-20220913.1749/transpose-frame-pkg.el b/code/elpa/transpose-frame-20220913.1749/transpose-frame-pkg.el deleted file mode 100644 index 2189fda..0000000 --- a/code/elpa/transpose-frame-20220913.1749/transpose-frame-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from transpose-frame.el -*- no-byte-compile: t -*- -(define-package "transpose-frame" "20220913.1749" "Transpose windows arrangement in a frame" 'nil :commit "7b7f8a1582436749a57ebbba6ead716b5a0edddc" :authors '(("S. Irie")) :maintainer '("S. Irie") :keywords '("window")) diff --git a/code/elpa/transpose-frame-20220913.1749/transpose-frame.el b/code/elpa/transpose-frame-20220913.1749/transpose-frame.el deleted file mode 100644 index c16c06c..0000000 --- a/code/elpa/transpose-frame-20220913.1749/transpose-frame.el +++ /dev/null @@ -1,237 +0,0 @@ -;;; transpose-frame.el --- Transpose windows arrangement in a frame - -;; Copyright (c) 2011 S. Irie - -;; Author: S. Irie -;; Keywords: window -;; Package-Version: 20220913.1749 -;; Package-Commit: 7b7f8a1582436749a57ebbba6ead716b5a0edddc - -;; This program is free software. - -;; Redistribution and use in source and binary forms, with or without -;; modification, are permitted provided that the following conditions -;; are met: - -;; 1. Redistributions of source code must retain the above copyright -;; notice, this list of conditions and the following disclaimer. -;; 2. Redistributions in binary form must reproduce the above copyright -;; notice, this list of conditions and the following disclaimer in the -;; documentation and/or other materials provided with the distribution. - -;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -;;; Commentary: - -;; This program provides some interactive functions which allows users -;; to transpose windows arrangement in currently selected frame: -;; -;; `transpose-frame' ... Swap x-direction and y-direction -;; -;; +------------+------------+ +----------------+--------+ -;; | | B | | A | | -;; | A +------------+ | | | -;; | | C | => +--------+-------+ D | -;; +------------+------------+ | B | C | | -;; | D | | | | | -;; +-------------------------+ +--------+-------+--------+ -;; -;; `flip-frame' ... Flip vertically -;; -;; +------------+------------+ +------------+------------+ -;; | | B | | D | -;; | A +------------+ +------------+------------+ -;; | | C | => | | C | -;; +------------+------------+ | A +------------+ -;; | D | | | B | -;; +-------------------------+ +------------+------------+ -;; -;; `flop-frame' ... Flop horizontally -;; -;; +------------+------------+ +------------+------------+ -;; | | B | | B | | -;; | A +------------+ +------------+ A | -;; | | C | => | C | | -;; +------------+------------+ +------------+------------+ -;; | D | | D | -;; +-------------------------+ +-------------------------+ -;; -;; `rotate-frame' ... Rotate 180 degrees -;; -;; +------------+------------+ +-------------------------+ -;; | | B | | D | -;; | A +------------+ +------------+------------+ -;; | | C | => | C | | -;; +------------+------------+ +------------+ A | -;; | D | | B | | -;; +-------------------------+ +------------+------------+ -;; -;; `rotate-frame-clockwise' ... Rotate 90 degrees clockwise -;; -;; +------------+------------+ +-------+-----------------+ -;; | | B | | | A | -;; | A +------------+ | | | -;; | | C | => | D +--------+--------+ -;; +------------+------------+ | | B | C | -;; | D | | | | | -;; +-------------------------+ +-------+--------+--------+ -;; -;; `rotate-frame-anticlockwise' ... Rotate 90 degrees anti-clockwise -;; -;; +------------+------------+ +--------+--------+-------+ -;; | | B | | B | C | | -;; | A +------------+ | | | | -;; | | C | => +--------+--------+ D | -;; +------------+------------+ | A | | -;; | D | | | | -;; +-------------------------+ +-----------------+-------+ -;; -;; This program is tested on GNU Emacs 22, 23. - -;;; Code: -;;; Internal functions - -(defun transpose-frame-get-arrangement (&optional frame subtree) - (let ((tree (or subtree - (car (window-tree frame))))) - (if (windowp tree) - (list (window-buffer tree) - (window-start tree) - (window-point tree) - (window-hscroll tree) - (window-margins tree) - (window-fringes tree) - (window-dedicated-p tree) - (jit-lock-register tree) - tree - (eq tree (frame-selected-window frame))) - (let* ((vertical (car tree)) - (edges (cadr tree)) - (length (float (if vertical - (- (nth 3 edges) (cadr edges)) - (- (nth 2 edges) (car edges)))))) - (cons vertical - (mapcar (lambda (subtree) - (cons (transpose-frame-get-arrangement frame subtree) - (/ (let ((edges (if (windowp subtree) - (window-edges subtree) - (cadr subtree)))) - (if vertical - (- (nth 3 edges) (cadr edges)) - (- (nth 2 edges) (car edges)))) - length))) - (cddr tree))))))) - -(defun transpose-frame-set-arrangement (config &optional window-or-frame &rest how) - (let ((window (if (windowp window-or-frame) - window-or-frame - (frame-selected-window window-or-frame)))) - (unless (windowp window-or-frame) - (delete-other-windows window)) - (if (bufferp (car config)) - (let ((buffer (pop config))) - (set-window-buffer window buffer) - (set-window-start window (pop config)) - (set-window-point window (pop config)) - (set-window-hscroll window (pop config)) - (set-window-margins window (caar config) (cdr (pop config))) - (apply 'set-window-fringes window (pop config)) - (set-window-dedicated-p window (pop config)) - (jit-lock-register window (pop config)) - (let* ((orig-window (pop config)) - (ol-func (lambda (ol) - (when (eq (overlay-get ol 'window) orig-window) - (overlay-put ol 'window window)))) - (ol-lists (with-current-buffer buffer - (overlay-lists)))) - (mapc ol-func (car ol-lists)) - (mapc ol-func (cdr ol-lists))) - (if (car config) (select-window window))) - (let* ((horizontal (if (memq 'transpose how) - (pop config) - (not (pop config)))) - (edges (window-edges window)) - (length (if horizontal - (- (nth 2 edges) (car edges)) - (- (nth 3 edges) (cadr edges))))) - (if (memq (if horizontal 'flop 'flip) how) - (setq config (reverse config))) - (while (cdr config) - (setq window (prog1 - (split-window window (round (* length (cdar config))) - horizontal) - (apply 'transpose-frame-set-arrangement - (caar config) window how)) - config (cdr config))) - (apply 'transpose-frame-set-arrangement - (caar config) window how))))) - -;;; User commands - -;;;###autoload -(defun transpose-frame (&optional frame) - "Transpose windows arrangement at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'transpose) - (when (called-interactively-p 'any) (recenter))) - -;;;###autoload -(defun flip-frame (&optional frame) - "Flip windows arrangement vertically at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'flip)) - -;;;###autoload -(defun flop-frame (&optional frame) - "Flop windows arrangement horizontally at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'flop)) - -;;;###autoload -(defun rotate-frame (&optional frame) - "Rotate windows arrangement 180 degrees at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'flip 'flop)) - -;;;###autoload -(defun rotate-frame-clockwise (&optional frame) - "Rotate windows arrangement 90 degrees clockwise at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'transpose 'flop) - (when (called-interactively-p 'any) (recenter))) - -;;;###autoload -(defun rotate-frame-anticlockwise (&optional frame) - "Rotate windows arrangement 90 degrees anti-clockwise at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'transpose 'flip) - (when (called-interactively-p 'any) (recenter))) - -;;; _ -;; Local Variables: -;; indent-tabs-mode: nil -;; End: -(provide 'transpose-frame) -;;; transpose-frame.el ends here diff --git a/code/elpa/transpose-frame-20221109.2053/transpose-frame-autoloads.el b/code/elpa/transpose-frame-20221109.2053/transpose-frame-autoloads.el deleted file mode 100644 index cae870d..0000000 --- a/code/elpa/transpose-frame-20221109.2053/transpose-frame-autoloads.el +++ /dev/null @@ -1,59 +0,0 @@ -;;; transpose-frame-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "transpose-frame" "transpose-frame.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from transpose-frame.el - -(autoload 'transpose-frame "transpose-frame" "\ -Transpose windows arrangement at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'flip-frame "transpose-frame" "\ -Flip windows arrangement vertically at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'flop-frame "transpose-frame" "\ -Flop windows arrangement horizontally at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'rotate-frame "transpose-frame" "\ -Rotate windows arrangement 180 degrees at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'rotate-frame-clockwise "transpose-frame" "\ -Rotate windows arrangement 90 degrees clockwise at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'rotate-frame-anticlockwise "transpose-frame" "\ -Rotate windows arrangement 90 degrees anti-clockwise at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(register-definition-prefixes "transpose-frame" '("transpose-frame-")) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; transpose-frame-autoloads.el ends here diff --git a/code/elpa/transpose-frame-20221109.2053/transpose-frame-pkg.el b/code/elpa/transpose-frame-20221109.2053/transpose-frame-pkg.el deleted file mode 100644 index 1b07ce9..0000000 --- a/code/elpa/transpose-frame-20221109.2053/transpose-frame-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from transpose-frame.el -*- no-byte-compile: t -*- -(define-package "transpose-frame" "20221109.2053" "Transpose windows arrangement in a frame" 'nil :commit "94c87794d53883a2358d13da264ad8dab9a52daa" :authors '(("S. Irie")) :maintainer '("S. Irie") :keywords '("window")) diff --git a/code/elpa/transpose-frame-20221109.2053/transpose-frame.el b/code/elpa/transpose-frame-20221109.2053/transpose-frame.el deleted file mode 100644 index c376e84..0000000 --- a/code/elpa/transpose-frame-20221109.2053/transpose-frame.el +++ /dev/null @@ -1,235 +0,0 @@ -;;; transpose-frame.el --- Transpose windows arrangement in a frame - -;; Copyright (c) 2011 S. Irie - -;; Author: S. Irie -;; Keywords: window -;; Package-Version: 20221109.2053 -;; Package-Commit: 94c87794d53883a2358d13da264ad8dab9a52daa - -;; This program is free software. - -;; Redistribution and use in source and binary forms, with or without -;; modification, are permitted provided that the following conditions -;; are met: - -;; 1. Redistributions of source code must retain the above copyright -;; notice, this list of conditions and the following disclaimer. -;; 2. Redistributions in binary form must reproduce the above copyright -;; notice, this list of conditions and the following disclaimer in the -;; documentation and/or other materials provided with the distribution. - -;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -;;; Commentary: - -;; This program provides some interactive functions which allows users -;; to transpose windows arrangement in currently selected frame: -;; -;; `transpose-frame' ... Swap x-direction and y-direction -;; -;; +------------+------------+ +----------------+--------+ -;; | | B | | A | | -;; | A +------------+ | | | -;; | | C | => +--------+-------+ D | -;; +------------+------------+ | B | C | | -;; | D | | | | | -;; +-------------------------+ +--------+-------+--------+ -;; -;; `flip-frame' ... Flip vertically -;; -;; +------------+------------+ +------------+------------+ -;; | | B | | D | -;; | A +------------+ +------------+------------+ -;; | | C | => | | C | -;; +------------+------------+ | A +------------+ -;; | D | | | B | -;; +-------------------------+ +------------+------------+ -;; -;; `flop-frame' ... Flop horizontally -;; -;; +------------+------------+ +------------+------------+ -;; | | B | | B | | -;; | A +------------+ +------------+ A | -;; | | C | => | C | | -;; +------------+------------+ +------------+------------+ -;; | D | | D | -;; +-------------------------+ +-------------------------+ -;; -;; `rotate-frame' ... Rotate 180 degrees -;; -;; +------------+------------+ +-------------------------+ -;; | | B | | D | -;; | A +------------+ +------------+------------+ -;; | | C | => | C | | -;; +------------+------------+ +------------+ A | -;; | D | | B | | -;; +-------------------------+ +------------+------------+ -;; -;; `rotate-frame-clockwise' ... Rotate 90 degrees clockwise -;; -;; +------------+------------+ +-------+-----------------+ -;; | | B | | | A | -;; | A +------------+ | | | -;; | | C | => | D +--------+--------+ -;; +------------+------------+ | | B | C | -;; | D | | | | | -;; +-------------------------+ +-------+--------+--------+ -;; -;; `rotate-frame-anticlockwise' ... Rotate 90 degrees anti-clockwise -;; -;; +------------+------------+ +--------+--------+-------+ -;; | | B | | B | C | | -;; | A +------------+ | | | | -;; | | C | => +--------+--------+ D | -;; +------------+------------+ | A | | -;; | D | | | | -;; +-------------------------+ +-----------------+-------+ -;; -;; This program is tested on GNU Emacs 22, 23. - -;;; Code: -;;; Internal functions - -(defun transpose-frame-get-arrangement (&optional frame subtree) - (let ((tree (or subtree - (car (window-tree frame))))) - (if (windowp tree) - (list (window-buffer tree) - (window-start tree) - (window-point tree) - (window-hscroll tree) - (window-margins tree) - (window-fringes tree) - (window-dedicated-p tree) - tree - (eq tree (frame-selected-window frame))) - (let* ((vertical (car tree)) - (edges (cadr tree)) - (length (float (if vertical - (- (nth 3 edges) (cadr edges)) - (- (nth 2 edges) (car edges)))))) - (cons vertical - (mapcar (lambda (subtree) - (cons (transpose-frame-get-arrangement frame subtree) - (/ (let ((edges (if (windowp subtree) - (window-edges subtree) - (cadr subtree)))) - (if vertical - (- (nth 3 edges) (cadr edges)) - (- (nth 2 edges) (car edges)))) - length))) - (cddr tree))))))) - -(defun transpose-frame-set-arrangement (config &optional window-or-frame &rest how) - (let ((window (if (windowp window-or-frame) - window-or-frame - (frame-selected-window window-or-frame)))) - (unless (windowp window-or-frame) - (delete-other-windows window)) - (if (bufferp (car config)) - (let ((buffer (pop config))) - (set-window-buffer window buffer) - (set-window-start window (pop config)) - (set-window-point window (pop config)) - (set-window-hscroll window (pop config)) - (set-window-margins window (caar config) (cdr (pop config))) - (apply 'set-window-fringes window (pop config)) - (set-window-dedicated-p window (pop config)) - (let* ((orig-window (pop config)) - (ol-func (lambda (ol) - (when (eq (overlay-get ol 'window) orig-window) - (overlay-put ol 'window window)))) - (ol-lists (with-current-buffer buffer - (overlay-lists)))) - (mapc ol-func (car ol-lists)) - (mapc ol-func (cdr ol-lists))) - (if (car config) (select-window window))) - (let* ((horizontal (if (memq 'transpose how) - (pop config) - (not (pop config)))) - (edges (window-edges window)) - (length (if horizontal - (- (nth 2 edges) (car edges)) - (- (nth 3 edges) (cadr edges))))) - (if (memq (if horizontal 'flop 'flip) how) - (setq config (reverse config))) - (while (cdr config) - (setq window (prog1 - (split-window window (round (* length (cdar config))) - horizontal) - (apply 'transpose-frame-set-arrangement - (caar config) window how)) - config (cdr config))) - (apply 'transpose-frame-set-arrangement - (caar config) window how))))) - -;;; User commands - -;;;###autoload -(defun transpose-frame (&optional frame) - "Transpose windows arrangement at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'transpose) - (when (called-interactively-p 'any) (recenter))) - -;;;###autoload -(defun flip-frame (&optional frame) - "Flip windows arrangement vertically at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'flip)) - -;;;###autoload -(defun flop-frame (&optional frame) - "Flop windows arrangement horizontally at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'flop)) - -;;;###autoload -(defun rotate-frame (&optional frame) - "Rotate windows arrangement 180 degrees at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'flip 'flop)) - -;;;###autoload -(defun rotate-frame-clockwise (&optional frame) - "Rotate windows arrangement 90 degrees clockwise at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'transpose 'flop) - (when (called-interactively-p 'any) (recenter))) - -;;;###autoload -(defun rotate-frame-anticlockwise (&optional frame) - "Rotate windows arrangement 90 degrees anti-clockwise at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'transpose 'flip) - (when (called-interactively-p 'any) (recenter))) - -;;; _ -;; Local Variables: -;; indent-tabs-mode: nil -;; End: -(provide 'transpose-frame) -;;; transpose-frame.el ends here diff --git a/org/elpa/persp-mode-20220909.836/persp-mode-autoloads.el b/org/elpa/persp-mode-20220909.836/persp-mode-autoloads.el deleted file mode 100644 index b375c0c..0000000 --- a/org/elpa/persp-mode-20220909.836/persp-mode-autoloads.el +++ /dev/null @@ -1,69 +0,0 @@ -;;; persp-mode-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "persp-mode" "persp-mode.el" (0 0 0 0)) -;;; Generated autoloads from persp-mode.el - -(autoload 'persp-def-auto-persp "persp-mode" "\ - - -\(fn NAME &rest KEYARGS &key BUFFER-NAME FILE-NAME MODE MODE-NAME MINOR-MODE MINOR-MODE-NAME PREDICATE HOOKS DYN-ENV GET-NAME GET-BUFFER GET-PERSP SWITCH PARAMETERS NOAUTO WEAK USER-DATA ON-MATCH AFTER-MATCH DONT-PICK-UP-BUFFERS DELETE)" nil nil) - -(define-obsolete-function-alias 'def-auto-persp 'persp-def-auto-persp "persp-mode 2.9.6") - -(autoload 'persp-def-buffer-save/load "persp-mode" "\ - - -\(fn &rest KEYARGS &key BUFFER-NAME FILE-NAME MODE MODE-NAME MINOR-MODE MINOR-MODE-NAME PREDICATE TAG-SYMBOL SAVE-VARS SAVE-FUNCTION LOAD-FUNCTION AFTER-LOAD-FUNCTION MODE-RESTORE-FUNCTION APPEND)" nil nil) - -(define-obsolete-function-alias 'def-persp-buffer-save/load 'persp-def-buffer-save/load "persp-mode 2.9.6") - -(defvar persp-mode nil "\ -Non-nil if Persp mode is enabled. -See the `persp-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 `persp-mode'.") - -(custom-autoload 'persp-mode "persp-mode" nil) - -(autoload 'persp-mode "persp-mode" "\ -Toggle the persp-mode. -When active, keeps track of multiple 'perspectives', -named collections of buffers and window configurations. -Here is a keymap of this minor mode: -\\{persp-mode-map} - -This is a minor mode. If called interactively, toggle the `Persp -mode' mode. If the prefix argument is positive, enable the mode, -and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='persp-mode)'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -\(fn &optional ARG)" t nil) - -(register-definition-prefixes "persp-mode" '("*persp-" "clear-window-persp" "def-" "get-" "ido-toggle-persp-filter" "persp" "safe-persp-" "set-" "window-persp-set-p" "with-persp-ido-hooks")) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; persp-mode-autoloads.el ends here diff --git a/org/elpa/persp-mode-20220909.836/persp-mode-pkg.el b/org/elpa/persp-mode-20220909.836/persp-mode-pkg.el deleted file mode 100644 index ea6dee7..0000000 --- a/org/elpa/persp-mode-20220909.836/persp-mode-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from persp-mode.el -*- no-byte-compile: t -*- -(define-package "persp-mode" "20220909.836" "windows/buffers sets shared among frames + save/load." '((emacs "24.3")) :commit "67be9feeb02613ea97f0de9eb5b792b193f073bc" :authors '(("Constantin Kulikov (Bad_ptr)" . "zxnotdead@gmail.com")) :maintainer '("Constantin Kulikov (Bad_ptr)" . "zxnotdead@gmail.com") :keywords '("perspectives" "session" "workspace" "persistence" "windows" "buffers" "convenience") :url "https://github.com/Bad-ptr/persp-mode.el") diff --git a/org/elpa/persp-mode-20220909.836/persp-mode.el b/org/elpa/persp-mode-20220909.836/persp-mode.el deleted file mode 100644 index cfa7fd4..0000000 --- a/org/elpa/persp-mode-20220909.836/persp-mode.el +++ /dev/null @@ -1,4163 +0,0 @@ -;;; persp-mode.el --- windows/buffers sets shared among frames + save/load. -*- lexical-binding: t; -*- - -;; Copyright (C) 2012 Constantin Kulikov - -;; Author: Constantin Kulikov (Bad_ptr) -;; Version: 3.0.6 -;; Package-Version: 20220909.836 -;; Package-Commit: 67be9feeb02613ea97f0de9eb5b792b193f073bc -;; Package-Requires: ((emacs "24.3")) -;; Keywords: perspectives, session, workspace, persistence, windows, buffers, convenience -;; URL: https://github.com/Bad-ptr/persp-mode.el - -;;; License: - -;; This file is not part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: - -;; Based on the perspective.el by Natalie Weizenbaum -;; (http://github.com/nex3/perspective-el) but the perspectives are shared -;; among the frames and could be saved/restored from/to a file. -;; -;; Homepage: https://github.com/Bad-ptr/persp-mode.el - -;; Installation: - -;; From the MELPA: M-x package-install RET persp-mode RET -;; From a file: M-x package-install-file RET 'path to this file' RET -;; Or put this file into your load-path. - -;; Configuration: - -;; When installed through the package-install: -;; (with-eval-after-load "persp-mode-autoloads" -;; (setq wg-morph-on nil) -;; ;; switch off the animation of restoring window configuration -;; (setq persp-autokill-buffer-on-remove 'kill-weak) -;; (add-hook 'after-init-hook #'(lambda () (persp-mode 1)))) - -;; When installed without generating an autoloads file: -;; (with-eval-after-load "persp-mode" -;; ;; .. all settings you want here -;; (add-hook 'after-init-hook #'(lambda () (persp-mode 1)))) -;; (require 'persp-mode) - -;; Dependencies: - -;; The ability to save/restore window configurations from/to a file -;; depends on the workgroups.el(https://github.com/tlh/workgroups.el) -;; for the emacs versions < 24.4 - -;; Customization: - -;; M-x: customize-group RET persp-mode RET - -;; You can read more in README.md - - -;;; Code: - - -;; Prerequirements: - -(require 'cl-lib) -(require 'easymenu) - -(declare-function golden-ratio-mode "ext:golden-ratio") -(declare-function tabbar-buffer-list "ext:tabbar-mode") - -(declare-function tramp-dissect-file-name "tramp") -(declare-function tramp-file-name-hop "tramp") -(declare-function tramp-file-name-host "tramp") -(declare-function tramp-file-name-localname "tramp") -(declare-function tramp-file-name-method "tramp") -(declare-function tramp-file-name-user "tramp") -(declare-function tramp-tramp-file-p "tramp") - -(defvar ido-cur-item) -(defvar ido-exit) -(defvar ido-temp-list) -(defvar ido-text) -(defvar ido-text-init) -(defvar tabbar-buffer-list-function) - -(defvar persp-mode nil) - -(defconst persp-not-persp :nil - "Something that is not a perspective.") - -(unless (fboundp 'condition-case-unless-debug) - (defalias 'condition-case-unless-debug 'condition-case-no-debug)) -(unless (fboundp 'read-multiple-choice) - (defun read-multiple-choice (prompt choices) - (let ((choice-chars (mapcar #'car choices))) - (when choice-chars - (assq (read-char-choice - (format "%s(%s): " - (substring prompt 0 (string-match ": $" prompt)) - (mapconcat #'(lambda (ch) - (format "[%c] - %s" (car ch) (cadr ch))) - choices "; ")) - choice-chars) - choices))))) -(unless (fboundp 'alist-get) - (defun alist-get (key alist &optional default remove) - (ignore remove) ;;Silence byte-compiler. - (let ((x (assq key alist))) - (if x (cdr x) default)))) - - -;; Customization variables: - -(unless - (memq 'custom-group (symbol-plist 'session)) - (defgroup session nil - "Emacs' state(opened files, buffers, windows, etc.)" - :group 'environment)) - -(defgroup persp-mode nil - "Customization of the `persp-mode'." - :prefix "persp-" - :group 'session - :link '(url-link - :tag "Github page" "https://github.com/Bad-ptr/persp-mode.el")) - -(defcustom persp-nil-name "none" - "Name for the nil perspective." - :group 'persp-mode - :type 'string - :set #'(lambda (sym val) - (when val - (when persp-mode - (cl-destructuring-bind (frames . windows) - (persp-frames-and-windows-with-persp - (persp-get-by-name persp-nil-name *persp-hash* nil)) - (dolist (win windows) - (when (equal persp-nil-name (get-window-persp* win)) - (set-window-persp* win val)))) - (run-hook-with-args - 'persp-renamed-functions nil persp-nil-name val)) - (custom-set-default sym val)))) - -(defface persp-face-lighter-buffer-not-in-persp - '((default . (:background "#F00" :foreground "#00F" :weight bold))) - "Face for the lighter when the current buffer is not in a perspective." - :group 'persp-mode) -(defface persp-face-lighter-nil-persp - '((t :inherit bold-italic)) - "Face for the lighter when the current perspective is nil." - :group 'persp-mode) -(defface persp-face-lighter-default - '((t :inherit italic)) - "Default face for the lighter.") - -(defcustom persp-lighter - '(:eval - (format - (propertize - " #%.5s" - 'face (let ((persp (get-current-persp))) - (if persp - (if (persp-contain-buffer-p (current-buffer) persp) - 'persp-face-lighter-default - 'persp-face-lighter-buffer-not-in-persp) - 'persp-face-lighter-nil-persp))) - (safe-persp-name (get-current-persp)))) - "Defines how the persp-mode show itself in the modeline." - :group 'persp-mode - :type 'sexp) - -(defcustom persp-save-dir (expand-file-name "persp-confs/" user-emacs-directory) - "The directory to/from where perspectives saved/loaded by default. -Autosave files are saved and loaded to/from this directory." - :group 'persp-mode - :type 'directory) - -(defcustom persp-auto-save-fname "persp-auto-save" - "Name of the file for auto save/load perspectives on the persp-mode -deactivation or the emacs shutdown." - :group 'persp-mode - :type 'string) - -(defcustom persp-auto-save-persps-to-their-file t - "If t -- then a perspective will be autosaved to a file specified -in the `persp-file' perspective parameter." - :group 'persp-mode - :type 'boolean) - -(defcustom persp-auto-save-persps-to-their-file-before-kill nil - "Whether or not perspectives will be saved before killed." - :group 'persp-mode - :type '(choice - (const :tag "Save perspectives which have `persp-file' parameter" - :value persp-file) - (const :tag "Save all perspectives" :value t) - (const :tag "Don't save just kill" :value nil))) - -(defcustom persp-auto-save-opt 2 - "This variable controls the autosave functionality of the persp-mode: -0 -- do not auto save; -1 -- save on the emacs shutdown and only if the persp-mode active; -2 -- save on the persp-mode deactivation or the emacs shutdown." - :group 'persp-mode - :type '(choice - (const :tag "Do not save" :value 0) - (const :tag "Save on exit" :value 1) - (const :tag "Save on exit and persp-mode deactivation" :value 2))) - -(defcustom persp-auto-save-num-of-backups 3 - "How many autosave file backups to keep." - :group 'persp-mode - :type 'integer) - -(defcustom persp-auto-resume-time 3.0 - "Delay time in seconds before loading from the autosave file. -If <= 0 -- do not autoresume." - :group 'persp-mode - :type 'float) - -(defcustom persp-set-last-persp-for-new-frames t - "If nil new frames will be created with the 'nil' perspective, -otherwise with a last activated perspective." - :group 'persp-mode - :type 'boolean) - -(defcustom persp-reset-windows-on-nil-window-conf t - "t -- When a perspective without a window configuration is activated -then delete all windows and show the *scratch* buffer; -function -- run that function; -nil -- do nothing." - :group 'persp-mode - :type '(choice - (const :tag "Delete all windows" :value t) - (const :tag "Do nothing" :value nil) - (function :tag "Run function" :value (lambda () nil)))) - - -(define-widget 'persp-buffer-list-restriction-choices 'lazy - "Variants of how the buffer-list can be restricted." - :offset 4 - :tag "\nControl the persp-buffer-list-restricted behaviour" - :type '(choice - (const :tag "List all buffers" :value -1) - (const :tag "List current perspective buffers" :value 0) - (const :tag "List buffers that aren't in the perspective" :value 1) - (const :tag "List buffers which unique to the perspective" :value 2) - (const :tag "List unique buffers, but show all for the nil perspective" - :value 2.5) - (const :tag "List free buffers" :value 3) - (const :tag "List free buffers, but show all for the nil perspective" - :value 3.5))) - -(defcustom *persp-restrict-buffers-to* 0 - "Controls the behaviour of the `persp-buffer-list-restricted' function." - :group 'persp-mode - :type '(choice - persp-buffer-list-restriction-choices - (function :tag "\nRun function with frame as an argument" - :value (lambda (f) (buffer-list f))))) - -(defcustom persp-restrict-buffers-to-if-foreign-buffer nil - "Override the *persp-restrict-buffers-to* if the current buffer is not in the -current perspective. If nil -- do not override." - :group 'persp-mode - :type '(choice - (const :tag "Do not override" :value nil) - persp-buffer-list-restriction-choices - (function :tag "\nRun function with frame as an argument" - :value (lambda (f) (buffer-list f))))) - -(defcustom persp-set-frame-buffer-predicate 'restricted-buffer-list - "t -- set the frame's buffer-predicate parameter to a function returning `t' - for buffers in current persp; -nil -- do not set the buffer-predicate; -restricted-buffer-list -- return t for buffers contained in the list returned - from the persp-buffer-list-restricted called without arguments; -number -- the same meaning as for the `*persp-restrict-buffers-to*'; -function -- use that function as buffer-predicate." - :group 'persp-mode - :type '(choice - (const :tag "\nConstrain to current perspective's buffers." - :value t) - (const :tag "\nDo not set frames' buffer-predicate parameter." - :value nil) - (const :tag "\nConstrain with persp-buffer-list-restricted." - :value restricted-buffer-list) - persp-buffer-list-restriction-choices - (function - :tag "\nConstrain with a function which take buffer as an argument." - :value (lambda (b) b))) - :set - #'(lambda (sym val) - (custom-set-default sym val) - (if val - (if persp-mode - (persp-update-frames-buffer-predicate) - (if (and (not (daemonp)) (null (cdr (frame-list)))) - (let (th) - (setq - th #'(lambda () - (run-at-time - 10 nil #'(lambda () - (remove-hook 'window-setup-hook th) - (persp-update-frames-buffer-predicate))))) - (add-hook 'window-setup-hook th)) - (add-hook 'persp-mode-hook - #'persp-update-frames-buffer-predicate))) - (persp-update-frames-buffer-predicate t)))) - -;; TODO: remove this var -(defcustom persp-hook-up-emacs-buffer-completion nil - "If t -- try to restrict read-buffer function of the current completion system." - :group 'persp-mode - :type 'boolean) -(make-obsolete-variable - 'persp-hook-up-emacs-buffer-completion - "`persp-set-read-buffer-function', `persp-set-ido-hooks', `persp-interactive-completion-function'" - "persp-mode 2.6") - -(defsubst persp-set-read-buffer-function (&optional opt) - (if opt - (when (not (eq read-buffer-function #'persp-read-buffer)) - (setq persp-saved-read-buffer-function read-buffer-function) - (setq read-buffer-function #'persp-read-buffer)) - (when (eq read-buffer-function #'persp-read-buffer) - (setq read-buffer-function persp-saved-read-buffer-function)))) -(defcustom persp-set-read-buffer-function nil - "If t -- set the read-buffer-function to persp-read-buffer." - :group 'persp-mode - :type 'boolean - :set #'(lambda (sym val) - (custom-set-default sym val) - (when persp-mode - (persp-set-read-buffer-function val)))) - -(defsubst persp-set-ido-hooks (&optional opt) - (if opt - (progn - (add-hook 'ido-make-buffer-list-hook #'persp-restrict-ido-buffers) - (add-hook 'ido-setup-hook #'persp-ido-setup)) - (remove-hook 'ido-make-buffer-list-hook #'persp-restrict-ido-buffers) - (remove-hook 'ido-setup-hook #'persp-ido-setup))) -(defcustom persp-set-ido-hooks nil - "If t -- set the ido hooks for buffer list restriction." - :group 'persp-mode - :type 'boolean - :set #'(lambda (sym val) - (custom-set-default sym val) - (when persp-mode - (persp-set-ido-hooks val)))) - -;; TODO: remove this var, just call the completing-read -(defvar persp-interactive-completion-function #'completing-read - "The function which is used by the persp-mode -to interactivly read user input with completion.") -(make-obsolete-variable - 'persp-interactive-completion-function - "`completing-read-function'" "persp-mode 2.7") - -(defun persp-update-completion-system (&optional system remove) - (interactive "i") - (when (and (not system) (not remove)) - (setq - system - (intern - (funcall persp-interactive-completion-function - "Set the completion system for persp-mode: " - '("ido" "completing-read") - nil t)))) - (if remove - (progn - (when (boundp 'persp-interactive-completion-system) - (when persp-hook-up-emacs-buffer-completion - (cl-case persp-interactive-completion-system - (ido (persp-set-ido-hooks)) - (t nil)))) - (setq persp-interactive-completion-function #'completing-read) - (custom-set-default 'persp-interactive-completion-system - 'completing-read)) - (persp-update-completion-system nil t) - (when system - (custom-set-default 'persp-interactive-completion-system system) - (when persp-hook-up-emacs-buffer-completion - (cl-case persp-interactive-completion-system - (ido - (persp-set-ido-hooks t) - (setq persp-interactive-completion-function #'ido-completing-read)) - (t nil)) - (persp-set-toggle-read-buffer-filter-keys - persp-toggle-read-buffer-filter-keys))))) - -;; TODO: remove this var -(defcustom persp-interactive-completion-system 'completing-read - "What completion system to use." - :group 'persp-mode - :type '(choice - (const :tag "ido" :value ido) - (const :tag "completing-read" :value completing-read)) - :set #'(lambda (sym val) - (if persp-mode - (persp-update-completion-system val) - (custom-set-default sym val)))) -(make-obsolete-variable - 'persp-interactive-completion-system - "`persp-set-read-buffer-function', `persp-set-ido-hooks', `persp-interactive-completion-function'" - "persp-mode 2.6") - -(define-widget 'persp-init-frame-behaviour-choices 'lazy - "Choices of the init-frame behavoiurs for the persp-mode." - :offset 4 - :tag "\nControl how frames initialized by persp-mode" - :type - '(choice - (const :tag "Restore window-configuration" :value t) - (const :tag "Do not restore window-configuration" :value nil) - (const :tag "Set persp-ignore-wconf flag for frame" - :value persp-ignore-wconf) - (const :tag "Set persp-ignore-wconf-once flag for frame" - :value persp-ignore-wconf-once) - (const :tag "Create a new random auto-perspective for the new frame" - :value auto-temp) - (const - :tag "Create a new perspective for the new frame and prompt for it's name" - :value prompt) - (string :tag "Use/create the perspective with a name" :value "pfnf") - (function :tag "Run this function" - :value (lambda (frame &optional new-frame-p) nil)))) - -(defcustom persp-init-frame-behaviour t - "Control the behaviour of how frames initialized." - :group 'persp-mode - :type 'persp-init-frame-behaviour-choices) - -(defcustom persp-init-new-frame-behaviour-override -1 - "Override the `persp-init-frame-behaviour` for new frames." - :group 'persp-mode - :type '(choice - (const :tag "Do not override" : value -1) - persp-init-frame-behaviour-choices)) - -(defcustom persp-interactive-init-frame-behaviour-override -1 - "Override the `persp-init-frame-behaviour' -when the `make-frame' was called interactively." - :group 'persp-mode - :type '(choice - (const :tag "Do not override" :value -1) - persp-init-frame-behaviour-choices)) - -(defcustom persp-emacsclient-init-frame-behaviour-override -1 - "Override the `persp-init-frame-behaviour' variable for frames created using -the emacsclient -[c|t]." - :group 'persp-mode - :type '(choice - (const :tag "Do not override" :value -1) - persp-init-frame-behaviour-choices)) - -(defcustom persp-server-switch-behaviour 'only-file-windows-for-client-frame - "Controls the behaviour of the server-switch-hook." - :group 'persp-mode - :type - '(choice - (const :tag "Do nothing" :value nil) - (const :tag "Leave only windows displaing files for edit -(files that was supplied as parameters to emacsclient)" - :value only-file-windows) - (const :tag "For the new frame(created by emacsclient -c ...) -leave only windows displaing files for edit" - :value only-file-windows-for-client-frame) - (function :tag "Run this function" :value (lambda (frame buflist) nil))) - :set - #'(lambda (sym val) - (custom-set-default sym val) - (if persp-mode - (persp-update-frame-server-switch-hook) - (add-hook 'persp-mode-hook #'persp-update-frame-server-switch-hook)))) - -;; TODO: remove this var -(defcustom persp-ignore-wconf-of-frames-created-to-edit-file t - "If t -- set the persp-ignore-wconf frame parameter -to t for frames that were created by emacsclient with file arguments. -Also delete windows not showing that files -(this is because server-switch-hook runs after after-make-frames); -If function -- run that function." - :group 'persp-mode - :type '(choice - (const :tag "Ignore window configuration" :value t) - (const :tag "Do as usual" :value nil) - (function :tag "Run function" :value (lambda () nil)))) -(make-obsolete-variable - 'persp-ignore-wconf-of-frames-created-to-edit-file - "`persp-emacsclient-frame-to-edit-file-behavoiur'" "persp-mode 2.0") - -(defcustom persp-add-buffer-on-find-file t - "If t -- add a buffer with opened file to current perspective." - :group 'persp-mode - :type - '(choice - (const :tag "Always add" :value t) - (const :tag "Newer add" :value nil) - (const - :tag "\nAdd if not matching any predicate from `persp-auto-persp-alist'" - :value if-not-autopersp) - (const :tag "\nAlways add but do not switch if the buffer matches any \ -predicate from `persp-auto-persp-alist'" - :value add-but-not-switch-if-autopersp))) - - -(defcustom persp-add-buffer-on-after-change-major-mode nil - "t -- add the current buffer to the current perspective when -the `after-change-major-mode-hook' fires; -nil -- do not add; -'free -- add only _free_ buffers; -function -- run that function." - :group 'persp-mode - :type '(choice - (const :tag "Always add" :value t) - (const :tag "Don't add" :value nil) - (const :tag "\nAdd if the buffer is not already in any other persp" - :value free) - (function :tag "Run this function" :value (lambda () nil))) - :set - #'(lambda (sym val) - (custom-set-default sym val) - (when persp-mode - (if val - (add-hook 'after-change-major-mode-hook - #'persp-after-change-major-mode-h t) - (remove-hook 'after-change-major-mode-hook - #'persp-after-change-major-mode-h))))) - -(defcustom persp-switch-to-added-buffer t - "If t then after you add a buffer to the current perspective -the currently selected window will be switched to that buffer." - :group 'persp-mode - :type 'boolean) - -(define-obsolete-variable-alias - 'persp-when-kill-switch-to-buffer-in-perspective - 'persp-when-remove-buffer-switch-to-other-buffer - "persp-mode 2.9.7") -(defcustom persp-when-remove-buffer-switch-to-other-buffer t - "If t -- then after a buffer is removed all windows of the current -perspective which showing that buffer will be switched to some previous buffer -in the current perspective." - :group 'persp-mode - :type 'boolean) - -(defcustom persp-remove-buffers-from-nil-persp-behaviour 'ask-to-rem-from-all - "What to do when removing a buffer from the nil perspective." - :group 'persp-mode - :type '(choice - (const :tag "Ask to remove from all perspectives" ask-to-rem-from-all) - (const :tag "Ask only if buffer belongs to a non-weak perspective" - ask-if-in-non-weak-persp) - (const :tag "Don't ask" nil) - (function :tag "Run this function" (lambda (b-o-ns) b-o-ns)))) - -(define-widget 'persp-kill-foreign-buffer-behaviour-choices 'lazy - "What to do when manually killing a buffer that is not in -the current perspective." - :offset 4 - :tag "\nControl the persp-kill-buffer-query-function behaviour." - :type - '(choice - (const :tag "Ask what to do" :value ask) - (const :tag "\nDon't ask if a buffer belongs only to weak perspectives" - :value dont-ask-weak) - (const :tag "Just kill" :value kill) - (const :tag "\nDo not suggest foreign buffer to the user(kill buffer)" - :value nil) - (function :tag "Run function" :value (lambda () t)))) - -(define-obsolete-variable-alias 'persp-kill-foreign-buffer-action - 'persp-kill-foreign-buffer-behaviour "persp-mode 2.9.6") -(defcustom persp-kill-foreign-buffer-behaviour 'dont-ask-weak - "What to do when manually killing a buffer that is not in -the current perspective." - :group 'persp-mode - :type 'persp-kill-foreign-buffer-behaviour-choices) - -(make-obsolete-variable - 'persp-kill-foreign-indirect-buffer-behaviour-override - "Don't use this" "persp-mode 2.9.7") - -(defcustom persp-autokill-buffer-on-remove nil - "Kill the buffer if it removed from every(or non weak) perspective." - :group 'persp-mode - :type - '(choice - (const :tag "Just kill" :value kill) ;; or t - (const - :tag "Kill if buffer belongs only to weak perspectives" :value kill-weak) - (const :tag "Do not kill" :value nil))) - -(defcustom persp-autokill-persp-when-removed-last-buffer 'hide-auto - "Kill the perspective if no buffers left in it." - :group 'persp-mode - :type '(choice - (const :tag "Just kill" :value kill) ;; or t - (const :tag "Kill auto perspectives" :value kill-auto) - (const :tag "Hide" :value hide) - (const :tag "Hide auto perspectives" :value hide-auto) - (const :tag "Do not kill" :value nil) - (function :tag "\nRun this function with persp as an argument" - :value (lambda (p) p)))) - -(defcustom persp-common-buffer-filter-functions - (list #'(lambda (b) (or (string-prefix-p " " (buffer-name b)) - (eq (buffer-local-value 'major-mode b) 'helm-major-mode)))) - "The list of functions wich takes a buffer as an argument. If one of these -functions returns a non nil value the buffer considered as 'filtered out'." - :group 'persp-mode - :type 'hook) - -(defcustom persp-buffer-list-restricted-filter-functions nil - "Additional filters for use inside the `persp-buffer-list-restricted'." - :group 'persp-mode - :type 'hook) - -(defcustom persp-add-buffer-on-after-change-major-mode-filter-functions nil - "Additional filters to know which buffers we dont want to add to -the current perspective after the `after-change-major-mode-hook' is fired." - :group 'persp-mode - :type 'hook) - -(defcustom persp-filter-save-buffers-functions - (list #'(lambda (b) (string-prefix-p "*" (buffer-name b)))) - "Additional filters to not save unneeded buffers." - :group 'persp-mode - :type 'hook) - -(defcustom persp-save-buffer-functions - (list #'(lambda (b) - (when (persp-buffer-filtered-out-p - b persp-filter-save-buffers-functions) - 'skip)) - #'persp-tramp-save-buffer - #'(lambda (b) - (when (eq 'dired-mode (buffer-local-value 'major-mode b)) - `(def-buffer ,(buffer-name b) - ,(buffer-local-value 'default-directory b) - ,(buffer-local-value 'major-mode b)))) - #'(lambda (b) - `(def-buffer ,(buffer-name b) - ,(buffer-file-name b) - ,(buffer-local-value 'major-mode b)))) - "Convert a buffer to a structure that could be saved to a file. -If a function return nil -- follow to the next function in the list. -If a function return 'skip -- don't save a buffer." - :group 'persp-mode - :type 'hook) - -(defcustom persp-load-buffer-functions - (list #'persp-buffer-from-savelist) - "Restore a buffer from a saved structure. -If a function return nil -- follow to the next function in the list. -If a function return 'skip -- don't restore a buffer." - :group 'persp-mode - :type 'hook) - -(defcustom persp-mode-hook nil - "The hook that's run after the `persp-mode' has been activated." - :group 'persp-mode - :type 'hook) - -(defcustom persp-mode-deactivated-hook nil - "Runs when the persp-mode is deactivated." - :group 'persp-mode - :type 'hook) - -(defcustom persp-created-functions nil - "Functions to run after a perspective was created. -These functions must accept two arguments -- the created perspective -and the hash in which this perspective will be placed, you can check -if that hash is the same as `*persp-hash*' or another(when you load -a subset of perspectives(with `persp-load-from-file-by-names') they -will be added to a temporary hash)." - :group 'persp-mode - :type 'hook) - -(defcustom persp-renamed-functions nil - "Functions to run if a perspective was renamed. -Each must take three arguments: 1) perspective; 2) old name; 3) new name. -These functions only run when renaming a perspective from `*persp-hash*'." - :group 'persp-mode - :type 'hook) - -(defcustom persp-before-kill-functions nil - "Functions that runs just before a perspective will be destroyed. -It's single argument is the perspective that will be killed." - :group 'persp-mode - :type 'hook) - -(defcustom persp-before-switch-functions nil - "Functions that runs before actually switching to a perspective. -These functions must take two arguments -- a name of a perspective to switch - (it could be a name of an nonexistent perspective or it could be the same -as current) and a frame or a window for which the switching will take place." - :group 'persp-mode - :type 'hook) - -(defcustom persp-activated-functions nil - "Functions that runs after a perspective has been activated. -These functions must take one argument -- a symbol, -if it is eq 'frame -- then the perspective is activated for `selected-frame', -if it is eq 'window -- then the perspective is activated for `selected-window'. -The activated perspective is available with `get-current-persp'." - :group 'persp-mode - :type 'hook) - -(defcustom persp-before-deactivate-functions nil - "Functions that runs before the current perspective has been deactivated -for selected frame or window. -These functions must take one argument -- a symbol, -if it's 'frame -- perspective will be deactivated for the `selected-frame', -if it's 'window -- perspective will be deactivated for the `selected-window'. -The perspective is available with `get-current-persp'." - :group 'persp-mode - :type 'hook) - -(defcustom persp-before-save-state-to-file-functions nil - "Functions to run before saving perspectives to a file. -Each function in this list will be called with 3 arguments: -1) a file name to which perspectives will be saved; -2) a hash with perspectives; -3) a bool argument indicating if the persp-file parameter of perspectives - must be set." - :group 'persp-mode - :type 'hook) - -(defcustom persp-after-load-state-functions - (list #'(lambda (file phash persp-names) - (when (eq phash *persp-hash*) - (persp-update-frames-window-confs persp-names)))) - "Functions that runs after perspectives state was loaded. -These functions must take 3 arguments: -1) a file from which the state was loaded; -2) a hash in which loaded perspectives were placed; -3) list of names of perspectives that was loaded." - :group 'persp-mode - :type 'hook) - -(defcustom persp-use-workgroups (and (version< emacs-version "24.4") - (locate-library "workgroups")) - "If t -- use the workgroups.el package for saving/restoring -windows configurations." - :group 'persp-mode - :type 'boolean - :set - #'(lambda (sym val) - (custom-set-default sym val) - ;; require workgroups if we are going to use it - (when persp-use-workgroups - ;;(require 'workgroups) - (unless (fboundp 'wg-make-wconfig) - (autoload 'wg-make-wconfig "workgroups" - "Return a new Workgroups window config from `selected-frame'." )) - (unless (fboundp 'wg-restore-wconfig) - (autoload 'wg-restore-wconfig "workgroups" - "Restore WCONFIG in `selected-frame'." ))))) - -(defcustom persp-restore-window-conf-method t - "Defines how to restore window configurations for the new frames: -t -- the standard action. -function -- run that function." - :group 'persp-mode - :type - '(choice - (const :tag "Standard action" :value t) - (const :tag "Do nothing" :value nil) - (function :tag "Run function" - :value (lambda (frame persp new-frame-p) nil)))) - -(defcustom persp-restore-window-conf-filter-functions - (list #'(lambda (f p new-f-p) - (or (null f) - (frame-parameter f 'persp-ignore-wconf) - (let ((old-piw (frame-parameter f 'persp-ignore-wconf-once))) - (when old-piw - (set-frame-parameter f 'persp-ignore-wconf-once nil) - old-piw))))) - "The list of functions which takes a frame, persp and new-frame-p as arguments. -If one of these functions return a non nil value then the window configuration -of the persp will not be restored for the frame" - :group 'persp-mode - :type 'hook) - -(defcustom persp-window-state-get-function - (if persp-use-workgroups - #'(lambda (&optional frame rwin) - (when (or frame (setq frame (selected-frame))) - (with-selected-frame frame (wg-make-wconfig)))) - (if (version< emacs-version "24.4") - #'(lambda (&optional frame rwin) - (when (or rwin (setq rwin (frame-root-window - (or frame (selected-frame))))) - (when (fboundp 'window-state-get) - (window-state-get rwin)))) - #'(lambda (&optional frame rwin) - (when (or rwin (setq rwin (frame-root-window - (or frame (selected-frame))))) - (window-state-get rwin t))))) - "Function for getting a window configuration of a frame, accept -two optional arguments: -first -- a frame(default is the selected one) -second -- a root window(default is the root window of the selected frame)." - :group 'persp-mode - :type 'function) - -(defcustom persp-window-state-put-function - (if persp-use-workgroups - #'(lambda (pwc &optional frame rwin) - (when (or frame (setq frame (selected-frame))) - (with-selected-frame frame - (cl-letf (((symbol-function 'wg-switch-to-window-buffer) - #'(lambda (win) - "Switch to a buffer determined from WIN's fname and bname. -Return the buffer if it was found, nil otherwise." - (wg-abind - win (fname bname) - (cond ((wg-awhen (get-buffer bname) - (persp-switch-to-buffer it))) - (t (persp-switch-to-buffer wg-default-buffer) - nil)))))) - (wg-restore-wconfig pwc))))) - #'(lambda (pwc &optional frame rwin) - (when (or rwin (setq rwin (frame-root-window - (or frame (selected-frame))))) - (when (fboundp 'window-state-put) - (window-state-put pwc rwin t))))) - "Function for restoring a window configuration. Accept a window configuration -obtained by the `persp-window-state-get-function' and two optional arguments: -one -- a frame(default is the selected frame) -and another -- root window(default is the root window of the selected frame)." - :group 'persp-mode - :type 'function) - -(defcustom persp-buffer-list-function (symbol-function 'buffer-list) - "The function that is used mostly internally by persp-mode functions -to get a list of all buffers." - :group 'persp-mode - :type 'function) - -(defcustom persp-dont-count-weaks-in-restricted-buffer-list nil - "if t -- dont count weak perspectives in `persp-buffer-list-restricted'. -For now it makes any effect only if the value of -the `*persp-restrict-buffers-to*' and friends is 2, 2.5, 3 or 3.5." - :group 'persp-mode - :type 'boolean) - -(defcustom persp-auto-persp-alist nil - "Alist of auto-persp definitions." - :group 'persp-mode - :tag "Auto perspectives" - :type '(alist :key-type (string :tag "Name") - :value-type (alist :tag "Parameters" - :key-type (symbol :tag "Keyword")))) - - -;; Global variables: - -;; check if the initial-buffer-choice may be a function (emacs >= 24.4) -(defvar persp-is-ibc-as-f-supported - (or - (not (version< emacs-version "24.4")) - (not - (null - (assq 'function - (cdr (cl-getf (symbol-plist 'initial-buffer-choice) 'custom-type)))))) - "t if the `initial-buffer-choice' as a function is supported in your emacs, -otherwise nil.") - -(defvar persp-minor-mode-menu nil - "Menu for the persp-mode.") - -(defvar *persp-hash* nil - "The hash table that contain perspectives.") - -(defvar persp-names-cache (when *persp-hash* (persp-names)) - "List of perspective names. -Used by the `persp-read-persp' and other UI functions, so it can be used -to alter the order of perspective names present to user. To achieve that -you must add functions to `persp-created-functions', `persp-renamed-functions', -`persp-before-kill-functions', `persp-before-switch-functions' and -`persp-after-load-state-functions' or just set the -`persp-names-sort-before-read-function'.") - -(defcustom persp-names-sort-before-read-function nil - "Function(or nil) to sort `persp-names-cache' before prompting a user for a -perspective name(s). The function must take a list of perspective names and -return a sorted list." - :group 'persp-mode - :type '(choice - (const :tag "No sort." :value nil) - (function :tag "Function" :value #'identity))) - -(defvar persp-temporarily-display-buffer nil - "This variable dynamically bound to t inside -the `persp-temporarily-display-buffer'.") - -(defvar persp-saved-read-buffer-function read-buffer-function - "Save the `read-buffer-function' to restore it on deactivation.") - -(defvar persp-last-persp-name persp-nil-name - "The last activated perspective. New frames will be created with -that perspective if `persp-set-last-persp-for-new-frames' is t.") - -(defvar persp-special-last-buffer nil - "Special variable to handle the case when new frames are switching -the selected window to a wrong buffer.") - -(defvar persp-frame-buffer-predicate nil - "Current buffer-predicate.") - -(defvar persp-frame-buffer-predicate-buffer-list-cache nil - "Variable to cache the perspective buffer list for buffer-predicate.") - -(defvar persp-frame-server-switch-hook nil - "Current persp-server-switch-hook.") - -(defvar persp-disable-buffer-restriction-once nil - "The flag used for toggling buffer filtering during read-buffer.") - -(defvar persp-inhibit-switch-for nil - "List of frames/windows for which the switching of perspectives is inhibited.") - -(defvar persp-read-multiple-exit-minibuffer-function #'exit-minibuffer - "Function to call to exit minibuffer when reading multiple candidates.") - -(defvar persp-buffer-props-hash (when persp-mode - (make-hash-table :test #'eq :size 10)) - "Cache to store buffer properties.") - - -(defvar persp-backtrace-frame-function - (if (version< emacs-version "24.4") - #'(lambda (nframes &optional base) - (let ((i (if base - (let ((k 8) found bt) - (while (and (not found) - (setq bt (cadr (funcall #'backtrace-frame - (cl-incf k))))) - ;; (message "%s:%s" k (backtrace-frame k)) - (when (eq bt base) (setq found t))) - (when found (+ nframes (- k 3)))) - (+ nframes 6)))) - (when i - (funcall #'backtrace-frame i)))) - #'backtrace-frame) - "Backtrace function with base argument.") - - -(defcustom persp-switch-wrap t - "Whether `persp-next' and `persp-prev' should wrap." - :group 'persp-mode - :type 'boolean) - - -;; Key bindings: - -(define-prefix-command 'persp-key-map) - -(defvar persp-mode-map (make-sparse-keymap) - "The keymap with a prefix for the persp-mode.") - -(define-key persp-key-map (kbd "n") #'persp-next) -(define-key persp-key-map (kbd "p") #'persp-prev) -(define-key persp-key-map (kbd "s") #'persp-frame-switch) -(define-key persp-key-map (kbd "S") #'persp-window-switch) -(define-key persp-key-map (kbd "r") #'persp-rename) -(define-key persp-key-map (kbd "c") #'persp-copy) -(define-key persp-key-map (kbd "C") #'persp-kill) -(define-key persp-key-map (kbd "z") #'persp-save-and-kill) -(define-key persp-key-map (kbd "a") #'persp-add-buffer) -(define-key persp-key-map (kbd "b") #'persp-switch-to-buffer) -(define-key persp-key-map (kbd "t") #'persp-temporarily-display-buffer) -(define-key persp-key-map (kbd "i") #'persp-import-buffers) -(define-key persp-key-map (kbd "I") #'persp-import-win-conf) -(define-key persp-key-map (kbd "k") #'persp-remove-buffer) -(define-key persp-key-map (kbd "K") #'persp-kill-buffer) -(define-key persp-key-map (kbd "w") #'persp-save-state-to-file) -(define-key persp-key-map (kbd "W") #'persp-save-to-file-by-names) -(define-key persp-key-map (kbd "l") #'persp-load-state-from-file) -(define-key persp-key-map (kbd "L") #'persp-load-from-file-by-names) -(define-key persp-key-map (kbd "o") #'(lambda () - (interactive) - (persp-mode -1))) - - -(defun persp-set-keymap-prefix (prefix) - (interactive - (list - (read-key-sequence - "Now press a key sequence to be used as the persp-key-map prefix: "))) - (when prefix - (when (boundp 'persp-keymap-prefix) - (substitute-key-definition 'persp-key-map nil persp-mode-map)) - (define-key persp-mode-map prefix 'persp-key-map) - (custom-set-default 'persp-keymap-prefix prefix))) - -(defcustom persp-keymap-prefix (kbd "C-c p") - "The prefix for activating the persp-mode keymap." - :group 'persp-mode - :type 'key-sequence - :set #'(lambda (sym val) (persp-set-keymap-prefix val))) - -;; TODO: remove this function -(defun persp-set-toggle-read-buffer-filter-keys (keys) - (interactive - (list - (read-key-sequence - "Now press a key sequence to be used for toggling persp filters during the read-buffer: "))) - (setcdr (assq 'toggle-persp-buffer-filter persp-read-multiple-keys) keys) - (custom-set-default 'persp-toggle-read-buffer-filter-keys keys)) -(define-obsolete-function-alias - 'persp-set-toggle-read-persp-filter-keys - 'persp-set-toggle-read-buffer-filter-keys - "persp-mode 2.9") - -(defcustom persp-read-multiple-keys - `((toggle-persp-buffer-filter . ,(kbd "C-x C-p")) - (push-item . ,(kbd "C-")) - (pop-item . ,(kbd "M-"))) - "Keybindings to use while prompting for multiple items." - :group 'persp-mode - :tag "Keys for reading multiple items" - :type '(alist :key-type symbol :value-type key-sequence)) - -(define-obsolete-variable-alias - 'persp-toggle-read-persp-filter-keys 'persp-toggle-read-buffer-filter-keys - "persp-mode 2.9") -(defcustom persp-toggle-read-buffer-filter-keys (kbd "C-x C-p") - "Keysequence to toggle the buffer filtering during read-buffer." - :group 'persp-mode - :type 'key-sequence - :set #'(lambda (sym val) - (persp-set-toggle-read-buffer-filter-keys val))) - - -;; Perspective struct: - -(cl-defstruct (perspective - (:conc-name persp-) - (:constructor make-persp)) - (name "") - (buffers nil) - (window-conf nil) - ;; reserved parameters: dont-save-to-file, persp-file. - (parameters nil) - (weak nil) - (auto nil) - (hidden nil)) - -(defun persp-p (obj) - (or (null obj) (perspective-p obj))) - -(defvar persp-nil-wconf nil - "Window configuration for the `nil' perspective.") - -(defvar persp-nil-parameters nil - "Parameters of the `nil' perspective.") - -(defvar persp-nil-hidden nil - "Hidden filed for the `nil' perspective.") - -(defun persp-buffer-list (&optional frame window) - (safe-persp-buffers (get-current-persp frame window))) - -(cl-defun persp-buffer-list-restricted - (&optional - (frame (selected-frame)) (option *persp-restrict-buffers-to*) - (option-foreign-override persp-restrict-buffers-to-if-foreign-buffer) - sure-not-killing) - (unless frame (setq frame (selected-frame))) - (unless option (setq option 0)) - (let* ((cpersp (get-current-persp frame)) - (curbuf (current-buffer)) - (cb-foreign (not (persp-contain-buffer-p curbuf cpersp)))) - (when (and option-foreign-override cb-foreign) - (setq option option-foreign-override)) - (cl-typecase option - (function (funcall option frame)) - (t - (when (= option 2.5) - (setq option (if (null cpersp) -1 2))) - (when (= option 3.5) - (setq option (if (null cpersp) -1 3))) - (let ((bl - (cl-case option - (-1 - (funcall persp-buffer-list-function frame)) - (0 - (if cpersp - (cl-copy-list (persp-buffers cpersp)) - (funcall persp-buffer-list-function frame))) - (1 - (let ((ret (if cpersp - (let ((pbs (cl-copy-list (persp-buffers cpersp)))) - (cl-delete-if - #'(lambda (b) (let ((cns (memq b pbs))) - (when cns - (setcar cns (cadr cns)) - (setcdr cns (cddr cns)) - t))) - (funcall persp-buffer-list-function frame))) - nil))) - (unless (persp-contain-buffer-p curbuf cpersp) - (setq ret (cons curbuf (cl-delete curbuf ret :count 1)))) - ret)) - (2 - (let ((ret - (cl-delete-if - #'(lambda (b) - (persp-buffer-in-other-p* - b cpersp - persp-dont-count-weaks-in-restricted-buffer-list)) - (if cpersp - (cl-copy-list (persp-buffers cpersp)) - (funcall persp-buffer-list-function frame))))) - ret)) - (3 - (let ((ret - (cl-delete-if - #'(lambda (b) - (or - (and cpersp - (persp-contain-buffer-p b cpersp)) - (persp-buffer-in-other-p* - b cpersp - persp-dont-count-weaks-in-restricted-buffer-list))) - (funcall persp-buffer-list-function frame)))) - ret))))) - (when persp-buffer-list-restricted-filter-functions - (setq bl - (cl-delete-if #'(lambda (b) - (persp-buffer-filtered-out-p - b persp-buffer-list-restricted-filter-functions)) - bl))) - (when (and - (not sure-not-killing) cpersp - (symbolp this-command) - persp-kill-foreign-buffer-behaviour - (string-match-p "^.*?kill-buffer.*?$" (symbol-name this-command)) - (not (memq curbuf bl)) - ;; TODO: remove this - ;; (not (persp-buffer-filtered-out-p curbuf)) - ) - (push curbuf bl)) - bl))))) - -(cl-defmacro with-persp-buffer-list - ((&key - (buffer-list-function persp-buffer-list-function) - (restriction *persp-restrict-buffers-to*) - (restriction-foreign-override persp-restrict-buffers-to-if-foreign-buffer) - sortp cache) - &rest body) - (let ((pblf-body `(persp-buffer-list-restricted frame))) - (when sortp (setq pblf-body `(sort ,pblf-body (with-no-warnings ,sortp)))) - `(let ((*persp-restrict-buffers-to* ,restriction) - (persp-restrict-buffers-to-if-foreign-buffer - ,restriction-foreign-override) - ,@(if cache `(persp-buffer-list-cache) nil)) - (cl-letf (((symbol-function 'buffer-list) - #'(lambda (&optional frame) - ,(if cache - `(if persp-buffer-list-cache - persp-buffer-list-cache - (setq persp-buffer-list-cache ,pblf-body)) - pblf-body)))) - ,@body)))) - -(cl-defmacro with-persp-read-buffer ((&key multiple (default-mode t)) &rest body) - `(let ((read-buffer-function #'persp-read-buffer)) - ,@body)) - -(defmacro with-persp-ido-hooks (&rest body) - `(let ((ido-make-buffer-list-hook ido-make-buffer-list-hook) - (ido-setup-hook ido-setup-hook)) - (persp-set-ido-hooks t) - ,@body)) - -;; TODO: rename -(defun safe-persp-name (p) - (if p (persp-name p) - persp-nil-name)) - -;; TODO: rename -(defun safe-persp-buffers (p) - (if p (persp-buffers p) - (funcall persp-buffer-list-function))) - -;; TODO: rename -(defun safe-persp-window-conf (p) - (if p (persp-window-conf p) - persp-nil-wconf)) - -;; TODO: rename -(defun safe-persp-parameters (p) - (if p (persp-parameters p) - persp-nil-parameters)) - -;; TODO: rename -(defun safe-persp-weak (p) - (if p (persp-weak p) - t)) - -;; TODO: rename -(defun safe-persp-auto (p) - (if p (persp-auto p) - nil)) - -;; TODO: rename -(defun safe-persp-hidden (p) - (if p (persp-hidden p) - persp-nil-hidden)) - - -;; TODO: rename -(cl-defun modify-persp-parameters (alist &optional (persp (get-current-persp))) - (cl-loop for (name . value) in alist - do (set-persp-parameter name value persp))) - -;; TODO: rename -(cl-defun set-persp-parameter - (param-name &optional value (persp (get-current-persp))) - (let* ((params (safe-persp-parameters persp)) - (old-cons (assq param-name params))) - (if old-cons - (setcdr old-cons value) - (if persp - (setf (persp-parameters persp) - (push (cons param-name value) params)) - (setq persp-nil-parameters - (push (cons param-name value) params)))))) - -(cl-defun persp-parameter (param-name &optional (persp (get-current-persp))) - (alist-get param-name (safe-persp-parameters persp))) - -;; TODO: rename -(cl-defun delete-persp-parameter (param-name &optional (persp (get-current-persp))) - (when (and (not (null param-name)) (symbolp param-name)) - (if persp - (setf (persp-parameters persp) - (delq (assq param-name (persp-parameters persp)) - (persp-parameters persp))) - (setq persp-nil-parameters - (delq (assq param-name persp-nil-parameters) - persp-nil-parameters))))) - -(defun persp--buffer-in-persps (buf) - (cdr (assq 'persp-buffer-in-persps - (gethash buf persp-buffer-props-hash)))) - -(defun persp--buffer-in-persps-set (buf persps) - (let* ((buf-props (gethash buf persp-buffer-props-hash)) - (cons (assq 'persp-buffer-in-persps buf-props))) - (if cons - (setf (cdr cons) persps) - (setq cons (cons 'persp-buffer-in-persps persps)) - (push cons buf-props) - (puthash buf buf-props persp-buffer-props-hash)))) - -(defun persp--buffer-in-persps-add (buf persp) - (persp--buffer-in-persps-set - buf (cons persp (persp--buffer-in-persps buf)))) - -(defun persp--buffer-in-persps-remove (buf persp) - (persp--buffer-in-persps-set - buf (delq persp (persp--buffer-in-persps buf)))) - - -;; Used in mode defenition: - -(defun persp-mode-restore-and-remove-from-make-frame-hook (&optional f) - (remove-hook 'after-make-frame-functions - #'persp-mode-restore-and-remove-from-make-frame-hook) - (if (> persp-auto-resume-time 0) - (run-at-time - persp-auto-resume-time nil - #'(lambda () - (remove-hook 'find-file-hook - #'persp-special-last-buffer-make-current) - (when (> persp-auto-resume-time 0) - (condition-case-unless-debug err - (persp-load-state-from-file) - (error - (message - "[persp-mode] Error: Can not autoresume perspectives -- %S" - err))) - (when (persp-get-buffer-or-null persp-special-last-buffer) - (persp-switch-to-buffer persp-special-last-buffer))))) - (remove-hook 'find-file-hook - #'persp-special-last-buffer-make-current))) - -(defun persp-asave-on-exit (&optional interactive-query opt) - (when persp-mode - (when (null opt) - (setq opt 0)) - (if (> persp-auto-save-opt opt) - (condition-case-unless-debug err - (persp-save-state-to-file) - (error - (message "[persp-mode] Error: Can not autosave perspectives -- %S" - err) - (when (or noninteractive - (progn - (when (null (persp-frame-list-without-daemon)) - (make-frame)) - (null (persp-frame-list-without-daemon)))) - (setq interactive-query nil)) - (if interactive-query - (yes-or-no-p - "persp-mode can not save perspectives, do you want to exit anyway?") - t))) - t))) -(defun persp-kill-emacs-h () - (persp-asave-on-exit nil)) - -(defun persp-kill-emacs-query-function () - (if persp-mode - (when (persp-asave-on-exit t) - (remove-hook 'kill-emacs-hook #'persp-kill-emacs-h) - t) - t)) - -(defun persp-special-last-buffer-make-current () - (setq persp-special-last-buffer (current-buffer))) - - -;; Auto persp functions: - -(defun persp-auto-persp-parameters (name) - (cdr (assoc name persp-auto-persp-alist))) -(defun persp--auto-persp-pickup-buffer (a-p-def buffer) - (let ((action (alist-get :main-action a-p-def))) - (when (functionp action) - (funcall action buffer)))) -(defun persp-auto-persp-pickup-bufferlist-for (name bufferlist) - (let ((a-p-def (persp-auto-persp-parameters name))) - (when a-p-def - (mapc (apply-partially #'persp--auto-persp-pickup-buffer a-p-def) - bufferlist)))) -(defun persp-auto-persps-pickup-bufferlist (bufferlist) - (mapc - #'(lambda (name) (persp-auto-persp-pickup-bufferlist-for name bufferlist)) - (mapcar #'car persp-auto-persp-alist))) -(defun persp-auto-persp-pickup-buffers-for (name) - (persp-auto-persp-pickup-bufferlist-for name - (funcall persp-buffer-list-function))) -(defun persp-auto-persps-pickup-buffers () - (interactive) - (persp-auto-persps-pickup-bufferlist (funcall persp-buffer-list-function))) - -(defun persp-buffer-match-auto-persp-p (buffer-or-name) - (let ((buffer (persp-get-buffer-or-null buffer-or-name)) - pred) - (car-safe - (cl-find-if #'(lambda (a-p-def) - (and (setq pred (alist-get :generated-predicate a-p-def)) - (funcall pred buffer))) - persp-auto-persp-alist - :key #'cdr)))) -(defun persp-auto-persps-for-buffer (buffer-or-name) - (let ((buffer (persp-get-buffer-or-null buffer-or-name))) - (cl-remove-if #'(lambda (pred) (funcall pred buffer)) - persp-auto-persp-alist - :key #'(lambda (a-p-cons) - (alist-get :generated-predicate (cdr a-p-cons)))))) - -(defun persp-auto-persp-activate-hooks (name) - (let ((hooks - (alist-get :hooks - (persp-auto-persp-parameters name)))) - (mapc #'(lambda (hook-cons) - (add-hook (car hook-cons) (cdr hook-cons))) - hooks))) -(defun persp-auto-persp-deactivate-hooks (name) - (let ((hooks - (alist-get :hooks - (persp-auto-persp-parameters name)))) - (mapc #'(lambda (hook-cons) - (remove-hook (car hook-cons) (cdr hook-cons))) - hooks))) -(defun persp-auto-persps-activate-hooks () - (mapc #'persp-auto-persp-activate-hooks - (mapcar #'car persp-auto-persp-alist))) -(defun persp-auto-persps-deactivate-hooks () - (mapc #'persp-auto-persp-deactivate-hooks - (mapcar #'car persp-auto-persp-alist))) - -(defsubst persp--generate-predicate-loop-any-all - (items-list condition &rest body) - (if items-list - (let (all noquote) - (setq items-list - (cl-typecase items-list - (function (list items-list)) - (list (if (persp-regexp-p items-list) (list items-list) items-list)) - (t (list items-list)))) - (setq noquote (eq :noquote (car items-list))) - (when noquote (setq items-list (cadr items-list))) - (when (listp items-list) - (setq all (eq :all (car items-list))) - (when all (pop items-list)) - (unless noquote (setq items-list `',items-list))) - (let* ((cnd `(cl-member-if - #'(lambda (item) - (setq cond-result - ,(if all - `(not ,condition) - condition))) - ,items-list))) - `(let (cond-result) - (when ,(if all `(not ,cnd) cnd) - ,@body)))) - `(let (cond-result) - ,@body))) -(cl-defun persp--generate-buffer-predicate - (&key - buffer-name file-name mode mode-name minor-mode minor-mode-name predicate - (true-value (if predicate 'cond-result t)) - &allow-other-keys) - (let ((predicate-body true-value)) - (when predicate - (setq predicate-body - (persp--generate-predicate-loop-any-all - predicate '(apply item buffer rest-args) predicate-body))) - (when file-name - (setq predicate-body - (persp--generate-predicate-loop-any-all - file-name '(persp-string-match-p item (buffer-file-name buffer)) - predicate-body))) - (when buffer-name - (setq predicate-body - (persp--generate-predicate-loop-any-all - buffer-name '(persp-string-match-p item (buffer-name buffer)) - predicate-body))) - (when minor-mode-name - (setq predicate-body - (persp--generate-predicate-loop-any-all - minor-mode-name - `(let ((regexp item)) - ,(persp--generate-predicate-loop-any-all - '(:noquote minor-mode-alist) - '(persp-string-match-p regexp (format-mode-line item)) - t)) - predicate-body))) - (when minor-mode - (setq predicate-body - (persp--generate-predicate-loop-any-all - minor-mode - `(cond - ((symbolp item) (bound-and-true-p item)) - ((persp-regexp-p item) (let ((regexp item)) - ,(persp--generate-predicate-loop-any-all - '(:noquote minor-mode-list) - '(and - (bound-and-true-p item) - (persp-string-match-p regexp item)) - t))) - (t nil)) - predicate-body))) - - (when mode-name - (setq predicate-body - (persp--generate-predicate-loop-any-all - mode-name '(persp-string-match-p item (format-mode-line mode-name)) - predicate-body))) - (when mode - (setq predicate-body - (persp--generate-predicate-loop-any-all - mode '(cond - ((symbolp item) (eq item major-mode)) - ((persp-regexp-p item) - (persp-string-match-p item (symbol-name major-mode))) - (t nil)) - predicate-body))) - (eval `(lambda (buffer &rest rest-args) - (when (buffer-live-p buffer) - (with-current-buffer buffer ,predicate-body)))))) - -(defun persp--auto-persp-default-on-match (state) - (persp-add-buffer (alist-get 'buffer state) - (alist-get 'persp state) - nil nil) - state) -(defun persp--auto-persp-default-after-match (state) - (let ((persp (alist-get 'persp state)) - (noauto (alist-get :noauto state)) - (weak (alist-get :weak state)) - (parameters (alist-get :parameters state))) - (when persp - (when (not noauto) - (setf (persp-auto persp) t)) - (when weak - (setf (persp-weak persp) t)) - (modify-persp-parameters parameters persp))) - (let ((persp-name (alist-get 'persp-name state)) - (switch (alist-get :switch state))) - (persp-unhide persp-name) - (cl-case switch - ('nil nil) - (window (persp-window-switch persp-name)) - (frame (persp-frame-switch persp-name)) - (t (persp-switch persp-name))) - (when switch - (persp-switch-to-buffer (alist-get 'buffer state)))) - state) - -;;;###autoload -(cl-defun persp-def-auto-persp - (name &rest keyargs - &key buffer-name file-name mode mode-name minor-mode minor-mode-name - predicate hooks dyn-env get-name get-buffer get-persp - switch parameters noauto weak user-data - on-match after-match dont-pick-up-buffers delete) - - (if delete - (let ((ap-cons (assoc name persp-auto-persp-alist))) - (persp-auto-persp-deactivate-hooks name) - (setq persp-auto-persp-alist - (delq ap-cons persp-auto-persp-alist))) - - (let (auto-persp-parameters - generated-predicate generated-hook - hook-body main-action) - - (cl-loop for (key val) on keyargs by #'cddr - when (and val (not (or (eq key :dont-pick-up-buffers)))) - do (push - (cons key - (if (and (functionp val) - (not (or (eq key :mode) (eq key :minor-mode))) - (null (byte-code-function-p val))) - val ;;(byte-compile val) - val)) - auto-persp-parameters)) - - (unless get-name - (push (cons :get-name - (byte-compile - `(lambda (state) - (push (cons 'persp-name ,name) state) - state))) - auto-persp-parameters)) - - (unless get-persp - (push (cons :get-persp - #'(lambda (state) - (let ((name (alist-get 'persp-name state))) - (when name - (push (cons 'persp (persp-add-new name)) - state))) - state)) - auto-persp-parameters)) - - (unless get-buffer - (push (cons :get-buffer - #'(lambda (state) - (push (cons 'buffer (current-buffer)) - state) - state)) - auto-persp-parameters)) - - (unless on-match - (push (cons :on-match - #'persp--auto-persp-default-on-match) - auto-persp-parameters)) - - (unless after-match - (push (cons :after-match - #'persp--auto-persp-default-after-match) - auto-persp-parameters)) - - (when (or (null hooks) (not (consp hooks))) - (unless hooks - (setq hooks - (when minor-mode - (intern (concat (symbol-name minor-mode) - "-hook"))))) - (unless hooks - (setq hooks - (cond - (mode - (intern (concat (symbol-name mode) - "-hook"))) - (minor-mode - (intern (concat (symbol-name minor-mode) - "-hook"))) - ((or mode-name predicate buffer-name) - 'after-change-major-mode-hook) - (file-name 'find-file-hook) - (t 'after-change-major-mode-hook)))) - - (when (and hooks (not (consp hooks))) - (setq hooks (list hooks))) - - (push (cons :hooks hooks) auto-persp-parameters)) - - (setq generated-predicate - (apply #'persp--generate-buffer-predicate - (if predicate - keyargs - (cons :true-value (cons '(car rest-args) keyargs))))) - (push (cons :generated-predicate generated-predicate) - auto-persp-parameters) - - (setq main-action - (eval - `(lambda (&optional buffer hook hook-args) - (let (,@dyn-env) - (let* ((state (copy-alist - (persp-auto-persp-parameters ,name)))) - (push (cons 'hook hook) state) - (push (cons 'hook-args hook-args) state) - (if buffer - (push (cons 'buffer buffer) state) - (let ((get-buffer - (alist-get :get-buffer state))) - (setq state (funcall get-buffer state)))) - (when - (setq state - (funcall (alist-get :generated-predicate state) - (alist-get 'buffer state) state)) - (with-current-buffer (alist-get 'buffer state) - (let ((get-name - (alist-get :get-name state))) - (setq state (funcall get-name state))) - (let ((get-persp - (alist-get :get-persp state))) - (setq state (funcall get-persp state))) - (let ((on-match (alist-get :on-match state))) - (when on-match - (setq state (funcall on-match state)) - (let ((after-match (alist-get :after-match state))) - (when after-match - (setq state (funcall after-match state))))))))))))) - (push (cons :main-action main-action) auto-persp-parameters) - - (when hooks - (let ((aparams-hooks (assq :hooks auto-persp-parameters))) - (dolist (hook hooks) - (setq generated-hook - (with-no-warnings - (let ((warning-minimum-level :emergency) - byte-compile-warnings) - (byte-compile - `(lambda (&rest hook-args) - (when persp-mode - (funcall (with-no-warnings ',main-action) - nil ',hook hook-args))))))) - (setcdr aparams-hooks (delete hook (cdr aparams-hooks))) - (push (cons hook generated-hook) (cdr aparams-hooks))))) - - (let ((auto-persp-definition (assoc name persp-auto-persp-alist))) - (if auto-persp-definition - (progn - (persp-auto-persp-deactivate-hooks name) - (setcdr auto-persp-definition auto-persp-parameters)) - (setq auto-persp-definition (cons name auto-persp-parameters)) - (push auto-persp-definition persp-auto-persp-alist))) - - (persp-auto-persp-activate-hooks name) - - (unless dont-pick-up-buffers - (persp-auto-persp-pickup-buffers-for name))))) - -;;;###autoload -(define-obsolete-function-alias 'def-auto-persp 'persp-def-auto-persp - "persp-mode 2.9.6") - - -;; Custom save/load functions: - -;;;###autoload -(cl-defun persp-def-buffer-save/load - (&rest - keyargs - &key buffer-name file-name mode mode-name minor-mode minor-mode-name - predicate tag-symbol save-vars save-function load-function after-load-function - mode-restore-function - append) - (let ((generated-save-predicate - (apply #'persp--generate-buffer-predicate keyargs)) - save-body load-fun) - (when save-vars - (unless (listp save-vars) (setq save-vars (list save-vars))) - (when (and (or mode mode-name) (not (memq 'major-mode save-vars))) - (push 'major-mode save-vars))) - (unless tag-symbol (setq tag-symbol 'def-buffer-with-vars)) - - (setq save-body - `(let ((vars-list - (with-current-buffer buffer - (cl-delete-if-not - #'(lambda (lvar) - (and - ,(persp--generate-predicate-loop-any-all - save-vars - '(if (persp-regexp-p item) - (persp-string-match-p item - (symbol-name lvar)) - (eq item lvar)) - t) - (persp-elisp-object-readable-p - (symbol-value lvar)))) - (buffer-local-variables) - :key #'car-safe)))) - ,(if save-function - `(funcall (with-no-warnings ',save-function) - buffer ',tag-symbol vars-list) - `(list ',tag-symbol (buffer-name buffer) vars-list))) - save-body `(when (funcall (with-no-warnings ',generated-save-predicate) - buffer) - ,save-body)) - - (setq load-fun - `(lambda (savelist) - (cl-destructuring-bind - (buffer-name vars-list &rest _rest) (cdr savelist) - (let ((buf-file (alist-get 'buffer-file-name vars-list)) - (buf-mmode (alist-get 'major-mode vars-list))) - ,(when mode-restore-function - `(push (cons 'persp-load-buffer-mode-restore-function - (with-no-warnings ',mode-restore-function)) - vars-list)) - (let ((persp-loaded-buffer - (persp-buffer-from-savelist - (list 'def-buffer buffer-name buf-file buf-mmode - (list (cons 'local-vars vars-list))))) - (persp-after-load-function (with-no-warnings - ',after-load-function)) - persp-after-load-lambda) - (when (and persp-loaded-buffer persp-after-load-function) - (setq persp-after-load-lambda - #'(lambda (&rest pall-args) - (apply persp-after-load-function - persp-loaded-buffer pall-args) - (remove-hook 'persp-after-load-state-functions - persp-after-load-lambda))) - (add-hook 'persp-after-load-state-functions - persp-after-load-lambda t)) - persp-loaded-buffer))))) - - (add-hook 'persp-save-buffer-functions - (eval `(lambda (buffer) ,save-body)) append) - (add-hook 'persp-load-buffer-functions - (eval - `(lambda (savelist) - (when (eq (car savelist) ',tag-symbol) - (let ((default-load-fun (with-no-warnings ',load-fun))) - ,(if load-function - `(funcall (with-no-warnings ',load-function) - savelist default-load-fun - (with-no-warnings ',after-load-function)) - `(funcall default-load-fun savelist)))))) - append))) - -;;;###autoload -(define-obsolete-function-alias - 'def-persp-buffer-save/load 'persp-def-buffer-save/load - "persp-mode 2.9.6") - - -;; Mode itself: - -;;;###autoload -(define-minor-mode persp-mode - "Toggle the persp-mode. -When active, keeps track of multiple 'perspectives', -named collections of buffers and window configurations. -Here is a keymap of this minor mode: -\\{persp-mode-map}" - :require 'persp-mode - :group 'persp-mode - :keymap persp-mode-map - :init-value nil - :global t - :lighter (:eval persp-lighter) - (if persp-mode - (when (or (eq 'persp-force-restart persp-mode) (null *persp-hash*)) - (setq persp-special-last-buffer nil) - (add-hook 'find-file-hook #'persp-special-last-buffer-make-current) - - (setq *persp-hash* (make-hash-table :test #'equal :size 10)) - (setq persp-buffer-props-hash (make-hash-table :test #'eq :size 10)) - (setq persp-names-cache nil) - - (push '(persp . writable) window-persistent-parameters) - - (persp-add-minor-mode-menu) - (persp-add-new persp-nil-name) - - (add-hook 'find-file-hook #'persp-add-or-not-on-find-file) - (add-hook 'kill-buffer-query-functions #'persp-kill-buffer-query-function) - (add-hook 'kill-buffer-hook #'persp-kill-buffer-h) - (add-hook 'before-make-frame-hook #'persp-before-make-frame) - (add-hook 'after-make-frame-functions #'persp-init-new-frame) - (add-hook 'delete-frame-functions #'persp-delete-frame) - (add-hook 'kill-emacs-query-functions #'persp-kill-emacs-query-function) - (add-hook 'kill-emacs-hook #'persp-kill-emacs-h) - (add-hook 'server-switch-hook #'persp-server-switch) - (add-hook 'after-change-major-mode-hook #'persp-after-change-major-mode-h) - - (persp-set-ido-hooks persp-set-ido-hooks) - (persp-set-read-buffer-function persp-set-read-buffer-function) - - (persp-update-completion-system persp-interactive-completion-system) - - (condition-case-unless-debug err - (mapc #'persp-init-frame (persp-frame-list-without-daemon)) - (error - (message "[persp-mode] Error: Can not initialize frame -- %S" - err))) - - (when (fboundp 'tabbar-mode) - (setq tabbar-buffer-list-function #'persp-buffer-list)) - - (persp-auto-persps-activate-hooks) - - (if (or noninteractive - (and (daemonp) - (null (cdr (frame-list))) - (eq (selected-frame) terminal-frame))) - (add-hook 'after-make-frame-functions - #'persp-mode-restore-and-remove-from-make-frame-hook) - (persp-mode-restore-and-remove-from-make-frame-hook))) - - (run-hooks 'persp-mode-deactivated-hook) - (unless (memq #'persp-mode-restore-and-remove-from-make-frame-hook - after-make-frame-functions) - (persp-asave-on-exit t 1)) - - (remove-hook 'find-file-hook #'persp-add-or-not-on-find-file) - (remove-hook 'kill-buffer-query-functions #'persp-kill-buffer-query-function) - (remove-hook 'kill-buffer-hook #'persp-kill-buffer-h) - (remove-hook 'before-make-frame-hook #'persp-before-make-frame) - (remove-hook 'after-make-frame-functions #'persp-init-new-frame) - (remove-hook 'delete-frame-functions #'persp-delete-frame) - (remove-hook 'kill-emacs-query-functions #'persp-kill-emacs-query-function) - (remove-hook 'kill-emacs-hook #'persp-kill-emacs-h) - (remove-hook 'server-switch-hook #'persp-server-switch) - (remove-hook 'after-change-major-mode-hook #'persp-after-change-major-mode-h) - - (persp-set-ido-hooks) - (persp-set-read-buffer-function) - (persp-update-frames-buffer-predicate t) - (persp-update-completion-system nil t) - - (persp-auto-persps-deactivate-hooks) - - (when (fboundp 'tabbar-mode) - (setq tabbar-buffer-list-function #'tabbar-buffer-list)) - - (setq window-persistent-parameters - (delq (assq 'persp window-persistent-parameters) - window-persistent-parameters)) - - ;; TODO: do it properly -- remove buffers, kill perspectives - (setq *persp-hash* nil) - (setq persp-buffer-props-hash nil) - (setq persp-names-cache nil))) - - -;; Hooks: - -(defun persp--kill-buffer-query-function-foreign-check (persp buf) - (let ((opt persp-kill-foreign-buffer-behaviour)) - (cond - ((functionp opt) (funcall opt)) - (t - (if (cl-case opt - ((kill nil) t) - (dont-ask-weak (persp-buffer-free-p buf t)) - (t (persp-buffer-filtered-out-p buf))) - 'kill - (let ((curwin (selected-window)) - (prompt (format "You are going to kill a buffer(%s) \ -which is not in the current(%s) perspective. It will be removed from \ -%s perspectives and then killed.\nWhat do you really want to do? " - (buffer-name buf) - (safe-persp-name persp) - (mapcar #'persp-name - (persp--buffer-in-persps buf))))) - (cl-macrolet - ((clwin (w) - `(run-at-time 1 nil #'(lambda (ww) - (when (window-live-p ww) - (delete-window ww))) - ,w)) - (swb (b w) - `(run-at-time - 1 nil - #'(lambda (bb ww) - (with-selected-window ww - (persp-set-another-buffer-for-window - bb ww))) - ,b ,w))) - (cl-destructuring-bind (char &rest _) - (let ((variants - (list '(?q "do nothing") - '(?k "kill") - '(?K "kill and close window") - '(?c "close window") - '(?s "switch to another buffer"))) - (cwin (selected-window))) - (when (minibuffer-window-active-p cwin) - (setq cwin (minibuffer-selected-window))) - (unless (eq buf (window-buffer cwin)) - (setq variants - (delq (assq ?K variants) - (delq (assq ?c variants) - (delq (assq ?s variants) variants))))) - (read-multiple-choice prompt variants)) - (cl-case char - ((?q ?\C-g ?\C-\[) nil) - (?k 'kill) - (?K (clwin curwin) 'kill) - (?c (clwin curwin) nil) - (?s (swb buf curwin) nil) - (t t)))))))))) - -(defun persp-kill-buffer-query-function () - "This must be the last hook in the `kill-buffer-query-functions'. -Otherwise if next function in the list returns nil -- the buffer will not be -killed, but just removed from a perspective(s)." - (if persp-mode - (let ((buffer (current-buffer))) - (if (persp--buffer-in-persps buffer) - (let* ((persp (get-current-persp)) - (foreign-check - (if (and persp - (persp-contain-buffer-p buffer persp)) - 'not-foreign - (persp--kill-buffer-query-function-foreign-check - persp buffer)))) - (cl-case foreign-check - (kill - (let (persp-autokill-buffer-on-remove) - (persp--remove-buffer-2 nil buffer)) - t) - (not-foreign - (if (persp-buffer-in-other-p* buffer persp) - (progn (persp--remove-buffer-2 persp buffer) - nil) - (if (or (not (buffer-live-p buffer)) - (persp--buffer-in-persps buffer)) - nil - t) - t)) - (t - nil))) - t)) - t)) - -(defun persp-kill-buffer-h () - (let ((buffer (current-buffer))) - (when (and persp-mode (persp--buffer-in-persps buffer)) - (let (persp-autokill-buffer-on-remove - (persp-when-remove-buffer-switch-to-other-buffer - (unless persp-set-frame-buffer-predicate - persp-when-remove-buffer-switch-to-other-buffer))) - (persp--remove-buffer-2 nil buffer))))) - -(defun persp--restore-buffer-on-find-file () - (when (buffer-live-p persp-special-last-buffer) - (set-window-buffer (or (get-buffer-window) (selected-window)) - persp-special-last-buffer)) - (setq persp-special-last-buffer nil) - (remove-hook 'window-configuration-change-hook - #'persp--restore-buffer-on-find-file)) -(defun persp-add-or-not-on-find-file () - (let ((no-select - (not (funcall persp-backtrace-frame-function 0 'find-file)))) - (and - (cl-case persp-add-buffer-on-find-file - ('nil nil) - (if-not-autopersp - (let ((ret (not (persp-buffer-match-auto-persp-p (current-buffer))))) - (unless (or ret no-select) - (setq persp-special-last-buffer (window-buffer)) - (add-hook 'window-configuration-change-hook - #'persp--restore-buffer-on-find-file)) - ret)) - (add-but-not-switch-if-autopersp - (when (and (not no-select) - (persp-buffer-match-auto-persp-p (current-buffer))) - (setq no-select t) - (setq persp-special-last-buffer (window-buffer)) - (add-hook 'window-configuration-change-hook - #'persp--restore-buffer-on-find-file)) - t) - (t t)) - (persp-add-buffer - (current-buffer) (get-current-persp) (not no-select) nil)))) - -(defun persp-after-change-major-mode-h () - (let ((buf (current-buffer))) - (persp-find-and-set-persps-for-buffer buf) - (when - (and - (cl-case persp-add-buffer-on-after-change-major-mode - ('nil nil) - (free (persp-buffer-free-p buf)) - (t t)) - (not - (persp-buffer-filtered-out-p - buf persp-add-buffer-on-after-change-major-mode-filter-functions))) - (persp-add-buffer buf (get-current-persp) nil nil)))) - -(defun persp-server-switch () - (condition-case-unless-debug err - (let* ((frame (selected-frame)) - (persp-server-switch-hook (frame-parameter - frame 'persp-server-switch-hook))) - (when persp-server-switch-hook - (unless (string-match-p "^.*magit.*$" (symbol-name last-command)) - (funcall persp-server-switch-hook frame)) - (set-frame-parameter frame 'persp-server-switch-hook nil))) - (error - (message "[persp-mode] Error: error in server-switch-hook -- %S" - err)))) - - -;; Misc funcs: - -(cl-defun persp-get-by-name - (name &optional (phash *persp-hash*) (default persp-not-persp)) - (gethash name phash default)) - -(cl-defun persp-with-name-exists-p (name &optional (phash *persp-hash*)) - (persp-p (persp-get-by-name name phash))) - -(cl-defun persp-by-name-and-exists (name &optional (phash *persp-hash*)) - (let ((persp (persp-get-by-name name phash))) - (cons (persp-p persp) persp))) - -(cl-defun persp-gen-random-name (&optional name (phash *persp-hash*)) - (unless name (setq name (number-to-string (random)))) - (cl-macrolet ((namegen () `(format "%s:%s" name (random 9)))) - (cl-do ((nname name (namegen))) - ((not (persp-with-name-exists-p nname phash)) - nname)))) - -(defsubst persp-is-frame-daemons-frame (f) - (and (daemonp) (eq f terminal-frame))) - -(defun persp-frame-list-without-daemon () - "Return a list of frames without the daemon's frame." - (if (daemonp) - (filtered-frame-list - #'(lambda (f) (not (persp-is-frame-daemons-frame f)))) - (frame-list))) - -;; TODO: rename -(defun set-frame-persp (persp &optional frame) - (set-frame-parameter frame 'persp persp)) - -;; TODO: rename -(defun get-frame-persp (&optional frame) - (frame-parameter frame 'persp)) - -(cl-defun persp-names (&optional (phash *persp-hash*) (reverse t)) - (let (ret) - (maphash #'(lambda (k p) - (push k ret)) - phash) - (if reverse - (nreverse ret) - ret))) - -;; TODO: rename -(defun set-window-persp* (persp-name &optional window) - (when persp-name - (set-window-parameter window 'persp persp-name))) -;; TODO: rename -(defun get-window-persp* (&optional window) - (window-parameter window 'persp)) -;; TODO: rename -(defun set-window-persp (persp &optional window) - (let ((frame (window-frame window))) - (if (eq persp (get-frame-persp frame)) - (clear-window-persp window) - (set-window-persp* (safe-persp-name persp) window)))) -;; TODO: rename -(defun window-persp-set-p (&optional window) - (get-window-persp* window)) -;; TODO: rename -(defun get-window-persp (&optional window) - (let ((pn (get-window-persp* window))) - (when pn - (cl-destructuring-bind (e . p) - (persp-by-name-and-exists pn) - (and e p))))) -;; TODO: rename -(defun clear-window-persp (&optional window) - (set-window-parameter window 'persp nil)) - -;; TODO: rename -(defun get-current-persp (&optional frame window) - (with-selected-frame (or frame (selected-frame)) - (if (window-persp-set-p window) - (get-window-persp window) - (get-frame-persp frame)))) - -;; TODO: rename -(defun set-current-persp (persp) - (if (window-persp-set-p) - (set-window-persp persp) - (set-frame-persp persp))) - -(defun persp-names-current-frame-fast-ordered () - (cl-copy-list persp-names-cache)) - -;; TODO: remove this -(cl-defsubst persp-names-sorted (&optional (phash *persp-hash*)) - (sort (persp-names phash nil) #'string<)) -(make-obsolete 'persp-names-sorted "it will be removed." "persp-mode 2.9.6") - -(defun persp-group-by (keyf lst &optional reverse) - (let (result) - (mapc #'(lambda (pd) - (let* ((key (funcall keyf pd)) - (kv (assoc key result))) - (if kv - (setcdr kv (cons pd (cdr kv))) - (push (cons key (list pd)) result)))) - lst) - (if reverse - (nreverse - (mapcar #'(lambda (gr) - (cl-destructuring-bind (key . pd) gr - (cons key (nreverse pd)))) - result)) - result))) - -(defun persp-regexp-p (obj) - (or (stringp obj) (and (consp obj) (stringp (cdr obj))))) -(defun persp-string-match-p (regexp string &optional start) - (when (and regexp (not (consp regexp))) - (setq regexp (cons t regexp))) - (let ((ret (string-match-p (cdr regexp) string start))) - (if (eq :not (car regexp)) - (not ret) - ret))) - -(cl-defun persp-persps (&optional (phash *persp-hash*) names-regexp reverse) - (when (and names-regexp (not (consp names-regexp))) - (setq names-regexp (cons t names-regexp))) - (let (ret) - (maphash #'(lambda (k p) - (if names-regexp - (when (persp-string-match-p names-regexp k) - (push p ret)) - (push p ret))) - phash) - (if reverse - (nreverse ret) - ret))) - -(cl-defun persp-other-not-hidden-persps (&optional persp (phash *persp-hash*)) - (cl-delete-if #'safe-persp-hidden (delq persp (persp-persps phash)))) - -(cl-defun persp-other-persps-with-buffer-except-nil - (&optional (buff-or-name (current-buffer)) (persp (get-current-persp)) - (phash *persp-hash*) del-weak) - (let ((buf (persp-get-buffer-or-null buff-or-name)) - ret) - (when buf - (setq ret (cl-delete-if-not - (apply-partially #'memq buf) - (delq persp (delq nil (persp-persps phash))) - :key #'persp-buffers)) - (when del-weak - (setq ret (cl-delete-if #'persp-weak ret)))) - ret)) -(cl-defun persp-other-persps-with-buffer-except-nil* - (&optional - (buff-or-name (current-buffer)) (persp (get-current-persp)) del-weak) - (let ((persps (persp--buffer-in-persps - (persp-get-buffer-or-null buff-or-name)))) - (when persp - (setq persps (remq persp persps))) - (when del-weak - (setq persps (cl-remove-if #'persp-weak persps))) - persps)) - -(cl-defun persp-buffer-in-other-p - (&optional (buff-or-name (current-buffer)) (persp (get-current-persp)) - (phash *persp-hash*) del-weak) - (persp-other-persps-with-buffer-except-nil buff-or-name persp phash del-weak)) -(cl-defun persp-buffer-in-other-p* - (&optional (buff-or-name (current-buffer)) (persp (get-current-persp)) del-weak) - (persp-other-persps-with-buffer-except-nil* buff-or-name persp del-weak)) - - -(cl-defun persp-frames-with-persp (&optional (persp (get-frame-persp))) - (cl-delete-if-not (apply-partially #'eq persp) - (persp-frame-list-without-daemon) - :key #'get-frame-persp)) -(cl-defun persp-frames-and-windows-with-persp (&optional (persp (get-current-persp))) - (let (frames windows) - (dolist (frame (persp-frame-list-without-daemon)) - (when (eq persp (get-frame-persp frame)) - (push frame frames)) - (dolist (window (window-list frame 'no-minibuf)) - (when (and (window-persp-set-p window) - (eq persp (get-window-persp window))) - (push window windows)))) - (cons frames windows))) - - -(cl-defun persp-do-buffer-list-by-regexp (&key func regexp blist noask - (rest-args nil rest-args-p)) - (interactive) - (unless func - (let ((fs (completing-read "What function to apply: " obarray 'functionp t))) - (when (and fs (not (string= fs ""))) - (setq func (read fs))))) - (when func - (unless regexp - (setq regexp (read-regexp "Regexp: "))) - (when regexp - (unless blist - (setq blist (eval (read--expression "Buffer list expression: " "nil")))) - (when blist - (unless rest-args-p - (setq rest-args (read--expression "Rest arguments: " "nil"))) - (setq blist - (cl-remove-if-not - (apply-partially #'persp-string-match-p regexp) - (mapcar #'get-buffer blist) - :key #'buffer-name)) - (when (and blist - (or noask (y-or-n-p (format "Do %s on these buffers:\n%s?\n" - func - (mapconcat #'buffer-name blist ", "))))) - (mapcar #'(lambda (b) (apply func b rest-args)) blist)))))) - - -;; Perspective funcs: - -(defun persp-next () - "Switch to next perspective (to the right)." - (interactive) - (let* ((persp-list (persp-names-current-frame-fast-ordered)) - (persp-list-length (length persp-list)) - (only-perspective? (equal persp-list-length 1)) - (pos (cl-position (safe-persp-name (get-current-persp)) persp-list))) - (cond - ((null pos) nil) - (only-perspective? nil) - ((= pos (1- persp-list-length)) - (if persp-switch-wrap (persp-switch (nth 0 persp-list)))) - (t (persp-switch (nth (1+ pos) persp-list)))))) - -(defun persp-prev () - "Switch to previous perspective (to the left)." - (interactive) - (let* ((persp-list (persp-names-current-frame-fast-ordered)) - (persp-list-length (length persp-list)) - (only-perspective? (equal persp-list-length 1)) - (pos (cl-position (safe-persp-name (get-current-persp)) persp-list))) - (cond - ((null pos) nil) - (only-perspective? nil) - ((= pos 0) - (if persp-switch-wrap - (persp-switch (nth (1- persp-list-length) persp-list)))) - (t (persp-switch (nth (1- pos) persp-list)))))) - -(cl-defun persp-add (persp &optional (phash *persp-hash*)) - "Insert `PERSP' to `PHASH'. -If we adding to the `*persp-hash*' add entries to the mode menu. -Return `PERSP'." - (let ((name (safe-persp-name persp))) - (puthash name persp phash) - (when (eq phash *persp-hash*) - (persp-add-to-menu persp))) - persp) - -(cl-defun persp-remove-by-name (name &optional (phash *persp-hash*)) - "Remove a perspective with name `NAME' from `PHASH'. -Save it's state before removing. -If we removing from the `*persp-hash*' remove also the menu entries. -Switch all frames with that perspective to another one. -Return the removed perspective." - (interactive "i") - (unless name - (setq name (persp-read-persp - "to remove" nil - (and (eq phash *persp-hash*) - (safe-persp-name (get-current-persp))) - t t))) - (let ((persp (persp-get-by-name name phash)) - (persp-to-switch persp-nil-name)) - (when (persp-p persp) - (persp-save-state persp) - (if (and (eq phash *persp-hash*) (null persp)) - (message "[persp-mode] Error: Can't remove the 'nil' perspective") - (when (eq phash *persp-hash*) - (persp-remove-from-menu persp) - (cl-destructuring-bind (frames . windows) - (persp-frames-and-windows-with-persp persp) - (dolist (w windows) (clear-window-persp w)) - ;; (setq persp-to-switch (or (car (persp-names phash nil)) - ;; persp-nil-name)) - (dolist (f frames) - (persp-frame-switch persp-to-switch f)))) - (remhash name phash))) - persp)) - -(cl-defun persp-add-new (name &optional (phash *persp-hash*)) - "Create a new perspective with the given `NAME'. Add it to `PHASH'. -Return the created perspective." - (interactive "sA name for the new perspective: ") - (if (and name (not (equal "" name))) - (cl-destructuring-bind (e . p) - (persp-by-name-and-exists name phash) - (if e p - (setq p (if (equal persp-nil-name name) - nil (make-persp :name name))) - (persp-add p phash) - (run-hook-with-args 'persp-created-functions p phash) - p)) - (message "[persp-mode] Error: Can't create a perspective with empty name.") - nil)) - -(defun persp-find-and-set-persps-for-buffer (&optional buffer-or-name) - (setq buffer-or-name (if buffer-or-name - (persp-get-buffer-or-null buffer-or-name) - (current-buffer))) - (mapc #'(lambda (p) - (when p - (persp-add-buffer buffer-or-name p nil nil))) - (persp--buffer-in-persps buffer-or-name)) - (persp--buffer-in-persps-set - buffer-or-name - (cl-delete-if-not (apply-partially #'memq buffer-or-name) - (delq nil (persp-persps)) - :key #'persp-buffers))) - -(cl-defun persp-contain-buffer-p - (&optional (buff-or-name (current-buffer)) (persp (get-current-persp)) delweak) - (if (and delweak (safe-persp-weak persp)) - nil - (if persp - (memq (persp-get-buffer-or-null buff-or-name) - (persp-buffers persp)) - t))) -(cl-defun persp-contain-buffer-p* - (&optional (buff-or-name (current-buffer)) (persp (get-current-persp)) delweak) - (if (and delweak (safe-persp-weak persp)) - nil - (if persp - (memq persp (persp--buffer-in-persps - (persp-get-buffer-or-null buff-or-name))) - t))) - -(cl-defun persp-add-buffer - (&optional buffs-or-names (persp (get-current-persp)) - (switchorno persp-switch-to-added-buffer) - (called-interactively-p (called-interactively-p 'any))) - (interactive "i") - (when (and called-interactively-p current-prefix-arg) - (setq switchorno (not switchorno))) - (unless buffs-or-names - (setq buffs-or-names - (when called-interactively-p - (let ((*persp-restrict-buffers-to* 1) - persp-restrict-buffers-to-if-foreign-buffer) - (persp-read-buffer (concat - "Add buffers to the perspective" - (and switchorno - " and switch to first added buffer") - ": ") - (current-buffer) t nil t))))) - (unless (listp buffs-or-names) (setq buffs-or-names (list buffs-or-names))) - (mapc - #'(lambda (bon) - (let ((buffer (persp-get-buffer-or-null bon))) - (when (and persp buffer) - (unless (persp-contain-buffer-p buffer persp) - (push buffer (persp-buffers persp))) - (unless (persp-contain-buffer-p* buffer persp) - (persp--buffer-in-persps-add buffer persp))) - (when (and buffer switchorno (eq persp (get-current-persp))) - (persp-switch-to-buffer buffer)) - buffer)) - buffs-or-names) - buffs-or-names) - -(cl-defun persp-add-buffers-by-regexp (&optional regexp (persp (get-current-persp))) - (interactive) - (when persp - (persp-do-buffer-list-by-regexp - :regexp regexp :func 'persp-add-buffer :rest-args (list persp nil) - :blist (persp-buffer-list-restricted (selected-frame) 1)))) - -(cl-defun persp-temporarily-display-buffer - (&optional buff-or-name (called-interactively-p (called-interactively-p 'any))) - (interactive "i") - (let ((persp-temporarily-display-buffer t)) - (unless buff-or-name - (setq buff-or-name - (if called-interactively-p - (let ((*persp-restrict-buffers-to* - (if (and called-interactively-p current-prefix-arg) 0 1)) - (persp-restrict-buffers-to-if-foreign-buffer - (if (= 0 *persp-restrict-buffers-to*) -1 nil))) - (persp-read-buffer - (if (= 0 *persp-restrict-buffers-to*) - "Remove a buffer from the perspective, but still display it: " - "Temporarily display a buffer, not adding it to the current perspective: ") - nil t)) - (current-buffer)))) - (let ((buffer (persp-get-buffer-or-null buff-or-name))) - (when buffer - (let ((persp (get-current-persp))) - (when (and persp (persp-contain-buffer-p* buffer persp)) - (let (persp-autokill-buffer-on-remove - persp-autokill-persp-when-removed-last-buffer) - (persp-remove-buffer buffer persp nil nil nil nil)))) - (persp-switch-to-buffer buffer t))))) - - -(defun persp--buffer-do-auto-action-if-needed (buffer) - (when (and persp-autokill-buffer-on-remove - (persp-buffer-free-p - buffer - (eq 'kill-weak persp-autokill-buffer-on-remove))) - (let (persp-autokill-buffer-on-remove) - (persp-kill-buffer buffer)))) - -(defun persp--remove-buffer-1 (buffer &optional persp) - (if persp - (progn - (when persp-when-remove-buffer-switch-to-other-buffer - (persp-switch-to-prev-buffer buffer persp)) - (persp--buffer-in-persps-remove buffer persp) - (setf (persp-buffers persp) (delq buffer (persp-buffers persp))) - persp) - (mapcar (apply-partially #'persp--remove-buffer-1 buffer) - (persp-other-persps-with-buffer-except-nil buffer persp)))) - -(defun persp--remove-buffer-2 (&optional persp buffer-or-name) - (let ((buffer (if buffer-or-name - (persp-get-buffer-or-null buffer-or-name) - (current-buffer)))) - (when buffer - (persp--remove-buffer-1 buffer persp) - (persp--buffer-do-auto-action-if-needed buffer) - (persp--do-auto-action-if-needed persp)) - buffer)) - -(defun persp--remove-buffers-from-nil-p (buffs-or-names) - (cl-typecase persp-remove-buffers-from-nil-persp-behaviour - (function - (funcall persp-remove-buffers-from-nil-persp-behaviour - buffs-or-names)) - (symbol - (cl-macrolet - ((ask () `(yes-or-no-p - (format "Remove %s buffers from all perspectives?" - buffs-or-names)))) - (cl-case persp-remove-buffers-from-nil-persp-behaviour - (ask-to-rem-from-all - (if (cl-find-if-not #'persp-buffer-free-p buffs-or-names) - (ask) t)) - (ask-if-in-non-weak-persp - (if (cl-find-if-not - #'(lambda (bon) - (persp-buffer-free-p bon t)) - buffs-or-names) - (ask) t)) - (t t)))) - (t t))) - -(cl-defun persp-remove-buffer - (&optional buffs-or-names (persp (get-current-persp)) - (rem-from-nil-opt persp-remove-buffers-from-nil-persp-behaviour) - (switch persp-when-remove-buffer-switch-to-other-buffer) - called-from-kill-buffer-hook - (called-interactively-p (called-interactively-p 'any))) - "Remove BUFFS-OR-NAMES(which may be a single buffer or a list of buffers) -from the PERSP. On success return removed buffers otherwise nil." - (interactive "i") - - ;; TODO: remove these parameters - (ignore called-from-kill-buffer-hook rem-from-nil-opt switch) - - (unless (listp buffs-or-names) (setq buffs-or-names (list buffs-or-names))) - (unless buffs-or-names - (setq buffs-or-names - (if called-interactively-p - (let ((*persp-restrict-buffers-to* 0) - persp-restrict-buffers-to-if-foreign-buffer) - (persp-read-buffer "Remove buffers from the perspective: " - (current-buffer) t nil t)) - (current-buffer)))) - (when (or persp - (persp--remove-buffers-from-nil-p buffs-or-names)) - (let ((persp-autokill-buffer-on-remove - (if (and called-interactively-p current-prefix-arg) - (not persp-autokill-buffer-on-remove) - persp-autokill-buffer-on-remove))) - (mapcar (apply-partially #'persp--remove-buffer-2 persp) - buffs-or-names)))) - -(defun persp-kill-buffer (&optional buffers-or-names) - "Kill buffers, read buffer with restriction to current perspective." - (interactive (list - (let ((*persp-restrict-buffers-to* 0) - persp-restrict-buffers-to-if-foreign-buffer) - (if persp-mode - (persp-read-buffer - "Kill buffers: " (current-buffer) t nil t) - (read-buffer "Kill buffer: " (current-buffer) t))))) - (unless (listp buffers-or-names) - (setq buffers-or-names (list buffers-or-names))) - (mapc #'kill-buffer - (cl-remove-if-not #'persp-get-buffer-or-null buffers-or-names)) - buffers-or-names) - -(defun persp-switch-to-buffer (buffer-or-name - &optional norecord force-same-window) - - "Switch to buffer, read buffer with restriction to current perspective." - - (interactive (list - (let ((*persp-restrict-buffers-to* 0) - persp-restrict-buffers-to-if-foreign-buffer) - (if persp-mode - (let ((dflt (other-buffer (current-buffer)))) - (unless (memq dflt (safe-persp-buffers - (get-current-persp))) - (cl-psetq dflt (current-buffer))) - (persp-read-buffer "Switch to buffer: " dflt t)) - (read-buffer-to-switch "Switch to buffer: "))))) - (when (and buffer-or-name - (persp-get-buffer-or-null (get-buffer buffer-or-name))) - (switch-to-buffer buffer-or-name norecord force-same-window))) - -(cl-defun persp-remove-buffers-by-regexp - (&optional regexp (persp (get-current-persp))) - (interactive) - (when persp - (persp-do-buffer-list-by-regexp - :regexp regexp :func 'persp-remove-buffer - :blist (persp-buffers persp) :rest-args (list persp)))) - -(cl-defun persp-import-buffers-from (persp-from - &optional (persp-to (get-current-persp))) - (if persp-to - (mapc #'(lambda (b) (persp-add-buffer b persp-to nil nil)) - (safe-persp-buffers persp-from)) - (message "[persp-mode] Error: Can't import buffers to the 'nil' perspective, \ -cause it already contain all buffers."))) - -(cl-defun persp-import-buffers - (names - &optional (persp-to (get-current-persp)) (phash *persp-hash*)) - "Import buffers from perspectives with the given names to another one." - (interactive "i") - (unless (listp names) (setq names (list names))) - (unless names - (setq names (persp-read-persp "to import buffers from" t nil t nil t))) - (mapc #'(lambda (persp-from) - (persp-import-buffers-from persp-from persp-to)) - (mapcar #'(lambda (pn) (persp-get-by-name pn phash)) names))) - -(cl-defun persp-import-win-conf - (name - &optional (persp-to (get-current-persp)) (phash *persp-hash*) - no-update-frames) - (interactive "i") - (unless name - (setq name (persp-read-persp - "to import window configuration from" nil nil t nil t))) - (let ((persp-from (persp-get-by-name name phash))) - (unless (or (eq persp-to persp-from) - (not (persp-p persp-from))) - (if persp-to - (setf (persp-window-conf persp-to) (safe-persp-window-conf persp-from)) - (setq persp-nil-wconf (persp-window-conf persp-from))) - (unless no-update-frames - (persp-update-frames-window-confs (list (safe-persp-name persp-to))))))) - -(cl-defun persp-copy - (new-name - &optional switch (called-interactively-p (called-interactively-p 'any))) - (interactive "i") - (unless new-name - (setq new-name - (read-string "Copy current persp with name: "))) - (if (member new-name (persp-names)) - (progn - (message - "[persp-mode] Error: There is already a perspective with that name %S" - new-name) - nil) - (let* ((new-persp (persp-add-new new-name)) - (current-persp (get-current-persp)) - (new-buffers (when new-persp - (if current-persp - (cl-copy-list (persp-buffers current-persp)) - (safe-persp-buffers current-persp))))) - (when new-persp - (when (and called-interactively-p current-prefix-arg) - (setq new-buffers - (let (choosen-buffers) - (cl-delete-if-not - (cl-destructuring-bind (char &rest _) - (read-multiple-choice - "What buffers to copy? " - '((?a "all") - (?d "displayed") - (?f "free and displayed") - (?F "free") - (?c "choose") - (?n "none"))) - (cl-case char - (?d #'(lambda (b) (get-buffer-window-list b 'no-minibuf))) - (?f #'(lambda (b) (or (persp-buffer-free-p b t) - (get-buffer-window-list b 'no-minibuf)))) - (?F #'(lambda (b) (persp-buffer-free-p b t))) - (?c (setq choosen-buffers - (mapcar #'get-buffer - (persp-read-buffer - "" (current-buffer) t nil t 'push))) - #'(lambda (b) (memq b choosen-buffers))) - (?n #'not) - (?a nil) - (t nil))) - new-buffers)))) - (persp-save-state current-persp) - (setf (persp-window-conf new-persp) - (safe-persp-window-conf current-persp) - (persp-parameters new-persp) - (cl-copy-list (safe-persp-parameters current-persp)) - (persp-weak new-persp) - (if current-persp (persp-weak current-persp) nil)) - (persp-add-buffer new-buffers new-persp nil nil) - (cl-case switch - (window (persp-window-switch new-name)) - (frame (persp-frame-switch new-name)) - (no-switch nil) - (t (persp-switch new-name))) - new-persp)))) - -(cl-defun persp-get-buffer - (&optional (buff-or-name (current-buffer)) (persp (get-current-persp))) - "Like `get-buffer', but constrained to the perspective's list of buffers. -Return the buffer if it's in the perspective or the first buffer from the -perspective buffers or nil." - (let ((buffer (persp-get-buffer-or-null buff-or-name))) - (or (cl-find buffer (safe-persp-buffers persp)) - (cl-first (safe-persp-buffers persp))))) - -(defun persp-get-buffer-or-null (buff-or-name) - "Safely return a buffer or the nil without errors." - (cl-typecase buff-or-name - ((or string buffer) - (let ((buf (get-buffer buff-or-name))) - (and (buffer-live-p buf) - buf))) - (otherwise nil))) - -(defun persp-buffer-filtered-out-p (buff-or-name &rest filters) - (setq filters (if filters - (cons - persp-common-buffer-filter-functions - filters) - persp-common-buffer-filter-functions) - buff-or-name (get-buffer buff-or-name)) - (cl-find-if #'(lambda (filter) - (if (functionp filter) - (funcall filter buff-or-name) - (cl-find-if #'(lambda (f) (funcall f buff-or-name)) filter))) - filters)) - -(defun persp-buffer-free-p (&optional buff-or-name del-weak) - (unless buff-or-name (setq buff-or-name (current-buffer))) - (let ((persps (persp--buffer-in-persps - (persp-get-buffer-or-null buff-or-name)))) - (if persps - (if del-weak - (not - (cl-find-if-not #'persp-weak persps)) - nil) - t))) - - -(cl-defun persp-set-another-buffer-for-window - (&optional (old-buff-or-name (current-buffer)) (window (selected-window)) - (persp (get-current-persp nil window))) - (unless (window-minibuffer-p window) - (let* ((old-buf (persp-get-buffer-or-null old-buff-or-name)) - (new-buf (if persp-set-frame-buffer-predicate - (other-buffer old-buf) - (cl-find-if #'(lambda (bc) - (and (bufferp bc) (not (eq bc old-buf)) - (persp-contain-buffer-p bc persp))) - (append (mapcar #'car - (window-prev-buffers window)) - (window-next-buffers window)))))) - (set-window-buffer - window - (or (and (buffer-live-p new-buf) new-buf) - (car (persp-buffer-list-restricted (window-frame window) 2.5)) - (car (buffer-list))))))) - -(cl-defun persp-switch-to-prev-buffer - (&optional (old-buff-or-name (current-buffer)) (persp (get-current-persp))) - "Switch all windows in all frames with a perspective displaying that buffer -to some previous buffer in the perspective. -Return that old buffer." - (let ((old-buf (persp-get-buffer-or-null old-buff-or-name))) - (cl-destructuring-bind (frames . windows) - (persp-frames-and-windows-with-persp persp) - (dolist (w windows) - (persp-set-another-buffer-for-window old-buf w)) - (dolist (f frames) - (dolist (w (get-buffer-window-list old-buf 'no-minibuf f)) - (persp-set-another-buffer-for-window old-buf w)))) - old-buf)) - -(cl-defsubst persp-filter-out-bad-buffers (&optional (persp (get-current-persp))) - ;; filter out killed buffers - (when persp - (setf (persp-buffers persp) - (cl-delete-if-not #'persp-get-buffer-or-null (persp-buffers persp))))) - -(defun persp-hide (names) - (interactive "i") - (unless (listp names) (setq names (list names))) - (unless names - (setq names (persp-read-persp - "to hide" t (safe-persp-name (get-current-persp)) t))) - (let ((persp-to-switch (get-current-persp)) - (hidden-persps - (mapcar #'(lambda (pn) - (let ((persp (persp-get-by-name pn))) - (when (persp-p persp) - (if persp - (setf (persp-hidden persp) t) - (setq persp-nil-hidden t))) - persp)) - names))) - (when (safe-persp-hidden persp-to-switch) - (setq persp-to-switch - (car (persp-other-not-hidden-persps persp-to-switch)))) - (mapc #'(lambda (p) - (when (persp-p p) - (cl-destructuring-bind (frames . windows) - (persp-frames-and-windows-with-persp p) - (dolist (w windows) (clear-window-persp w)) - (dolist (f frames) - (persp-frame-switch (safe-persp-name persp-to-switch) f))))) - hidden-persps))) - -(defun persp-unhide (names) - (interactive "i") - (unless (listp names) (setq names (list names))) - (unless names - (let ((hidden-persps - (mapcar #'safe-persp-name - (cl-delete-if-not #'safe-persp-hidden - (persp-persps))))) - (setq names - (persp-read-persp - "to unhide" t (car hidden-persps) t nil nil hidden-persps t)))) - (when names - (mapc #'(lambda (pn) - (let ((persp (persp-get-by-name pn))) - (when (persp-p persp) - (if persp - (setf (persp-hidden persp) nil) - (setq persp-nil-hidden nil))))) - names))) - -(cl-defun persp-kill (names &optional dont-kill-buffers - (called-interactively-p (called-interactively-p 'any))) - (interactive "i") - (when (and called-interactively-p current-prefix-arg) - (setq dont-kill-buffers (not dont-kill-buffers))) - (unless (listp names) (setq names (list names))) - (unless names - (setq names (persp-read-persp - (concat "to kill" - (and dont-kill-buffers " not killing buffers")) - t (safe-persp-name (get-current-persp)) t))) - (mapc #'(lambda (pn) - (let ((persp (persp-get-by-name pn))) - (when (persp-p persp) - (when (or (not called-interactively-p) - (not (null persp)) - (yes-or-no-p - "Really kill the 'nil' perspective (It'l kill all buffers)?")) - (let ((pfile (persp-parameter 'persp-file persp))) - (cl-case persp-auto-save-persps-to-their-file-before-kill - (persp-file nil) - ('nil (setq pfile nil)) - (t (unless pfile - (setq pfile persp-auto-save-fname)))) - (when pfile - (persp-save-to-file-by-names - pfile *persp-hash* (list pn) t nil))) - (run-hook-with-args 'persp-before-kill-functions persp) - (let (persp-autokill-persp-when-removed-last-buffer) - (if dont-kill-buffers - (let (persp-autokill-buffer-on-remove) - (mapc #'(lambda (b) - (persp-remove-buffer b persp t t nil nil)) - (safe-persp-buffers persp))) - (mapc #'(lambda (b) - (persp-remove-buffer b persp t t nil nil)) - (safe-persp-buffers persp)))) - (when persp - (persp-remove-by-name pn)))))) - names)) - -(defun persp-kill-without-buffers (names) - (interactive "i") - (persp-kill names t nil)) - -(cl-defun persp-save-and-kill - (names &optional dont-kill-buffers - (called-interactively-p (called-interactively-p 'any))) - (interactive "i") - (when (and called-interactively-p current-prefix-arg) - (setq dont-kill-buffers (not dont-kill-buffers))) - (unless (listp names) (setq names (list names))) - (unless names - (setq names (persp-read-persp - (concat "to save and kill" - (and dont-kill-buffers " not killing buffers")) - t (safe-persp-name (get-current-persp)) t))) - (let ((temphash (make-hash-table :test 'equal :size 10))) - (mapc #'(lambda (p) - (persp-add p temphash)) - (mapcar #'(lambda (pn) (persp-get-by-name pn)) names)) - (persp-save-state-to-file persp-auto-save-fname temphash - persp-auto-save-persps-to-their-file - 'yes))) - -(cl-defun persp-rename (new-name - &optional (persp (get-current-persp)) (phash *persp-hash*)) - "Change the name field of the `PERSP'. -Return old name on success, otherwise nil." - (interactive "i") - (if persp - (let ((opersp (persp-get-by-name new-name phash)) - (old-name (safe-persp-name persp))) - (unless new-name - (setq new-name - (read-string - (concat "New name for the " old-name " perspective: ") old-name))) - (if (and (not (persp-p opersp)) new-name - (not (equal old-name new-name))) - (progn - (when (eq phash *persp-hash*) - (persp-remove-from-menu persp)) - (remhash old-name phash) - (setf (persp-name persp) new-name) - (puthash new-name persp phash) - (when (eq phash *persp-hash*) - (persp-add-to-menu persp) - (run-hook-with-args - 'persp-renamed-functions persp old-name new-name)) - old-name) - (message - "[persp-mode] Error: There is already a perspective with that name: %S." - new-name) - nil)) - (message - "[persp-mode] Error: You can't rename the `nil' perspective, use \ -M-x: customize-variable RET persp-nil-name RET") - nil)) - -(cl-defun persp-switch - (name &optional frame (window (selected-window)) - (called-interactively-p (called-interactively-p 'any))) - "Switch to the perspective with name `NAME'. -If there is no perspective with that name it will be created. -Return `NAME'." - (interactive "i") - (let ((switch-type 'frame)) - (if (or (window-persp-set-p window) - (and called-interactively-p current-prefix-arg)) - (setq switch-type 'window) - (unless frame (setq frame (window-frame window)))) - (if (eq 'window switch-type) - (persp-window-switch name window) - (persp-frame-switch name frame)))) -(cl-defun persp-frame-switch (name &optional (frame (selected-frame))) - (interactive "i") - (unless name - (setq name (persp-read-persp "to switch(in frame)" nil nil nil nil t))) - (unless (memq frame persp-inhibit-switch-for) - (run-hook-with-args 'persp-before-switch-functions name frame) - (let ((persp-inhibit-switch-for (cons frame persp-inhibit-switch-for))) - (persp-activate (persp-add-new name) frame))) - name) -(cl-defun persp-window-switch (name &optional (window (selected-window))) - (interactive "i") - (unless name - (setq name (persp-read-persp "to switch(in window)" nil nil nil nil t))) - (unless (memq window persp-inhibit-switch-for) - (run-hook-with-args 'persp-before-switch-functions name window) - (let ((persp-inhibit-switch-for (cons window persp-inhibit-switch-for))) - (persp-activate (persp-add-new name) window))) - name) - -(defun persp-before-make-frame () - (let ((persp (persp-get-by-name - (or (and persp-set-last-persp-for-new-frames - persp-last-persp-name) - persp-nil-name)))) - (unless (persp-p persp) - (when persp-set-last-persp-for-new-frames - (setq persp-last-persp-name persp-nil-name)) - (setq persp (persp-add-new persp-nil-name))) - (persp-save-state persp nil t))) - -(defun persp--do-auto-action-if-needed (persp) - (when (and (safe-persp-auto persp) - persp-autokill-persp-when-removed-last-buffer - (null (safe-persp-buffers persp))) - (cond - ((functionp persp-autokill-persp-when-removed-last-buffer) - (funcall persp-autokill-persp-when-removed-last-buffer persp)) - ((or - (eq 'hide persp-autokill-persp-when-removed-last-buffer) - (and (eq 'hide-auto persp-autokill-persp-when-removed-last-buffer) - (safe-persp-auto persp))) - (persp-hide (safe-persp-name persp))) - ((or - (eq t persp-autokill-persp-when-removed-last-buffer) - (eq 'kill persp-autokill-persp-when-removed-last-buffer) - (and - (eq 'kill-auto persp-autokill-persp-when-removed-last-buffer) - (safe-persp-auto persp))) - (persp-kill (safe-persp-name persp) nil nil))))) - -(defsubst persp--deactivate (frame-or-window &optional new-persp) - (let (persp) - (cl-typecase frame-or-window - (frame - (setq persp (get-frame-persp frame-or-window)) - (unless (eq persp new-persp) - (with-selected-frame frame-or-window - (run-hook-with-args 'persp-before-deactivate-functions 'frame)) - (persp-frame-save-state - frame-or-window - (if persp-set-last-persp-for-new-frames - (equal (safe-persp-name persp) persp-last-persp-name) - (null persp))))) - (window - (setq persp (get-window-persp frame-or-window)) - (unless (eq persp new-persp) - (with-selected-window frame-or-window - (run-hook-with-args 'persp-before-deactivate-functions 'window))))) - (let ((persp-inhibit-switch-for - (cons frame-or-window persp-inhibit-switch-for))) - (persp--do-auto-action-if-needed persp)))) - -(cl-defun persp-activate - (persp &optional (frame-or-window (selected-frame)) new-frame-p) - (when frame-or-window - (let (old-persp type) - (cl-typecase frame-or-window - (frame - (setq old-persp (get-frame-persp frame-or-window) - type 'frame)) - (window - (setq old-persp (get-window-persp frame-or-window) - type 'window))) - (when (or new-frame-p - (not (eq old-persp persp))) - (unless new-frame-p - (persp--deactivate frame-or-window persp)) - (cl-case type - (frame - (setq persp-last-persp-name (safe-persp-name persp)) - (set-frame-persp persp frame-or-window) - (when persp-init-frame-behaviour - (persp-restore-window-conf frame-or-window persp new-frame-p)) - (with-selected-frame frame-or-window - (run-hook-with-args 'persp-activated-functions 'frame))) - (window - (set-window-persp persp frame-or-window) - (let ((cbuf (window-buffer frame-or-window))) - (unless (persp-contain-buffer-p cbuf persp) - (persp-set-another-buffer-for-window cbuf frame-or-window persp))) - (with-selected-window frame-or-window - (run-hook-with-args 'persp-activated-functions 'window)))))))) - -(defun persp-init-new-frame (frame) - (condition-case-unless-debug err - (persp-init-frame frame t (frame-parameter frame 'client)) - (error - (message "[persp-mode] Error: Can not initialize frame -- %S" - err)))) -(cl-defun persp-init-frame (frame &optional new-frame-p client) - (let ((persp-init-frame-behaviour - (cond - ((and client - (not (eql -1 persp-emacsclient-init-frame-behaviour-override))) - persp-emacsclient-init-frame-behaviour-override) - ((and (eq this-command 'make-frame) - (not (eql -1 persp-interactive-init-frame-behaviour-override))) - persp-interactive-init-frame-behaviour-override) - ((and new-frame-p (not (eql -1 persp-init-new-frame-behaviour-override))) - persp-init-new-frame-behaviour-override) - (t persp-init-frame-behaviour)))) - (let (persp-name persp) - (cl-macrolet - ((set-default-persp - () - `(progn - (setq persp-name (or (and persp-set-last-persp-for-new-frames - persp-last-persp-name) - persp-nil-name) - persp (persp-get-by-name persp-name)) - (unless (persp-p persp) - (setq persp-name persp-nil-name - persp (persp-add-new persp-name)))))) - (cl-typecase persp-init-frame-behaviour - (function - (funcall persp-init-frame-behaviour frame new-frame-p)) - (string - (setq persp-name persp-init-frame-behaviour - persp (persp-add-new persp-name))) - (symbol - (cl-case persp-init-frame-behaviour - (auto-temp (setq persp-name (persp-gen-random-name) - persp (persp-add-new persp-name)) - (when persp - (setf (persp-auto persp) t))) - (prompt (select-frame frame) - (setq persp-name - (persp-read-persp "to switch" nil nil nil nil t) - persp (persp-add-new persp-name))) - (t (set-default-persp)))) - (t (set-default-persp)))) - (when persp-name - (modify-frame-parameters frame `((persp . nil))) - (when persp-set-frame-buffer-predicate - (persp-set-frame-buffer-predicate frame)) - (persp-set-frame-server-switch-hook frame) - (when (or (eq persp-init-frame-behaviour 'persp-ignore-wconf) - (eq persp-init-frame-behaviour 'persp-ignore-wconf-once)) - (set-frame-parameter frame persp-init-frame-behaviour t)) - (persp-activate persp frame new-frame-p))))) - -(defun persp-delete-frame (frame) - (condition-case-unless-debug err - (persp--deactivate frame persp-not-persp) - (error - (message "[persp-mode] Error: Can not deactivate frame -- %S" - err)))) - -;; TODO: rename -(cl-defun find-other-frame-with-persp (&optional (persp (get-frame-persp)) - (exframe (selected-frame)) - for-save) - (let ((flist (delq exframe (persp-frames-with-persp persp)))) - (cl-find-if - #'(lambda (f) - (and f - (if for-save - (and (not (frame-parameter f 'persp-ignore-wconf)) - (not (frame-parameter f 'persp-ignore-wconf-once))) - t) - (eq persp (get-frame-persp f)))) - flist))) - - -;; Helper funcs: - -(defun persp-add-minor-mode-menu () - (easy-menu-define persp-minor-mode-menu - persp-mode-map - "The menu for the `persp-mode'." - '("Perspectives" - "-"))) - -(defun persp-remove-from-menu (persp) - (let ((name (safe-persp-name persp))) - (cl-psetq persp-names-cache (cl-delete name persp-names-cache :count 1)) - (easy-menu-remove-item persp-minor-mode-menu nil name) - (when persp - (easy-menu-remove-item persp-minor-mode-menu '("kill") name)))) - -(defun persp-add-to-menu (persp) - (let ((name (safe-persp-name persp))) - (cl-psetq persp-names-cache - (append persp-names-cache (list name))) - (let ((str_name name)) - (easy-menu-add-item persp-minor-mode-menu nil - (vector str_name #'(lambda () (interactive) - (persp-switch str_name)))) - (when persp - (easy-menu-add-item persp-minor-mode-menu '("kill") - (vector str_name #'(lambda () (interactive) - (persp-kill str_name)))))))) - -(cl-defun persp-read-persp - (&optional action multiple default require-match delnil delcur persp-list - show-hidden (default-mode t)) - - "Read perspective name(s)." - - (when persp-names-sort-before-read-function - (cl-psetq persp-names-cache - (funcall persp-names-sort-before-read-function - persp-names-cache))) - - (cl-psetq persp-list - (if persp-list - (cl-delete-if-not #'(lambda (pn) (member pn persp-list)) - (persp-names-current-frame-fast-ordered)) - (persp-names-current-frame-fast-ordered))) - - (when delnil - (setq persp-list (cl-delete persp-nil-name persp-list :count 1))) - (when delcur - (setq persp-list (cl-delete (safe-persp-name (get-current-persp)) persp-list :count 1))) - (unless show-hidden - (setq persp-list - (cl-delete-if #'safe-persp-hidden persp-list :key #'persp-get-by-name))) - (when (and default (not (member default persp-list))) - (setq default nil)) - (let (retlst) - (cl-macrolet - ((call-pif - () - `(funcall - persp-interactive-completion-function - (concat - "Perspective name" (and multiple "s") (and action " ") action - (if default (concat " (default " default ")") "") - (when retlst - (concat "< " (mapconcat #'identity retlst " ") " > ")) - ": ") - persp-list nil require-match nil nil default))) - (if multiple - (let ((done_str "[>done<]") (not-finished default-mode) - exit-minibuffer-function mb-local-key-map - (push-keys (alist-get 'push-item persp-read-multiple-keys)) - (pop-keys (alist-get 'pop-item persp-read-multiple-keys)) - push-keys-backup pop-keys-backup) - (while (member done_str persp-list) - (setq done_str (concat ">" done_str))) - (let ((persp-minibuffer-setup - #'(lambda () - (setq mb-local-key-map (current-local-map)) - (when (keymapp mb-local-key-map) - (unless exit-minibuffer-function - (setq exit-minibuffer-function - (or (lookup-key mb-local-key-map (kbd "RET")) - persp-read-multiple-exit-minibuffer-function))) - (unless push-keys-backup - (setq push-keys-backup - (lookup-key mb-local-key-map push-keys))) - (define-key mb-local-key-map push-keys - #'(lambda () (interactive) - (setq not-finished 'push) - (funcall exit-minibuffer-function))) - (unless pop-keys-backup - (setq pop-keys-backup - (lookup-key mb-local-key-map pop-keys))) - (define-key mb-local-key-map pop-keys - #'(lambda () (interactive) - (setq not-finished 'pop) - (funcall exit-minibuffer-function)))))) - cp) - (unwind-protect - (progn - (add-hook 'minibuffer-setup-hook persp-minibuffer-setup t) - (while not-finished - (setq cp (call-pif)) - (cl-case not-finished - (push - (when (and cp (member cp persp-list)) - (if retlst - (when (string= cp done_str) - (setq not-finished nil)) - (push done_str persp-list)) - (when not-finished - (if (eq 'reverse multiple) - (setq retlst (append retlst (list cp))) - (push cp retlst)) - (setq persp-list (cl-delete cp persp-list :count 1) - default done_str))) - (when not-finished - (setq not-finished default-mode))) - (pop - (let ((last-item (pop retlst))) - (unless retlst (setq persp-list (cl-delete done_str persp-list :count 1) - default nil)) - (when last-item - (push last-item persp-list))) - (setq not-finished default-mode)) - (t - (when (and cp (not (string= cp done_str)) - (member cp persp-list)) - (push cp retlst)) - (setq not-finished nil))))) - (remove-hook 'minibuffer-setup-hook persp-minibuffer-setup) - (when (keymapp mb-local-key-map) - (when (lookup-key mb-local-key-map push-keys) - (define-key mb-local-key-map push-keys push-keys-backup)) - (when (lookup-key mb-local-key-map pop-keys) - (define-key mb-local-key-map pop-keys pop-keys-backup))))) - retlst) - (call-pif))))) -(define-obsolete-function-alias 'persp-prompt 'persp-read-persp "persp-mode 2.9") - -(defsubst persp--set-frame-buffer-predicate-buffer-list-cache (buflist) - (prog1 - (setq persp-frame-buffer-predicate-buffer-list-cache buflist) - (unless persp-frame-buffer-predicate-buffer-list-cache - (setq persp-frame-buffer-predicate-buffer-list-cache :nil)) - (run-at-time - 2 nil #'(lambda () - (setq persp-frame-buffer-predicate-buffer-list-cache nil))))) -(defmacro persp--get-frame-buffer-predicate-buffer-list-cache (buflist) - `(if persp-frame-buffer-predicate-buffer-list-cache - (if (eq :nil persp-frame-buffer-predicate-buffer-list-cache) - nil - persp-frame-buffer-predicate-buffer-list-cache) - (persp--set-frame-buffer-predicate-buffer-list-cache ,buflist))) -(defun persp-generate-frame-buffer-predicate (opt) - (if opt - (eval - `(lambda (b) - (if (string-prefix-p " *temp*" (buffer-name (current-buffer))) - t - ,(cl-typecase opt - (function - `(funcall (with-no-warnings ',opt) b)) - (number - `(let ((*persp-restrict-buffers-to* ,opt)) - (memq - b (persp--get-frame-buffer-predicate-buffer-list-cache - (let ((ret - (persp-buffer-list-restricted - (selected-frame) ,opt - persp-restrict-buffers-to-if-foreign-buffer t))) - (if (get-current-persp) - ret - (cl-delete-if #'persp-buffer-filtered-out-p ret))))))) - (symbol - (cl-case opt - ('nil t) - (restricted-buffer-list - '(progn - (memq - b (persp--get-frame-buffer-predicate-buffer-list-cache - (let ((ret - (persp-buffer-list-restricted - (selected-frame) - *persp-restrict-buffers-to* - persp-restrict-buffers-to-if-foreign-buffer - t))) - (if (get-current-persp) - ret - (cl-delete-if #'persp-buffer-filtered-out-p ret))))))) - (t '(memq - b (persp--get-frame-buffer-predicate-buffer-list-cache - (let ((ret (safe-persp-buffers (get-current-persp)))) - (if (get-current-persp) - ret - (cl-delete-if #'persp-buffer-filtered-out-p ret)))))))) - (t t))))) - nil)) - -(defun persp-set-frame-buffer-predicate (frame &optional off) - (let ((old-pred (frame-parameter frame 'persp-buffer-predicate-old)) - (cur-pred (frame-parameter frame 'buffer-predicate)) - (last-persp-pred - (frame-parameter frame 'persp-buffer-predicate-generated))) - (let (new-pred) - (if off - (progn - (set-frame-parameter frame 'persp-buffer-predicate-old nil) - (set-frame-parameter frame 'persp-buffer-predicate-generated nil) - (setq new-pred (if (eq cur-pred last-persp-pred) old-pred cur-pred)) - (set-frame-parameter frame 'buffer-predicate new-pred)) - (unless persp-frame-buffer-predicate - (setq persp-frame-buffer-predicate - (persp-generate-frame-buffer-predicate - persp-set-frame-buffer-predicate))) - (if persp-frame-buffer-predicate - (progn - (set-frame-parameter frame 'persp-buffer-predicate-old - (if (eq cur-pred last-persp-pred) - old-pred (setq old-pred cur-pred))) - (setq new-pred - (cl-case old-pred - ('nil persp-frame-buffer-predicate) - (t `(lambda (b) - (and - (funcall (with-no-warnings - ',persp-frame-buffer-predicate) - b) - (funcall (with-no-warnings ',old-pred) b)))))) - (unless (symbolp new-pred) - (setq new-pred (with-no-warnings - (let ((warning-minimum-level :emergency) - byte-compile-warnings) - (byte-compile new-pred))))) - (set-frame-parameter - frame 'persp-buffer-predicate-generated new-pred) - (set-frame-parameter frame 'buffer-predicate new-pred)) - (persp-set-frame-buffer-predicate frame t)))))) - -(defun persp-update-frames-buffer-predicate (&optional off) - (unless off - (setq persp-frame-buffer-predicate nil) - (persp-update-frames-buffer-predicate t)) - (mapc #'(lambda (f) (persp-set-frame-buffer-predicate f off)) - (persp-frame-list-without-daemon))) - - -(defun persp-generate-frame-server-switch-hook (opt) - (if opt - (eval - `(lambda (frame) - ,(if (functionp opt) - `(funcall (with-no-warnings ',opt) frame) - `(let* ((frame-client (frame-parameter frame 'client)) - (frame-client-bl (when (processp frame-client) - (process-get frame-client 'buffers)))) - ,(cl-case opt - (only-file-windows - `(if frame-client - (when frame-client-bl - (mapc #'(lambda (w) - (unless (memq (window-buffer w) - frame-client-bl) - (delete-window w))) - (window-list frame 'no-minibuf))) - (let (frame-server-bl) - (mapc #'(lambda (proc) - (setq frame-server-bl - (append frame-server-bl - (process-get proc 'buffers)))) - (server-clients-with 'frame nil)) - (when frame-server-bl - (mapc #'(lambda (w) - (unless (memq (window-buffer w) - frame-server-bl) - (delete-window w))) - (window-list frame 'no-minibuf)))))) - (only-file-windows-for-client-frame - `(when frame-client-bl - (mapc #'(lambda (w) - (unless (memq (window-buffer w) frame-client-bl) - (delete-window w))) - (window-list frame 'no-minibuf)))) - (t nil)))))) - nil)) - -(defun persp-set-frame-server-switch-hook (frame) - (when (frame-parameter frame 'client) - (set-frame-parameter - frame 'persp-server-switch-hook persp-frame-server-switch-hook))) - -(defun persp-update-frame-server-switch-hook () - (setq persp-frame-server-switch-hook - (persp-generate-frame-server-switch-hook persp-server-switch-behaviour)) - (mapc #'persp-set-frame-server-switch-hook - (persp-frame-list-without-daemon))) - - -(defun persp-ido-setup () - (when (eq ido-cur-item 'buffer) - (setq persp-disable-buffer-restriction-once nil))) - -(defun persp-restrict-ido-buffers () - "Support for the `ido-mode'." - (let ((buffer-names-sorted - (if persp-disable-buffer-restriction-once - (mapcar #'buffer-name (persp-buffer-list-restricted nil -1 nil)) - (mapcar #'buffer-name (persp-buffer-list-restricted)))) - (indices (make-hash-table))) - (let ((i 0)) - (dolist (elt ido-temp-list) - (puthash elt i indices) - (setq i (1+ i)))) - (setq ido-temp-list - (sort buffer-names-sorted #'(lambda (a b) - (< (gethash a indices 10000) - (gethash b indices 10000))))))) - -;; TODO: rename -(defun ido-toggle-persp-filter () - (interactive) - (setq persp-disable-buffer-restriction-once - (not persp-disable-buffer-restriction-once) - ido-text-init ido-text ido-exit 'refresh) - (exit-minibuffer)) - - -(cl-defun persp-read-buffer - (prompt &optional default require-match predicate multiple (default-mode t)) - - "Read buffers with restriction." - - (setq persp-disable-buffer-restriction-once nil) - - (when default - (unless (stringp default) - (if (and (bufferp default) (buffer-live-p default)) - (setq default (buffer-name default)) - (setq default nil)))) - - (if prompt - (setq prompt (car (split-string prompt ": *$" t))) - (setq prompt "Please provide a buffer name: ")) - - (let* ((buffer-names (mapcar #'buffer-name (persp-buffer-list-restricted))) - cp retlst - (done_str "[>done<]") (not-finished default-mode) - - (push-keys (alist-get 'push-item persp-read-multiple-keys)) - (pop-keys (alist-get 'pop-item persp-read-multiple-keys)) - push-keys-backup pop-keys-backup - (toggle-filter-keys - (alist-get 'toggle-persp-buffer-filter persp-read-multiple-keys)) - toggle-filter-keys-backup - - exit-minibuffer-function mb-local-key-map - (persp-minibuffer-setup - #'(lambda () - (setq mb-local-key-map (current-local-map)) - (when (keymapp mb-local-key-map) - (unless exit-minibuffer-function - (setq exit-minibuffer-function - (or (lookup-key mb-local-key-map (kbd "RET")) - persp-read-multiple-exit-minibuffer-function))) - (unless toggle-filter-keys-backup - (setq toggle-filter-keys-backup - (lookup-key mb-local-key-map toggle-filter-keys))) - (define-key mb-local-key-map toggle-filter-keys - #'(lambda () (interactive) - (setq not-finished 'toggle-filter) - (funcall exit-minibuffer-function)))))) - (persp-multiple-minibuffer-setup - #'(lambda () - (when (keymapp mb-local-key-map) - (unless push-keys-backup - (setq push-keys-backup - (lookup-key mb-local-key-map push-keys))) - (define-key mb-local-key-map push-keys - #'(lambda () (interactive) - (setq not-finished 'push) - (funcall exit-minibuffer-function))) - (unless pop-keys-backup - (setq pop-keys-backup - (lookup-key mb-local-key-map pop-keys))) - (define-key mb-local-key-map pop-keys - #'(lambda () (interactive) - (setq not-finished 'pop) - (funcall exit-minibuffer-function))))))) - - (while (member done_str buffer-names) - (setq done_str (concat ">" done_str))) - - (unwind-protect - (progn - (when (and default (not (member default buffer-names))) - (push default buffer-names) - ;; TODO: remove this - ;; (setq default nil) - ) - (when multiple - (add-hook 'minibuffer-setup-hook persp-multiple-minibuffer-setup)) - (add-hook 'minibuffer-setup-hook persp-minibuffer-setup) - (while not-finished - (setq cp - (funcall - persp-interactive-completion-function - (concat prompt - (and default (concat "(default " default ")")) - (and retlst - (concat - "< " (mapconcat #'identity retlst " ") " >")) - ": ") - buffer-names predicate require-match nil nil default)) - (cl-case not-finished - (push - (when (and cp (member cp buffer-names)) - (if retlst - (when (string= cp done_str) - (setq not-finished nil)) - (push done_str buffer-names)) - (when not-finished - (if (eq 'reverse multiple) - (setq retlst (append retlst (list cp))) - (push cp retlst)) - (setq buffer-names (cl-delete cp buffer-names :count 1) - default done_str))) - (when not-finished - (setq not-finished default-mode))) - (pop - (let ((last-item (pop retlst))) - (unless retlst (setq buffer-names (cl-delete done_str buffer-names :count 1) - default nil)) - (when last-item - (push last-item buffer-names))) - (setq not-finished default-mode)) - (toggle-filter - (setq persp-disable-buffer-restriction-once - (not persp-disable-buffer-restriction-once)) - (setq buffer-names - (cl-delete-if - #'(lambda (bn) (member bn retlst)) - (mapcar #'buffer-name - (if persp-disable-buffer-restriction-once - (funcall persp-buffer-list-function) - (cl-delete-if #'persp-buffer-filtered-out-p - (persp-buffer-list-restricted)))))) - (setq not-finished default-mode)) - (t - (when (and cp (not (string= cp done_str)) - (member cp buffer-names)) - (push cp retlst)) - (setq not-finished nil)))) - (if multiple retlst (car retlst))) - (remove-hook 'minibuffer-setup-hook persp-multiple-minibuffer-setup) - (remove-hook 'minibuffer-setup-hook persp-minibuffer-setup) - (when (keymapp mb-local-key-map) - (when multiple - (when (lookup-key mb-local-key-map push-keys) - (define-key mb-local-key-map push-keys push-keys-backup)) - (when (lookup-key mb-local-key-map pop-keys) - (define-key mb-local-key-map pop-keys pop-keys-backup))) - (when (lookup-key mb-local-key-map toggle-filter-keys) - (define-key mb-local-key-map toggle-filter-keys - toggle-filter-keys-backup))) - (setq persp-disable-buffer-restriction-once nil)))) - - -;; Save/Load funcs: - -(defun persp-delete-other-windows () - (let ((win (selected-window))) - (when (or (window-parameter win 'window-side) - (window-minibuffer-p win)) - (setq win (cl-loop - for win in (window-list nil 1) - unless (window-parameter win 'window-side) - return win))) - (when win - (let ((ignore-window-parameters t)) - (condition-case-unless-debug err - (delete-other-windows win) - (error - (message "[persp-mode] Warning: Can not delete-other-windows -- %S" err))))))) - -(cl-defun persp-restore-window-conf (&optional (frame (selected-frame)) - (persp (get-frame-persp frame)) - new-frame-p) - (when new-frame-p (sit-for 0.01)) - (unless (run-hook-with-args-until-success 'persp-restore-window-conf-filter-functions - frame persp new-frame-p) - (with-selected-frame frame - (let ((pwc (safe-persp-window-conf persp)) - (split-width-threshold 2) - (split-height-threshold 2) - (window-safe-min-height 1) - (window-safe-min-width 1) - (window-min-height 1) - (window-min-width 1) - (window-resize-pixelwise t) - (gr-mode (and (boundp 'golden-ratio-mode) golden-ratio-mode))) - (when gr-mode - (golden-ratio-mode -1)) - (unwind-protect - (cond - ((functionp persp-restore-window-conf-method) - (funcall persp-restore-window-conf-method frame persp new-frame-p)) - ((null persp-restore-window-conf-method) nil) - (t - (if pwc - (progn - (persp-delete-other-windows) - (set-window-dedicated-p nil nil) - (condition-case-unless-debug err - (funcall persp-window-state-put-function pwc frame) - (error - (message - "[persp-mode] Warning: Can not restore the window \ -configuration, because of the error -- %S" err) - (let* ((cw (selected-window)) - (cwb (window-buffer cw))) - (unless (persp-contain-buffer-p cwb persp) - (persp-set-another-buffer-for-window - cwb cw persp))))) - (when (and new-frame-p persp-is-ibc-as-f-supported) - (setq initial-buffer-choice - #'(lambda () persp-special-last-buffer)))) - (when persp-reset-windows-on-nil-window-conf - (if (functionp persp-reset-windows-on-nil-window-conf) - (funcall persp-reset-windows-on-nil-window-conf) - (persp-delete-other-windows) - (set-window-dedicated-p nil nil) - (let* ((pbs (safe-persp-buffers persp)) - (w (selected-window)) - (wb (window-buffer w))) - (when (and pbs (not (memq wb pbs))) - (persp-set-another-buffer-for-window wb w persp)))))))) - (when gr-mode - (golden-ratio-mode 1))))))) - - -;; Save funcs - -(cl-defun persp-frame-save-state - (&optional (frame (selected-frame)) set-persp-special-last-buffer) - (when (and (frame-live-p frame) - (not (persp-is-frame-daemons-frame frame)) - (not (frame-parameter frame 'persp-ignore-wconf)) - (not (frame-parameter frame 'persp-ignore-wconf-once))) - (let ((persp (get-frame-persp frame))) - (with-selected-frame frame - (when set-persp-special-last-buffer - (persp-special-last-buffer-make-current)) - (if persp - (setf (persp-window-conf persp) - (funcall persp-window-state-get-function frame)) - (setq persp-nil-wconf - (funcall persp-window-state-get-function frame))))))) - -(cl-defun persp-save-state - (&optional (persp (get-frame-persp)) exfr set-persp-special-last-buffer) - (let ((frame (selected-frame))) - (when (eq frame exfr) (setq frame nil)) - (unless (and frame (eq persp (get-frame-persp frame))) - (setq frame (find-other-frame-with-persp persp exfr t))) - (when frame (persp-frame-save-state frame set-persp-special-last-buffer)))) - - -(defun persp-buffers-to-savelist (persp) - (cl-delete-if - #'symbolp - (let (find-ret) - (mapcar #'(lambda (b) - (setq find-ret nil) - (cl-find-if #'(lambda (sl) (when sl (setq find-ret sl))) - persp-save-buffer-functions - :key #'(lambda (s-f) (with-current-buffer b - (funcall s-f b)))) - find-ret) - (if persp - (persp-buffers persp) - (cl-delete-if-not #'persp-buffer-free-p - (funcall persp-buffer-list-function))))))) - -(defun persp-window-conf-to-savelist (persp) - `(def-wconf ,(if (or persp-use-workgroups - (not (version< emacs-version "24.4"))) - (safe-persp-window-conf persp) - nil))) - -(defun persp-elisp-object-readable-p (obj) - (let (print-length print-level) - (or (stringp obj) - (not (string-match-p "#<.*?>" (prin1-to-string obj)))))) - -(defun persp-parameters-to-savelist (persp) - `(def-params ,(cl-remove-if - #'(lambda (param) - (and (not (persp-elisp-object-readable-p param)) - (message "[persp-mode] Info: The parameter %S \ -of the perspective %S can't be saved." - param (safe-persp-name persp)) - t)) - (safe-persp-parameters persp)))) - -(defun persp-to-savelist (persp) - `(def-persp ,(and persp (persp-name persp)) - ,(persp-buffers-to-savelist persp) - ,(persp-window-conf-to-savelist persp) - ,(persp-parameters-to-savelist persp) - ,(safe-persp-weak persp) - ,(safe-persp-auto persp) - ,(safe-persp-hidden persp))) - -(defun persps-to-savelist (&optional phash names-regexp) - (mapcar - #'persp-to-savelist - (cl-delete-if - (apply-partially #'persp-parameter 'dont-save-to-file) - (if (eq phash *persp-hash*) - (mapcar #'(lambda (pn) - (when (or (not names-regexp) - (persp-string-match-p names-regexp pn)) - (persp-get-by-name pn *persp-hash* nil))) - (persp-names-current-frame-fast-ordered)) - (persp-persps (or phash *persp-hash*) names-regexp t))))) - -(defsubst persp-save-with-backups (fname) - (when (and (string= fname - (concat (expand-file-name persp-save-dir) - persp-auto-save-fname)) - (> persp-auto-save-num-of-backups 0)) - (cl-do ((cur persp-auto-save-num-of-backups (1- cur)) - (prev (1- persp-auto-save-num-of-backups) (1- prev))) - ((> 1 cur) nil) - (let ((cf (concat fname (number-to-string cur))) - (pf (concat fname (if (> prev 0) - (number-to-string prev) - "")))) - (when (file-exists-p pf) - (when (file-exists-p cf) - (delete-file cf)) - (rename-file pf cf t)))) - (when (file-exists-p fname) - (rename-file fname (concat fname (number-to-string 1)) t))) - (write-file fname nil) - t) - -(cl-defun persp-save-state-to-file - (&optional - (fname persp-auto-save-fname) (phash *persp-hash*) - (respect-persp-file-parameter persp-auto-save-persps-to-their-file) - (keep-others-in-non-parametric-file 'no)) - (interactive (list (read-file-name "Save perspectives to a file: " - persp-save-dir ""))) - (when (and (stringp fname) phash) - (when (< (string-width (file-name-nondirectory fname)) 1) - (message "[persp-mode] Error: You must provide nonempty filename to save perspectives.") - (cl-return-from persp-save-state-to-file nil)) - (let* ((p-save-dir (or (file-name-directory fname) - (expand-file-name persp-save-dir))) - (p-save-file (concat p-save-dir (file-name-nondirectory fname)))) - (unless (and (file-exists-p p-save-dir) - (file-directory-p p-save-dir)) - (message "[persp-mode] Info: Trying to create the `persp-conf-dir'.") - (make-directory p-save-dir t)) - (if (not (and (file-exists-p p-save-dir) - (file-directory-p p-save-dir))) - (progn - (message "[persp-mode] Error: Can't save perspectives -- \ -`persp-save-dir' does not exists or not a directory %S." p-save-dir) - nil) - (mapc #'persp-save-state (persp-persps phash)) - (run-hook-with-args 'persp-before-save-state-to-file-functions - fname phash respect-persp-file-parameter) - (if (and respect-persp-file-parameter - (cl-member-if (apply-partially #'persp-parameter 'persp-file) - (persp-persps phash nil))) - (let (persp-auto-save-persps-to-their-file - persp-before-save-state-to-file-functions) - (mapc #'(lambda (gr) - (cl-destructuring-bind (pfname . pl) gr - (let ((names (mapcar #'safe-persp-name pl))) - (if pfname - (persp-save-to-file-by-names - pfname phash names 'yes nil) - (persp-save-to-file-by-names - p-save-file phash names - keep-others-in-non-parametric-file nil))))) - (persp-group-by - (apply-partially #'persp-parameter 'persp-file) - (persp-persps phash nil t) t))) - (with-temp-buffer - (buffer-disable-undo) - (erase-buffer) - (goto-char (point-min)) - (insert - ";; -*- mode: emacs-lisp; eval: (progn (pp-buffer) (indent-buffer)) -*-") - (newline) - (insert (let (print-length print-level) - (pp-to-string (persps-to-savelist phash)))) - (persp-save-with-backups p-save-file))))))) - -(cl-defun persp-save-to-file-by-names - (&optional (fname persp-auto-save-fname) (phash *persp-hash*) names - keep-others (called-interactively-p (called-interactively-p 'any))) - (interactive) - (unless names - (setq names - (persp-read-persp - "to save" 'reverse (safe-persp-name (get-current-persp)) - t nil nil nil nil 'push))) - (when (or (not fname) called-interactively-p) - (setq fname (read-file-name - (format "Save a subset of perspectives%s to a file: " names) - persp-save-dir))) - (when names - (unless keep-others - (setq keep-others - (if (and (file-exists-p fname) - (yes-or-no-p "Keep other perspectives in the file?")) - 'yes 'no))) - (let ((temphash (make-hash-table :test 'equal :size 10)) - (persp-nil-wconf persp-nil-wconf) - (persp-nil-parameters (copy-tree persp-nil-parameters)) - (persp-nil-hidden persp-nil-hidden) - bufferlist-diff) - (when (or (eq keep-others 'yes) (eq keep-others t)) - (let ((bufferlist-pre - (mapcar #'(lambda (b) (cons b (persp--buffer-in-persps b))) - (funcall persp-buffer-list-function)))) - (persp-load-state-from-file - fname temphash (cons :not (regexp-opt names))) - (setq bufferlist-diff - (cl-delete-if #'(lambda (bcons) - (when bcons - (cl-destructuring-bind (buf . buf-persps) bcons - (when buf - (persp--buffer-in-persps-set buf buf-persps) - t)))) - (funcall persp-buffer-list-function) - :key #'(lambda (b) (assq b bufferlist-pre)))))) - (mapc #'(lambda (p) - (persp-add p temphash) - (when (and p persp-auto-save-persps-to-their-file) - (set-persp-parameter 'persp-file fname p))) - (mapcar #'(lambda (pn) (persp-get-by-name pn phash)) names)) - (persp-save-state-to-file fname temphash nil) - (mapc #'kill-buffer bufferlist-diff)))) - -(defun persp-tramp-save-buffer (b) - (let* ((buf-f-name (buffer-file-name b)) - (persp-tramp-file-name - (when (and (or (featurep 'tramp) (require 'tramp nil t)) - (tramp-tramp-file-p buf-f-name)) - (let ((dissected-f-name (tramp-dissect-file-name buf-f-name)) - tmh) - (if (tramp-file-name-method dissected-f-name) - (when (and - (or (featurep 'tramp-sh) (require 'tramp-sh nil t)) - (fboundp 'tramp-compute-multi-hops) - (setq tmh - (condition-case-unless-debug err - (tramp-compute-multi-hops dissected-f-name) - (error nil)))) - (let ((persp-tramp-file-name tramp-prefix-format)) - (while tmh - (let* ((hop (car tmh)) - (method (tramp-file-name-method hop)) - (user (tramp-file-name-user hop)) - (host (tramp-file-name-host hop)) - (port (tramp-file-name-port hop)) - (filename (tramp-file-name-localname hop))) - (setq persp-tramp-file-name - (concat - persp-tramp-file-name - method tramp-postfix-method-format - user (when user tramp-postfix-user-format) - host - (when port tramp-prefix-port-format) - port - (if (= (string-width filename) 0) - tramp-postfix-hop-format - (concat - tramp-postfix-host-format filename))) - tmh (cdr tmh)))) - persp-tramp-file-name)) - buf-f-name))))) - (when persp-tramp-file-name - `(def-buffer ,(buffer-name b) - ,persp-tramp-file-name - ,(buffer-local-value 'major-mode b))))) - -;; Load funcs - -(defun persp-update-frames-window-confs (&optional persp-names) - (mapc #'persp-restore-window-conf - (if persp-names - (cl-delete-if-not - #'(lambda (pn) (member pn persp-names)) - (persp-frame-list-without-daemon) - :key #'(lambda (f) (safe-persp-name (get-frame-persp f)))) - (persp-frame-list-without-daemon)))) - -(defmacro persp-car-as-fun-cdr-as-args (lst) - (let ((kar (gensym "lst-car"))) - `(let* ((,kar (car-safe ,lst)) - (args (cdr-safe ,lst)) - (fun (or (condition-case-unless-debug err - (symbol-function ,kar) - (error nil)) - (symbol-value ,kar)))) - (if (functionp fun) - (apply fun args) - (message "[persp-mode] Error: %S is not a function." fun))))) - -(defvar def-buffer nil) -(defun persp-buffer-from-savelist (savelist) - (when (eq (car savelist) 'def-buffer) - (let (persp-add-buffer-on-find-file - buf - (def-buffer - #'(lambda (bname fname mode &optional parameters) - (setq buf (persp-get-buffer-or-null bname)) - (if buf - (if (or (null fname) - (string= fname (buffer-file-name buf))) - buf - (if (file-exists-p fname) - (setq buf (find-file-noselect fname)) - (message - "[persp-mode] Warning: The file %S no longer exists." - fname) - (setq buf nil))) - (if (and fname (file-exists-p fname)) - (with-current-buffer (setq buf (find-file-noselect fname)) - (unless (string= bname (buffer-name buf)) - (rename-buffer bname t))) - (when fname - (message - "[persp-mode] Warning: The file %S no longer exists." - fname)) - (setq buf (get-buffer-create bname)))) - (when (buffer-live-p buf) - (cl-macrolet - ((restorevars - () - `(mapc - #'(lambda (varcons) - (cl-destructuring-bind (vname . vvalue) varcons - (unless (or (eq vname 'buffer-file-name) - (eq vname 'major-mode)) - (set (make-local-variable vname) vvalue)))) - (alist-get 'local-vars parameters)))) - (with-current-buffer buf - (restorevars) - (cond - ((and (boundp 'persp-load-buffer-mode-restore-function) - (variable-binding-locus 'persp-load-buffer-mode-restore-function) - (functionp persp-load-buffer-mode-restore-function)) - (funcall persp-load-buffer-mode-restore-function mode) - (restorevars)) - ((functionp mode) - (when (and (not (eq major-mode mode)) - (not (eq major-mode 'not-loaded-yet))) - (funcall mode) - (restorevars))))))) - buf))) - (condition-case-unless-debug err - (persp-car-as-fun-cdr-as-args savelist) - (error - (message "[persp-mode] Error details: %S" savelist) - (message "[persp-mode] Error: persp-buffer-from-savelist failed to restore a buffer -- %S" err) - buf))))) - -(defun persp-buffers-from-savelist-0 (savelist) - (cl-delete-if-not - #'persp-get-buffer-or-null - (let (find-ret) - (mapcar - #'(lambda (saved-buf) - (setq find-ret nil) - (cl-find-if - #'(lambda (lb) (when lb (setq find-ret lb))) - persp-load-buffer-functions - :key #'(lambda (l-f) - (condition-case-unless-debug err - (funcall l-f saved-buf) - (error - (message "[persp-mode] Error details: %S" saved-buf) - (message "[persp-mode] Error: Failed to resume buffer using %S load buffer function -- %S" l-f err) - nil)))) - find-ret) - savelist)))) - -(defvar def-wconf nil) -(defun persp-window-conf-from-savelist-0 (savelist) - (let ((def-wconf #'identity)) - (persp-car-as-fun-cdr-as-args savelist))) - -(defvar def-params nil) -(defun persp-parameters-from-savelist-0 (savelist) - (let ((def-params #'identity)) - (persp-car-as-fun-cdr-as-args savelist))) - -(defvar def-persp nil) -(defun persp-from-savelist-0 (savelist phash persp-file) - (let ((def-persp - #'(lambda (name dbufs dwc &optional dparams weak auto hidden) - (let* ((pname (or name persp-nil-name)) - (persp (persp-add-new pname phash))) - (mapc #'(lambda (b) - (persp-add-buffer b persp nil nil)) - (condition-case-unless-debug err - (persp-buffers-from-savelist-0 dbufs) - (error - (message "[persp-mode] Error details: %S" dbufs) - (message "[persp-mode] Error: failed to load buffers for %S perspective from %S file -- %S" pname persp-file err) - nil))) - (let ((loaded-wconf - (condition-case-unless-debug err - (persp-window-conf-from-savelist-0 dwc) - (error - (message "[persp-mode] Error details: %S" dwc) - (message "[persp-mode] Error: failed to load window configuration for %S perspective from %S file -- %S" pname persp-file err) - nil)))) - (if (and persp loaded-wconf) - (setf (persp-window-conf persp) loaded-wconf) - (setq persp-nil-wconf loaded-wconf))) - (modify-persp-parameters - (condition-case-unless-debug err - (persp-parameters-from-savelist-0 dparams) - (error - (message "[persp-mode] Error details: %S" dparams) - (message "[persp-mode] Error: Failed to load %S perspective parameters from %S file -- %S" pname persp-file err) - nil)) - persp) - (when persp - (setf (persp-weak persp) weak - (persp-auto persp) auto)) - - (if persp - (setf (persp-hidden persp) hidden) - (setq persp-nil-hidden hidden)) - - (when persp-file - (set-persp-parameter 'persp-file persp-file persp)) - pname)))) - (persp-car-as-fun-cdr-as-args savelist))) - -(defun persps-from-savelist-0 - (savelist phash persp-file set-persp-file names-regexp) - (when (and names-regexp (not (consp names-regexp))) - (setq names-regexp (cons t names-regexp))) - (delq nil - (mapcar #'(lambda (pd) - (condition-case-unless-debug err - (persp-from-savelist-0 pd phash (and set-persp-file persp-file)) - (error - (message "[persp-mode] Error details: %S" pd) - (message "[persp-mode] Error: Can not load a perspective from %S file -- %S" persp-file err) - nil))) - (if names-regexp - (cl-delete-if-not - (apply-partially #'persp-string-match-p names-regexp) - savelist - :key #'(lambda (pd) (or (cadr pd) persp-nil-name))) - savelist)))) - -(defun persp-names-from-savelist-0 (savelist) - (mapcar #'(lambda (pd) (or (cadr pd) persp-nil-name)) savelist)) - -(defun persps-savelist-version-string (savelist) - (let* ((version-list (car savelist)) - (version (or (and (eq (car version-list) - 'def-persp-save-format-version) - (cadr version-list)) - 0))) - (list - (format "%S" version) - (if (eql version 0) - savelist - (cdr savelist))))) - -(defun persp-dispatch-loadf-version (funsym savelist) - (cl-destructuring-bind (version s-list) - (persps-savelist-version-string savelist) - (let ((funame (intern (concat (symbol-name funsym) "-" version)))) - (if (fboundp funame) - (list funame s-list) - (message - "[persp-mode] Warning: Can not find load function for this version: %S." - version) - (list nil s-list))))) - -(defun persps-from-savelist - (savelist phash persp-file set-persp-file names-regexp) - (cl-destructuring-bind (fun s-list) - (persp-dispatch-loadf-version 'persps-from-savelist savelist) - (if fun - (let ((persp-names - (funcall fun s-list phash persp-file set-persp-file names-regexp))) - (run-hook-with-args 'persp-after-load-state-functions persp-file phash - persp-names) - persp-names) - (message - "[persp-mode] Error: Can not load perspectives from savelist: %S -\tloaded from %S" savelist persp-file) - nil))) - -(defun persp-list-persp-names-in-file (fname) - (when (and fname (file-exists-p fname)) - (let* ((pslist (with-temp-buffer - (buffer-disable-undo) - (insert-file-contents fname nil nil nil t) - (goto-char (point-min)) - (read (current-buffer))))) - (cl-destructuring-bind (fun s-list) - (persp-dispatch-loadf-version 'persp-names-from-savelist pslist) - (if fun - (funcall fun s-list) - (message - "[persp-mode] Error: Can not list perspective names in file %S." - fname)))))) - - -(cl-defun persp-load-state-from-file - (&optional (fname persp-auto-save-fname) (phash *persp-hash*) - names-regexp set-persp-file) - (interactive (list (read-file-name "Load perspectives from a file: " - persp-save-dir))) - (when fname - (let ((p-save-file (concat (or (file-name-directory fname) - (expand-file-name persp-save-dir)) - (file-name-nondirectory fname)))) - (if (not (file-exists-p p-save-file)) - (progn (message "[persp-mode] Error: No such file -- %S." p-save-file) - nil) - (let ((readed-list - (with-temp-buffer - (buffer-disable-undo) - (insert-file-contents p-save-file nil nil nil t) - (goto-char (point-min)) - (read (current-buffer))))) - (persps-from-savelist - readed-list phash p-save-file set-persp-file names-regexp)))))) - -(cl-defun persp-load-from-file-by-names (&optional (fname persp-auto-save-fname) - (phash *persp-hash*) - names) - (interactive - (list (read-file-name "Load a subset of perspectives from a file: " - persp-save-dir))) - (unless names - (let* ((p-save-file (concat (or (file-name-directory fname) - (expand-file-name persp-save-dir)) - (file-name-nondirectory fname))) - (available-names (persp-list-persp-names-in-file p-save-file))) - (setq names - (persp-read-persp - "to load" 'reverse nil t nil nil available-names nil 'push)))) - (when names - (let ((names-regexp (regexp-opt names))) - (persp-load-state-from-file fname phash names-regexp t)))) - - -(provide 'persp-mode) - -;;; persp-mode.el ends here diff --git a/org/elpa/persp-mode-20230110.1045/persp-mode-autoloads.el b/org/elpa/persp-mode-20230110.1045/persp-mode-autoloads.el deleted file mode 100644 index b375c0c..0000000 --- a/org/elpa/persp-mode-20230110.1045/persp-mode-autoloads.el +++ /dev/null @@ -1,69 +0,0 @@ -;;; persp-mode-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "persp-mode" "persp-mode.el" (0 0 0 0)) -;;; Generated autoloads from persp-mode.el - -(autoload 'persp-def-auto-persp "persp-mode" "\ - - -\(fn NAME &rest KEYARGS &key BUFFER-NAME FILE-NAME MODE MODE-NAME MINOR-MODE MINOR-MODE-NAME PREDICATE HOOKS DYN-ENV GET-NAME GET-BUFFER GET-PERSP SWITCH PARAMETERS NOAUTO WEAK USER-DATA ON-MATCH AFTER-MATCH DONT-PICK-UP-BUFFERS DELETE)" nil nil) - -(define-obsolete-function-alias 'def-auto-persp 'persp-def-auto-persp "persp-mode 2.9.6") - -(autoload 'persp-def-buffer-save/load "persp-mode" "\ - - -\(fn &rest KEYARGS &key BUFFER-NAME FILE-NAME MODE MODE-NAME MINOR-MODE MINOR-MODE-NAME PREDICATE TAG-SYMBOL SAVE-VARS SAVE-FUNCTION LOAD-FUNCTION AFTER-LOAD-FUNCTION MODE-RESTORE-FUNCTION APPEND)" nil nil) - -(define-obsolete-function-alias 'def-persp-buffer-save/load 'persp-def-buffer-save/load "persp-mode 2.9.6") - -(defvar persp-mode nil "\ -Non-nil if Persp mode is enabled. -See the `persp-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 `persp-mode'.") - -(custom-autoload 'persp-mode "persp-mode" nil) - -(autoload 'persp-mode "persp-mode" "\ -Toggle the persp-mode. -When active, keeps track of multiple 'perspectives', -named collections of buffers and window configurations. -Here is a keymap of this minor mode: -\\{persp-mode-map} - -This is a minor mode. If called interactively, toggle the `Persp -mode' mode. If the prefix argument is positive, enable the mode, -and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='persp-mode)'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -\(fn &optional ARG)" t nil) - -(register-definition-prefixes "persp-mode" '("*persp-" "clear-window-persp" "def-" "get-" "ido-toggle-persp-filter" "persp" "safe-persp-" "set-" "window-persp-set-p" "with-persp-ido-hooks")) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; persp-mode-autoloads.el ends here diff --git a/org/elpa/persp-mode-20230110.1045/persp-mode-pkg.el b/org/elpa/persp-mode-20230110.1045/persp-mode-pkg.el deleted file mode 100644 index 7e7a19d..0000000 --- a/org/elpa/persp-mode-20230110.1045/persp-mode-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from persp-mode.el -*- no-byte-compile: t -*- -(define-package "persp-mode" "20230110.1045" "windows/buffers sets shared among frames + save/load." '((emacs "24.3")) :commit "df95ea710e2a72f7a88293b72137acb0ca024d90" :authors '(("Constantin Kulikov (Bad_ptr)" . "zxnotdead@gmail.com")) :maintainer '("Constantin Kulikov (Bad_ptr)" . "zxnotdead@gmail.com") :keywords '("perspectives" "session" "workspace" "persistence" "windows" "buffers" "convenience") :url "https://github.com/Bad-ptr/persp-mode.el") diff --git a/org/elpa/persp-mode-20230110.1045/persp-mode.el b/org/elpa/persp-mode-20230110.1045/persp-mode.el deleted file mode 100644 index 73f0900..0000000 --- a/org/elpa/persp-mode-20230110.1045/persp-mode.el +++ /dev/null @@ -1,4175 +0,0 @@ -;;; persp-mode.el --- windows/buffers sets shared among frames + save/load. -*- lexical-binding: t; -*- - -;; Copyright (C) 2012 Constantin Kulikov - -;; Author: Constantin Kulikov (Bad_ptr) -;; Version: 3.0.7 -;; Package-Version: 20230110.1045 -;; Package-Commit: df95ea710e2a72f7a88293b72137acb0ca024d90 -;; Package-Requires: ((emacs "24.3")) -;; Keywords: perspectives, session, workspace, persistence, windows, buffers, convenience -;; URL: https://github.com/Bad-ptr/persp-mode.el - -;;; License: - -;; This file is not part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: - -;; Based on the perspective.el by Natalie Weizenbaum -;; (http://github.com/nex3/perspective-el) but the perspectives are shared -;; among the frames and could be saved/restored from/to a file. -;; -;; Homepage: https://github.com/Bad-ptr/persp-mode.el - -;; Installation: - -;; From the MELPA: M-x package-install RET persp-mode RET -;; From a file: M-x package-install-file RET 'path to this file' RET -;; Or put this file into your load-path. - -;; Configuration: - -;; When installed through the package-install: -;; (with-eval-after-load "persp-mode-autoloads" -;; (setq wg-morph-on nil) -;; ;; switch off the animation of restoring window configuration -;; (setq persp-autokill-buffer-on-remove 'kill-weak) -;; (add-hook 'after-init-hook #'(lambda () (persp-mode 1)))) - -;; When installed without generating an autoloads file: -;; (with-eval-after-load "persp-mode" -;; ;; .. all settings you want here -;; (add-hook 'after-init-hook #'(lambda () (persp-mode 1)))) -;; (require 'persp-mode) - -;; Dependencies: - -;; The ability to save/restore window configurations from/to a file -;; depends on the workgroups.el(https://github.com/tlh/workgroups.el) -;; for the emacs versions < 24.4 - -;; Customization: - -;; M-x: customize-group RET persp-mode RET - -;; You can read more in README.md - - -;;; Code: - - -;; Prerequirements: - -(require 'cl-lib) -(require 'easymenu) - -(declare-function golden-ratio-mode "ext:golden-ratio") -(declare-function tabbar-buffer-list "ext:tabbar-mode") - -(declare-function tramp-dissect-file-name "tramp") -(declare-function tramp-file-name-hop "tramp") -(declare-function tramp-file-name-host "tramp") -(declare-function tramp-file-name-localname "tramp") -(declare-function tramp-file-name-method "tramp") -(declare-function tramp-file-name-user "tramp") -(declare-function tramp-tramp-file-p "tramp") - -(defvar ido-cur-item) -(defvar ido-exit) -(defvar ido-temp-list) -(defvar ido-text) -(defvar ido-text-init) -(defvar tabbar-buffer-list-function) - -(defvar persp-mode nil) - -(defconst persp-not-persp :nil - "Something that is not a perspective.") - -(unless (fboundp 'condition-case-unless-debug) - (defalias 'condition-case-unless-debug 'condition-case-no-debug)) -(unless (fboundp 'read-multiple-choice) - (defun read-multiple-choice (prompt choices) - (let ((choice-chars (mapcar #'car choices))) - (when choice-chars - (assq (read-char-choice - (format "%s(%s): " - (substring prompt 0 (string-match ": $" prompt)) - (mapconcat #'(lambda (ch) - (format "[%c] - %s" (car ch) (cadr ch))) - choices "; ")) - choice-chars) - choices))))) -(unless (fboundp 'alist-get) - (defun alist-get (key alist &optional default remove) - (ignore remove) ;;Silence byte-compiler. - (let ((x (assq key alist))) - (if x (cdr x) default)))) - - -;; Customization variables: - -(unless - (memq 'custom-group (symbol-plist 'session)) - (defgroup session nil - "Emacs' state(opened files, buffers, windows, etc.)" - :group 'environment)) - -(defgroup persp-mode nil - "Customization of the `persp-mode'." - :prefix "persp-" - :group 'session - :link '(url-link - :tag "Github page" "https://github.com/Bad-ptr/persp-mode.el")) - -(defcustom persp-nil-name "none" - "Name for the nil perspective." - :group 'persp-mode - :type 'string - :set #'(lambda (sym val) - (when val - (when persp-mode - (cl-destructuring-bind (frames . windows) - (persp-frames-and-windows-with-persp - (persp-get-by-name persp-nil-name *persp-hash* nil)) - (dolist (win windows) - (when (equal persp-nil-name (get-window-persp* win)) - (set-window-persp* win val)))) - (run-hook-with-args - 'persp-renamed-functions nil persp-nil-name val)) - (custom-set-default sym val)))) - -(defface persp-face-lighter-buffer-not-in-persp - '((default . (:background "#F00" :foreground "#00F" :weight bold))) - "Face for the lighter when the current buffer is not in a perspective." - :group 'persp-mode) -(defface persp-face-lighter-nil-persp - '((t :inherit bold-italic)) - "Face for the lighter when the current perspective is nil." - :group 'persp-mode) -(defface persp-face-lighter-default - '((t :inherit italic)) - "Default face for the lighter.") - -(defcustom persp-lighter - '(:eval - (format - (propertize - " #%.5s" - 'face (let ((persp (get-current-persp))) - (if persp - (if (persp-contain-buffer-p (current-buffer) persp) - 'persp-face-lighter-default - 'persp-face-lighter-buffer-not-in-persp) - 'persp-face-lighter-nil-persp))) - (safe-persp-name (get-current-persp)))) - "Defines how the persp-mode show itself in the modeline." - :group 'persp-mode - :type 'sexp) - -(defcustom persp-save-dir (expand-file-name "persp-confs/" user-emacs-directory) - "The directory to/from where perspectives saved/loaded by default. -Autosave files are saved and loaded to/from this directory." - :group 'persp-mode - :type 'directory) - -(defcustom persp-auto-save-fname "persp-auto-save" - "Name of the file for auto save/load perspectives on the persp-mode -deactivation or the emacs shutdown." - :group 'persp-mode - :type 'string) - -(defcustom persp-auto-save-persps-to-their-file t - "If t -- then a perspective will be autosaved to a file specified -in the `persp-file' perspective parameter." - :group 'persp-mode - :type 'boolean) - -(defcustom persp-auto-save-persps-to-their-file-before-kill nil - "Whether or not perspectives will be saved before killed." - :group 'persp-mode - :type '(choice - (const :tag "Save perspectives which have `persp-file' parameter" - :value persp-file) - (const :tag "Save all perspectives" :value t) - (const :tag "Don't save just kill" :value nil))) - -(defcustom persp-auto-save-opt 2 - "This variable controls the autosave functionality of the persp-mode: -0 -- do not auto save; -1 -- save on the emacs shutdown and only if the persp-mode active; -2 -- save on the persp-mode deactivation or the emacs shutdown." - :group 'persp-mode - :type '(choice - (const :tag "Do not save" :value 0) - (const :tag "Save on exit" :value 1) - (const :tag "Save on exit and persp-mode deactivation" :value 2))) - -(defcustom persp-auto-save-num-of-backups 3 - "How many autosave file backups to keep." - :group 'persp-mode - :type 'integer) - -(defcustom persp-auto-resume-time 3.0 - "Delay time in seconds before loading from the autosave file. -If <= 0 -- do not autoresume." - :group 'persp-mode - :type 'float) - -(defcustom persp-set-last-persp-for-new-frames t - "If nil new frames will be created with the 'nil' perspective, -otherwise with a last activated perspective." - :group 'persp-mode - :type 'boolean) - -(defcustom persp-reset-windows-on-nil-window-conf t - "t -- When a perspective without a window configuration is activated -then delete all windows and show the *scratch* buffer; -function -- run that function; -nil -- do nothing." - :group 'persp-mode - :type '(choice - (const :tag "Delete all windows" :value t) - (const :tag "Do nothing" :value nil) - (function :tag "Run function" :value (lambda () nil)))) - - -(define-widget 'persp-buffer-list-restriction-choices 'lazy - "Variants of how the buffer-list can be restricted." - :offset 4 - :tag "\nControl the persp-buffer-list-restricted behaviour" - :type '(choice - (const :tag "List all buffers" :value -1) - (const :tag "List current perspective buffers" :value 0) - (const :tag "List buffers that aren't in the perspective" :value 1) - (const :tag "List buffers which unique to the perspective" :value 2) - (const :tag "List unique buffers, but show all for the nil perspective" - :value 2.5) - (const :tag "List free buffers" :value 3) - (const :tag "List free buffers, but show all for the nil perspective" - :value 3.5))) - -(defcustom *persp-restrict-buffers-to* 0 - "Controls the behaviour of the `persp-buffer-list-restricted' function." - :group 'persp-mode - :type '(choice - persp-buffer-list-restriction-choices - (function :tag "\nRun function with frame as an argument" - :value (lambda (f) (buffer-list f))))) - -(defcustom persp-restrict-buffers-to-if-foreign-buffer nil - "Override the *persp-restrict-buffers-to* if the current buffer is not in the -current perspective. If nil -- do not override." - :group 'persp-mode - :type '(choice - (const :tag "Do not override" :value nil) - persp-buffer-list-restriction-choices - (function :tag "\nRun function with frame as an argument" - :value (lambda (f) (buffer-list f))))) - -(defcustom persp-set-frame-buffer-predicate 'restricted-buffer-list - "t -- set the frame's buffer-predicate parameter to a function returning `t' - for buffers in current persp; -nil -- do not set the buffer-predicate; -restricted-buffer-list -- return t for buffers contained in the list returned - from the persp-buffer-list-restricted called without arguments; -number -- the same meaning as for the `*persp-restrict-buffers-to*'; -function -- use that function as buffer-predicate." - :group 'persp-mode - :type '(choice - (const :tag "\nConstrain to current perspective's buffers." - :value t) - (const :tag "\nDo not set frames' buffer-predicate parameter." - :value nil) - (const :tag "\nConstrain with persp-buffer-list-restricted." - :value restricted-buffer-list) - persp-buffer-list-restriction-choices - (function - :tag "\nConstrain with a function which take buffer as an argument." - :value (lambda (b) b))) - :set - #'(lambda (sym val) - (custom-set-default sym val) - (if val - (if persp-mode - (persp-update-frames-buffer-predicate) - (if (and (not (daemonp)) (null (cdr (frame-list)))) - (let (th) - (setq - th #'(lambda () - (run-at-time - 10 nil #'(lambda () - (remove-hook 'window-setup-hook th) - (persp-update-frames-buffer-predicate))))) - (add-hook 'window-setup-hook th)) - (add-hook 'persp-mode-hook - #'persp-update-frames-buffer-predicate))) - (persp-update-frames-buffer-predicate t)))) - -;; TODO: remove this var -(defcustom persp-hook-up-emacs-buffer-completion nil - "If t -- try to restrict read-buffer function of the current completion system." - :group 'persp-mode - :type 'boolean) -(make-obsolete-variable - 'persp-hook-up-emacs-buffer-completion - "`persp-set-read-buffer-function', `persp-set-ido-hooks', `persp-interactive-completion-function'" - "persp-mode 2.6") - -(defsubst persp-set-read-buffer-function (&optional opt) - (if opt - (when (not (eq read-buffer-function #'persp-read-buffer)) - (setq persp-saved-read-buffer-function read-buffer-function) - (setq read-buffer-function #'persp-read-buffer)) - (when (eq read-buffer-function #'persp-read-buffer) - (setq read-buffer-function persp-saved-read-buffer-function)))) -(defcustom persp-set-read-buffer-function nil - "If t -- set the read-buffer-function to persp-read-buffer." - :group 'persp-mode - :type 'boolean - :set #'(lambda (sym val) - (custom-set-default sym val) - (when persp-mode - (persp-set-read-buffer-function val)))) - -(defsubst persp-set-ido-hooks (&optional opt) - (if opt - (progn - (add-hook 'ido-make-buffer-list-hook #'persp-restrict-ido-buffers) - (add-hook 'ido-setup-hook #'persp-ido-setup)) - (remove-hook 'ido-make-buffer-list-hook #'persp-restrict-ido-buffers) - (remove-hook 'ido-setup-hook #'persp-ido-setup))) -(defcustom persp-set-ido-hooks nil - "If t -- set the ido hooks for buffer list restriction." - :group 'persp-mode - :type 'boolean - :set #'(lambda (sym val) - (custom-set-default sym val) - (when persp-mode - (persp-set-ido-hooks val)))) - -;; TODO: remove this var, just call the completing-read -(defvar persp-interactive-completion-function #'completing-read - "The function which is used by the persp-mode -to interactivly read user input with completion.") -(make-obsolete-variable - 'persp-interactive-completion-function - "`completing-read-function'" "persp-mode 2.7") - -(defun persp-update-completion-system (&optional system remove) - (interactive "i") - (when (and (not system) (not remove)) - (setq - system - (intern - (funcall persp-interactive-completion-function - "Set the completion system for persp-mode: " - '("ido" "completing-read") - nil t)))) - (if remove - (progn - (when (boundp 'persp-interactive-completion-system) - (when persp-hook-up-emacs-buffer-completion - (cl-case persp-interactive-completion-system - (ido (persp-set-ido-hooks)) - (t nil)))) - (setq persp-interactive-completion-function #'completing-read) - (custom-set-default 'persp-interactive-completion-system - 'completing-read)) - (persp-update-completion-system nil t) - (when system - (custom-set-default 'persp-interactive-completion-system system) - (when persp-hook-up-emacs-buffer-completion - (cl-case persp-interactive-completion-system - (ido - (persp-set-ido-hooks t) - (setq persp-interactive-completion-function #'ido-completing-read)) - (t nil)) - (persp-set-toggle-read-buffer-filter-keys - persp-toggle-read-buffer-filter-keys))))) - -;; TODO: remove this var -(defcustom persp-interactive-completion-system 'completing-read - "What completion system to use." - :group 'persp-mode - :type '(choice - (const :tag "ido" :value ido) - (const :tag "completing-read" :value completing-read)) - :set #'(lambda (sym val) - (if persp-mode - (persp-update-completion-system val) - (custom-set-default sym val)))) -(make-obsolete-variable - 'persp-interactive-completion-system - "`persp-set-read-buffer-function', `persp-set-ido-hooks', `persp-interactive-completion-function'" - "persp-mode 2.6") - -(define-widget 'persp-init-frame-behaviour-choices 'lazy - "Choices of the init-frame behavoiurs for the persp-mode." - :offset 4 - :tag "\nControl how frames initialized by persp-mode" - :type - '(choice - (const :tag "Restore window-configuration" :value t) - (const :tag "Do not restore window-configuration" :value nil) - (const :tag "Set persp-ignore-wconf flag for frame" - :value persp-ignore-wconf) - (const :tag "Set persp-ignore-wconf-once flag for frame" - :value persp-ignore-wconf-once) - (const :tag "Create a new random auto-perspective for the new frame" - :value auto-temp) - (const - :tag "Create a new perspective for the new frame and prompt for it's name" - :value prompt) - (string :tag "Use/create the perspective with a name" :value "pfnf") - (function :tag "Run this function" - :value (lambda (frame &optional new-frame-p) nil)))) - -(defcustom persp-init-frame-behaviour t - "Control the behaviour of how frames initialized." - :group 'persp-mode - :type 'persp-init-frame-behaviour-choices) - -(defcustom persp-init-new-frame-behaviour-override -1 - "Override the `persp-init-frame-behaviour` for new frames." - :group 'persp-mode - :type '(choice - (const :tag "Do not override" : value -1) - persp-init-frame-behaviour-choices)) - -(defcustom persp-interactive-init-frame-behaviour-override -1 - "Override the `persp-init-frame-behaviour' -when the `make-frame' was called interactively." - :group 'persp-mode - :type '(choice - (const :tag "Do not override" :value -1) - persp-init-frame-behaviour-choices)) - -(defcustom persp-emacsclient-init-frame-behaviour-override -1 - "Override the `persp-init-frame-behaviour' variable for frames created using -the emacsclient -[c|t]." - :group 'persp-mode - :type '(choice - (const :tag "Do not override" :value -1) - persp-init-frame-behaviour-choices)) - -(defcustom persp-server-switch-behaviour 'only-file-windows-for-client-frame - "Controls the behaviour of the server-switch-hook." - :group 'persp-mode - :type - '(choice - (const :tag "Do nothing" :value nil) - (const :tag "Leave only windows displaing files for edit -(files that was supplied as parameters to emacsclient)" - :value only-file-windows) - (const :tag "For the new frame(created by emacsclient -c ...) -leave only windows displaing files for edit" - :value only-file-windows-for-client-frame) - (function :tag "Run this function" :value (lambda (frame buflist) nil))) - :set - #'(lambda (sym val) - (custom-set-default sym val) - (if persp-mode - (persp-update-frame-server-switch-hook) - (add-hook 'persp-mode-hook #'persp-update-frame-server-switch-hook)))) - -;; TODO: remove this var -(defcustom persp-ignore-wconf-of-frames-created-to-edit-file t - "If t -- set the persp-ignore-wconf frame parameter -to t for frames that were created by emacsclient with file arguments. -Also delete windows not showing that files -(this is because server-switch-hook runs after after-make-frames); -If function -- run that function." - :group 'persp-mode - :type '(choice - (const :tag "Ignore window configuration" :value t) - (const :tag "Do as usual" :value nil) - (function :tag "Run function" :value (lambda () nil)))) -(make-obsolete-variable - 'persp-ignore-wconf-of-frames-created-to-edit-file - "`persp-emacsclient-frame-to-edit-file-behavoiur'" "persp-mode 2.0") - -(defcustom persp-add-buffer-on-find-file t - "If t -- add a buffer with opened file to current perspective." - :group 'persp-mode - :type - '(choice - (const :tag "Always add" :value t) - (const :tag "Newer add" :value nil) - (const - :tag "\nAdd if not matching any predicate from `persp-auto-persp-alist'" - :value if-not-autopersp) - (const :tag "\nAlways add but do not switch if the buffer matches any \ -predicate from `persp-auto-persp-alist'" - :value add-but-not-switch-if-autopersp))) - - -(defcustom persp-add-buffer-on-after-change-major-mode nil - "t -- add the current buffer to the current perspective when -the `after-change-major-mode-hook' fires; -nil -- do not add; -'free -- add only _free_ buffers; -function -- run that function." - :group 'persp-mode - :type '(choice - (const :tag "Always add" :value t) - (const :tag "Don't add" :value nil) - (const :tag "\nAdd if the buffer is not already in any other persp" - :value free) - (function :tag "Run this function" :value (lambda () nil))) - :set - #'(lambda (sym val) - (custom-set-default sym val) - (when persp-mode - (if val - (add-hook 'after-change-major-mode-hook - #'persp-after-change-major-mode-h t) - (remove-hook 'after-change-major-mode-hook - #'persp-after-change-major-mode-h))))) - -(defcustom persp-switch-to-added-buffer t - "If t then after you add a buffer to the current perspective -the currently selected window will be switched to that buffer." - :group 'persp-mode - :type 'boolean) - -(define-obsolete-variable-alias - 'persp-when-kill-switch-to-buffer-in-perspective - 'persp-when-remove-buffer-switch-to-other-buffer - "persp-mode 2.9.7") -(defcustom persp-when-remove-buffer-switch-to-other-buffer t - "If t -- then after a buffer is removed all windows of the current -perspective which showing that buffer will be switched to some previous buffer -in the current perspective." - :group 'persp-mode - :type 'boolean) - -(defcustom persp-remove-buffers-from-nil-persp-behaviour 'ask-to-rem-from-all - "What to do when removing a buffer from the nil perspective." - :group 'persp-mode - :type '(choice - (const :tag "Ask to remove from all perspectives" ask-to-rem-from-all) - (const :tag "Ask only if buffer belongs to a non-weak perspective" - ask-if-in-non-weak-persp) - (const :tag "Don't ask" nil) - (function :tag "Run this function" (lambda (b-o-ns) b-o-ns)))) - -(define-widget 'persp-kill-foreign-buffer-behaviour-choices 'lazy - "What to do when manually killing a buffer that is not in -the current perspective." - :offset 4 - :tag "\nControl the persp-kill-buffer-query-function behaviour." - :type - '(choice - (const :tag "Ask what to do" :value ask) - (const :tag "\nDon't ask if a buffer belongs only to weak perspectives" - :value dont-ask-weak) - (const :tag "Just kill" :value kill) - (const :tag "\nDo not suggest foreign buffer to the user(kill buffer)" - :value nil) - (function :tag "Run function" :value (lambda () t)))) - -(define-obsolete-variable-alias 'persp-kill-foreign-buffer-action - 'persp-kill-foreign-buffer-behaviour "persp-mode 2.9.6") -(defcustom persp-kill-foreign-buffer-behaviour 'dont-ask-weak - "What to do when manually killing a buffer that is not in -the current perspective." - :group 'persp-mode - :type 'persp-kill-foreign-buffer-behaviour-choices) - -(make-obsolete-variable - 'persp-kill-foreign-indirect-buffer-behaviour-override - "Don't use this" "persp-mode 2.9.7") - -(defcustom persp-autokill-buffer-on-remove nil - "Kill the buffer if it removed from every(or non weak) perspective." - :group 'persp-mode - :type - '(choice - (const :tag "Just kill" :value kill) ;; or t - (const - :tag "Kill if buffer belongs only to weak perspectives" :value kill-weak) - (const :tag "Do not kill" :value nil))) - -(defcustom persp-autokill-persp-when-removed-last-buffer 'hide-auto - "Kill the perspective if no buffers left in it." - :group 'persp-mode - :type '(choice - (const :tag "Just kill" :value kill) ;; or t - (const :tag "Kill auto perspectives" :value kill-auto) - (const :tag "Hide" :value hide) - (const :tag "Hide auto perspectives" :value hide-auto) - (const :tag "Do not kill" :value nil) - (function :tag "\nRun this function with persp as an argument" - :value (lambda (p) p)))) - -(defcustom persp-common-buffer-filter-functions - (list #'(lambda (b) (or (string-prefix-p " " (buffer-name b)) - (eq (buffer-local-value 'major-mode b) 'helm-major-mode)))) - "The list of functions wich takes a buffer as an argument. If one of these -functions returns a non nil value the buffer considered as 'filtered out'." - :group 'persp-mode - :type 'hook) - -(defcustom persp-buffer-list-restricted-filter-functions nil - "Additional filters for use inside the `persp-buffer-list-restricted'." - :group 'persp-mode - :type 'hook) - -(defcustom persp-add-buffer-on-after-change-major-mode-filter-functions nil - "Additional filters to know which buffers we dont want to add to -the current perspective after the `after-change-major-mode-hook' is fired." - :group 'persp-mode - :type 'hook) - -(defcustom persp-filter-save-buffers-functions - (list #'(lambda (b) (string-prefix-p "*" (buffer-name b)))) - "Additional filters to not save unneeded buffers." - :group 'persp-mode - :type 'hook) - -(defcustom persp-save-buffer-functions - (list #'(lambda (b) - (when (persp-buffer-filtered-out-p - b persp-filter-save-buffers-functions) - 'skip)) - #'persp-tramp-save-buffer - #'(lambda (b) - (when (eq 'dired-mode (buffer-local-value 'major-mode b)) - `(def-buffer ,(buffer-name b) - ,(buffer-local-value 'default-directory b) - ,(buffer-local-value 'major-mode b)))) - #'(lambda (b) - `(def-buffer ,(buffer-name b) - ,(buffer-file-name b) - ,(buffer-local-value 'major-mode b)))) - "Convert a buffer to a structure that could be saved to a file. -If a function return nil -- follow to the next function in the list. -If a function return 'skip -- don't save a buffer." - :group 'persp-mode - :type 'hook) - -(defcustom persp-load-buffer-functions - (list #'persp-buffer-from-savelist) - "Restore a buffer from a saved structure. -If a function return nil -- follow to the next function in the list. -If a function return 'skip -- don't restore a buffer." - :group 'persp-mode - :type 'hook) - -(defcustom persp-mode-hook nil - "The hook that's run after the `persp-mode' has been activated." - :group 'persp-mode - :type 'hook) - -(defcustom persp-mode-deactivated-hook nil - "Runs when the persp-mode is deactivated." - :group 'persp-mode - :type 'hook) - -(defcustom persp-created-functions nil - "Functions to run after a perspective was created. -These functions must accept two arguments -- the created perspective -and the hash in which this perspective will be placed, you can check -if that hash is the same as `*persp-hash*' or another(when you load -a subset of perspectives(with `persp-load-from-file-by-names') they -will be added to a temporary hash)." - :group 'persp-mode - :type 'hook) - -(defcustom persp-renamed-functions nil - "Functions to run if a perspective was renamed. -Each must take three arguments: 1) perspective; 2) old name; 3) new name. -These functions only run when renaming a perspective from `*persp-hash*'." - :group 'persp-mode - :type 'hook) - -(defcustom persp-before-kill-functions nil - "Functions that runs just before a perspective will be destroyed. -It's single argument is the perspective that will be killed." - :group 'persp-mode - :type 'hook) - -(defcustom persp-before-switch-functions nil - "Functions that runs before actually switching to a perspective. -These functions must take two arguments -- a name of a perspective to switch - (it could be a name of an nonexistent perspective or it could be the same -as current) and a frame or a window for which the switching will take place." - :group 'persp-mode - :type 'hook) - -(defcustom persp-activated-functions nil - "Functions that runs after a perspective has been activated. -These functions must take one argument -- a symbol, -if it is eq 'frame -- then the perspective is activated for `selected-frame', -if it is eq 'window -- then the perspective is activated for `selected-window'. -The activated perspective is available with `get-current-persp'." - :group 'persp-mode - :type 'hook) - -(defcustom persp-before-deactivate-functions nil - "Functions that runs before the current perspective has been deactivated -for selected frame or window. -These functions must take one argument -- a symbol, -if it's 'frame -- perspective will be deactivated for the `selected-frame', -if it's 'window -- perspective will be deactivated for the `selected-window'. -The perspective is available with `get-current-persp'." - :group 'persp-mode - :type 'hook) - -(defcustom persp-before-save-state-to-file-functions nil - "Functions to run before saving perspectives to a file. -Each function in this list will be called with 3 arguments: -1) a file name to which perspectives will be saved; -2) a hash with perspectives; -3) a bool argument indicating if the persp-file parameter of perspectives - must be set." - :group 'persp-mode - :type 'hook) - -(defcustom persp-after-load-state-functions - (list #'(lambda (file phash persp-names) - (when (eq phash *persp-hash*) - (persp-update-frames-window-confs persp-names)))) - "Functions that runs after perspectives state was loaded. -These functions must take 3 arguments: -1) a file from which the state was loaded; -2) a hash in which loaded perspectives were placed; -3) list of names of perspectives that was loaded." - :group 'persp-mode - :type 'hook) - -(defcustom persp-use-workgroups (and (version< emacs-version "24.4") - (locate-library "workgroups")) - "If t -- use the workgroups.el package for saving/restoring -windows configurations." - :group 'persp-mode - :type 'boolean - :set - #'(lambda (sym val) - (custom-set-default sym val) - ;; require workgroups if we are going to use it - (when persp-use-workgroups - ;;(require 'workgroups) - (unless (fboundp 'wg-make-wconfig) - (autoload 'wg-make-wconfig "workgroups" - "Return a new Workgroups window config from `selected-frame'." )) - (unless (fboundp 'wg-restore-wconfig) - (autoload 'wg-restore-wconfig "workgroups" - "Restore WCONFIG in `selected-frame'." ))))) - -(defcustom persp-restore-window-conf-method t - "Defines how to restore window configurations for the new frames: -t -- the standard action. -function -- run that function." - :group 'persp-mode - :type - '(choice - (const :tag "Standard action" :value t) - (const :tag "Do nothing" :value nil) - (function :tag "Run function" - :value (lambda (frame persp new-frame-p) nil)))) - -(defcustom persp-restore-window-conf-filter-functions - (list #'(lambda (f p new-f-p) - (or (null f) - (frame-parameter f 'persp-ignore-wconf) - (let ((old-piw (frame-parameter f 'persp-ignore-wconf-once))) - (when old-piw - (set-frame-parameter f 'persp-ignore-wconf-once nil) - old-piw))))) - "The list of functions which takes a frame, persp and new-frame-p as arguments. -If one of these functions return a non nil value then the window configuration -of the persp will not be restored for the frame" - :group 'persp-mode - :type 'hook) - -(defcustom persp-window-state-get-function - (if persp-use-workgroups - #'(lambda (&optional frame rwin) - (when (or frame (setq frame (selected-frame))) - (with-selected-frame frame (wg-make-wconfig)))) - (if (version< emacs-version "24.4") - #'(lambda (&optional frame rwin) - (when (or rwin (setq rwin (frame-root-window - (or frame (selected-frame))))) - (when (fboundp 'window-state-get) - (window-state-get rwin)))) - #'(lambda (&optional frame rwin) - (when (or rwin (setq rwin (frame-root-window - (or frame (selected-frame))))) - (window-state-get rwin t))))) - "Function for getting a window configuration of a frame, accept -two optional arguments: -first -- a frame(default is the selected one) -second -- a root window(default is the root window of the selected frame)." - :group 'persp-mode - :type 'function) - -(defcustom persp-window-state-put-function - (if persp-use-workgroups - #'(lambda (pwc &optional frame rwin) - (when (or frame (setq frame (selected-frame))) - (with-selected-frame frame - (cl-letf (((symbol-function 'wg-switch-to-window-buffer) - #'(lambda (win) - "Switch to a buffer determined from WIN's fname and bname. -Return the buffer if it was found, nil otherwise." - (wg-abind - win (fname bname) - (cond ((wg-awhen (get-buffer bname) - (persp-switch-to-buffer it))) - (t (persp-switch-to-buffer wg-default-buffer) - nil)))))) - (wg-restore-wconfig pwc))))) - #'(lambda (pwc &optional frame rwin) - (when (or rwin (setq rwin (frame-root-window - (or frame (selected-frame))))) - (when (fboundp 'window-state-put) - (window-state-put pwc rwin t))))) - "Function for restoring a window configuration. Accept a window configuration -obtained by the `persp-window-state-get-function' and two optional arguments: -one -- a frame(default is the selected frame) -and another -- root window(default is the root window of the selected frame)." - :group 'persp-mode - :type 'function) - -(defcustom persp-buffer-list-function (symbol-function 'buffer-list) - "The function that is used mostly internally by persp-mode functions -to get a list of all buffers." - :group 'persp-mode - :type 'function) - -(defcustom persp-dont-count-weaks-in-restricted-buffer-list nil - "if t -- dont count weak perspectives in `persp-buffer-list-restricted'. -For now it makes any effect only if the value of -the `*persp-restrict-buffers-to*' and friends is 2, 2.5, 3 or 3.5." - :group 'persp-mode - :type 'boolean) - -(defcustom persp-auto-persp-alist nil - "Alist of auto-persp definitions." - :group 'persp-mode - :tag "Auto perspectives" - :type '(alist :key-type (string :tag "Name") - :value-type (alist :tag "Parameters" - :key-type (symbol :tag "Keyword")))) - - -;; Global variables: - -;; check if the initial-buffer-choice may be a function (emacs >= 24.4) -(defvar persp-is-ibc-as-f-supported - (or - (not (version< emacs-version "24.4")) - (not - (null - (assq 'function - (cdr (cl-getf (symbol-plist 'initial-buffer-choice) 'custom-type)))))) - "t if the `initial-buffer-choice' as a function is supported in your emacs, -otherwise nil.") - -(defvar persp-minor-mode-menu nil - "Menu for the persp-mode.") - -(defvar *persp-hash* nil - "The hash table that contain perspectives.") - -(defvar persp-names-cache (when *persp-hash* (persp-names)) - "List of perspective names. -Used by the `persp-read-persp' and other UI functions, so it can be used -to alter the order of perspective names present to user. To achieve that -you must add functions to `persp-created-functions', `persp-renamed-functions', -`persp-before-kill-functions', `persp-before-switch-functions' and -`persp-after-load-state-functions' or just set the -`persp-names-sort-before-read-function'.") - -(defcustom persp-names-sort-before-read-function nil - "Function(or nil) to sort `persp-names-cache' before prompting a user for a -perspective name(s). The function must take a list of perspective names and -return a sorted list." - :group 'persp-mode - :type '(choice - (const :tag "No sort." :value nil) - (function :tag "Function" :value #'identity))) - -(defvar persp-temporarily-display-buffer nil - "This variable dynamically bound to t inside -the `persp-temporarily-display-buffer'.") - -(defvar persp-saved-read-buffer-function read-buffer-function - "Save the `read-buffer-function' to restore it on deactivation.") - -(defvar persp-last-persp-name persp-nil-name - "The last activated perspective. New frames will be created with -that perspective if `persp-set-last-persp-for-new-frames' is t.") - -(defvar persp-special-last-buffer nil - "Special variable to handle the case when new frames are switching -the selected window to a wrong buffer.") - -(defvar persp-frame-buffer-predicate nil - "Current buffer-predicate.") - -(defvar persp-frame-buffer-predicate-buffer-list-cache nil - "Variable to cache the perspective buffer list for buffer-predicate.") - -(defvar persp-frame-server-switch-hook nil - "Current persp-server-switch-hook.") - -(defvar persp-disable-buffer-restriction-once nil - "The flag used for toggling buffer filtering during read-buffer.") - -(defvar persp-inhibit-switch-for nil - "List of frames/windows for which the switching of perspectives is inhibited.") - -(defvar persp-read-multiple-exit-minibuffer-function #'exit-minibuffer - "Function to call to exit minibuffer when reading multiple candidates.") - -(defvar persp-buffer-props-hash (when persp-mode - (make-hash-table :test #'eq :size 10)) - "Cache to store buffer properties.") - - -(defvar persp-backtrace-frame-function - (if (version< emacs-version "24.4") - #'(lambda (nframes &optional base) - (let ((i (if base - (let ((k 8) found bt) - (while (and (not found) - (setq bt (cadr (funcall #'backtrace-frame - (cl-incf k))))) - ;; (message "%s:%s" k (backtrace-frame k)) - (when (eq bt base) (setq found t))) - (when found (+ nframes (- k 3)))) - (+ nframes 6)))) - (when i - (funcall #'backtrace-frame i)))) - #'backtrace-frame) - "Backtrace function with base argument.") - - -(defcustom persp-switch-wrap t - "Whether `persp-next' and `persp-prev' should wrap." - :group 'persp-mode - :type 'boolean) - - -;; Key bindings: - -(define-prefix-command 'persp-key-map) - -(defvar persp-mode-map (make-sparse-keymap) - "The keymap with a prefix for the persp-mode.") - -(define-key persp-key-map (kbd "n") #'persp-next) -(define-key persp-key-map (kbd "p") #'persp-prev) -(define-key persp-key-map (kbd "s") #'persp-frame-switch) -(define-key persp-key-map (kbd "S") #'persp-window-switch) -(define-key persp-key-map (kbd "r") #'persp-rename) -(define-key persp-key-map (kbd "c") #'persp-copy) -(define-key persp-key-map (kbd "C") #'persp-kill) -(define-key persp-key-map (kbd "z") #'persp-save-and-kill) -(define-key persp-key-map (kbd "a") #'persp-add-buffer) -(define-key persp-key-map (kbd "b") #'persp-switch-to-buffer) -(define-key persp-key-map (kbd "t") #'persp-temporarily-display-buffer) -(define-key persp-key-map (kbd "i") #'persp-import-buffers) -(define-key persp-key-map (kbd "I") #'persp-import-win-conf) -(define-key persp-key-map (kbd "k") #'persp-remove-buffer) -(define-key persp-key-map (kbd "K") #'persp-kill-buffer) -(define-key persp-key-map (kbd "w") #'persp-save-state-to-file) -(define-key persp-key-map (kbd "W") #'persp-save-to-file-by-names) -(define-key persp-key-map (kbd "l") #'persp-load-state-from-file) -(define-key persp-key-map (kbd "L") #'persp-load-from-file-by-names) -(define-key persp-key-map (kbd "o") #'(lambda () - (interactive) - (persp-mode -1))) - - -(defun persp-set-keymap-prefix (prefix) - (interactive - (list - (read-key-sequence - "Now press a key sequence to be used as the persp-key-map prefix: "))) - (when prefix - (when (boundp 'persp-keymap-prefix) - (substitute-key-definition 'persp-key-map nil persp-mode-map)) - (define-key persp-mode-map prefix 'persp-key-map) - (custom-set-default 'persp-keymap-prefix prefix))) - -(defcustom persp-keymap-prefix (kbd "C-c p") - "The prefix for activating the persp-mode keymap." - :group 'persp-mode - :type 'key-sequence - :set #'(lambda (sym val) (persp-set-keymap-prefix val))) - -;; TODO: remove this function -(defun persp-set-toggle-read-buffer-filter-keys (keys) - (interactive - (list - (read-key-sequence - "Now press a key sequence to be used for toggling persp filters during the read-buffer: "))) - (setcdr (assq 'toggle-persp-buffer-filter persp-read-multiple-keys) keys) - (custom-set-default 'persp-toggle-read-buffer-filter-keys keys)) -(define-obsolete-function-alias - 'persp-set-toggle-read-persp-filter-keys - 'persp-set-toggle-read-buffer-filter-keys - "persp-mode 2.9") - -(defcustom persp-read-multiple-keys - `((toggle-persp-buffer-filter . ,(kbd "C-x C-p")) - (push-item . ,(kbd "C-")) - (pop-item . ,(kbd "M-"))) - "Keybindings to use while prompting for multiple items." - :group 'persp-mode - :tag "Keys for reading multiple items" - :type '(alist :key-type symbol :value-type key-sequence)) - -(define-obsolete-variable-alias - 'persp-toggle-read-persp-filter-keys 'persp-toggle-read-buffer-filter-keys - "persp-mode 2.9") -(defcustom persp-toggle-read-buffer-filter-keys (kbd "C-x C-p") - "Keysequence to toggle the buffer filtering during read-buffer." - :group 'persp-mode - :type 'key-sequence - :set #'(lambda (sym val) - (persp-set-toggle-read-buffer-filter-keys val))) - - -;; Perspective struct: - -(cl-defstruct (perspective - (:conc-name persp-) - (:constructor make-persp)) - (name "") - (buffers nil) - (window-conf nil) - ;; reserved parameters: dont-save-to-file, persp-file. - (parameters nil) - (weak nil) - (auto nil) - (hidden nil)) - -(defun persp-p (obj) - (or (null obj) (perspective-p obj))) - -(defvar persp-nil-wconf nil - "Window configuration for the `nil' perspective.") - -(defvar persp-nil-parameters nil - "Parameters of the `nil' perspective.") - -(defvar persp-nil-hidden nil - "Hidden filed for the `nil' perspective.") - -(defun persp-buffer-list (&optional frame window) - (safe-persp-buffers (get-current-persp frame window))) - -(cl-defun persp-buffer-list-restricted - (&optional - (frame (selected-frame)) (option *persp-restrict-buffers-to*) - (option-foreign-override persp-restrict-buffers-to-if-foreign-buffer) - sure-not-killing) - (unless frame (setq frame (selected-frame))) - (unless option (setq option 0)) - (let* ((cpersp (get-current-persp frame)) - (curbuf (current-buffer)) - (cb-foreign (not (persp-contain-buffer-p curbuf cpersp)))) - (when (and option-foreign-override cb-foreign) - (setq option option-foreign-override)) - (cl-typecase option - (function (funcall option frame)) - (t - (when (= option 2.5) - (setq option (if (null cpersp) -1 2))) - (when (= option 3.5) - (setq option (if (null cpersp) -1 3))) - (let ((bl - (cl-case option - (-1 - (funcall persp-buffer-list-function frame)) - (0 - (if cpersp - (cl-copy-list (persp-buffers cpersp)) - (funcall persp-buffer-list-function frame))) - (1 - (let ((ret (if cpersp - (let ((pbs (cl-copy-list (persp-buffers cpersp)))) - (cl-delete-if - #'(lambda (b) (let ((cns (memq b pbs))) - (when cns - (setcar cns (cadr cns)) - (setcdr cns (cddr cns)) - t))) - (funcall persp-buffer-list-function frame))) - nil))) - (unless (persp-contain-buffer-p curbuf cpersp) - (setq ret (cons curbuf (cl-delete curbuf ret :count 1)))) - ret)) - (2 - (let ((ret - (cl-delete-if - #'(lambda (b) - (persp-buffer-in-other-p* - b cpersp - persp-dont-count-weaks-in-restricted-buffer-list)) - (if cpersp - (cl-copy-list (persp-buffers cpersp)) - (funcall persp-buffer-list-function frame))))) - ret)) - (3 - (let ((ret - (cl-delete-if - #'(lambda (b) - (or - (and cpersp - (persp-contain-buffer-p b cpersp)) - (persp-buffer-in-other-p* - b cpersp - persp-dont-count-weaks-in-restricted-buffer-list))) - (funcall persp-buffer-list-function frame)))) - ret))))) - (when persp-buffer-list-restricted-filter-functions - (setq bl - (cl-delete-if #'(lambda (b) - (persp-buffer-filtered-out-p - b persp-buffer-list-restricted-filter-functions)) - bl))) - (when (and - (not sure-not-killing) cpersp - (symbolp this-command) - persp-kill-foreign-buffer-behaviour - (string-match-p "^.*?kill-buffer.*?$" (symbol-name this-command)) - (not (memq curbuf bl)) - ;; TODO: remove this - ;; (not (persp-buffer-filtered-out-p curbuf)) - ) - (push curbuf bl)) - bl))))) - -(cl-defmacro with-persp-buffer-list - ((&key - (buffer-list-function persp-buffer-list-function) - (restriction *persp-restrict-buffers-to*) - (restriction-foreign-override persp-restrict-buffers-to-if-foreign-buffer) - sortp cache) - &rest body) - (let ((pblf-body `(persp-buffer-list-restricted frame))) - (when sortp (setq pblf-body `(sort ,pblf-body (with-no-warnings ,sortp)))) - `(let ((*persp-restrict-buffers-to* ,restriction) - (persp-restrict-buffers-to-if-foreign-buffer - ,restriction-foreign-override) - ,@(if cache `(persp-buffer-list-cache) nil)) - (cl-letf (((symbol-function 'buffer-list) - #'(lambda (&optional frame) - ,(if cache - `(if persp-buffer-list-cache - persp-buffer-list-cache - (setq persp-buffer-list-cache ,pblf-body)) - pblf-body)))) - ,@body)))) - -(cl-defmacro with-persp-read-buffer ((&key multiple (default-mode t)) &rest body) - `(let ((read-buffer-function #'persp-read-buffer)) - ,@body)) - -(defmacro with-persp-ido-hooks (&rest body) - `(let ((ido-make-buffer-list-hook ido-make-buffer-list-hook) - (ido-setup-hook ido-setup-hook)) - (persp-set-ido-hooks t) - ,@body)) - -;; TODO: rename -(defun safe-persp-name (p) - (if p (persp-name p) - persp-nil-name)) - -;; TODO: rename -(defun safe-persp-buffers (p) - (if p (persp-buffers p) - (funcall persp-buffer-list-function))) - -;; TODO: rename -(defun safe-persp-window-conf (p) - (if p (persp-window-conf p) - persp-nil-wconf)) - -;; TODO: rename -(defun safe-persp-parameters (p) - (if p (persp-parameters p) - persp-nil-parameters)) - -;; TODO: rename -(defun safe-persp-weak (p) - (if p (persp-weak p) - t)) - -;; TODO: rename -(defun safe-persp-auto (p) - (if p (persp-auto p) - nil)) - -;; TODO: rename -(defun safe-persp-hidden (p) - (if p (persp-hidden p) - persp-nil-hidden)) - - -;; TODO: rename -(cl-defun modify-persp-parameters (alist &optional (persp (get-current-persp))) - (cl-loop for (name . value) in alist - do (set-persp-parameter name value persp))) - -;; TODO: rename -(cl-defun set-persp-parameter - (param-name &optional value (persp (get-current-persp))) - (let* ((params (safe-persp-parameters persp)) - (old-cons (assq param-name params))) - (if old-cons - (setcdr old-cons value) - (if persp - (setf (persp-parameters persp) - (push (cons param-name value) params)) - (setq persp-nil-parameters - (push (cons param-name value) params)))))) - -(cl-defun persp-parameter (param-name &optional (persp (get-current-persp))) - (alist-get param-name (safe-persp-parameters persp))) - -;; TODO: rename -(cl-defun delete-persp-parameter (param-name &optional (persp (get-current-persp))) - (when (and (not (null param-name)) (symbolp param-name)) - (if persp - (setf (persp-parameters persp) - (delq (assq param-name (persp-parameters persp)) - (persp-parameters persp))) - (setq persp-nil-parameters - (delq (assq param-name persp-nil-parameters) - persp-nil-parameters))))) - -(defun persp--buffer-in-persps (buf) - (cdr (assq 'persp-buffer-in-persps - (gethash buf persp-buffer-props-hash)))) - -(defun persp--buffer-in-persps-set (buf persps) - (let* ((buf-props (gethash buf persp-buffer-props-hash)) - (cons (assq 'persp-buffer-in-persps buf-props))) - (if cons - (setf (cdr cons) persps) - (setq cons (cons 'persp-buffer-in-persps persps)) - (push cons buf-props) - (puthash buf buf-props persp-buffer-props-hash)))) - -(defun persp--buffer-in-persps-add (buf persp) - (persp--buffer-in-persps-set - buf (cons persp (persp--buffer-in-persps buf)))) - -(defun persp--buffer-in-persps-remove (buf persp) - (persp--buffer-in-persps-set - buf (delq persp (persp--buffer-in-persps buf)))) - - -;; Used in mode defenition: - -(defun persp-mode-restore-and-remove-from-make-frame-hook (&optional f) - (remove-hook 'after-make-frame-functions - #'persp-mode-restore-and-remove-from-make-frame-hook) - (if (> persp-auto-resume-time 0) - (run-at-time - persp-auto-resume-time nil - #'(lambda () - (remove-hook 'find-file-hook - #'persp-special-last-buffer-make-current) - (when (> persp-auto-resume-time 0) - (condition-case-unless-debug err - (persp-load-state-from-file) - (error - (message - "[persp-mode] Error: Can not autoresume perspectives -- %S" - err))) - (when (persp-get-buffer-or-null persp-special-last-buffer) - (persp-switch-to-buffer persp-special-last-buffer))))) - (remove-hook 'find-file-hook - #'persp-special-last-buffer-make-current))) - -(defun persp-asave-on-exit (&optional interactive-query opt) - (when persp-mode - (when (null opt) - (setq opt 0)) - (if (> persp-auto-save-opt opt) - (condition-case-unless-debug err - (persp-save-state-to-file) - (error - (message "[persp-mode] Error: Can not autosave perspectives -- %S" - err) - (when (or noninteractive - (progn - (when (null (persp-frame-list-without-daemon)) - (make-frame)) - (null (persp-frame-list-without-daemon)))) - (setq interactive-query nil)) - (if interactive-query - (yes-or-no-p - "persp-mode can not save perspectives, do you want to exit anyway?") - t))) - t))) -(defun persp-kill-emacs-h () - (persp-asave-on-exit nil)) - -(defun persp-kill-emacs-query-function () - (if persp-mode - (when (persp-asave-on-exit t) - (remove-hook 'kill-emacs-hook #'persp-kill-emacs-h) - t) - t)) - -(defun persp-special-last-buffer-make-current () - (setq persp-special-last-buffer (current-buffer))) - - -;; Auto persp functions: - -(defun persp-auto-persp-parameters (name) - (cdr (assoc name persp-auto-persp-alist))) -(defun persp--auto-persp-pickup-buffer (a-p-def buffer) - (let ((action (alist-get :main-action a-p-def))) - (when (functionp action) - (funcall action buffer)))) -(defun persp-auto-persp-pickup-bufferlist-for (name bufferlist) - (let ((a-p-def (persp-auto-persp-parameters name))) - (when a-p-def - (mapc (apply-partially #'persp--auto-persp-pickup-buffer a-p-def) - bufferlist)))) -(defun persp-auto-persps-pickup-bufferlist (bufferlist) - (mapc - #'(lambda (name) (persp-auto-persp-pickup-bufferlist-for name bufferlist)) - (mapcar #'car persp-auto-persp-alist))) -(defun persp-auto-persp-pickup-buffers-for (name) - (persp-auto-persp-pickup-bufferlist-for name - (funcall persp-buffer-list-function))) -(defun persp-auto-persps-pickup-buffers () - (interactive) - (persp-auto-persps-pickup-bufferlist (funcall persp-buffer-list-function))) - -(defun persp-buffer-match-auto-persp-p (buffer-or-name) - (let ((buffer (persp-get-buffer-or-null buffer-or-name)) - pred) - (car-safe - (cl-find-if #'(lambda (a-p-def) - (and (setq pred (alist-get :generated-predicate a-p-def)) - (funcall pred buffer))) - persp-auto-persp-alist - :key #'cdr)))) -(defun persp-auto-persps-for-buffer (buffer-or-name) - (let ((buffer (persp-get-buffer-or-null buffer-or-name))) - (cl-remove-if #'(lambda (pred) (funcall pred buffer)) - persp-auto-persp-alist - :key #'(lambda (a-p-cons) - (alist-get :generated-predicate (cdr a-p-cons)))))) - -(defun persp-auto-persp-activate-hooks (name) - (let ((hooks - (alist-get :hooks - (persp-auto-persp-parameters name)))) - (mapc #'(lambda (hook-cons) - (add-hook (car hook-cons) (cdr hook-cons))) - hooks))) -(defun persp-auto-persp-deactivate-hooks (name) - (let ((hooks - (alist-get :hooks - (persp-auto-persp-parameters name)))) - (mapc #'(lambda (hook-cons) - (remove-hook (car hook-cons) (cdr hook-cons))) - hooks))) -(defun persp-auto-persps-activate-hooks () - (mapc #'persp-auto-persp-activate-hooks - (mapcar #'car persp-auto-persp-alist))) -(defun persp-auto-persps-deactivate-hooks () - (mapc #'persp-auto-persp-deactivate-hooks - (mapcar #'car persp-auto-persp-alist))) - -(defsubst persp--generate-predicate-loop-any-all - (items-list condition &rest body) - (if items-list - (let (all noquote) - (setq items-list - (cl-typecase items-list - (function (list items-list)) - (list (if (persp-regexp-p items-list) (list items-list) items-list)) - (t (list items-list)))) - (setq noquote (eq :noquote (car items-list))) - (when noquote (setq items-list (cadr items-list))) - (when (listp items-list) - (setq all (eq :all (car items-list))) - (when all (pop items-list)) - (unless noquote (setq items-list `',items-list))) - (let* ((cnd `(cl-member-if - #'(lambda (item) - (setq cond-result - ,(if all - `(not ,condition) - condition))) - ,items-list))) - `(let (cond-result) - (when ,(if all `(not ,cnd) cnd) - ,@body)))) - `(let (cond-result) - ,@body))) -(cl-defun persp--generate-buffer-predicate - (&key - buffer-name file-name mode mode-name minor-mode minor-mode-name predicate - (true-value (if predicate 'cond-result t)) - &allow-other-keys) - (let ((predicate-body true-value)) - (when predicate - (setq predicate-body - (persp--generate-predicate-loop-any-all - predicate '(apply item buffer rest-args) predicate-body))) - (when file-name - (setq predicate-body - (persp--generate-predicate-loop-any-all - file-name '(persp-string-match-p item (buffer-file-name buffer)) - predicate-body))) - (when buffer-name - (setq predicate-body - (persp--generate-predicate-loop-any-all - buffer-name '(persp-string-match-p item (buffer-name buffer)) - predicate-body))) - (when minor-mode-name - (setq predicate-body - (persp--generate-predicate-loop-any-all - minor-mode-name - `(let ((regexp item)) - ,(persp--generate-predicate-loop-any-all - '(:noquote minor-mode-alist) - '(persp-string-match-p regexp (format-mode-line item)) - t)) - predicate-body))) - (when minor-mode - (setq predicate-body - (persp--generate-predicate-loop-any-all - minor-mode - `(cond - ((symbolp item) (bound-and-true-p item)) - ((persp-regexp-p item) (let ((regexp item)) - ,(persp--generate-predicate-loop-any-all - '(:noquote minor-mode-list) - '(and - (bound-and-true-p item) - (persp-string-match-p regexp item)) - t))) - (t nil)) - predicate-body))) - - (when mode-name - (setq predicate-body - (persp--generate-predicate-loop-any-all - mode-name '(persp-string-match-p item (format-mode-line mode-name)) - predicate-body))) - (when mode - (setq predicate-body - (persp--generate-predicate-loop-any-all - mode '(cond - ((symbolp item) (eq item major-mode)) - ((persp-regexp-p item) - (persp-string-match-p item (symbol-name major-mode))) - (t nil)) - predicate-body))) - (eval `(lambda (buffer &rest rest-args) - (when (buffer-live-p buffer) - (with-current-buffer buffer ,predicate-body)))))) - -(defun persp--auto-persp-default-on-match (state) - (persp-add-buffer (alist-get 'buffer state) - (alist-get 'persp state) - nil nil) - state) -(defun persp--auto-persp-default-after-match (state) - (let ((persp (alist-get 'persp state)) - (noauto (alist-get :noauto state)) - (weak (alist-get :weak state)) - (parameters (alist-get :parameters state))) - (when persp - (when (not noauto) - (setf (persp-auto persp) t)) - (when weak - (setf (persp-weak persp) t)) - (modify-persp-parameters parameters persp))) - (let ((persp-name (alist-get 'persp-name state)) - (switch (alist-get :switch state))) - (persp-unhide persp-name) - (cl-case switch - ('nil nil) - (window (persp-window-switch persp-name)) - (frame (persp-frame-switch persp-name)) - (t (persp-switch persp-name))) - (when switch - (persp-switch-to-buffer (alist-get 'buffer state)))) - state) - -;;;###autoload -(cl-defun persp-def-auto-persp - (name &rest keyargs - &key buffer-name file-name mode mode-name minor-mode minor-mode-name - predicate hooks dyn-env get-name get-buffer get-persp - switch parameters noauto weak user-data - on-match after-match dont-pick-up-buffers delete) - - (if delete - (let ((ap-cons (assoc name persp-auto-persp-alist))) - (persp-auto-persp-deactivate-hooks name) - (setq persp-auto-persp-alist - (delq ap-cons persp-auto-persp-alist))) - - (let (auto-persp-parameters - generated-predicate generated-hook - hook-body main-action) - - (cl-loop for (key val) on keyargs by #'cddr - when (and val (not (or (eq key :dont-pick-up-buffers)))) - do (push - (cons key - (if (and (functionp val) - (not (or (eq key :mode) (eq key :minor-mode))) - (null (byte-code-function-p val))) - val ;;(byte-compile val) - val)) - auto-persp-parameters)) - - (unless get-name - (push (cons :get-name - (byte-compile - `(lambda (state) - (push (cons 'persp-name ,name) state) - state))) - auto-persp-parameters)) - - (unless get-persp - (push (cons :get-persp - #'(lambda (state) - (let ((name (alist-get 'persp-name state))) - (when name - (push (cons 'persp (persp-add-new name)) - state))) - state)) - auto-persp-parameters)) - - (unless get-buffer - (push (cons :get-buffer - #'(lambda (state) - (push (cons 'buffer (current-buffer)) - state) - state)) - auto-persp-parameters)) - - (unless on-match - (push (cons :on-match - #'persp--auto-persp-default-on-match) - auto-persp-parameters)) - - (unless after-match - (push (cons :after-match - #'persp--auto-persp-default-after-match) - auto-persp-parameters)) - - (when (or (null hooks) (not (consp hooks))) - (unless hooks - (setq hooks - (when minor-mode - (intern (concat (symbol-name minor-mode) - "-hook"))))) - (unless hooks - (setq hooks - (cond - (mode - (intern (concat (symbol-name mode) - "-hook"))) - (minor-mode - (intern (concat (symbol-name minor-mode) - "-hook"))) - ((or mode-name predicate buffer-name) - 'after-change-major-mode-hook) - (file-name 'find-file-hook) - (t 'after-change-major-mode-hook)))) - - (when (and hooks (not (consp hooks))) - (setq hooks (list hooks))) - - (push (cons :hooks hooks) auto-persp-parameters)) - - (setq generated-predicate - (apply #'persp--generate-buffer-predicate - (if predicate - keyargs - (cons :true-value (cons '(car rest-args) keyargs))))) - (push (cons :generated-predicate generated-predicate) - auto-persp-parameters) - - (setq main-action - (eval - `(lambda (&optional buffer hook hook-args) - (let (,@dyn-env) - (let* ((state (copy-alist - (persp-auto-persp-parameters ,name)))) - (push (cons 'hook hook) state) - (push (cons 'hook-args hook-args) state) - (if buffer - (push (cons 'buffer buffer) state) - (let ((get-buffer - (alist-get :get-buffer state))) - (setq state (funcall get-buffer state)))) - (when - (setq state - (funcall (alist-get :generated-predicate state) - (alist-get 'buffer state) state)) - (with-current-buffer (alist-get 'buffer state) - (let ((get-name - (alist-get :get-name state))) - (setq state (funcall get-name state))) - (let ((get-persp - (alist-get :get-persp state))) - (setq state (funcall get-persp state))) - (let ((on-match (alist-get :on-match state))) - (when on-match - (setq state (funcall on-match state)) - (let ((after-match (alist-get :after-match state))) - (when after-match - (setq state (funcall after-match state))))))))))))) - (push (cons :main-action main-action) auto-persp-parameters) - - (when hooks - (let ((aparams-hooks (assq :hooks auto-persp-parameters))) - (dolist (hook hooks) - (setq generated-hook - (with-no-warnings - (let ((warning-minimum-level :emergency) - byte-compile-warnings) - (byte-compile - `(lambda (&rest hook-args) - (when persp-mode - (funcall (with-no-warnings ',main-action) - nil ',hook hook-args))))))) - (setcdr aparams-hooks (delete hook (cdr aparams-hooks))) - (push (cons hook generated-hook) (cdr aparams-hooks))))) - - (let ((auto-persp-definition (assoc name persp-auto-persp-alist))) - (if auto-persp-definition - (progn - (persp-auto-persp-deactivate-hooks name) - (setcdr auto-persp-definition auto-persp-parameters)) - (setq auto-persp-definition (cons name auto-persp-parameters)) - (push auto-persp-definition persp-auto-persp-alist))) - - (persp-auto-persp-activate-hooks name) - - (unless dont-pick-up-buffers - (persp-auto-persp-pickup-buffers-for name))))) - -;;;###autoload -(define-obsolete-function-alias 'def-auto-persp 'persp-def-auto-persp - "persp-mode 2.9.6") - - -;; Custom save/load functions: - -;;;###autoload -(cl-defun persp-def-buffer-save/load - (&rest - keyargs - &key buffer-name file-name mode mode-name minor-mode minor-mode-name - predicate tag-symbol save-vars save-function load-function after-load-function - mode-restore-function - append) - (let ((generated-save-predicate - (apply #'persp--generate-buffer-predicate keyargs)) - save-body load-fun) - (when save-vars - (unless (listp save-vars) (setq save-vars (list save-vars))) - (when (and (or mode mode-name) (not (memq 'major-mode save-vars))) - (push 'major-mode save-vars))) - (unless tag-symbol (setq tag-symbol 'def-buffer-with-vars)) - - (setq save-body - `(let ((vars-list - (with-current-buffer buffer - (cl-delete-if-not - #'(lambda (lvar) - (and - ,(persp--generate-predicate-loop-any-all - save-vars - '(if (persp-regexp-p item) - (persp-string-match-p item - (symbol-name lvar)) - (eq item lvar)) - t) - (persp-elisp-object-readable-p - (symbol-value lvar)))) - (buffer-local-variables) - :key #'car-safe)))) - ,(if save-function - `(funcall (with-no-warnings ',save-function) - buffer ',tag-symbol vars-list) - `(list ',tag-symbol (buffer-name buffer) vars-list))) - save-body `(when (funcall (with-no-warnings ',generated-save-predicate) - buffer) - ,save-body)) - - (setq load-fun - `(lambda (savelist) - (cl-destructuring-bind - (buffer-name vars-list &rest _rest) (cdr savelist) - (let ((buf-file (alist-get 'buffer-file-name vars-list)) - (buf-mmode (alist-get 'major-mode vars-list))) - ,(when mode-restore-function - `(push (cons 'persp-load-buffer-mode-restore-function - (with-no-warnings ',mode-restore-function)) - vars-list)) - (let ((persp-loaded-buffer - (persp-buffer-from-savelist - (list 'def-buffer buffer-name buf-file buf-mmode - (list (cons 'local-vars vars-list))))) - (persp-after-load-function (with-no-warnings - ',after-load-function)) - persp-after-load-lambda) - (when (and persp-loaded-buffer persp-after-load-function) - (setq persp-after-load-lambda - #'(lambda (&rest pall-args) - (apply persp-after-load-function - persp-loaded-buffer pall-args) - (remove-hook 'persp-after-load-state-functions - persp-after-load-lambda))) - (add-hook 'persp-after-load-state-functions - persp-after-load-lambda t)) - persp-loaded-buffer))))) - - (add-hook 'persp-save-buffer-functions - (eval `(lambda (buffer) ,save-body)) append) - (add-hook 'persp-load-buffer-functions - (eval - `(lambda (savelist) - (when (eq (car savelist) ',tag-symbol) - (let ((default-load-fun (with-no-warnings ',load-fun))) - ,(if load-function - `(funcall (with-no-warnings ',load-function) - savelist default-load-fun - (with-no-warnings ',after-load-function)) - `(funcall (eval default-load-fun t) savelist)))))) - append))) - -;;;###autoload -(define-obsolete-function-alias - 'def-persp-buffer-save/load 'persp-def-buffer-save/load - "persp-mode 2.9.6") - - -;; Mode itself: - -;;;###autoload -(define-minor-mode persp-mode - "Toggle the persp-mode. -When active, keeps track of multiple 'perspectives', -named collections of buffers and window configurations. -Here is a keymap of this minor mode: -\\{persp-mode-map}" - :require 'persp-mode - :group 'persp-mode - :keymap persp-mode-map - :init-value nil - :global t - :lighter (:eval persp-lighter) - (if persp-mode - (when (or (eq 'persp-force-restart persp-mode) (null *persp-hash*)) - (setq persp-special-last-buffer nil) - (add-hook 'find-file-hook #'persp-special-last-buffer-make-current) - - (setq *persp-hash* (make-hash-table :test #'equal :size 10)) - (setq persp-buffer-props-hash (make-hash-table :test #'eq :size 10)) - (setq persp-names-cache nil) - - (push '(persp . writable) window-persistent-parameters) - - (persp-add-minor-mode-menu) - (persp-add-new persp-nil-name) - - (add-hook 'find-file-hook #'persp-add-or-not-on-find-file) - (add-hook 'kill-buffer-query-functions #'persp-kill-buffer-query-function) - (add-hook 'kill-buffer-hook #'persp-kill-buffer-h) - (add-hook 'before-make-frame-hook #'persp-before-make-frame) - (add-hook 'after-make-frame-functions #'persp-init-new-frame) - (add-hook 'delete-frame-functions #'persp-delete-frame) - (add-hook 'kill-emacs-query-functions #'persp-kill-emacs-query-function) - (add-hook 'kill-emacs-hook #'persp-kill-emacs-h) - (add-hook 'server-switch-hook #'persp-server-switch) - (add-hook 'after-change-major-mode-hook #'persp-after-change-major-mode-h) - - (persp-set-ido-hooks persp-set-ido-hooks) - (persp-set-read-buffer-function persp-set-read-buffer-function) - - (persp-update-completion-system persp-interactive-completion-system) - - (condition-case-unless-debug err - (mapc #'persp-init-frame (persp-frame-list-without-daemon)) - (error - (message "[persp-mode] Error: Can not initialize frame -- %S" - err))) - - (when (fboundp 'tabbar-mode) - (setq tabbar-buffer-list-function #'persp-buffer-list)) - - (persp-auto-persps-activate-hooks) - - (if (or noninteractive - (and (daemonp) - (null (cdr (frame-list))) - (eq (selected-frame) terminal-frame))) - (add-hook 'after-make-frame-functions - #'persp-mode-restore-and-remove-from-make-frame-hook) - (persp-mode-restore-and-remove-from-make-frame-hook))) - - (run-hooks 'persp-mode-deactivated-hook) - (unless (memq #'persp-mode-restore-and-remove-from-make-frame-hook - after-make-frame-functions) - (persp-asave-on-exit t 1)) - - (remove-hook 'find-file-hook #'persp-add-or-not-on-find-file) - (remove-hook 'kill-buffer-query-functions #'persp-kill-buffer-query-function) - (remove-hook 'kill-buffer-hook #'persp-kill-buffer-h) - (remove-hook 'before-make-frame-hook #'persp-before-make-frame) - (remove-hook 'after-make-frame-functions #'persp-init-new-frame) - (remove-hook 'delete-frame-functions #'persp-delete-frame) - (remove-hook 'kill-emacs-query-functions #'persp-kill-emacs-query-function) - (remove-hook 'kill-emacs-hook #'persp-kill-emacs-h) - (remove-hook 'server-switch-hook #'persp-server-switch) - (remove-hook 'after-change-major-mode-hook #'persp-after-change-major-mode-h) - - (persp-set-ido-hooks) - (persp-set-read-buffer-function) - (persp-update-frames-buffer-predicate t) - (persp-update-completion-system nil t) - - (persp-auto-persps-deactivate-hooks) - - (when (fboundp 'tabbar-mode) - (setq tabbar-buffer-list-function #'tabbar-buffer-list)) - - (setq window-persistent-parameters - (delq (assq 'persp window-persistent-parameters) - window-persistent-parameters)) - - ;; TODO: do it properly -- remove buffers, kill perspectives - (setq *persp-hash* nil) - (setq persp-buffer-props-hash nil) - (setq persp-names-cache nil))) - - -;; Hooks: - -(defun persp--kill-buffer-query-function-foreign-check (persp buf) - (let ((opt persp-kill-foreign-buffer-behaviour)) - (cond - ((functionp opt) (funcall opt)) - (t - (if (cl-case opt - ((kill nil) t) - (dont-ask-weak (persp-buffer-free-p buf t)) - (t (persp-buffer-filtered-out-p buf))) - 'kill - (let ((curwin (selected-window)) - (prompt (format "You are going to kill a buffer(%s) \ -which is not in the current(%s) perspective. It will be removed from \ -%s perspectives and then killed.\nWhat do you really want to do? " - (buffer-name buf) - (safe-persp-name persp) - (mapcar #'persp-name - (persp--buffer-in-persps buf))))) - (cl-macrolet - ((clwin (w) - `(run-at-time 1 nil #'(lambda (ww) - (when (window-live-p ww) - (delete-window ww))) - ,w)) - (swb (b w) - `(run-at-time - 1 nil - #'(lambda (bb ww) - (with-selected-window ww - (persp-set-another-buffer-for-window - bb ww))) - ,b ,w))) - (cl-destructuring-bind (char &rest _) - (let ((variants - (list '(?q "do nothing") - '(?k "kill") - '(?K "kill and close window") - '(?c "close window") - '(?s "switch to another buffer"))) - (cwin (selected-window))) - (when (minibuffer-window-active-p cwin) - (setq cwin (minibuffer-selected-window))) - (unless (eq buf (window-buffer cwin)) - (setq variants - (delq (assq ?K variants) - (delq (assq ?c variants) - (delq (assq ?s variants) variants))))) - (read-multiple-choice prompt variants)) - (cl-case char - ((?q ?\C-g ?\C-\[) nil) - (?k 'kill) - (?K (clwin curwin) 'kill) - (?c (clwin curwin) nil) - (?s (swb buf curwin) nil) - (t t)))))))))) - -(defun persp-kill-buffer-query-function () - "This must be the last hook in the `kill-buffer-query-functions'. -Otherwise if next function in the list returns nil -- the buffer will not be -killed, but just removed from a perspective(s)." - (if persp-mode - (let ((buffer (current-buffer))) - (if (persp--buffer-in-persps buffer) - (let* ((persp (get-current-persp)) - (foreign-check - (if (and persp - (persp-contain-buffer-p buffer persp)) - 'not-foreign - (persp--kill-buffer-query-function-foreign-check - persp buffer)))) - (cl-case foreign-check - (kill - (let (persp-autokill-buffer-on-remove) - (persp--remove-buffer-2 nil buffer)) - t) - (not-foreign - (if (persp-buffer-in-other-p* buffer persp) - (progn (persp--remove-buffer-2 persp buffer) - nil) - (if (or (not (buffer-live-p buffer)) - (persp--buffer-in-persps buffer)) - nil - t) - t)) - (t - nil))) - t)) - t)) - -(defun persp-kill-buffer-h () - (let ((buffer (current-buffer))) - (when (and persp-mode (persp--buffer-in-persps buffer)) - (let (persp-autokill-buffer-on-remove - (persp-when-remove-buffer-switch-to-other-buffer - (unless persp-set-frame-buffer-predicate - persp-when-remove-buffer-switch-to-other-buffer))) - (persp--remove-buffer-2 nil buffer))))) - -(defun persp--restore-buffer-on-find-file () - (when (buffer-live-p persp-special-last-buffer) - (set-window-buffer (or (get-buffer-window) (selected-window)) - persp-special-last-buffer)) - (setq persp-special-last-buffer nil) - (remove-hook 'window-configuration-change-hook - #'persp--restore-buffer-on-find-file)) -(defun persp-add-or-not-on-find-file () - (let ((no-select - (not (funcall persp-backtrace-frame-function 0 'find-file)))) - (and - (cl-case persp-add-buffer-on-find-file - ('nil nil) - (if-not-autopersp - (let ((ret (not (persp-buffer-match-auto-persp-p (current-buffer))))) - (unless (or ret no-select) - (setq persp-special-last-buffer (window-buffer)) - (add-hook 'window-configuration-change-hook - #'persp--restore-buffer-on-find-file)) - ret)) - (add-but-not-switch-if-autopersp - (when (and (not no-select) - (persp-buffer-match-auto-persp-p (current-buffer))) - (setq no-select t) - (setq persp-special-last-buffer (window-buffer)) - (add-hook 'window-configuration-change-hook - #'persp--restore-buffer-on-find-file)) - t) - (t t)) - (persp-add-buffer - (current-buffer) (get-current-persp) (not no-select) nil)))) - -(defun persp-after-change-major-mode-h () - (let ((buf (current-buffer))) - (persp-find-and-set-persps-for-buffer buf) - (when - (and - (cl-case persp-add-buffer-on-after-change-major-mode - ('nil nil) - (free (persp-buffer-free-p buf)) - (t t)) - (not - (persp-buffer-filtered-out-p - buf persp-add-buffer-on-after-change-major-mode-filter-functions))) - (persp-add-buffer buf (get-current-persp) nil nil)))) - -(defun persp-server-switch () - (condition-case-unless-debug err - (let* ((frame (selected-frame)) - (persp-server-switch-hook (frame-parameter - frame 'persp-server-switch-hook))) - (when persp-server-switch-hook - (unless (string-match-p "^.*magit.*$" (symbol-name last-command)) - (funcall persp-server-switch-hook frame)) - (set-frame-parameter frame 'persp-server-switch-hook nil))) - (error - (message "[persp-mode] Error: error in server-switch-hook -- %S" - err)))) - - -;; Misc funcs: - -(cl-defun persp-get-by-name - (name &optional (phash *persp-hash*) (default persp-not-persp)) - (gethash name phash default)) - -(cl-defun persp-with-name-exists-p (name &optional (phash *persp-hash*)) - (persp-p (persp-get-by-name name phash))) - -(cl-defun persp-by-name-and-exists (name &optional (phash *persp-hash*)) - (let ((persp (persp-get-by-name name phash))) - (cons (persp-p persp) persp))) - -(cl-defun persp-gen-random-name (&optional name (phash *persp-hash*)) - (unless name (setq name (number-to-string (random)))) - (cl-macrolet ((namegen () `(format "%s:%s" name (random 9)))) - (cl-do ((nname name (namegen))) - ((not (persp-with-name-exists-p nname phash)) - nname)))) - -(defsubst persp-is-frame-daemons-frame (f) - (and (daemonp) (eq f terminal-frame))) - -(defun persp-frame-list-without-daemon () - "Return a list of frames without the daemon's frame." - (if (daemonp) - (filtered-frame-list - #'(lambda (f) (not (persp-is-frame-daemons-frame f)))) - (frame-list))) - -;; TODO: rename -(defun set-frame-persp (persp &optional frame) - (set-frame-parameter frame 'persp persp)) - -;; TODO: rename -(defun get-frame-persp (&optional frame) - (frame-parameter frame 'persp)) - -(cl-defun persp-names (&optional (phash *persp-hash*) (reverse t)) - (let (ret) - (maphash #'(lambda (k p) - (push k ret)) - phash) - (if reverse - (nreverse ret) - ret))) - -;; TODO: rename -(defun set-window-persp* (persp-name &optional window) - (when persp-name - (set-window-parameter window 'persp persp-name))) -;; TODO: rename -(defun get-window-persp* (&optional window) - (window-parameter window 'persp)) -;; TODO: rename -(defun set-window-persp (persp &optional window) - (let ((frame (window-frame window))) - (if (eq persp (get-frame-persp frame)) - (clear-window-persp window) - (set-window-persp* (safe-persp-name persp) window)))) -;; TODO: rename -(defun window-persp-set-p (&optional window) - (get-window-persp* window)) -;; TODO: rename -(defun get-window-persp (&optional window) - (let ((pn (get-window-persp* window))) - (when pn - (cl-destructuring-bind (e . p) - (persp-by-name-and-exists pn) - (and e p))))) -;; TODO: rename -(defun clear-window-persp (&optional window) - (set-window-parameter window 'persp nil)) - -;; TODO: rename -(defun get-current-persp (&optional frame window) - (with-selected-frame (or frame (selected-frame)) - (if (window-persp-set-p window) - (get-window-persp window) - (get-frame-persp frame)))) - -;; TODO: rename -(defun set-current-persp (persp) - (if (window-persp-set-p) - (set-window-persp persp) - (set-frame-persp persp))) - -(defun persp-names-current-frame-fast-ordered () - (cl-copy-list persp-names-cache)) - -;; TODO: remove this -(cl-defsubst persp-names-sorted (&optional (phash *persp-hash*)) - (sort (persp-names phash nil) #'string<)) -(make-obsolete 'persp-names-sorted "it will be removed." "persp-mode 2.9.6") - -(defun persp-group-by (keyf lst &optional reverse) - (let (result) - (mapc #'(lambda (pd) - (let* ((key (funcall keyf pd)) - (kv (assoc key result))) - (if kv - (setcdr kv (cons pd (cdr kv))) - (push (cons key (list pd)) result)))) - lst) - (if reverse - (nreverse - (mapcar #'(lambda (gr) - (cl-destructuring-bind (key . pd) gr - (cons key (nreverse pd)))) - result)) - result))) - -(defun persp-regexp-p (obj) - (or (stringp obj) (and (consp obj) (stringp (cdr obj))))) -(defun persp-string-match-p (regexp string &optional start) - (when (and regexp (not (consp regexp))) - (setq regexp (cons t regexp))) - (let ((ret (string-match-p (cdr regexp) string start))) - (if (eq :not (car regexp)) - (not ret) - ret))) - -(cl-defun persp-persps (&optional (phash *persp-hash*) names-regexp reverse) - (when (and names-regexp (not (consp names-regexp))) - (setq names-regexp (cons t names-regexp))) - (let (ret) - (maphash #'(lambda (k p) - (if names-regexp - (when (persp-string-match-p names-regexp k) - (push p ret)) - (push p ret))) - phash) - (if reverse - (nreverse ret) - ret))) - -(cl-defun persp-other-not-hidden-persps (&optional persp (phash *persp-hash*)) - (cl-delete-if #'safe-persp-hidden (delq persp (persp-persps phash)))) - -(cl-defun persp-other-persps-with-buffer-except-nil - (&optional (buff-or-name (current-buffer)) (persp (get-current-persp)) - (phash *persp-hash*) del-weak) - (let ((buf (persp-get-buffer-or-null buff-or-name)) - ret) - (when buf - (setq ret (cl-delete-if-not - (apply-partially #'memq buf) - (delq persp (delq nil (persp-persps phash))) - :key #'persp-buffers)) - (when del-weak - (setq ret (cl-delete-if #'persp-weak ret)))) - ret)) -(cl-defun persp-other-persps-with-buffer-except-nil* - (&optional - (buff-or-name (current-buffer)) (persp (get-current-persp)) del-weak) - (let ((persps (persp--buffer-in-persps - (persp-get-buffer-or-null buff-or-name)))) - (when persp - (setq persps (remq persp persps))) - (when del-weak - (setq persps (cl-remove-if #'persp-weak persps))) - persps)) - -(cl-defun persp-buffer-in-other-p - (&optional (buff-or-name (current-buffer)) (persp (get-current-persp)) - (phash *persp-hash*) del-weak) - (persp-other-persps-with-buffer-except-nil buff-or-name persp phash del-weak)) -(cl-defun persp-buffer-in-other-p* - (&optional (buff-or-name (current-buffer)) (persp (get-current-persp)) del-weak) - (persp-other-persps-with-buffer-except-nil* buff-or-name persp del-weak)) - - -(cl-defun persp-frames-with-persp (&optional (persp (get-frame-persp))) - (cl-delete-if-not (apply-partially #'eq persp) - (persp-frame-list-without-daemon) - :key #'get-frame-persp)) -(cl-defun persp-frames-and-windows-with-persp (&optional (persp (get-current-persp))) - (let (frames windows) - (dolist (frame (persp-frame-list-without-daemon)) - (when (eq persp (get-frame-persp frame)) - (push frame frames)) - (dolist (window (window-list frame 'no-minibuf)) - (when (and (window-persp-set-p window) - (eq persp (get-window-persp window))) - (push window windows)))) - (cons frames windows))) - - -(cl-defun persp-do-buffer-list-by-regexp (&key func regexp blist noask - (rest-args nil rest-args-p)) - (interactive) - (unless func - (let ((fs (completing-read "What function to apply: " obarray 'functionp t))) - (when (and fs (not (string= fs ""))) - (setq func (read fs))))) - (when func - (unless regexp - (setq regexp (read-regexp "Regexp: "))) - (when regexp - (unless blist - (setq blist (eval (read--expression "Buffer list expression: " "nil")))) - (when blist - (unless rest-args-p - (setq rest-args (read--expression "Rest arguments: " "nil"))) - (setq blist - (cl-remove-if-not - (apply-partially #'persp-string-match-p regexp) - (mapcar #'get-buffer blist) - :key #'buffer-name)) - (when (and blist - (or noask (y-or-n-p (format "Do %s on these buffers:\n%s?\n" - func - (mapconcat #'buffer-name blist ", "))))) - (mapcar #'(lambda (b) (apply func b rest-args)) blist)))))) - - -;; Perspective funcs: - -(defun persp-next () - "Switch to next perspective (to the right)." - (interactive) - (let* ((persp-list (persp-names-current-frame-fast-ordered)) - (persp-list-length (length persp-list)) - (only-perspective? (equal persp-list-length 1)) - (pos (cl-position (safe-persp-name (get-current-persp)) persp-list))) - (cond - ((null pos) nil) - (only-perspective? nil) - ((= pos (1- persp-list-length)) - (if persp-switch-wrap (persp-switch (nth 0 persp-list)))) - (t (persp-switch (nth (1+ pos) persp-list)))))) - -(defun persp-prev () - "Switch to previous perspective (to the left)." - (interactive) - (let* ((persp-list (persp-names-current-frame-fast-ordered)) - (persp-list-length (length persp-list)) - (only-perspective? (equal persp-list-length 1)) - (pos (cl-position (safe-persp-name (get-current-persp)) persp-list))) - (cond - ((null pos) nil) - (only-perspective? nil) - ((= pos 0) - (if persp-switch-wrap - (persp-switch (nth (1- persp-list-length) persp-list)))) - (t (persp-switch (nth (1- pos) persp-list)))))) - -(cl-defun persp-add (persp &optional (phash *persp-hash*)) - "Insert `PERSP' to `PHASH'. -If we adding to the `*persp-hash*' add entries to the mode menu. -Return `PERSP'." - (let ((name (safe-persp-name persp))) - (puthash name persp phash) - (when (eq phash *persp-hash*) - (persp-add-to-menu persp))) - persp) - -(cl-defun persp-remove-by-name (name &optional (phash *persp-hash*)) - "Remove a perspective with name `NAME' from `PHASH'. -Save it's state before removing. -If we removing from the `*persp-hash*' remove also the menu entries. -Switch all frames with that perspective to another one. -Return the removed perspective." - (interactive "i") - (unless name - (setq name (persp-read-persp - "to remove" nil - (and (eq phash *persp-hash*) - (safe-persp-name (get-current-persp))) - t t))) - (let ((persp (persp-get-by-name name phash)) - (persp-to-switch persp-nil-name)) - (when (persp-p persp) - (persp-save-state persp) - (if (and (eq phash *persp-hash*) (null persp)) - (message "[persp-mode] Error: Can't remove the 'nil' perspective") - (when (eq phash *persp-hash*) - (persp-remove-from-menu persp) - (cl-destructuring-bind (frames . windows) - (persp-frames-and-windows-with-persp persp) - (dolist (w windows) (clear-window-persp w)) - ;; (setq persp-to-switch (or (car (persp-names phash nil)) - ;; persp-nil-name)) - (dolist (f frames) - (persp-frame-switch persp-to-switch f)))) - (remhash name phash))) - persp)) - -(cl-defun persp-add-new (name &optional (phash *persp-hash*)) - "Create a new perspective with the given `NAME'. Add it to `PHASH'. -Return the created perspective." - (interactive "sA name for the new perspective: ") - (if (and name (not (equal "" name))) - (cl-destructuring-bind (e . p) - (persp-by-name-and-exists name phash) - (if e p - (setq p (if (equal persp-nil-name name) - nil (make-persp :name name))) - (persp-add p phash) - (run-hook-with-args 'persp-created-functions p phash) - p)) - (message "[persp-mode] Error: Can't create a perspective with empty name.") - nil)) - -(defun persp-find-and-set-persps-for-buffer (&optional buffer-or-name) - (setq buffer-or-name (if buffer-or-name - (persp-get-buffer-or-null buffer-or-name) - (current-buffer))) - (mapc #'(lambda (p) - (when p - (persp-add-buffer buffer-or-name p nil nil))) - (persp--buffer-in-persps buffer-or-name)) - (persp--buffer-in-persps-set - buffer-or-name - (cl-delete-if-not (apply-partially #'memq buffer-or-name) - (delq nil (persp-persps)) - :key #'persp-buffers))) - -(cl-defun persp-contain-buffer-p - (&optional (buff-or-name (current-buffer)) (persp (get-current-persp)) delweak) - (if (and delweak (safe-persp-weak persp)) - nil - (if persp - (memq (persp-get-buffer-or-null buff-or-name) - (persp-buffers persp)) - t))) -(cl-defun persp-contain-buffer-p* - (&optional (buff-or-name (current-buffer)) (persp (get-current-persp)) delweak) - (if (and delweak (safe-persp-weak persp)) - nil - (if persp - (memq persp (persp--buffer-in-persps - (persp-get-buffer-or-null buff-or-name))) - t))) - -(cl-defun persp-add-buffer - (&optional buffs-or-names (persp (get-current-persp)) - (switchorno persp-switch-to-added-buffer) - (called-interactively-p (called-interactively-p 'any))) - (interactive "i") - (when (and called-interactively-p current-prefix-arg) - (setq switchorno (not switchorno))) - (unless buffs-or-names - (setq buffs-or-names - (when called-interactively-p - (let ((*persp-restrict-buffers-to* 1) - persp-restrict-buffers-to-if-foreign-buffer) - (persp-read-buffer (concat - "Add buffers to the perspective" - (and switchorno - " and switch to first added buffer") - ": ") - (current-buffer) t nil t))))) - (unless (listp buffs-or-names) (setq buffs-or-names (list buffs-or-names))) - (mapc - #'(lambda (bon) - (let ((buffer (persp-get-buffer-or-null bon))) - (when (and persp buffer) - (unless (persp-contain-buffer-p buffer persp) - (push buffer (persp-buffers persp))) - (unless (persp-contain-buffer-p* buffer persp) - (persp--buffer-in-persps-add buffer persp))) - (when (and buffer switchorno (eq persp (get-current-persp))) - (persp-switch-to-buffer buffer)) - buffer)) - buffs-or-names) - buffs-or-names) - -(cl-defun persp-add-buffers-by-regexp (&optional regexp (persp (get-current-persp))) - (interactive) - (when persp - (persp-do-buffer-list-by-regexp - :regexp regexp :func 'persp-add-buffer :rest-args (list persp nil) - :blist (persp-buffer-list-restricted (selected-frame) 1)))) - -(cl-defun persp-temporarily-display-buffer - (&optional buff-or-name (called-interactively-p (called-interactively-p 'any))) - (interactive "i") - (let ((persp-temporarily-display-buffer t)) - (unless buff-or-name - (setq buff-or-name - (if called-interactively-p - (let ((*persp-restrict-buffers-to* - (if (and called-interactively-p current-prefix-arg) 0 1)) - (persp-restrict-buffers-to-if-foreign-buffer - (if (= 0 *persp-restrict-buffers-to*) -1 nil))) - (persp-read-buffer - (if (= 0 *persp-restrict-buffers-to*) - "Remove a buffer from the perspective, but still display it: " - "Temporarily display a buffer, not adding it to the current perspective: ") - nil t)) - (current-buffer)))) - (let ((buffer (persp-get-buffer-or-null buff-or-name))) - (when buffer - (let ((persp (get-current-persp))) - (when (and persp (persp-contain-buffer-p* buffer persp)) - (let (persp-autokill-buffer-on-remove - persp-autokill-persp-when-removed-last-buffer) - (persp-remove-buffer buffer persp nil nil nil nil)))) - (persp-switch-to-buffer buffer t))))) - - -(defun persp--buffer-do-auto-action-if-needed (buffer) - (when (and persp-autokill-buffer-on-remove - (persp-buffer-free-p - buffer - (eq 'kill-weak persp-autokill-buffer-on-remove))) - (let (persp-autokill-buffer-on-remove) - (persp-kill-buffer buffer)))) - -(defun persp--remove-buffer-1 (buffer &optional persp) - (if persp - (progn - (when persp-when-remove-buffer-switch-to-other-buffer - (persp-switch-to-prev-buffer buffer persp)) - (persp--buffer-in-persps-remove buffer persp) - (setf (persp-buffers persp) (delq buffer (persp-buffers persp))) - persp) - (mapcar (apply-partially #'persp--remove-buffer-1 buffer) - (persp-other-persps-with-buffer-except-nil buffer persp)))) - -(defun persp--remove-buffer-2 (&optional persp buffer-or-name) - (let ((buffer (if buffer-or-name - (persp-get-buffer-or-null buffer-or-name) - (current-buffer)))) - (when buffer - (persp--remove-buffer-1 buffer persp) - (persp--buffer-do-auto-action-if-needed buffer) - (persp--do-auto-action-if-needed persp)) - buffer)) - -(defun persp--remove-buffers-from-nil-p (buffs-or-names) - (cl-typecase persp-remove-buffers-from-nil-persp-behaviour - (function - (funcall persp-remove-buffers-from-nil-persp-behaviour - buffs-or-names)) - (symbol - (cl-macrolet - ((ask () `(yes-or-no-p - (format "Remove %s buffers from all perspectives?" - buffs-or-names)))) - (cl-case persp-remove-buffers-from-nil-persp-behaviour - (ask-to-rem-from-all - (if (cl-find-if-not #'persp-buffer-free-p buffs-or-names) - (ask) t)) - (ask-if-in-non-weak-persp - (if (cl-find-if-not - #'(lambda (bon) - (persp-buffer-free-p bon t)) - buffs-or-names) - (ask) t)) - (t t)))) - (t t))) - -(cl-defun persp-remove-buffer - (&optional buffs-or-names (persp (get-current-persp)) - (rem-from-nil-opt persp-remove-buffers-from-nil-persp-behaviour) - (switch persp-when-remove-buffer-switch-to-other-buffer) - called-from-kill-buffer-hook - (called-interactively-p (called-interactively-p 'any))) - "Remove BUFFS-OR-NAMES(which may be a single buffer or a list of buffers) -from the PERSP. On success return removed buffers otherwise nil." - (interactive "i") - - ;; TODO: remove these parameters - (ignore called-from-kill-buffer-hook rem-from-nil-opt switch) - - (unless (listp buffs-or-names) (setq buffs-or-names (list buffs-or-names))) - (unless buffs-or-names - (setq buffs-or-names - (if called-interactively-p - (let ((*persp-restrict-buffers-to* 0) - persp-restrict-buffers-to-if-foreign-buffer) - (persp-read-buffer "Remove buffers from the perspective: " - (current-buffer) t nil t)) - (current-buffer)))) - (when (or persp - (persp--remove-buffers-from-nil-p buffs-or-names)) - (let ((persp-autokill-buffer-on-remove - (if (and called-interactively-p current-prefix-arg) - (not persp-autokill-buffer-on-remove) - persp-autokill-buffer-on-remove))) - (mapcar (apply-partially #'persp--remove-buffer-2 persp) - buffs-or-names)))) - -(defun persp-kill-buffer (&optional buffers-or-names) - "Kill buffers, read buffer with restriction to current perspective." - (interactive (list - (let ((*persp-restrict-buffers-to* 0) - persp-restrict-buffers-to-if-foreign-buffer) - (if persp-mode - (persp-read-buffer - "Kill buffers: " (current-buffer) t nil t) - (read-buffer "Kill buffer: " (current-buffer) t))))) - (unless (listp buffers-or-names) - (setq buffers-or-names (list buffers-or-names))) - (mapc #'kill-buffer - (cl-remove-if-not #'persp-get-buffer-or-null buffers-or-names)) - buffers-or-names) - -(defun persp-switch-to-buffer (buffer-or-name - &optional norecord force-same-window) - - "Switch to buffer, read buffer with restriction to current perspective." - - (interactive (list - (let ((*persp-restrict-buffers-to* 0) - persp-restrict-buffers-to-if-foreign-buffer) - (if persp-mode - (let ((dflt (other-buffer (current-buffer)))) - (unless (memq dflt (safe-persp-buffers - (get-current-persp))) - (cl-psetq dflt (current-buffer))) - (persp-read-buffer "Switch to buffer: " dflt t)) - (read-buffer-to-switch "Switch to buffer: "))))) - (when (and buffer-or-name - (persp-get-buffer-or-null (get-buffer buffer-or-name))) - (switch-to-buffer buffer-or-name norecord force-same-window))) - -(cl-defun persp-remove-buffers-by-regexp - (&optional regexp (persp (get-current-persp))) - (interactive) - (when persp - (persp-do-buffer-list-by-regexp - :regexp regexp :func 'persp-remove-buffer - :blist (persp-buffers persp) :rest-args (list persp)))) - -(cl-defun persp-import-buffers-from (persp-from - &optional (persp-to (get-current-persp))) - (if persp-to - (mapc #'(lambda (b) (persp-add-buffer b persp-to nil nil)) - (safe-persp-buffers persp-from)) - (message "[persp-mode] Error: Can't import buffers to the 'nil' perspective, \ -cause it already contain all buffers."))) - -(cl-defun persp-import-buffers - (names - &optional (persp-to (get-current-persp)) (phash *persp-hash*)) - "Import buffers from perspectives with the given names to another one." - (interactive "i") - (unless (listp names) (setq names (list names))) - (unless names - (setq names (persp-read-persp "to import buffers from" t nil t nil t))) - (mapc #'(lambda (persp-from) - (persp-import-buffers-from persp-from persp-to)) - (mapcar #'(lambda (pn) (persp-get-by-name pn phash)) names))) - -(cl-defun persp-import-win-conf - (name - &optional (persp-to (get-current-persp)) (phash *persp-hash*) - no-update-frames) - (interactive "i") - (unless name - (setq name (persp-read-persp - "to import window configuration from" nil nil t nil t))) - (let ((persp-from (persp-get-by-name name phash))) - (unless (or (eq persp-to persp-from) - (not (persp-p persp-from))) - (if persp-to - (setf (persp-window-conf persp-to) (safe-persp-window-conf persp-from)) - (setq persp-nil-wconf (persp-window-conf persp-from))) - (unless no-update-frames - (persp-update-frames-window-confs (list (safe-persp-name persp-to))))))) - -(cl-defun persp-copy - (new-name - &optional switch (called-interactively-p (called-interactively-p 'any))) - (interactive "i") - (unless new-name - (setq new-name - (read-string "Copy current persp with name: "))) - (if (member new-name (persp-names)) - (progn - (message - "[persp-mode] Error: There is already a perspective with that name %S" - new-name) - nil) - (let* ((new-persp (persp-add-new new-name)) - (current-persp (get-current-persp)) - (new-buffers (when new-persp - (if current-persp - (cl-copy-list (persp-buffers current-persp)) - (safe-persp-buffers current-persp))))) - (when new-persp - (when (and called-interactively-p current-prefix-arg) - (setq new-buffers - (let (choosen-buffers) - (cl-delete-if-not - (cl-destructuring-bind (char &rest _) - (read-multiple-choice - "What buffers to copy? " - '((?a "all") - (?d "displayed") - (?f "free and displayed") - (?F "free") - (?c "choose") - (?n "none"))) - (cl-case char - (?d #'(lambda (b) (get-buffer-window-list b 'no-minibuf))) - (?f #'(lambda (b) (or (persp-buffer-free-p b t) - (get-buffer-window-list b 'no-minibuf)))) - (?F #'(lambda (b) (persp-buffer-free-p b t))) - (?c (setq choosen-buffers - (mapcar #'get-buffer - (persp-read-buffer - "" (current-buffer) t nil t 'push))) - #'(lambda (b) (memq b choosen-buffers))) - (?n #'not) - (?a nil) - (t nil))) - new-buffers)))) - (persp-save-state current-persp) - (setf (persp-window-conf new-persp) - (safe-persp-window-conf current-persp) - (persp-parameters new-persp) - (cl-copy-list (safe-persp-parameters current-persp)) - (persp-weak new-persp) - (if current-persp (persp-weak current-persp) nil)) - (persp-add-buffer new-buffers new-persp nil nil) - (cl-case switch - (window (persp-window-switch new-name)) - (frame (persp-frame-switch new-name)) - (no-switch nil) - (t (persp-switch new-name))) - new-persp)))) - -(cl-defun persp-get-buffer - (&optional (buff-or-name (current-buffer)) (persp (get-current-persp))) - "Like `get-buffer', but constrained to the perspective's list of buffers. -Return the buffer if it's in the perspective or the first buffer from the -perspective buffers or nil." - (let ((buffer (persp-get-buffer-or-null buff-or-name))) - (or (cl-find buffer (safe-persp-buffers persp)) - (cl-first (safe-persp-buffers persp))))) - -(defun persp-get-buffer-or-null (buff-or-name) - "Safely return a buffer or the nil without errors." - (cl-typecase buff-or-name - ((or string buffer) - (let ((buf (get-buffer buff-or-name))) - (and (buffer-live-p buf) - buf))) - (otherwise nil))) - -(defun persp-buffer-filtered-out-p (buff-or-name &rest filters) - (setq filters (if filters - (cons - persp-common-buffer-filter-functions - filters) - persp-common-buffer-filter-functions) - buff-or-name (get-buffer buff-or-name)) - (cl-find-if #'(lambda (filter) - (if (functionp filter) - (funcall filter buff-or-name) - (cl-find-if #'(lambda (f) (funcall f buff-or-name)) filter))) - filters)) - -(defun persp-buffer-free-p (&optional buff-or-name del-weak) - (unless buff-or-name (setq buff-or-name (current-buffer))) - (let ((persps (persp--buffer-in-persps - (persp-get-buffer-or-null buff-or-name)))) - (if persps - (if del-weak - (not - (cl-find-if-not #'persp-weak persps)) - nil) - t))) - - -(cl-defun persp-set-another-buffer-for-window - (&optional (old-buff-or-name (current-buffer)) (window (selected-window)) - (persp (get-current-persp nil window))) - (unless (window-minibuffer-p window) - (let* ((old-buf (persp-get-buffer-or-null old-buff-or-name)) - (new-buf (if persp-set-frame-buffer-predicate - (other-buffer old-buf) - (cl-find-if #'(lambda (bc) - (and (bufferp bc) (not (eq bc old-buf)) - (persp-contain-buffer-p bc persp))) - (append (mapcar #'car - (window-prev-buffers window)) - (window-next-buffers window)))))) - (set-window-buffer - window - (or (and (buffer-live-p new-buf) new-buf) - (car (persp-buffer-list-restricted (window-frame window) 2.5)) - (car (buffer-list))))))) - -(cl-defun persp-switch-to-prev-buffer - (&optional (old-buff-or-name (current-buffer)) (persp (get-current-persp))) - "Switch all windows in all frames with a perspective displaying that buffer -to some previous buffer in the perspective. -Return that old buffer." - (let ((old-buf (persp-get-buffer-or-null old-buff-or-name))) - (cl-destructuring-bind (frames . windows) - (persp-frames-and-windows-with-persp persp) - (dolist (w windows) - (persp-set-another-buffer-for-window old-buf w)) - (dolist (f frames) - (dolist (w (get-buffer-window-list old-buf 'no-minibuf f)) - (persp-set-another-buffer-for-window old-buf w)))) - old-buf)) - -(cl-defsubst persp-filter-out-bad-buffers (&optional (persp (get-current-persp))) - ;; filter out killed buffers - (when persp - (setf (persp-buffers persp) - (cl-delete-if-not #'persp-get-buffer-or-null (persp-buffers persp))))) - -(defun persp-hide (names) - (interactive "i") - (unless (listp names) (setq names (list names))) - (unless names - (setq names (persp-read-persp - "to hide" t (safe-persp-name (get-current-persp)) t))) - (let ((persp-to-switch (get-current-persp)) - (hidden-persps - (mapcar #'(lambda (pn) - (let ((persp (persp-get-by-name pn))) - (when (persp-p persp) - (if persp - (setf (persp-hidden persp) t) - (setq persp-nil-hidden t))) - persp)) - names))) - (when (safe-persp-hidden persp-to-switch) - (setq persp-to-switch - (car (persp-other-not-hidden-persps persp-to-switch)))) - (mapc #'(lambda (p) - (when (persp-p p) - (cl-destructuring-bind (frames . windows) - (persp-frames-and-windows-with-persp p) - (dolist (w windows) (clear-window-persp w)) - (dolist (f frames) - (persp-frame-switch (safe-persp-name persp-to-switch) f))))) - hidden-persps))) - -(defun persp-unhide (names) - (interactive "i") - (unless (listp names) (setq names (list names))) - (unless names - (let ((hidden-persps - (mapcar #'safe-persp-name - (cl-delete-if-not #'safe-persp-hidden - (persp-persps))))) - (setq names - (persp-read-persp - "to unhide" t (car hidden-persps) t nil nil hidden-persps t)))) - (when names - (mapc #'(lambda (pn) - (let ((persp (persp-get-by-name pn))) - (when (persp-p persp) - (if persp - (setf (persp-hidden persp) nil) - (setq persp-nil-hidden nil))))) - names))) - -(cl-defun persp-kill (names &optional dont-kill-buffers - (called-interactively-p (called-interactively-p 'any))) - (interactive "i") - (when (and called-interactively-p current-prefix-arg) - (setq dont-kill-buffers (not dont-kill-buffers))) - (unless (listp names) (setq names (list names))) - (unless names - (setq names (persp-read-persp - (concat "to kill" - (and dont-kill-buffers " not killing buffers")) - t (safe-persp-name (get-current-persp)) t))) - (mapc #'(lambda (pn) - (let ((persp (persp-get-by-name pn))) - (when (persp-p persp) - (when (or (not called-interactively-p) - (not (null persp)) - (yes-or-no-p - "Really kill the 'nil' perspective (It'l kill all buffers)?")) - (let ((pfile (persp-parameter 'persp-file persp))) - (cl-case persp-auto-save-persps-to-their-file-before-kill - (persp-file nil) - ('nil (setq pfile nil)) - (t (unless pfile - (setq pfile persp-auto-save-fname)))) - (when pfile - (persp-save-to-file-by-names - pfile *persp-hash* (list pn) t nil))) - (run-hook-with-args 'persp-before-kill-functions persp) - (let (persp-autokill-persp-when-removed-last-buffer) - (if dont-kill-buffers - (let (persp-autokill-buffer-on-remove) - (mapc #'(lambda (b) - (persp-remove-buffer b persp t t nil nil)) - (safe-persp-buffers persp))) - (mapc #'(lambda (b) - (persp-remove-buffer b persp t t nil nil)) - (safe-persp-buffers persp)))) - (when persp - (persp-remove-by-name pn)))))) - names)) - -(defun persp-kill-without-buffers (names) - (interactive "i") - (persp-kill names t nil)) - -(cl-defun persp-save-and-kill - (names &optional dont-kill-buffers - (called-interactively-p (called-interactively-p 'any))) - (interactive "i") - (when (and called-interactively-p current-prefix-arg) - (setq dont-kill-buffers (not dont-kill-buffers))) - (unless (listp names) (setq names (list names))) - (unless names - (setq names (persp-read-persp - (concat "to save and kill" - (and dont-kill-buffers " not killing buffers")) - t (safe-persp-name (get-current-persp)) t))) - (let ((temphash (make-hash-table :test 'equal :size 10))) - (mapc #'(lambda (p) - (persp-add p temphash)) - (mapcar #'(lambda (pn) (persp-get-by-name pn)) names)) - (persp-save-state-to-file persp-auto-save-fname temphash - persp-auto-save-persps-to-their-file - 'yes))) - -(cl-defun persp-rename (new-name - &optional (persp (get-current-persp)) (phash *persp-hash*)) - "Change the name field of the `PERSP'. -Return old name on success, otherwise nil." - (interactive "i") - (if persp - (let ((opersp (persp-get-by-name new-name phash)) - (old-name (safe-persp-name persp))) - (unless new-name - (setq new-name - (read-string - (concat "New name for the " old-name " perspective: ") old-name))) - (if (and (not (persp-p opersp)) new-name - (not (equal old-name new-name))) - (progn - (when (eq phash *persp-hash*) - (persp-remove-from-menu persp)) - (remhash old-name phash) - (setf (persp-name persp) new-name) - (puthash new-name persp phash) - (when (eq phash *persp-hash*) - (persp-add-to-menu persp) - (run-hook-with-args - 'persp-renamed-functions persp old-name new-name)) - old-name) - (message - "[persp-mode] Error: There is already a perspective with that name: %S." - new-name) - nil)) - (message - "[persp-mode] Error: You can't rename the `nil' perspective, use \ -M-x: customize-variable RET persp-nil-name RET") - nil)) - -(cl-defun persp-switch - (name &optional frame (window (selected-window)) - (called-interactively-p (called-interactively-p 'any))) - "Switch to the perspective with name `NAME'. -If there is no perspective with that name it will be created. -Return `NAME'." - (interactive "i") - (let ((switch-type 'frame)) - (if (or (window-persp-set-p window) - (and called-interactively-p current-prefix-arg)) - (setq switch-type 'window) - (unless frame (setq frame (window-frame window)))) - (if (eq 'window switch-type) - (persp-window-switch name window) - (persp-frame-switch name frame)))) -(cl-defun persp-frame-switch (name &optional (frame (selected-frame))) - (interactive "i") - (unless name - (setq name (persp-read-persp "to switch(in frame)" nil nil nil nil t))) - (unless (memq frame persp-inhibit-switch-for) - (run-hook-with-args 'persp-before-switch-functions name frame) - (let ((persp-inhibit-switch-for (cons frame persp-inhibit-switch-for))) - (persp-activate (persp-add-new name) frame))) - name) -(cl-defun persp-window-switch (name &optional (window (selected-window))) - (interactive "i") - (unless name - (setq name (persp-read-persp "to switch(in window)" nil nil nil nil t))) - (unless (memq window persp-inhibit-switch-for) - (run-hook-with-args 'persp-before-switch-functions name window) - (let ((persp-inhibit-switch-for (cons window persp-inhibit-switch-for))) - (persp-activate (persp-add-new name) window))) - name) - -(defun persp-before-make-frame () - (let ((persp (persp-get-by-name - (or (and persp-set-last-persp-for-new-frames - persp-last-persp-name) - persp-nil-name)))) - (unless (persp-p persp) - (when persp-set-last-persp-for-new-frames - (setq persp-last-persp-name persp-nil-name)) - (setq persp (persp-add-new persp-nil-name))) - (persp-save-state persp nil t))) - -(defun persp--do-auto-action-if-needed (persp) - (when (and (safe-persp-auto persp) - persp-autokill-persp-when-removed-last-buffer - (null (safe-persp-buffers persp))) - (cond - ((functionp persp-autokill-persp-when-removed-last-buffer) - (funcall persp-autokill-persp-when-removed-last-buffer persp)) - ((or - (eq 'hide persp-autokill-persp-when-removed-last-buffer) - (and (eq 'hide-auto persp-autokill-persp-when-removed-last-buffer) - (safe-persp-auto persp))) - (persp-hide (safe-persp-name persp))) - ((or - (eq t persp-autokill-persp-when-removed-last-buffer) - (eq 'kill persp-autokill-persp-when-removed-last-buffer) - (and - (eq 'kill-auto persp-autokill-persp-when-removed-last-buffer) - (safe-persp-auto persp))) - (persp-kill (safe-persp-name persp) nil nil))))) - -(defsubst persp--deactivate (frame-or-window &optional new-persp) - (let (persp) - (cl-typecase frame-or-window - (frame - (setq persp (get-frame-persp frame-or-window)) - (unless (eq persp new-persp) - (with-selected-frame frame-or-window - (run-hook-with-args 'persp-before-deactivate-functions 'frame)) - (persp-frame-save-state - frame-or-window - (if persp-set-last-persp-for-new-frames - (equal (safe-persp-name persp) persp-last-persp-name) - (null persp))))) - (window - (setq persp (get-window-persp frame-or-window)) - (unless (eq persp new-persp) - (with-selected-window frame-or-window - (run-hook-with-args 'persp-before-deactivate-functions 'window))))) - (let ((persp-inhibit-switch-for - (cons frame-or-window persp-inhibit-switch-for))) - (persp--do-auto-action-if-needed persp)))) - -(cl-defun persp-activate - (persp &optional (frame-or-window (selected-frame)) new-frame-p) - (when frame-or-window - (let (old-persp type) - (cl-typecase frame-or-window - (frame - (setq old-persp (get-frame-persp frame-or-window) - type 'frame)) - (window - (setq old-persp (get-window-persp frame-or-window) - type 'window))) - (when (or new-frame-p - (not (eq old-persp persp))) - (unless new-frame-p - (persp--deactivate frame-or-window persp)) - (cl-case type - (frame - (setq persp-last-persp-name (safe-persp-name persp)) - (set-frame-persp persp frame-or-window) - (when persp-init-frame-behaviour - (persp-restore-window-conf frame-or-window persp new-frame-p)) - (with-selected-frame frame-or-window - (run-hook-with-args 'persp-activated-functions 'frame))) - (window - (set-window-persp persp frame-or-window) - (let ((cbuf (window-buffer frame-or-window))) - (unless (persp-contain-buffer-p cbuf persp) - (persp-set-another-buffer-for-window cbuf frame-or-window persp))) - (with-selected-window frame-or-window - (run-hook-with-args 'persp-activated-functions 'window)))))))) - -(defun persp-init-new-frame (frame) - (condition-case-unless-debug err - (persp-init-frame frame t (frame-parameter frame 'client)) - (error - (message "[persp-mode] Error: Can not initialize frame -- %S" - err)))) -(cl-defun persp-init-frame (frame &optional new-frame-p client) - (let ((persp-init-frame-behaviour - (cond - ((and client - (not (eql -1 persp-emacsclient-init-frame-behaviour-override))) - persp-emacsclient-init-frame-behaviour-override) - ((and (eq this-command 'make-frame) - (not (eql -1 persp-interactive-init-frame-behaviour-override))) - persp-interactive-init-frame-behaviour-override) - ((and new-frame-p (not (eql -1 persp-init-new-frame-behaviour-override))) - persp-init-new-frame-behaviour-override) - (t persp-init-frame-behaviour)))) - (let (persp-name persp) - (cl-macrolet - ((set-default-persp - () - `(progn - (setq persp-name (or (and persp-set-last-persp-for-new-frames - persp-last-persp-name) - persp-nil-name) - persp (persp-get-by-name persp-name)) - (unless (persp-p persp) - (setq persp-name persp-nil-name - persp (persp-add-new persp-name)))))) - (cl-typecase persp-init-frame-behaviour - (function - (funcall persp-init-frame-behaviour frame new-frame-p)) - (string - (setq persp-name persp-init-frame-behaviour - persp (persp-add-new persp-name))) - (symbol - (cl-case persp-init-frame-behaviour - (auto-temp (setq persp-name (persp-gen-random-name) - persp (persp-add-new persp-name)) - (when persp - (setf (persp-auto persp) t))) - (prompt (select-frame frame) - (setq persp-name - (persp-read-persp "to switch" nil nil nil nil t) - persp (persp-add-new persp-name))) - (t (set-default-persp)))) - (t (set-default-persp)))) - (when persp-name - (modify-frame-parameters frame `((persp . nil))) - (when persp-set-frame-buffer-predicate - (persp-set-frame-buffer-predicate frame)) - (persp-set-frame-server-switch-hook frame) - (when (or (eq persp-init-frame-behaviour 'persp-ignore-wconf) - (eq persp-init-frame-behaviour 'persp-ignore-wconf-once)) - (set-frame-parameter frame persp-init-frame-behaviour t)) - (persp-activate persp frame new-frame-p))))) - -(defun persp-delete-frame (frame) - (condition-case-unless-debug err - (persp--deactivate frame persp-not-persp) - (error - (message "[persp-mode] Error: Can not deactivate frame -- %S" - err)))) - -;; TODO: rename -(cl-defun find-other-frame-with-persp (&optional (persp (get-frame-persp)) - (exframe (selected-frame)) - for-save) - (let ((flist (delq exframe (persp-frames-with-persp persp)))) - (cl-find-if - #'(lambda (f) - (and f - (if for-save - (and (not (frame-parameter f 'persp-ignore-wconf)) - (not (frame-parameter f 'persp-ignore-wconf-once))) - t) - (eq persp (get-frame-persp f)))) - flist))) - - -;; Helper funcs: - -(defun persp-add-minor-mode-menu () - (easy-menu-define persp-minor-mode-menu - persp-mode-map - "The menu for the `persp-mode'." - '("Perspectives" - "-"))) - -(defun persp-remove-from-menu (persp) - (let ((name (safe-persp-name persp))) - (cl-psetq persp-names-cache (cl-delete name persp-names-cache :count 1)) - (easy-menu-remove-item persp-minor-mode-menu nil name) - (when persp - (easy-menu-remove-item persp-minor-mode-menu '("kill") name)))) - -(defun persp-add-to-menu (persp) - (let ((name (safe-persp-name persp))) - (cl-psetq persp-names-cache - (append persp-names-cache (list name))) - (let ((str_name name)) - (easy-menu-add-item persp-minor-mode-menu nil - (vector str_name #'(lambda () (interactive) - (persp-switch str_name)))) - (when persp - (easy-menu-add-item persp-minor-mode-menu '("kill") - (vector str_name #'(lambda () (interactive) - (persp-kill str_name)))))))) - -(cl-defun persp-read-persp - (&optional action multiple default require-match delnil delcur persp-list - show-hidden (default-mode t)) - - "Read perspective name(s)." - - (when persp-names-sort-before-read-function - (cl-psetq persp-names-cache - (funcall persp-names-sort-before-read-function - persp-names-cache))) - - (cl-psetq persp-list - (if persp-list - (cl-delete-if-not #'(lambda (pn) (member pn persp-list)) - (persp-names-current-frame-fast-ordered)) - (persp-names-current-frame-fast-ordered))) - - (when delnil - (setq persp-list (cl-delete persp-nil-name persp-list :count 1))) - (when delcur - (setq persp-list (cl-delete (safe-persp-name (get-current-persp)) persp-list :count 1))) - (unless show-hidden - (setq persp-list - (cl-delete-if #'safe-persp-hidden persp-list :key #'persp-get-by-name))) - (when (and default (not (member default persp-list))) - (setq default nil)) - (let (retlst) - (cl-macrolet - ((call-pif - () - `(funcall - persp-interactive-completion-function - (concat - "Perspective name" (and multiple "s") (and action " ") action - (if default (concat " (default " default ")") "") - (when retlst - (concat "< " (mapconcat #'identity retlst " ") " > ")) - ": ") - persp-list nil require-match nil nil default))) - (if multiple - (let ((done_str "[>done<]") (not-finished default-mode) - exit-minibuffer-function mb-local-key-map - (push-keys (alist-get 'push-item persp-read-multiple-keys)) - (pop-keys (alist-get 'pop-item persp-read-multiple-keys)) - push-keys-backup pop-keys-backup) - (while (member done_str persp-list) - (setq done_str (concat ">" done_str))) - (let ((persp-minibuffer-setup - #'(lambda () - (setq mb-local-key-map (current-local-map)) - (when (keymapp mb-local-key-map) - (unless exit-minibuffer-function - (setq exit-minibuffer-function - (or (lookup-key mb-local-key-map (kbd "RET")) - persp-read-multiple-exit-minibuffer-function))) - (unless push-keys-backup - (setq push-keys-backup - (lookup-key mb-local-key-map push-keys))) - (define-key mb-local-key-map push-keys - #'(lambda () (interactive) - (setq not-finished 'push) - (funcall exit-minibuffer-function))) - (unless pop-keys-backup - (setq pop-keys-backup - (lookup-key mb-local-key-map pop-keys))) - (define-key mb-local-key-map pop-keys - #'(lambda () (interactive) - (setq not-finished 'pop) - (funcall exit-minibuffer-function)))))) - cp) - (unwind-protect - (progn - (add-hook 'minibuffer-setup-hook persp-minibuffer-setup t) - (while not-finished - (setq cp (call-pif)) - (cl-case not-finished - (push - (when (and cp (member cp persp-list)) - (if retlst - (when (string= cp done_str) - (setq not-finished nil)) - (push done_str persp-list)) - (when not-finished - (if (eq 'reverse multiple) - (setq retlst (append retlst (list cp))) - (push cp retlst)) - (setq persp-list (cl-delete cp persp-list :count 1) - default done_str))) - (when not-finished - (setq not-finished default-mode))) - (pop - (let ((last-item (pop retlst))) - (unless retlst (setq persp-list (cl-delete done_str persp-list :count 1) - default nil)) - (when last-item - (push last-item persp-list))) - (setq not-finished default-mode)) - (t - (when (and cp (not (string= cp done_str)) - (member cp persp-list)) - (push cp retlst)) - (setq not-finished nil))))) - (remove-hook 'minibuffer-setup-hook persp-minibuffer-setup) - (when (keymapp mb-local-key-map) - (when (lookup-key mb-local-key-map push-keys) - (define-key mb-local-key-map push-keys push-keys-backup)) - (when (lookup-key mb-local-key-map pop-keys) - (define-key mb-local-key-map pop-keys pop-keys-backup))))) - retlst) - (call-pif))))) -(define-obsolete-function-alias 'persp-prompt 'persp-read-persp "persp-mode 2.9") - -(defsubst persp--set-frame-buffer-predicate-buffer-list-cache (buflist) - (prog1 - (setq persp-frame-buffer-predicate-buffer-list-cache buflist) - (unless persp-frame-buffer-predicate-buffer-list-cache - (setq persp-frame-buffer-predicate-buffer-list-cache :nil)) - (run-at-time - 2 nil #'(lambda () - (setq persp-frame-buffer-predicate-buffer-list-cache nil))))) -(defmacro persp--get-frame-buffer-predicate-buffer-list-cache (buflist) - `(if persp-frame-buffer-predicate-buffer-list-cache - (if (eq :nil persp-frame-buffer-predicate-buffer-list-cache) - nil - persp-frame-buffer-predicate-buffer-list-cache) - (persp--set-frame-buffer-predicate-buffer-list-cache ,buflist))) -(defun persp-generate-frame-buffer-predicate (opt) - (if opt - (eval - `(lambda (b) - (if (string-prefix-p " *temp*" (buffer-name (current-buffer))) - t - ,(cl-typecase opt - (function - `(funcall (with-no-warnings ',opt) b)) - (number - `(let ((*persp-restrict-buffers-to* ,opt)) - (memq - b (persp--get-frame-buffer-predicate-buffer-list-cache - (let ((ret - (persp-buffer-list-restricted - (selected-frame) ,opt - persp-restrict-buffers-to-if-foreign-buffer t))) - (if (get-current-persp) - ret - (cl-delete-if #'persp-buffer-filtered-out-p ret))))))) - (symbol - (cl-case opt - ('nil t) - (restricted-buffer-list - '(progn - (memq - b (persp--get-frame-buffer-predicate-buffer-list-cache - (let ((ret - (persp-buffer-list-restricted - (selected-frame) - *persp-restrict-buffers-to* - persp-restrict-buffers-to-if-foreign-buffer - t))) - (if (get-current-persp) - ret - (cl-delete-if #'persp-buffer-filtered-out-p ret))))))) - (t '(memq - b (persp--get-frame-buffer-predicate-buffer-list-cache - (let ((ret (safe-persp-buffers (get-current-persp)))) - (if (get-current-persp) - ret - (cl-delete-if #'persp-buffer-filtered-out-p ret)))))))) - (t t))))) - nil)) - -(defun persp-set-frame-buffer-predicate (frame &optional off) - (let ((old-pred (frame-parameter frame 'persp-buffer-predicate-old)) - (cur-pred (frame-parameter frame 'buffer-predicate)) - (last-persp-pred - (frame-parameter frame 'persp-buffer-predicate-generated))) - (let (new-pred) - (if off - (progn - (set-frame-parameter frame 'persp-buffer-predicate-old nil) - (set-frame-parameter frame 'persp-buffer-predicate-generated nil) - (setq new-pred (if (eq cur-pred last-persp-pred) old-pred cur-pred)) - (set-frame-parameter frame 'buffer-predicate new-pred)) - (unless persp-frame-buffer-predicate - (setq persp-frame-buffer-predicate - (persp-generate-frame-buffer-predicate - persp-set-frame-buffer-predicate))) - (if persp-frame-buffer-predicate - (progn - (set-frame-parameter frame 'persp-buffer-predicate-old - (if (eq cur-pred last-persp-pred) - old-pred (setq old-pred cur-pred))) - (setq new-pred - (cl-case old-pred - ('nil persp-frame-buffer-predicate) - (t `(lambda (b) - (and - (funcall (with-no-warnings - ',persp-frame-buffer-predicate) - b) - (funcall (with-no-warnings ',old-pred) b)))))) - (unless (symbolp new-pred) - (setq new-pred (with-no-warnings - (let ((warning-minimum-level :emergency) - byte-compile-warnings) - (byte-compile new-pred))))) - (set-frame-parameter - frame 'persp-buffer-predicate-generated new-pred) - (set-frame-parameter frame 'buffer-predicate new-pred)) - (persp-set-frame-buffer-predicate frame t)))))) - -(defun persp-update-frames-buffer-predicate (&optional off) - (unless off - (setq persp-frame-buffer-predicate nil) - (persp-update-frames-buffer-predicate t)) - (mapc #'(lambda (f) (persp-set-frame-buffer-predicate f off)) - (persp-frame-list-without-daemon))) - - -(defun persp-generate-frame-server-switch-hook (opt) - (if opt - (eval - `(lambda (frame) - ,(if (functionp opt) - `(funcall (with-no-warnings ',opt) frame) - `(let* ((frame-client (frame-parameter frame 'client)) - (frame-client-bl (when (processp frame-client) - (process-get frame-client 'buffers)))) - ,(cl-case opt - (only-file-windows - `(if frame-client - (when frame-client-bl - (mapc #'(lambda (w) - (unless (memq (window-buffer w) - frame-client-bl) - (delete-window w))) - (window-list frame 'no-minibuf))) - (let (frame-server-bl) - (mapc #'(lambda (proc) - (setq frame-server-bl - (append frame-server-bl - (process-get proc 'buffers)))) - (server-clients-with 'frame nil)) - (when frame-server-bl - (mapc #'(lambda (w) - (unless (memq (window-buffer w) - frame-server-bl) - (delete-window w))) - (window-list frame 'no-minibuf)))))) - (only-file-windows-for-client-frame - `(when frame-client-bl - (mapc #'(lambda (w) - (unless (memq (window-buffer w) frame-client-bl) - (delete-window w))) - (window-list frame 'no-minibuf)))) - (t nil)))))) - nil)) - -(defun persp-set-frame-server-switch-hook (frame) - (when (frame-parameter frame 'client) - (set-frame-parameter - frame 'persp-server-switch-hook persp-frame-server-switch-hook))) - -(defun persp-update-frame-server-switch-hook () - (setq persp-frame-server-switch-hook - (persp-generate-frame-server-switch-hook persp-server-switch-behaviour)) - (mapc #'persp-set-frame-server-switch-hook - (persp-frame-list-without-daemon))) - - -(defun persp-ido-setup () - (when (eq ido-cur-item 'buffer) - (setq persp-disable-buffer-restriction-once nil))) - -(defun persp-restrict-ido-buffers () - "Support for the `ido-mode'." - (let ((buffer-names-sorted - (if persp-disable-buffer-restriction-once - (mapcar #'buffer-name (persp-buffer-list-restricted nil -1 nil)) - (mapcar #'buffer-name (persp-buffer-list-restricted)))) - (indices (make-hash-table))) - (let ((i 0)) - (dolist (elt ido-temp-list) - (puthash elt i indices) - (setq i (1+ i)))) - (setq ido-temp-list - (sort buffer-names-sorted #'(lambda (a b) - (< (gethash a indices 10000) - (gethash b indices 10000))))))) - -;; TODO: rename -(defun ido-toggle-persp-filter () - (interactive) - (setq persp-disable-buffer-restriction-once - (not persp-disable-buffer-restriction-once) - ido-text-init ido-text ido-exit 'refresh) - (exit-minibuffer)) - - -(cl-defun persp-read-buffer - (prompt &optional default require-match predicate multiple (default-mode t)) - - "Read buffers with restriction." - - (setq persp-disable-buffer-restriction-once nil) - - (when default - (unless (stringp default) - (if (and (bufferp default) (buffer-live-p default)) - (setq default (buffer-name default)) - (setq default nil)))) - - (if prompt - (setq prompt (car (split-string prompt ": *$" t))) - (setq prompt "Please provide a buffer name: ")) - - (let* ((buffer-names (mapcar #'buffer-name (persp-buffer-list-restricted))) - cp retlst - (done_str "[>done<]") (not-finished default-mode) - - (push-keys (alist-get 'push-item persp-read-multiple-keys)) - (pop-keys (alist-get 'pop-item persp-read-multiple-keys)) - push-keys-backup pop-keys-backup - (toggle-filter-keys - (alist-get 'toggle-persp-buffer-filter persp-read-multiple-keys)) - toggle-filter-keys-backup - - exit-minibuffer-function mb-local-key-map - (persp-minibuffer-setup - #'(lambda () - (setq mb-local-key-map (current-local-map)) - (when (keymapp mb-local-key-map) - (unless exit-minibuffer-function - (setq exit-minibuffer-function - (or (lookup-key mb-local-key-map (kbd "RET")) - persp-read-multiple-exit-minibuffer-function))) - (unless toggle-filter-keys-backup - (setq toggle-filter-keys-backup - (lookup-key mb-local-key-map toggle-filter-keys))) - (define-key mb-local-key-map toggle-filter-keys - #'(lambda () (interactive) - (setq not-finished 'toggle-filter) - (funcall exit-minibuffer-function)))))) - (persp-multiple-minibuffer-setup - #'(lambda () - (when (keymapp mb-local-key-map) - (unless push-keys-backup - (setq push-keys-backup - (lookup-key mb-local-key-map push-keys))) - (define-key mb-local-key-map push-keys - #'(lambda () (interactive) - (setq not-finished 'push) - (funcall exit-minibuffer-function))) - (unless pop-keys-backup - (setq pop-keys-backup - (lookup-key mb-local-key-map pop-keys))) - (define-key mb-local-key-map pop-keys - #'(lambda () (interactive) - (setq not-finished 'pop) - (funcall exit-minibuffer-function))))))) - - (while (member done_str buffer-names) - (setq done_str (concat ">" done_str))) - - (unwind-protect - (progn - (when (and default (not (member default buffer-names))) - (push default buffer-names) - ;; TODO: remove this - ;; (setq default nil) - ) - (when multiple - (add-hook 'minibuffer-setup-hook persp-multiple-minibuffer-setup)) - (add-hook 'minibuffer-setup-hook persp-minibuffer-setup) - (while not-finished - (setq cp - (funcall - persp-interactive-completion-function - (concat prompt - (and default (concat "(default " default ")")) - (and retlst - (concat - "< " (mapconcat #'identity retlst " ") " >")) - (and persp-toggle-read-buffer-filter-keys - (concat - " [`" - (help-key-description - persp-toggle-read-buffer-filter-keys - nil) - "' toggles filter]")) - ": ") - buffer-names predicate require-match nil nil default)) - (cl-case not-finished - (push - (when (and cp (member cp buffer-names)) - (if retlst - (when (string= cp done_str) - (setq not-finished nil)) - (push done_str buffer-names)) - (when not-finished - (if (eq 'reverse multiple) - (setq retlst (append retlst (list cp))) - (push cp retlst)) - (setq buffer-names (cl-delete cp buffer-names :count 1) - default done_str))) - (when not-finished - (setq not-finished default-mode))) - (pop - (let ((last-item (pop retlst))) - (unless retlst (setq buffer-names (cl-delete done_str buffer-names :count 1) - default nil)) - (when last-item - (push last-item buffer-names))) - (setq not-finished default-mode)) - (toggle-filter - (setq persp-disable-buffer-restriction-once - (not persp-disable-buffer-restriction-once)) - (setq buffer-names - (cl-delete-if - #'(lambda (bn) (member bn retlst)) - (mapcar #'buffer-name - (if persp-disable-buffer-restriction-once - (funcall persp-buffer-list-function) - (cl-delete-if #'persp-buffer-filtered-out-p - (persp-buffer-list-restricted)))))) - (setq not-finished default-mode)) - (t - (when (and cp (not (string= cp done_str)) - (member cp buffer-names)) - (push cp retlst)) - (setq not-finished nil)))) - (if multiple retlst (car retlst))) - (remove-hook 'minibuffer-setup-hook persp-multiple-minibuffer-setup) - (remove-hook 'minibuffer-setup-hook persp-minibuffer-setup) - (when (keymapp mb-local-key-map) - (when multiple - (when (lookup-key mb-local-key-map push-keys) - (define-key mb-local-key-map push-keys push-keys-backup)) - (when (lookup-key mb-local-key-map pop-keys) - (define-key mb-local-key-map pop-keys pop-keys-backup))) - (when (lookup-key mb-local-key-map toggle-filter-keys) - (define-key mb-local-key-map toggle-filter-keys - toggle-filter-keys-backup))) - (setq persp-disable-buffer-restriction-once nil)))) - - -;; Save/Load funcs: - -(defun persp-delete-other-windows () - (let ((win (selected-window))) - (when (or (window-parameter win 'window-side) - (window-minibuffer-p win)) - (setq win (cl-loop - for win in (window-list nil 1) - unless (window-parameter win 'window-side) - return win))) - (when win - (let ((ignore-window-parameters t)) - (condition-case-unless-debug err - (delete-other-windows win) - (error - (message "[persp-mode] Warning: Can not delete-other-windows -- %S" err))))))) - -(cl-defun persp-restore-window-conf (&optional (frame (selected-frame)) - (persp (get-frame-persp frame)) - new-frame-p) - (when new-frame-p (sit-for 0.01)) - (unless (run-hook-with-args-until-success 'persp-restore-window-conf-filter-functions - frame persp new-frame-p) - (with-selected-frame frame - (let ((pwc (safe-persp-window-conf persp)) - (split-width-threshold 2) - (split-height-threshold 2) - (window-safe-min-height 1) - (window-safe-min-width 1) - (window-min-height 1) - (window-min-width 1) - (window-resize-pixelwise t) - (gr-mode (and (boundp 'golden-ratio-mode) golden-ratio-mode))) - (when gr-mode - (golden-ratio-mode -1)) - (unwind-protect - (cond - ((functionp persp-restore-window-conf-method) - (funcall persp-restore-window-conf-method frame persp new-frame-p)) - ((null persp-restore-window-conf-method) nil) - (t - (if pwc - (progn - (persp-delete-other-windows) - (set-window-dedicated-p nil nil) - (condition-case-unless-debug err - (funcall persp-window-state-put-function pwc frame) - (error - (message - "[persp-mode] Warning: Can not restore the window \ -configuration, because of the error -- %S" err) - (let* ((cw (selected-window)) - (cwb (window-buffer cw))) - (unless (persp-contain-buffer-p cwb persp) - (persp-set-another-buffer-for-window - cwb cw persp))))) - (when (and new-frame-p persp-is-ibc-as-f-supported) - (setq initial-buffer-choice - #'(lambda () persp-special-last-buffer)))) - (when persp-reset-windows-on-nil-window-conf - (if (functionp persp-reset-windows-on-nil-window-conf) - (funcall persp-reset-windows-on-nil-window-conf) - (persp-delete-other-windows) - (set-window-dedicated-p nil nil) - (let* ((pbs (safe-persp-buffers persp)) - (w (selected-window)) - (wb (window-buffer w))) - (when (and pbs (not (memq wb pbs))) - (persp-set-another-buffer-for-window wb w persp)))))))) - (when gr-mode - (golden-ratio-mode 1))))))) - - -;; Save funcs - -(cl-defun persp-frame-save-state - (&optional (frame (selected-frame)) set-persp-special-last-buffer) - (when (and (frame-live-p frame) - (not (persp-is-frame-daemons-frame frame)) - (not (frame-parameter frame 'persp-ignore-wconf)) - (not (frame-parameter frame 'persp-ignore-wconf-once))) - (let ((persp (get-frame-persp frame))) - (with-selected-frame frame - (when set-persp-special-last-buffer - (persp-special-last-buffer-make-current)) - (if persp - (setf (persp-window-conf persp) - (funcall persp-window-state-get-function frame)) - (setq persp-nil-wconf - (funcall persp-window-state-get-function frame))))))) - -(cl-defun persp-save-state - (&optional (persp (get-frame-persp)) exfr set-persp-special-last-buffer) - (let ((frame (selected-frame))) - (when (eq frame exfr) (setq frame nil)) - (unless (and frame (eq persp (get-frame-persp frame))) - (setq frame (find-other-frame-with-persp persp exfr t))) - (when frame (persp-frame-save-state frame set-persp-special-last-buffer)))) - - -(defun persp-buffers-to-savelist (persp) - (cl-delete-if - #'symbolp - (let (find-ret) - (mapcar #'(lambda (b) - (setq find-ret nil) - (cl-find-if #'(lambda (sl) (when sl (setq find-ret sl))) - persp-save-buffer-functions - :key #'(lambda (s-f) (with-current-buffer b - (funcall s-f b)))) - find-ret) - (if persp - (persp-buffers persp) - (cl-delete-if-not #'persp-buffer-free-p - (funcall persp-buffer-list-function))))))) - -(defun persp-window-conf-to-savelist (persp) - `(def-wconf ,(if (or persp-use-workgroups - (not (version< emacs-version "24.4"))) - (safe-persp-window-conf persp) - nil))) - -(defun persp-elisp-object-readable-p (obj) - (let (print-length print-level) - (or (stringp obj) - (not (string-match-p "#<.*?>" (prin1-to-string obj)))))) - -(defun persp-parameters-to-savelist (persp) - `(def-params ,(cl-remove-if - #'(lambda (param) - (and (not (persp-elisp-object-readable-p param)) - (message "[persp-mode] Info: The parameter %S \ -of the perspective %S can't be saved." - param (safe-persp-name persp)) - t)) - (safe-persp-parameters persp)))) - -(defun persp-to-savelist (persp) - `(def-persp ,(and persp (persp-name persp)) - ,(persp-buffers-to-savelist persp) - ,(persp-window-conf-to-savelist persp) - ,(persp-parameters-to-savelist persp) - ,(safe-persp-weak persp) - ,(safe-persp-auto persp) - ,(safe-persp-hidden persp))) - -(defun persps-to-savelist (&optional phash names-regexp) - (mapcar - #'persp-to-savelist - (cl-delete-if - (apply-partially #'persp-parameter 'dont-save-to-file) - (if (eq phash *persp-hash*) - (mapcar #'(lambda (pn) - (when (or (not names-regexp) - (persp-string-match-p names-regexp pn)) - (persp-get-by-name pn *persp-hash* nil))) - (persp-names-current-frame-fast-ordered)) - (persp-persps (or phash *persp-hash*) names-regexp t))))) - -(defsubst persp-save-with-backups (fname) - (when (and (string= fname - (concat (expand-file-name persp-save-dir) - persp-auto-save-fname)) - (> persp-auto-save-num-of-backups 0)) - (cl-do ((cur persp-auto-save-num-of-backups (1- cur)) - (prev (1- persp-auto-save-num-of-backups) (1- prev))) - ((> 1 cur) nil) - (let ((cf (concat fname (number-to-string cur))) - (pf (concat fname (if (> prev 0) - (number-to-string prev) - "")))) - (when (file-exists-p pf) - (when (file-exists-p cf) - (delete-file cf)) - (rename-file pf cf t)))) - (when (file-exists-p fname) - (rename-file fname (concat fname (number-to-string 1)) t))) - (write-file fname nil) - t) - -(cl-defun persp-save-state-to-file - (&optional - (fname persp-auto-save-fname) (phash *persp-hash*) - (respect-persp-file-parameter persp-auto-save-persps-to-their-file) - (keep-others-in-non-parametric-file 'no)) - (interactive (list (read-file-name "Save perspectives to a file: " - persp-save-dir ""))) - (when (and (stringp fname) phash) - (when (< (string-width (file-name-nondirectory fname)) 1) - (message "[persp-mode] Error: You must provide nonempty filename to save perspectives.") - (cl-return-from persp-save-state-to-file nil)) - (let* ((p-save-dir (or (file-name-directory fname) - (expand-file-name persp-save-dir))) - (p-save-file (concat p-save-dir (file-name-nondirectory fname)))) - (unless (and (file-exists-p p-save-dir) - (file-directory-p p-save-dir)) - (message "[persp-mode] Info: Trying to create the `persp-conf-dir'.") - (make-directory p-save-dir t)) - (if (not (and (file-exists-p p-save-dir) - (file-directory-p p-save-dir))) - (progn - (message "[persp-mode] Error: Can't save perspectives -- \ -`persp-save-dir' does not exists or not a directory %S." p-save-dir) - nil) - (mapc #'persp-save-state (persp-persps phash)) - (run-hook-with-args 'persp-before-save-state-to-file-functions - fname phash respect-persp-file-parameter) - (if (and respect-persp-file-parameter - (cl-member-if (apply-partially #'persp-parameter 'persp-file) - (persp-persps phash nil))) - (let (persp-auto-save-persps-to-their-file - persp-before-save-state-to-file-functions) - (mapc #'(lambda (gr) - (cl-destructuring-bind (pfname . pl) gr - (let ((names (mapcar #'safe-persp-name pl))) - (if pfname - (persp-save-to-file-by-names - pfname phash names 'yes nil) - (persp-save-to-file-by-names - p-save-file phash names - keep-others-in-non-parametric-file nil))))) - (persp-group-by - (apply-partially #'persp-parameter 'persp-file) - (persp-persps phash nil t) t))) - (with-temp-buffer - (buffer-disable-undo) - (erase-buffer) - (goto-char (point-min)) - (insert - ";; -*- mode: emacs-lisp; eval: (progn (pp-buffer) (indent-buffer)) -*-") - (newline) - (insert (let (print-length print-level) - (pp-to-string (persps-to-savelist phash)))) - (persp-save-with-backups p-save-file))))))) - -(cl-defun persp-save-to-file-by-names - (&optional (fname persp-auto-save-fname) (phash *persp-hash*) names - keep-others (called-interactively-p (called-interactively-p 'any))) - (interactive) - (unless names - (setq names - (persp-read-persp - "to save" 'reverse (safe-persp-name (get-current-persp)) - t nil nil nil nil 'push))) - (when (or (not fname) called-interactively-p) - (setq fname (read-file-name - (format "Save a subset of perspectives%s to a file: " names) - persp-save-dir))) - (when names - (unless keep-others - (setq keep-others - (if (and (file-exists-p fname) - (yes-or-no-p "Keep other perspectives in the file?")) - 'yes 'no))) - (let ((temphash (make-hash-table :test 'equal :size 10)) - (persp-nil-wconf persp-nil-wconf) - (persp-nil-parameters (copy-tree persp-nil-parameters)) - (persp-nil-hidden persp-nil-hidden) - bufferlist-diff) - (when (or (eq keep-others 'yes) (eq keep-others t)) - (let ((bufferlist-pre - (mapcar #'(lambda (b) (cons b (persp--buffer-in-persps b))) - (funcall persp-buffer-list-function)))) - (persp-load-state-from-file - fname temphash (cons :not (regexp-opt names))) - (setq bufferlist-diff - (cl-delete-if #'(lambda (bcons) - (when bcons - (cl-destructuring-bind (buf . buf-persps) bcons - (when buf - (persp--buffer-in-persps-set buf buf-persps) - t)))) - (funcall persp-buffer-list-function) - :key #'(lambda (b) (assq b bufferlist-pre)))))) - (mapc #'(lambda (p) - (persp-add p temphash) - (when (and p persp-auto-save-persps-to-their-file) - (set-persp-parameter 'persp-file fname p))) - (mapcar #'(lambda (pn) (persp-get-by-name pn phash)) names)) - (persp-save-state-to-file fname temphash nil) - (mapc #'kill-buffer bufferlist-diff)))) - -(defun persp-tramp-save-buffer (b) - (let* ((buf-f-name (buffer-file-name b)) - (persp-tramp-file-name - (when (and (or (featurep 'tramp) (require 'tramp nil t)) - (tramp-tramp-file-p buf-f-name)) - (let ((dissected-f-name (tramp-dissect-file-name buf-f-name)) - tmh) - (if (tramp-file-name-method dissected-f-name) - (when (and - (or (featurep 'tramp-sh) (require 'tramp-sh nil t)) - (fboundp 'tramp-compute-multi-hops) - (setq tmh - (condition-case-unless-debug err - (tramp-compute-multi-hops dissected-f-name) - (error nil)))) - (let ((persp-tramp-file-name tramp-prefix-format)) - (while tmh - (let* ((hop (car tmh)) - (method (tramp-file-name-method hop)) - (user (tramp-file-name-user hop)) - (host (tramp-file-name-host hop)) - (port (tramp-file-name-port hop)) - (filename (tramp-file-name-localname hop))) - (setq persp-tramp-file-name - (concat - persp-tramp-file-name - method tramp-postfix-method-format - user (when user tramp-postfix-user-format) - host - (when port tramp-prefix-port-format) - port - (if (= (string-width filename) 0) - tramp-postfix-hop-format - (concat - tramp-postfix-host-format filename))) - tmh (cdr tmh)))) - persp-tramp-file-name)) - buf-f-name))))) - (when persp-tramp-file-name - `(def-buffer ,(buffer-name b) - ,persp-tramp-file-name - ,(buffer-local-value 'major-mode b))))) - -;; Load funcs - -(defun persp-update-frames-window-confs (&optional persp-names) - (mapc #'persp-restore-window-conf - (if persp-names - (cl-delete-if-not - #'(lambda (pn) (member pn persp-names)) - (persp-frame-list-without-daemon) - :key #'(lambda (f) (safe-persp-name (get-frame-persp f)))) - (persp-frame-list-without-daemon)))) - -(defmacro persp-car-as-fun-cdr-as-args (lst) - (let ((kar (gensym "lst-car"))) - `(let* ((,kar (car-safe ,lst)) - (args (cdr-safe ,lst)) - (fun (or (condition-case-unless-debug err - (symbol-function ,kar) - (error nil)) - (symbol-value ,kar)))) - (if (functionp fun) - (apply fun args) - (message "[persp-mode] Error: %S is not a function." fun))))) - -(defvar def-buffer nil) -(defun persp-buffer-from-savelist (savelist) - (when (eq (car savelist) 'def-buffer) - (let (persp-add-buffer-on-find-file - buf - (def-buffer - #'(lambda (bname fname mode &optional parameters) - (setq buf (persp-get-buffer-or-null bname)) - (if buf - (if (or (null fname) - (string= fname (buffer-file-name buf))) - buf - (if (file-exists-p fname) - (setq buf (find-file-noselect fname)) - (message - "[persp-mode] Warning: The file %S no longer exists." - fname) - (setq buf nil))) - (if (and fname (file-exists-p fname)) - (with-current-buffer (setq buf (find-file-noselect fname)) - (unless (string= bname (buffer-name buf)) - (rename-buffer bname t))) - (when fname - (message - "[persp-mode] Warning: The file %S no longer exists." - fname)) - (setq buf (get-buffer-create bname)))) - (when (buffer-live-p buf) - (cl-macrolet - ((restorevars - () - `(mapc - #'(lambda (varcons) - (cl-destructuring-bind (vname . vvalue) varcons - (unless (or (eq vname 'buffer-file-name) - (eq vname 'major-mode)) - (set (make-local-variable vname) vvalue)))) - (alist-get 'local-vars parameters)))) - (with-current-buffer buf - (restorevars) - (cond - ((and (boundp 'persp-load-buffer-mode-restore-function) - (variable-binding-locus 'persp-load-buffer-mode-restore-function) - (functionp persp-load-buffer-mode-restore-function)) - (funcall persp-load-buffer-mode-restore-function mode) - (restorevars)) - ((functionp mode) - (when (and (not (eq major-mode mode)) - (not (eq major-mode 'not-loaded-yet))) - (funcall mode) - (restorevars))))))) - buf))) - (condition-case-unless-debug err - (persp-car-as-fun-cdr-as-args savelist) - (error - (message "[persp-mode] Error details: %S" savelist) - (message "[persp-mode] Error: persp-buffer-from-savelist failed to restore a buffer -- %S" err) - buf))))) - -(defun persp-buffers-from-savelist-0 (savelist) - (cl-delete-if-not - #'persp-get-buffer-or-null - (let (find-ret) - (mapcar - #'(lambda (saved-buf) - (setq find-ret nil) - (cl-find-if - #'(lambda (lb) (when lb (setq find-ret lb))) - persp-load-buffer-functions - :key #'(lambda (l-f) - (condition-case-unless-debug err - (funcall l-f saved-buf) - (error - (message "[persp-mode] Error details: %S" saved-buf) - (message "[persp-mode] Error: Failed to resume buffer using %S load buffer function -- %S" l-f err) - nil)))) - find-ret) - savelist)))) - -(defvar def-wconf nil) -(defun persp-window-conf-from-savelist-0 (savelist) - (let ((def-wconf #'identity)) - (persp-car-as-fun-cdr-as-args savelist))) - -(defvar def-params nil) -(defun persp-parameters-from-savelist-0 (savelist) - (let ((def-params #'identity)) - (persp-car-as-fun-cdr-as-args savelist))) - -(defvar def-persp nil) -(defun persp-from-savelist-0 (savelist phash persp-file) - (let ((def-persp - #'(lambda (name dbufs dwc &optional dparams weak auto hidden) - (let* ((pname (or name persp-nil-name)) - (persp (persp-add-new pname phash))) - (mapc #'(lambda (b) - (persp-add-buffer b persp nil nil)) - (condition-case-unless-debug err - (persp-buffers-from-savelist-0 dbufs) - (error - (message "[persp-mode] Error details: %S" dbufs) - (message "[persp-mode] Error: failed to load buffers for %S perspective from %S file -- %S" pname persp-file err) - nil))) - (let ((loaded-wconf - (condition-case-unless-debug err - (persp-window-conf-from-savelist-0 dwc) - (error - (message "[persp-mode] Error details: %S" dwc) - (message "[persp-mode] Error: failed to load window configuration for %S perspective from %S file -- %S" pname persp-file err) - nil)))) - (if (and persp loaded-wconf) - (setf (persp-window-conf persp) loaded-wconf) - (setq persp-nil-wconf loaded-wconf))) - (modify-persp-parameters - (condition-case-unless-debug err - (persp-parameters-from-savelist-0 dparams) - (error - (message "[persp-mode] Error details: %S" dparams) - (message "[persp-mode] Error: Failed to load %S perspective parameters from %S file -- %S" pname persp-file err) - nil)) - persp) - (when persp - (setf (persp-weak persp) weak - (persp-auto persp) auto)) - - (if persp - (setf (persp-hidden persp) hidden) - (setq persp-nil-hidden hidden)) - - (when persp-file - (set-persp-parameter 'persp-file persp-file persp)) - pname)))) - (persp-car-as-fun-cdr-as-args savelist))) - -(defun persps-from-savelist-0 - (savelist phash persp-file set-persp-file names-regexp) - (when (and names-regexp (not (consp names-regexp))) - (setq names-regexp (cons t names-regexp))) - (delq nil - (mapcar #'(lambda (pd) - (condition-case-unless-debug err - (persp-from-savelist-0 pd phash (and set-persp-file persp-file)) - (error - (message "[persp-mode] Error details: %S" pd) - (message "[persp-mode] Error: Can not load a perspective from %S file -- %S" persp-file err) - nil))) - (if names-regexp - (cl-delete-if-not - (apply-partially #'persp-string-match-p names-regexp) - savelist - :key #'(lambda (pd) (or (cadr pd) persp-nil-name))) - savelist)))) - -(defun persp-names-from-savelist-0 (savelist) - (mapcar #'(lambda (pd) (or (cadr pd) persp-nil-name)) savelist)) - -(defun persps-savelist-version-string (savelist) - (let* ((version-list (car savelist)) - (version (or (and (eq (car version-list) - 'def-persp-save-format-version) - (cadr version-list)) - 0))) - (list - (format "%S" version) - (if (eql version 0) - savelist - (cdr savelist))))) - -(defun persp-dispatch-loadf-version (funsym savelist) - (cl-destructuring-bind (version s-list) - (persps-savelist-version-string savelist) - (let ((funame (intern (concat (symbol-name funsym) "-" version)))) - (if (fboundp funame) - (list funame s-list) - (message - "[persp-mode] Warning: Can not find load function for this version: %S." - version) - (list nil s-list))))) - -(defun persps-from-savelist - (savelist phash persp-file set-persp-file names-regexp) - (cl-destructuring-bind (fun s-list) - (persp-dispatch-loadf-version 'persps-from-savelist savelist) - (if fun - (let ((persp-names - (funcall fun s-list phash persp-file set-persp-file names-regexp))) - (run-hook-with-args 'persp-after-load-state-functions persp-file phash - persp-names) - persp-names) - (message - "[persp-mode] Error: Can not load perspectives from savelist: %S -\tloaded from %S" savelist persp-file) - nil))) - -(defun persp-list-persp-names-in-file (fname) - (when (and fname (file-exists-p fname)) - (let* ((pslist (with-temp-buffer - (buffer-disable-undo) - (insert-file-contents fname nil nil nil t) - (goto-char (point-min)) - (read (current-buffer))))) - (cl-destructuring-bind (fun s-list) - (persp-dispatch-loadf-version 'persp-names-from-savelist pslist) - (if fun - (funcall fun s-list) - (message - "[persp-mode] Error: Can not list perspective names in file %S." - fname)))))) - - -(cl-defun persp-load-state-from-file - (&optional (fname persp-auto-save-fname) (phash *persp-hash*) - names-regexp set-persp-file) - (interactive (list (read-file-name "Load perspectives from a file: " - persp-save-dir))) - (when fname - (let ((p-save-file (concat (or (file-name-directory fname) - (expand-file-name persp-save-dir)) - (file-name-nondirectory fname)))) - (if (not (file-exists-p p-save-file)) - (progn (message "[persp-mode] Error: No such file -- %S." p-save-file) - nil) - (let ((readed-list - (with-temp-buffer - (buffer-disable-undo) - (insert-file-contents p-save-file nil nil nil t) - (goto-char (point-min)) - (read (current-buffer))))) - (persps-from-savelist - readed-list phash p-save-file set-persp-file names-regexp)))))) - -(cl-defun persp-load-from-file-by-names (&optional (fname persp-auto-save-fname) - (phash *persp-hash*) - names) - (interactive - (list (read-file-name "Load a subset of perspectives from a file: " - persp-save-dir))) - (unless names - (let* ((p-save-file (concat (or (file-name-directory fname) - (expand-file-name persp-save-dir)) - (file-name-nondirectory fname))) - (available-names (persp-list-persp-names-in-file p-save-file))) - (setq names - (persp-read-persp - "to load" 'reverse nil t nil nil available-names nil 'push)))) - (when names - (let ((names-regexp (regexp-opt names))) - (persp-load-state-from-file fname phash names-regexp t)))) - - -(provide 'persp-mode) - - -;; Local Variables: -;; indent-tabs-mode: nil -;; End: - -;;; persp-mode.el ends here diff --git a/org/elpa/persp-mode-projectile-bridge-20170315.1120/persp-mode-projectile-bridge-autoloads.el b/org/elpa/persp-mode-projectile-bridge-20170315.1120/persp-mode-projectile-bridge-autoloads.el deleted file mode 100644 index c447e34..0000000 --- a/org/elpa/persp-mode-projectile-bridge-20170315.1120/persp-mode-projectile-bridge-autoloads.el +++ /dev/null @@ -1,54 +0,0 @@ -;;; persp-mode-projectile-bridge-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "persp-mode-projectile-bridge" "persp-mode-projectile-bridge.el" -;;;;;; (0 0 0 0)) -;;; Generated autoloads from persp-mode-projectile-bridge.el - -(defvar persp-mode-projectile-bridge-mode nil "\ -Non-nil if Persp-Mode-Projectile-Bridge mode is enabled. -See the `persp-mode-projectile-bridge-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 `persp-mode-projectile-bridge-mode'.") - -(custom-autoload 'persp-mode-projectile-bridge-mode "persp-mode-projectile-bridge" nil) - -(autoload 'persp-mode-projectile-bridge-mode "persp-mode-projectile-bridge" "\ -`persp-mode' and `projectile-mode' integration. -Creates perspectives for projectile projects. - -This is a minor mode. If called interactively, toggle the -`Persp-Mode-Projectile-Bridge mode' mode. If the prefix argument -is positive, enable the mode, and if it is zero or negative, -disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable -the mode if ARG is nil, omitted, or is a positive number. -Disable the mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='persp-mode-projectile-bridge-mode)'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -\(fn &optional ARG)" t nil) - -(register-definition-prefixes "persp-mode-projectile-bridge" '("persp-mode-projectile-bridge-")) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; persp-mode-projectile-bridge-autoloads.el ends here diff --git a/org/elpa/persp-mode-projectile-bridge-20170315.1120/persp-mode-projectile-bridge-pkg.el b/org/elpa/persp-mode-projectile-bridge-20170315.1120/persp-mode-projectile-bridge-pkg.el deleted file mode 100644 index 1bd5756..0000000 --- a/org/elpa/persp-mode-projectile-bridge-20170315.1120/persp-mode-projectile-bridge-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from persp-mode-projectile-bridge.el -*- no-byte-compile: t -*- -(define-package "persp-mode-projectile-bridge" "20170315.1120" "persp-mode + projectile integration." '((persp-mode "2.9") (projectile "0.13.0") (cl-lib "0.5")) :commit "f6453cd7b8b4352c06e771706f2c5b7e2cdff1ce" :authors '(("Constantin Kulikov (Bad_ptr)" . "zxnotdead@gmail.com")) :maintainer '("Constantin Kulikov (Bad_ptr)" . "zxnotdead@gmail.com") :keywords '("persp-mode" "projectile") :url "https://github.com/Bad-ptr/persp-mode-projectile-bridge.el") diff --git a/org/elpa/persp-mode-projectile-bridge-20170315.1120/persp-mode-projectile-bridge.el b/org/elpa/persp-mode-projectile-bridge-20170315.1120/persp-mode-projectile-bridge.el deleted file mode 100644 index 2861ddb..0000000 --- a/org/elpa/persp-mode-projectile-bridge-20170315.1120/persp-mode-projectile-bridge.el +++ /dev/null @@ -1,211 +0,0 @@ -;;; persp-mode-projectile-bridge.el --- persp-mode + projectile integration. -*- lexical-binding: t -*- - -;; Copyright (C) 2017 Constantin Kulikov -;; -;; Author: Constantin Kulikov (Bad_ptr) -;; Version: 0.1 -;; Package-Version: 20170315.1120 -;; Package-Commit: f6453cd7b8b4352c06e771706f2c5b7e2cdff1ce -;; Package-Requires: ((persp-mode "2.9") (projectile "0.13.0") (cl-lib "0.5")) -;; Date: 2017/03/04 10:10:41 -;; License: GPL either version 3 or any later version -;; Keywords: persp-mode, projectile -;; URL: https://github.com/Bad-ptr/persp-mode-projectile-bridge.el - -;;; License: - -;; 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 this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: - -;; Creates a perspective for each projectile project. - -;;; Usage: - -;; Installation: - -;; M-x package-install-file RET persp-mode-projectile-bridge.el RET - -;; Example configuration: - -;; (with-eval-after-load "persp-mode-projectile-bridge-autoloads" -;; (add-hook 'persp-mode-projectile-bridge-mode-hook -;; #'(lambda () -;; (if persp-mode-projectile-bridge-mode -;; (persp-mode-projectile-bridge-find-perspectives-for-all-buffers) -;; (persp-mode-projectile-bridge-kill-perspectives)))) -;; (add-hook 'after-init-hook -;; #'(lambda () -;; (persp-mode-projectile-bridge-mode 1)) -;; t)) - - -;;; Code: - - -(require 'persp-mode) -(require 'projectile) -(require 'cl-lib) - - -(defvar persp-mode-projectile-bridge-mode nil) - -(defgroup persp-mode-projectile-bridge nil - "persp-mode projectile integration." - :group 'persp-mode - :group 'projectile - :prefix "persp-mode-projectile-bridge-" - :link - '(url-link - :tag "Github" "https://github.com/Bad-ptr/persp-mode-projectile-bridge.el")) - -(defcustom persp-mode-projectile-bridge-persp-name-prefix "[p] " - "Prefix to use for projectile perspective names." - :group 'persp-mode-projectile-bridge - :type 'string - :set #'(lambda (sym val) - (if persp-mode-projectile-bridge-mode - (let ((old-prefix (symbol-value sym))) - (custom-set-default sym val) - (let (old-name) - (mapc #'(lambda (p) - (when (and - p (persp-parameter - 'persp-mode-projectile-bridge p)) - (setq old-name - (substring (persp-name p) - (string-width old-prefix))) - (persp-rename (concat val old-name) p))) - (persp-persps)))) - (custom-set-default sym val)))) - - -(defun persp-mode-projectile-bridge-add-new-persp (name) - (let ((persp (persp-get-by-name name *persp-hash* :nil))) - (if (eq :nil persp) - (prog1 - (setq persp (persp-add-new name)) - (when persp - (set-persp-parameter 'persp-mode-projectile-bridge t persp) - (set-persp-parameter 'dont-save-to-file t persp) - (persp-add-buffer (projectile-project-buffers) - persp nil nil))) - persp))) - -(defun persp-mode-projectile-bridge-find-perspective-for-buffer (b) - (when (buffer-live-p b) - (with-current-buffer b - (when (and persp-mode-projectile-bridge-mode - (buffer-file-name b) (projectile-project-p)) - (let ((persp (persp-mode-projectile-bridge-add-new-persp - (concat persp-mode-projectile-bridge-persp-name-prefix - (projectile-project-name))))) - (when persp - (persp-add-buffer b persp nil nil) - persp)))))) - -(defvar persp-mode-projectile-bridge-before-switch-selected-window-buffer nil) -(defun persp-mode-projectile-bridge-hook-before-switch (&rest _args) - (let ((win (if (minibuffer-window-active-p (selected-window)) - (minibuffer-selected-window) - (selected-window)))) - (when (window-live-p win) - (setq persp-mode-projectile-bridge-before-switch-selected-window-buffer - (window-buffer win))))) - -(defun persp-mode-projectile-bridge-hook-switch (&rest _args) - (let ((persp - (persp-mode-projectile-bridge-find-perspective-for-buffer - (current-buffer)))) - (when persp - (when (buffer-live-p - persp-mode-projectile-bridge-before-switch-selected-window-buffer) - (let ((win (selected-window))) - (unless (eq (window-buffer win) - persp-mode-projectile-bridge-before-switch-selected-window-buffer) - (set-window-buffer - win persp-mode-projectile-bridge-before-switch-selected-window-buffer) - (setq persp-mode-projectile-bridge-before-switch-selected-window-buffer nil)))) - (persp-frame-switch (persp-name persp))))) - -(defun persp-mode-projectile-bridge-hook-find-file (&rest _args) - (let ((persp - (persp-mode-projectile-bridge-find-perspective-for-buffer - (current-buffer)))) - (when persp - (persp-add-buffer (current-buffer) persp nil nil)))) - -(defun persp-mode-projectile-bridge-find-perspectives-for-all-buffers () - (when (and persp-mode-projectile-bridge-mode) - (mapc #'persp-mode-projectile-bridge-find-perspective-for-buffer - (buffer-list)))) - -(defun persp-mode-projectile-bridge-kill-perspectives () - (when (and persp-mode projectile-mode) - (mapc #'persp-kill - (mapcar #'persp-name - (cl-delete-if-not - (apply-partially - #'persp-parameter - 'persp-mode-projectile-bridge) - (persp-persps)))))) - - -;;;###autoload -(define-minor-mode persp-mode-projectile-bridge-mode - "`persp-mode' and `projectile-mode' integration. -Creates perspectives for projectile projects." - :require 'persp-mode-projectile-bridge - :group 'persp-mode-projectile-bridge - :init-value nil - :global t - - (if persp-mode-projectile-bridge-mode - (if (and persp-mode projectile-mode) - (progn - (add-hook 'find-file-hook - #'persp-mode-projectile-bridge-hook-find-file) - (add-hook 'projectile-mode-hook - #'(lambda () - (unless projectile-mode - (persp-mode-projectile-bridge-mode -1)))) - (add-hook 'persp-mode-hook - #'(lambda () - (unless persp-mode - (persp-mode-projectile-bridge-mode -1)))) - (add-hook 'projectile-before-switch-project-hook - #'persp-mode-projectile-bridge-hook-before-switch) - (add-hook 'projectile-after-switch-project-hook - #'persp-mode-projectile-bridge-hook-switch) - (add-hook 'projectile-find-file-hook - #'persp-mode-projectile-bridge-hook-switch)) - (message "You can not enable persp-mode-projectile-bridge-mode \ -unless persp-mode and projectile-mode are active.") - (setq persp-mode-projectile-bridge-mode nil)) - (remove-hook 'find-file-hook - #'persp-mode-projectile-bridge-hook-find-file) - (remove-hook 'projectile-before-switch-project-hook - #'persp-mode-projectile-bridge-hook-before-switch) - (remove-hook 'projectile-after-switch-project-hook - #'persp-mode-projectile-bridge-hook-switch) - (remove-hook 'projectile-find-file-hook - #'persp-mode-projectile-bridge-hook-switch))) - - -(provide 'persp-mode-projectile-bridge) - -;;; persp-mode-projectile-bridge.el ends here diff --git a/org/elpa/projectile-20221105.1641/projectile-autoloads.el b/org/elpa/projectile-20221105.1641/projectile-autoloads.el deleted file mode 100644 index dfa6c0b..0000000 --- a/org/elpa/projectile-20221105.1641/projectile-autoloads.el +++ /dev/null @@ -1,640 +0,0 @@ -;;; projectile-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; 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." t nil) - -(autoload 'projectile-discover-projects-in-directory "projectile" "\ -Discover any projects in DIRECTORY and add them to the projectile cache. - -If DEPTH is non-nil recursively descend exactly DEPTH levels below DIRECTORY and -discover projects there. - -\(fn DIRECTORY &optional DEPTH)" t nil) - -(autoload 'projectile-discover-projects-in-search-path "projectile" "\ -Discover projects in `projectile-project-search-path'. -Invoked automatically when `projectile-mode' is enabled." t nil) - -(autoload 'projectile-switch-to-buffer "projectile" "\ -Switch to a project buffer." t nil) - -(autoload 'projectile-switch-to-buffer-other-window "projectile" "\ -Switch to a project buffer and show it in another window." t nil) - -(autoload 'projectile-switch-to-buffer-other-frame "projectile" "\ -Switch to a project buffer and show it in another frame." t nil) - -(autoload 'projectile-display-buffer "projectile" "\ -Display a project buffer in another window without selecting it." 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." 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 different extensions in other window. -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 different extensions in other frame. -Switch between files with the same name but different extensions in other frame. -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." t nil) - -(autoload 'projectile-add-dir-local-variable "projectile" "\ -Run `add-dir-local-variable' with .dir-locals.el in root of project. - -Parameters MODE VARIABLE VALUE are passed directly to `add-dir-local-variable'. - -\(fn MODE VARIABLE VALUE)" nil nil) - -(autoload 'projectile-delete-dir-local-variable "projectile" "\ -Run `delete-dir-local-variable' with .dir-locals.el in root of project. - -Parameters MODE VARIABLE VALUE are passed directly to -`delete-dir-local-variable'. - -\(fn MODE VARIABLE)" nil 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 frame 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." t nil) - -(autoload 'projectile-find-related-file-other-frame "projectile" "\ -Open related file in other frame." t nil) - -(autoload 'projectile-find-related-file "projectile" "\ -Open related file." 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. -Use 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. -Use files with EXTENSION based on TEST-SUFFIX. - -\(fn EXTENSION TEST-SUFFIX)" nil nil) - -(autoload 'projectile-project-info "projectile" "\ -Display info for current project." t nil) - -(autoload 'projectile-find-implementation-or-test-other-window "projectile" "\ -Open matching implementation or test file in other window. - -See the documentation of `projectile--find-matching-file' and -`projectile--find-matching-test' for how implementation and test files -are determined." t nil) - -(autoload 'projectile-find-implementation-or-test-other-frame "projectile" "\ -Open matching implementation or test file in other frame. - -See the documentation of `projectile--find-matching-file' and -`projectile--find-matching-test' for how implementation and test files -are determined." t nil) - -(autoload 'projectile-toggle-between-implementation-and-test "projectile" "\ -Toggle between an implementation file and its test file. - - -See the documentation of `projectile--find-matching-file' and -`projectile--find-matching-test' for how implementation and test files -are determined." 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 (rg) search with `SEARCH-TERM' at current project root. - -With an optional prefix argument ARG SEARCH-TERM is interpreted as a -regular expression. - -This command depends on of the Emacs packages ripgrep or rg being -installed to work. - -\(fn SEARCH-TERM &optional ARG)" t nil) - -(autoload 'projectile-regenerate-tags "projectile" "\ -Regenerate the project's [e|g]tags." t nil) - -(autoload 'projectile-find-tag "projectile" "\ -Find tag in project." t nil) - -(autoload 'projectile-run-command-in-root "projectile" "\ -Invoke `execute-extended-command' in the project's root." t nil) - -(autoload 'projectile-run-shell-command-in-root "projectile" "\ -Invoke `shell-command' in the project's root. - -\(fn COMMAND &optional OUTPUT-BUFFER ERROR-BUFFER)" t nil) - -(autoload 'projectile-run-async-shell-command-in-root "projectile" "\ -Invoke `async-shell-command' in the project's root. - -\(fn COMMAND &optional OUTPUT-BUFFER ERROR-BUFFER)" t nil) - -(autoload 'projectile-run-gdb "projectile" "\ -Invoke `gdb' in the project's root." 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 &optional 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 &optional 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 &optional 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 &optional 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 and file name patterns -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'." t nil) - -(autoload 'projectile-save-project-buffers "projectile" "\ -Save all project buffers." t nil) - -(autoload 'projectile-dired "projectile" "\ -Open `dired' at the root of the project." t nil) - -(autoload 'projectile-dired-other-window "projectile" "\ -Open `dired' at the root of the project in another window." t nil) - -(autoload 'projectile-dired-other-frame "projectile" "\ -Open `dired' at the root of the project in another frame." 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." 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-install-project "projectile" "\ -Run project install 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-package-project "projectile" "\ -Run project package 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', -`projectile-install-project', `projectile-package-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." t nil) - -(autoload 'projectile-cleanup-known-projects "projectile" "\ -Remove known projects that don't exist anymore." t nil) - -(autoload 'projectile-clear-known-projects "projectile" "\ -Clear both `projectile-known-projects' and `projectile-known-projects-file'." t nil) - -(autoload 'projectile-reset-known-projects "projectile" "\ -Clear known projects and rediscover." 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." 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." 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." 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") - -(register-definition-prefixes "projectile" '("??" "compilation-find-file-projectile-find-compilation-buffer" "def-projectile-commander-method" "delete-file-projectile-remove-from-cache" "project")) - -;;;*** - -;; 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/org/elpa/projectile-20221105.1641/projectile-pkg.el b/org/elpa/projectile-20221105.1641/projectile-pkg.el deleted file mode 100644 index 3891ecd..0000000 --- a/org/elpa/projectile-20221105.1641/projectile-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from projectile.el -*- no-byte-compile: t -*- -(define-package "projectile" "20221105.1641" "Manage and navigate projects in Emacs easily" '((emacs "25.1")) :commit "3de6bdc2ae6c5ce08bce3726cec936e4da5d9bad" :authors '(("Bozhidar Batsov" . "bozhidar@batsov.dev")) :maintainer '("Bozhidar Batsov" . "bozhidar@batsov.dev") :keywords '("project" "convenience") :url "https://github.com/bbatsov/projectile") diff --git a/org/elpa/projectile-20221105.1641/projectile.el b/org/elpa/projectile-20221105.1641/projectile.el deleted file mode 100644 index 4bb9cd8..0000000 --- a/org/elpa/projectile-20221105.1641/projectile.el +++ /dev/null @@ -1,6090 +0,0 @@ -;;; projectile.el --- Manage and navigate projects in Emacs easily -*- lexical-binding: t -*- - -;; Copyright © 2011-2022 Bozhidar Batsov - -;; Author: Bozhidar Batsov -;; URL: https://github.com/bbatsov/projectile -;; Package-Version: 20221105.1641 -;; Package-Commit: 3de6bdc2ae6c5ce08bce3726cec936e4da5d9bad -;; Keywords: project, convenience -;; Version: 2.7.0-snapshot -;; Package-Requires: ((emacs "25.1")) - -;; 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) -(require 'lisp-mnt) -(eval-when-compile - (require 'find-dired) - (require 'subr-x)) - -;;; Declarations -;; -;; A bunch of variable and function declarations -;; needed to appease the byte-compiler. -(defvar ido-mode) -(defvar ivy-mode) -(defvar helm-mode) -(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) -(defvar grep-files-aliases) -(defvar grep-find-ignored-directories) -(defvar grep-find-ignored-files) - -(declare-function tags-completion-table "etags") -(declare-function make-term "term") -(declare-function term-mode "term") -(declare-function term-char-mode "term") -(declare-function term-ansi-make-term "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 tramp-archive-file-name-p "tramp-archive") -(declare-function helm-grep-get-file-extensions "helm-grep") - -(declare-function ggtags-ensure-project "ext:ggtags") -(declare-function ggtags-update-tags "ext:ggtags") -(declare-function ripgrep-regexp "ext:ripgrep") -(declare-function rg-run "ext:rg") -(declare-function vterm "ext:vterm") -(declare-function vterm-send-return "ext:vterm") -(declare-function vterm-send-string "ext:vterm") - -;;; 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-discover t - "Whether to discover projects when `projectile-mode' is activated." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.3.0")) - -(defcustom projectile-auto-update-cache t - "Whether cache is automatically 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 'auto - "The completion system to be used by Projectile." - :group 'projectile - :type '(radio - (const :tag "Auto-detect" auto) - (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 - '( - "GTAGS" ; GNU Global tags - "TAGS" ; etags/ctags are usually in the root of project - "configure.ac" ; autoconf new style - "configure.in" ; autoconf old style - "cscope.out" ; cscope - ) - "A list of files considered to mark the root of a project. -The topmost match has precedence. -See `projectile-register-project-type'." - :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 - ".pijul" ; Pijul 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)) - -(define-obsolete-variable-alias 'projectile-project-root-files-functions 'projectile-project-root-functions "2.4") - -(defcustom projectile-project-root-functions - '(projectile-root-local - projectile-root-bottom-up - projectile-root-top-down - projectile-root-top-down-recurring) - "A list of functions for finding project root folders. -The functions will be ran until one of them returns a project folder. -Reordering the default functions will alter the project discovery -algorithm." - :group 'projectile - :type '(repeat function)) - -(defcustom projectile-dirconfig-comment-prefix - nil - "Projectile config file (.projectile) comment start marker. -If specified, starting a line in a project's .projectile file with this -character marks that line as a comment instead of a pattern. -Similar to '#' in .gitignore files." - :group 'projectile - :type 'character - :package-version '(projectile . "2.2.0")) - -(defcustom projectile-globally-ignored-files - (list projectile-tags-file-name) - "A list of files globally ignored by projectile. -Note that files aren't filtered if `projectile-indexing-method' -is set to `alien'." - :group 'projectile - :type '(repeat string)) - -(defcustom projectile-globally-unignored-files nil - "A list of files globally unignored by projectile. -Regular expressions can be used. -Note that files aren't filtered if `projectile-indexing-method' -is set to `alien'." - :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. -Note that files aren't filtered if `projectile-indexing-method' -is set to `alien'." - :group 'projectile - :type '(repeat string)) - -(defcustom projectile-globally-ignored-directories - '("^\\.idea$" - "^\\.vscode$" - "^\\.ensime_cache$" - "^\\.eunit$" - "^\\.git$" - "^\\.hg$" - "^\\.fslckout$" - "^_FOSSIL_$" - "^\\.bzr$" - "^_darcs$" - "^\\.pijul$" - "^\\.tox$" - "^\\.svn$" - "^\\.stack-work$" - "^\\.ccls-cache$" - "^\\.cache$" - "^\\.clangd$") - "A list of directories globally ignored by projectile. -Regular expressions can be used. - -Strings that don't start with * are only ignored at the top level -of the project. Strings that start with * are ignored everywhere -in the project, as if there was no *. So note that * when used as -a prefix is not a wildcard; it is an indicator that the directory -should be ignored at all levels, not just root. - -Examples: \"tmp\" ignores only ./tmp at the top level of the -project, but not ./src/tmp. \"*tmp\" will ignore both ./tmp and -./src/tmp, but not ./not-a-tmp or ./src/not-a-tmp. - -Note that files aren't filtered if `projectile-indexing-method' -is set to `alien'." - :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. -Note that files aren't filtered if `projectile-indexing-method' -is set to `alien'." - :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 - '("*scratch*" - "*lsp-log*") - "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")) - -(defcustom projectile-default-src-directory "src/" - "The default value of a project's src-dir property. - -It's used as a fallback in the case the property is not set for a project -type when `projectile-toggle-between-implementation-and-test' is used." - :group 'projectile - :type 'string) - -(defcustom projectile-default-test-directory "test/" - "The default value of a project's test-dir property. - -It's used as a fallback in the case the property is not set for a project -type when `projectile-toggle-between-implementation-and-test' is used." - :group 'projectile - :type 'string) - - -;;; 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 -the variable `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, (~/github . 1) etc. - -For elements of form (DIRECTORY . DEPTH), DIRECTORY has to be a -directory and DEPTH an integer that specifies the depth at which to -look for projects. A DEPTH of 0 means check DIRECTORY. A depth of 1 -means check all the subdirectories of DIRECTORY. Etc." - :group 'projectile - :type '(repeat (choice directory (cons directory (integer :tag "Depth")))) - :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 $displaypath' | 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-pijul-command "pijul list | tr '\\n' '\\0'" - "Command used by projectile to get the files in a pijul 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 - (cond - ;; we prefer fd over find - ;; note that --strip-cwd-prefix is only available in version 8.3.0+ - ((executable-find "fd") - "fd . -0 --type f --color=never --strip-cwd-prefix") - ;; fd's executable is named fdfind is some Linux distros (e.g. Ubuntu) - ((executable-find "fdfind") - "fdfind . -0 --type f --color=never --strip-cwd-prefix") - ;; with find we have to be careful to strip the ./ from the paths - ;; see https://stackoverflow.com/questions/2596462/how-to-strip-leading-in-unix-find - (t "find . -type f | cut -c3- | tr '\\n' '\\0'")) - "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")) - - ;; OCaml extensions - ("ml" . ("mli")) - ("mli" . ("ml" "mll" "mly")) - ("mll" . ("mli")) - ("mly" . ("mli")) - ("eliomi" . ("eliom")) - ("eliom" . ("eliomi")) - - ;; 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-per-project-compilation-buffer nil - "When non-nil, the compilation command makes the per-project compilation buffer." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.6.0")) - -(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))) - -(defcustom projectile-max-file-buffer-count nil - "Maximum number of file buffers per project that are kept open. - -If the value is nil, there is no limit to the opend buffers count." - :group 'projectile - :type 'integer - :package-version '(projectile . "2.2.0")) - -(defvar projectile-project-test-suffix nil - "Use this variable to override the current project's test-suffix property. -It takes precedence over the test-suffix for the project type when set. -Should be set via .dir-locals.el.") - -(defvar projectile-project-test-prefix nil - "Use this variable to override the current project's test-prefix property. -It takes precedence over the test-prefix for the project type when set. -Should be set via .dir-locals.el.") - -(defvar projectile-project-related-files-fn nil - "Use this variable to override the current project's related-files-fn property. -It takes precedence over the related-files-fn attribute for the project type -when set. Should be set via .dir-locals.el.") - -(defvar projectile-project-src-dir nil - "Use this variable to override the current project's src-dir property. -It takes precedence over the src-dir for the project type when set. -Should be set via .dir-locals.el.") - -(defvar projectile-project-test-dir nil - "Use this variable to override the current project's test-dir property. -It takes precedence over the test-dir for the project type when set. -Should be set via .dir-locals.el.") - - -;;; Version information - -(defconst projectile-version "2.7.0-snapshot" - "The current version of Projectile.") - -(defun projectile--pkg-version () - "Extract Projectile's package version from its package metadata." - ;; Use `cond' below to avoid a compiler unused return value warning - ;; when `package-get-version' returns nil. See #3181. - ;; FIXME: Inline the logic from package-get-version and adapt it - (cond ((fboundp 'package-get-version) - (package-get-version)))) - -;;;###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)) - (let ((version (or (projectile--pkg-version) projectile-version))) - (if show-version - (message "Projectile %s" version) - version))) - -;;; 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 &optional project) - "Infer the buffer name for PROCESS or generate a new one if MAKE-NEW is true. -The function operates on the current project by default, but you can also -specify a project explicitly via the optional PROJECT param." - (let* ((project (or project (projectile-acquire-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'." - (if (file-writable-p filename) - (with-temp-file filename - (insert (let (print-length) (prin1-to-string data)))) - (message "Projectile cache '%s' not writeable" filename))) - -(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-acquire-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." - (if (fboundp 'time-convert) - (time-convert nil 'integer) - (cl-destructuring-bind (high low _usec _psec) (current-time) - (+ (ash 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 &optional depth) - "Discover any projects in DIRECTORY and add them to the projectile cache. - -If DEPTH is non-nil recursively descend exactly DEPTH levels below DIRECTORY and -discover projects there." - (interactive - (list (read-directory-name "Starting directory: "))) - - (if (file-directory-p directory) - (if (and (numberp depth) (> depth 0)) - ;; Ignore errors when listing files in the directory, because - ;; sometimes that directory is an unreadable one at the root of a - ;; volume. This is the case, for example, on macOS with the - ;; .Spotlight-V100 directory. - (let ((progress-reporter - (make-progress-reporter - (format "Projectile is discovering projects in %s..." - (propertize directory 'face 'font-lock-keyword-face))))) - (progress-reporter-update progress-reporter) - (dolist (dir (ignore-errors (directory-files directory t))) - (when (and (file-directory-p dir) - (not (member (file-name-nondirectory dir) '(".." ".")))) - (projectile-discover-projects-in-directory dir (1- depth)))) - (progress-reporter-done progress-reporter)) - (when (projectile-project-p directory) - (let ((dir (abbreviate-file-name (projectile-project-root directory)))) - (unless (member dir projectile-known-projects) - (projectile-add-known-project dir))))) - (message "Project search path directory %s doesn't exist" directory))) - -;;;###autoload -(defun projectile-discover-projects-in-search-path () - "Discover projects in `projectile-project-search-path'. -Invoked automatically when `projectile-mode' is enabled." - (interactive) - (dolist (path projectile-project-search-path) - (if (consp path) - (projectile-discover-projects-in-directory (car path) (cdr path)) - (projectile-discover-projects-in-directory path 1)))) - - -(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 the variable `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." - (projectile-locate-dominating-file - dir - (lambda (directory) - (let ((files (mapcar (lambda (file) (expand-file-name file directory)) - (or list projectile-project-root-files-bottom-up)))) - (cl-some (lambda (file) (and file (file-exists-p file))) files))))) - -(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." - (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)))) - ;; 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 - (cl-subst nil 'none - (or - ;; if we've already failed to find a project dir for this - ;; dir, and cached that failure, don't recompute - (let* ((cache-key (format "projectilerootless-%s" dir)) - (cache-value (gethash cache-key projectile-project-root-cache))) - cache-value) - ;; if the file isn't local, and we're not connected, don't try to - ;; find a root now now, but don't cache failure, as we might - ;; re-connect. 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. - (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 - (unless (or is-local is-connected) - 'none)) - ;; if the file is local or we're connected to it via TRAMP, run - ;; through the project root functions until we find a project dir - (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-functions) - ;; if we get here, we have failed to find a root by all - ;; conventional means, and we assume the failure isn't transient - ;; / network related, so cache the failure - (let ((cache-key (format "projectilerootless-%s" dir))) - (puthash cache-key 'none projectile-project-root-cache) - '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'. - -See also `projectile-acquire-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 cannot find a project definition in %s" default-directory)) - (t default-directory)))) - -(defun projectile-acquire-root (&optional dir) - "Find the current project root, and prompts the user for it if that fails. -Provides the common idiom (projectile-ensure-project (projectile-project-root)). -Starts the search for the project with DIR." - (projectile-ensure-project (projectile-project-root dir))) - -(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 to create the project name. -The project name is 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 &optional ignored-files ignored-directories globally-ignored-directories) - "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. The list of IGNORED-FILES and -IGNORED-DIRECTORIES may optionally be provided." - ;; we compute the ignored files and directories only once and then we reuse the - ;; pre-computed values in the subsequent recursive invocations of the function - (let ((ignored-files (or ignored-files (projectile-ignored-files))) - (ignored-directories (or ignored-directories (projectile-ignored-directories))) - (globally-ignored-directories (or globally-ignored-directories (projectile-globally-ignored-directory-names)))) - (apply #'append - (mapcar - (lambda (f) - (let ((local-f (file-name-nondirectory (directory-file-name f)))) - (unless (or (and patterns (projectile-ignored-rel-p f directory patterns)) - (member local-f '("." ".."))) - (progress-reporter-update progress-reporter) - (if (file-directory-p f) - (unless (projectile-ignored-directory-p - (file-name-as-directory f) - ignored-directories - local-f - globally-ignored-directories) - (projectile-index-directory f patterns progress-reporter ignored-files ignored-directories globally-ignored-directories)) - (unless (projectile-ignored-file-p f ignored-files) - (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) - ('pijul projectile-pijul-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. - -Only text sent to standard output is taken into account." - (when (stringp command) - (let ((default-directory root)) - (with-temp-buffer - (shell-command command t "*projectile-files-errors*") - (let ((shell-output (buffer-substring (point-min) (point-max)))) - (split-string (string-trim shell-output) "\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-acquire-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-process-current-project-buffers-current (action) - "Invoke ACTION on every project buffer with that buffer current. -ACTION is called without arguments." - (let ((project-buffers (projectile-project-buffers))) - (dolist (buffer project-buffers) - (with-current-buffer buffer - (funcall action))))) - -(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 - (let ((directory (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory))) - (and (not (string-prefix-p " " (buffer-name buffer))) - (not (projectile-ignored-buffer-p buffer)) - directory - (string-equal (file-remote-p directory) - (file-remote-p project-root)) - (not (string-match-p "^http\\(s\\)?://" directory)) - (string-prefix-p project-root (file-truename 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 frame." - (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-acquire-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 &optional ignored-directories local-directory globally-ignored-directories) - "Check if DIRECTORY should be ignored. - -Regular expressions can be used. Pre-computed lists of -IGNORED-DIRECTORIES and GLOBALLY-IGNORED-DIRECTORIES -and the LOCAL-DIRECTORY name may optionally be provided." - (let ((ignored-directories (or ignored-directories (projectile-ignored-directories))) - (globally-ignored-directories (or globally-ignored-directories (projectile-globally-ignored-directory-names))) - (local-directory (or local-directory (file-name-nondirectory (directory-file-name directory))))) - (or (cl-some - (lambda (name) - (string-match-p name directory)) - ignored-directories) - (cl-some - (lambda (name) - (string-match-p name local-directory)) - globally-ignored-directories)))) - -(defun projectile-ignored-file-p (file &optional ignored-files) - "Check if FILE should be ignored. - -Regular expressions can be used. A pre-computed list of -IGNORED-FILES may optionally be provided." - (cl-some - (lambda (name) - (string-match-p name file)) - (or ignored-files (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. -PATTERNS should have the form: (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-globally-ignored-directory-names () - "Return list of ignored directory names." - (projectile-difference - projectile-globally-ignored-directories - projectile-globally-unignored-directories)) - -(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) - ;; ignore comment lines if prefix char has been set - ((pred (lambda (leading-char) - (and projectile-dirconfig-comment-prefix - (eql leading-char - projectile-dirconfig-comment-prefix)))) - nil) - (?+ (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 &optional dir) - "Expand NAME to project root. -When DIR is specified it uses DIR's project, otherwise it acts -on the current project. - -Never use on many files since it's going to recalculate the -project-root for every file." - (expand-file-name name (projectile-project-root dir))) - -(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 - (pcase (if (eq projectile-completion-system 'auto) - (cond - ((bound-and-true-p ido-mode) 'ido) - ((bound-and-true-p helm-mode) 'helm) - ((bound-and-true-p ivy-mode) 'ivy) - (t 'default)) - projectile-completion-system) - ('default (completing-read prompt choices nil nil initial-input)) - ('ido (ido-completing-read prompt choices nil nil initial-input)) - ('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"))) - ('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"))) - (_ (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-acquire-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-acquire-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 different extensions in other window. -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 different extensions in other frame. -Switch between files with the same name but different extensions in other frame. -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-acquire-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-acquire-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-acquire-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"))))) - -;;;###autoload -(defun projectile-add-dir-local-variable (mode variable value) - "Run `add-dir-local-variable' with .dir-locals.el in root of project. - -Parameters MODE VARIABLE VALUE are passed directly to `add-dir-local-variable'." - (let ((inhibit-read-only t) - (default-directory (projectile-acquire-root))) - (add-dir-local-variable mode variable value) - (save-buffer) - (kill-buffer))) - -;;;###autoload -(defun projectile-delete-dir-local-variable (mode variable) - "Run `delete-dir-local-variable' with .dir-locals.el in root of project. - -Parameters MODE VARIABLE VALUE are passed directly to -`delete-dir-local-variable'." - (let ((inhibit-read-only t) - (default-directory (projectile-acquire-root))) - (delete-dir-local-variable mode variable) - (save-buffer) - (kill-buffer))) - - -;;;; 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-acquire-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 frame 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. -PROJECT-ROOT is the 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. -Use 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. -Use 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.") - -(defun projectile--combine-plists (&rest plists) - "Create a single property list from all plists in PLISTS. -The process starts by copying the first list, and then setting properties -from the other lists. Settings in the last list are the most significant -ones and overrule settings in the other lists." - (let ((rtn (copy-sequence (pop plists))) - p v ls) - (while plists - (setq ls (pop plists)) - (while ls - (setq p (pop ls) v (pop ls)) - (setq rtn (plist-put rtn p v)))) - rtn)) - -(cl-defun projectile--build-project-plist - (marker-files &key project-file compilation-dir configure compile install package test run test-suffix test-prefix src-dir test-dir related-files-fn) - "Return a project type plist with the provided arguments. - -A project type is defined by PROJECT-TYPE, a set of MARKER-FILES, -and optional keyword arguments: -PROJECT-FILE the main project file in the root project directory. -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, -INSTALL which specifies a command to install the project. -PACKAGE which specifies a command to package 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 - 'project-file project-file - 'compilation-dir compilation-dir - 'configure-command configure - 'compile-command compile - 'test-command test - 'install-command install - 'package-command package - 'run-command run))) - (when (and project-file (not (member project-file projectile-project-root-files))) - (add-to-list 'projectile-project-root-files project-file)) - (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)) - project-plist)) - -(cl-defun projectile-register-project-type - (project-type marker-files &key project-file compilation-dir configure compile install package 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: -PROJECT-FILE the main project file in the root project directory. -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, -INSTALL which specifies a command to install the project. -PACKAGE which specifies a command to package 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." - (setq projectile-project-types - (cons `(,project-type . - ,(projectile--build-project-plist - marker-files - :project-file project-file - :compilation-dir compilation-dir - :configure configure - :compile compile - :install install - :package package - :test test - :run run - :test-suffix test-suffix - :test-prefix test-prefix - :src-dir src-dir - :test-dir test-dir - :related-files-fn related-files-fn)) - projectile-project-types))) - -(cl-defun projectile-update-project-type - (project-type - &key precedence - (marker-files nil marker-files-specified) - (project-file nil project-file-specified) - (compilation-dir nil compilation-dir-specified) - (configure nil configure-specified) - (compile nil compile-specified) - (install nil install-specified) - (package nil package-specified) - (test nil test-specified) - (run nil run-specified) - (test-suffix nil test-suffix-specified) - (test-prefix nil test-prefix-specified) - (src-dir nil src-dir-specified) - (test-dir nil test-dir-specified) - (related-files-fn nil related-files-fn-specified)) - "Update an existing projectile project type. - -Passed items will override existing values for the project type given -by PROJECT-TYPE. nil can be used to remove a project type attribute. Raise -an error if PROJECT-TYPE is not already registered with projectile. This -function may also take the keyword argument PRECEDENCE which when set to ‘high’ -will make projectile prioritise this project type over other clashing project -types, and a value of ‘low’ will make projectile prefer (all) other project -types by default. Otherwise, the arguments to this function are as for -`projectile-register-project-type': - -A project type is defined by PROJECT-TYPE, a set of MARKER-FILES, -and optional keyword arguments: -MARKER-FILES a set of indicator files for PROJECT-TYPE. -PROJECT-FILE the main project file in the root project directory. -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, -INSTALL which specifies a command to install the project. -PACKAGE which specifies a command to package 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* ((existing-project-plist - (or (cl-find-if - (lambda (p) (eq project-type (car p))) projectile-project-types) - (error "No existing project found for: %s" project-type))) - (new-plist - (append - (when marker-files-specified `(marker-files ,marker-files)) - (when project-file-specified `(project-file ,project-file)) - (when compilation-dir-specified `(compilation-dir ,compilation-dir)) - (when configure-specified `(configure-command ,configure)) - (when compile-specified `(compile-command ,compile)) - (when test-specified `(test-command ,test)) - (when install-specified `(install-command ,install)) - (when package-specified `(package-command ,package)) - (when run-specified `(run-command ,run)) - (when test-suffix-specified `(test-suffix ,test-suffix)) - (when test-prefix-specified `(test-prefix ,test-prefix)) - (when src-dir-specified `(src-dir ,src-dir)) - (when test-dir-specified `(test-dir ,test-dir)) - (when related-files-fn-specified - `(related-files-fn ,related-files-fn)))) - (merged-plist - (projectile--combine-plists - (cdr existing-project-plist) new-plist)) - (project-type-elt (cons project-type merged-plist))) - (cl-flet* ((project-filter (p) (eq project-type (car p))) - (project-map (p) (if (project-filter p) project-type-elt p))) - (setq projectile-project-types - (if precedence - (let ((filtered-types - (cl-remove-if #'project-filter projectile-project-types))) - (setq projectile-project-type-cache (make-hash-table)) - (cond ((eq precedence 'high) - (cons project-type-elt filtered-types)) - ((eq precedence 'low) - (append filtered-types (list project-type-elt))) - (t (error "Precedence must be one of '(high low)")))) - (mapcar #'project-map projectile-project-types)))))) - -(defun projectile-eldev-project-p (&optional dir) - "Check if a project contains eldev files. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project." - (or (projectile-verify-file "Eldev" dir) - (projectile-verify-file "Eldev-local" dir))) - -(defun projectile-cabal-project-p (&optional dir) - "Check if a project contains *.cabal files but no stack.yaml file. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project." - (and (projectile-verify-file-wildcard "?*.cabal" dir) - (not (projectile-verify-file "stack.yaml" dir)))) - -(defun projectile-dotnet-project-p (&optional dir) - "Check if a project contains a .NET project marker. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project." - (or (projectile-verify-file-wildcard "?*.csproj" dir) - (projectile-verify-file-wildcard "?*.fsproj" dir))) - -(defun projectile-go-project-p (&optional dir) - "Check if a project contains Go source files. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project." - (or (projectile-verify-file "go.mod" dir) - (projectile-verify-file-wildcard "*.go" dir))) - -(defcustom projectile-go-project-test-function #'projectile-go-project-p - "Function to determine if project's type is go." - :group 'projectile - :type 'function - :package-version '(projectile . "1.0.0")) - -;;;; Constant signifying opting out of CMake preset commands. -(defconst projectile--cmake-no-preset "*no preset*") - -(defun projectile--cmake-version () - "Compute CMake version." - (let* ((string (shell-command-to-string "cmake --version")) - (match (string-match "^cmake version \\(.*\\)$" string))) - (when match - (version-to-list (match-string 1 string))))) - -(defun projectile--cmake-check-version (version) - "Check if CMake version is at least VERSION." - (and - (version-list-<= version (projectile--cmake-version)))) - -(defconst projectile--cmake-command-presets-minimum-version-alist - '((:configure-command . (3 19)) - (:compile-command . (3 20)) - (:test-command . (3 20)) - (:install-command . (3 20)))) - -(defun projectile--cmake-command-presets-supported (command-type) - "Check if CMake supports presets for COMMAND-TYPE." - (let ((minimum-version - (cdr (assoc command-type projectile--cmake-command-presets-minimum-version-alist)))) - (projectile--cmake-check-version minimum-version))) - -(defun projectile--cmake-read-preset (filename) - "Read CMake preset from FILENAME." - (when (file-exists-p filename) - (with-temp-buffer - (insert-file-contents filename) - (when (functionp 'json-parse-buffer) - (json-parse-buffer :array-type 'list))))) - -(defconst projectile--cmake-command-preset-array-id-alist - '((:configure-command . "configurePresets") - (:compile-command . "buildPresets") - (:test-command . "testPresets") - (:install-command . "buildPresets"))) - -(defun projectile--cmake-command-preset-array-id (command-type) - "Map from COMMAND-TYPE to id of command preset array in CMake preset." - (cdr (assoc command-type projectile--cmake-command-preset-array-id-alist))) - -(defun projectile--cmake-command-presets (filename command-type) - "Get CMake COMMAND-TYPE presets from FILENAME." - (when-let ((preset (projectile--cmake-read-preset (projectile-expand-root filename)))) - (cl-remove-if - (lambda (preset) (equal (gethash "hidden" preset) t)) - (gethash (projectile--cmake-command-preset-array-id command-type) preset)))) - -(defun projectile--cmake-all-command-presets (command-type) - "Get CMake user and system COMMAND-TYPE presets." - (projectile-flatten - (mapcar (lambda (filename) (projectile--cmake-command-presets filename command-type)) - '("CMakeUserPresets.json" "CMakePresets.json")))) - -(defun projectile--cmake-command-preset-names (command-type) - "Get names of CMake user and system COMMAND-TYPE presets." - (mapcar (lambda (preset) - (gethash "name" preset)) - (projectile--cmake-all-command-presets command-type))) - -(defcustom projectile-enable-cmake-presets nil - "Enables configuration with CMake presets. - -When `projectile-enable-cmake-presets' is non-nil, CMake projects can -be configured, built and tested using presets." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.4.0")) - -(defun projectile--cmake-use-command-presets (command-type) - "Test whether or not to use command presets for COMMAND-TYPE. - -Presets are used if `projectile-enable-cmake-presets' is non-nil, and CMake -supports presets for COMMAND-TYPE, and `json-parse-buffer' is available." - (and projectile-enable-cmake-presets - (projectile--cmake-command-presets-supported command-type) - (functionp 'json-parse-buffer))) - -(defun projectile--cmake-select-command (command-type) - "Select a CMake command preset or a manual CMake command. - -The selection is done like this: - -- If `projectile--cmake-use-commands-presets' for COMMAND-TYPE returns true, and -there is at least one preset available for COMMAND-TYPE, the user is prompted to -select a name of a command preset, or opt a manual command by selecting -`projectile--cmake-no-preset'. - -- Else `projectile--cmake-no-preset' is used." - (if-let ((use-presets (projectile--cmake-use-command-presets command-type)) - (preset-names (projectile--cmake-command-preset-names command-type))) - (projectile-completing-read - "Use preset: " - (append preset-names `(,projectile--cmake-no-preset))) - projectile--cmake-no-preset)) - -(defconst projectile--cmake-manual-command-alist - '((:configure-command . "cmake -S . -B build") - (:compile-command . "cmake --build build") - (:test-command . "cmake --build build --target test") - (:install-command . "cmake --build build --target install"))) - -(defun projectile--cmake-manual-command (command-type) - "Create maunual CMake COMMAND-TYPE command." - (cdr (assoc command-type projectile--cmake-manual-command-alist))) - -(defconst projectile--cmake-preset-command-alist - '((:configure-command . "cmake . --preset %s") - (:compile-command . "cmake --build --preset %s") - (:test-command . "ctest --preset %s") - (:install-command . "cmake --build --preset %s --target install"))) - -(defun projectile--cmake-preset-command (command-type preset) - "Create CMake COMMAND-TYPE command using PRESET." - (format (cdr (assoc command-type projectile--cmake-preset-command-alist)) preset)) - -(defun projectile--cmake-command (command-type) - "Create a CMake COMMAND-TYPE command. - -The command is created like this: - -- If `projectile--cmake-select-command' returns `projectile--cmake-no-preset' -a manual COMMAND-TYPE command is created with -`projectile--cmake-manual-command'. - -- Else a preset COMMAND-TYPE command using the selected preset is created with -`projectile--cmake-preset-command'." - (let ((maybe-preset (projectile--cmake-select-command command-type))) - (if (equal maybe-preset projectile--cmake-no-preset) - (projectile--cmake-manual-command command-type) - (projectile--cmake-preset-command command-type maybe-preset)))) - -(defun projectile--cmake-configure-command () - "CMake configure command." - (projectile--cmake-command :configure-command)) - -(defun projectile--cmake-compile-command () - "CMake compile command." - (projectile--cmake-command :compile-command)) - -(defun projectile--cmake-test-command () - "CMake test command." - (projectile--cmake-command :test-command)) - -(defun projectile--cmake-install-command () - "CMake install command." - (projectile--cmake-command :install-command)) - -;;; 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") -;; File-based detection project types - -;; Universal -(projectile-register-project-type 'scons '("SConstruct") - :project-file "SConstruct" - :compile "scons" - :test "scons test" - :test-suffix "test") -(projectile-register-project-type 'meson '("meson.build") - :project-file "meson.build" - :compilation-dir "build" - :configure "meson %s" - :compile "ninja" - :test "ninja test") -(projectile-register-project-type 'nix '("default.nix") - :project-file "default.nix" - :compile "nix-build" - :test "nix-build") -(projectile-register-project-type 'nix-flake '("flake.nix") - :project-file "flake.nix" - :compile "nix build" - :test "nix flake check" - :run "nix run") -(projectile-register-project-type 'bazel '("WORKSPACE") - :project-file "WORKSPACE" - :compile "bazel build" - :test "bazel test" - :run "bazel run") -(projectile-register-project-type 'debian '("debian/control") - :project-file "debian/control" - :compile "debuild -uc -us") - -;; Make & CMake -(projectile-register-project-type 'make '("Makefile") - :project-file "Makefile" - :compile "make" - :test "make test" - :install "make install") -(projectile-register-project-type 'gnumake '("GNUMakefile") - :project-file "GNUMakefile" - :compile "make" - :test "make test" - :install "make install") -(projectile-register-project-type 'cmake '("CMakeLists.txt") - :project-file "CMakeLists.txt" - :configure #'projectile--cmake-configure-command - :compile #'projectile--cmake-compile-command - :test #'projectile--cmake-test-command - :install #'projectile--cmake-install-command - :package "cmake --build build --target package") -;; go-task/task -(projectile-register-project-type 'go-task '("Taskfile.yml") - :project-file "Taskfile.yml" - :compile "task build" - :test "task test" - :install "task install") -;; Go should take higher precedence than Make because Go projects often have a Makefile. -(projectile-register-project-type 'go projectile-go-project-test-function - :compile "go build" - :test "go test ./..." - :test-suffix "_test") -;; PHP -(projectile-register-project-type 'php-symfony '("composer.json" "app" "src" "vendor") - :project-file "composer.json" - :compile "app/console server:run" - :test "phpunit -c app " - :test-suffix "Test") -;; Erlang & Elixir -(projectile-register-project-type 'rebar '("rebar.config") - :project-file "rebar.config" - :compile "rebar3 compile" - :test "rebar3 do eunit,ct" - :test-suffix "_SUITE") -(projectile-register-project-type 'elixir '("mix.exs") - :project-file "mix.exs" - :compile "mix compile" - :src-dir "lib/" - :test "mix test" - :test-suffix "_test") -;; JavaScript -(projectile-register-project-type 'grunt '("Gruntfile.js") - :project-file "Gruntfile.js" - :compile "grunt" - :test "grunt test") -(projectile-register-project-type 'gulp '("gulpfile.js") - :project-file "gulpfile.js" - :compile "gulp" - :test "gulp test") -(projectile-register-project-type 'npm '("package.json") - :project-file "package.json" - :compile "npm install" - :test "npm test" - :test-suffix ".test") -;; Angular -(projectile-register-project-type 'angular '("angular.json" ".angular-cli.json") - :project-file "angular.json" - :compile "ng build" - :run "ng serve" - :test "ng test" - :test-suffix ".spec") -;; Python -(projectile-register-project-type 'django '("manage.py") - :project-file "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") - :project-file "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") - :project-file "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") - :project-file "tox.ini" - :compile "tox -r --notest" - :test "tox" - :test-prefix "test_" - :test-suffix"_test") -(projectile-register-project-type 'python-pipenv '("Pipfile") - :project-file "Pipfile" - :compile "pipenv run build" - :test "pipenv run test" - :test-prefix "test_" - :test-suffix "_test") -(projectile-register-project-type 'python-poetry '("poetry.lock") - :project-file "poetry.lock" - :compile "poetry build" - :test "poetry run python -m unittest discover" - :test-prefix "test_" - :test-suffix "_test") -;; Java & friends -(projectile-register-project-type 'maven '("pom.xml") - :project-file "pom.xml" - :compile "mvn -B clean install" - :test "mvn -B test" - :test-suffix "Test" - :src-dir "src/main/" - :test-dir "src/test/") -(projectile-register-project-type 'gradle '("build.gradle") - :project-file "build.gradle" - :compile "gradle build" - :test "gradle test" - :test-suffix "Spec") -(projectile-register-project-type 'gradlew '("gradlew") - :project-file "gradlew" - :compile "./gradlew build" - :test "./gradlew test" - :test-suffix "Spec") -(projectile-register-project-type 'grails '("application.yml" "grails-app") - :project-file "application.yml" - :compile "grails package" - :test "grails test-app" - :test-suffix "Spec") -;; Scala -(projectile-register-project-type 'sbt '("build.sbt") - :project-file "build.sbt" - :src-dir "main" - :test-dir "test" - :compile "sbt compile" - :test "sbt test" - :test-suffix "Spec") - -(projectile-register-project-type 'mill '("build.sc") - :project-file "build.sc" - :src-dir "src/" - :test-dir "test/src/" - :compile "mill all __.compile" - :test "mill all __.test" - :test-suffix "Test") - -;; Clojure -(projectile-register-project-type 'lein-test '("project.clj") - :project-file "project.clj" - :compile "lein compile" - :test "lein test" - :test-suffix "_test") -(projectile-register-project-type 'lein-midje '("project.clj" ".midje.clj") - :project-file "project.clj" - :compile "lein compile" - :test "lein midje" - :test-prefix "t_") -(projectile-register-project-type 'boot-clj '("build.boot") - :project-file "build.boot" - :compile "boot aot" - :test "boot test" - :test-suffix "_test") -(projectile-register-project-type 'clojure-cli '("deps.edn") - :project-file "deps.edn" - :test-suffix "_test") -(projectile-register-project-type 'bloop '(".bloop") - :project-file ".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") - :project-file "Gemfile" - :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") - :project-file "Gemfile" - :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") - :project-file "Gemfile" - :compile "bundle exec rails server" - :src-dir "app/" - :test "bundle exec rake test" - :test-suffix "_test") -(projectile-register-project-type 'rails-rspec '("Gemfile" "app" "lib" "db" "config" "spec") - :project-file "Gemfile" - :compile "bundle exec rails server" - :src-dir "app/" - :test "bundle exec rspec" - :test-dir "spec/" - :test-suffix "_spec") -;; Crystal -(projectile-register-project-type 'crystal-spec '("shard.yml") - :project-file "shard.yml" - :src-dir "src/" - :test "crystal spec" - :test-dir "spec/" - :test-suffix "_spec") - -;; Emacs -(projectile-register-project-type 'emacs-cask '("Cask") - :project-file "Cask" - :compile "cask install" - :test-prefix "test-" - :test-suffix "-test") -(projectile-register-project-type 'emacs-eldev #'projectile-eldev-project-p - :project-file "Eldev" - :compile "eldev compile" - :test "eldev test" - :run "eldev emacs" - :package "eldev package") - -;; R -(projectile-register-project-type 'r '("DESCRIPTION") - :project-file "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") - :project-file "stack.yaml" - :compile "stack build" - :test "stack build --test" - :test-suffix "Spec") - -;; Rust -(projectile-register-project-type 'rust-cargo '("Cargo.toml") - :project-file "Cargo.toml" - :compile "cargo build" - :test "cargo test" - :run "cargo run") - -;; Racket -(projectile-register-project-type 'racket '("info.rkt") - :project-file "info.rkt" - :test "raco test ." - :install "raco pkg install" - :package "raco pkg create --source $(pwd)") - -;; Dart -(projectile-register-project-type 'dart '("pubspec.yaml") - :project-file "pubspec.yaml" - :compile "pub get" - :test "pub run test" - :run "dart" - :test-suffix "_test.dart") - -;; OCaml -(projectile-register-project-type 'ocaml-dune '("dune-project") - :project-file "dune-project" - :compile "dune build" - :test "dune runtest") - -(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 (&optional dir) - "Detect the type of the project. -When DIR is specified it detects its project type, otherwise it acts -on 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 (functionp marker) - (and (funcall marker dir) project-type) - (and (projectile-verify-files marker dir) project-type)))) - projectile-project-types)) - 'generic))) - (puthash (projectile-project-root dir) 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." - (or (and (not dir) projectile-project-type) - (if-let ((project-root (projectile-project-root dir))) - (or (gethash project-root projectile-project-type-cache) - (projectile-detect-project-type dir))))) - -;;;###autoload -(defun projectile-project-info () - "Display info for current project." - (interactive) - (message "Project dir: %s ## Project VCS: %s ## Project type: %s" - (projectile-acquire-root) - (projectile-project-vcs) - (projectile-project-type))) - -(defun projectile-verify-files (files &optional dir) - "Check whether all FILES exist in the project. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project." - (cl-every #'(lambda (file) (projectile-verify-file file dir)) files)) - -(defun projectile-verify-file (file &optional dir) - "Check whether FILE exists in the current project. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project." - (file-exists-p (projectile-expand-root file dir))) - -(defun projectile-verify-file-wildcard (file &optional dir) - "Check whether FILE exists in the current project. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project. -Expands wildcards using `file-expand-wildcards' before checking." - (file-expand-wildcards (projectile-expand-root file dir))) - -(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 -the variable `projectile-project-root'." - (or project-root (setq project-root (projectile-acquire-root))) - (cond - ;; first we check for a VCS marker in the project root itself - ((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 ".pijul" project-root)) 'pijul) - ((projectile-file-exists-p (expand-file-name ".svn" project-root)) 'svn) - ;; then we check if there's a VCS marker up the directory tree - ;; that covers the case when a project is part of a multi-project repository - ;; in those cases you can still the VCS to get a list of files for - ;; the project in question - ((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 ".pijul") 'pijul) - ((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. - -IMPL-FILE-PATH may be a absolute path, relative path or a file name." - (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 "Cannot determine a test file name, one of \"test-suffix\" or \"test-prefix\" must be set for project type `%s'" project-type))))) - -(defun projectile--impl-name-for-test-name (test-file-path) - "Determine the name of the implementation file for TEST-FILE-PATH. - -TEST-FILE-PATH may be a absolute path, relative path or a file name." - (let* ((project-type (projectile-project-type)) - (test-file-name (file-name-sans-extension (file-name-nondirectory test-file-path))) - (test-file-ext (file-name-extension test-file-path)) - (test-prefix (funcall projectile-test-prefix-function project-type)) - (test-suffix (funcall projectile-test-suffix-function project-type))) - (cond - (test-prefix - (concat (string-remove-prefix test-prefix test-file-name) "." test-file-ext)) - (test-suffix - (concat (string-remove-suffix test-suffix test-file-name) "." test-file-ext)) - (t (error "Cannot determine an implementation file name, one of \"test-suffix\" or \"test-prefix\" must be set for project type `%s'" project-type))))) - -(defun projectile--test-to-impl-dir (test-dir-path) - "Return the directory path of an impl file with test file in TEST-DIR-PATH. - -Occurrences of the current project type's test-dir property (which should be a -string) are replaced with the current project type's src-dir property - (which should be a string) to obtain the new directory. - -Nil is returned if either the src-dir or test-dir properties are not strings." - (let* ((project-type (projectile-project-type)) - (test-dir (projectile-project-type-attribute project-type 'test-dir)) - (impl-dir (projectile-project-type-attribute project-type 'src-dir))) - (when (and (stringp test-dir) (stringp impl-dir)) - (if (not (string-match-p test-dir (file-name-directory test-dir-path))) - (error "Attempted to find a implementation file by switching this project type's (%s) test-dir property \"%s\" with this project type's src-dir property \"%s\", but %s does not contain \"%s\"" - project-type test-dir impl-dir test-dir-path test-dir) - (projectile-complementary-dir test-dir-path test-dir impl-dir))))) - -(defun projectile--impl-to-test-dir-fallback (impl-dir-path) - "Return the test file for IMPL-DIR-PATH by guessing a test directory. - -Occurrences of the `projectile-default-src-directory' in the directory of -IMPL-DIR-PATH are replaced with `projectile-default-test-directory'. Nil is -returned if `projectile-default-src-directory' is not a substring of -IMPL-DIR-PATH." - (when-let ((file (projectile--complementary-file - impl-dir-path - (lambda (f) - (when (string-match-p projectile-default-src-directory f) - (projectile-complementary-dir - impl-dir-path - projectile-default-src-directory - projectile-default-test-directory))) - #'projectile--test-name-for-impl-name))) - (file-relative-name file (projectile-project-root)))) - -(defun projectile--test-to-impl-dir-fallback (test-dir-path) - "Return the impl file for TEST-DIR-PATH by guessing a source directory. - -Occurrences of `projectile-default-test-directory' in the directory of -TEST-DIR-PATH are replaced with `projectile-default-src-directory'. Nil is -returned if `projectile-default-test-directory' is not a substring of -TEST-DIR-PATH." - (when-let ((file (projectile--complementary-file - test-dir-path - (lambda (f) - (when (string-match-p projectile-default-test-directory f) - (projectile-complementary-dir - test-dir-path - projectile-default-test-directory - projectile-default-src-directory))) - #'projectile--impl-name-for-test-name))) - (file-relative-name file (projectile-project-root)))) - -(defun projectile--impl-to-test-dir (impl-dir-path) - "Return the directory path of a test whose impl file resides in IMPL-DIR-PATH. - -Occurrences of the current project type's src-dir property (which should be a -string) are replaced with the current project type's test-dir property - (which should be a string) to obtain the new directory. - -If the src-dir property is set and IMPL-DIR-PATH does not contain (as a -substring) the src-dir property of the current project type, an error is -signalled. - -Nil is returned if either the src-dir or test-dir properties are not strings." - (let* ((project-type (projectile-project-type)) - (test-dir (projectile-project-type-attribute project-type 'test-dir)) - (impl-dir (projectile-project-type-attribute project-type 'src-dir))) - (when (and (stringp test-dir) (stringp impl-dir)) - (if (not (string-match-p impl-dir (file-name-directory impl-dir-path))) - (error "Attempted to find a test file by switching this project type's (%s) src-dir property \"%s\" with this project type's test-dir property \"%s\", but %s does not contain \"%s\"" - project-type impl-dir test-dir impl-dir-path impl-dir) - (projectile-complementary-dir impl-dir-path impl-dir test-dir))))) - -(defun projectile-complementary-dir (dir-path string replacement) - "Return the \"complementary\" directory of DIR-PATH. -Replace STRING in DIR-PATH with REPLACEMENT." - (let* ((project-root (projectile-project-root)) - (relative-dir (file-name-directory (file-relative-name dir-path project-root)))) - (projectile-expand-root - (replace-regexp-in-string string replacement relative-dir)))) - -(defun projectile--create-directories-for (path) - "Create directories necessary for PATH." - (unless (file-exists-p path) - (make-directory (if (file-directory-p path) - path - (file-name-directory path)) - :create-parents))) - -(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")) - (unless (projectile-project-type) (projectile-ensure-project nil)) - (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* ((error-msg (format - "No matching test file found for project type `%s'" - (projectile-project-type))) - (test-file (or (projectile-find-matching-test file-name) - (error error-msg))) - (expanded-test-file (projectile-expand-root test-file))) - (cond ((file-exists-p expanded-test-file) expanded-test-file) - (projectile-create-missing-test-files - (projectile--create-directories-for expanded-test-file) - expanded-test-file) - (t (error "Determined test file to be \"%s\", which does not exist. Set `projectile-create-missing-test-files' to allow `projectile-find-implementation-or-test' to create new files" test-file)))))) - -;;;###autoload -(defun projectile-find-implementation-or-test-other-window () - "Open matching implementation or test file in other window. - -See the documentation of `projectile--find-matching-file' and -`projectile--find-matching-test' for how implementation and test files -are determined." - (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. - -See the documentation of `projectile--find-matching-file' and -`projectile--find-matching-test' for how implementation and test files -are determined." - (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. - - -See the documentation of `projectile--find-matching-file' and -`projectile--find-matching-test' for how implementation and test files -are determined." - (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." - (or projectile-project-test-prefix - (projectile-project-type-attribute project-type 'test-prefix))) - -(defun projectile-test-suffix (project-type) - "Find default test files suffix based on PROJECT-TYPE." - (or projectile-project-test-suffix - (projectile-project-type-attribute project-type 'test-suffix))) - -(defun projectile-related-files-fn (project-type) - "Find relative file based on PROJECT-TYPE." - (or projectile-project-related-files-fn - (projectile-project-type-attribute project-type 'related-files-fn))) - -(defun projectile-src-directory (project-type) - "Find default src directory based on PROJECT-TYPE." - (or projectile-project-src-dir - (projectile-project-type-attribute - project-type 'src-dir projectile-default-src-directory))) - -(defun projectile-test-directory (project-type) - "Find default test directory based on PROJECT-TYPE." - (or projectile-project-test-dir - (projectile-project-type-attribute - project-type 'test-dir projectile-default-test-directory))) - -(defun projectile-dirname-matching-count (a b) - "Count matching dirnames ascending file paths in A and B." - (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 of 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--complementary-file (file-path dir-fn filename-fn) - "Apply DIR-FN and FILENAME-FN to the directory and name of FILE-PATH. - -More specifically, return DIR-FN applied to the directory of FILE-PATH -concatenated with FILENAME-FN applied to the file name of FILE-PATH. - -If either function returns nil, return nil." - (let ((filename (file-name-nondirectory file-path))) - (when-let ((complementary-filename (funcall filename-fn filename)) - (dir (funcall dir-fn (file-name-directory file-path)))) - (concat (file-name-as-directory dir) complementary-filename)))) - -(defun projectile--impl-file-from-src-dir-str (file-name) - "Get the relative path of the implementation file FILE-NAME. -Return a path relative to the project root for the impl file of FILE-NAME -using the src-dir and test-dir properties of the current project type which -should be strings, nil returned if this is not the case." - (when-let ((complementary-file (projectile--complementary-file - file-name - #'projectile--test-to-impl-dir - #'projectile--impl-name-for-test-name))) - (file-relative-name complementary-file (projectile-project-root)))) - -(defun projectile--test-file-from-test-dir-str (file-name) - "Get the relative path of the test file FILE-NAME. -Return a path relative to the project root for the test file of FILE-NAME -using the src-dir and test-dir properties of the current project type which -should be strings, nil returned if this is not the case." - (when-let (complementary-file (projectile--complementary-file - file-name - #'projectile--impl-to-test-dir - #'projectile--test-name-for-impl-name)) - (file-relative-name complementary-file (projectile-project-root)))) - -(defun projectile--impl-file-from-src-dir-fn (test-file) - "Get the relative path to the implementation file corresponding to TEST-FILE. -Return the implementation file path for the absolute path TEST-FILE -relative to the project root in the case the current project type's src-dir -has been set to a custom function, return nil if this is not the case or -the path points to a file that does not exist." - (when-let ((src-dir (projectile-src-directory (projectile-project-type)))) - (when (functionp src-dir) - (let ((impl-file (projectile--complementary-file - test-file - src-dir - #'projectile--impl-name-for-test-name))) - (when (file-exists-p impl-file) - (file-relative-name impl-file (projectile-project-root))))))) - -(defun projectile--test-file-from-test-dir-fn (impl-file) - "Get the relative path to the test file corresponding to IMPL-FILE. -Return the test file path for the absolute path IMPL-FILE relative to the -project root, in the case the current project type's test-dir has been set -to a custom function, else return nil." - (when-let ((test-dir (projectile-test-directory (projectile-project-type)))) - (when (functionp test-dir) - (file-relative-name - (projectile--complementary-file - impl-file - test-dir - #'projectile--test-name-for-impl-name) - (projectile-project-root))))) - -(defmacro projectile--acond (&rest clauses) - "Like `cond', but the result of each condition is bound to `it'. - -The variable `it' is available within the remainder of each of CLAUSES. - -CLAUSES are otherwise as documented for `cond'. This is copied from -anaphora.el." - (declare (debug cond)) - (if (null clauses) - nil - (let ((cl1 (car clauses)) - (sym (cl-gensym))) - `(let ((,sym ,(car cl1))) - (if ,sym - (if (null ',(cdr cl1)) - ,sym - (let ((it ,sym)) ,@(cdr cl1))) - (projectile--acond ,@(cdr clauses))))))) - -(defun projectile--find-matching-test (impl-file) - "Return a list of test files for IMPL-FILE. - -The precedence for determining test files to return is: - -1. Use the project type's test-dir property if it's set to a function -2. Use the project type's related-files-fn property if set -3. Use the project type's test-dir property if it's set to a string -4. Attempt to find a file by matching all project files against - `projectile--impl-to-test-predicate' -5. Fallback to swapping \"src\" for \"test\" in IMPL-FILE if \"src\" - is a substring of IMPL-FILE." - (projectile--acond - ((projectile--test-file-from-test-dir-fn impl-file) (list it)) - ((projectile--related-files-plist-by-kind impl-file :test) - (projectile--related-files-from-plist it)) - ((projectile--test-file-from-test-dir-str impl-file) (list it)) - ((projectile--best-or-all-candidates-based-on-parents-dirs - impl-file (cl-remove-if-not - (projectile--impl-to-test-predicate impl-file) - (projectile-current-project-files))) it) - ((projectile--impl-to-test-dir-fallback impl-file) - (list it)))) - -(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. - -The precedence for determining implementation files to return is: - -1. Use the project type's src-dir property if it's set to a function -2. Use the project type's related-files-fn property if set -3. Use the project type's src-dir property if it's set to a string -4. Default to a fallback which matches all project files against - `projectile--test-to-impl-predicate' -5. Fallback to swapping \"test\" for \"src\" in TEST-FILE if \"test\" - is a substring of TEST-FILE." - (projectile--acond - ((projectile--impl-file-from-src-dir-fn test-file) (list it)) - ((projectile--related-files-plist-by-kind test-file :impl) - (projectile--related-files-from-plist it)) - ((projectile--impl-file-from-src-dir-str test-file) (list it)) - ((projectile--best-or-all-candidates-based-on-parents-dirs - test-file (cl-remove-if-not - (projectile--test-to-impl-predicate test-file) - (projectile-current-project-files))) it) - ((projectile--test-to-impl-dir-fallback test-file) (list it)))) - -(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." - (when-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." - (when-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-acquire-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-ignored-files-rel) - (projectile-ignored-directories-rel) - (projectile--globally-ignored-file-suffixes-glob) - ;; ag supports git ignore files directly - (unless (eq (projectile-project-vcs) 'git) - (append 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-acquire-root))) - (error "Package 'ag' is not available"))) - -;;;###autoload -(defun projectile-ripgrep (search-term &optional arg) - "Run a ripgrep (rg) search with `SEARCH-TERM' at current project root. - -With an optional prefix argument ARG SEARCH-TERM is interpreted as a -regular expression. - -This command depends on of the Emacs packages ripgrep or rg being -installed to work." - (interactive - (list (projectile--read-search-string-with-default - (format "Ripgrep %ssearch for" (if current-prefix-arg "regexp " ""))) - current-prefix-arg)) - (let ((args (mapcar (lambda (val) (concat "--glob !" val)) - (append projectile-globally-ignored-files - projectile-globally-ignored-directories)))) - ;; we rely on the external packages ripgrep and rg for the actual search - ;; - ;; first we check if we can load ripgrep - (cond ((require 'ripgrep nil 'noerror) - (ripgrep-regexp search-term - (projectile-acquire-root) - (if arg - args - (cons "--fixed-strings --hidden" args)))) - ;; and then we try rg - ((require 'rg nil 'noerror) - (rg-run search-term - "*" ;; all files - (projectile-acquire-root) - (not arg) ;; literal search? - nil ;; no need to confirm - args)) - (t (error "Packages `ripgrep' and `rg' are not available"))))) - -(defun projectile-find-references (&optional symbol) - "Find all references to SYMBOL in the current project. - -A thin wrapper around `xref-references-in-directory'." - (interactive) - (when (and (fboundp 'xref-references-in-directory) - (fboundp 'xref--show-xrefs)) - (let ((project-root (projectile-acquire-root)) - (symbol (or symbol (read-from-minibuffer "Lookup in project: " (projectile-symbol-at-point))))) - (xref--show-xrefs (xref-references-in-directory symbol project-root) nil)))) - -(defun projectile-tags-exclude-patterns () - "Return a string with exclude patterns for ctags." - (mapconcat (lambda (pattern) (format "--exclude=\"%s\"" - (directory-file-name pattern))) - (append - (projectile-ignored-directories-rel) - (projectile-patterns-to-ignore)) " ")) - -;;;###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-acquire-root)) - (default-directory ggtags-project-root)) - (ggtags-ensure-project) - (ggtags-update-tags t))) - (let* ((project-root (projectile-acquire-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 - (or (file-remote-p tags-file 'localname) tags-file) - tags-exclude - ".")) - shell-output exit-code) - (with-temp-buffer - (setq exit-code - (process-file-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-acquire-root) - (call-interactively #'execute-extended-command))) - -;;;###autoload -(defun projectile-run-shell-command-in-root (command &optional output-buffer error-buffer) - "Invoke `shell-command' in the project's root." - (interactive (list (read-shell-command "Shell command: "))) - (projectile-with-default-dir (projectile-acquire-root) - (shell-command command output-buffer error-buffer))) - -;;;###autoload -(defun projectile-run-async-shell-command-in-root (command &optional output-buffer error-buffer) - "Invoke `async-shell-command' in the project's root." - (interactive (list (read-shell-command "Async shell command: "))) - (projectile-with-default-dir (projectile-acquire-root) - (async-shell-command command output-buffer error-buffer))) - -;;;###autoload -(defun projectile-run-gdb () - "Invoke `gdb' in the project's root." - (interactive) - (projectile-with-default-dir (projectile-acquire-root) - (call-interactively 'gdb))) - -;;;###autoload -(defun projectile-run-shell (&optional 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") - (let ((project (projectile-acquire-root))) - (projectile-with-default-dir project - (shell (projectile-generate-process-name "shell" arg project))))) - -;;;###autoload -(defun projectile-run-eshell (&optional 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") - (let ((project (projectile-acquire-root))) - (projectile-with-default-dir project - (let ((eshell-buffer-name (projectile-generate-process-name "eshell" arg project))) - (eshell))))) - -;;;###autoload -(defun projectile-run-ielm (&optional 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-acquire-root)) - (ielm-buffer-name (projectile-generate-process-name "ielm" arg project))) - (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 (&optional 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-acquire-root)) - (buffer-name (projectile-generate-process-name "term" arg project)) - (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-acquire-root)) - (buffer (projectile-generate-process-name "vterm" arg project))) - (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-acquire-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)))) - -(defvar projectile-files-with-string-commands - '((rg . "rg -lF --no-heading --color never ") - (ag . "ag --literal --nocolor --noheading -l ") - (ack . "ack --literal --nocolor -l ") - (git . "git grep -HlI ") - ;; -r: recursive - ;; -H: show filename for each match - ;; -l: show only file names with matches - ;; -I: no binary files - (grep . "grep -rHlI %s ."))) - -(defun projectile--rg-construct-command (search-term &optional file-ext) - "Construct Rg option to search files by the extension FILE-EXT." - (if (stringp file-ext) - (concat (cdr (assoc 'rg projectile-files-with-string-commands)) - "-g '" - file-ext - "' " - search-term) - (concat (cdr (assoc 'rg projectile-files-with-string-commands)) - search-term))) - -(defun projectile--ag-construct-command (search-term &optional file-ext) - "Construct Ag option to search files by the extension FILE-EXT." - (if (stringp file-ext) - (concat (cdr (assoc 'ag projectile-files-with-string-commands)) - "-G " - (replace-regexp-in-string - "\\*" "" - (replace-regexp-in-string "\\." "\\\\." file-ext)) - "$ " - search-term) - (concat (cdr (assoc 'ag projectile-files-with-string-commands)) - search-term))) - -(defun projectile--ack-construct-command (search-term &optional file-ext) - "Construct Ack option to search files by the extension FILE-EXT." - (if (stringp file-ext) - (concat "ack -g '" - (replace-regexp-in-string - "\\*" "" - (replace-regexp-in-string "\\." "\\\\." file-ext)) - "$' | " - (cdr (assoc 'ack projectile-files-with-string-commands)) - "-x " - search-term) - (concat (cdr (assoc 'ack projectile-files-with-string-commands)) - search-term))) - -(defun projectile--git-grep-construct-command (search-term &optional file-ext) - "Construct Grep option to search files by the extension FILE-EXT." - (if (stringp file-ext) - (concat (cdr (assoc 'git projectile-files-with-string-commands)) - search-term - " -- '" - file-ext - "'") - (concat (cdr (assoc 'git projectile-files-with-string-commands)) - search-term))) - -(defun projectile--grep-construct-command (search-term &optional file-ext) - "Construct Grep option to search files by the extension FILE-EXT." - (if (stringp file-ext) - (concat (format (cdr (assoc 'grep projectile-files-with-string-commands)) - search-term) - " --include '" - file-ext - "'") - (format (cdr (assoc 'grep projectile-files-with-string-commands)) - search-term))) - -(defun projectile-files-with-string (string directory &optional file-ext) - "Return a list of all files containing STRING in DIRECTORY. - -Tries to use rg, 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 "rg") - (projectile--rg-construct-command search-term file-ext)) - ((executable-find "ag") - (projectile--ag-construct-command search-term file-ext)) - ((executable-find "ack") - (projectile--ack-construct-command search-term file-ext)) - ((and (executable-find "git") - (eq (projectile-project-vcs) 'git)) - (projectile--git-grep-construct-command search-term file-ext)) - (t - (projectile--grep-construct-command search-term file-ext))))) - (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 #'(lambda (file) (expand-file-name file directory)) - (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 and file name patterns -on which to run the replacement." - (interactive "P") - (let* ((directory (if arg - (file-name-as-directory - (read-directory-name "Replace in directory: ")) - (projectile-acquire-root))) - (file-ext (if arg - (if (fboundp #'helm-grep-get-file-extensions) - (car (helm-grep-get-file-extensions (list directory))) - (read-string - (projectile-prepend-project-name - "With file extension (empty string means all files): "))) - nil)) - (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 file-ext))) - (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) - (with-no-warnings - (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))))) - (setq 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-acquire-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 #'(lambda (file) (expand-file-name file directory)) - (projectile-dir-files directory))))) - ;; FIXME: Probably would fail on Emacs 27+, fourth argument is gone. - (with-no-warnings (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-acquire-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-acquire-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-acquire-root))) - -;;;###autoload -(defun projectile-dired-other-window () - "Open `dired' at the root of the project in another window." - (interactive) - (dired-other-window (projectile-acquire-root))) - -;;;###autoload -(defun projectile-dired-other-frame () - "Open `dired' at the root of the project in another frame." - (interactive) - (dired-other-frame (projectile-acquire-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)))) - (unless project-root - (setq project-root (projectile-acquire-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-acquire-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-install-cmd-map - (make-hash-table :test 'equal) - "A mapping between projects and the last install command used on them.") - -(defvar projectile-package-cmd-map - (make-hash-table :test 'equal) - "A mapping between projects and the last package 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-enable-cmd-caching t - "Enables command caching for the project. Set to nil to disable. -Should be set via .dir-locals.el.") - -(defun projectile--cache-project-commands-p () - "Whether to cache project commands." - (with-temp-buffer - (hack-dir-local-variables-non-file-buffer) - projectile-project-enable-cmd-caching)) - -(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-install-cmd nil - "The command to use with `projectile-install-project'. -It takes precedence over the default command for the project type when set. -Should be set via .dir-locals.el.") - -(defvar projectile-project-package-cmd nil - "The command to use with `projectile-package-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-install-command (project-type) - "Retrieve default install command for PROJECT-TYPE." - (projectile-default-generic-command project-type 'install-command)) - -(defun projectile-default-package-command (project-type) - "Retrieve default package command for PROJECT-TYPE." - (projectile-default-generic-command project-type 'package-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-buffer-name (compilation-mode) - "Meant to be used for `compilation-buffer-name-function`. -Argument COMPILATION-MODE is the name of the major mode used for the -compilation buffer." - (concat "*" (downcase compilation-mode) "*" - (if (projectile-project-p) (concat "<" (projectile-project-name) ">") ""))) - -(defun projectile-current-project-buffer-p () - "Meant to be used for `compilation-save-buffers-predicate`. -This indicates whether the current buffer is in the same project as the current -window (including returning true if neither is in a project)." - (let ((root (with-current-buffer (window-buffer) (projectile-project-root)))) - (or (not root) - (projectile-project-buffer-p (current-buffer) root)))) - -(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-install-command (compile-dir) - "Retrieve the install command for COMPILE-DIR. - -The command is determined like this: - -- first we check `projectile-install-cmd-map' for the last -install command that was invoked on the project - -- then we check for `projectile-project-install-cmd' supplied -via .dir-locals.el - -- finally we check for the default install command for a -project of that type" - (or (gethash compile-dir projectile-install-cmd-map) - projectile-project-install-cmd - (projectile-default-install-command (projectile-project-type)))) - -(defun projectile-package-command (compile-dir) - "Retrieve the package command for COMPILE-DIR. - -The command is determined like this: - -- first we check `projectile-packgage-cmd-map' for the last -install command that was invoked on the project - -- then we check for `projectile-project-package-cmd' supplied -via .dir-locals.el - -- finally we check for the default package command for a -project of that type" - (or (gethash compile-dir projectile-package-cmd-map) - projectile-project-package-cmd - (projectile-default-package-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 the function `compilation-read-command'." - (let ((compile-history - ;; fetch the command history for the current project - (ring-elements (projectile--get-command-history (projectile-acquire-root))))) - (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 &optional use-comint-mode) - "Run external or Elisp compilation command CMD." - (if (functionp cmd) - (funcall cmd) - (compile cmd use-comint-mode))) - -(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 use-comint-mode) - "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)) - compilation-buffer-name-function - compilation-save-buffers-predicate) - (when command-map - (puthash default-directory command command-map) - (let ((hist (projectile--get-command-history project-root))) - (unless (string= (car-safe (ring-elements hist)) command) - (ring-insert hist command)))) - (when save-buffers - (save-some-buffers (not compilation-ask-about-save) - (lambda () - (projectile-project-buffer-p (current-buffer) - project-root)))) - (when projectile-per-project-compilation-buffer - (setq compilation-buffer-name-function #'projectile-compilation-buffer-name) - (setq compilation-save-buffers-predicate #'projectile-current-project-buffer-p)) - (unless (file-directory-p default-directory) - (mkdir default-directory)) - (projectile-run-compilation command use-comint-mode) - command)) - -(defcustom projectile-configure-use-comint-mode nil - "Make the output buffer of `projectile-configure-project' interactive." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.5.0")) - -(defcustom projectile-compile-use-comint-mode nil - "Make the output buffer of `projectile-compile-project' interactive." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.5.0")) - -(defcustom projectile-test-use-comint-mode nil - "Make the output buffer of `projectile-test-project' interactive." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.5.0")) - -(defcustom projectile-install-use-comint-mode nil - "Make the output buffer of `projectile-install-project' interactive." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.5.0")) - -(defcustom projectile-package-use-comint-mode nil - "Make the output buffer of `projectile-package-project' interactive." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.5.0")) - -(defcustom projectile-run-use-comint-mode nil - "Make the output buffer of `projectile-run-project' interactive." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.5.0")) - -;;;###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))) - (command-map (if (projectile--cache-project-commands-p) projectile-configure-cmd-map))) - (projectile--run-project-cmd command command-map - :show-prompt arg - :prompt-prefix "Configure command: " - :save-buffers t - :use-comint-mode projectile-configure-use-comint-mode))) - -;;;###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))) - (command-map (if (projectile--cache-project-commands-p) projectile-compilation-cmd-map))) - (projectile--run-project-cmd command command-map - :show-prompt arg - :prompt-prefix "Compile command: " - :save-buffers t - :use-comint-mode projectile-compile-use-comint-mode))) - -;;;###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))) - (command-map (if (projectile--cache-project-commands-p) projectile-test-cmd-map))) - (projectile--run-project-cmd command command-map - :show-prompt arg - :prompt-prefix "Test command: " - :save-buffers t - :use-comint-mode projectile-test-use-comint-mode))) - -;;;###autoload -(defun projectile-install-project (arg) - "Run project install 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-install-command (projectile-compilation-dir))) - (command-map (if (projectile--cache-project-commands-p) projectile-install-cmd-map))) - (projectile--run-project-cmd command command-map - :show-prompt arg - :prompt-prefix "Install command: " - :save-buffers t - :use-comint-mode projectile-install-use-comint-mode))) - -;;;###autoload -(defun projectile-package-project (arg) - "Run project package 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-package-command (projectile-compilation-dir))) - (command-map (if (projectile--cache-project-commands-p) projectile-package-cmd-map))) - (projectile--run-project-cmd command command-map - :show-prompt arg - :prompt-prefix "Package command: " - :save-buffers t - :use-comint-mode projectile-package-use-comint-mode))) - -;;;###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))) - (command-map (if (projectile--cache-project-commands-p) projectile-run-cmd-map))) - (projectile--run-project-cmd command command-map - :show-prompt arg - :prompt-prefix "Run command: " - :use-comint-mode projectile-run-use-comint-mode))) - -;;;###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', -`projectile-install-project', `projectile-package-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-acquire-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) - "Advice around compilation-find-file. -We enhance its functionality by appending the current project's directories -to its search path. This way when filenames in compilation buffers can't be -found by compilation's normal logic they are searched for in project -directories." - (let* ((root (projectile-project-root)) - (compilation-search-path - (if (projectile-project-p) - (append compilation-search-path (list root) - (mapcar (lambda (f) (expand-file-name f root)) - (projectile-current-project-dirs))) - compilation-search-path))) - (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-let ((project-root (projectile-project-root))) - (when (projectile-project-buffer-p buffer project-root) - (abbreviate-file-name 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.'" - ;; let's make sure that the target directory exists and is actually a project - ;; we ignore remote folders, as the check breaks for TRAMP unless already connected - (unless (or (file-remote-p project-to-switch) (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) - (switched-buffer - ;; 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) - (current-buffer))))) - ;; If switch-project-action switched buffers then with-temp-buffer will - ;; have lost that change, so switch back to the correct buffer. - (when (buffer-live-p switched-buffer) - (switch-to-buffer switched-buffer))) - (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. -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-reset-known-projects () - "Clear known projects and rediscover." - (interactive) - (projectile-clear-known-projects) - (projectile-discover-projects-in-search-path)) - -;;;###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-acquire-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) - (push (file-name-as-directory (abbreviate-file-name project-root)) projectile-known-projects) - (delete-dups 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 - (let ((directory (file-name-as-directory (expand-file-name qualifier)))) - (and (projectile-project-buffer-p buf directory) - (equal directory - (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-acquire-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-acquire-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-acquire-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 "0.12.0") -(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")) - -(defcustom projectile-show-menu t - "Controls whether to display Projectile's menu." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.6.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 "?") #'projectile-find-references) - (define-key map (kbd "a") #'projectile-find-other-file) - (define-key map (kbd "b") #'projectile-switch-to-buffer) - (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 "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 x") #'projectile-find-references) - (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 "v") #'projectile-vc) - (define-key map (kbd "V") #'projectile-browse-dirty-projects) - ;; project lifecycle external commands - ;; TODO: Bundle those under some prefix key - (define-key map (kbd "C") #'projectile-configure-project) - (define-key map (kbd "c") #'projectile-compile-project) - (define-key map (kbd "K") #'projectile-package-project) - (define-key map (kbd "L") #'projectile-install-project) - (define-key map (kbd "P") #'projectile-test-project) - (define-key map (kbd "u") #'projectile-run-project) - ;; integration with utilities - (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) - ;; misc - (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" :visible projectile-show-menu - ("Find..." - ["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] - ["Jump between implementation file and test file" projectile-toggle-between-implementation-and-test]) - ("Buffers" - ["Switch to buffer" projectile-switch-to-buffer] - ["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]) - ("Projects" - ["Switch to project" projectile-switch-project] - ["Switch to open project" projectile-switch-open-project] - "--" - ["Discover projects in directory" projectile-discover-projects-in-directory] - ["Discover projects in search path" projectile-discover-projects-in-search-path] - ["Clear known projects" projectile-clear-known-projects] - ["Reset known projects" projectile-reset-known-projects] - "--" - ["Open project in dired" projectile-dired] - "--" - ["Browse dirty projects" projectile-browse-dirty-projects] - "--" - ["Cache current file" projectile-cache-current-file] - ["Invalidate cache" projectile-invalidate-cache] - ["Regenerate [e|g]tags" projectile-regenerate-tags] - "--" - ["Toggle project wide read-only" projectile-toggle-project-read-only] - ["Edit .dir-locals.el" projectile-edit-dir-locals] - ["Project info" projectile-project-info]) - ("Search" - ["Search with grep" projectile-grep] - ["Search with ag" projectile-ag] - ["Search with ripgrep" projectile-ripgrep] - ["Replace in project" projectile-replace] - ["Multi-occur in project" projectile-multi-occur] - ["Find references in project" projectile-find-references]) - ("Run..." - ["Run shell" projectile-run-shell] - ["Run eshell" projectile-run-eshell] - ["Run ielm" projectile-run-ielm] - ["Run term" projectile-run-term] - ["Run vterm" projectile-run-vterm] - "--" - ["Run GDB" projectile-run-gdb]) - ("Build" - ["Configure project" projectile-configure-project] - ["Compile project" projectile-compile-project] - ["Test project" projectile-test-project] - ["Install project" projectile-install-project] - ["Package project" projectile-package-project] - ["Run project" projectile-run-project] - "--" - ["Repeat last build command" projectile-repeat-last-command]) - "--" - ["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." - (projectile-maybe-limit-project-file-buffers) - (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))) - -(defun projectile-maybe-limit-project-file-buffers () - "Limit the opened file buffers for a project. - -The function simply kills the last buffer, as it's normally called -when opening new files." - (when projectile-max-file-buffer-count - (let ((project-buffers (projectile-project-buffer-files))) - (when (> (length project-buffers) projectile-max-file-buffer-count) - (kill-buffer (car (last project-buffers))))))) - -;;;###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) - (when projectile-auto-discover - (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)))) - -;;; savehist-mode - When `savehist-mode' is t, projectile-project-command-history will be saved. -;; See https://github.com/bbatsov/projectile/issues/1637 for more details -(if (bound-and-true-p savehist-loaded) - (add-to-list 'savehist-additional-variables 'projectile-project-command-history) - (defvar savehist-additional-variables nil) - (add-hook 'savehist-mode-hook - (lambda() - (add-to-list 'savehist-additional-variables 'projectile-project-command-history)))) - -;;;###autoload -(define-obsolete-function-alias 'projectile-global-mode 'projectile-mode "1.0") - -;;;; project.el integration -;; -;; Projectile will become the default provider for -;; project.el project and project files lookup. -;; See https://github.com/bbatsov/projectile/issues/1591 for -;; more details. - -;; it's safe to require this directly, as it was added in Emacs 25.1 -(require 'project) - -(cl-defmethod project-root ((project (head projectile))) - (cdr project)) - -(cl-defmethod project-files ((project (head projectile)) &optional _dirs) - (let ((root (project-root project))) - ;; Make paths absolute and ignore the optional dirs argument, - ;; see https://github.com/bbatsov/projectile/issues/1591#issuecomment-896423965 - ;; That's needed because Projectile uses relative paths for project files - ;; and project.el expects them to be absolute. - ;; FIXME: That's probably going to be very slow in large projects. - (mapcar (lambda (f) - (concat root f)) - (projectile-project-files root)))) - -(defun project-projectile (dir) - "Return Projectile project of form ('projectile . root-dir) for DIR." - (let ((root (projectile-project-root dir))) - (when root - (cons 'projectile root)))) - -(add-hook 'project-find-functions #'project-projectile) - -(provide 'projectile) - -;;; projectile.el ends here diff --git a/org/elpa/projectile-20230219.647/projectile-autoloads.el b/org/elpa/projectile-20230219.647/projectile-autoloads.el deleted file mode 100644 index dfa6c0b..0000000 --- a/org/elpa/projectile-20230219.647/projectile-autoloads.el +++ /dev/null @@ -1,640 +0,0 @@ -;;; projectile-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; 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." t nil) - -(autoload 'projectile-discover-projects-in-directory "projectile" "\ -Discover any projects in DIRECTORY and add them to the projectile cache. - -If DEPTH is non-nil recursively descend exactly DEPTH levels below DIRECTORY and -discover projects there. - -\(fn DIRECTORY &optional DEPTH)" t nil) - -(autoload 'projectile-discover-projects-in-search-path "projectile" "\ -Discover projects in `projectile-project-search-path'. -Invoked automatically when `projectile-mode' is enabled." t nil) - -(autoload 'projectile-switch-to-buffer "projectile" "\ -Switch to a project buffer." t nil) - -(autoload 'projectile-switch-to-buffer-other-window "projectile" "\ -Switch to a project buffer and show it in another window." t nil) - -(autoload 'projectile-switch-to-buffer-other-frame "projectile" "\ -Switch to a project buffer and show it in another frame." t nil) - -(autoload 'projectile-display-buffer "projectile" "\ -Display a project buffer in another window without selecting it." 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." 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 different extensions in other window. -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 different extensions in other frame. -Switch between files with the same name but different extensions in other frame. -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." t nil) - -(autoload 'projectile-add-dir-local-variable "projectile" "\ -Run `add-dir-local-variable' with .dir-locals.el in root of project. - -Parameters MODE VARIABLE VALUE are passed directly to `add-dir-local-variable'. - -\(fn MODE VARIABLE VALUE)" nil nil) - -(autoload 'projectile-delete-dir-local-variable "projectile" "\ -Run `delete-dir-local-variable' with .dir-locals.el in root of project. - -Parameters MODE VARIABLE VALUE are passed directly to -`delete-dir-local-variable'. - -\(fn MODE VARIABLE)" nil 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 frame 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." t nil) - -(autoload 'projectile-find-related-file-other-frame "projectile" "\ -Open related file in other frame." t nil) - -(autoload 'projectile-find-related-file "projectile" "\ -Open related file." 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. -Use 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. -Use files with EXTENSION based on TEST-SUFFIX. - -\(fn EXTENSION TEST-SUFFIX)" nil nil) - -(autoload 'projectile-project-info "projectile" "\ -Display info for current project." t nil) - -(autoload 'projectile-find-implementation-or-test-other-window "projectile" "\ -Open matching implementation or test file in other window. - -See the documentation of `projectile--find-matching-file' and -`projectile--find-matching-test' for how implementation and test files -are determined." t nil) - -(autoload 'projectile-find-implementation-or-test-other-frame "projectile" "\ -Open matching implementation or test file in other frame. - -See the documentation of `projectile--find-matching-file' and -`projectile--find-matching-test' for how implementation and test files -are determined." t nil) - -(autoload 'projectile-toggle-between-implementation-and-test "projectile" "\ -Toggle between an implementation file and its test file. - - -See the documentation of `projectile--find-matching-file' and -`projectile--find-matching-test' for how implementation and test files -are determined." 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 (rg) search with `SEARCH-TERM' at current project root. - -With an optional prefix argument ARG SEARCH-TERM is interpreted as a -regular expression. - -This command depends on of the Emacs packages ripgrep or rg being -installed to work. - -\(fn SEARCH-TERM &optional ARG)" t nil) - -(autoload 'projectile-regenerate-tags "projectile" "\ -Regenerate the project's [e|g]tags." t nil) - -(autoload 'projectile-find-tag "projectile" "\ -Find tag in project." t nil) - -(autoload 'projectile-run-command-in-root "projectile" "\ -Invoke `execute-extended-command' in the project's root." t nil) - -(autoload 'projectile-run-shell-command-in-root "projectile" "\ -Invoke `shell-command' in the project's root. - -\(fn COMMAND &optional OUTPUT-BUFFER ERROR-BUFFER)" t nil) - -(autoload 'projectile-run-async-shell-command-in-root "projectile" "\ -Invoke `async-shell-command' in the project's root. - -\(fn COMMAND &optional OUTPUT-BUFFER ERROR-BUFFER)" t nil) - -(autoload 'projectile-run-gdb "projectile" "\ -Invoke `gdb' in the project's root." 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 &optional 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 &optional 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 &optional 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 &optional 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 and file name patterns -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'." t nil) - -(autoload 'projectile-save-project-buffers "projectile" "\ -Save all project buffers." t nil) - -(autoload 'projectile-dired "projectile" "\ -Open `dired' at the root of the project." t nil) - -(autoload 'projectile-dired-other-window "projectile" "\ -Open `dired' at the root of the project in another window." t nil) - -(autoload 'projectile-dired-other-frame "projectile" "\ -Open `dired' at the root of the project in another frame." 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." 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-install-project "projectile" "\ -Run project install 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-package-project "projectile" "\ -Run project package 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', -`projectile-install-project', `projectile-package-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." t nil) - -(autoload 'projectile-cleanup-known-projects "projectile" "\ -Remove known projects that don't exist anymore." t nil) - -(autoload 'projectile-clear-known-projects "projectile" "\ -Clear both `projectile-known-projects' and `projectile-known-projects-file'." t nil) - -(autoload 'projectile-reset-known-projects "projectile" "\ -Clear known projects and rediscover." 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." 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." 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." 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") - -(register-definition-prefixes "projectile" '("??" "compilation-find-file-projectile-find-compilation-buffer" "def-projectile-commander-method" "delete-file-projectile-remove-from-cache" "project")) - -;;;*** - -;; 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/org/elpa/projectile-20230219.647/projectile-pkg.el b/org/elpa/projectile-20230219.647/projectile-pkg.el deleted file mode 100644 index 5141284..0000000 --- a/org/elpa/projectile-20230219.647/projectile-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from projectile.el -*- no-byte-compile: t -*- -(define-package "projectile" "20230219.647" "Manage and navigate projects in Emacs easily" '((emacs "25.1")) :commit "fd257811c46f89f53143dd0ccbc134fc9459d6bb" :authors '(("Bozhidar Batsov" . "bozhidar@batsov.dev")) :maintainer '("Bozhidar Batsov" . "bozhidar@batsov.dev") :keywords '("project" "convenience") :url "https://github.com/bbatsov/projectile") diff --git a/org/elpa/projectile-20230219.647/projectile.el b/org/elpa/projectile-20230219.647/projectile.el deleted file mode 100644 index 96b670b..0000000 --- a/org/elpa/projectile-20230219.647/projectile.el +++ /dev/null @@ -1,6133 +0,0 @@ -;;; projectile.el --- Manage and navigate projects in Emacs easily -*- lexical-binding: t -*- - -;; Copyright © 2011-2022 Bozhidar Batsov - -;; Author: Bozhidar Batsov -;; URL: https://github.com/bbatsov/projectile -;; Package-Version: 20230219.647 -;; Package-Commit: fd257811c46f89f53143dd0ccbc134fc9459d6bb -;; Keywords: project, convenience -;; Version: 2.7.0 -;; Package-Requires: ((emacs "25.1")) - -;; 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) -(require 'lisp-mnt) -(eval-when-compile - (require 'find-dired) - (require 'subr-x)) - -;;; Declarations -;; -;; A bunch of variable and function declarations -;; needed to appease the byte-compiler. -(defvar ido-mode) -(defvar ivy-mode) -(defvar helm-mode) -(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) -(defvar grep-files-aliases) -(defvar grep-find-ignored-directories) -(defvar grep-find-ignored-files) - -(declare-function tags-completion-table "etags") -(declare-function make-term "term") -(declare-function term-mode "term") -(declare-function term-char-mode "term") -(declare-function term-ansi-make-term "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 tramp-archive-file-name-p "tramp-archive") -(declare-function helm-grep-get-file-extensions "helm-grep") - -(declare-function ggtags-ensure-project "ext:ggtags") -(declare-function ggtags-update-tags "ext:ggtags") -(declare-function ripgrep-regexp "ext:ripgrep") -(declare-function rg-run "ext:rg") -(declare-function vterm "ext:vterm") -(declare-function vterm-send-return "ext:vterm") -(declare-function vterm-send-string "ext:vterm") - -;;; 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-discover t - "Whether to discover projects when `projectile-mode' is activated." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.3.0")) - -(defcustom projectile-auto-update-cache t - "Whether cache is automatically 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 'auto - "The completion system to be used by Projectile." - :group 'projectile - :type '(radio - (const :tag "Auto-detect" auto) - (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 - '( - "GTAGS" ; GNU Global tags - "TAGS" ; etags/ctags are usually in the root of project - "configure.ac" ; autoconf new style - "configure.in" ; autoconf old style - "cscope.out" ; cscope - ) - "A list of files considered to mark the root of a project. -The topmost match has precedence. -See `projectile-register-project-type'." - :group 'projectile - :type '(repeat string)) - -(defcustom projectile-project-root-files-bottom-up - '(".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 - ".pijul" ; Pijul 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)) - -(define-obsolete-variable-alias 'projectile-project-root-files-functions 'projectile-project-root-functions "2.4") - -(defcustom projectile-project-root-functions - '(projectile-root-local - projectile-root-marked - projectile-root-bottom-up - projectile-root-top-down - projectile-root-top-down-recurring) - "A list of functions for finding project root folders. -The functions will be ran until one of them returns a project folder. -Reordering the default functions will alter the project discovery -algorithm." - :group 'projectile - :type '(repeat function)) - -(defcustom projectile-dirconfig-file - ".projectile" - "The file which serves both as a project marker and configuration file. -This should _not_ be set via .dir-locals.el." - :group 'projectile - :type 'file - :package-version '(projectile . "2.7.0")) - -(defcustom projectile-dirconfig-comment-prefix - nil - "`projectile-dirconfig-file` comment start marker. -If specified, starting a line in a project's .projectile file with this -character marks that line as a comment instead of a pattern. -Similar to '#' in .gitignore files." - :group 'projectile - :type 'character - :package-version '(projectile . "2.2.0")) - -(defcustom projectile-globally-ignored-files - (list projectile-tags-file-name) - "A list of files globally ignored by projectile. -Note that files aren't filtered if `projectile-indexing-method' -is set to `alien'." - :group 'projectile - :type '(repeat string)) - -(defcustom projectile-globally-unignored-files nil - "A list of files globally unignored by projectile. -Regular expressions can be used. -Note that files aren't filtered if `projectile-indexing-method' -is set to `alien'." - :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. -Note that files aren't filtered if `projectile-indexing-method' -is set to `alien'." - :group 'projectile - :type '(repeat string)) - -(defcustom projectile-globally-ignored-directories - '("^\\.idea$" - "^\\.vscode$" - "^\\.ensime_cache$" - "^\\.eunit$" - "^\\.git$" - "^\\.hg$" - "^\\.fslckout$" - "^_FOSSIL_$" - "^\\.bzr$" - "^_darcs$" - "^\\.pijul$" - "^\\.tox$" - "^\\.svn$" - "^\\.stack-work$" - "^\\.ccls-cache$" - "^\\.cache$" - "^\\.clangd$") - "A list of directories globally ignored by projectile. -Regular expressions can be used. - -Strings that don't start with * are only ignored at the top level -of the project. Strings that start with * are ignored everywhere -in the project, as if there was no *. So note that * when used as -a prefix is not a wildcard; it is an indicator that the directory -should be ignored at all levels, not just root. - -Examples: \"tmp\" ignores only ./tmp at the top level of the -project, but not ./src/tmp. \"*tmp\" will ignore both ./tmp and -./src/tmp, but not ./not-a-tmp or ./src/not-a-tmp. - -Note that files aren't filtered if `projectile-indexing-method' -is set to `alien'." - :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. -Note that files aren't filtered if `projectile-indexing-method' -is set to `alien'." - :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 - '("*scratch*" - "*lsp-log*") - "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")) - -(defcustom projectile-default-src-directory "src/" - "The default value of a project's src-dir property. - -It's used as a fallback in the case the property is not set for a project -type when `projectile-toggle-between-implementation-and-test' is used." - :group 'projectile - :type 'string) - -(defcustom projectile-default-test-directory "test/" - "The default value of a project's test-dir property. - -It's used as a fallback in the case the property is not set for a project -type when `projectile-toggle-between-implementation-and-test' is used." - :group 'projectile - :type 'string) - - -;;; 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 -the variable `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, (~/github . 1) etc. - -For elements of form (DIRECTORY . DEPTH), DIRECTORY has to be a -directory and DEPTH an integer that specifies the depth at which to -look for projects. A DEPTH of 0 means check DIRECTORY. A depth of 1 -means check all the subdirectories of DIRECTORY. Etc." - :group 'projectile - :type '(repeat (choice directory (cons directory (integer :tag "Depth")))) - :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 $displaypath' | 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-pijul-command "pijul list | tr '\\n' '\\0'" - "Command used by projectile to get the files in a pijul 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 - (cond - ;; we prefer fd over find - ;; note that --strip-cwd-prefix is only available in version 8.3.0+ - ((executable-find "fd") - "fd . -0 --type f --color=never --strip-cwd-prefix") - ;; fd's executable is named fdfind is some Linux distros (e.g. Ubuntu) - ((executable-find "fdfind") - "fdfind . -0 --type f --color=never --strip-cwd-prefix") - ;; with find we have to be careful to strip the ./ from the paths - ;; see https://stackoverflow.com/questions/2596462/how-to-strip-leading-in-unix-find - (t "find . -type f | cut -c3- | tr '\\n' '\\0'")) - "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")) - - ;; OCaml extensions - ("ml" . ("mli")) - ("mli" . ("ml" "mll" "mly")) - ("mll" . ("mli")) - ("mly" . ("mli")) - ("eliomi" . ("eliom")) - ("eliom" . ("eliomi")) - - ;; 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-per-project-compilation-buffer nil - "When non-nil, the compilation command makes the per-project compilation buffer." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.6.0")) - -(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))) - -(defcustom projectile-max-file-buffer-count nil - "Maximum number of file buffers per project that are kept open. - -If the value is nil, there is no limit to the opend buffers count." - :group 'projectile - :type 'integer - :package-version '(projectile . "2.2.0")) - -(defvar projectile-project-test-suffix nil - "Use this variable to override the current project's test-suffix property. -It takes precedence over the test-suffix for the project type when set. -Should be set via .dir-locals.el.") - -(defvar projectile-project-test-prefix nil - "Use this variable to override the current project's test-prefix property. -It takes precedence over the test-prefix for the project type when set. -Should be set via .dir-locals.el.") - -(defvar projectile-project-related-files-fn nil - "Use this variable to override the current project's related-files-fn property. -It takes precedence over the related-files-fn attribute for the project type -when set. Should be set via .dir-locals.el.") - -(defvar projectile-project-src-dir nil - "Use this variable to override the current project's src-dir property. -It takes precedence over the src-dir for the project type when set. -Should be set via .dir-locals.el.") - -(defvar projectile-project-test-dir nil - "Use this variable to override the current project's test-dir property. -It takes precedence over the test-dir for the project type when set. -Should be set via .dir-locals.el.") - - -;;; Version information - -(defconst projectile-version "2.7.0" - "The current version of Projectile.") - -(defun projectile--pkg-version () - "Extract Projectile's package version from its package metadata." - ;; Use `cond' below to avoid a compiler unused return value warning - ;; when `package-get-version' returns nil. See #3181. - ;; FIXME: Inline the logic from package-get-version and adapt it - (cond ((fboundp 'package-get-version) - (package-get-version)))) - -;;;###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)) - (let ((version (or (projectile--pkg-version) projectile-version))) - (if show-version - (message "Projectile %s" version) - version))) - -;;; 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 &optional project) - "Infer the buffer name for PROCESS or generate a new one if MAKE-NEW is true. -The function operates on the current project by default, but you can also -specify a project explicitly via the optional PROJECT param." - (let* ((project (or project (projectile-acquire-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'." - (if (file-writable-p filename) - (with-temp-file filename - (insert (let (print-length) (prin1-to-string data)))) - (message "Projectile cache '%s' not writeable" filename))) - -(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-acquire-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." - (if (fboundp 'time-convert) - (time-convert nil 'integer) - (cl-destructuring-bind (high low _usec _psec) (current-time) - (+ (ash 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 &optional depth) - "Discover any projects in DIRECTORY and add them to the projectile cache. - -If DEPTH is non-nil recursively descend exactly DEPTH levels below DIRECTORY and -discover projects there." - (interactive - (list (read-directory-name "Starting directory: "))) - - (if (file-directory-p directory) - (if (and (numberp depth) (> depth 0)) - ;; Ignore errors when listing files in the directory, because - ;; sometimes that directory is an unreadable one at the root of a - ;; volume. This is the case, for example, on macOS with the - ;; .Spotlight-V100 directory. - (let ((progress-reporter - (make-progress-reporter - (format "Projectile is discovering projects in %s..." - (propertize directory 'face 'font-lock-keyword-face))))) - (progress-reporter-update progress-reporter) - (dolist (dir (ignore-errors (directory-files directory t))) - (when (and (file-directory-p dir) - (not (member (file-name-nondirectory dir) '(".." ".")))) - (projectile-discover-projects-in-directory dir (1- depth)))) - (progress-reporter-done progress-reporter)) - (when (projectile-project-p directory) - (let ((dir (abbreviate-file-name (projectile-project-root directory)))) - (unless (member dir projectile-known-projects) - (projectile-add-known-project dir))))) - (message "Project search path directory %s doesn't exist" directory))) - -;;;###autoload -(defun projectile-discover-projects-in-search-path () - "Discover projects in `projectile-project-search-path'. -Invoked automatically when `projectile-mode' is enabled." - (interactive) - (dolist (path projectile-project-search-path) - (if (consp path) - (projectile-discover-projects-in-directory (car path) (cdr path)) - (projectile-discover-projects-in-directory path 1)))) - - -(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 (projectile-expand-file-name-wildcard 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 the variable `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 (projectile-expand-file-name-wildcard f dir))) - (or list projectile-project-root-files))))) - -(defun projectile-root-marked (dir) - "Identify a project root in DIR by search for `projectile-dirconfig-file`." - (projectile-root-bottom-up dir (list projectile-dirconfig-file))) - -(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." - (projectile-locate-dominating-file - dir - (lambda (directory) - (let ((files (mapcar (lambda (file) (expand-file-name file directory)) - (or list projectile-project-root-files-bottom-up)))) - (cl-some (lambda (file) (and file (file-exists-p file))) files))))) - -(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 (projectile-expand-file-name-wildcard f dir)) - (or (string-match locate-dominating-stop-dir-regexp (projectile-parent dir)) - (not (projectile-file-exists-p (projectile-expand-file-name-wildcard 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." - (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)))) - ;; 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 - (cl-subst nil 'none - (or - ;; if we've already failed to find a project dir for this - ;; dir, and cached that failure, don't recompute - (let* ((cache-key (format "projectilerootless-%s" dir)) - (cache-value (gethash cache-key projectile-project-root-cache))) - cache-value) - ;; if the file isn't local, and we're not connected, don't try to - ;; find a root now now, but don't cache failure, as we might - ;; re-connect. 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. - (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 - (unless (or is-local is-connected) - 'none)) - ;; if the file is local or we're connected to it via TRAMP, run - ;; through the project root functions until we find a project dir - (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-functions) - ;; if we get here, we have failed to find a root by all - ;; conventional means, and we assume the failure isn't transient - ;; / network related, so cache the failure - (let ((cache-key (format "projectilerootless-%s" dir))) - (puthash cache-key 'none projectile-project-root-cache) - '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'. - -See also `projectile-acquire-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 cannot find a project definition in %s" default-directory)) - (t default-directory)))) - -(defun projectile-acquire-root (&optional dir) - "Find the current project root, and prompts the user for it if that fails. -Provides the common idiom (projectile-ensure-project (projectile-project-root)). -Starts the search for the project with DIR." - (projectile-ensure-project (projectile-project-root dir))) - -(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 to create the project name. -The project name is 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 &optional ignored-files ignored-directories globally-ignored-directories) - "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. The list of IGNORED-FILES and -IGNORED-DIRECTORIES may optionally be provided." - ;; we compute the ignored files and directories only once and then we reuse the - ;; pre-computed values in the subsequent recursive invocations of the function - (let ((ignored-files (or ignored-files (projectile-ignored-files))) - (ignored-directories (or ignored-directories (projectile-ignored-directories))) - (globally-ignored-directories (or globally-ignored-directories (projectile-globally-ignored-directory-names)))) - (apply #'append - (mapcar - (lambda (f) - (let ((local-f (file-name-nondirectory (directory-file-name f)))) - (unless (or (and patterns (projectile-ignored-rel-p f directory patterns)) - (member local-f '("." ".."))) - (progress-reporter-update progress-reporter) - (if (file-directory-p f) - (unless (projectile-ignored-directory-p - (file-name-as-directory f) - ignored-directories - local-f - globally-ignored-directories) - (projectile-index-directory f patterns progress-reporter ignored-files ignored-directories globally-ignored-directories)) - (unless (projectile-ignored-file-p f ignored-files) - (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) - ('pijul projectile-pijul-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. - -Only text sent to standard output is taken into account." - (when (stringp command) - (let ((default-directory root)) - (with-temp-buffer - (shell-command command t "*projectile-files-errors*") - (let ((shell-output (buffer-substring (point-min) (point-max)))) - (split-string (string-trim shell-output) "\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-acquire-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-process-current-project-buffers-current (action) - "Invoke ACTION on every project buffer with that buffer current. -ACTION is called without arguments." - (let ((project-buffers (projectile-project-buffers))) - (dolist (buffer project-buffers) - (with-current-buffer buffer - (funcall action))))) - -(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 - (let ((directory (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory))) - (and (not (string-prefix-p " " (buffer-name buffer))) - (not (projectile-ignored-buffer-p buffer)) - directory - (string-equal (file-remote-p directory) - (file-remote-p project-root)) - (not (string-match-p "^http\\(s\\)?://" directory)) - (string-prefix-p project-root (file-truename 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 frame." - (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-acquire-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 &optional ignored-directories local-directory globally-ignored-directories) - "Check if DIRECTORY should be ignored. - -Regular expressions can be used. Pre-computed lists of -IGNORED-DIRECTORIES and GLOBALLY-IGNORED-DIRECTORIES -and the LOCAL-DIRECTORY name may optionally be provided." - (let ((ignored-directories (or ignored-directories (projectile-ignored-directories))) - (globally-ignored-directories (or globally-ignored-directories (projectile-globally-ignored-directory-names))) - (local-directory (or local-directory (file-name-nondirectory (directory-file-name directory))))) - (or (cl-some - (lambda (name) - (string-match-p name directory)) - ignored-directories) - (cl-some - (lambda (name) - (string-match-p name local-directory)) - globally-ignored-directories)))) - -(defun projectile-ignored-file-p (file &optional ignored-files) - "Check if FILE should be ignored. - -Regular expressions can be used. A pre-computed list of -IGNORED-FILES may optionally be provided." - (cl-some - (lambda (name) - (string-match-p name file)) - (or ignored-files (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. -PATTERNS should have the form: (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-globally-ignored-directory-names () - "Return list of ignored directory names." - (projectile-difference - projectile-globally-ignored-directories - projectile-globally-unignored-directories)) - -(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-dirconfig-file (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) - ;; ignore comment lines if prefix char has been set - ((pred (lambda (leading-char) - (and projectile-dirconfig-comment-prefix - (eql leading-char - projectile-dirconfig-comment-prefix)))) - nil) - (?+ (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 &optional dir) - "Expand NAME to project root. -When DIR is specified it uses DIR's project, otherwise it acts -on the current project. - -Never use on many files since it's going to recalculate the -project-root for every file." - (expand-file-name name (projectile-project-root dir))) - -(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 - (pcase (if (eq projectile-completion-system 'auto) - (cond - ((bound-and-true-p ido-mode) 'ido) - ((bound-and-true-p helm-mode) 'helm) - ((bound-and-true-p ivy-mode) 'ivy) - (t 'default)) - projectile-completion-system) - ('default (completing-read prompt choices nil nil initial-input)) - ('ido (ido-completing-read prompt choices nil nil initial-input)) - ('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"))) - ('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"))) - (_ (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-acquire-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-acquire-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 different extensions in other window. -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 different extensions in other frame. -Switch between files with the same name but different extensions in other frame. -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-acquire-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-acquire-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-acquire-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"))))) - -;;;###autoload -(defun projectile-add-dir-local-variable (mode variable value) - "Run `add-dir-local-variable' with .dir-locals.el in root of project. - -Parameters MODE VARIABLE VALUE are passed directly to `add-dir-local-variable'." - (let ((inhibit-read-only t) - (default-directory (projectile-acquire-root))) - (add-dir-local-variable mode variable value) - (save-buffer) - (kill-buffer))) - -;;;###autoload -(defun projectile-delete-dir-local-variable (mode variable) - "Run `delete-dir-local-variable' with .dir-locals.el in root of project. - -Parameters MODE VARIABLE VALUE are passed directly to -`delete-dir-local-variable'." - (let ((inhibit-read-only t) - (default-directory (projectile-acquire-root))) - (delete-dir-local-variable mode variable) - (save-buffer) - (kill-buffer))) - - -;;;; 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-acquire-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 frame 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. -PROJECT-ROOT is the 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 (projectile-expand-file-name-wildcard 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. -Use 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. -Use 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.") - -(defun projectile--combine-plists (&rest plists) - "Create a single property list from all plists in PLISTS. -The process starts by copying the first list, and then setting properties -from the other lists. Settings in the last list are the most significant -ones and overrule settings in the other lists." - (let ((rtn (copy-sequence (pop plists))) - p v ls) - (while plists - (setq ls (pop plists)) - (while ls - (setq p (pop ls) v (pop ls)) - (setq rtn (plist-put rtn p v)))) - rtn)) - -(cl-defun projectile--build-project-plist - (marker-files &key project-file compilation-dir configure compile install package test run test-suffix test-prefix src-dir test-dir related-files-fn) - "Return a project type plist with the provided arguments. - -A project type is defined by PROJECT-TYPE, a set of MARKER-FILES, -and optional keyword arguments: -PROJECT-FILE the main project file in the root project directory. -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, -INSTALL which specifies a command to install the project. -PACKAGE which specifies a command to package 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 - 'project-file project-file - 'compilation-dir compilation-dir - 'configure-command configure - 'compile-command compile - 'test-command test - 'install-command install - 'package-command package - 'run-command run)) - (project-files (if (listp project-file) - project-file - (list project-file)))) - (dolist (project-file project-files) - (when (and project-file (not (member project-file projectile-project-root-files))) - (add-to-list 'projectile-project-root-files project-file))) - (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)) - project-plist)) - -(cl-defun projectile-register-project-type - (project-type marker-files &key project-file compilation-dir configure compile install package 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: -PROJECT-FILE the main project file in the root project directory. -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, -INSTALL which specifies a command to install the project. -PACKAGE which specifies a command to package 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." - (setq projectile-project-types - (cons `(,project-type . - ,(projectile--build-project-plist - marker-files - :project-file project-file - :compilation-dir compilation-dir - :configure configure - :compile compile - :install install - :package package - :test test - :run run - :test-suffix test-suffix - :test-prefix test-prefix - :src-dir src-dir - :test-dir test-dir - :related-files-fn related-files-fn)) - projectile-project-types))) - -(cl-defun projectile-update-project-type - (project-type - &key precedence - (marker-files nil marker-files-specified) - (project-file nil project-file-specified) - (compilation-dir nil compilation-dir-specified) - (configure nil configure-specified) - (compile nil compile-specified) - (install nil install-specified) - (package nil package-specified) - (test nil test-specified) - (run nil run-specified) - (test-suffix nil test-suffix-specified) - (test-prefix nil test-prefix-specified) - (src-dir nil src-dir-specified) - (test-dir nil test-dir-specified) - (related-files-fn nil related-files-fn-specified)) - "Update an existing projectile project type. - -Passed items will override existing values for the project type given -by PROJECT-TYPE. nil can be used to remove a project type attribute. Raise -an error if PROJECT-TYPE is not already registered with projectile. This -function may also take the keyword argument PRECEDENCE which when set to ‘high’ -will make projectile prioritise this project type over other clashing project -types, and a value of ‘low’ will make projectile prefer (all) other project -types by default. Otherwise, the arguments to this function are as for -`projectile-register-project-type': - -A project type is defined by PROJECT-TYPE, a set of MARKER-FILES, -and optional keyword arguments: -MARKER-FILES a set of indicator files for PROJECT-TYPE. -PROJECT-FILE the main project file in the root project directory. -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, -INSTALL which specifies a command to install the project. -PACKAGE which specifies a command to package 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* ((existing-project-plist - (or (cl-find-if - (lambda (p) (eq project-type (car p))) projectile-project-types) - (error "No existing project found for: %s" project-type))) - (new-plist - (append - (when marker-files-specified `(marker-files ,marker-files)) - (when project-file-specified `(project-file ,project-file)) - (when compilation-dir-specified `(compilation-dir ,compilation-dir)) - (when configure-specified `(configure-command ,configure)) - (when compile-specified `(compile-command ,compile)) - (when test-specified `(test-command ,test)) - (when install-specified `(install-command ,install)) - (when package-specified `(package-command ,package)) - (when run-specified `(run-command ,run)) - (when test-suffix-specified `(test-suffix ,test-suffix)) - (when test-prefix-specified `(test-prefix ,test-prefix)) - (when src-dir-specified `(src-dir ,src-dir)) - (when test-dir-specified `(test-dir ,test-dir)) - (when related-files-fn-specified - `(related-files-fn ,related-files-fn)))) - (merged-plist - (projectile--combine-plists - (cdr existing-project-plist) new-plist)) - (project-type-elt (cons project-type merged-plist))) - (cl-flet* ((project-filter (p) (eq project-type (car p))) - (project-map (p) (if (project-filter p) project-type-elt p))) - (setq projectile-project-types - (if precedence - (let ((filtered-types - (cl-remove-if #'project-filter projectile-project-types))) - (setq projectile-project-type-cache (make-hash-table)) - (cond ((eq precedence 'high) - (cons project-type-elt filtered-types)) - ((eq precedence 'low) - (append filtered-types (list project-type-elt))) - (t (error "Precedence must be one of '(high low)")))) - (mapcar #'project-map projectile-project-types)))))) - -(defun projectile-eldev-project-p (&optional dir) - "Check if a project contains eldev files. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project." - (or (projectile-verify-file "Eldev" dir) - (projectile-verify-file "Eldev-local" dir))) - -(defun projectile-expand-file-name-wildcard (name-pattern dir) - "Expand the maybe-wildcard-containing NAME-PATTERN in DIR. -If there are results expanding a wildcard, get the first result, -otherwise expand NAME-PATTERN in DIR ignoring wildcards." - (let ((expanded (expand-file-name name-pattern dir))) - (or (if (string-match-p "[[*?]" name-pattern) - (car - (file-expand-wildcards expanded))) - expanded))) - -(defun projectile-cabal-project-p (&optional dir) - "Check if a project contains *.cabal files but no stack.yaml file. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project." - (and (projectile-verify-file-wildcard "?*.cabal" dir) - (not (projectile-verify-file "stack.yaml" dir)))) - -(defun projectile-dotnet-project-p (&optional dir) - "Check if a project contains a .NET project marker. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project." - (or (projectile-verify-file-wildcard "?*.csproj" dir) - (projectile-verify-file-wildcard "?*.fsproj" dir))) - -(defun projectile-go-project-p (&optional dir) - "Check if a project contains Go source files. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project." - (or (projectile-verify-file "go.mod" dir) - (projectile-verify-file-wildcard "*.go" dir))) - -(defcustom projectile-go-project-test-function #'projectile-go-project-p - "Function to determine if project's type is go." - :group 'projectile - :type 'function - :package-version '(projectile . "1.0.0")) - -;;;; Constant signifying opting out of CMake preset commands. -(defconst projectile--cmake-no-preset "*no preset*") - -(defun projectile--cmake-version () - "Compute CMake version." - (let* ((string (shell-command-to-string "cmake --version")) - (match (string-match "^cmake version \\(.*\\)$" string))) - (when match - (version-to-list (match-string 1 string))))) - -(defun projectile--cmake-check-version (version) - "Check if CMake version is at least VERSION." - (and - (version-list-<= version (projectile--cmake-version)))) - -(defconst projectile--cmake-command-presets-minimum-version-alist - '((:configure-command . (3 19)) - (:compile-command . (3 20)) - (:test-command . (3 20)) - (:install-command . (3 20)))) - -(defun projectile--cmake-command-presets-supported (command-type) - "Check if CMake supports presets for COMMAND-TYPE." - (let ((minimum-version - (cdr (assoc command-type projectile--cmake-command-presets-minimum-version-alist)))) - (projectile--cmake-check-version minimum-version))) - -(defun projectile--cmake-read-preset (filename) - "Read CMake preset from FILENAME." - (when (file-exists-p filename) - (with-temp-buffer - (insert-file-contents filename) - (when (functionp 'json-parse-buffer) - (json-parse-buffer :array-type 'list))))) - -(defconst projectile--cmake-command-preset-array-id-alist - '((:configure-command . "configurePresets") - (:compile-command . "buildPresets") - (:test-command . "testPresets") - (:install-command . "buildPresets"))) - -(defun projectile--cmake-command-preset-array-id (command-type) - "Map from COMMAND-TYPE to id of command preset array in CMake preset." - (cdr (assoc command-type projectile--cmake-command-preset-array-id-alist))) - -(defun projectile--cmake-command-presets (filename command-type) - "Get CMake COMMAND-TYPE presets from FILENAME." - (when-let ((preset (projectile--cmake-read-preset (projectile-expand-root filename)))) - (cl-remove-if - (lambda (preset) (equal (gethash "hidden" preset) t)) - (gethash (projectile--cmake-command-preset-array-id command-type) preset)))) - -(defun projectile--cmake-all-command-presets (command-type) - "Get CMake user and system COMMAND-TYPE presets." - (projectile-flatten - (mapcar (lambda (filename) (projectile--cmake-command-presets filename command-type)) - '("CMakeUserPresets.json" "CMakePresets.json")))) - -(defun projectile--cmake-command-preset-names (command-type) - "Get names of CMake user and system COMMAND-TYPE presets." - (mapcar (lambda (preset) - (gethash "name" preset)) - (projectile--cmake-all-command-presets command-type))) - -(defcustom projectile-enable-cmake-presets nil - "Enables configuration with CMake presets. - -When `projectile-enable-cmake-presets' is non-nil, CMake projects can -be configured, built and tested using presets." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.4.0")) - -(defun projectile--cmake-use-command-presets (command-type) - "Test whether or not to use command presets for COMMAND-TYPE. - -Presets are used if `projectile-enable-cmake-presets' is non-nil, and CMake -supports presets for COMMAND-TYPE, and `json-parse-buffer' is available." - (and projectile-enable-cmake-presets - (projectile--cmake-command-presets-supported command-type) - (functionp 'json-parse-buffer))) - -(defun projectile--cmake-select-command (command-type) - "Select a CMake command preset or a manual CMake command. - -The selection is done like this: - -- If `projectile--cmake-use-commands-presets' for COMMAND-TYPE returns true, and -there is at least one preset available for COMMAND-TYPE, the user is prompted to -select a name of a command preset, or opt a manual command by selecting -`projectile--cmake-no-preset'. - -- Else `projectile--cmake-no-preset' is used." - (if-let ((use-presets (projectile--cmake-use-command-presets command-type)) - (preset-names (projectile--cmake-command-preset-names command-type))) - (projectile-completing-read - "Use preset: " - (append preset-names `(,projectile--cmake-no-preset))) - projectile--cmake-no-preset)) - -(defconst projectile--cmake-manual-command-alist - '((:configure-command . "cmake -S . -B build") - (:compile-command . "cmake --build build") - (:test-command . "cmake --build build --target test") - (:install-command . "cmake --build build --target install"))) - -(defun projectile--cmake-manual-command (command-type) - "Create maunual CMake COMMAND-TYPE command." - (cdr (assoc command-type projectile--cmake-manual-command-alist))) - -(defconst projectile--cmake-preset-command-alist - '((:configure-command . "cmake . --preset %s") - (:compile-command . "cmake --build --preset %s") - (:test-command . "ctest --preset %s") - (:install-command . "cmake --build --preset %s --target install"))) - -(defun projectile--cmake-preset-command (command-type preset) - "Create CMake COMMAND-TYPE command using PRESET." - (format (cdr (assoc command-type projectile--cmake-preset-command-alist)) preset)) - -(defun projectile--cmake-command (command-type) - "Create a CMake COMMAND-TYPE command. - -The command is created like this: - -- If `projectile--cmake-select-command' returns `projectile--cmake-no-preset' -a manual COMMAND-TYPE command is created with -`projectile--cmake-manual-command'. - -- Else a preset COMMAND-TYPE command using the selected preset is created with -`projectile--cmake-preset-command'." - (let ((maybe-preset (projectile--cmake-select-command command-type))) - (if (equal maybe-preset projectile--cmake-no-preset) - (projectile--cmake-manual-command command-type) - (projectile--cmake-preset-command command-type maybe-preset)))) - -(defun projectile--cmake-configure-command () - "CMake configure command." - (projectile--cmake-command :configure-command)) - -(defun projectile--cmake-compile-command () - "CMake compile command." - (projectile--cmake-command :compile-command)) - -(defun projectile--cmake-test-command () - "CMake test command." - (projectile--cmake-command :test-command)) - -(defun projectile--cmake-install-command () - "CMake install command." - (projectile--cmake-command :install-command)) - -;;; 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 - :project-file '("?*.csproj" "?*.fsproj") - :compile "dotnet build" - :run "dotnet run" - :test "dotnet test") -(projectile-register-project-type 'dotnet-sln '("src") - :project-file "?*.sln" - :compile "dotnet build" - :run "dotnet run" - :test "dotnet test") -;; File-based detection project types - -;; Universal -(projectile-register-project-type 'scons '("SConstruct") - :project-file "SConstruct" - :compile "scons" - :test "scons test" - :test-suffix "test") -(projectile-register-project-type 'meson '("meson.build") - :project-file "meson.build" - :compilation-dir "build" - :configure "meson %s" - :compile "ninja" - :test "ninja test") -(projectile-register-project-type 'nix '("default.nix") - :project-file "default.nix" - :compile "nix-build" - :test "nix-build") -(projectile-register-project-type 'nix-flake '("flake.nix") - :project-file "flake.nix" - :compile "nix build" - :test "nix flake check" - :run "nix run") -(projectile-register-project-type 'bazel '("WORKSPACE") - :project-file "WORKSPACE" - :compile "bazel build" - :test "bazel test" - :run "bazel run") -(projectile-register-project-type 'debian '("debian/control") - :project-file "debian/control" - :compile "debuild -uc -us") - -;; Make & CMake -(projectile-register-project-type 'make '("Makefile") - :project-file "Makefile" - :compile "make" - :test "make test" - :install "make install") -(projectile-register-project-type 'gnumake '("GNUMakefile") - :project-file "GNUMakefile" - :compile "make" - :test "make test" - :install "make install") -(projectile-register-project-type 'cmake '("CMakeLists.txt") - :project-file "CMakeLists.txt" - :configure #'projectile--cmake-configure-command - :compile #'projectile--cmake-compile-command - :test #'projectile--cmake-test-command - :install #'projectile--cmake-install-command - :package "cmake --build build --target package") -;; go-task/task -(projectile-register-project-type 'go-task '("Taskfile.yml") - :project-file "Taskfile.yml" - :compile "task build" - :test "task test" - :install "task install") -;; Go should take higher precedence than Make because Go projects often have a Makefile. -(projectile-register-project-type 'go projectile-go-project-test-function - :compile "go build" - :test "go test ./..." - :test-suffix "_test") -;; PHP -(projectile-register-project-type 'php-symfony '("composer.json" "app" "src" "vendor") - :project-file "composer.json" - :compile "app/console server:run" - :test "phpunit -c app " - :test-suffix "Test") -;; Erlang & Elixir -(projectile-register-project-type 'rebar '("rebar.config") - :project-file "rebar.config" - :compile "rebar3 compile" - :test "rebar3 do eunit,ct" - :test-suffix "_SUITE") -(projectile-register-project-type 'elixir '("mix.exs") - :project-file "mix.exs" - :compile "mix compile" - :src-dir "lib/" - :test "mix test" - :test-suffix "_test") -;; JavaScript -(projectile-register-project-type 'grunt '("Gruntfile.js") - :project-file "Gruntfile.js" - :compile "grunt" - :test "grunt test") -(projectile-register-project-type 'gulp '("gulpfile.js") - :project-file "gulpfile.js" - :compile "gulp" - :test "gulp test") -(projectile-register-project-type 'npm '("package.json") - :project-file "package.json" - :compile "npm install" - :test "npm test" - :test-suffix ".test") -;; Angular -(projectile-register-project-type 'angular '("angular.json" ".angular-cli.json") - :project-file "angular.json" - :compile "ng build" - :run "ng serve" - :test "ng test" - :test-suffix ".spec") -;; Python -(projectile-register-project-type 'django '("manage.py") - :project-file "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") - :project-file "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") - :project-file "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") - :project-file "tox.ini" - :compile "tox -r --notest" - :test "tox" - :test-prefix "test_" - :test-suffix"_test") -(projectile-register-project-type 'python-pipenv '("Pipfile") - :project-file "Pipfile" - :compile "pipenv run build" - :test "pipenv run test" - :test-prefix "test_" - :test-suffix "_test") -(projectile-register-project-type 'python-poetry '("poetry.lock") - :project-file "poetry.lock" - :compile "poetry build" - :test "poetry run python -m unittest discover" - :test-prefix "test_" - :test-suffix "_test") -(projectile-register-project-type 'python-toml '("pyproject.toml") - :project-file "pyproject.toml" - :compile "python -m build" - :test "python -m unittest discover" - :test-prefix "test_" - :test-suffix "_test") -;; Java & friends -(projectile-register-project-type 'maven '("pom.xml") - :project-file "pom.xml" - :compile "mvn -B clean install" - :test "mvn -B test" - :test-suffix "Test" - :src-dir "src/main/" - :test-dir "src/test/") -(projectile-register-project-type 'gradle '("build.gradle") - :project-file "build.gradle" - :compile "gradle build" - :test "gradle test" - :test-suffix "Spec") -(projectile-register-project-type 'gradlew '("gradlew") - :project-file "gradlew" - :compile "./gradlew build" - :test "./gradlew test" - :test-suffix "Spec") -(projectile-register-project-type 'grails '("application.yml" "grails-app") - :project-file "application.yml" - :compile "grails package" - :test "grails test-app" - :test-suffix "Spec") -;; Scala -(projectile-register-project-type 'sbt '("build.sbt") - :project-file "build.sbt" - :src-dir "main" - :test-dir "test" - :compile "sbt compile" - :test "sbt test" - :test-suffix "Spec") - -(projectile-register-project-type 'mill '("build.sc") - :project-file "build.sc" - :src-dir "src/" - :test-dir "test/src/" - :compile "mill all __.compile" - :test "mill all __.test" - :test-suffix "Test") - -;; Clojure -(projectile-register-project-type 'lein-test '("project.clj") - :project-file "project.clj" - :compile "lein compile" - :test "lein test" - :test-suffix "_test") -(projectile-register-project-type 'lein-midje '("project.clj" ".midje.clj") - :project-file "project.clj" - :compile "lein compile" - :test "lein midje" - :test-prefix "t_") -(projectile-register-project-type 'boot-clj '("build.boot") - :project-file "build.boot" - :compile "boot aot" - :test "boot test" - :test-suffix "_test") -(projectile-register-project-type 'clojure-cli '("deps.edn") - :project-file "deps.edn" - :test-suffix "_test") -(projectile-register-project-type 'bloop '(".bloop") - :project-file ".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") - :project-file "Gemfile" - :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") - :project-file "Gemfile" - :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") - :project-file "Gemfile" - :compile "bundle exec rails server" - :src-dir "app/" - :test "bundle exec rake test" - :test-suffix "_test") -(projectile-register-project-type 'rails-rspec '("Gemfile" "app" "lib" "db" "config" "spec") - :project-file "Gemfile" - :compile "bundle exec rails server" - :src-dir "app/" - :test "bundle exec rspec" - :test-dir "spec/" - :test-suffix "_spec") -;; Crystal -(projectile-register-project-type 'crystal-spec '("shard.yml") - :project-file "shard.yml" - :src-dir "src/" - :test "crystal spec" - :test-dir "spec/" - :test-suffix "_spec") - -;; Emacs -(projectile-register-project-type 'emacs-cask '("Cask") - :project-file "Cask" - :compile "cask install" - :test-prefix "test-" - :test-suffix "-test") -(projectile-register-project-type 'emacs-eldev #'projectile-eldev-project-p - :project-file "Eldev" - :compile "eldev compile" - :test "eldev test" - :run "eldev emacs" - :package "eldev package") - -;; R -(projectile-register-project-type 'r '("DESCRIPTION") - :project-file "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") - :project-file "stack.yaml" - :compile "stack build" - :test "stack build --test" - :test-suffix "Spec") - -;; Rust -(projectile-register-project-type 'rust-cargo '("Cargo.toml") - :project-file "Cargo.toml" - :compile "cargo build" - :test "cargo test" - :run "cargo run") - -;; Racket -(projectile-register-project-type 'racket '("info.rkt") - :project-file "info.rkt" - :test "raco test ." - :install "raco pkg install" - :package "raco pkg create --source $(pwd)") - -;; Dart -(projectile-register-project-type 'dart '("pubspec.yaml") - :project-file "pubspec.yaml" - :compile "pub get" - :test "pub run test" - :run "dart" - :test-suffix "_test.dart") - -;; Elm -(projectile-register-project-type 'elm '("elm.json") - :project-file "elm.json" - :compile "elm make") - -;; OCaml -(projectile-register-project-type 'ocaml-dune '("dune-project") - :project-file "dune-project" - :compile "dune build" - :test "dune runtest") - -(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 (&optional dir) - "Detect the type of the project. -When DIR is specified it detects its project type, otherwise it acts -on 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 (functionp marker) - (and (funcall marker dir) project-type) - (and (projectile-verify-files marker dir) project-type)))) - projectile-project-types)) - 'generic))) - (puthash (projectile-project-root dir) 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." - (or (and (not dir) projectile-project-type) - (if-let ((project-root (projectile-project-root dir))) - (or (gethash project-root projectile-project-type-cache) - (projectile-detect-project-type dir))))) - -;;;###autoload -(defun projectile-project-info () - "Display info for current project." - (interactive) - (message "Project dir: %s ## Project VCS: %s ## Project type: %s" - (projectile-acquire-root) - (projectile-project-vcs) - (projectile-project-type))) - -(defun projectile-verify-files (files &optional dir) - "Check whether all FILES exist in the project. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project." - (cl-every #'(lambda (file) (projectile-verify-file file dir)) files)) - -(defun projectile-verify-file (file &optional dir) - "Check whether FILE exists in the current project. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project." - (file-exists-p (projectile-expand-root file dir))) - -(defun projectile-verify-file-wildcard (file &optional dir) - "Check whether FILE exists in the current project. -When DIR is specified it checks DIR's project, otherwise -it acts on the current project. -Expands wildcards using `file-expand-wildcards' before checking." - (file-expand-wildcards (projectile-expand-root file dir))) - -(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 -the variable `projectile-project-root'." - (or project-root (setq project-root (projectile-acquire-root))) - (cond - ;; first we check for a VCS marker in the project root itself - ((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 ".pijul" project-root)) 'pijul) - ((projectile-file-exists-p (expand-file-name ".svn" project-root)) 'svn) - ;; then we check if there's a VCS marker up the directory tree - ;; that covers the case when a project is part of a multi-project repository - ;; in those cases you can still the VCS to get a list of files for - ;; the project in question - ((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 ".pijul") 'pijul) - ((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. - -IMPL-FILE-PATH may be a absolute path, relative path or a file name." - (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 "Cannot determine a test file name, one of \"test-suffix\" or \"test-prefix\" must be set for project type `%s'" project-type))))) - -(defun projectile--impl-name-for-test-name (test-file-path) - "Determine the name of the implementation file for TEST-FILE-PATH. - -TEST-FILE-PATH may be a absolute path, relative path or a file name." - (let* ((project-type (projectile-project-type)) - (test-file-name (file-name-sans-extension (file-name-nondirectory test-file-path))) - (test-file-ext (file-name-extension test-file-path)) - (test-prefix (funcall projectile-test-prefix-function project-type)) - (test-suffix (funcall projectile-test-suffix-function project-type))) - (cond - (test-prefix - (concat (string-remove-prefix test-prefix test-file-name) "." test-file-ext)) - (test-suffix - (concat (string-remove-suffix test-suffix test-file-name) "." test-file-ext)) - (t (error "Cannot determine an implementation file name, one of \"test-suffix\" or \"test-prefix\" must be set for project type `%s'" project-type))))) - -(defun projectile--test-to-impl-dir (test-dir-path) - "Return the directory path of an impl file with test file in TEST-DIR-PATH. - -Occurrences of the current project type's test-dir property (which should be a -string) are replaced with the current project type's src-dir property - (which should be a string) to obtain the new directory. - -Nil is returned if either the src-dir or test-dir properties are not strings." - (let* ((project-type (projectile-project-type)) - (test-dir (projectile-project-type-attribute project-type 'test-dir)) - (impl-dir (projectile-project-type-attribute project-type 'src-dir))) - (when (and (stringp test-dir) (stringp impl-dir)) - (if (not (string-match-p test-dir (file-name-directory test-dir-path))) - (error "Attempted to find a implementation file by switching this project type's (%s) test-dir property \"%s\" with this project type's src-dir property \"%s\", but %s does not contain \"%s\"" - project-type test-dir impl-dir test-dir-path test-dir) - (projectile-complementary-dir test-dir-path test-dir impl-dir))))) - -(defun projectile--impl-to-test-dir-fallback (impl-dir-path) - "Return the test file for IMPL-DIR-PATH by guessing a test directory. - -Occurrences of the `projectile-default-src-directory' in the directory of -IMPL-DIR-PATH are replaced with `projectile-default-test-directory'. Nil is -returned if `projectile-default-src-directory' is not a substring of -IMPL-DIR-PATH." - (when-let ((file (projectile--complementary-file - impl-dir-path - (lambda (f) - (when (string-match-p projectile-default-src-directory f) - (projectile-complementary-dir - impl-dir-path - projectile-default-src-directory - projectile-default-test-directory))) - #'projectile--test-name-for-impl-name))) - (file-relative-name file (projectile-project-root)))) - -(defun projectile--test-to-impl-dir-fallback (test-dir-path) - "Return the impl file for TEST-DIR-PATH by guessing a source directory. - -Occurrences of `projectile-default-test-directory' in the directory of -TEST-DIR-PATH are replaced with `projectile-default-src-directory'. Nil is -returned if `projectile-default-test-directory' is not a substring of -TEST-DIR-PATH." - (when-let ((file (projectile--complementary-file - test-dir-path - (lambda (f) - (when (string-match-p projectile-default-test-directory f) - (projectile-complementary-dir - test-dir-path - projectile-default-test-directory - projectile-default-src-directory))) - #'projectile--impl-name-for-test-name))) - (file-relative-name file (projectile-project-root)))) - -(defun projectile--impl-to-test-dir (impl-dir-path) - "Return the directory path of a test whose impl file resides in IMPL-DIR-PATH. - -Occurrences of the current project type's src-dir property (which should be a -string) are replaced with the current project type's test-dir property - (which should be a string) to obtain the new directory. - -If the src-dir property is set and IMPL-DIR-PATH does not contain (as a -substring) the src-dir property of the current project type, an error is -signalled. - -Nil is returned if either the src-dir or test-dir properties are not strings." - (let* ((project-type (projectile-project-type)) - (test-dir (projectile-project-type-attribute project-type 'test-dir)) - (impl-dir (projectile-project-type-attribute project-type 'src-dir))) - (when (and (stringp test-dir) (stringp impl-dir)) - (if (not (string-match-p impl-dir (file-name-directory impl-dir-path))) - (error "Attempted to find a test file by switching this project type's (%s) src-dir property \"%s\" with this project type's test-dir property \"%s\", but %s does not contain \"%s\"" - project-type impl-dir test-dir impl-dir-path impl-dir) - (projectile-complementary-dir impl-dir-path impl-dir test-dir))))) - -(defun projectile-complementary-dir (dir-path string replacement) - "Return the \"complementary\" directory of DIR-PATH. -Replace STRING in DIR-PATH with REPLACEMENT." - (let* ((project-root (projectile-project-root)) - (relative-dir (file-name-directory (file-relative-name dir-path project-root)))) - (projectile-expand-root - (replace-regexp-in-string string replacement relative-dir)))) - -(defun projectile--create-directories-for (path) - "Create directories necessary for PATH." - (unless (file-exists-p path) - (make-directory (if (file-directory-p path) - path - (file-name-directory path)) - :create-parents))) - -(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")) - (unless (projectile-project-type) (projectile-ensure-project nil)) - (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* ((error-msg (format - "No matching test file found for project type `%s'" - (projectile-project-type))) - (test-file (or (projectile-find-matching-test file-name) - (error error-msg))) - (expanded-test-file (projectile-expand-root test-file))) - (cond ((file-exists-p expanded-test-file) expanded-test-file) - (projectile-create-missing-test-files - (projectile--create-directories-for expanded-test-file) - expanded-test-file) - (t (error "Determined test file to be \"%s\", which does not exist. Set `projectile-create-missing-test-files' to allow `projectile-find-implementation-or-test' to create new files" test-file)))))) - -;;;###autoload -(defun projectile-find-implementation-or-test-other-window () - "Open matching implementation or test file in other window. - -See the documentation of `projectile--find-matching-file' and -`projectile--find-matching-test' for how implementation and test files -are determined." - (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. - -See the documentation of `projectile--find-matching-file' and -`projectile--find-matching-test' for how implementation and test files -are determined." - (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. - - -See the documentation of `projectile--find-matching-file' and -`projectile--find-matching-test' for how implementation and test files -are determined." - (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." - (or projectile-project-test-prefix - (projectile-project-type-attribute project-type 'test-prefix))) - -(defun projectile-test-suffix (project-type) - "Find default test files suffix based on PROJECT-TYPE." - (or projectile-project-test-suffix - (projectile-project-type-attribute project-type 'test-suffix))) - -(defun projectile-related-files-fn (project-type) - "Find relative file based on PROJECT-TYPE." - (or projectile-project-related-files-fn - (projectile-project-type-attribute project-type 'related-files-fn))) - -(defun projectile-src-directory (project-type) - "Find default src directory based on PROJECT-TYPE." - (or projectile-project-src-dir - (projectile-project-type-attribute - project-type 'src-dir projectile-default-src-directory))) - -(defun projectile-test-directory (project-type) - "Find default test directory based on PROJECT-TYPE." - (or projectile-project-test-dir - (projectile-project-type-attribute - project-type 'test-dir projectile-default-test-directory))) - -(defun projectile-dirname-matching-count (a b) - "Count matching dirnames ascending file paths in A and B." - (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 of 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--complementary-file (file-path dir-fn filename-fn) - "Apply DIR-FN and FILENAME-FN to the directory and name of FILE-PATH. - -More specifically, return DIR-FN applied to the directory of FILE-PATH -concatenated with FILENAME-FN applied to the file name of FILE-PATH. - -If either function returns nil, return nil." - (let ((filename (file-name-nondirectory file-path))) - (when-let ((complementary-filename (funcall filename-fn filename)) - (dir (funcall dir-fn (file-name-directory file-path)))) - (concat (file-name-as-directory dir) complementary-filename)))) - -(defun projectile--impl-file-from-src-dir-str (file-name) - "Get the relative path of the implementation file FILE-NAME. -Return a path relative to the project root for the impl file of FILE-NAME -using the src-dir and test-dir properties of the current project type which -should be strings, nil returned if this is not the case." - (when-let ((complementary-file (projectile--complementary-file - file-name - #'projectile--test-to-impl-dir - #'projectile--impl-name-for-test-name))) - (file-relative-name complementary-file (projectile-project-root)))) - -(defun projectile--test-file-from-test-dir-str (file-name) - "Get the relative path of the test file FILE-NAME. -Return a path relative to the project root for the test file of FILE-NAME -using the src-dir and test-dir properties of the current project type which -should be strings, nil returned if this is not the case." - (when-let (complementary-file (projectile--complementary-file - file-name - #'projectile--impl-to-test-dir - #'projectile--test-name-for-impl-name)) - (file-relative-name complementary-file (projectile-project-root)))) - -(defun projectile--impl-file-from-src-dir-fn (test-file) - "Get the relative path to the implementation file corresponding to TEST-FILE. -Return the implementation file path for the absolute path TEST-FILE -relative to the project root in the case the current project type's src-dir -has been set to a custom function, return nil if this is not the case or -the path points to a file that does not exist." - (when-let ((src-dir (projectile-src-directory (projectile-project-type)))) - (when (functionp src-dir) - (let ((impl-file (projectile--complementary-file - test-file - src-dir - #'projectile--impl-name-for-test-name))) - (when (file-exists-p impl-file) - (file-relative-name impl-file (projectile-project-root))))))) - -(defun projectile--test-file-from-test-dir-fn (impl-file) - "Get the relative path to the test file corresponding to IMPL-FILE. -Return the test file path for the absolute path IMPL-FILE relative to the -project root, in the case the current project type's test-dir has been set -to a custom function, else return nil." - (when-let ((test-dir (projectile-test-directory (projectile-project-type)))) - (when (functionp test-dir) - (file-relative-name - (projectile--complementary-file - impl-file - test-dir - #'projectile--test-name-for-impl-name) - (projectile-project-root))))) - -(defmacro projectile--acond (&rest clauses) - "Like `cond', but the result of each condition is bound to `it'. - -The variable `it' is available within the remainder of each of CLAUSES. - -CLAUSES are otherwise as documented for `cond'. This is copied from -anaphora.el." - (declare (debug cond)) - (if (null clauses) - nil - (let ((cl1 (car clauses)) - (sym (cl-gensym))) - `(let ((,sym ,(car cl1))) - (if ,sym - (if (null ',(cdr cl1)) - ,sym - (let ((it ,sym)) ,@(cdr cl1))) - (projectile--acond ,@(cdr clauses))))))) - -(defun projectile--find-matching-test (impl-file) - "Return a list of test files for IMPL-FILE. - -The precedence for determining test files to return is: - -1. Use the project type's test-dir property if it's set to a function -2. Use the project type's related-files-fn property if set -3. Use the project type's test-dir property if it's set to a string -4. Attempt to find a file by matching all project files against - `projectile--impl-to-test-predicate' -5. Fallback to swapping \"src\" for \"test\" in IMPL-FILE if \"src\" - is a substring of IMPL-FILE." - (projectile--acond - ((projectile--test-file-from-test-dir-fn impl-file) (list it)) - ((projectile--related-files-plist-by-kind impl-file :test) - (projectile--related-files-from-plist it)) - ((projectile--test-file-from-test-dir-str impl-file) (list it)) - ((projectile--best-or-all-candidates-based-on-parents-dirs - impl-file (cl-remove-if-not - (projectile--impl-to-test-predicate impl-file) - (projectile-current-project-files))) it) - ((projectile--impl-to-test-dir-fallback impl-file) - (list it)))) - -(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. - -The precedence for determining implementation files to return is: - -1. Use the project type's src-dir property if it's set to a function -2. Use the project type's related-files-fn property if set -3. Use the project type's src-dir property if it's set to a string -4. Default to a fallback which matches all project files against - `projectile--test-to-impl-predicate' -5. Fallback to swapping \"test\" for \"src\" in TEST-FILE if \"test\" - is a substring of TEST-FILE." - (projectile--acond - ((projectile--impl-file-from-src-dir-fn test-file) (list it)) - ((projectile--related-files-plist-by-kind test-file :impl) - (projectile--related-files-from-plist it)) - ((projectile--impl-file-from-src-dir-str test-file) (list it)) - ((projectile--best-or-all-candidates-based-on-parents-dirs - test-file (cl-remove-if-not - (projectile--test-to-impl-predicate test-file) - (projectile-current-project-files))) it) - ((projectile--test-to-impl-dir-fallback test-file) (list it)))) - -(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." - (when-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." - (when-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-acquire-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-ignored-files-rel) - (projectile-ignored-directories-rel) - (projectile--globally-ignored-file-suffixes-glob) - ;; ag supports git ignore files directly - (unless (eq (projectile-project-vcs) 'git) - (append 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-acquire-root))) - (error "Package 'ag' is not available"))) - -;;;###autoload -(defun projectile-ripgrep (search-term &optional arg) - "Run a ripgrep (rg) search with `SEARCH-TERM' at current project root. - -With an optional prefix argument ARG SEARCH-TERM is interpreted as a -regular expression. - -This command depends on of the Emacs packages ripgrep or rg being -installed to work." - (interactive - (list (projectile--read-search-string-with-default - (format "Ripgrep %ssearch for" (if current-prefix-arg "regexp " ""))) - current-prefix-arg)) - (let ((args (mapcar (lambda (val) (concat "--glob !" val)) - (append projectile-globally-ignored-files - projectile-globally-ignored-directories)))) - ;; we rely on the external packages ripgrep and rg for the actual search - ;; - ;; first we check if we can load ripgrep - (cond ((require 'ripgrep nil 'noerror) - (ripgrep-regexp search-term - (projectile-acquire-root) - (if arg - args - (cons "--fixed-strings --hidden" args)))) - ;; and then we try rg - ((require 'rg nil 'noerror) - (rg-run search-term - "*" ;; all files - (projectile-acquire-root) - (not arg) ;; literal search? - nil ;; no need to confirm - args)) - (t (error "Packages `ripgrep' and `rg' are not available"))))) - -(defun projectile-find-references (&optional symbol) - "Find all references to SYMBOL in the current project. - -A thin wrapper around `xref-references-in-directory'." - (interactive) - (when (and (fboundp 'xref-references-in-directory) - (fboundp 'xref--show-xrefs)) - (let ((project-root (projectile-acquire-root)) - (symbol (or symbol (read-from-minibuffer "Lookup in project: " (projectile-symbol-at-point))))) - (xref--show-xrefs (xref-references-in-directory symbol project-root) nil)))) - -(defun projectile-tags-exclude-patterns () - "Return a string with exclude patterns for ctags." - (mapconcat (lambda (pattern) (format "--exclude=\"%s\"" - (directory-file-name pattern))) - (append - (projectile-ignored-directories-rel) - (projectile-patterns-to-ignore)) " ")) - -;;;###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-acquire-root)) - (default-directory ggtags-project-root)) - (ggtags-ensure-project) - (ggtags-update-tags t))) - (let* ((project-root (projectile-acquire-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 - (or (file-remote-p tags-file 'localname) tags-file) - tags-exclude - ".")) - shell-output exit-code) - (with-temp-buffer - (setq exit-code - (process-file-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-acquire-root) - (call-interactively #'execute-extended-command))) - -;;;###autoload -(defun projectile-run-shell-command-in-root (command &optional output-buffer error-buffer) - "Invoke `shell-command' in the project's root." - (interactive (list (read-shell-command "Shell command: "))) - (projectile-with-default-dir (projectile-acquire-root) - (shell-command command output-buffer error-buffer))) - -;;;###autoload -(defun projectile-run-async-shell-command-in-root (command &optional output-buffer error-buffer) - "Invoke `async-shell-command' in the project's root." - (interactive (list (read-shell-command "Async shell command: "))) - (projectile-with-default-dir (projectile-acquire-root) - (async-shell-command command output-buffer error-buffer))) - -;;;###autoload -(defun projectile-run-gdb () - "Invoke `gdb' in the project's root." - (interactive) - (projectile-with-default-dir (projectile-acquire-root) - (call-interactively 'gdb))) - -;;;###autoload -(defun projectile-run-shell (&optional 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") - (let ((project (projectile-acquire-root))) - (projectile-with-default-dir project - (shell (projectile-generate-process-name "shell" arg project))))) - -;;;###autoload -(defun projectile-run-eshell (&optional 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") - (let ((project (projectile-acquire-root))) - (projectile-with-default-dir project - (let ((eshell-buffer-name (projectile-generate-process-name "eshell" arg project))) - (eshell))))) - -;;;###autoload -(defun projectile-run-ielm (&optional 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-acquire-root)) - (ielm-buffer-name (projectile-generate-process-name "ielm" arg project))) - (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 (&optional 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-acquire-root)) - (buffer-name (projectile-generate-process-name "term" arg project)) - (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-acquire-root)) - (buffer (projectile-generate-process-name "vterm" arg project))) - (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-acquire-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)))) - -(defvar projectile-files-with-string-commands - '((rg . "rg -lF --no-heading --color never ") - (ag . "ag --literal --nocolor --noheading -l ") - (ack . "ack --literal --nocolor -l ") - (git . "git grep -HlI ") - ;; -r: recursive - ;; -H: show filename for each match - ;; -l: show only file names with matches - ;; -I: no binary files - (grep . "grep -rHlI %s ."))) - -(defun projectile--rg-construct-command (search-term &optional file-ext) - "Construct Rg option to search files by the extension FILE-EXT." - (if (stringp file-ext) - (concat (cdr (assoc 'rg projectile-files-with-string-commands)) - "-g '" - file-ext - "' " - search-term) - (concat (cdr (assoc 'rg projectile-files-with-string-commands)) - search-term))) - -(defun projectile--ag-construct-command (search-term &optional file-ext) - "Construct Ag option to search files by the extension FILE-EXT." - (if (stringp file-ext) - (concat (cdr (assoc 'ag projectile-files-with-string-commands)) - "-G " - (replace-regexp-in-string - "\\*" "" - (replace-regexp-in-string "\\." "\\\\." file-ext)) - "$ " - search-term) - (concat (cdr (assoc 'ag projectile-files-with-string-commands)) - search-term))) - -(defun projectile--ack-construct-command (search-term &optional file-ext) - "Construct Ack option to search files by the extension FILE-EXT." - (if (stringp file-ext) - (concat "ack -g '" - (replace-regexp-in-string - "\\*" "" - (replace-regexp-in-string "\\." "\\\\." file-ext)) - "$' | " - (cdr (assoc 'ack projectile-files-with-string-commands)) - "-x " - search-term) - (concat (cdr (assoc 'ack projectile-files-with-string-commands)) - search-term))) - -(defun projectile--git-grep-construct-command (search-term &optional file-ext) - "Construct Grep option to search files by the extension FILE-EXT." - (if (stringp file-ext) - (concat (cdr (assoc 'git projectile-files-with-string-commands)) - search-term - " -- '" - file-ext - "'") - (concat (cdr (assoc 'git projectile-files-with-string-commands)) - search-term))) - -(defun projectile--grep-construct-command (search-term &optional file-ext) - "Construct Grep option to search files by the extension FILE-EXT." - (if (stringp file-ext) - (concat (format (cdr (assoc 'grep projectile-files-with-string-commands)) - search-term) - " --include '" - file-ext - "'") - (format (cdr (assoc 'grep projectile-files-with-string-commands)) - search-term))) - -(defun projectile-files-with-string (string directory &optional file-ext) - "Return a list of all files containing STRING in DIRECTORY. - -Tries to use rg, 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 "rg") - (projectile--rg-construct-command search-term file-ext)) - ((executable-find "ag") - (projectile--ag-construct-command search-term file-ext)) - ((executable-find "ack") - (projectile--ack-construct-command search-term file-ext)) - ((and (executable-find "git") - (eq (projectile-project-vcs) 'git)) - (projectile--git-grep-construct-command search-term file-ext)) - (t - (projectile--grep-construct-command search-term file-ext))))) - (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 #'(lambda (file) (expand-file-name file directory)) - (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 and file name patterns -on which to run the replacement." - (interactive "P") - (let* ((directory (if arg - (file-name-as-directory - (read-directory-name "Replace in directory: ")) - (projectile-acquire-root))) - (file-ext (if arg - (if (fboundp #'helm-grep-get-file-extensions) - (car (helm-grep-get-file-extensions (list directory))) - (read-string - (projectile-prepend-project-name - "With file extension (empty string means all files): "))) - nil)) - (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 file-ext))) - (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) - (with-no-warnings - (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))))) - (setq 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-acquire-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 #'(lambda (file) (expand-file-name file directory)) - (projectile-dir-files directory))))) - ;; FIXME: Probably would fail on Emacs 27+, fourth argument is gone. - (with-no-warnings (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-acquire-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-acquire-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-acquire-root))) - -;;;###autoload -(defun projectile-dired-other-window () - "Open `dired' at the root of the project in another window." - (interactive) - (dired-other-window (projectile-acquire-root))) - -;;;###autoload -(defun projectile-dired-other-frame () - "Open `dired' at the root of the project in another frame." - (interactive) - (dired-other-frame (projectile-acquire-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)))) - (unless project-root - (setq project-root (projectile-acquire-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-acquire-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-install-cmd-map - (make-hash-table :test 'equal) - "A mapping between projects and the last install command used on them.") - -(defvar projectile-package-cmd-map - (make-hash-table :test 'equal) - "A mapping between projects and the last package 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-enable-cmd-caching t - "Enables command caching for the project. Set to nil to disable. -Should be set via .dir-locals.el.") - -(defun projectile--cache-project-commands-p () - "Whether to cache project commands." - (with-temp-buffer - (hack-dir-local-variables-non-file-buffer) - projectile-project-enable-cmd-caching)) - -(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-install-cmd nil - "The command to use with `projectile-install-project'. -It takes precedence over the default command for the project type when set. -Should be set via .dir-locals.el.") - -(defvar projectile-project-package-cmd nil - "The command to use with `projectile-package-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-install-command (project-type) - "Retrieve default install command for PROJECT-TYPE." - (projectile-default-generic-command project-type 'install-command)) - -(defun projectile-default-package-command (project-type) - "Retrieve default package command for PROJECT-TYPE." - (projectile-default-generic-command project-type 'package-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-buffer-name (compilation-mode) - "Meant to be used for `compilation-buffer-name-function`. -Argument COMPILATION-MODE is the name of the major mode used for the -compilation buffer." - (concat "*" (downcase compilation-mode) "*" - (if (projectile-project-p) (concat "<" (projectile-project-name) ">") ""))) - -(defun projectile-current-project-buffer-p () - "Meant to be used for `compilation-save-buffers-predicate`. -This indicates whether the current buffer is in the same project as the current -window (including returning true if neither is in a project)." - (let ((root (with-current-buffer (window-buffer) (projectile-project-root)))) - (or (not root) - (projectile-project-buffer-p (current-buffer) root)))) - -(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-install-command (compile-dir) - "Retrieve the install command for COMPILE-DIR. - -The command is determined like this: - -- first we check `projectile-install-cmd-map' for the last -install command that was invoked on the project - -- then we check for `projectile-project-install-cmd' supplied -via .dir-locals.el - -- finally we check for the default install command for a -project of that type" - (or (gethash compile-dir projectile-install-cmd-map) - projectile-project-install-cmd - (projectile-default-install-command (projectile-project-type)))) - -(defun projectile-package-command (compile-dir) - "Retrieve the package command for COMPILE-DIR. - -The command is determined like this: - -- first we check `projectile-packgage-cmd-map' for the last -install command that was invoked on the project - -- then we check for `projectile-project-package-cmd' supplied -via .dir-locals.el - -- finally we check for the default package command for a -project of that type" - (or (gethash compile-dir projectile-package-cmd-map) - projectile-project-package-cmd - (projectile-default-package-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 the function `compilation-read-command'." - (let ((compile-history - ;; fetch the command history for the current project - (ring-elements (projectile--get-command-history (projectile-acquire-root))))) - (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 &optional use-comint-mode) - "Run external or Elisp compilation command CMD." - (if (functionp cmd) - (funcall cmd) - (compile cmd use-comint-mode))) - -(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 use-comint-mode) - "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)) - compilation-buffer-name-function - compilation-save-buffers-predicate) - (when command-map - (puthash default-directory command command-map) - (let ((hist (projectile--get-command-history project-root))) - (unless (string= (car-safe (ring-elements hist)) command) - (ring-insert hist command)))) - (when save-buffers - (save-some-buffers (not compilation-ask-about-save) - (lambda () - (projectile-project-buffer-p (current-buffer) - project-root)))) - (when projectile-per-project-compilation-buffer - (setq compilation-buffer-name-function #'projectile-compilation-buffer-name) - (setq compilation-save-buffers-predicate #'projectile-current-project-buffer-p)) - (unless (file-directory-p default-directory) - (mkdir default-directory)) - (projectile-run-compilation command use-comint-mode) - command)) - -(defcustom projectile-configure-use-comint-mode nil - "Make the output buffer of `projectile-configure-project' interactive." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.5.0")) - -(defcustom projectile-compile-use-comint-mode nil - "Make the output buffer of `projectile-compile-project' interactive." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.5.0")) - -(defcustom projectile-test-use-comint-mode nil - "Make the output buffer of `projectile-test-project' interactive." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.5.0")) - -(defcustom projectile-install-use-comint-mode nil - "Make the output buffer of `projectile-install-project' interactive." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.5.0")) - -(defcustom projectile-package-use-comint-mode nil - "Make the output buffer of `projectile-package-project' interactive." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.5.0")) - -(defcustom projectile-run-use-comint-mode nil - "Make the output buffer of `projectile-run-project' interactive." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.5.0")) - -;;;###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))) - (command-map (if (projectile--cache-project-commands-p) projectile-configure-cmd-map))) - (projectile--run-project-cmd command command-map - :show-prompt arg - :prompt-prefix "Configure command: " - :save-buffers t - :use-comint-mode projectile-configure-use-comint-mode))) - -;;;###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))) - (command-map (if (projectile--cache-project-commands-p) projectile-compilation-cmd-map))) - (projectile--run-project-cmd command command-map - :show-prompt arg - :prompt-prefix "Compile command: " - :save-buffers t - :use-comint-mode projectile-compile-use-comint-mode))) - -;;;###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))) - (command-map (if (projectile--cache-project-commands-p) projectile-test-cmd-map))) - (projectile--run-project-cmd command command-map - :show-prompt arg - :prompt-prefix "Test command: " - :save-buffers t - :use-comint-mode projectile-test-use-comint-mode))) - -;;;###autoload -(defun projectile-install-project (arg) - "Run project install 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-install-command (projectile-compilation-dir))) - (command-map (if (projectile--cache-project-commands-p) projectile-install-cmd-map))) - (projectile--run-project-cmd command command-map - :show-prompt arg - :prompt-prefix "Install command: " - :save-buffers t - :use-comint-mode projectile-install-use-comint-mode))) - -;;;###autoload -(defun projectile-package-project (arg) - "Run project package 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-package-command (projectile-compilation-dir))) - (command-map (if (projectile--cache-project-commands-p) projectile-package-cmd-map))) - (projectile--run-project-cmd command command-map - :show-prompt arg - :prompt-prefix "Package command: " - :save-buffers t - :use-comint-mode projectile-package-use-comint-mode))) - -;;;###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))) - (command-map (if (projectile--cache-project-commands-p) projectile-run-cmd-map))) - (projectile--run-project-cmd command command-map - :show-prompt arg - :prompt-prefix "Run command: " - :use-comint-mode projectile-run-use-comint-mode))) - -;;;###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', -`projectile-install-project', `projectile-package-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-acquire-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) - "Advice around compilation-find-file. -We enhance its functionality by appending the current project's directories -to its search path. This way when filenames in compilation buffers can't be -found by compilation's normal logic they are searched for in project -directories." - (let* ((root (projectile-project-root)) - (compilation-search-path - (if (projectile-project-p) - (append compilation-search-path (list root) - (mapcar (lambda (f) (expand-file-name f root)) - (projectile-current-project-dirs))) - compilation-search-path))) - (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-let ((project-root (projectile-project-root))) - (when (projectile-project-buffer-p buffer project-root) - (abbreviate-file-name 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.'" - ;; let's make sure that the target directory exists and is actually a project - ;; we ignore remote folders, as the check breaks for TRAMP unless already connected - (unless (or (file-remote-p project-to-switch) (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) - (switched-buffer - ;; 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) - (current-buffer))))) - ;; If switch-project-action switched buffers then with-temp-buffer will - ;; have lost that change, so switch back to the correct buffer. - (when (buffer-live-p switched-buffer) - (switch-to-buffer switched-buffer))) - (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. -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-reset-known-projects () - "Clear known projects and rediscover." - (interactive) - (projectile-clear-known-projects) - (projectile-discover-projects-in-search-path)) - -;;;###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-acquire-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) - (push (file-name-as-directory (abbreviate-file-name project-root)) projectile-known-projects) - (delete-dups 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 - (let ((directory (file-name-as-directory (expand-file-name qualifier)))) - (and (projectile-project-buffer-p buf directory) - (equal directory - (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-acquire-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-acquire-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-acquire-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 "0.12.0") -(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")) - -(defcustom projectile-show-menu t - "Controls whether to display Projectile's menu." - :group 'projectile - :type 'boolean - :package-version '(projectile . "2.6.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 "?") #'projectile-find-references) - (define-key map (kbd "a") #'projectile-find-other-file) - (define-key map (kbd "b") #'projectile-switch-to-buffer) - (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 "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 x") #'projectile-find-references) - (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 "v") #'projectile-vc) - (define-key map (kbd "V") #'projectile-browse-dirty-projects) - ;; project lifecycle external commands - ;; TODO: Bundle those under some prefix key - (define-key map (kbd "C") #'projectile-configure-project) - (define-key map (kbd "c") #'projectile-compile-project) - (define-key map (kbd "K") #'projectile-package-project) - (define-key map (kbd "L") #'projectile-install-project) - (define-key map (kbd "P") #'projectile-test-project) - (define-key map (kbd "u") #'projectile-run-project) - ;; integration with utilities - (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) - ;; misc - (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" :visible projectile-show-menu - ("Find..." - ["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] - ["Jump between implementation file and test file" projectile-toggle-between-implementation-and-test]) - ("Buffers" - ["Switch to buffer" projectile-switch-to-buffer] - ["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]) - ("Projects" - ["Switch to project" projectile-switch-project] - ["Switch to open project" projectile-switch-open-project] - "--" - ["Discover projects in directory" projectile-discover-projects-in-directory] - ["Discover projects in search path" projectile-discover-projects-in-search-path] - ["Clear known projects" projectile-clear-known-projects] - ["Reset known projects" projectile-reset-known-projects] - "--" - ["Open project in dired" projectile-dired] - "--" - ["Browse dirty projects" projectile-browse-dirty-projects] - "--" - ["Cache current file" projectile-cache-current-file] - ["Invalidate cache" projectile-invalidate-cache] - ["Regenerate [e|g]tags" projectile-regenerate-tags] - "--" - ["Toggle project wide read-only" projectile-toggle-project-read-only] - ["Edit .dir-locals.el" projectile-edit-dir-locals] - ["Project info" projectile-project-info]) - ("Search" - ["Search with grep" projectile-grep] - ["Search with ag" projectile-ag] - ["Search with ripgrep" projectile-ripgrep] - ["Replace in project" projectile-replace] - ["Multi-occur in project" projectile-multi-occur] - ["Find references in project" projectile-find-references]) - ("Run..." - ["Run shell" projectile-run-shell] - ["Run eshell" projectile-run-eshell] - ["Run ielm" projectile-run-ielm] - ["Run term" projectile-run-term] - ["Run vterm" projectile-run-vterm] - "--" - ["Run GDB" projectile-run-gdb]) - ("Build" - ["Configure project" projectile-configure-project] - ["Compile project" projectile-compile-project] - ["Test project" projectile-test-project] - ["Install project" projectile-install-project] - ["Package project" projectile-package-project] - ["Run project" projectile-run-project] - "--" - ["Repeat last build command" projectile-repeat-last-command]) - "--" - ["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." - (projectile-maybe-limit-project-file-buffers) - (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))) - -(defun projectile-maybe-limit-project-file-buffers () - "Limit the opened file buffers for a project. - -The function simply kills the last buffer, as it's normally called -when opening new files." - (when projectile-max-file-buffer-count - (let ((project-buffers (projectile-project-buffer-files))) - (when (> (length project-buffers) projectile-max-file-buffer-count) - (kill-buffer (car (last project-buffers))))))) - -;;;###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) - (when projectile-auto-discover - (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)))) - -;;; savehist-mode - When `savehist-mode' is t, projectile-project-command-history will be saved. -;; See https://github.com/bbatsov/projectile/issues/1637 for more details -(if (bound-and-true-p savehist-loaded) - (add-to-list 'savehist-additional-variables 'projectile-project-command-history) - (defvar savehist-additional-variables nil) - (add-hook 'savehist-mode-hook - (lambda() - (add-to-list 'savehist-additional-variables 'projectile-project-command-history)))) - -;;;###autoload -(define-obsolete-function-alias 'projectile-global-mode 'projectile-mode "1.0") - -;;;; project.el integration -;; -;; Projectile will become the default provider for -;; project.el project and project files lookup. -;; See https://github.com/bbatsov/projectile/issues/1591 for -;; more details. - -;; it's safe to require this directly, as it was added in Emacs 25.1 -(require 'project) - -(cl-defmethod project-root ((project (head projectile))) - (cdr project)) - -(cl-defmethod project-files ((project (head projectile)) &optional _dirs) - (let ((root (project-root project))) - ;; Make paths absolute and ignore the optional dirs argument, - ;; see https://github.com/bbatsov/projectile/issues/1591#issuecomment-896423965 - ;; That's needed because Projectile uses relative paths for project files - ;; and project.el expects them to be absolute. - ;; FIXME: That's probably going to be very slow in large projects. - (mapcar (lambda (f) - (concat root f)) - (projectile-project-files root)))) - -(defun project-projectile (dir) - "Return Projectile project of form ('projectile . root-dir) for DIR." - (let ((root (projectile-project-root dir))) - (when root - (cons 'projectile root)))) - -(add-hook 'project-find-functions #'project-projectile) - -(provide 'projectile) - -;;; projectile.el ends here diff --git a/org/elpa/transpose-frame-20220913.1749/transpose-frame-autoloads.el b/org/elpa/transpose-frame-20220913.1749/transpose-frame-autoloads.el deleted file mode 100644 index cae870d..0000000 --- a/org/elpa/transpose-frame-20220913.1749/transpose-frame-autoloads.el +++ /dev/null @@ -1,59 +0,0 @@ -;;; transpose-frame-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "transpose-frame" "transpose-frame.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from transpose-frame.el - -(autoload 'transpose-frame "transpose-frame" "\ -Transpose windows arrangement at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'flip-frame "transpose-frame" "\ -Flip windows arrangement vertically at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'flop-frame "transpose-frame" "\ -Flop windows arrangement horizontally at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'rotate-frame "transpose-frame" "\ -Rotate windows arrangement 180 degrees at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'rotate-frame-clockwise "transpose-frame" "\ -Rotate windows arrangement 90 degrees clockwise at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'rotate-frame-anticlockwise "transpose-frame" "\ -Rotate windows arrangement 90 degrees anti-clockwise at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(register-definition-prefixes "transpose-frame" '("transpose-frame-")) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; transpose-frame-autoloads.el ends here diff --git a/org/elpa/transpose-frame-20220913.1749/transpose-frame-pkg.el b/org/elpa/transpose-frame-20220913.1749/transpose-frame-pkg.el deleted file mode 100644 index 2189fda..0000000 --- a/org/elpa/transpose-frame-20220913.1749/transpose-frame-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from transpose-frame.el -*- no-byte-compile: t -*- -(define-package "transpose-frame" "20220913.1749" "Transpose windows arrangement in a frame" 'nil :commit "7b7f8a1582436749a57ebbba6ead716b5a0edddc" :authors '(("S. Irie")) :maintainer '("S. Irie") :keywords '("window")) diff --git a/org/elpa/transpose-frame-20220913.1749/transpose-frame.el b/org/elpa/transpose-frame-20220913.1749/transpose-frame.el deleted file mode 100644 index c16c06c..0000000 --- a/org/elpa/transpose-frame-20220913.1749/transpose-frame.el +++ /dev/null @@ -1,237 +0,0 @@ -;;; transpose-frame.el --- Transpose windows arrangement in a frame - -;; Copyright (c) 2011 S. Irie - -;; Author: S. Irie -;; Keywords: window -;; Package-Version: 20220913.1749 -;; Package-Commit: 7b7f8a1582436749a57ebbba6ead716b5a0edddc - -;; This program is free software. - -;; Redistribution and use in source and binary forms, with or without -;; modification, are permitted provided that the following conditions -;; are met: - -;; 1. Redistributions of source code must retain the above copyright -;; notice, this list of conditions and the following disclaimer. -;; 2. Redistributions in binary form must reproduce the above copyright -;; notice, this list of conditions and the following disclaimer in the -;; documentation and/or other materials provided with the distribution. - -;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -;;; Commentary: - -;; This program provides some interactive functions which allows users -;; to transpose windows arrangement in currently selected frame: -;; -;; `transpose-frame' ... Swap x-direction and y-direction -;; -;; +------------+------------+ +----------------+--------+ -;; | | B | | A | | -;; | A +------------+ | | | -;; | | C | => +--------+-------+ D | -;; +------------+------------+ | B | C | | -;; | D | | | | | -;; +-------------------------+ +--------+-------+--------+ -;; -;; `flip-frame' ... Flip vertically -;; -;; +------------+------------+ +------------+------------+ -;; | | B | | D | -;; | A +------------+ +------------+------------+ -;; | | C | => | | C | -;; +------------+------------+ | A +------------+ -;; | D | | | B | -;; +-------------------------+ +------------+------------+ -;; -;; `flop-frame' ... Flop horizontally -;; -;; +------------+------------+ +------------+------------+ -;; | | B | | B | | -;; | A +------------+ +------------+ A | -;; | | C | => | C | | -;; +------------+------------+ +------------+------------+ -;; | D | | D | -;; +-------------------------+ +-------------------------+ -;; -;; `rotate-frame' ... Rotate 180 degrees -;; -;; +------------+------------+ +-------------------------+ -;; | | B | | D | -;; | A +------------+ +------------+------------+ -;; | | C | => | C | | -;; +------------+------------+ +------------+ A | -;; | D | | B | | -;; +-------------------------+ +------------+------------+ -;; -;; `rotate-frame-clockwise' ... Rotate 90 degrees clockwise -;; -;; +------------+------------+ +-------+-----------------+ -;; | | B | | | A | -;; | A +------------+ | | | -;; | | C | => | D +--------+--------+ -;; +------------+------------+ | | B | C | -;; | D | | | | | -;; +-------------------------+ +-------+--------+--------+ -;; -;; `rotate-frame-anticlockwise' ... Rotate 90 degrees anti-clockwise -;; -;; +------------+------------+ +--------+--------+-------+ -;; | | B | | B | C | | -;; | A +------------+ | | | | -;; | | C | => +--------+--------+ D | -;; +------------+------------+ | A | | -;; | D | | | | -;; +-------------------------+ +-----------------+-------+ -;; -;; This program is tested on GNU Emacs 22, 23. - -;;; Code: -;;; Internal functions - -(defun transpose-frame-get-arrangement (&optional frame subtree) - (let ((tree (or subtree - (car (window-tree frame))))) - (if (windowp tree) - (list (window-buffer tree) - (window-start tree) - (window-point tree) - (window-hscroll tree) - (window-margins tree) - (window-fringes tree) - (window-dedicated-p tree) - (jit-lock-register tree) - tree - (eq tree (frame-selected-window frame))) - (let* ((vertical (car tree)) - (edges (cadr tree)) - (length (float (if vertical - (- (nth 3 edges) (cadr edges)) - (- (nth 2 edges) (car edges)))))) - (cons vertical - (mapcar (lambda (subtree) - (cons (transpose-frame-get-arrangement frame subtree) - (/ (let ((edges (if (windowp subtree) - (window-edges subtree) - (cadr subtree)))) - (if vertical - (- (nth 3 edges) (cadr edges)) - (- (nth 2 edges) (car edges)))) - length))) - (cddr tree))))))) - -(defun transpose-frame-set-arrangement (config &optional window-or-frame &rest how) - (let ((window (if (windowp window-or-frame) - window-or-frame - (frame-selected-window window-or-frame)))) - (unless (windowp window-or-frame) - (delete-other-windows window)) - (if (bufferp (car config)) - (let ((buffer (pop config))) - (set-window-buffer window buffer) - (set-window-start window (pop config)) - (set-window-point window (pop config)) - (set-window-hscroll window (pop config)) - (set-window-margins window (caar config) (cdr (pop config))) - (apply 'set-window-fringes window (pop config)) - (set-window-dedicated-p window (pop config)) - (jit-lock-register window (pop config)) - (let* ((orig-window (pop config)) - (ol-func (lambda (ol) - (when (eq (overlay-get ol 'window) orig-window) - (overlay-put ol 'window window)))) - (ol-lists (with-current-buffer buffer - (overlay-lists)))) - (mapc ol-func (car ol-lists)) - (mapc ol-func (cdr ol-lists))) - (if (car config) (select-window window))) - (let* ((horizontal (if (memq 'transpose how) - (pop config) - (not (pop config)))) - (edges (window-edges window)) - (length (if horizontal - (- (nth 2 edges) (car edges)) - (- (nth 3 edges) (cadr edges))))) - (if (memq (if horizontal 'flop 'flip) how) - (setq config (reverse config))) - (while (cdr config) - (setq window (prog1 - (split-window window (round (* length (cdar config))) - horizontal) - (apply 'transpose-frame-set-arrangement - (caar config) window how)) - config (cdr config))) - (apply 'transpose-frame-set-arrangement - (caar config) window how))))) - -;;; User commands - -;;;###autoload -(defun transpose-frame (&optional frame) - "Transpose windows arrangement at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'transpose) - (when (called-interactively-p 'any) (recenter))) - -;;;###autoload -(defun flip-frame (&optional frame) - "Flip windows arrangement vertically at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'flip)) - -;;;###autoload -(defun flop-frame (&optional frame) - "Flop windows arrangement horizontally at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'flop)) - -;;;###autoload -(defun rotate-frame (&optional frame) - "Rotate windows arrangement 180 degrees at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'flip 'flop)) - -;;;###autoload -(defun rotate-frame-clockwise (&optional frame) - "Rotate windows arrangement 90 degrees clockwise at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'transpose 'flop) - (when (called-interactively-p 'any) (recenter))) - -;;;###autoload -(defun rotate-frame-anticlockwise (&optional frame) - "Rotate windows arrangement 90 degrees anti-clockwise at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'transpose 'flip) - (when (called-interactively-p 'any) (recenter))) - -;;; _ -;; Local Variables: -;; indent-tabs-mode: nil -;; End: -(provide 'transpose-frame) -;;; transpose-frame.el ends here diff --git a/org/elpa/transpose-frame-20221109.2053/transpose-frame-autoloads.el b/org/elpa/transpose-frame-20221109.2053/transpose-frame-autoloads.el deleted file mode 100644 index cae870d..0000000 --- a/org/elpa/transpose-frame-20221109.2053/transpose-frame-autoloads.el +++ /dev/null @@ -1,59 +0,0 @@ -;;; transpose-frame-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*- -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (autoloads nil "transpose-frame" "transpose-frame.el" (0 0 -;;;;;; 0 0)) -;;; Generated autoloads from transpose-frame.el - -(autoload 'transpose-frame "transpose-frame" "\ -Transpose windows arrangement at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'flip-frame "transpose-frame" "\ -Flip windows arrangement vertically at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'flop-frame "transpose-frame" "\ -Flop windows arrangement horizontally at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'rotate-frame "transpose-frame" "\ -Rotate windows arrangement 180 degrees at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'rotate-frame-clockwise "transpose-frame" "\ -Rotate windows arrangement 90 degrees clockwise at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(autoload 'rotate-frame-anticlockwise "transpose-frame" "\ -Rotate windows arrangement 90 degrees anti-clockwise at FRAME. -Omitting FRAME means currently selected frame. - -\(fn &optional FRAME)" t nil) - -(register-definition-prefixes "transpose-frame" '("transpose-frame-")) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; transpose-frame-autoloads.el ends here diff --git a/org/elpa/transpose-frame-20221109.2053/transpose-frame-pkg.el b/org/elpa/transpose-frame-20221109.2053/transpose-frame-pkg.el deleted file mode 100644 index 1b07ce9..0000000 --- a/org/elpa/transpose-frame-20221109.2053/transpose-frame-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; Generated package description from transpose-frame.el -*- no-byte-compile: t -*- -(define-package "transpose-frame" "20221109.2053" "Transpose windows arrangement in a frame" 'nil :commit "94c87794d53883a2358d13da264ad8dab9a52daa" :authors '(("S. Irie")) :maintainer '("S. Irie") :keywords '("window")) diff --git a/org/elpa/transpose-frame-20221109.2053/transpose-frame.el b/org/elpa/transpose-frame-20221109.2053/transpose-frame.el deleted file mode 100644 index c376e84..0000000 --- a/org/elpa/transpose-frame-20221109.2053/transpose-frame.el +++ /dev/null @@ -1,235 +0,0 @@ -;;; transpose-frame.el --- Transpose windows arrangement in a frame - -;; Copyright (c) 2011 S. Irie - -;; Author: S. Irie -;; Keywords: window -;; Package-Version: 20221109.2053 -;; Package-Commit: 94c87794d53883a2358d13da264ad8dab9a52daa - -;; This program is free software. - -;; Redistribution and use in source and binary forms, with or without -;; modification, are permitted provided that the following conditions -;; are met: - -;; 1. Redistributions of source code must retain the above copyright -;; notice, this list of conditions and the following disclaimer. -;; 2. Redistributions in binary form must reproduce the above copyright -;; notice, this list of conditions and the following disclaimer in the -;; documentation and/or other materials provided with the distribution. - -;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -;;; Commentary: - -;; This program provides some interactive functions which allows users -;; to transpose windows arrangement in currently selected frame: -;; -;; `transpose-frame' ... Swap x-direction and y-direction -;; -;; +------------+------------+ +----------------+--------+ -;; | | B | | A | | -;; | A +------------+ | | | -;; | | C | => +--------+-------+ D | -;; +------------+------------+ | B | C | | -;; | D | | | | | -;; +-------------------------+ +--------+-------+--------+ -;; -;; `flip-frame' ... Flip vertically -;; -;; +------------+------------+ +------------+------------+ -;; | | B | | D | -;; | A +------------+ +------------+------------+ -;; | | C | => | | C | -;; +------------+------------+ | A +------------+ -;; | D | | | B | -;; +-------------------------+ +------------+------------+ -;; -;; `flop-frame' ... Flop horizontally -;; -;; +------------+------------+ +------------+------------+ -;; | | B | | B | | -;; | A +------------+ +------------+ A | -;; | | C | => | C | | -;; +------------+------------+ +------------+------------+ -;; | D | | D | -;; +-------------------------+ +-------------------------+ -;; -;; `rotate-frame' ... Rotate 180 degrees -;; -;; +------------+------------+ +-------------------------+ -;; | | B | | D | -;; | A +------------+ +------------+------------+ -;; | | C | => | C | | -;; +------------+------------+ +------------+ A | -;; | D | | B | | -;; +-------------------------+ +------------+------------+ -;; -;; `rotate-frame-clockwise' ... Rotate 90 degrees clockwise -;; -;; +------------+------------+ +-------+-----------------+ -;; | | B | | | A | -;; | A +------------+ | | | -;; | | C | => | D +--------+--------+ -;; +------------+------------+ | | B | C | -;; | D | | | | | -;; +-------------------------+ +-------+--------+--------+ -;; -;; `rotate-frame-anticlockwise' ... Rotate 90 degrees anti-clockwise -;; -;; +------------+------------+ +--------+--------+-------+ -;; | | B | | B | C | | -;; | A +------------+ | | | | -;; | | C | => +--------+--------+ D | -;; +------------+------------+ | A | | -;; | D | | | | -;; +-------------------------+ +-----------------+-------+ -;; -;; This program is tested on GNU Emacs 22, 23. - -;;; Code: -;;; Internal functions - -(defun transpose-frame-get-arrangement (&optional frame subtree) - (let ((tree (or subtree - (car (window-tree frame))))) - (if (windowp tree) - (list (window-buffer tree) - (window-start tree) - (window-point tree) - (window-hscroll tree) - (window-margins tree) - (window-fringes tree) - (window-dedicated-p tree) - tree - (eq tree (frame-selected-window frame))) - (let* ((vertical (car tree)) - (edges (cadr tree)) - (length (float (if vertical - (- (nth 3 edges) (cadr edges)) - (- (nth 2 edges) (car edges)))))) - (cons vertical - (mapcar (lambda (subtree) - (cons (transpose-frame-get-arrangement frame subtree) - (/ (let ((edges (if (windowp subtree) - (window-edges subtree) - (cadr subtree)))) - (if vertical - (- (nth 3 edges) (cadr edges)) - (- (nth 2 edges) (car edges)))) - length))) - (cddr tree))))))) - -(defun transpose-frame-set-arrangement (config &optional window-or-frame &rest how) - (let ((window (if (windowp window-or-frame) - window-or-frame - (frame-selected-window window-or-frame)))) - (unless (windowp window-or-frame) - (delete-other-windows window)) - (if (bufferp (car config)) - (let ((buffer (pop config))) - (set-window-buffer window buffer) - (set-window-start window (pop config)) - (set-window-point window (pop config)) - (set-window-hscroll window (pop config)) - (set-window-margins window (caar config) (cdr (pop config))) - (apply 'set-window-fringes window (pop config)) - (set-window-dedicated-p window (pop config)) - (let* ((orig-window (pop config)) - (ol-func (lambda (ol) - (when (eq (overlay-get ol 'window) orig-window) - (overlay-put ol 'window window)))) - (ol-lists (with-current-buffer buffer - (overlay-lists)))) - (mapc ol-func (car ol-lists)) - (mapc ol-func (cdr ol-lists))) - (if (car config) (select-window window))) - (let* ((horizontal (if (memq 'transpose how) - (pop config) - (not (pop config)))) - (edges (window-edges window)) - (length (if horizontal - (- (nth 2 edges) (car edges)) - (- (nth 3 edges) (cadr edges))))) - (if (memq (if horizontal 'flop 'flip) how) - (setq config (reverse config))) - (while (cdr config) - (setq window (prog1 - (split-window window (round (* length (cdar config))) - horizontal) - (apply 'transpose-frame-set-arrangement - (caar config) window how)) - config (cdr config))) - (apply 'transpose-frame-set-arrangement - (caar config) window how))))) - -;;; User commands - -;;;###autoload -(defun transpose-frame (&optional frame) - "Transpose windows arrangement at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'transpose) - (when (called-interactively-p 'any) (recenter))) - -;;;###autoload -(defun flip-frame (&optional frame) - "Flip windows arrangement vertically at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'flip)) - -;;;###autoload -(defun flop-frame (&optional frame) - "Flop windows arrangement horizontally at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'flop)) - -;;;###autoload -(defun rotate-frame (&optional frame) - "Rotate windows arrangement 180 degrees at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'flip 'flop)) - -;;;###autoload -(defun rotate-frame-clockwise (&optional frame) - "Rotate windows arrangement 90 degrees clockwise at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'transpose 'flop) - (when (called-interactively-p 'any) (recenter))) - -;;;###autoload -(defun rotate-frame-anticlockwise (&optional frame) - "Rotate windows arrangement 90 degrees anti-clockwise at FRAME. -Omitting FRAME means currently selected frame." - (interactive) - (transpose-frame-set-arrangement (transpose-frame-get-arrangement frame) frame - 'transpose 'flip) - (when (called-interactively-p 'any) (recenter))) - -;;; _ -;; Local Variables: -;; indent-tabs-mode: nil -;; End: -(provide 'transpose-frame) -;;; transpose-frame.el ends here