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

450
lisp/treemacs/treemacs-interface.el
View File

@@ -16,13 +16,13 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Not autoloaded, but user-facing functions.
;; Not autoloaded, but user-facing functions.
;;; Code:
(require 'hl-line)
(require 'button)
(require 'f)
(require 's)
(require 'dash)
(require 'treemacs-core-utils)
@@ -47,6 +47,7 @@
cfrs-read)
(treemacs-import-functions-from "treemacs"
treemacs-find-file
treemacs-select-window)
(treemacs-import-functions-from "treemacs-tags"
@@ -113,7 +114,7 @@ them instead."
(interactive "P")
(treemacs-do-for-button-state
:on-root-node-open (treemacs--collapse-root-node btn arg)
:on-root-node-closed (treemacs--expand-root-node btn)
:on-root-node-closed (treemacs--expand-root-node btn arg)
:on-dir-node-open (treemacs--collapse-dir-node btn arg)
:on-dir-node-closed (treemacs--expand-dir-node btn :recursive arg)
:on-file-node-open (treemacs--collapse-file-node btn arg)
@@ -166,8 +167,10 @@ This function's exact configuration is stored in `treemacs-TAB-actions-config'."
(treemacs-pulse-on-failure "No TAB action defined for node of type %s."
(propertize (format "%s" state) 'face 'font-lock-type-face)))))
(defun treemacs-goto-parent-node ()
"Select parent of selected node, if possible."
(defun treemacs-goto-parent-node (&optional _arg)
"Select parent of selected node, if possible.
ARG is optional and only available so this function can be used as an action."
(interactive)
(--if-let (-some-> (treemacs-current-button) (treemacs-button-get :parent))
(goto-char it)
@@ -191,7 +194,8 @@ This function's exact configuration is stored in `treemacs-TAB-actions-config'."
(defun treemacs-visit-node-vertical-split (&optional arg)
"Open current file or tag by vertically splitting `next-window'.
Stay in current window with a prefix argument ARG."
Stay in the current window with a single prefix argument ARG, or close the
treemacs window with a double prefix argument."
(interactive "P")
(treemacs--execute-button-action
:split-function #'split-window-vertically
@@ -199,12 +203,13 @@ Stay in current window with a prefix argument ARG."
:dir-action (dired (treemacs-safe-button-get btn :path))
:tag-section-action (treemacs--visit-or-expand/collapse-tag-node btn arg nil)
:tag-action (treemacs--goto-tag btn)
:save-window arg
:window-arg arg
:no-match-explanation "Node is neither a file, a directory or a tag - nothing to do here."))
(defun treemacs-visit-node-horizontal-split (&optional arg)
"Open current file or tag by horizontally splitting `next-window'.
Stay in current window with a prefix argument ARG."
Stay in the current window with a single prefix argument ARG, or close the
treemacs window with a double prefix argument."
(interactive "P")
(treemacs--execute-button-action
:split-function #'split-window-horizontally
@@ -212,27 +217,38 @@ Stay in current window with a prefix argument ARG."
:dir-action (dired (treemacs-safe-button-get btn :path))
:tag-section-action (treemacs--visit-or-expand/collapse-tag-node btn arg nil)
:tag-action (treemacs--goto-tag btn)
:save-window arg
:window-arg arg
:no-match-explanation "Node is neither a file, a directory or a tag - nothing to do here."))
(defun treemacs-visit-node-close-treemacs (&optional _)
"Open current node without and close treemacs.
Works just like calling `treemacs-visit-node-no-split' with a double prefix
arg."
(interactive "P")
(treemacs-visit-node-no-split '(16)))
(defun treemacs-visit-node-no-split (&optional arg)
"Open current file or tag within the window the file is already opened in.
If the file/tag is no visible opened in any window use `next-window' instead.
Stay in current window with a prefix argument ARG."
"Open current node without performing any window split or window selection.
The node will be displayed in the window next to treemacs, the exact selection
is determined by `next-window'. If the node is already opened in some other
window then that window will be selected instead.
Stay in the current window with a single prefix argument ARG, or close the
treemacs window with a double prefix argument."
(interactive "P")
(treemacs--execute-button-action
:file-action (find-file (treemacs-safe-button-get btn :path))
:dir-action (dired (treemacs-safe-button-get btn :path))
:tag-section-action (treemacs--visit-or-expand/collapse-tag-node btn arg nil)
:tag-action (treemacs--goto-tag btn)
:save-window arg
:window-arg arg
:ensure-window-split t
:window (-some-> btn (treemacs--nearest-path) (get-file-buffer) (get-buffer-window))
:no-match-explanation "Node is neither a file, a directory or a tag - nothing to do here."))
(defun treemacs-visit-node-ace (&optional arg)
"Open current file or tag in window selected by `ace-window'.
Stay in current window with a prefix argument ARG."
Stay in the current window with a single prefix argument ARG, or close the
treemacs window with a double prefix argument."
(interactive "P")
(treemacs--execute-button-action
:window (aw-select "Select window")
@@ -240,13 +256,14 @@ Stay in current window with a prefix argument ARG."
:dir-action (dired (treemacs-safe-button-get btn :path))
:tag-section-action (treemacs--visit-or-expand/collapse-tag-node btn arg nil)
:tag-action (treemacs--goto-tag btn)
:save-window arg
:window-arg arg
:ensure-window-split t
:no-match-explanation "Node is neither a file, a directory or a tag - nothing to do here."))
(defun treemacs-visit-node-in-most-recently-used-window (&optional arg)
"Open current file or tag in window selected by `get-mru-window'.
Stay in current window with a prefix argument ARG."
Stay in the current window with a single prefix argument ARG, or close the
treemacs window with a double prefix argument."
(interactive "P")
(treemacs--execute-button-action
:window (get-mru-window (selected-frame) nil :not-selected)
@@ -254,13 +271,14 @@ Stay in current window with a prefix argument ARG."
:dir-action (dired (treemacs-safe-button-get btn :path))
:tag-section-action (treemacs--visit-or-expand/collapse-tag-node btn arg nil)
:tag-action (treemacs--goto-tag btn)
:save-window arg
:window-arg arg
:ensure-window-split t
:no-match-explanation "Node is neither a file, a directory or a tag - nothing to do here."))
(defun treemacs-visit-node-ace-horizontal-split (&optional arg)
"Open current file by horizontally splitting window selected by `ace-window'.
Stay in current window with a prefix argument ARG."
Stay in the current window with a single prefix argument ARG, or close the
treemacs window with a double prefix argument."
(interactive "P")
(treemacs--execute-button-action
:split-function #'split-window-horizontally
@@ -269,12 +287,13 @@ Stay in current window with a prefix argument ARG."
:dir-action (dired (treemacs-safe-button-get btn :path))
:tag-section-action (treemacs--visit-or-expand/collapse-tag-node btn arg nil)
:tag-action (treemacs--goto-tag btn)
:save-window arg
:window-arg arg
:no-match-explanation "Node is neither a file, a directory or a tag - nothing to do here."))
(defun treemacs-visit-node-ace-vertical-split (&optional arg)
"Open current file by vertically splitting window selected by `ace-window'.
Stay in current window with a prefix argument ARG."
Stay in the current window with a single prefix argument ARG, or close the
treemacs window with a double prefix argument."
(interactive "P")
(treemacs--execute-button-action
:split-function #'split-window-vertically
@@ -283,7 +302,7 @@ Stay in current window with a prefix argument ARG."
:dir-action (dired (treemacs-safe-button-get btn :path))
:tag-section-action (treemacs--visit-or-expand/collapse-tag-node btn arg nil)
:tag-action (treemacs--goto-tag btn)
:save-window arg
:window-arg arg
:no-match-explanation "Node is neither a file, a directory or a tag - nothing to do here."))
(defun treemacs-visit-node-default (&optional arg)
@@ -327,6 +346,33 @@ ACTION should be one of the `treemacs-visit-node-*' commands."
(setf treemacs-TAB-actions-config (assq-delete-all state treemacs-TAB-actions-config))
(push (cons state action) treemacs-TAB-actions-config))
(defun treemacs-COLLAPSE-action (&optional arg)
"Run the appropriate COLLAPSE action for the current button.
In the default configuration this usually means to close the content of the
currently selected node. A potential prefix ARG is passed on to the executed
action, if possible.
This function's exact configuration is stored in
`treemacs-COLLAPSE-actions-config'."
(interactive "P")
(-when-let (state (treemacs--prop-at-point :state))
(--if-let (cdr (assq state treemacs-COLLAPSE-actions-config))
(progn
(funcall it arg)
(treemacs--evade-image))
(treemacs-pulse-on-failure "No COLLAPSE action defined for node of type %s."
(propertize (format "%s" state) 'face 'font-lock-type-face)))))
(defun treemacs-define-COLLAPSE-action (state action)
"Define the behaviour of `treemacs-COLLAPSE-action'.
Determines that a button with a given STATE should lead to the execution of
ACTION.
The list of possible states can be found in `treemacs-valid-button-states'.
ACTION should be one of the `treemacs-visit-node-*' commands."
(setf treemacs-COLLAPSE-actions-config (assq-delete-all state treemacs-COLLAPSE-actions-config))
(push (cons state action) treemacs-COLLAPSE-actions-config))
(defun treemacs-visit-node-in-external-application ()
"Open current file according to its mime type in an external application.
Treemacs knows how to open files on linux, windows and macos."
@@ -340,8 +386,12 @@ Treemacs knows how to open files on linux, windows and macos."
('darwin
(shell-command (format "open \"%s\"" path)))
('gnu/linux
(let ((process-connection-type nil))
(start-process "" nil "xdg-open" path)))
(let (process-connection-type)
(start-process
"" nil "sh" "-c"
;; XXX workaround for #633
(format "xdg-open %s; sleep 1"
(shell-quote-argument path)))))
(_ (treemacs-pulse-on-failure "Don't know how to open files on %s."
(propertize (symbol-name system-type) 'face 'font-lock-string-face))))
(treemacs-pulse-on-failure "Nothing to open here.")))
@@ -365,120 +415,11 @@ With a prefix ARG call `treemacs-kill-buffer' instead."
(kill-buffer-and-window))
(run-hooks 'treemacs-kill-hook)))
(defun treemacs-delete (&optional arg)
"Delete node at point.
A delete action must always be confirmed. Directories are deleted recursively.
By default files are deleted by moving them to the trash. With a prefix ARG
they will instead be wiped irreversibly."
(interactive "P")
(treemacs-block
(treemacs-unless-let (btn (treemacs-current-button))
(treemacs-pulse-on-failure "Nothing to delete here.")
(treemacs-error-return-if (not (memq (treemacs-button-get btn :state)
'(file-node-open file-node-closed dir-node-open dir-node-closed)))
"Only files and directories can be deleted.")
(treemacs--without-filewatch
(let* ((delete-by-moving-to-trash (not arg))
(path (treemacs-button-get btn :path))
(file-name (propertize (treemacs--filename path) 'face 'font-lock-string-face)))
(cond
((f-symlink? path)
(if (yes-or-no-p (format "Remove link '%s -> %s' ? "
file-name
(propertize (file-symlink-p path) 'face 'font-lock-face)))
(delete-file path delete-by-moving-to-trash)
(treemacs-return (treemacs-log "Cancelled."))))
((f-file? path)
(if (yes-or-no-p (format "Delete '%s' ? " file-name))
(delete-file path delete-by-moving-to-trash)
(treemacs-return (treemacs-log "Cancelled."))))
((f-directory? path)
(if (yes-or-no-p (format "Recursively delete '%s' ? " file-name))
(delete-directory path t delete-by-moving-to-trash)
(treemacs-return (treemacs-log "Cancelled."))))
(t
(treemacs-error-return
(treemacs-pulse-on-failure
"Item is neither a file, a link or a directory - treemacs does not know how to delete it. (Maybe it no longer exists?)"))))
(treemacs--on-file-deletion path)
(treemacs-without-messages
(treemacs-run-in-every-buffer
(treemacs-delete-single-node path)))
(treemacs-log "Deleted %s."
(propertize path 'face 'font-lock-string-face))))
(treemacs--evade-image))))
(defun treemacs-create-file ()
"Create a new file.
Enter first the directory to create the new file in, then the new file's name.
The pre-selection for what directory to create in is based on the \"nearest\"
path to point - the containing directory for tags and files or the directory
itself, using $HOME when there is no path at or near point to grab."
(interactive)
(treemacs--create-file/dir t))
(defun treemacs-move-file ()
"Move file (or directory) at point.
Destination may also be a filename, in which case the moved file will also
be renamed."
(interactive)
(treemacs--copy-or-move :move))
(defun treemacs-copy-file ()
"Copy file (or directory) at point.
Destination may also be a filename, in which case the copied file will also
be renamed."
(interactive)
(treemacs--copy-or-move :copy))
(cl-defun treemacs-rename ()
"Rename the currently selected node.
Buffers visiting the renamed file or visiting a file inside a renamed directory
and windows showing them will be reloaded. The list of recent files will
likewise be updated."
(interactive)
(treemacs-block
(-let [btn (treemacs-current-button)]
(treemacs-error-return-if (null btn)
"Nothing to rename here.")
(let* ((old-path (treemacs-button-get btn :path))
(project (treemacs--find-project-for-path old-path))
(new-path nil)
(new-name nil)
(dir nil))
(treemacs-error-return-if (null old-path)
"Found nothing to rename here.")
(treemacs-error-return-if (not (file-exists-p old-path))
"The file to be renamed does not exist.")
(setq new-name (treemacs--read-string "New name: " (file-name-nondirectory old-path))
dir (f-dirname old-path)
new-path (f-join dir new-name))
(treemacs-error-return-if (file-exists-p new-path)
"A file named %s already exists."
(propertize new-name 'face font-lock-string-face))
(treemacs--without-filewatch (rename-file old-path new-path))
(treemacs--replace-recentf-entry old-path new-path)
(-let [treemacs-silent-refresh t]
(treemacs-run-in-every-buffer
(treemacs--on-rename old-path new-path treemacs-filewatch-mode)
(treemacs--do-refresh (current-buffer) project)))
(treemacs--reload-buffers-after-rename old-path new-path)
(treemacs-goto-file-node new-path project)
(treemacs-pulse-on-success "Renamed %s to %s."
(propertize (treemacs--filename old-path) 'face font-lock-string-face)
(propertize new-name 'face font-lock-string-face))))))
(defun treemacs-create-dir ()
"Create a new directory.
Enter first the directory to create the new dir in, then the new dir's name.
The pre-selection for what directory to create in is based on the \"nearest\"
path to point - the containing directory for tags and files or the directory
itself, using $HOME when there is no path at or near point to grab."
(interactive)
(treemacs--create-file/dir nil))
(defun treemacs-toggle-show-dotfiles ()
"Toggle the hiding and displaying of dotfiles."
"Toggle the hiding and displaying of dotfiles.
For toggling the display of git-ignored files see
`treemacs-hide-gitignored-files-mode'."
(interactive)
(setq treemacs-show-hidden-files (not treemacs-show-hidden-files))
(treemacs-run-in-every-buffer
@@ -487,14 +428,17 @@ itself, using $HOME when there is no path at or near point to grab."
(if treemacs-show-hidden-files "displayed." "hidden.")))
(defun treemacs-toggle-fixed-width ()
"Toggle whether the treemacs buffer should have a fixed width.
"Toggle whether the local treemacs buffer should have a fixed width.
See also `treemacs-width.'"
(interactive)
(setq treemacs--width-is-locked (not treemacs--width-is-locked)
window-size-fixed (when treemacs--width-is-locked 'width))
(treemacs-log "Window width has been %s."
(propertize (if treemacs--width-is-locked "locked" "unlocked")
'face 'font-lock-string-face)))
(-if-let (buffer (treemacs-get-local-buffer))
(with-current-buffer buffer
(setq treemacs--width-is-locked (not treemacs--width-is-locked)
window-size-fixed (when treemacs--width-is-locked 'width))
(treemacs-log "Window width has been %s."
(propertize (if treemacs--width-is-locked "locked" "unlocked")
'face 'font-lock-string-face)))
(treemacs-log-failure "There is no treemacs buffer in the current scope.")))
(defun treemacs-set-width (&optional arg)
"Select a new value for `treemacs-width'.
@@ -507,6 +451,38 @@ With a prefix ARG simply reset the width of the treemacs window."
(read-number))))
(treemacs--set-width treemacs-width))
(defun treemacs-increase-width (&optional arg)
"Increase the value for `treemacs-width' with `treemacs-width-increment'.
With a prefix ARG add the increment value multiple times."
(interactive "P")
(let* ((treemacs-window (treemacs-get-local-window))
(multiplier (if (numberp arg) arg 1))
(old-width (window-body-width treemacs-window))
(new-width (+ old-width (* multiplier treemacs-width-increment))))
(setq treemacs-width new-width)
(treemacs--set-width new-width)
(let ((current-size (window-body-width treemacs-window)))
(when (not (eq current-size new-width))
(setq treemacs-width old-width)
(treemacs--set-width old-width)
(treemacs-pulse-on-failure "Could not increase window width!")))))
(defun treemacs-decrease-width (&optional arg)
"Decrease the value for `treemacs-width' with `treemacs-width-increment'.
With a prefix ARG substract the increment value multiple times."
(interactive "P")
(let* ((treemacs-window (treemacs-get-local-window))
(multiplier (if (numberp arg) arg 1))
(old-width (window-body-width treemacs-window))
(new-width (- old-width (* multiplier treemacs-width-increment))))
(setq treemacs-width new-width)
(treemacs--set-width new-width)
(let ((current-size (window-body-width treemacs-window)))
(when (not (eq current-size new-width))
(setq treemacs-width old-width)
(treemacs--set-width old-width)
(treemacs-pulse-on-failure "Could not decrease window width!")))))
(defun treemacs-copy-absolute-path-at-point ()
"Copy the absolute path of the node at point."
(interactive)
@@ -516,8 +492,10 @@ With a prefix ARG simply reset the width of the treemacs window."
"There is nothing to copy here")
(treemacs-error-return-if (not (stringp path))
"Path at point is not a file.")
(-let [copied (-> path (f-full) (kill-new))]
(treemacs-pulse-on-success "Copied absolute path: %s" (propertize copied 'face 'font-lock-string-face))))))
(when (file-directory-p path)
(setf path (treemacs--add-trailing-slash path)))
(kill-new path)
(treemacs-pulse-on-success "Copied absolute path: %s" (propertize path 'face 'font-lock-string-face)))))
(defun treemacs-copy-relative-path-at-point ()
"Copy the path of the node at point relative to the project root."
@@ -529,7 +507,9 @@ With a prefix ARG simply reset the width of the treemacs window."
"There is nothing to copy here")
(treemacs-error-return-if (not (stringp path))
"Path at point is not a file.")
(-let [copied (-> path (f-full) (file-relative-name (treemacs-project->path project)) (kill-new))]
(when (file-directory-p path)
(setf path (treemacs--add-trailing-slash path)))
(-let [copied (-> path (file-relative-name (treemacs-project->path project)) (kill-new))]
(treemacs-pulse-on-success "Copied relative path: %s" (propertize copied 'face 'font-lock-string-face))))))
(defun treemacs-copy-project-path-at-point ()
@@ -602,7 +582,7 @@ without the need to call `treemacs-resort' with a prefix arg."
((or 'file-node-open 'file-node-closed 'tag-node-open 'tag-node-closed 'tag-node)
(let* ((parent (treemacs-button-get btn :parent)))
(while (and parent
(not (-some-> parent (treemacs-button-get :path) (f-directory?))))
(not (-some-> parent (treemacs-button-get :path) (file-directory-p))))
(setq parent (treemacs-button-get parent :parent)))
(if parent
(let ((line (line-number-at-pos))
@@ -791,12 +771,14 @@ With a prefix ARG select project to remove by name."
save-pos (not (equal project (treemacs-project-at-point)))))
(pcase (if save-pos
(treemacs-save-position
(treemacs-do-remove-project-from-workspace project))
(treemacs-do-remove-project-from-workspace project))
(treemacs-do-remove-project-from-workspace project nil :ask))
(treemacs-do-remove-project-from-workspace project nil :ask))
(`success
(whitespace-cleanup)
(treemacs-pulse-on-success "Removed project %s from the workspace."
(propertize (treemacs-project->name project) 'face 'font-lock-type-face)))
(`user-cancel
(ignore))
(`cannot-delete-last-project
(treemacs-pulse-on-failure "Cannot delete the last project."))
(`(invalid-project ,reason)
@@ -890,21 +872,22 @@ workspaces."
(interactive)
(treemacs-unless-let (btn (treemacs-current-button))
(treemacs-log-failure "There is nothing to refresh.")
(treemacs--do-refresh (current-buffer) (treemacs-project-of-node btn))))
(treemacs-without-recenter
(treemacs--do-refresh (current-buffer) (treemacs-project-of-node btn)))))
(defun treemacs-collapse-project (&optional arg)
"Close the project at point.
With a prefix ARG also forget about all the nodes opened in the project."
(interactive "P")
(treemacs-unless-let (btn (treemacs-current-button))
(treemacs-unless-let (project (treemacs-project-at-point))
(treemacs-pulse-on-failure "There is nothing to close here.")
(while (not (treemacs-button-get btn :project))
(setq btn (treemacs-button-get btn :parent)))
(when (eq 'root-node-open (treemacs-button-get btn :state))
(treemacs--forget-last-highlight)
(goto-char btn)
(treemacs--collapse-root-node btn arg)
(treemacs--maybe-recenter 'on-distance))))
(-let [btn (treemacs-project->position project)]
(when (treemacs-is-node-expanded? btn)
(treemacs--forget-last-highlight)
(goto-char btn)
(treemacs--collapse-root-node btn arg)
(treemacs--maybe-recenter 'on-distance)))
(treemacs-pulse-on-success "Collapsed current project")))
(defun treemacs-collapse-all-projects (&optional arg)
"Collapses all projects.
@@ -917,47 +900,29 @@ With a prefix ARG also forget about all the nodes opened in the projects."
(when (eq 'root-node-open (treemacs-button-get pos :state))
(goto-char pos)
(treemacs--collapse-root-node pos arg)))))
(treemacs--maybe-recenter 'on-distance))
(treemacs--maybe-recenter 'on-distance)
(treemacs-pulse-on-success "Collapsed all projects"))
(defun treemacs-collapse-other-projects (&optional arg)
"Collapses all projects except the project at point.
With a prefix ARG also forget about all the nodes opened in the projects."
(interactive "P")
(save-excursion
(-let [curr-project (-some-> (treemacs-current-button)
(treemacs--nearest-path)
(treemacs--find-project-for-path))]
(-let [curr-project (treemacs-project-at-point)]
(dolist (project (treemacs-workspace->projects (treemacs-current-workspace)))
(unless (eq project curr-project)
(-when-let (pos (treemacs-project->position project))
(when (eq 'root-node-open (treemacs-button-get pos :state))
(goto-char pos)
(treemacs--collapse-root-node pos arg)))))))
(treemacs--maybe-recenter 'on-distance))
(treemacs--maybe-recenter 'on-distance)
(treemacs-pulse-on-success "Collapsed all other projects"))
(defun treemacs-peek ()
"Peek at the content of the node at point.
This will display the file (or tag) at point in `next-window' much like
`treemacs-visit-node-no-split' would. The difference that the file is not
really (or rather permanently) opened - any command other than `treemacs-peek',
`treemacs-next-line-other-window', `treemacs-previous-line-other-window',
`treemacs-next-page-other-window' or `treemacs-previous-page-other-window' will
cause it to be closed again and the previously shown buffer to be restored. The
buffer visiting the peeked file will also be killed again, unless it was already
open before being used for peeking."
(interactive)
(treemacs--execute-button-action
:save-window t
:ensure-window-split t
:window (-some-> btn (treemacs--nearest-path) (get-file-buffer) (get-buffer-window))
:no-match-explanation "Only files and tags are peekable."
:file-action (treemacs--setup-peek-buffer btn)
:tag-action (treemacs--setup-peek-buffer btn t)))
(defun treemacs-root-up ()
(defun treemacs-root-up (&optional _)
"Move treemacs' root one level upward.
Only works with a single project in the workspace."
(interactive)
(interactive "P")
(treemacs-block
(unless (= 1 (length (treemacs-workspace->projects (treemacs-current-workspace))))
(treemacs-error-return
@@ -968,9 +933,9 @@ Only works with a single project in the workspace."
(let* ((project (-> btn (treemacs--nearest-path) (treemacs--find-project-for-path)))
(old-root (treemacs-project->path project))
(new-root (treemacs--parent old-root))
(new-name (if (f-root? new-root)
"/"
(file-name-nondirectory new-root)))
(new-name (pcase new-root
("/" new-root)
(_ (file-name-nondirectory new-root))))
(treemacs--no-messages t)
(treemacs-pulse-on-success nil))
(unless (treemacs-is-path old-root :same-as new-root)
@@ -979,10 +944,10 @@ Only works with a single project in the workspace."
(treemacs-do-add-project-to-workspace new-root new-name)
(treemacs-goto-file-node old-root))))))
(defun treemacs-root-down ()
(defun treemacs-root-down (&optional _)
"Move treemacs' root into the directory at point.
Only works with a single project in the workspace."
(interactive)
(interactive "P")
(treemacs-block
(treemacs-error-return-if (/= 1 (length (treemacs-workspace->projects (treemacs-current-workspace))))
"Free navigation is only possible when there is but a single project in the workspace.")
@@ -997,8 +962,7 @@ Only works with a single project in the workspace."
(treemacs-do-remove-project-from-workspace (treemacs-project-at-point) :ignore-last-project-restriction)
(treemacs--reset-dom) ;; remove also the previous root's dom entry
(treemacs-do-add-project-to-workspace new-root (file-name-nondirectory new-root))
(treemacs-goto-file-node new-root)
(treemacs-toggle-node)))
(treemacs-goto-file-node new-root)))
(_
(treemacs-pulse-on-failure "Button at point is not a directory."))))))
@@ -1012,8 +976,8 @@ Only works with a single project in the workspace."
'(("* Directory Extensions" . directory)
("* Project Extensions" . project)
("* Root Extetensions" . root)) )
(let ((top-name (symbol-value (intern (s-lex-format "treemacs--${name}-top-extensions"))))
(bottom-name (symbol-value (intern (s-lex-format "treemacs--${name}-bottom-extensions")))))
(let ((top-name (symbol-value (intern (format "treemacs--%s-top-extensions" name))))
(bottom-name (symbol-value (intern (format "treemacs--%s-bottom-extensions" name)))))
(push headline txt)
(pcase-dolist
(`(,pos-txt . ,pos-val)
@@ -1091,6 +1055,8 @@ Only works with a single project in the workspace."
"Finish editing your workspaces and apply the change."
(interactive)
(treemacs-block
(treemacs-error-return-if (not (equal (buffer-name) treemacs--org-edit-buffer-name))
"This is not a valid treemacs workspace edit buffer")
(treemacs--org-edit-remove-validation-msg)
(widen)
(whitespace-cleanup)
@@ -1102,16 +1068,25 @@ Only works with a single project in the workspace."
(treemacs--org-edit-display-validation-msg err-msg err-line))
('success
(treemacs--invalidate-buffer-project-cache)
(f-write (apply #'concat (--map (concat it "\n") lines)) 'utf-8 treemacs-persist-file)
(kill-buffer)
(write-region
(apply #'concat (--map (concat it "\n") lines))
nil
treemacs-persist-file
nil :silent)
(treemacs--restore)
(-if-let (ws (treemacs--select-workspace-by-name
(treemacs-workspace->name (treemacs-current-workspace))))
(setf (treemacs-current-workspace) ws)
(treemacs--find-workspace))
(treemacs--consolidate-projects)
(-some-> (get-buffer treemacs--org-edit-buffer-name) (kill-buffer))
(if (and (treemacs-get-local-window)
(= 2 (length (window-list))))
(kill-buffer)
(quit-window)
(kill-buffer-and-window))
(run-hooks 'treemacs-workspace-edit-hook)
(when treemacs-hide-gitignored-files-mode
(treemacs--prefetch-gitignore-cache 'all))
(treemacs-log "Edit completed successfully."))))))
(defun treemacs-collapse-parent-node (arg)
@@ -1219,6 +1194,20 @@ absolute path of the node (if it is present)."
(message "%s" (pfuture-callback-output))
(kill-buffer buffer)))))
(defun treemacs-narrow-to-current-file ()
"Close everything except the view on the current file.
This command is best understood as a combination of
`treemacs-collapse-all-projects' followed by `treemacs-find-file'."
(interactive)
(treemacs-unless-let (buffer (treemacs-get-local-buffer))
(treemacs-log-failure "There is no treemacs buffer")
(let* ((treemacs-pulse-on-success nil)
(treemacs-pulse-on-failure nil)
(treemacs--no-messages t))
(with-current-buffer buffer
(treemacs-collapse-all-projects :forget-all))
(treemacs-find-file))))
(defun treemacs-select-scope-type ()
"Select the scope for treemacs buffers.
The default (and only) option is scoping by frame, which means that every Emacs
@@ -1244,6 +1233,79 @@ To programmatically set the scope type see `treemacs-set-scope-type'."
(treemacs-log "Scope of type %s is now in effect."
(propertize selection 'face 'font-lock-type-face))))))
(defun treemacs-cleanup-litter ()
"Collapse all nodes matching any of `treemacs-litter-directories'."
(interactive)
(-let [litter-list (-map #'regexp-quote treemacs-litter-directories)]
(treemacs-run-in-every-buffer
(treemacs-save-position
(dolist (project (treemacs-workspace->projects workspace))
(treemacs-walk-reentry-dom (-> project treemacs-project->path treemacs-find-in-dom)
(lambda (dom-node)
(-let [path (treemacs-dom-node->key dom-node)]
(when (and (stringp path)
(--any? (string-match-p it path) litter-list))
(--when-let (treemacs-find-node path project)
(goto-char it)
(treemacs-toggle-node :purge)))))))))
(treemacs-pulse-on-success "Cleanup complete.")))
(defun treemacs-fit-window-width ()
"Make treemacs wide enough to display its entire content.
Specifically this will increase (or reduce) the width of the treemacs window to
that of the longest line, counting all lines, not just the ones that are
visible."
(interactive)
(let ((longest 0)
(depth 0))
(save-excursion
(goto-char (point-min))
(while (= 0 (forward-line 1))
(-let [new-len (- (point-at-eol) (point-at-bol))]
(when (> new-len longest)
(setf longest new-len
depth (treemacs--prop-at-point :depth))))))
(let* ((icon-px-diff (* depth (- treemacs--icon-size (frame-char-width))))
(icon-offset (% icon-px-diff (frame-char-width)))
(new-width (+ longest icon-offset)))
(setf treemacs-width new-width)
(treemacs--set-width new-width)
(treemacs-pulse-on-success "Width set to %s"
(propertize (format "%s" new-width) 'face 'font-lock-string-face)))))
(defun treemacs-extra-wide-toggle ()
"Expand the treemacs window to an extr-wide state (or turn it back).
Specifically this will toggle treemacs' width between
`treemacs-wide-toggle-width' and the normal `treemacs-width'."
(interactive)
(if (get 'treemacs-extra-wide-toggle :toggle-on)
(progn
(treemacs--set-width treemacs-width)
(put 'treemacs-extra-wide-toggle :toggle-on nil)
(treemacs-log "Switched to normal width display"))
(treemacs--set-width treemacs-wide-toggle-width)
(put 'treemacs-extra-wide-toggle :toggle-on t)
(treemacs-log "Switched to extra width display")))
(defun treemacs-next-workspace (&optional arg)
"Switch to the next workspace.
With a prefix ARG switch to the previous workspace instead."
(interactive)
(treemacs-block
(treemacs-error-return-if (= 1 (length treemacs--workspaces))
"There is only 1 workspace.")
(let* ((ws (treemacs-current-workspace))
(ws-count (length treemacs--workspaces))
(idx (--find-index (eq it ws) treemacs--workspaces))
(new-idx (% (+ ws-count (if arg (1- idx) (1+ idx))) ws-count))
(new-ws (nth new-idx treemacs--workspaces)))
(treemacs-do-switch-workspace new-ws)
(treemacs-pulse-on-success "Switched to workdpace '%s'"
(propertize (treemacs-workspace->name new-ws)
'face 'font-lock-string-face)))))
(defun treemacs-icon-catalogue ()
"Showcase a catalogue of all treemacs themes and their icons."
(interactive)