daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2022-01-04 21:35:17 +01:00
parent 1d5275c946
commit 8de00e5202
700 changed files with 42441 additions and 85378 deletions
Download Patch File Download Diff File Expand all files Collapse all files

277
lisp/treemacs/treemacs-core-utils.el
View File

@@ -16,7 +16,8 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; General implementation details.
;; General implementation details.
;;; Code:
@@ -24,7 +25,6 @@
(require 'dash)
(require 's)
(require 'ht)
(require 'f)
(require 'pfuture)
(require 'treemacs-customization)
(require 'treemacs-logging)
@@ -37,6 +37,9 @@
(treemacs-import-functions-from "cfrs"
cfrs-read)
(treemacs-import-functions-from "treemacs-interface"
treemacs-toggle-node)
(treemacs-import-functions-from "treemacs-tags"
treemacs--expand-file-node
treemacs--collapse-file-node
@@ -134,28 +137,15 @@ Used in `treemacs-is-node-collapsed?'")
"States marking a node as open.
Used in `treemacs-is-node-expanded?'")
(defconst treemacs--buffer-name-prefix " *Treemacs-")
(defconst treemacs-dir
;; locally we're in src/elisp, installed from melpa we're at the package root
(-let [dir (-> (if load-file-name
(file-name-directory load-file-name)
default-directory)
(expand-file-name))]
(if (s-ends-with? "src/elisp/" dir)
(-> dir (f-parent) (f-parent))
dir))
"The directory treemacs.el is stored in.")
(defvar-local treemacs--width-is-locked t
"Keeps track of whether the width of the treemacs window is locked.")
(defvar-local treemacs--in-this-buffer nil
"Non-nil only in buffers meant to show treemacs.
Used to show an error message if someone mistakenly activates `treemacs-mode'.")
(defvar treemacs--pre-peek-state nil
"List of window, buffer to restore and buffer to kill treemacs used for peeking.")
(define-inline treemacs--unslash (path)
"Remove the final slash in PATH."
(declare (pure t) (side-effect-free t))
(inline-letevals (path)
(inline-quote
(if (and (> (length ,path) 1)
(eq ?/ (aref ,path (1- (length ,path)))))
(substring ,path 0 -1)
,path))))
(define-inline treemacs--parent-dir (path)
"Return the parent of PATH is it's a file, or PATH if it is a directory.
@@ -168,6 +158,26 @@ PATH: File Path"
(file-name-directory)
(treemacs--unslash)))))
(defconst treemacs--buffer-name-prefix " *Treemacs-")
(defconst treemacs-dir
;; locally we're in src/elisp, installed from melpa we're at the package root
(-let [dir (-> (if load-file-name
(file-name-directory load-file-name)
default-directory)
(expand-file-name))]
(if (s-ends-with? "src/elisp/" dir)
(-> dir (treemacs--unslash) (treemacs--parent-dir) (treemacs--parent-dir))
dir))
"The directory treemacs.el is stored in.")
(defvar-local treemacs--width-is-locked t
"Keeps track of whether the width of the treemacs window is locked.")
(defvar-local treemacs--in-this-buffer nil
"Non-nil only in buffers meant to show treemacs.
Used to show an error message if someone mistakenly activates `treemacs-mode'.")
(define-inline treemacs--remove-trailing-newline (str)
"Remove final newline in STR."
(declare (pure t) (side-effect-free t))
@@ -190,7 +200,7 @@ If STR already has a slash return it unchanged."
(define-inline treemacs--delete-line ()
"Delete the current line.
Unlike `kill-whole-line' this won't pollute the kill ring."
Unlike the function `kill-whole-line' this won't pollute the kill ring."
(inline-quote
(delete-region (point-at-bol) (min (point-max) (1+ (point-at-eol))))))
@@ -218,7 +228,7 @@ button type on every call."
,prop ,val))))
(define-inline treemacs-button-get (button prop)
"Get the property of button BUTTON named PROP
"Get the property of button BUTTON named PROP.
Same as `button-get', but faster since it's inlined and does not query the
button type on every call."
(declare (side-effect-free t))
@@ -258,16 +268,6 @@ button type on every call."
(inline-quote
(memq (treemacs-button-get ,btn :state) treemacs--closed-node-states)))
(define-inline treemacs--unslash (path)
"Remove the final slash in PATH."
(declare (pure t) (side-effect-free t))
(inline-letevals (path)
(inline-quote
(if (and (> (length ,path) 1)
(eq ?/ (aref ,path (1- (length ,path)))))
(substring ,path 0 -1)
,path))))
(define-inline treemacs--get-label-of (btn)
"Return the text label of BTN."
(declare (side-effect-free t))
@@ -283,7 +283,7 @@ EXCLUDE-PREFIX: File Path"
(declare (pure t) (side-effect-free t))
(inline-letevals (path exclude-prefix)
(inline-quote
(cdr (f-split (substring ,path (length ,exclude-prefix)))))))
(treemacs-split-path (substring ,path (length ,exclude-prefix))))))
(defun treemacs--replace-recentf-entry (old-file new-file)
"Replace OLD-FILE with NEW-FILE in the recent file list."
@@ -311,14 +311,14 @@ EXCLUDE-PREFIX: File Path"
(with-current-buffer buffer (treemacs--follow)))
(run-hook-with-args 'treemacs-select-functions 'exists))))
(define-inline treemacs--button-symbol-switch (new-sym)
"Replace icon in current line with NEW-SYM."
(inline-letevals (new-sym)
(define-inline treemacs--button-symbol-switch (new-symbol)
"Replace icon in current line with NEW-SYMBOL."
(inline-letevals (new-symbol)
(inline-quote
(save-excursion
(let ((len (length ,new-sym)))
(let ((len (length ,new-symbol)))
(goto-char (- (treemacs-button-start (next-button (point-at-bol) t)) len))
(insert ,new-sym)
(insert ,new-symbol)
(delete-char len))))))
(defun treemacs-project-of-node (node)
@@ -417,7 +417,7 @@ extensions and special names like this."
(define-inline treemacs--on-file-deletion (path &optional no-buffer-delete)
"Cleanup to run when treemacs file at PATH was deleted.
Do not try to delete buffers for PATH when NO-BUFFER-DELETE is non-nil. This is
Do not try to delete buffers for PATH when NO-BUFFER-DELETE is non-nil. This is
necessary since interacting with magit can cause file delete events for files
being edited to trigger."
(inline-letevals (path no-buffer-delete)
@@ -448,8 +448,10 @@ In practice this means expand PATH and remove its final slash."
(declare (pure t) (side-effect-free t))
(inline-letevals (path)
(inline-quote
(let (file-name-handler-alist)
(-> ,path (expand-file-name) (treemacs--unslash))))))
(if (file-remote-p ,path)
(treemacs--unslash ,path)
(let (file-name-handler-alist)
(-> ,path (expand-file-name) (treemacs--unslash)))))))
;; TODO(2020/12/28): alias is for backwards compatibility, remove it eventually
(defalias 'treemacs--canonical-path #'treemacs-canonical-path)
@@ -472,7 +474,7 @@ In practice this means expand PATH and remove its final slash."
(let* ((win-buff (window-buffer window))
(buff-file (buffer-file-name win-buff)))
(when buff-file
(setq buff-file (f-long buff-file))
(setq buff-file (expand-file-name buff-file))
(when (treemacs-is-path buff-file :in old-path)
(treemacs-without-following
(with-selected-window window
@@ -483,7 +485,7 @@ In practice this means expand PATH and remove its final slash."
;; then the rest
(--each (buffer-list)
(-when-let (buff-file (buffer-file-name it))
(setq buff-file (f-long buff-file))
(setq buff-file (expand-file-name buff-file))
(when (treemacs-is-path buff-file :in old-path)
(let ((new-file (s-replace old-path new-path buff-file)))
(kill-buffer it)
@@ -530,9 +532,14 @@ Add a project for ROOT and NAME if they are non-nil."
(setf run-hook? t)))
(when root (treemacs-do-add-project-to-workspace (treemacs-canonical-path root) name))
(with-no-warnings (setq treemacs--ready-to-follow t))
(when (or treemacs-follow-after-init (with-no-warnings treemacs-follow-mode))
(with-current-buffer origin-buffer
(treemacs--follow)))
(let* ((origin-file (buffer-file-name origin-buffer))
(file-project (treemacs-is-path origin-file :in-workspace)))
(cond
((and (or treemacs-follow-after-init (with-no-warnings treemacs-follow-mode))
file-project)
(treemacs-goto-file-node origin-file file-project))
(treemacs-expand-after-init
(treemacs-toggle-node))))
;; The hook should run at the end of the setup, but also only
;; if a new buffer was created, as the other cases are already covered
;; in their respective setup functions.
@@ -563,50 +570,6 @@ selected tags or extension entry. Must be called from treemacs buffer."
(-some-> (treemacs-button-get btn :parent)
(treemacs--nearest-path)))))
(defun treemacs--create-file/dir (is-file?)
"Interactively create either a file or directory, depending on IS-FILE.
IS-FILE?: Bool"
(interactive)
(let* ((curr-path (--if-let (treemacs-current-button)
(treemacs--nearest-path it)
(f-expand "~")))
(path-to-create (read-file-name
(if is-file? "Create File: " "Create Directory: ")
(treemacs--add-trailing-slash
(if (f-dir? curr-path)
curr-path
(f-dirname curr-path))))))
(treemacs-block
(treemacs-error-return-if (file-exists-p path-to-create)
"%s already exists." (propertize path-to-create 'face 'font-lock-string-face))
(treemacs--without-filewatch
(if is-file?
(-let [dir (f-dirname path-to-create)]
(unless (f-exists? dir)
(make-directory dir t))
(f-touch path-to-create))
(make-directory path-to-create t))
(run-hook-with-args 'treemacs-create-file-functions path-to-create))
(-when-let (project (treemacs--find-project-for-path path-to-create))
(-when-let* ((created-under (treemacs--parent path-to-create))
(created-under-pos (treemacs-find-visible-node created-under)))
;; update only the part that changed to keep things smooth
;; for files that's just their parent, for directories we have to take
;; flattening into account
(if (and (treemacs-button-get created-under-pos :parent)
(or (treemacs-button-get created-under-pos :collapsed)
;; count includes "." "..", so it'll be flattened
(= 3 (length (directory-files created-under)))))
(treemacs-do-update-node (-> created-under-pos
(treemacs-button-get :parent)
(treemacs-button-get :path)))
(treemacs-do-update-node created-under)))
(treemacs-goto-file-node (treemacs-canonical-path path-to-create) project)
(recenter))
(treemacs-pulse-on-success
"Created %s." (propertize path-to-create 'face 'font-lock-string-face)))))
(define-inline treemacs--follow-path-elements (btn items)
"Starting at BTN follow (goto and open) every single element in ITEMS.
Return the button that is found or the symbol `follow-failed' if the search
@@ -653,7 +616,7 @@ failed. PROJECT is used for determining whether Git actions are appropriate."
;; consecutively try to move to /x/src, /x/src/confg and finally /x/src/config/foo.el
(while ,dir-parts
(setq dir-part (pop ,dir-parts)
root (f-join root dir-part)
root (treemacs-join-path root dir-part)
,btn
(let (current-btn)
(cl-block search
@@ -800,8 +763,8 @@ PATH: Node Path"
(defun treemacs-find-node (path &optional project)
"Find position of node identified by PATH under PROJECT in the current buffer.
In spite of the signature this function effectively supports two different calling
conventions.
In spite of the signature this function effectively supports two different
calling conventions.
The first one is for movement towards a node that identifies a file. In this
case the signature is applied as is, and this function diverges simply into
@@ -810,16 +773,16 @@ optional, as treemacs is able to determine which project, if any, a given file
belongs to. Providing the project is therefore only a matter of efficiency and
convenience. If PROJECT is not given it will be found with
`treemacs--find-project-for-path'. No attempt is made to verify that PATH falls
under a project in the workspace. It is assumed that this check has already been
made.
under a project in the workspace. It is assumed that this check has already
been made.
The second calling convention deals with custom nodes defined by an extension
for treemacs. In this case the PATH is made up of all the node keys that lead to
the node to be moved to.
for treemacs. In this case the PATH is made up of all the node keys that lead
to the node to be moved to.
For a directory extension, created with `treemacs-define-directory-extension',
that means that the path's first element must be the filepath of its parent. For
a project extension, created with `treemacs-define-project-extension', the
that means that the path's first element must be the filepath of its parent.
For a project extension, created with `treemacs-define-project-extension', the
first element of the path must instead be the keyword `:custom', followed by the
node's unique path. The second argument is therefore ignored in this case.
@@ -837,8 +800,8 @@ PROJECT Project Struct"
(defun treemacs-goto-node (path &optional project ignore-file-exists)
"Move point to button identified by PATH under PROJECT in the current buffer.
Falls under the same constraints as `treemacs-find-node', but will actually move
point. Will do nothing if file at PATH does not exist, unless IGNORE-FILE-EXISTS
is non-nil.
point. Will do nothing if file at PATH does not exist, unless
IGNORE-FILE-EXISTS is non-nil.
PATH: Filepath | Node Path
PROJECT Project Struct
@@ -863,7 +826,7 @@ PROJECT: Project Struct"
;; the path we're moving to minus the project root
(path-minus-root (->> project (treemacs-project->path) (length) (substring path)))
;; the parts of the path that we can try to go to until we arrive at the project root
(dir-parts (nreverse (s-split (f-path-separator) path-minus-root :omit-nulls)))
(dir-parts (nreverse (s-split "/" path-minus-root :omit-nulls)))
;; the path we try to quickly move to because it's already open and thus in the dom
(goto-path path)
;; manual as in to be expanded manually after we moved to the next closest node we can find
@@ -1126,44 +1089,6 @@ Will refresh every project when PROJECT is 'all."
(unless treemacs-silent-refresh
(treemacs-log "Refresh complete.")))))
(defun treemacs--setup-peek-buffer (btn &optional goto-tag?)
"Setup the peek buffer and window for BTN.
Additionally also navigate to BTN's tag if GOTO-TAG is t.
BTN: Button
GOTO-TAG: Bool"
(let ((path (file-truename
(if goto-tag?
(treemacs-with-button-buffer btn
(treemacs--nearest-path btn))
(treemacs-safe-button-get btn :path))))
(buffer-to-restore (current-buffer))
(buffer-to-kill nil))
(-if-let (buffer (get-file-buffer path))
(switch-to-buffer buffer)
(find-file path)
(setq buffer-to-kill (current-buffer)))
(when goto-tag?
(treemacs--goto-tag btn))
(unless treemacs--pre-peek-state
(setq treemacs--pre-peek-state `(,(selected-window) ,buffer-to-restore ,buffer-to-kill)))
(add-hook 'post-command-hook #'treemacs--restore-peeked-window)))
(defun treemacs--restore-peeked-window ()
"Revert the buffer displayed in the peek window before it was used for peeking."
(unless (memq this-command
'(treemacs-peek treemacs-next-line-other-window treemacs-previous-line-other-window
treemacs-next-page-other-window treemacs-previous-page-other-window))
(remove-hook 'post-command-hook #'treemacs--restore-peeked-window)
(treemacs-without-following
(when treemacs--pre-peek-state
(-let [(window buffer-to-restore buffer-to-kill) treemacs--pre-peek-state]
(setq treemacs--pre-peek-state nil)
(when (buffer-live-p buffer-to-kill)
(kill-buffer buffer-to-kill))
(with-selected-window window
(switch-to-buffer buffer-to-restore)))))))
(define-inline treemacs-is-node-file-or-dir? (node)
"Return t when NODE is a file or directory."
(inline-letevals (node)
@@ -1183,57 +1108,6 @@ PATH: Node Path"
(inline-quote
(treemacs-find-in-dom ,path))))
(defun treemacs--copy-or-move (action)
"Internal implementation for copying and moving files.
ACTION will be either `:copy' or `:move', depending on whether we are calling
from `treemacs-copy-file' or `treemacs-move-file'."
(let ((no-node-msg)
(wrong-type-msg)
(prompt)
(action-function)
(finish-msg))
(pcase action
(:copy
(setf no-node-msg "There is nothing to copy here."
wrong-type-msg "Only files and directories can be copied."
prompt "Copy to: "
action-function #'f-copy
finish-msg "Copied %s to %s"))
(:move
(setf no-node-msg "There is nothing to move here."
wrong-type-msg "Only files and directories can be moved."
prompt "Move to: "
action-function #'f-move
finish-msg "Moved %s to %s")))
(treemacs-block
(treemacs-unless-let (node (treemacs-node-at-point))
(treemacs-error-return no-node-msg)
(treemacs-error-return-if (not (treemacs-is-node-file-or-dir? node))
wrong-type-msg)
(let* ((source (treemacs-button-get node :path))
(source-name (treemacs--filename source))
(destination (treemacs--unslash (read-file-name prompt nil default-directory)))
(target-is-dir? (file-directory-p destination))
(target-name (if target-is-dir? (treemacs--filename source) (treemacs--filename destination)))
(destination-dir (if target-is-dir? destination (treemacs--parent-dir destination)))
(target (treemacs--find-repeated-file-name (f-join destination-dir target-name))))
(unless (file-exists-p destination-dir)
(make-directory destination-dir :parents))
(when (eq action :move)
;; do the deletion *before* moving the file, otherwise it will no longer exist and treemacs will
;; not recognize it as a file path
(treemacs-do-delete-single-node source))
(treemacs--without-filewatch
(funcall action-function source target))
;; no waiting for filewatch, if we copied to an expanded directory refresh it immediately
(-let [parent (treemacs--parent target)]
(when (treemacs-is-path-visible? parent)
(treemacs-do-update-node parent)))
(treemacs-goto-file-node target)
(treemacs-pulse-on-success finish-msg
(propertize source-name 'face 'font-lock-string-face)
(propertize destination 'face 'font-lock-string-face)))))))
(defun treemacs--find-repeated-file-name (path)
"Find a fitting copy name for given file PATH.
Returns a name in the /file/name (Copy 1).ext. If that also already
@@ -1247,7 +1121,7 @@ exists it returns /file/name (Copy 2).ext etc."
(new-path path))
(while (file-exists-p new-path)
(cl-incf n)
(setf new-path (f-join dir (concat filename-no-ext (format template n) ext))))
(setf new-path (treemacs-join-path dir (concat filename-no-ext (format template n) ext))))
new-path))
(defun treemacs--read-string (prompt &optional initial-input)
@@ -1262,6 +1136,17 @@ INITIAL-INPUT: String"
('from-minibuffer (read-string prompt initial-input))
(other (user-error "Unknown read-string-input value: `%s'" other))))
(defun treemacs-join-path (&rest items)
"Join the given ITEMS to a single file PATH."
(declare (side-effect-free t))
(--reduce-from (expand-file-name it acc) "/" items))
(define-inline treemacs-split-path (path)
"Split the given PATH into single items."
(declare (pure t) (side-effect-free t))
(inline-letevals (path)
(inline-quote (split-string ,path "/" :omit-nulls))))
(provide 'treemacs-core-utils)
;;; treemacs-core-utils.el ends here