daniel/emacs-conf
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

24
lisp/treemacs/Changelog.org
View File

@@ -3,6 +3,20 @@
* Changelog
** current master
- Added ~treemacs-width-increment~ and the ability to resize the treemacs window incrementally
- Added ~treemacs-indent-guide-mode~
- Added option to close treemacs when visiting nodes with a double prefix arg
- Added ~treemacs-visit-node-close-treemacs~
- Added ~treemacs-fit-widdow-width~
- Added ~treemacs-extra-wide-toggle~
- Added ~treemacs-next-workspace~
- Added ~treemacs-find-workspace-method~
- Added option for ~treemacs-select-window~ to close treemacs when it is already selected
- Added ~detailed~ option for ~treemacs-eldoc-display~
- Added ~treemacs-select-directory~
- Added option to select workspace when starting/selecting treemacs
- Promoted peeking into a proper minor mode
** v2.9
- Published ~treemacs-all-the-icons~
- Added ~treemacs-workspace-switch-cleanup~
- Added support for disabling the mode line
@@ -18,8 +32,18 @@
- Added ~treemacs-copy-relative-path-at-point~
- Added ~treemacs-expand-added-projects~
- Added ~treemacs-window-background-color~
- Added ~treemacs-define-custom-image-icon~
- Added ~treemacs-narrow-to-current-file~
- Added ~treemacs-cleanup-litter~
- Added ~treemacs-expand-after-init~
- Added ~treemacs-width-is-initially-locked~
- Added ~treemacs-hide-gitignored-files-mode~
- Added ~treemacs-select-when-already-in-treemacs~
- Added ~treemacs-text-scale~
- Added option to only show the fringe indicator when the treemacs window is
selected
- Implemented one hand navigation with ~h~ collapsing nodes and ~l~ functioning like ~RET~, ~M-H/L~
is used now for changing root nodes.
- New icons
- Bug Fixes
** v2.8

BIN
lisp/treemacs/icons/default/gradle.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 9.3 KiB

143
lisp/treemacs/treemacs-async.el
View File

@@ -16,7 +16,8 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code for dealing with asynchronous processes.
;; Code for dealing with treemacs' asynchronous features.
;;; Code:
@@ -30,25 +31,34 @@
(require 'treemacs-workspaces)
(require 'treemacs-dom)
(require 'treemacs-logging)
(require 'treemacs-visuals)
(eval-when-compile
(require 'inline)
(require 'treemacs-macros))
(treemacs-import-functions-from treemacs-rendering
treemacs-do-delete-single-node)
(defconst treemacs--dirs-to-collapse.py
(if (member "treemacs-dirs-to-collapse.py" (directory-files treemacs-dir))
(f-join treemacs-dir "treemacs-dirs-to-collapse.py")
(f-join treemacs-dir "src/scripts/treemacs-dirs-to-collapse.py")))
(treemacs-join-path treemacs-dir "treemacs-dirs-to-collapse.py")
(treemacs-join-path treemacs-dir "src/scripts/treemacs-dirs-to-collapse.py")))
(defconst treemacs--git-status.py
(if (member "treemacs-git-status.py" (directory-files treemacs-dir))
(f-join treemacs-dir "treemacs-git-status.py")
(f-join treemacs-dir "src/scripts/treemacs-git-status.py")))
(treemacs-join-path treemacs-dir "treemacs-git-status.py")
(treemacs-join-path treemacs-dir "src/scripts/treemacs-git-status.py")))
(defconst treemacs--single-file-git-status.py
(if (member "treemacs-single-file-git-status.py" (directory-files treemacs-dir))
(f-join treemacs-dir "treemacs-single-file-git-status.py")
(f-join treemacs-dir "src/scripts/treemacs-single-file-git-status.py")))
(treemacs-join-path treemacs-dir "treemacs-single-file-git-status.py")
(treemacs-join-path treemacs-dir "src/scripts/treemacs-single-file-git-status.py")))
(defconst treemacs--find-ignored-files.py
(if (member "treemacs-find-ignored-files.py" (directory-files treemacs-dir))
(treemacs-join-path treemacs-dir "treemacs-find-ignored-files.py")
(treemacs-join-path treemacs-dir "src/scripts/treemacs-find-ignored-files.py")))
(defvar treemacs--git-cache-max-size 60
"Maximum size for `treemacs--git-cache'.
@@ -83,12 +93,16 @@ DEFAULT: Face"
("R" 'treemacs-git-renamed-face)
(_ ,default)))))
(defvar treemacs--git-mode nil
"Saves the specific version of git-mode that is active.
Values are either `simple', `extended', `deferred' or nil.")
(define-inline treemacs--get-node-face (path git-info default)
"Return the appropriate face for PATH based on GIT-INFO.
If there is no git entry for PATH return DEFAULT.
PATH: Filepath
GIT-INFO: Hashtable
GIT-INFO: Hash-Table
DEFAULT: Face"
(declare (pure t) (side-effect-free t))
(inline-letevals (path git-info default)
@@ -180,7 +194,7 @@ GIT-FUTURE: Pfuture"
(defun treemacs--git-status-process-simple (path)
"Start a simple git status process for files under PATH."
(let* ((default-directory (f-canonical path))
(let* ((default-directory (file-truename path))
(process-environment (cons "GIT_OPTIONAL_LOCKS=0" process-environment))
(future (pfuture-new "git" "status" "--porcelain" "--ignored" "-z" ".")))
(process-put future 'default-directory default-directory)
@@ -215,7 +229,7 @@ GIT-FUTURE: Pfuture"
(if (eq ?R (aref status 0))
(setq i (1+ i))
(ht-set! git-info-hash
(f-join git-root (s-trim-left path))
(treemacs-join-path git-root (s-trim-left path))
(substring (s-trim-left status) 0 1)))))
(setq i (1+ i)))))))))
git-info-hash))
@@ -370,36 +384,77 @@ newline."
(when (= 0 (process-exit-status future))
(read output)))))
(defun treemacs--prefetch-gitignore-cache (path)
"Pre-load all the git-ignored files in the given PATH.
PATH is either the symbol `all', in which case the state of all projects in the
current workspace is gathered instead, or a single project's path, when that
project has just been added to the workspace.
Required for `treemacs-hide-gitignored-files-mode' to properly work with
deferred git-mode, as otherwise ignored files will not be hidden on the first
run because the git cache has yet to be filled."
(if (eq path 'all)
(setf path (-map #'treemacs-project->path
(treemacs-workspace->projects (treemacs-current-workspace))))
(setf path (list path)))
(pfuture-callback `(,treemacs-python-executable
"-O"
,treemacs--find-ignored-files.py
,@path)
:on-error (ignore)
:on-success
(let ((ignore-pairs (read (pfuture-callback-output)))
(ignored-files nil))
(while ignore-pairs
(let* ((root (pop ignore-pairs))
(file (pop ignore-pairs))
(cache (ht-get treemacs--git-cache root)))
(unless cache
(setf cache (make-hash-table :size 20 :test 'equal))
(ht-set! treemacs--git-cache root cache))
(ht-set! cache file "!")
(push file ignored-files)))
(treemacs-run-in-every-buffer
(treemacs-save-position
(dolist (file ignored-files)
(when-let (treemacs-is-path-visible? file)
(treemacs-do-delete-single-node file))))))))
(define-minor-mode treemacs-git-mode
"Toggle `treemacs-git-mode'.
When enabled treemacs will check files' git status and highlight them
accordingly. This git integration is available in 3 variants: simple, extended
accordingly. This git integration is available in 3 variants: simple, extended
and deferred.
The simple variant will start a git status process whose output is parsed in
elisp. This version is simpler and slightly faster, but incomplete - it will
elisp. This version is simpler and slightly faster, but incomplete - it will
highlight only files, not directories.
The extended variant requires a non-trivial amount of parsing to be done, which
is achieved with python (specifically python3). It is slightly slower, but
complete - both files and directories will be highlighted according to their
git status.
is achieved with python (specifically python3). It is slightly slower, but
complete - both files and directories will be highlighted according to their git
status.
The deferred variant is the same is extended, except the tasks of rendering
nodes and highlighting them are separated. The former happens immediately, the
latter after `treemacs-deferred-git-apply-delay' seconds of idle time. This may
be faster (if not in truth then at least in appereance) as the git process is
given a much greater amount of time to finish. The downside is that the effect
of nodes changing their colors may be somewhat jarring, though this effect is
nodes and highlighting them are separated. The former happens immediately, the
latter after `treemacs-deferred-git-apply-delay' seconds of idle time. This may
be faster (if not in truth then at least in appearance) as the git process is
given a much greater amount of time to finish. The downside is that the effect
of nodes changing their colours may be somewhat jarring, though this issue is
largely mitigated due to the use of a caching layer.
All versions run asynchronously and are optimized for not doing more work than
All versions run asynchronously and are optimised for not doing more work than
is necessary, so their performance cost should, for the most part, be the
constant time needed to fork a subprocess."
:init-value nil
:global t
:lighter nil
:group 'treemacs
:group 'treemacs-git
;; case when the mode is re-activated by `custom-set-minor-mode'
(when (and (equal arg 1) treemacs--git-mode)
(setf arg treemacs--git-mode))
(if treemacs-git-mode
(if (memq arg '(simple extended deferred))
(treemacs--setup-git-mode arg)
@@ -412,8 +467,8 @@ Use either ARG as git integration value of read it interactively."
(interactive (list (-> (completing-read "Git Integration: " '("Simple" "Extended" "Deferred"))
(downcase)
(intern))))
(setq treemacs-git-mode arg)
(pcase treemacs-git-mode
(setf treemacs--git-mode arg)
(pcase treemacs--git-mode
((or 'extended 'deferred)
(fset 'treemacs--git-status-process-function #'treemacs--git-status-process-extended)
(fset 'treemacs--git-status-parse-function #'treemacs--parse-git-status-extended))
@@ -426,12 +481,13 @@ Use either ARG as git integration value of read it interactively."
(defun treemacs--tear-down-git-mode ()
"Tear down `treemacs-git-mode'."
(setf treemacs--git-mode nil)
(fset 'treemacs--git-status-process-function #'ignore)
(fset 'treemacs--git-status-parse-function (lambda (_) (ht))))
(define-inline treemacs--get-or-parse-git-result (future)
"Get the parsed git result of FUTURE.
Parse and set it if it hasn't been done yet. If FUTURE is nil an empty hash
Parse and set it if it hasn't been done yet. If FUTURE is nil an empty hash
table is returned.
FUTURE: Pfuture process"
@@ -445,6 +501,43 @@ FUTURE: Pfuture process"
result))
(ht)))))
(define-minor-mode treemacs-hide-gitignored-files-mode
"Toggle `treemacs-hide-gitignored-files-mode'.
When enabled treemacs will hide files that are ignored by git.
Some form of `treemacs-git-mode' *must* be enabled, otherwise this feature will
have no effect.
Both `extended' and `deferred' git-mode settings will work in full (in case of
`deferred' git-mode treemacs will pre-load the list of ignored files so they
will be hidden even on the first run). The limitations of `simple' git-mode
apply here as well: since it only knows about files and not directories only
files will be hidden."
:init-value nil
:global t
:lighter nil
:group 'treemacs-git
(if treemacs-hide-gitignored-files-mode
(progn
(add-to-list 'treemacs-pre-file-insert-predicates
#'treemacs-is-file-git-ignored?)
(when (and (eq 'deferred treemacs--git-mode)
(not (get 'treemacs-hide-gitignored-files-mode
:prefetch-done)))
(treemacs--prefetch-gitignore-cache 'all)
(put 'treemacs-hide-gitignored-files-mode :prefetch-done t)))
(setf treemacs-pre-file-insert-predicates
(delete #'treemacs-is-file-git-ignored?
treemacs-pre-file-insert-predicates)))
(treemacs-run-in-every-buffer
(treemacs--do-refresh (current-buffer) 'all))
(when (called-interactively-p 'interactive)
(treemacs-pulse-on-success "Git-ignored files will now be %s"
(propertize
(if treemacs-hide-gitignored-files-mode "hidden." "displayed.")
'face 'font-lock-constant-face))) )
(treemacs-only-during-init
(let ((has-git (not (null (executable-find "git"))))
(has-python (not (null treemacs-python-executable))))

19
lisp/treemacs/treemacs-bookmarks.el
View File

@@ -16,14 +16,15 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Integrates treemacs with bookmark.el.
;;; NOTE: This module is lazy-loaded.
;; Integrates treemacs with bookmark.el.
;; NOTE: This module is lazy-loaded.
;;; Code:
(require 'bookmark)
(require 'dash)
(require 'f)
(require 'treemacs-follow-mode)
(require 'treemacs-interface)
(require 'treemacs-scope)
@@ -48,18 +49,19 @@ fashion to `treemacs-find-file'.
With a prefix argument ARG treemacs will also open the bookmarked location."
(interactive "P")
(treemacs-block
(bookmark-maybe-load-default-file)
(-let [bookmarks
(cl-loop
for b in bookmark-alist
for name = (car b)
for location = (bookmark-location b)
when (or (f-file? location) (f-directory? location))
for location = (treemacs-canonical-path (bookmark-location b))
when (or (file-regular-p location) (file-directory-p location))
collect (propertize name 'location location))]
(treemacs-error-return-if (null bookmarks)
"Didn't find any bookmarks pointing to files.")
(let* ((bookmark (completing-read "Bookmark: " bookmarks))
(location (f-long (get-text-property 0 'location (--first (string= it bookmark) bookmarks))))
(dir (if (f-directory? location) location (f-dirname location)))
(location (treemacs-canonical-path (get-text-property 0 'location (--first (string= it bookmark) bookmarks))))
(dir (if (file-directory-p location) location (treemacs--parent-dir location)))
(project (treemacs--find-project-for-path dir)))
(treemacs-error-return-if (null project)
"Bookmark at %s does not fall under any project in the workspace."
@@ -196,7 +198,8 @@ treemacs node is pointing to a valid buffer position."
(-let [name (treemacs--read-string "Bookmark name: ")]
(bookmark-store name `((filename . ,(treemacs-button-get current-btn :path))) nil)))
('tag-node
(-let [(tag-buffer . tag-pos) (treemacs--extract-position (treemacs-button-get current-btn :marker))]
(-let [(tag-buffer . tag-pos)
(treemacs--extract-position (treemacs-button-get current-btn :marker) nil)]
(if (buffer-live-p tag-buffer)
(bookmark-store
(treemacs--read-string "Bookmark name: ")

39
lisp/treemacs/treemacs-compatibility.el
View File

@@ -16,8 +16,9 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Simple bits of code to make treemacs compatible with other packages
;;; that aren't worth the effort of being turned into their own package.
;; Simple bits of code to make treemacs compatible with other packages
;; that aren't worth the effort of being turned into their own package.
;;; Code:
@@ -36,6 +37,30 @@
(push '(treemacs-id . :never) frameset-filter-alist)
(push '(treemacs-workspace . :never) frameset-filter-alist))
(with-eval-after-load 'tramp
(setf treemacs--file-name-handler-alist
(with-no-warnings
(list
(cons tramp-file-name-regexp #'tramp-file-name-handler)))))
(with-eval-after-load 'recentf
(with-no-warnings
(add-to-list 'recentf-exclude treemacs-persist-file)
(add-to-list 'recentf-exclude treemacs-last-error-persist-file)))
(with-eval-after-load 'eyebrowse
(defun treemacs--follow-after-eyebrowse-switch ()
(when treemacs-follow-mode
(--when-let (treemacs-get-local-window)
(with-selected-window it
(treemacs--follow-after-buffer-list-update)
(hl-line-highlight)))))
(declare-function treemacs--follow-after-eyebrowse-switch "treemacs-compatibility")
(add-hook 'eyebrowse-post-window-switch-hook #'treemacs--follow-after-eyebrowse-switch))
(with-eval-after-load 'winum
(when (boundp 'winum-ignored-buffers-regexp)
(add-to-list 'winum-ignored-buffers-regexp (regexp-quote (format "%sScoped-Buffer-" treemacs--buffer-name-prefix)))))
@@ -52,6 +77,16 @@
(when (boundp 'indent-guide-inhibit-modes)
(push 'treemacs-mode indent-guide-inhibit-modes)))
(with-eval-after-load 'ediff
(add-hook
'ediff-before-setup-hook
(defun treemacs--dont-diff-in-treemacs-window ()
"Select `next-window' before ediff's window setup.
Treemacs is by default a side-window, meaning it'll throw an error if ediff trys
to split it."
(when treemacs--in-this-buffer
(select-window (next-window))))))
(with-eval-after-load 'persp-mode
(defun treemacs--remove-treemacs-window-in-new-frames (persp-activated-for)
(when (eq persp-activated-for 'frame)

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

243
lisp/treemacs/treemacs-customization.el
View File

@@ -16,13 +16,14 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Customize interface definitions.
;; Customize interface definitions.
;;; Code:
(require 's)
(require 'widget)
(require 'dash)
(require 'f)
(eval-when-compile
(require 'cl-lib))
@@ -38,12 +39,14 @@
(s-lines)
(--first
(when (file-exists-p it)
(->> (concat (shell-quote-argument it) " --version")
(shell-command-to-string)
(s-trim)
(s-replace "Python " "")
(s-left 1)
(version<= "3")))))
(condition-case _
(->> (concat (shell-quote-argument it) " --version")
(shell-command-to-string)
(s-trim)
(s-replace "Python " "")
(s-left 1)
(version<= "3"))
(error nil)))))
(error nil)))))
(cl-macrolet
@@ -84,7 +87,7 @@
:link '(url-link :tag "Repository" "https://github.com/Alexander-Miller/treemacs"))
(defgroup treemacs-git nil
"Customizations for treemacs' git integration"
"Customisations for treemacs' git integration."
:group 'treemacs
:prefix "treemacs-"
:link '(url-link :tag "Repository" "https://github.com/Alexander-Miller/treemacs"))
@@ -96,13 +99,13 @@
:link '(url-link :tag "Repository" "https://github.com/Alexander-Miller/treemacs"))
(defgroup treemacs-follow nil
"Customizations for the behaviour of the treemacs' file and tag following."
"Customisations for the behaviour of the treemacs' file and tag following."
:group 'treemacs
:prefix "treemacs-"
:link '(url-link :tag "Repository" "https://github.com/Alexander-Miller/treemacs"))
(defgroup treemacs-window nil
"Customizations for the behaviour of the treemacs window."
"Customisations for the behaviour of the treemacs window."
:group 'treemacs
:prefix "treemacs-"
:link '(url-link :tag "Repository" "https://github.com/Alexander-Miller/treemacs"))
@@ -118,6 +121,16 @@ indentation will be a space INTEGER pixels wide."
(const :tag "" px)))
:group 'treemacs)
(defcustom treemacs-litter-directories '("/node_modules" "/.venv" "/.cask")
"List of directories affected by `treemacs-cleanup-litter'.
Every item in the list is a regular expression, to be recognised a directory
must be matched with `string-match-p'.
Regexp-quoting the items in this list is *not* necessary, the quoting will
happen automatically when needed."
:type 'list
:group 'treemacs)
(defcustom treemacs-read-string-input 'from-child-frame
"The function treemacs uses to read user input.
Only applies to plaintext input, like when renaming a project, file or
@@ -138,10 +151,27 @@ There are 2 options:
:type 'boolean
:group 'treemacs)
(defcustom treemacs-eldoc-display t
(defcustom treemacs-eldoc-display 'simple
"Enables eldoc display of the file path at point.
There are 2 options:
- `simple': shows the absolute path of the file at point
- `detailed': shows the absolute path, size, last modification time and
permissions of the file at point
Requires eldoc mode to be enabled."
:type 'boolean
:type '(choice (const :tag "Simple" 'simple)
(const :tag "Detailed" 'detailed))
:group 'treemacs)
(defcustom treemacs-indent-guide-style 'line
"Determines the appearance of `treemacs-indent-guide-mode'.
The choices are
- `line' for indent guides to use the ' ┃ ' character for every indentation
level
- `block' to use a thick '██' block interspersed at every second indentation
level"
:type '(choice (const :tag "Line" 'line) (const :tag "Block" 'block))
:group 'treemacs)
(defcustom treemacs-indentation-string " "
@@ -153,7 +183,9 @@ used when there is no windowing system available."
:group 'treemacs)
(defcustom treemacs-show-hidden-files t
"Dotfiles will be shown if this is set to t and be hidden otherwise."
"Dotfiles will be shown if this is set to t and be hidden otherwise.
Can be toggled by `treemacs-toggle-show-dotfiles'."
:type 'boolean
:group 'treemacs)
@@ -185,11 +217,11 @@ of how this config works and how to modify it."
(root-node-closed . treemacs-toggle-node)
(dir-node-open . treemacs-toggle-node)
(dir-node-closed . treemacs-toggle-node)
(file-node-open . treemacs-visit-node-default)
(file-node-closed . treemacs-visit-node-default)
(file-node-open . treemacs-visit-node-in-most-recently-used-window)
(file-node-closed . treemacs-visit-node-in-most-recently-used-window)
(tag-node-open . treemacs-toggle-node)
(tag-node-closed . treemacs-toggle-node)
(tag-node . treemacs-visit-node-default))
(tag-node . treemacs-visit-node-in-most-recently-used-window))
"Defines the behaviour of `treemacs-doubleclick-action'.
See the doc string of `treemacs-RET-actions-config' for a detailed description
@@ -228,6 +260,23 @@ To keep the alist clean changes should not be made directly, but with
:type '(alist :key-type symbol :value-type treemacs-ret-action)
:group 'treemacs)
(defcustom treemacs-COLLAPSE-actions-config
'((root-node-open . treemacs-toggle-node)
(root-node-closed . treemacs-goto-parent-node)
(dir-node-open . treemacs-toggle-node)
(dir-node-closed . treemacs-goto-parent-node)
(file-node-open . treemacs-toggle-node)
(file-node-closed . treemacs-goto-parent-node)
(tag-node-open . treemacs-toggle-node)
(tag-node-closed . treemacs-goto-parent-node)
(tag-node . treemacs-goto-parent-node))
"Defines the behaviour of `treemacs-COLLAPSE-action'.
See the doc string of `treemacs-RET-actions-config' for a detailed description
of how this config works and how to modify it."
:type '(alist :key-type symbol :value-type treemacs-collapse-action)
:group 'treemacs)
(defcustom treemacs-dotfiles-regex (rx bol "." (1+ any))
"Files matching this regular expression count as dotfiles."
:type 'regexp
@@ -261,10 +310,10 @@ In plaintext: some sort settings are much slower than others. Alphabetic
sorting \(the default) is fastest and causes no additional overhead (even when
compared against foregoing sorting altogether).
Modification time sorting takes the middle, being ca. 4x slower than alphabetic.
Sorting by size is slowest, being ca. 5-6x slower than alphabetic. It also
produces the most garbage, making it more like for you to run into a garbage
collection pause.
Modification time sorting takes the middle, being ca. 4x slower than
alphabetic. Sorting by size is slowest, being ca. 5-6x slower than alphabetic.
It also produces the most garbage, making it more like for you to run into a
garbage collection pause.
Lest these numbers scare you off keep in mind that they will likely have little
to no effect on your usage of treemacs until you begin frequently refreshing
@@ -283,9 +332,9 @@ treemacs views containing hundreds or even thousands of nodes."
(pcase system-type
('darwin '(treemacs--std-ignore-file-predicate treemacs--mac-ignore-file-predicate))
(_ '(treemacs--std-ignore-file-predicate)))
"List of predicates to test for files and directories ignored by Emacs.
"List of predicates to test for files and directories ignored by treemacs.
Ignored files will *never* be shown in the treemacs buffer (unlike dotfiles)
Ignored files will *never* be shown in the treemacs buffer (unlike dotfiles
whose presence is controlled by `treemacs-show-hidden-files').
Each predicate is a function that takes 2 arguments: a file's name and its
@@ -293,9 +342,10 @@ absolute path and returns t if the file should be ignored and nil otherwise. A
file which returns t for *any* function in this list counts as ignored.
By default this list contains `treemacs--std-ignore-file-predicate' which
filters out '.', '..', Emacs' lock files as well temp files created by flycheck,
and therefore should not be directly overwritten, but added to and removed from
instead.
filters out '.', '..', Emacs' lock files as well temp files created by flycheck.
This means that this variable should *not* be set directly, but instead modified
with functions like `add-to-list'.
Additionally `treemacs--mac-ignore-file-predicate' is also included on
Mac-derived operating systems (when `system-type' is `darwin')."
:type 'list
@@ -306,12 +356,14 @@ Mac-derived operating systems (when `system-type' is `darwin')."
The difference between this and `treemacs-ignored-file-predicates' is that the
functions in this list will be called on files just before they would be
rendered, when the files' git status information is now available. This for
example allows to make files ignored by git invisible.
example allows to make files ignored by git invisible (however this particular
use-case is already covered by `treemacs-hide-gitignored-files-mode').
The functions in this list are therefore expected to have a different signature:
They must take two arguments - a file's absolute path and a hash table that maps
files to their git status. The files' paths are the table's keys, its values are
characters (and not strings) indicating the file's git condition. The chars map
map as follows: (the pattern is derived from 'git status --porcelain')
files to their git status. The files' paths are the table's keys, its values
are characters (and not strings) indicating the file's git condition. The chars
map map as follows: (the pattern is derived from 'git status --porcelain')
* M - file is modified
* U - file is in conflict
@@ -322,10 +374,7 @@ map as follows: (the pattern is derived from 'git status --porcelain')
Otherwise the behaviour is the same as `treemacs-ignored-file-predicates', in
that any one function returning t for a file means that this file will not
be rendered.
Since removing files ignored by git is the most likely use-case treemacs offers
`treemacs-is-file-git-ignored?' to quickly make this possible."
be rendered."
:type 'list
:group 'treemacs)
@@ -368,7 +417,11 @@ performance cap and to prevent too long directory names in the treemacs view.
To minimise this option's impact on display performance the search for
directories to collapse is done asynchronously in a python script and will thus
only work when python installed. The script should work both on python 2 and 3."
only work when python installed. The script should work both on python 2 and 3.
If you experience incorrect display of CJK characters while using this feature
you have to inform Emacs about your language environment using
`set-language-environment'."
:type 'integer
:group 'treemacs)
@@ -393,6 +446,12 @@ The change will apply the next time a treemacs buffer is created."
:type 'boolean
:group 'treemacs)
(defcustom treemacs-expand-after-init t
"When non-nil expand the first project after treemacs is first initialised.
Might be superseded by `treemacs-follow-after-init'."
:type 'boolean
:group 'treemacs)
(defcustom treemacs-expand-added-projects t
"When non-nil newly added projects will be expanded."
:type 'boolean
@@ -512,13 +571,13 @@ Can be set to nil to use the default value."
:group 'treemacs)
(defcustom treemacs-persist-file
(f-join user-emacs-directory ".cache" "treemacs-persist")
(expand-file-name ".cache/treemacs-persist" user-emacs-directory)
"Path to the file treemacs uses to persist its state."
:group 'treemacs
:type 'string)
(defcustom treemacs-last-error-persist-file
(f-join user-emacs-directory ".cache" "treemacs-persist-at-last-error")
(expand-file-name ".cache/treemacs-persist-at-last-error" user-emacs-directory)
"File that stores the treemacs state as it was during the last load error."
:group 'treemacs
:type 'string)
@@ -564,12 +623,12 @@ missing project will not appear in the project list next time Emacs is started."
:group 'treemacs)
(defcustom treemacs-directory-name-transformer #'identity
"Transformer function that is applied to directory names before rendering for any sort of cosmetic effect."
"Transformer to apply to directory names before rendering for cosmetic effect."
:type 'function
:group 'treemacs)
(defcustom treemacs-file-name-transformer #'identity
"Transformer function that is applied to file names before rendering for any sort of cosmetic effect."
"Transformer to apply to file names before rendering for cosmetic effect."
:type 'function
:group 'treemacs)
@@ -591,10 +650,8 @@ Note that this does *not* take `scroll-margin' into account."
:group 'treemacs-follow)
(defcustom treemacs-follow-after-init nil
"When t always find and focus the current file when treemacs is built.
A treemacs buffer is built when after calling `treemacs-init' or
`treemacs-projectle-init'. This will ignore `treemacs-follow-mode'."
"When non-nil find the current file in treemacs after it is first initialised.
Might supersede `treemacs-expand-after-init'."
:type 'boolean
:group 'treemacs-follow)
@@ -642,8 +699,9 @@ Possible values are:
This means that treemacs will make sure that only the currently followed project
is expanded while all others will remain collapsed.
Setting this to t might lead to noticeable slowdowns, at least when `treemacs-git-mode'
is enabled, since constantly expanding an entire project is fairly expensive."
Setting this to t might lead to noticeable slowdowns, at least when
`treemacs-git-mode' is enabled, since constantly expanding an entire project is
fairly expensive."
:type 'boolean
:group 'treemacs-follow)
@@ -688,11 +746,18 @@ used to reduce the size of the output to a manageable volume for treemacs."
(defcustom treemacs-is-never-other-window nil
"When non-nil treemacs will use the `no-other-window' parameter.
In practice means that treemacs will become invisible to commands like
In practice it means that treemacs will become invisible to commands like
`other-window' or `evil-window-left'."
:type 'boolean
:group 'treemacs-window)
(defcustom treemacs-width-is-initially-locked t
"Indicates whether the width of the treemacs window is initially locked.
A locked width means that changes it is only possible with the commands
`treemacs-set-width' or `treemacs-toggle-fixed-width'."
:type 'boolean
:group 'treemacs-window)
(defcustom treemacs-window-background-color nil
"Custom background colours for the treemacs window.
Value must be a cons cell consisting of two colours: first the background of the
@@ -706,6 +771,16 @@ marking the selected line."
:type 'integer
:group 'treemacs-window)
(defcustom treemacs-wide-toggle-width 70
"When resizing, this value is added or subtracted from the window width."
:type 'integer
:group 'treemacs-window)
(defcustom treemacs-width-increment 1
"When resizing, this value is added or subtracted from the window width."
:type 'integer
:group 'treemacs-window)
(defcustom treemacs-display-in-side-window t
"When non-nil treemacs will use a dedicated side-window.
On the one hand this will alleviate issues of unequally sized window splits when
@@ -735,6 +810,26 @@ constituent parts, or any other value acceptable for `header-line-format'."
:type 'string
:group 'treemacs-window)
(defcustom treemacs-text-scale nil
"Optional scale for the text (not the icons) in the treemacs window.
If set the value will be passed to `text-scale-increase'. Both positive and
negative values are possible."
:type 'integer
:group 'treemacs-window)
(defcustom treemacs-select-when-already-in-treemacs 'move-back
"How `treemacs-select-window' behaves when treemacs is already selected.
Possible values are:
- `stay' - remain in the treemacs windows, effectively doing nothing
- `close' - close the treemacs window
- `move-back' - move point back to the most recently used window (as selected
by `get-mru-window')"
:type '(choice (const stay)
(const close)
(const move-back))
:group 'treemacs)
(defcustom treemacs-position 'left
"Position of treemacs buffer.
@@ -758,6 +853,37 @@ Will be called with the created file's or dir's path as the sole argument."
:type 'hook
:group 'treemacs-hooks)
(defcustom treemacs-delete-file-functions nil
"Hooks to run whenever a file or directory is deleted.
Applies only when using `treemacs-delete'. Will be called with the created
file's or dir's path as the sole argument."
:type 'hook
:group 'treemacs-hooks)
(defcustom treemacs-rename-file-functions nil
"Hooks to run whenever a file or directory is renamed.
Applies only when using `treemacs-rename'. Will be called with 2 arguments: the
file's old name, and the file's new name, both as absolute paths."
:type 'hook
:group 'treemacs-hooks)
(defcustom treemacs-move-file-functions nil
"Hooks to run whenever a file or directory is moved.
Applies only when using `treemacs-move-file'. Will be called with 2 arguments:
the file's old location, and the file's new location, both as absolute paths."
:type 'hook
:group 'treemacs-hooks)
(defcustom treemacs-copy-file-functions nil
"Hooks to run whenever a file or directory is copied.
Applies only when using `treemacs-copy-file'. Will be called with 2 arguments:
the original file's location, and the copy's location, both as absolute paths."
:type 'hook
:group 'treemacs-hooks)
(defcustom treemacs-delete-project-functions nil
"Hooks to run whenever a project is deleted.
Will be called with the deleted project as the sole argument *after* it has been
@@ -765,6 +891,28 @@ deleted."
:type 'hook
:group 'treemacs-hooks)
(defcustom treemacs-find-workspace-method 'find-for-file-or-pick-first
"The method by which treemacs selects a workspace when first starting.
There are 3 options:
- `find-for-file-or-pick-first' means treemacs will select the first workspace
with a project that contains the current buffer's file. If no such workspace
exists, or if the current buffer is not visiting a file, the first workspace
in the list (as seen in `treemacs-edit-workspaces' or picked with
`treemacs-set-fallback-workspace') is selected
- `find-for-file-or-manually-select' works the same, but an interactive
selection is used as fallback instead
- `always-ask' means the workspace *always* has to be manually selected
Note that the selection process will be skipped if there is only one workspace."
:type '(choice (const
:tag "Find workspace for current file, pick the first workspace as falback"
find-for-file-or-pick-first)
(const
:tag "Find workspace for current file, interactively select workspace as falback"
find-for-file-or-manually-select)
(const :tag "Always ask" always-ask))
:group 'treemacs-hooks)
(defcustom treemacs-rename-project-functions nil
"Hooks to run whenever a project is renamed.
Will be called with the renamed project and the old name as its arguments."
@@ -912,7 +1060,8 @@ available \"Treemacs\" text will be displayed.
Setting this to `none' will disable the modeline.
For more specific information about formatting mode line check `mode-line-format'."
For more specific information about formatting mode line check
`mode-line-format'."
:type 'sexp
:group 'treemacs)

11
lisp/treemacs/treemacs-diagnostics.el
View File

@@ -16,7 +16,8 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; WIP implementation of diagnostics display.
;; WIP implementation of diagnostics display.
;;; Code:
@@ -42,12 +43,12 @@
(defface treemacs-diagnostic-error-face
'((t :underline "red"))
"TODO"
"TODO."
:group 'treemacs-faces)
(defface treemacs-diagnostic-warning-face
'((t :underline "yellow"))
"TODO"
"TODO."
:group 'treemacs-faces)
(defun treemacs--reset-and-save-diagnosics (path diagnostics)
@@ -73,8 +74,8 @@ features several pre-made faces named `treemacs-diagnostic-*-face'.
This method is debounced, it will never run more often than once every 3
seconds. In addition the use of a lazy thunk ensures that potentially expensive
transformations happen only once and only when required. Performance is thus not
expected to be a major issue.
transformations happen only once and only when required. Performance is thus
not expected to be a major issue.
A basic example use would look like this:

18
lisp/treemacs/treemacs-dom.el
View File

@@ -16,7 +16,8 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Basically this: https://github.com/Alexander-Miller/treemacs/issues/143
;; Basically this: https://github.com/Alexander-Miller/treemacs/issues/143.
;;; Code:
@@ -123,7 +124,7 @@ SELF: Dom Node Struct"
ret))))
(define-inline treemacs-on-expand (key pos)
"Rearrange the dom when node at KEY with POS is expanded.
"Re-arrange the dom when node at KEY with POS is expanded.
KEY: Node Path
POS: Marker"
@@ -142,9 +143,9 @@ POS: Marker"
(treemacs-dom-node->insert-into-dom! dom-node)))))
(define-inline treemacs-on-collapse (key &optional purge)
"Rearragne the dom when node at KEY was collapsed.
"Re-arrange the dom when node at KEY was collapsed.
Will remove NODE's parent/child link and invalidate the position and refresh
data of NODE and all its children. When PURGE is non-nil will instead remove
data of NODE and all its children. When PURGE is non-nil will instead remove
NODE and its children from the dom.
KEY: Node Path
@@ -166,7 +167,7 @@ Purge: Boolean"
(define-inline treemacs--on-purged-collapse (dom-node)
"Run when a DOM-NODE is collapsed with a purge (prefix) argument.
Will remove all of DOM-NODE's children from the dom.
Will remove all the children of DOM-NODE from the dom.
DOM-NODE: Dom Node Struct"
(inline-letevals (dom-node)
@@ -243,9 +244,10 @@ levels the one currently visiting.
NODE: Dom Node Struct
FN: (Dom Node) -> Any"
(declare (indent 1))
(funcall fn node)
(dolist (it (treemacs-dom-node->children node))
(treemacs-walk-dom it fn)))
(-let [children (treemacs-dom-node->children node)]
(funcall fn node)
(dolist (it children)
(treemacs-walk-dom it fn))))
(defun treemacs-walk-dom-exclusive (node fn)
"Same as `treemacs-walk-dom', but start NODE will not be passed to FN.

40
lisp/treemacs/treemacs-extensions.el
View File

@@ -16,7 +16,8 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; API required for writing extensions for/with treemacs.
;; API required for writing extensions for/with treemacs.
;;; Code:
@@ -40,7 +41,8 @@
(defmacro treemacs--build-extension-addition (name)
"Internal building block.
Creates a `treemacs-define-${NAME}-extension' function and the necessary helpers."
Creates a `treemacs-define-${NAME}-extension' function and the necessary
helpers."
(let ((define-function-name (intern (s-lex-format "treemacs-define-${name}-extension")))
(top-extension-point (intern (s-lex-format "treemacs--${name}-top-extensions")))
(bottom-extension-point (intern (s-lex-format "treemacs--${name}-bottom-extensions"))))
@@ -50,8 +52,8 @@ Creates a `treemacs-define-${NAME}-extension' function and the necessary helpers
(cl-defun ,define-function-name (&key extension predicate position)
,(s-lex-format
"Define an extension of type `${name}' for treemacs to use.
EXTENSION is an extension function, as created by `treemacs-define-expandable-node'
when a `:root' argument is given.
EXTENSION is an extension function, as created by
`treemacs-define-expandable-node' when a `:root' argument is given.
PREDICATE is a function that will be called to determine whether the extension
should be displayed. It is invoked with a single argument, which is the treemacs
@@ -71,7 +73,8 @@ See also `treemacs-remove-${name}-extension'.")
(defmacro treemacs--build-extension-removal (name)
"Internal building block.
Creates a `treemacs-remove-${NAME}-extension' function and the necessary helpers."
Creates a `treemacs-remove-${NAME}-extension' function and the necessary
helpers."
(let ((remove-function-name (intern (s-lex-format "treemacs-remove-${name}-extension")))
(top-extension-point (intern (s-lex-format "treemacs--${name}-top-extensions")))
(bottom-extension-point (intern (s-lex-format "treemacs--${name}-bottom-extensions"))))
@@ -224,8 +227,8 @@ variable and a `treemacs-${name}-icon' icon variable. If the icon should not be
static, and should be instead computed every time this node is rendered in its
parent's :render-action use 'dynamic-icon as a value for ICON.
The ICON is a string that should be created with `treemacs-as-icon'. If the icon
is for a file you can also use `treemacs-icon-for-file'.
The ICON is a string that should be created with `treemacs-as-icon'. If the
icon is for a file you can also use `treemacs-icon-for-file'.
RET-ACTION, TAB-ACTION and MOUSE1-ACTION are function references that will be
invoked when RET or TAB are pressed or mouse1 is double-clicked a node of this
@@ -267,12 +270,11 @@ type. VISIT-ACTION is used in `treemacs-visit-node-no-split' actions."
"Define a type of node with given NAME that can be further expanded.
ICON-OPEN and ICON-CLOSED are strings and must be created by `treemacs-as-icon'.
They will be defvar'd as 'treemacs-icon-${name}-open/closed'.
As an alternative to static icons you can also supply ICON-OPEN-FORM and
ICON-CLOSED-FORM that will be dynamically executed whenever a new icon is
needed. Keep in mind that, since child nodes are first rendered by their
parents, an ICON-CLOSED-FORM will need to be repeated in the parent's
RENDER-ACTION.
They will be defvar'd as 'treemacs-icon-${name}-open/closed'. As an alternative
to static icons you can also supply ICON-OPEN-FORM and ICON-CLOSED-FORM that
will be dynamically executed whenever a new icon is needed. Keep in mind that,
since child nodes are first rendered by their parents, an ICON-CLOSED-FORM will
need to be repeated in the parent's RENDER-ACTION.
QUERY-FUNCTION is a form and will be invoked when the node is expanded. It must
provide the list of elements that will be rendered with RENDER-ACTION.
@@ -284,8 +286,8 @@ bound under the name `item'. The form itself should end in a call to
RET-ACTION will define what function is called when RET is pressed on this type
of node. Only RET, without TAB and mouse1 can be defined since for expandable
nodes both TAB and RET should toggle expansion/collapse. VISIT-ACTION is used in
`treemacs-visit-node-no-split' actions.
nodes both TAB and RET should toggle expansion/collapse. VISIT-ACTION is used
in `treemacs-visit-node-no-split' actions.
AFTER-EXPAND and AFTER-COLLAPSE are optional forms that will be called after a
node has been expanded or collapsed. The closed or opened node marker will be
@@ -306,8 +308,8 @@ way as the KEY-FORM argument in `treemacs-render-node'.
TOP-LEVEL-MARKER works much the same way as ROOT-MARKER (and is mutually
exclusive with it). The difference is that it declares the node defined here to
a top level element with nothing above it, like a project, instead of a
top level node *inside* a project. Other than that things work the same. Setting
a top level element with nothing above it, like a project, instead of a top
level node *inside* a project. Other than that things work the same. Setting
TOP-LEVEL-MARKER will define a function named `treemacs-${NAME}-extension' that
can be passed to `treemacs-define-root-extension', and it requires the same
additional keys."
@@ -523,8 +525,8 @@ child nodes when expanded. For example think of an extension that groups buffers
based on the major mode, with each major-mode being its own top-level group, so
it is not known which (if any) major-mode groupings exist.
Works the same as `treemacs-define-expandable-node', so the same restrictions and
rules apply for QUERY-FUNCTION, RENDER-ACTION and ROOT-KEY-FORM."
Works the same as `treemacs-define-expandable-node', so the same restrictions
and rules apply for QUERY-FUNCTION, RENDER-ACTION and ROOT-KEY-FORM."
(declare (indent 1))
`(treemacs-define-expandable-node ,name
:icon-closed ""

13
lisp/treemacs/treemacs-faces.el
View File

@@ -16,7 +16,8 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Treemacs faces.
;; Treemacs faces.
;;; Code:
@@ -102,7 +103,7 @@ variant), so it will only be used if git-mode is disabled or set to simple."
(defface treemacs-git-conflict-face
'((t :inherit error))
"Face for conlicting files."
"Face for conflicting files."
:group 'treemacs-faces)
(defface treemacs-tags-face
@@ -139,12 +140,18 @@ variant), so it will only be used if git-mode is disabled or set to simple."
(defface treemacs-header-button-face
'((t :inherit 'font-lock-keyword-face))
"Face used for header buttons like
"Face used for header buttons.
Applies to buttons like
- `treemacs-header-close-button'
- `treemacs-header-projects-button'
- `treemacs-header-workspace-button'"
:group 'treemacs-faces)
(defface treemacs-peek-mode-indicator-face
'((t :background "#669966"))
"Face used to indicate that `treemacs-peek-mode' is enabled."
:group 'treemacs-faces)
(provide 'treemacs-faces)
;;; treemacs-faces.el ends here

304
lisp/treemacs/treemacs-file-management.el Normal file
View File

@@ -0,0 +1,304 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Everything related to file management.
;; NOTE: This module is lazy-loaded.
;;; Code:
(require 'dash)
(require 'treemacs-core-utils)
(require 'treemacs-visuals)
(require 'treemacs-filewatch-mode)
(require 'treemacs-logging)
(require 'treemacs-rendering)
(eval-when-compile
(require 'inline)
(require 'treemacs-macros))
(with-eval-after-load 'recentf
(declare-function recentf-remove-if-non-kept "recentf")
(declare-function treemacs--remove-from-recentf-after-move/rename "treemacs-file-management")
(defun treemacs--remove-from-recentf-after-move/rename (path _)
"Remove PATH from recentf after the file was moved or renamed."
(recentf-remove-if-non-kept path))
(add-hook 'treemacs-rename-file-functions #'treemacs--remove-from-recentf-after-move/rename)
(add-hook 'treemacs-move-file-functions #'treemacs--remove-from-recentf-after-move/rename)
(add-hook 'treemacs-delete-file-functions #'recentf-remove-if-non-kept))
(defconst treemacs--file-node-states
'(file-node-open file-node-closed dir-node-open dir-node-closed)
"List of node states treemacs is able to rename/delete etc.")
(define-inline treemacs--is-node-file-manageable? (btn)
"Determines whether BTN is a file node treemacs can rename/delete."
(declare (side-effect-free t))
(inline-letevals (btn)
(inline-quote
(memq (treemacs-button-get ,btn :state)
treemacs--file-node-states))))
;;;###autoload
(defun treemacs-delete-file (&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--select-file-from-btn btn "Delete: "))
(file-name (propertize (treemacs--filename path) 'face 'font-lock-string-face)))
(cond
((file-symlink-p 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."))))
((file-regular-p path)
(if (yes-or-no-p (format "Delete '%s' ? " file-name))
(delete-file path delete-by-moving-to-trash)
(treemacs-return (treemacs-log "Cancelled."))))
((file-directory-p 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)))
(run-hook-with-args 'treemacs-delete-file-functions path)
(treemacs-log "Deleted %s."
(propertize path 'face 'font-lock-string-face))))
(treemacs--evade-image))))
(defalias 'treemacs-delete #'treemacs-delete-file)
(make-obsolete #'treemacs-delete #'treemacs-delete-file "v2.9.3")
;;;###autoload
(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))
;;;###autoload
(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))
(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 (lambda (from to)
(if (file-directory-p from)
(copy-directory from to)
(copy-file from to)))
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 #'rename-file
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--select-file-from-btn
node (if (eq action :copy "File to copy: " "File to move: "))))
(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 (treemacs-join-path 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)
(run-hook-with-args
(pcase action
(:copy 'treemacs-copy-file-functions)
(:move 'treemacs-move-file-functions))
source target)
(treemacs-pulse-on-success finish-msg
(propertize source-name 'face 'font-lock-string-face)
(propertize destination 'face 'font-lock-string-face)))))))
;;;###autoload
(cl-defun treemacs-rename-file ()
"Rename the file/directory at point.
Buffers visiting the renamed file or visiting a file inside the renamed
directory and windows showing them will be reloaded. The list of recent files
will likewise be updated."
(interactive)
(treemacs-block
(treemacs-unless-let (btn (treemacs-current-button))
(treemacs-pulse-on-failure "Nothing to rename here.")
(-let [old-path (treemacs--select-file-from-btn btn "Rename: ")]
(treemacs-error-return-if (null old-path)
"Found nothing to rename here.")
(treemacs-error-return-if (not (treemacs--is-node-file-manageable? btn))
"Only files and directories can be deleted.")
(treemacs-error-return-if (not (file-exists-p old-path))
"The file to be renamed does not exist.")
(let* ((old-name (treemacs--filename old-path))
(new-name (treemacs--read-string
"New name: " (file-name-nondirectory old-path)))
(dir (treemacs--parent-dir old-path))
(new-path (treemacs-join-path dir new-name))
(parent (treemacs-button-get btn :parent)))
(treemacs-error-return-if
(and (file-exists-p new-path)
(or (not (eq 'darwin system-type))
(not (string= old-name new-name))))
"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-update-node (treemacs-button-get parent :path)))))
(treemacs--reload-buffers-after-rename old-path new-path)
(run-hook-with-args
'treemacs-rename-file-functions
old-path new-path)
(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)))))))
(defalias 'treemacs-rename #'treemacs-rename-file)
(make-obsolete #'treemacs-rename #'treemacs-rename-file "v2.9.3")
;;;###autoload
(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))
;;;###autoload
(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--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--select-file-from-btn it "Create in: ")
(expand-file-name "~")))
(path-to-create (treemacs-canonical-path
(read-file-name
(if is-file? "Create File: " "Create Directory: ")
(treemacs--add-trailing-slash
(if (file-directory-p curr-path)
curr-path
(treemacs--parent-dir 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 (treemacs--parent-dir path-to-create)]
(unless (file-exists-p dir)
(make-directory dir t))
(write-region "" nil path-to-create nil 0))
(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-btn (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 (treemacs-button-get created-under-btn :collapsed)
(treemacs-update-node (treemacs-button-get (treemacs-button-get created-under-btn :parent) :path))
(treemacs-update-node (treemacs-button-get created-under-btn :path))))
(treemacs-goto-file-node path-to-create project)
(recenter))
(treemacs-pulse-on-success
"Created %s." (propertize path-to-create 'face 'font-lock-string-face)))))
(defun treemacs--select-file-from-btn (btn prompt)
"Select the file represented by BTN for file management.
Offer a specifying dialogue with PROMPT when BTN is flattened."
(declare (side-effect-free t))
(-if-let (collapse-info (treemacs-button-get btn :collapsed))
(completing-read prompt collapse-info nil :require-match)
(treemacs-button-get btn :key)))
(provide 'treemacs-file-management)
;;; treemacs-file-management.el ends here

37
lisp/treemacs/treemacs-filewatch-mode.el
View File

@@ -16,10 +16,14 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; File event watch and reaction implementation.
;;; Open directories are put under watch and file changes event collected even if filewatch-mode
;;; is disabled. This allows to remove deleted files from all the caches they are in. Activating
;;; filewatch-mode will therefore only enable automatic refresh of treemacs buffers.
;; File event watch and reaction implementation.
;; Open directories are put under watch and file changes event
;; collected even if filewatch-mode is disabled. This allows to
;; remove deleted files from all the caches they are in. Activating
;; filewatch-mode will therefore only enable automatic refresh of
;; treemacs buffers.
;;; Code:
@@ -108,8 +112,8 @@ COLLAPSE: Bool"
"Stop watching PATH for file events.
This also means stopping the watch over all dirs below path.
Must be called inside the treemacs buffer since it will remove `current-buffer'
from PATH's watch list. Does not apply if this is called in reaction to a file
being deleted. In this case ALL is t and all buffers watching PATH will be
from PATH's watch list. Does not apply if this is called in reaction to a file
being deleted. In this case ALL is t and all buffers watching PATH will be
removed from the filewatch hashes.
PATH: Filepath
@@ -150,6 +154,11 @@ An event counts as relevant when
(not (or (eq action 'stopped)
(and (eq action 'changed)
(not treemacs-git-mode))
(and treemacs-hide-gitignored-files-mode
(let* ((file (caddr ,event))
(parent (treemacs--parent-dir file))
(cache (ht-get treemacs--git-cache parent)))
(and cache (not (string= "!" (ht-get cache file))))))
(let* ((dir (caddr ,event))
(filename (treemacs--filename dir)))
(--any? (funcall it filename dir) treemacs-ignored-file-predicates)))))))))
@@ -210,8 +219,10 @@ Extracted only so `treemacs--process-file-events' can decide when to call
(treemacs-run-in-every-buffer
(treemacs-save-position
(-let [treemacs--no-messages (or treemacs-silent-refresh treemacs-silent-filewatch)]
(treemacs--recursive-refresh))
(hl-line-highlight)))))
(dolist (project (treemacs-workspace->projects workspace))
(-when-let (root-node (-> project (treemacs-project->path) (treemacs-find-in-dom)))
(treemacs--recursive-refresh-descent root-node project)))))
(hl-line-highlight))))
(defun treemacs--process-file-events ()
"Process the file events that have been collected.
@@ -265,13 +276,13 @@ Called when filewatch mode is disabled."
(treemacs--cancel-refresh-timer))))
(define-minor-mode treemacs-filewatch-mode
"Minor mode to let treemacs autorefresh itself on file system changes.
"Minor mode to let treemacs auto-refresh itself on file system changes.
Activating this mode enables treemacs to watch the files it is displaying (and
only those) for changes and automatically refresh its view when it detects a
change that it decides is relevant.
A file change event is relevant for treemacs if a new file has been created or
deleted or a file has been changed and `treemacs-git-mode' is enabled. Events
deleted or a file has been changed and `treemacs-git-mode' is enabled. Events
caused by files that are ignored as per `treemacs-ignored-file-predicates' are
counted as not relevant.
@@ -279,8 +290,12 @@ The refresh is not called immediately after an event was received, treemacs
instead waits `treemacs-file-event-delay' ms to see if any more files have
changed to avoid having to refresh multiple times over a short period of time.
Due to limitations in the underlying kqueue library this mode may not be able to
track file modifications on MacOS, making it miss potentially useful updates
when used in combination with `treemacs-git-mode.'
The watch mechanism only applies to directories opened *after* this mode has
been activated. This means that to enable file watching in an already existing
been activated. This means that to enable file watching in an already existing
treemacs buffer it needs to be torn down and rebuilt by calling `treemacs' or
`treemacs-projectile'.

49
lisp/treemacs/treemacs-find-ignored-files.py Normal file
View File

@@ -0,0 +1,49 @@
from subprocess import Popen, PIPE
from os.path import exists
import sys
GIT_CMD = "git clean -ndX"
STDOUT = sys.stdout.buffer
def quote(string):
return b'"' + string + b'"'
def process_git_output(root, proc):
root_bytes = bytes(root, "utf-8")
count = 0
for line in proc.stdout:
# output has the form 'Would remove /a/b/c'
# final newline and final slash also need to go
path = line.replace(b"Would remove ", b"")[:-1]
if path.endswith(b"/"):
path = path[:-1]
ignored_file = root_bytes + b"/" + path
ignored_file_parent = ignored_file[:ignored_file.rindex(b"/")]
STDOUT.write(quote(ignored_file_parent))
STDOUT.write(quote(ignored_file))
# arbitrary limit of no more than 100 files
count += 1
if count > 100:
break
def main():
roots = sys.argv[1:]
procs = []
for root in roots:
if exists(root + "/.git"):
proc = Popen(GIT_CMD, shell=True, stdout=PIPE, bufsize=100, cwd=root)
procs.append((root, proc))
STDOUT.write(b"(")
for (root, proc) in procs:
process_git_output(root, proc)
STDOUT.write(b")")
main()

8
lisp/treemacs/treemacs-follow-mode.el
View File

@@ -16,14 +16,14 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Follow mode definition.
;; Follow mode definition.
;;; Code:
(require 'hl-line)
(require 'dash)
(require 's)
(require 'f)
(require 'treemacs-customization)
(require 'treemacs-rendering)
(require 'treemacs-dom)
@@ -63,7 +63,7 @@ not visible."
(when (and treemacs-window
current-file
(not (s-starts-with? treemacs--buffer-name-prefix (buffer-name current-buffer)))
(f-exists? current-file))
(file-exists-p current-file))
(-when-let (project-for-file (treemacs--find-project-for-buffer current-file))
(with-selected-window treemacs-window
(-let [selected-file (--if-let (treemacs-current-button)
@@ -100,7 +100,7 @@ not visible."
(define-minor-mode treemacs-follow-mode
"Toggle `treemacs-follow-mode'.
When enabled treemacs will keep track of and focus the currently selected
buffer's file. This only applies if the file is within the treemacs root
buffer's file. This only applies if the file is within the treemacs root
directory.
This functionality can also be manually invoked with `treemacs-find-file'."
:init-value nil

7
lisp/treemacs/treemacs-fringe-indicator.el
View File

@@ -16,7 +16,8 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Handling of visuals in general and icons in particular.
;; Handling of visuals in general and icons in particular.
;;; Code:
@@ -84,8 +85,8 @@ WINDOW is the treemacs window that has just been focused or unfocused."
(define-minor-mode treemacs-fringe-indicator-mode
"Toggle `treemacs-fringe-indicator-mode'.
When enabled, a visual indicator in the fringe will be displayed to highlight
the selected line in addition to hl-line-mode. Useful if hl-line-mode doesn't
stand out enough with your color theme.
the selected line in addition to `hl-line-mode'. Useful if `hl-line-mode'
doesn't stand out enough with your colour theme.
Can be called with one of two arguments:

3
lisp/treemacs/treemacs-header-line.el
View File

@@ -16,7 +16,8 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Variations of header-line-format treemacs can use.
;; Variations of header-line-format treemacs can use.
;;; Code:

126
lisp/treemacs/treemacs-hydras.el
View File

@@ -16,8 +16,10 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Definition for the Helpful Hydras.
;;; NOTE: This module is lazy-loaded.
;; Definition for the Helpful Hydras.
;; NOTE: This module is lazy-loaded.
;;; Code:
@@ -34,10 +36,21 @@
treemacs-edit-workspaces
treemacs-version)
(treemacs-import-functions-from "treemacs-file-management"
treemacs-rename-file
treemacs-create-file
treemacs-create-dir
treemacs-copy-file
treemacs-move-file
treemacs-delete-file)
(treemacs-import-functions-from "treemacs-hydras"
treemacs--common-helpful-hydra/body
treemacs--advanced-helpful-hydra/body)
(treemacs-import-functions-from "treemacs-peek-mode"
treemacs-peek-mode)
(cl-defun treemacs--find-keybind (func &optional (pad 8))
"Find the keybind for FUNC in treemacs.
Return of cons of the key formatted for inclusion in the hydra string, including
@@ -108,12 +121,15 @@ find the key a command is bound to it will show a blank instead."
(key-open-ace-v (treemacs--find-keybind #'treemacs-visit-node-ace-vertical-split))
(key-open-ext (treemacs--find-keybind #'treemacs-visit-node-in-external-application))
(key-open-mru (treemacs--find-keybind #'treemacs-visit-node-in-most-recently-used-window))
(key-open-close (treemacs--find-keybind #'treemacs-visit-node-close-treemacs))
(key-close-above (treemacs--find-keybind #'treemacs-collapse-parent-node))
(key-follow-mode (treemacs--find-keybind #'treemacs-follow-mode))
(key-fringe-mode (treemacs--find-keybind #'treemacs-fringe-indicator-mode))
(key-fwatch-mode (treemacs--find-keybind #'treemacs-filewatch-mode))
(key-git-mode (treemacs--find-keybind #'treemacs-git-mode))
(key-show-dotfiles (treemacs--find-keybind #'treemacs-toggle-show-dotfiles))
(key-indent-guide (treemacs--find-keybind #'treemacs-indent-guide-mode))
(key-show-gitignore (treemacs--find-keybind #'treemacs-hide-gitignored-files-mode))
(key-toggle-width (treemacs--find-keybind #'treemacs-toggle-fixed-width))
(key-add-project (treemacs--find-keybind #'treemacs-add-project-to-workspace 12))
(key-remove-project (treemacs--find-keybind #'treemacs-remove-project-from-workspace 12))
@@ -124,33 +140,35 @@ find the key a command is bound to it will show a blank instead."
%s
%s (%s)
%s ^^^^^^^^│ %s ^^^^^^^^^^^│ %s ^^^^^^│ %s
――――――――――――――――――――――――┼――――――――――――――――――――――――――――┼―――――――――――――――――――――――――┼――――――――――――――――――――――――――
%s next Line ^^^^│ %s dwim TAB ^^^^│ %s follow mode ^^^^│ %s add project
%s prev line ^^^^│ %s dwim RET ^^^^│ %s filewatch mode ^^^^│ %s remove project
%s next neighbour ^^^^│ %s open no split ^^^^│ %s git mode ^^^^│ %s rename project
%s prev neighbour ^^^^│ %s open horizontal ^^^^│ %s show dotfiles ^^^^│
%s goto parent ^^^^│ %s open vertical ^^^^│ %s resizability ^^^^│
%s down next window ^^^^│ %s open ace ^^^^│ %s fringe indicator ^^^^│
%s up next window ^^^^│ %s open ace horizontal ^^^^│ │
%s root up ^^^^│ %s open ace vertical ^^^^│ │
%s root down ^^^^│ %s open mru window ^^^^│ │
│ %s open externally ^^^^│ │
│ %s close parent ^^^^│ │
%s ^^^^^^^^│ %s ^^^^^^^^^^^│ %s ^^^^^^│ %s
――――――――――――――――――――――――┼――――――――――――――――――――――――――――┼――――――――――――――――――――――――――――――┼――――――――――――――――――――――――――
%s next Line ^^^^│ %s dwim TAB ^^^^│ %s follow mode ^^^^│ %s add project
%s prev line ^^^^│ %s dwim RET ^^^^│ %s filewatch mode ^^^^│ %s remove project
%s next neighbour ^^^^│ %s open no split ^^^^│ %s git mode ^^^^│ %s rename project
%s prev neighbour ^^^^│ %s open horizontal ^^^^│ %s show dotfiles ^^^^│
%s goto parent ^^^^│ %s open vertical ^^^^│ %s show gitignored files ^^^^│
%s down next window ^^^^│ %s open ace ^^^^│ %s resizability ^^^^│
%s up next window ^^^^│ %s open ace horizontal ^^^^│ %s fringe indicator ^^^^│
%s root up ^^^^│ %s open ace vertical ^^^^│ %s indent guide ^^^^│
%s root down ^^^^│ %s open mru window ^^^^│ │
│ %s open externally ^^^^│ │
│ %s open close treemacs ^^^^│ │
│ %s close parent ^^^^│ │
"
title
adv-hint (car (s-split":" (car key-adv-hydra)))
column-nav column-nodes column-toggles column-projects
(car key-next-line) (car key-tab) (car key-follow-mode) (car key-add-project)
(car key-prev-line) (car key-ret) (car key-fwatch-mode) (car key-remove-project)
(car key-next-neighbour) (car key-open) (car key-git-mode) (car key-rename-project)
column-nav column-nodes column-toggles column-projects
(car key-next-line) (car key-tab) (car key-follow-mode) (car key-add-project)
(car key-prev-line) (car key-ret) (car key-fwatch-mode) (car key-remove-project)
(car key-next-neighbour) (car key-open) (car key-git-mode) (car key-rename-project)
(car key-prev-neighbour) (car key-open-horiz) (car key-show-dotfiles)
(car key-goto-parent) (car key-open-vert) (car key-toggle-width)
(car key-down-next-w) (car key-open-ace) (car key-fringe-mode)
(car key-up-next-w) (car key-open-ace-h)
(car key-root-up) (car key-open-ace-v)
(car key-goto-parent) (car key-open-vert) (car key-show-gitignore)
(car key-down-next-w) (car key-open-ace) (car key-toggle-width)
(car key-up-next-w) (car key-open-ace-h) (car key-fringe-mode)
(car key-root-up) (car key-open-ace-v) (car key-indent-guide)
(car key-root-down) (car key-open-mru)
(car key-open-ext)
(car key-open-close)
(car key-close-above))))
(eval
`(defhydra treemacs--common-helpful-hydra (:exit nil :hint nil :columns 4)
@@ -175,17 +193,20 @@ find the key a command is bound to it will show a blank instead."
(,(cdr key-open-ace-v) #'treemacs-visit-node-ace-vertical-split)
(,(cdr key-open-mru) #'treemacs-visit-node-in-most-recently-used-window)
(,(cdr key-open-ext) #'treemacs-visit-node-in-external-application)
(,(cdr key-open-close) #'treemacs-visit-node-close-treemacs)
(,(cdr key-close-above) #'treemacs-collapse-parent-node)
(,(cdr key-follow-mode) #'treemacs-follow-mode)
(,(cdr key-show-dotfiles) #'treemacs-toggle-show-dotfiles)
(,(cdr key-show-gitignore) #'treemacs-hide-gitignored-files-mode)
(,(cdr key-toggle-width) #'treemacs-toggle-fixed-width)
(,(cdr key-fringe-mode) #'treemacs-fringe-indicator-mode)
(,(cdr key-indent-guide) #'treemacs-indent-guide-mode)
(,(cdr key-git-mode) #'treemacs-git-mode)
(,(cdr key-fwatch-mode) #'treemacs-filewatch-mode)
(,(cdr key-add-project) #'treemacs-add-project-to-workspace)
(,(cdr key-remove-project) #'treemacs-remove-project-from-workspace)
(,(cdr key-rename-project) #'treemacs-rename-project)
("ESC" nil "Exit"))))
("<escape>" nil "Exit"))))
(treemacs--common-helpful-hydra/body))
(treemacs-log-failure "The helpful hydra cannot be summoned without an existing treemacs buffer.")))
@@ -209,14 +230,15 @@ find the key a command is bound to it will show a blank instead."
(column-files (propertize "File Management" 'face 'treemacs-help-column-face))
(column-ws (propertize "Workspaces" 'face 'treemacs-help-column-face))
(column-misc (propertize "Misc." 'face 'treemacs-help-column-face))
(column-window (propertize "Other Window." 'face 'treemacs-help-column-face))
(common-hint (format "%s %s"
(propertize "For common keybinds see" 'face 'treemacs-help-title-face)
(propertize "treemacs-common-helpful-hydra" 'face 'font-lock-function-name-face)))
(key-common-hydra (treemacs--find-keybind #'treemacs-common-helpful-hydra))
(key-create-file (treemacs--find-keybind #'treemacs-create-file))
(key-create-dir (treemacs--find-keybind #'treemacs-create-dir))
(key-rename (treemacs--find-keybind #'treemacs-rename))
(key-delete (treemacs--find-keybind #'treemacs-delete))
(key-rename (treemacs--find-keybind #'treemacs-rename-file))
(key-delete (treemacs--find-keybind #'treemacs-delete-file))
(key-copy-file (treemacs--find-keybind #'treemacs-copy-file))
(key-move-file (treemacs--find-keybind #'treemacs-move-file))
(key-refresh (treemacs--find-keybind #'treemacs-refresh))
@@ -231,42 +253,48 @@ find the key a command is bound to it will show a blank instead."
(key-remove-ws (treemacs--find-keybind #'treemacs-remove-workspace 12))
(key-rename-ws (treemacs--find-keybind #'treemacs-rename-workspace 12))
(key-switch-ws (treemacs--find-keybind #'treemacs-switch-workspace 12))
(key-next-ws (treemacs--find-keybind #'treemacs-next-workspace 12))
(key-fallback-ws (treemacs--find-keybind #'treemacs-set-fallback-workspace 12))
(key-peek (treemacs--find-keybind #'treemacs-peek-mode 10))
(key-line-down (treemacs--find-keybind #'treemacs-next-line-other-window 10))
(key-line-up (treemacs--find-keybind #'treemacs-previous-line-other-window 10))
(key-page-down (treemacs--find-keybind #'treemacs-next-page-other-window 10))
(key-page-up (treemacs--find-keybind #'treemacs-previous-page-other-window 10))
(hydra-str
(format
"
%s
%s (%s)
%s ^^^^^^^^^^^^^│ %s ^^^^^^^^│ %s
――――――――――――――――――――┼―――――――――――――――――――――――――――――┼―――――――――――――――――――――
%s create file ^^^^│ %s Edit Workspaces ^^^^^^^^│ %s refresh
%s create dir ^^^^│ %s Create Workspace ^^^^^^^^│ %s (re)set width
%s rename ^^^^│ %s Remove Workspace ^^^^^^^^│ %s copy path absolute
%s delete ^^^^│ %s Rename Workspace ^^^^^^^^│ %s copy path relative
%s copy ^^^^│ %s Switch Workspace ^^^^^^^^│ %s copy root path
%s move ^^^^│ %s Set Fallback ^^^^^^^^│ %s re-sort
│ │ %s bookmark
%s ^^^^^^^^^^^^^│ %s ^^^^^^^^│ %s ^^^^^^^^^^^│ %s
――――――――――――――――――――┼―――――――――――――――――――――――――――――┼――――――――――――――――――――┼――――――――――――――――――――――
%s create file ^^^^│ %s Edit Workspaces ^^^^^^^^│ %s peek ^^^^^^│ %s refresh
%s create dir ^^^^│ %s Create Workspace ^^^^^^^^│ %s line down ^^^^^^│ %s (re)set width
%s rename ^^^^│ %s Remove Workspace ^^^^^^^^│ %s line up ^^^^^^│ %s copy path absolute
%s delete ^^^^│ %s Rename Workspace ^^^^^^^^│ %s page down ^^^^^^│ %s copy path relative
%s copy ^^^^│ %s Switch Workspace ^^^^^^^^│ %s page up ^^^^^^│ %s copy root path
%s move ^^^^│ %s Next Workspace ^^^^^^^^│ │ %s re-sort
│ %s Set Fallback ^^^^^^^^│ │ %s bookmark
"
title
common-hint (car (s-split":" (car key-common-hydra)))
column-files column-ws column-misc
(car key-create-file) (car key-edit-ws) (car key-refresh)
(car key-create-dir) (car key-create-ws) (car key-set-width)
(car key-rename) (car key-remove-ws) (car key-copy-path-abs)
(car key-delete) (car key-rename-ws) (car key-copy-path-rel)
(car key-copy-file) (car key-switch-ws) (car key-copy-root)
(car key-move-file) (car key-fallback-ws) (car key-resort)
(car key-bookmark))))
column-files column-ws column-window column-misc
(car key-create-file) (car key-edit-ws) (car key-peek) (car key-refresh)
(car key-create-dir) (car key-create-ws) (car key-line-down) (car key-set-width)
(car key-rename) (car key-remove-ws) (car key-line-up) (car key-copy-path-abs)
(car key-delete) (car key-rename-ws) (car key-page-down) (car key-copy-path-rel)
(car key-copy-file) (car key-switch-ws) (car key-page-up) (car key-copy-root)
(car key-move-file) (car key-next-ws) (car key-resort)
(car key-fallback-ws) (car key-bookmark))))
(eval
`(defhydra treemacs--advanced-helpful-hydra (:exit nil :hint nil :columns 3)
,hydra-str
(,(cdr key-common-hydra) #'treemacs-common-helpful-hydra :exit t)
(,(cdr key-create-file) #'treemacs-create-file)
(,(cdr key-create-dir) #'treemacs-create-dir)
(,(cdr key-rename) #'treemacs-rename)
(,(cdr key-delete) #'treemacs-delete)
(,(cdr key-rename) #'treemacs-rename-file)
(,(cdr key-delete) #'treemacs-delete-file)
(,(cdr key-copy-file) #'treemacs-copy-file)
(,(cdr key-move-file) #'treemacs-move-file)
(,(cdr key-refresh) #'treemacs-refresh)
@@ -281,8 +309,14 @@ find the key a command is bound to it will show a blank instead."
(,(cdr key-remove-ws) #'treemacs-remove-workspace)
(,(cdr key-rename-ws) #'treemacs-rename-workspace)
(,(cdr key-switch-ws) #'treemacs-switch-workspace)
(,(cdr key-next-ws) #'treemacs-next-workspace)
(,(cdr key-fallback-ws) #'treemacs-set-fallback-workspace)
("ESC" nil "Exit"))))
(,(cdr key-peek) #'treemacs-peek-mode)
(,(cdr key-line-down) #'treemacs-next-line-other-window)
(,(cdr key-line-up) #'treemacs-previous-line-other-window)
(,(cdr key-page-down) #'treemacs-next-page-other-window)
(,(cdr key-page-up) #'treemacs-previous-previous-other-window)
("<escape>" nil "Exit"))))
(treemacs--advanced-helpful-hydra/body))
(treemacs-log-failure "The helpful hydra cannot be summoned without an existing treemacs buffer.")))

100
lisp/treemacs/treemacs-icons.el
View File

@@ -16,8 +16,10 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Most of everything related to icons is handled here. Specifically the
;;; definition, instantiation, customization, resizing and resetting of icons.
;; Most of everything related to icons is handled here. Specifically
;; the definition, instantiation, customization, resizing and
;; resetting of icons.
;;; Code:
@@ -51,21 +53,17 @@
(eval-and-compile
(defvar treemacs--not-selected-icon-background
(pcase (face-attribute 'default :background nil t)
('unspecified
(prog1 "#2d2d31"
(unless (or noninteractive (boundp 'treemacs-no-load-time-warnings))
(message "[Treemacs] Warning: coudn't find default background colour for icons, falling back on #2d2d31."))))
('unspecified-bg
(prog1 "#2d2d31"
(unless (or noninteractive (boundp 'treemacs-no-load-time-warnings))
(message "[Treemacs] Warning: background colour is unspecified, icons will likely look wrong. Falling back on #2d2d31."))))
((or 'unspecified 'unspecified-bg "unspecified" "unspecified-bg")
(unless (or noninteractive (boundp 'treemacs-no-load-time-warnings))
(message "[Treemacs] Warning: coudn't find default background colour for icons, falling back on #2d2d31."))
"#2d2d31" )
(other other)))
"Background for non-selected icons.")
(eval-and-compile
(defvar treemacs--selected-icon-background
(-let [bg (face-attribute 'hl-line :background nil t)]
(if (memq bg '(unspecified unspecified-b))
(if (member bg '(unspecified unspecified-b "unspecified" "unspecified-bg"))
(prog1 treemacs--not-selected-icon-background
(unless (or noninteractive (boundp 'treemacs-no-load-time-warnings))
(message "[Treemacs] Warning: couldn't find hl-line-mode's background color for icons, falling back on %s."
@@ -148,7 +146,7 @@ Also called as advice after `load-theme', hence the ignored argument."
"Will return non-nil when Emacs is unable to create images.
In this scenario (usually caused by running Emacs without a graphical
environment) treemacs will not create any of its icons and will be forced to
permanently use its simple string icon fallack."
permanently use its simple string icon fallback."
(declare (pure t) (side-effect-free t))
(inline-quote (not (image-type-available-p 'png))))
@@ -228,7 +226,7 @@ Necessary since root icons are not rectangular."
- FILE is a file path relative to the icon directory of the current theme.
- ICON is a string of an already created icon. Mutually exclusive with FILE.
- FALLBACK is the fallback string for situations where png images are
unavailable.
unavailable. Can be set to `same-as-icon' to use the same value as ICON.
- ICONS-DIR can optionally be used to overwrite the path used to find icons.
Normally the current theme's icon-path is used, but it may be convenient to
use another when calling `treemacs-modify-theme'.
@@ -241,36 +239,39 @@ Necessary since root icons are not rectangular."
accessible."
(treemacs-static-assert (or (null icon) (null file))
"FILE and ICON arguments are mutually exclusive")
`(let* ((icons-dir ,(if icons-dir icons-dir `(treemacs-theme->path treemacs--current-theme)))
(icon-path ,(if file `(f-join icons-dir ,file) nil))
(icon-pair ,(if file `(treemacs--create-icon-strings icon-path ,fallback)
`(cons ,(treemacs--splice-icon icon) ,fallback)))
(gui-icons (treemacs-theme->gui-icons treemacs--current-theme))
(tui-icons (treemacs-theme->tui-icons treemacs--current-theme))
(gui-icon (car icon-pair))
(tui-icon (cdr icon-pair)))
,(unless file
`(progn
(ignore icon-path)
(ignore icons-dir)))
;; prefer to have icons as empty strings with a display property for compatibility
;; in e.g. dired, where an actual text icon would break `dired-goto-file-1'
(unless (get-text-property 0 'display gui-icon)
(setf gui-icon (propertize " " 'display gui-icon)))
,@(->> (-filter #'symbolp extensions)
(--map `(progn (add-to-list 'treemacs--icon-symbols ',it)
(defvar ,(intern (format "treemacs-icon-%s" it)) nil))))
(--each ',extensions
(ht-set! gui-icons it gui-icon)
(ht-set! tui-icons it tui-icon))))
(-let [ext-list (--map (if (stringp it) (downcase it) it)
(if (symbolp extensions) (symbol-value extensions) extensions))]
`(let* ((fallback ,(if (equal fallback (quote 'same-as-icon))
icon
fallback))
(icons-dir ,(if icons-dir icons-dir `(treemacs-theme->path treemacs--current-theme)))
(icon-path ,(if file `(treemacs-join-path icons-dir ,file) nil))
(icon-pair ,(if file `(treemacs--create-icon-strings icon-path fallback)
`(cons ,(treemacs--splice-icon icon) fallback)))
(gui-icons (treemacs-theme->gui-icons treemacs--current-theme))
(tui-icons (treemacs-theme->tui-icons treemacs--current-theme))
(gui-icon (car icon-pair))
(tui-icon (cdr icon-pair)))
,(unless file
`(progn
(ignore icon-path)
(ignore icons-dir)))
;; prefer to have icons as empty strings with a display property for compatibility
;; in e.g. dired, where an actual text icon would break `dired-goto-file-1'
(unless (get-text-property 0 'display gui-icon)
(setf gui-icon (propertize " " 'display gui-icon)))
,@(->> (-filter #'symbolp ext-list)
(--map `(progn (add-to-list 'treemacs--icon-symbols ',it)
(defvar ,(intern (format "treemacs-icon-%s" it)) nil))))
(--each (quote ,ext-list)
(ht-set! gui-icons it gui-icon)
(ht-set! tui-icons it tui-icon)))))
(treemacs-create-theme "Default"
:icon-directory (f-join treemacs-dir "icons/default")
:icon-directory (treemacs-join-path treemacs-dir "icons/default")
:config
(progn
;; directory and other icons
;; TODO(2020/12/30): temporary workaround for issues like #752, to be removed in 2 months
(treemacs-create-icon :file "vsc/root-closed.png" :extensions (root) :fallback "")
(treemacs-create-icon :file "vsc/root-closed.png" :extensions (root-closed) :fallback "")
(treemacs-create-icon :file "vsc/root-open.png" :extensions (root-open) :fallback "")
(treemacs-create-icon :file "vsc/dir-closed.png" :extensions (dir-closed) :fallback (propertize "+ " 'face 'treemacs-term-node-face))
@@ -297,7 +298,10 @@ Necessary since root icons are not rectangular."
(treemacs-create-icon :file "emacs.png" :extensions ("el" "elc"))
(treemacs-create-icon :file "ledger.png" :extensions ("ledger"))
(treemacs-create-icon :file "yaml.png" :extensions ("yml" "yaml" "travis.yml"))
(treemacs-create-icon :file "shell.png" :extensions ("sh" "zsh" "fish"))
(treemacs-create-icon
:file "shell.png"
:extensions ("sh" "zsh" "zshrc" "zshenv" "fish" "zprofile" "zlogin" "zlogout" "bash"
"bash_profile" "bashrc" "bash_login" "profile" "bash_aliases"))
(treemacs-create-icon :file "pdf.png" :extensions ("pdf"))
(treemacs-create-icon :file "c.png" :extensions ("c" "h"))
(treemacs-create-icon :file "haskell.png" :extensions ("hs" "lhs"))
@@ -308,7 +312,6 @@ Necessary since root icons are not rectangular."
(treemacs-create-icon :file "asciidoc.png" :extensions ("adoc" "asciidoc"))
(treemacs-create-icon :file "rust.png" :extensions ("rs"))
(treemacs-create-icon :file "image.png" :extensions ("jpg" "jpeg" "bmp" "svg" "png" "xpm" "gif"))
(treemacs-create-icon :file "emacs.png" :extensions ("el" "elc"))
(treemacs-create-icon :file "clojure.png" :extensions ("clj" "cljs" "cljc"))
(treemacs-create-icon :file "ts.png" :extensions ("ts" "tsx"))
(treemacs-create-icon :file "vue.png" :extensions ("vue"))
@@ -320,6 +323,7 @@ Necessary since root icons are not rectangular."
(treemacs-create-icon :file "jar.png" :extensions ("jar"))
(treemacs-create-icon :file "kotlin.png" :extensions ("kt"))
(treemacs-create-icon :file "scala.png" :extensions ("scala"))
(treemacs-create-icon :file "gradle.png" :extensions ("gradle"))
(treemacs-create-icon :file "sbt.png" :extensions ("sbt"))
(treemacs-create-icon :file "go.png" :extensions ("go"))
(treemacs-create-icon :file "systemd.png" :extensions ("service" "timer"))
@@ -433,7 +437,7 @@ Necessary since root icons are not rectangular."
(treemacs-create-icon :file "vsc/sql.png" :extensions ("sql"))
(treemacs-create-icon :file "vsc/toml.png" :extensions ("toml"))
(treemacs-create-icon :file "vsc/nim.png" :extensions ("nim"))
(treemacs-create-icon :file "vsc/org.png" :extensions ("org"))
(treemacs-create-icon :file "vsc/org.png" :extensions ("org" "org_archive"))
(treemacs-create-icon :file "vsc/perl.png" :extensions ("pl" "pm" "perl"))
(treemacs-create-icon :file "vsc/vim.png" :extensions ("vimrc" "tridactylrc" "vimperatorrc" "ideavimrc" "vrapperrc"))
(treemacs-create-icon :file "vsc/deps.png" :extensions ("cask"))
@@ -530,6 +534,20 @@ down-cased state."
(downcase ext)
(concat icon " "))))
;;;###autoload
(defun treemacs-define-custom-image-icon (file &rest file-extensions)
"Same as `treemacs-define-custom-icon' but for image icons instead of strings.
FILE is the path to an icon image (and not the actual icon string).
FILE-EXTENSIONS are all the (not case-sensitive) file extensions the icon
should be used for."
(unless file
(user-error "Custom icon cannot be nil"))
(-let [icon (car (treemacs--create-icon-strings file " "))]
(dolist (ext file-extensions)
(ht-set! (treemacs-theme->gui-icons treemacs--current-theme)
(downcase ext)
icon))))
;;;###autoload
(defun treemacs-map-icons-with-auto-mode-alist (extensions mode-icon-alist)
"Remaps icons for EXTENSIONS according to `auto-mode-alist'.

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)

11
lisp/treemacs/treemacs-logging.el
View File

@@ -16,7 +16,8 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Implementation for logging messages.
;; Implementation for logging messages.
;;; Code:
@@ -49,12 +50,12 @@ Not used directly, but as part of `treemacs-without-messages'.")
(defmacro treemacs--do-log (prefix msg &rest args)
"Print a log statement with the given PREFIX and MSG and format ARGS."
`(progn
(unless (listp treemacs--saved-eldoc-display)
(unless (consp treemacs--saved-eldoc-display)
(setf treemacs--saved-eldoc-display (list treemacs-eldoc-display)))
(setf treemacs-eldoc-display nil)
(unless treemacs--no-messages
(message "%s %s" ,prefix (format ,msg ,@args)))
(add-hook 'post-command-hook #'treemacs--restore-eldoc-after-log)))
(add-hook 'pre-command-hook #'treemacs--restore-eldoc-after-log)))
(defmacro treemacs-log (msg &rest args)
"Write an info/success log statement given format string MSG and ARGS."
@@ -67,14 +68,14 @@ Not used directly, but as part of `treemacs-without-messages'.")
"Write a warning/failure log statement given format string MSG and ARGS."
(declare (indent 1))
`(treemacs--do-log
(propertize "[Treemacs Failure]" 'face '((:inherit warning :weight bold)))
(propertize "[Treemacs]" 'face '((:inherit warning :weight bold)))
,msg ,@args))
(defmacro treemacs-log-err (msg &rest args)
"Write an error log statement given format string MSG and ARGS."
(declare (indent 1))
`(treemacs--do-log
(propertize "[Treemacs Error]" 'face '((:inherit warning :weight bold)))
(propertize "[Treemacs]" 'face '((:inherit error :weight bold)))
,msg ,@args))
(provide 'treemacs-logging)

59
lisp/treemacs/treemacs-macros.el
View File

@@ -16,14 +16,14 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; General purpose macros, and those used in, but defined outside of
;;; treemacs-core-utils.el are put here, to prevent using them before their
;;; definition, hopefully preventing issues like #97.
;; General purpose macros, and those used in, but defined outside of
;; treemacs-core-utils.el are put here, to prevent using them before
;; their definition, hopefully preventing issues like #97.
;;; Code:
(require 'dash)
(require 'f)
(require 's)
(require 'pcase)
@@ -161,12 +161,12 @@ executed."
(&key no-match-explanation
window
split-function
save-window
ensure-window-split
dir-action
file-action
tag-section-action
tag-action)
tag-action
window-arg)
"Infrastructure macro for setting up actions on different button states.
Fetches the currently selected button and verifies it's in the correct state
@@ -175,16 +175,16 @@ based on the given state actions.
If it isn't it will log NO-MATCH-EXPLANATION, if it is it selects WINDOW (or
`next-window' if none is given) and splits it with SPLIT-FUNCTION if given.
If SAVE-WINDOW is non-nil the selected window will remain selected after the
actions have been executed.
If ENSURE-WINDOW-SPLIT is non-nil treemacs will vertically split the window if
treemacs is the only window to make sure a buffer is opened next to it, not
under or below it.
DIR-ACTION, FILE-ACTION, TAG-SECTION-ACTION and TAG-ACTION are inserted into a
`pcase' statement matching the buttons state. Project root nodes are treated
the same common directory nodes."
the same common directory nodes.
WINDOW-ARG determines whether the treemacs windows should remain selected,
\(single prefix arg), or deleted (double prefix arg)."
(declare (debug (&rest [sexp form])))
(let ((valid-states (list)))
(when dir-action
@@ -235,9 +235,11 @@ the same common directory nodes."
(funcall visit-action btn)
(error "No match achieved even though button's state %s was part of the set of valid states %s"
state ',valid-states))))
(when ,save-window
(select-window current-window))))))))))
(pcase ,window-arg
('(4) (select-window current-window))
('(16) (delete-window current-window)))))))))))
;; TODO(2021/08/28): RM
(defmacro treemacs--without-filewatch (&rest body)
"Run BODY without triggering the filewatch callback.
Required for manual interactions with the file system (like deletion), otherwise
@@ -278,7 +280,7 @@ not work keep it on the same line."
(treemacs-goto-file-node curr-file))
((or 'dir-node-open 'dir-node-closed 'file-node-open 'file-node-closed)
;; stay on the same file
(if (and (file-exists-p curr-file)
(if (and (treemacs-is-path-visible? curr-file)
(or treemacs-show-hidden-files
(not (s-matches? treemacs-dotfiles-regex (treemacs--filename curr-file)))))
(treemacs-goto-file-node curr-file)
@@ -286,7 +288,7 @@ not work keep it on the same line."
;; try dodging to our immediate neighbours, if they are no longer visible either
;; keep going up
(cl-labels
((can-move-to (it) (and (file-exists-p it)
((can-move-to (it) (and (treemacs-is-path-visible? it)
(or treemacs-show-hidden-files
(not (s-matches? treemacs-dotfiles-regex (treemacs--filename it)))))))
(cond
@@ -316,7 +318,8 @@ not work keep it on the same line."
(-let [buffer-point (point)]
(with-selected-window curr-window
;; recenter starts counting at 0
(recenter (1- curr-win-line))
(-let [scroll-margin 0]
(recenter (1- curr-win-line)))
(set-window-point (selected-window) buffer-point))))
,@final-form)))
@@ -372,16 +375,16 @@ Entry variables will bound based on NAMES which is a list of two elements."
,table)))
(defmacro treemacs-error-return (error-msg &rest msg-args)
"Early return failure from `treemacs-block'.
Will pass ERROR-MSG and MSG-ARGS to `treemacs-pulse-on-failure'."
"Interactive early return failure from `treemacs-block'.
Will also pass ERROR-MSG and MSG-ARGS to `treemacs-pulse-on-failure'."
(declare (indent 1) (debug (form body)))
`(cl-return-from __body__
(treemacs-pulse-on-failure ,error-msg ,@msg-args)))
(defmacro treemacs-error-return-if (predicate error-msg &rest msg-args)
"Early return from `treemacs-block'.
When PREDICATE returns non-nil value will pass ERROR-MSG and MSG-ARGS to
`treemacs-pulse-on-failure'."
"Interactive early return from `treemacs-block'.
Checks if PREDICATE returns a non-nil value, and will pass also ERROR-MSG and
MSG-ARGS to `treemacs-pulse-on-failure'."
(declare (indent 1) (debug (form sexp body)))
`(when ,predicate
(cl-return-from __body__
@@ -392,7 +395,7 @@ When PREDICATE returns non-nil value will pass ERROR-MSG and MSG-ARGS to
(declare (debug t))
`(cl-return-from __body__ ,ret))
(defmacro treemacs-return-if (predicate ret)
(defmacro treemacs-return-if (predicate &optional ret)
"Early return from `treemacs-block'.
When PREDICATE returns non-nil RET will be returned."
(declare (indent 1) (debug (form sexp)))
@@ -528,8 +531,18 @@ Based on a timer GUARD variable run function with the given DELAY and BODY."
(run-with-idle-timer
,delay nil
(lambda ()
,@body
(setf ,guard nil))))))
(unwind-protect
(progn ,@body)
(setf ,guard nil)))))))
(defmacro treemacs-without-recenter (&rest body)
"Run BODY without the usual recentering for expanded nodes.
Specifically `treemacs--no-recenter' will be set to 't' so that
`treemacs--maybe-recenter' will have no effect during non-interactive updates
triggered by e.g. filewatch-mode."
(declare (debug t))
`(let ((treemacs--no-recenter t))
,@body))
(provide 'treemacs-macros)

289
lisp/treemacs/treemacs-mode.el
View File

@@ -1,4 +1,4 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;;; treemacs-mode.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
@@ -16,13 +16,13 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Major mode definition.
;; Major mode definition.
;;; Code:
(require 'eldoc)
(require 's)
(require 'f)
(require 'treemacs-interface)
(require 'treemacs-customization)
(require 'treemacs-faces)
@@ -83,111 +83,125 @@ Will be set by `treemacs--post-command'.")
ob)
"Treemacs' own eldoc obarray.")
;; no warning - we cannot require treemacs.el where all the autoloaded functions
;; are defined or we get a recursive require, so it's either this or an equally
;; large block of `declare-function'
(with-no-warnings
(defvar treemacs-project-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "r") #'treemacs-rename-project)
(define-key map (kbd "a") #'treemacs-add-project-to-workspace)
(define-key map (kbd "d") #'treemacs-remove-project-from-workspace)
(define-key map (kbd "c c") #'treemacs-collapse-project)
(define-key map (kbd "c o") #'treemacs-collapse-other-projects)
(define-key map (kbd "c a") #'treemacs-collapse-all-projects)
map)
"Keymap for project-related commands in `treemacs-mode'.")
(defvar treemacs-workspace-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "r") #'treemacs-rename-workspace)
(define-key map (kbd "a") #'treemacs-create-workspace)
(define-key map (kbd "d") #'treemacs-remove-workspace)
(define-key map (kbd "s") #'treemacs-switch-workspace)
(define-key map (kbd "e") #'treemacs-edit-workspaces)
(define-key map (kbd "f") #'treemacs-set-fallback-workspace)
map)
"Keymap for workspace-related commands in `treemacs-mode'.")
(defvar treemacs-node-visit-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "v") #'treemacs-visit-node-vertical-split)
(define-key map (kbd "h") #'treemacs-visit-node-horizontal-split)
(define-key map (kbd "o") #'treemacs-visit-node-no-split)
(define-key map (kbd "aa") #'treemacs-visit-node-ace)
(define-key map (kbd "ah") #'treemacs-visit-node-ace-horizontal-split)
(define-key map (kbd "av") #'treemacs-visit-node-ace-vertical-split)
(define-key map (kbd "r") #'treemacs-visit-node-in-most-recently-used-window)
(define-key map (kbd "x") #'treemacs-visit-node-in-external-application)
map)
"Keymap for node-visiting commands in `treemacs-mode'.")
(defvar treemacs-toggle-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "h") #'treemacs-toggle-show-dotfiles)
(define-key map (kbd "w") #'treemacs-toggle-fixed-width)
(define-key map (kbd "v") #'treemacs-fringe-indicator-mode)
(define-key map (kbd "g") #'treemacs-git-mode)
(define-key map (kbd "f") #'treemacs-follow-mode)
(define-key map (kbd "a") #'treemacs-filewatch-mode)
map)
"Keymap for commands that toggle state in `treemacs-mode'.")
(defvar treemacs-copy-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "a") #'treemacs-copy-absolute-path-at-point)
(define-key map (kbd "r") #'treemacs-copy-relative-path-at-point)
(define-key map (kbd "p") #'treemacs-copy-project-path-at-point)
(define-key map (kbd "f") #'treemacs-copy-file)
map)
"Keymap for copy commands in `treemacs-mode'.")
(defvar treemacs-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "?") #'treemacs-common-helpful-hydra)
(define-key map (kbd "C-?") #'treemacs-advanced-helpful-hydra)
(define-key map [down-mouse-1] #'treemacs-leftclick-action)
(define-key map [drag-mouse-1] #'treemacs-dragleftclick-action)
(define-key map [double-mouse-1] #'treemacs-doubleclick-action)
(define-key map [mouse-3] #'treemacs-rightclick-menu)
(define-key map [tab] #'treemacs-TAB-action)
(define-key map [?\t] #'treemacs-TAB-action)
(define-key map [return] #'treemacs-RET-action)
(define-key map (kbd "RET") #'treemacs-RET-action)
(define-key map (kbd "r") #'treemacs-refresh)
(define-key map (kbd "d") #'treemacs-delete)
(define-key map (kbd "cf") #'treemacs-create-file)
(define-key map (kbd "cd") #'treemacs-create-dir)
(define-key map (kbd "R") #'treemacs-rename)
(define-key map (kbd "u") #'treemacs-goto-parent-node)
(define-key map (kbd "q") #'treemacs-quit)
(define-key map (kbd "Q") #'treemacs-kill-buffer)
(define-key map (kbd "o") treemacs-node-visit-map)
(define-key map (kbd "P") #'treemacs-peek)
(define-key map (kbd "n") #'treemacs-next-line)
(define-key map (kbd "p") #'treemacs-previous-line)
(define-key map (kbd "M-N") #'treemacs-next-line-other-window)
(define-key map (kbd "M-P") #'treemacs-previous-line-other-window)
(define-key map (kbd "<prior>") #'treemacs-previous-page-other-window)
(define-key map (kbd "<next>") #'treemacs-next-page-other-window)
(define-key map (kbd "M-n") #'treemacs-next-neighbour)
(define-key map (kbd "M-p") #'treemacs-previous-neighbour)
(define-key map (kbd "t") treemacs-toggle-map)
(define-key map (kbd "w") #'treemacs-set-width)
(define-key map (kbd "y") treemacs-copy-map)
(define-key map (kbd "m") #'treemacs-move-file)
(define-key map (kbd "g") #'treemacs-refresh)
(define-key map (kbd "s") #'treemacs-resort)
(define-key map (kbd "b") #'treemacs-add-bookmark)
(define-key map (kbd "C-c C-p") treemacs-project-map)
(define-key map (kbd "C-c C-w") treemacs-workspace-map)
(define-key map (kbd "<M-up>") #'treemacs-move-project-up)
(define-key map (kbd "<M-down>") #'treemacs-move-project-down)
(define-key map (kbd "<backtab>") #'treemacs-collapse-all-projects)
(define-key map (kbd "C-j") #'treemacs-next-project)
(define-key map (kbd "C-k") #'treemacs-previous-project)
(define-key map (kbd "h") #'treemacs-root-up)
(define-key map (kbd "l") #'treemacs-root-down)
(define-key map (kbd "H") #'treemacs-collapse-parent-node)
(define-key map (kbd "!") #'treemacs-run-shell-command-for-current-node)
(define-key map (kbd "M-!") #'treemacs-run-shell-command-in-project-root)
map)
"Keymap for `treemacs-mode'."))
(defvar treemacs-project-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "r") 'treemacs-rename-project)
(define-key map (kbd "a") 'treemacs-add-project-to-workspace)
(define-key map (kbd "d") 'treemacs-remove-project-from-workspace)
(define-key map (kbd "c c") 'treemacs-collapse-project)
(define-key map (kbd "c o") 'treemacs-collapse-other-projects)
(define-key map (kbd "c a") 'treemacs-collapse-all-projects)
map)
"Keymap for project-related commands in `treemacs-mode'.")
(defvar treemacs-workspace-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "r") 'treemacs-rename-workspace)
(define-key map (kbd "a") 'treemacs-create-workspace)
(define-key map (kbd "d") 'treemacs-remove-workspace)
(define-key map (kbd "s") 'treemacs-switch-workspace)
(define-key map (kbd "e") 'treemacs-edit-workspaces)
(define-key map (kbd "f") 'treemacs-set-fallback-workspace)
(define-key map (kbd "n") 'treemacs-next-workspace)
map)
"Keymap for workspace-related commands in `treemacs-mode'.")
(defvar treemacs-node-visit-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "v") 'treemacs-visit-node-vertical-split)
(define-key map (kbd "c") 'treemacs-visit-node-close-treemacs)
(define-key map (kbd "h") 'treemacs-visit-node-horizontal-split)
(define-key map (kbd "o") 'treemacs-visit-node-no-split)
(define-key map (kbd "aa") 'treemacs-visit-node-ace)
(define-key map (kbd "ah") 'treemacs-visit-node-ace-horizontal-split)
(define-key map (kbd "av") 'treemacs-visit-node-ace-vertical-split)
(define-key map (kbd "r") 'treemacs-visit-node-in-most-recently-used-window)
(define-key map (kbd "x") 'treemacs-visit-node-in-external-application)
map)
"Keymap for node-visiting commands in `treemacs-mode'.")
(defvar treemacs-toggle-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "h") 'treemacs-toggle-show-dotfiles)
(define-key map (kbd "i") 'treemacs-hide-gitignored-files-mode)
(define-key map (kbd "w") 'treemacs-toggle-fixed-width)
(define-key map (kbd "v") 'treemacs-fringe-indicator-mode)
(define-key map (kbd "g") 'treemacs-git-mode)
(define-key map (kbd "f") 'treemacs-follow-mode)
(define-key map (kbd "a") 'treemacs-filewatch-mode)
(define-key map (kbd "n") 'treemacs-indent-guide-mode)
map)
"Keymap for commands that toggle state in `treemacs-mode'.")
(defvar treemacs-copy-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "a") 'treemacs-copy-absolute-path-at-point)
(define-key map (kbd "r") 'treemacs-copy-relative-path-at-point)
(define-key map (kbd "p") 'treemacs-copy-project-path-at-point)
(define-key map (kbd "f") 'treemacs-copy-file)
map)
"Keymap for copy commands in `treemacs-mode'.")
(defvar treemacs-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "?") 'treemacs-common-helpful-hydra)
(define-key map (kbd "C-?") 'treemacs-advanced-helpful-hydra)
(define-key map [down-mouse-1] 'treemacs-leftclick-action)
(define-key map [drag-mouse-1] 'treemacs-dragleftclick-action)
(define-key map [double-mouse-1] 'treemacs-doubleclick-action)
(define-key map [mouse-3] 'treemacs-rightclick-menu)
(define-key map [tab] 'treemacs-TAB-action)
(define-key map [?\t] 'treemacs-TAB-action)
(define-key map [return] 'treemacs-RET-action)
(define-key map (kbd "RET") 'treemacs-RET-action)
(define-key map (kbd "r") 'treemacs-refresh)
(define-key map (kbd "d") 'treemacs-delete-file)
(define-key map (kbd "cf") 'treemacs-create-file)
(define-key map (kbd "cd") 'treemacs-create-dir)
(define-key map (kbd "R") 'treemacs-rename-file)
(define-key map (kbd "u") 'treemacs-goto-parent-node)
(define-key map (kbd "q") 'treemacs-quit)
(define-key map (kbd "Q") 'treemacs-kill-buffer)
(define-key map (kbd "o") treemacs-node-visit-map)
(define-key map (kbd "P") 'treemacs-peek-mode)
(define-key map (kbd "n") 'treemacs-next-line)
(define-key map (kbd "p") 'treemacs-previous-line)
(define-key map (kbd "M-N") 'treemacs-next-line-other-window)
(define-key map (kbd "M-P") 'treemacs-previous-line-other-window)
(define-key map (kbd "<prior>") 'treemacs-previous-page-other-window)
(define-key map (kbd "<next>") 'treemacs-next-page-other-window)
(define-key map (kbd "M-n") 'treemacs-next-neighbour)
(define-key map (kbd "M-p") 'treemacs-previous-neighbour)
(define-key map (kbd "t") treemacs-toggle-map)
(define-key map (kbd "w") 'treemacs-set-width)
(define-key map (kbd "<") 'treemacs-decrease-width)
(define-key map (kbd ">") 'treemacs-increase-width)
(define-key map (kbd "y") treemacs-copy-map)
(define-key map (kbd "m") 'treemacs-move-file)
(define-key map (kbd "g") 'treemacs-refresh)
(define-key map (kbd "s") 'treemacs-resort)
(define-key map (kbd "b") 'treemacs-add-bookmark)
(define-key map (kbd "C-c C-p") treemacs-project-map)
(define-key map (kbd "C-c C-w") treemacs-workspace-map)
(define-key map (kbd "<M-up>") 'treemacs-move-project-up)
(define-key map (kbd "<M-down>") 'treemacs-move-project-down)
(define-key map (kbd "<backtab>") 'treemacs-collapse-all-projects)
(define-key map (kbd "C-j") 'treemacs-next-project)
(define-key map (kbd "C-k") 'treemacs-previous-project)
(define-key map (kbd "h") 'treemacs-COLLAPSE-action)
(define-key map (kbd "l") 'treemacs-RET-action)
(define-key map (kbd "M-h") 'treemacs-COLLAPSE-action)
(define-key map (kbd "M-l") 'treemacs-RET-action)
(define-key map (kbd "M-H") 'treemacs-root-up)
(define-key map (kbd "M-L") 'treemacs-root-down)
(define-key map (kbd "H") 'treemacs-collapse-parent-node)
(define-key map (kbd "!") 'treemacs-run-shell-command-for-current-node)
(define-key map (kbd "M-!") 'treemacs-run-shell-command-in-project-root)
(define-key map (kbd "C") 'treemacs-cleanup-litter)
(define-key map (kbd "=") 'treemacs-fit-window-width)
(define-key map (kbd "W") 'treemacs-extra-wide-toggle)
map)
"Keymap for `treemacs-mode'.")
(defun treemacs--setup-mode-line ()
"Create either a simple modeline, or integrate into spaceline."
@@ -219,6 +233,13 @@ If there is no node at point use \"~/\" instead.
Also skip hidden buttons (as employed by variadic extensions).
Used as a post command hook."
(let ((newline-char 10)
(point-max (point-max)))
(unless (= newline-char (char-before point-max))
(treemacs-with-writable-buffer
(save-excursion
(goto-char point-max)
(insert newline-char)))))
(-when-let (btn (treemacs-current-button))
(when (treemacs-button-get btn 'invisible)
(treemacs-next-line 1))
@@ -227,17 +248,55 @@ Used as a post command hook."
(treemacs--nearest-path btn))))
(when (and (treemacs-project->is-readable? project)
(file-readable-p path))
(setq treemacs--eldoc-msg path
(setf treemacs--eldoc-msg (treemacs--get-eldoc-message path)
default-directory (treemacs--add-trailing-slash
(if (file-directory-p path) path (file-name-directory path)))))
(setq treemacs--eldoc-msg nil
default-directory "~/"))))
(defun treemacs--get-eldoc-message (path)
"Set the eldoc message for given PATH.
Message will be either just the path, or the path plus meta info like file size,
depending on the value of `treemacs-eldoc-display'."
(pcase treemacs-eldoc-display
('detailed
(-let [attr (file-attributes path)]
(format "%s -- %s: %s %s: %s %s: %s"
(propertize path 'face 'font-lock-string-face)
(propertize "Size" 'face 'font-lock-keyword-face)
(propertize
(treemacs--human-readable-bytes (file-attribute-size attr))
'face 'font-lock-type-face)
(propertize "Last Modified" 'face 'font-lock-keyword-face)
(propertize
(format-time-string "%F %T" (file-attribute-modification-time attr))
'face 'font-lock-type-face)
(propertize "Permissions" 'face 'font-lock-keyword-face)
(propertize
(file-attribute-modes attr)
'face 'font-lock-type-face))))
('simple (propertize path 'face 'font-lock-string-face))
(_ (propertize path 'face 'font-lock-string-face))))
(define-inline treemacs--human-readable-bytes (bytes)
"Return a human-readable string version of BYTES."
(declare (pure t) (side-effect-free t))
(inline-letevals (bytes)
(inline-quote
(cl-loop with result = (cons "B" ,bytes)
for i in '("k" "M" "G" "T" "P" "E" "Z" "Y")
while (>= (cdr result) 1024.0)
do (setf result (cons i (/ (cdr result) 1024.0)))
finally return
(pcase (car result)
("B" (format "%sb" ,bytes))
(_ (format "%.1f%s" (cdr result) (car result))))))))
(defun treemacs--eldoc-function ()
"Treemacs' implementation of `eldoc-documentation-function'.
Will simply return `treemacs--eldoc-msg'."
(when (and treemacs-eldoc-display treemacs--eldoc-msg)
(propertize treemacs--eldoc-msg 'face 'font-lock-string-face)))
treemacs--eldoc-msg))
;;;###autoload
(define-derived-mode treemacs-mode special-mode "Treemacs"
@@ -247,7 +306,7 @@ Will simply return `treemacs--eldoc-msg'."
truncate-lines t
indent-tabs-mode nil
desktop-save-buffer nil
window-size-fixed (when treemacs--width-is-locked 'width)
window-size-fixed (when treemacs-width-is-initially-locked 'width)
treemacs--in-this-buffer t)
(unless treemacs-show-cursor
@@ -257,7 +316,7 @@ Will simply return `treemacs--eldoc-msg'."
(setq evil-treemacs-state-cursor
(if treemacs-show-cursor
evil-motion-state-cursor
'(hbar . 0)))))
'(bar . 0)))))
;; higher fuzz value makes it less likely to start a mouse drag
;; and make a switch to visual state
@@ -297,6 +356,9 @@ Will simply return `treemacs--eldoc-msg'."
(face-remap-add-relative 'fringe :background (car treemacs-window-background-color))
(face-remap-add-relative 'hl-line :background (cdr treemacs-window-background-color)))
(when treemacs-text-scale
(text-scale-increase treemacs-text-scale))
(add-hook 'window-configuration-change-hook #'treemacs--on-window-config-change)
(add-hook 'kill-buffer-hook #'treemacs--on-buffer-kill nil t)
(add-hook 'post-command-hook #'treemacs--post-command nil t)
@@ -344,7 +406,8 @@ Will run original MODE-ACTIVATION and its ARGS only when
(propertize "treemacs-select-window" 'face 'font-lock-function-name-face)
(propertize "treemacs-add-and-display-current-project" 'face 'font-lock-function-name-face)
(propertize
" \\
"\
\\
\\
____
/ \\

65
lisp/treemacs/treemacs-mouse-interface.el
View File

@@ -16,8 +16,10 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Functions relating to using the mouse in treemacs.
;;; NOTE: This module is lazy-loaded.
;; Functions relating to using the mouse in treemacs.
;; NOTE: This module is lazy-loaded.
;;; Code:
@@ -43,16 +45,21 @@
(defun treemacs--builtin-project-mouse-selection-menu ()
"Build a mouse selection menu for project.el projects."
(if (eq project--list 'unset)
(list (vector "Project.el list is empty" #'ignore))
(-let [projects
(->> project--list
(--map (treemacs-canonical-path (car it)))
(--reject (treemacs-is-path it :in-workspace))
(-sort #'string<))]
(if (null projects)
(list (vector "All Project.el projects are alread in the workspace" #'ignore))
(--map (vector it (lambda () (interactive) (treemacs-add-project-to-workspace it))) projects)))))
(pcase (if (fboundp 'project-known-project-roots)
(->> (project-known-project-roots)
(-map #'treemacs-canonical-path)
(-sort #'string<))
'unavailable)
(`unavailable
(list (vector "Project.el api is not available" #'ignore)))
(`nil
(list (vector "Project.el list is empty" #'ignore)))
(projects
(pcase (--reject (treemacs-is-path it :in-workspace) projects)
(`nil
(list (vector "All Project.el projects are alread in the workspace" #'ignore)))
(candidates
(--map (vector it (lambda () (interactive) (treemacs-add-project-to-workspace it))) candidates))))))
;;;###autoload
(defun treemacs-leftclick-action (event)
@@ -77,12 +84,13 @@ Must be bound to a mouse click, or EVENT will not be supplied."
;;;###autoload
(defun treemacs-doubleclick-action (event)
"Run the appropriate double-click action for the current node.
In the default configuration this means to do the same as `treemacs-RET-action'.
In the default configuration this means to expand/collapse directories and open
files and tags in the most recently used window.
This function's exact configuration is stored in
`treemacs-doubleclick-actions-config'.
Must be bound to a mouse click, or EVENT will not be supplied."
Must be bound to a mouse double click to properly handle a click EVENT."
(interactive "e")
(when (eq 'double-mouse-1 (elt event 0))
(goto-char (posn-point (cadr event)))
@@ -160,12 +168,12 @@ and ignore any prefix argument."
:dir-action (find-file-noselect (treemacs-safe-button-get btn :path))
:tag-action (treemacs--tag-noselect btn)
:window (selected-window)
:save-window t
:window-arg '(4)
:ensure-window-split nil
:no-match-explanation "")))
(defun treemacs--imenu-tag-noselect (file tag-path)
"Return a list of the source buffer for FILE and the position of the tag from TAG-PATH."
"Return a list of the source buffer for FILE and the tag's from TAG-PATH."
(let ((tag (-last-item tag-path))
(path (-butlast tag-path)))
(condition-case e
@@ -174,8 +182,8 @@ and ignore any prefix argument."
(let ((index (treemacs--get-imenu-index file)))
(dolist (path-item path)
(setq index (cdr (assoc path-item index))))
(-let [(buf . pos) (treemacs--extract-position
(cdr (--first (equal (car it) tag) index)))]
(-let [(buf . pos)
(treemacs--extract-position (cdr (--first (equal (car it) tag) index)) path)]
;; some imenu implementations, like markdown, will only provide
;; a raw buffer position (an int) to move to
(list (or buf (get-file-buffer file)) pos))))
@@ -200,7 +208,9 @@ and ignore any prefix argument."
(marker-position (save-excursion (xref-location-marker (xref-item-location item))))))
(-let [(tag-buf . tag-pos)
(treemacs-with-button-buffer btn
(-> btn (treemacs-button-get :marker) (treemacs--extract-position)))]
(let ((marker (treemacs-button-get :marker btn))
(path (treemacs-button-get :path btn)))
(treemacs--extract-position marker path)))]
(if tag-buf
(list tag-buf tag-pos)
(pcase treemacs-goto-tag-strategy
@@ -247,6 +257,7 @@ and ignore any prefix argument."
["Open" treemacs-visit-node-no-split :visible ,(check node)]
("Open With" :visible ,(not (null node))
["Open Directly" treemacs-visit-node-no-split]
["Open In External Application" treemacs-visit-node-in-external-application]
["Open With Vertical Split" treemacs-visit-node-vertical-split]
["Open With Horizontal Split" treemacs-visit-node-horizontal-split]
["Open With Ace" treemacs-visit-node-ace]
@@ -255,10 +266,10 @@ and ignore any prefix argument."
["Open Tags" treemacs-toggle-node :visible ,(check (memq state '(file-node-closed tag-node-closed)))]
["Close Tags" treemacs-toggle-node :visible ,(check (memq state '(file-node-open tag-node-open)))]
["--" #'ignore :visible ,(check node)]
["Rename" treemacs-rename :visible ,(check node)]
["Delete" treemacs-delete :visible ,(check node)]
["Move" treemacs-move-file :visible ,(check node)]
["--" #'ignore :visible ,(check node)]
["Rename" treemacs-rename-file :visible ,(check node)]
["Delete" treemacs-delete-file :visible ,(check node)]
["Move" treemacs-move-file :visible ,(check node)]
("Copy"
["Copy File" treemacs-copy-file :visible ,(check node)]
["Copy Absolute Path" treemacs-copy-absolute-path-at-point :visible ,(check node)]
@@ -300,12 +311,14 @@ and ignore any prefix argument."
(cmd (lookup-key menu (apply 'vector choice))))
;; In the terminal clicking on a nested menu item does not expand it, but actually
;; selects it as the chosen use option. So as a workaround we need to manually go
;; thtough the menus until we land on an executable command.
(while (not (commandp cmd))
;; through the menus until we land on an executable command.
(while (and (not (commandp cmd))
(not (eq cmd menu)))
(setf menu choice
choice (x-popup-menu event cmd)
cmd (lookup-key cmd (apply 'vector choice))))
(when cmd (call-interactively cmd))
(when (and cmd (commandp cmd))
(call-interactively cmd))
(hl-line-highlight)))))
(provide 'treemacs-mouse-interface)

149
lisp/treemacs/treemacs-peek-mode.el Normal file
View File

@@ -0,0 +1,149 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; TODO
;; NOTE: This module is lazy-loaded.
;;; Code:
(require 'treemacs-tags)
(require 'treemacs-core-utils)
(eval-when-compile
(require 'treemacs-macros))
(defvar treemacs--peek-timer nil)
(defvar treemacs--peeked-buffers nil)
(defvar treemacs--pre-peek-state nil
"List of window, buffer to restore and buffer to kill treemacs used for peeking.")
(defun treemacs--kill-peek-buffers ()
"Kill buffers opened during peeking that are no longer needed."
(-each treemacs--peeked-buffers #'kill-buffer)
(setf treemacs--peeked-buffers nil))
(defun treemacs--setup-peek-buffer (path)
"Setup the peek buffer and window for PATH."
(let* ((file-buffer (get-file-buffer path))
(next-window (next-window (selected-window)))
(window (if file-buffer
(or (get-buffer-window file-buffer)
next-window)
next-window)))
(save-selected-window
(select-window window)
(unless treemacs--pre-peek-state
(setf treemacs--pre-peek-state (list window (window-buffer window))))
(if file-buffer
(switch-to-buffer file-buffer :norecord)
(find-file-existing path)
(add-to-list 'treemacs--peeked-buffers (current-buffer))))))
(defun treemacs--do-peek ()
"Timer callback to set up the peeked buffer.
Check if the node at point is a file, and if yes take a peek."
(when (eq t treemacs--in-this-buffer)
(let* ((btn (treemacs-current-button))
(path (and btn (treemacs-button-get btn :path))))
(when (and path
(stringp path)
(file-exists-p path))
(treemacs--setup-peek-buffer path)))))
(defun treemacs--finish-peek-on-window-leave (&optional _)
"Finish peeking when the treemacs window is no longer selected.
Shut down peek-mode while making sure that the current buffer will not be
purged."
(let ((treemacs-buffer (treemacs-get-local-buffer))
(current-buffer (current-buffer)))
(unless (equal treemacs-buffer current-buffer)
(setf treemacs--peeked-buffers
(delete current-buffer treemacs--peeked-buffers))
(treemacs-peek-mode -1))))
(defun treemacs--setup-peek-mode ()
"Set up faces, timers, and hooks etc."
(when treemacs--fringe-indicator-overlay
(overlay-put treemacs--fringe-indicator-overlay
'face 'treemacs-peek-mode-indicator-face))
(when treemacs--peek-timer (cancel-timer treemacs--peek-timer))
(setf treemacs--peek-timer
(run-with-idle-timer 0.5 :repeat #'treemacs--do-peek))
(add-hook
'window-selection-change-functions #'treemacs--finish-peek-on-window-leave
nil :local))
(defun treemacs--tear-down-peek-mode (&optional restore-window)
"Tear down faces, timers.
Restore the initial window buffer when RESTORE-WINDOW is non-nil. Will only
happen when `treemacs-peek-mode' has been called interactively, when the
tear-down happens on account of the window-leave hook the current buffer is
kept."
(with-current-buffer (treemacs-get-local-buffer)
(when treemacs--fringe-indicator-overlay
(overlay-put treemacs--fringe-indicator-overlay
'face 'treemacs-fringe-indicator-face))
(when treemacs--peek-timer (cancel-timer treemacs--peek-timer))
(treemacs--kill-peek-buffers)
(remove-hook
'window-selection-change-functions
#'treemacs--finish-peek-on-window-leave
:local)
(when (and restore-window treemacs--pre-peek-state)
(-let [(window buffer) treemacs--pre-peek-state]
(with-selected-window window
(switch-to-buffer buffer))))
(setf treemacs--pre-peek-state nil)))
;;;###autoload
(define-minor-mode treemacs-peek-mode
"Minor mode that allows you to peek at buffers before deciding to open them.
While the mode is active treemacs will automatically display the file at point,
without leaving the treemacs window.
Peeking will stop when you leave the treemacs window, be it through a command
like `treemacs-RET-action' or some other window selection change.
Files' buffers that have been opened for peeking will be cleaned up if they did
not exist before peeking started.
The peeked window can be scrolled using
`treemacs-next/previous-line-other-window' and
`treemacs-next/previous-page-other-window'"
:init-value nil
:global t
:lighter nil
:group 'treemacs
(if treemacs-peek-mode
(progn
(unless (boundp 'window-selection-change-functions)
(user-error "%s %s"
"Peek-mode is only available in Emacs"
"versions that support `window-selection-change-functions'"))
(treemacs--setup-peek-mode))
(treemacs--tear-down-peek-mode (called-interactively-p 'interactive))))
(provide 'treemacs-peek-mode)
;;; treemacs-peek-mode.el ends here

20
lisp/treemacs/treemacs-persistence.el
View File

@@ -16,11 +16,11 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Persistence of treemacs' workspaces into an org-mode compatible file.
;; Persistence of treemacs' workspaces into an org-mode compatible file.
;;; Code:
(require 'f)
(require 's)
(require 'dash)
(require 'treemacs-workspaces)
@@ -40,19 +40,13 @@
"The name of the buffer used to edit treemacs' workspace.")
(defconst treemacs--last-error-persist-file
(f-join user-emacs-directory ".cache" "treemacs-persist-at-last-error")
(treemacs-join-path user-emacs-directory ".cache" "treemacs-persist-at-last-error")
"File that stores the treemacs state as it was during the last load error.")
(make-obsolete-variable 'treemacs--last-error-persist-file 'treemacs-last-error-persist-file "v2.7")
(defconst treemacs--persist-kv-regex
(rx bol
(? " ")
"- "
(or "path")
" :: "
(1+ (or (syntax word) (syntax symbol) (syntax punctuation) space))
eol)
(rx bol (? " ") "- path :: " (1+ any) eol)
"The regular expression to match org's \"key :: value\" lines.")
(defconst treemacs--persist-workspace-name-regex
@@ -201,7 +195,9 @@ ITER: Treemacs-Iter Struct"
"Read the relevant lines from given TXT or `treemacs-persist-file'.
Will read all lines, except those that start with # or contain only whitespace."
(-some->> (or txt (when (file-exists-p treemacs-persist-file)
(f-read treemacs-persist-file)))
(with-temp-buffer
(insert-file-contents treemacs-persist-file)
(buffer-string))))
(s-trim)
(s-lines)
(--reject (or (s-blank-str? it)
@@ -345,7 +341,7 @@ PROJ-COUNT: Int"
(apply #'concat (--map (concat it "\n") lines)))]
(unless (file-exists-p treemacs-last-error-persist-file)
(make-directory (file-name-directory treemacs-last-error-persist-file) :with-parents))
(f-write txt 'utf-8 treemacs-last-error-persist-file)))
(write-region txt nil treemacs-last-error-persist-file nil :silent)))
(add-hook 'kill-emacs-hook #'treemacs--persist)

5
lisp/treemacs/treemacs-pkg.el
View File

@@ -1,15 +1,14 @@
(define-package "treemacs" "20210107.1251" "A tree style file explorer package"
(define-package "treemacs" "20220104.1302" "A tree style file explorer package"
'((emacs "26.1")
(cl-lib "0.5")
(dash "2.11.0")
(s "1.12.0")
(f "0.11.0")
(ace-window "0.9.0")
(pfuture "1.7")
(hydra "0.13.2")
(ht "2.2")
(cfrs "1.3.2"))
:commit "c1109b9bd79f29078183a85646b7d95408604c36" :authors
:commit "deb7f2cd9eb06960798edd7393df2602902ed071" :authors
'(("Alexander Miller" . "alexanderm@web.de"))
:maintainer
'("Alexander Miller" . "alexanderm@web.de")

121
lisp/treemacs/treemacs-project-follow-mode.el Normal file
View File

@@ -0,0 +1,121 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Minor mode to automatically display just the current project.
;; NOTE: This module is lazy-loaded.
;;; Code:
(require 'treemacs-scope)
(require 'treemacs-follow-mode)
(require 'treemacs-core-utils)
(treemacs-import-functions-from "treemacs"
treemacs-display-current-project-exclusively)
(defvar treemacs--project-follow-timer nil
"Idle timer for `treemacs-project-follow-mode'.")
(defconst treemacs--project-follow-delay 1.5
"Delay in seconds for `treemacs-project-follow-mode'.")
(defun treemacs--follow-project (_)
"Debounced display of the current project for `treemacs-project-follow-mode'.
Used as a hook for `window-buffer-change-functions', thus the ignored parameter."
(treemacs-debounce treemacs--project-follow-timer treemacs--project-follow-delay
(-when-let (window (treemacs-get-local-window))
(treemacs-block
(let* ((ws (treemacs-current-workspace))
(new-project-path (treemacs--find-current-user-project))
(old-project-path (-some-> ws
(treemacs-workspace->projects)
(car)
(treemacs-project->path))))
(treemacs-return-if
(or treemacs--in-this-buffer
(null new-project-path)
(bound-and-true-p edebug-mode)
(frame-parent)
(and (= 1 (length (treemacs-workspace->projects ws)))
(string= new-project-path old-project-path))))
(-let [new-project-name (treemacs--filename new-project-path)]
(setf (treemacs-workspace->projects ws) nil)
(-let [add-result (treemacs-do-add-project-to-workspace
new-project-path new-project-name)]
(treemacs-return-if (not (eq 'success (car add-result)))
(treemacs-log-err "Something went wrong when adding project at '%s': %s"
(propertize new-project-path 'face 'font-lock-string-face)
add-result)))
(with-selected-window window
(treemacs--consolidate-projects))
(treemacs--follow)))))))
(defun treemacs--setup-project-follow-mode ()
"Setup all the hooks needed for `treemacs-project-follow-mode'."
(add-hook 'window-buffer-change-functions #'treemacs--follow-project)
(add-hook 'window-selection-change-functions #'treemacs--follow-project)
(treemacs--follow-project nil))
(defun treemacs--tear-down-project-follow-mode ()
"Remove the hooks added by `treemacs--setup-project-follow-mode'."
(cancel-timer treemacs--project-follow-timer)
(remove-hook 'window-buffer-change-functions #'treemacs--follow-project)
(remove-hook 'window-selection-change-functions #'treemacs--follow-project))
;;;###autoload
(define-minor-mode treemacs-project-follow-mode
"Toggle `treemacs-only-current-project-mode'.
This is a minor mode meant for those who do not care about treemacs' workspace
features, or its preference to work with multiple projects simultaneously. When
enabled it will function as an automated version of
`treemacs-display-current-project-exclusively', making sure that, after a small
idle delay, the current project, and *only* the current project, is displayed in
treemacs.
The project detection is based on the current buffer, and will try to determine
the project using the following methods, in the order they are listed:
- the current projectile.el project, if `treemacs-projectile' is installed
- the current project.el project
- the current `default-directory'
The update will only happen when treemacs is in the foreground, meaning a
treemacs window must exist in the current scope.
This mode requires at least Emacs version 27 since it relies on
`window-buffer-change-functions' and `window-selection-change-functions'."
:init-value nil
:global t
:lighter nil
:group 'treemacs
(if treemacs-project-follow-mode
(progn
(unless (and (boundp 'window-buffer-change-functions)
(boundp 'window-selection-change-functions))
(user-error "%s %s"
"Project-Follow-Mode is only available in Emacs"
"versions that support `window-buffer-change-functions'"))
(treemacs--setup-project-follow-mode))
(treemacs--tear-down-project-follow-mode)))
(provide 'treemacs-project-follow-mode)
;;; treemacs-project-follow-mode.el ends here

258
lisp/treemacs/treemacs-rendering.el
View File

@@ -16,15 +16,15 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code in this file is considered performance critical.
;;; The usual restrictions w.r.t quality, readability and maintainability are
;;; lifted here.
;; Code in this file is considered performance critical. The usual
;; restrictions w.r.t quality, readability and maintainability are
;; lifted here.
;;; Code:
(require 's)
(require 'ht)
(require 'f)
(require 'treemacs-core-utils)
(require 'treemacs-icons)
(require 'treemacs-async)
@@ -39,6 +39,9 @@
(require 'treemacs-macros)
(require 'inline))
(treemacs-import-functions-from "treemacs"
treemacs-select-window)
(treemacs-import-functions-from "treemacs-filewatch-mode"
treemacs--start-watching
treemacs--stop-watching)
@@ -47,6 +50,7 @@
treemacs--get-indentation)
(treemacs-import-functions-from "treemacs-interface"
treemacs-add-project-to-workspace
treemacs-TAB-action)
(treemacs-import-functions-from "treemacs-extensions"
@@ -64,12 +68,19 @@
(defvar-local treemacs--projects-end nil
"Marker pointing to position at the end of the last project.
If there are no projects, points to the position at the end of any top-level
extensions positioned to `TOP'. This can always be used as the insertion point
If there are no projects, points to the position at the end of any top level
extensions positioned to `TOP'. This can always be used as the insertion point
for new projects.")
(defvar treemacs--file-name-handler-alist nil
"Value of `file-name-handler-alist' when treemacs loads a directory's content.")
(defvar treemacs--no-recenter nil
"Set for non-interactive updates.
When non-nil `treemacs--maybe-recenter' will have no effect.")
(define-inline treemacs--projects-end ()
"Importable getter for `treemacs--projects-end'."
"Importable accessor for `treemacs--projects-end'."
(declare (side-effect-free t))
(inline-quote treemacs--projects-end))
@@ -89,7 +100,7 @@ is a marker pointing to POS."
(define-inline treemacs--lines-in-window ()
"Determine the number of lines visible in the current (treemacs) window.
A simple call to something like `window-screen-lines' is insufficient becase
A simple call to something like `window-screen-lines' is insufficient because
the height of treemacs' icons must be taken into account."
(declare (side-effect-free t))
(inline-quote
@@ -97,31 +108,31 @@ the height of treemacs' icons must be taken into account."
(max treemacs--icon-size (frame-char-height)))))
(define-inline treemacs--sort-alphabetic-asc (f1 f2)
"Sort F1 and F2 alphabetically asc."
"Sort F1 and F2 alphabetically ascending."
(declare (pure t) (side-effect-free t))
(inline-letevals (f1 f2)
(inline-quote (string-lessp ,f1 ,f2))))
(define-inline treemacs--sort-alphabetic-desc (f1 f2)
"Sort F1 and F2 alphabetically desc."
"Sort F1 and F2 alphabetically descending."
(declare (pure t) (side-effect-free t))
(inline-letevals (f1 f2)
(inline-quote (string-lessp ,f2 ,f1))))
(define-inline treemacs--sort-alphabetic-case-insensitive-asc (f1 f2)
"Sort F1 and F2 case insensitive alphabetically asc."
"Sort F1 and F2 case insensitive alphabetically ascending."
(declare (pure t) (side-effect-free t))
(inline-letevals (f1 f2)
(inline-quote (string-lessp (downcase ,f1) (downcase ,f2)))))
(define-inline treemacs--sort-alphabetic-case-insensitive-desc (f1 f2)
"Sort F1 and F2 case insensitive alphabetically desc."
"Sort F1 and F2 case insensitive alphabetically descending."
(declare (pure t) (side-effect-free t))
(inline-letevals (f1 f2)
(inline-quote (string-lessp (downcase ,f2) (downcase ,f1)))))
(define-inline treemacs--sort-size-asc (f1 f2)
"Sort F1 and F2 by size asc."
"Sort F1 and F2 by size ascending."
(declare (side-effect-free t))
(inline-letevals (f1 f2)
(inline-quote
@@ -129,7 +140,7 @@ the height of treemacs' icons must be taken into account."
(nth 7 (file-attributes ,f2))))))
(define-inline treemacs--sort-size-desc (f1 f2)
"Sort F1 and F2 by size desc."
"Sort F1 and F2 by size descending."
(declare (side-effect-free t))
(inline-letevals (f1 f2)
(inline-quote
@@ -137,13 +148,13 @@ the height of treemacs' icons must be taken into account."
(nth 7 (file-attributes ,f2))))))
(define-inline treemacs--sort-mod-time-asc (f1 f2)
"Sort F1 and F2 by modification time asc."
"Sort F1 and F2 by modification time ascending."
(declare (side-effect-free t))
(inline-letevals (f1 f2)
(inline-quote (file-newer-than-file-p ,f2 ,f1))))
(define-inline treemacs--sort-mod-time-desc (f1 f2)
"Sort F1 and F2 by modification time desc."
"Sort F1 and F2 by modification time descending."
(declare (side-effect-free t))
(inline-letevals (f1 f2)
(inline-quote (file-newer-than-file-p ,f1 ,f2))))
@@ -168,12 +179,12 @@ the height of treemacs' icons must be taken into account."
(other other))))
(define-inline treemacs--get-dir-content (dir)
"Get the content of DIR, separated into sublists of first dirs, then files."
"Get the content of DIR, separated into sub-lists of first dirs, then files."
(inline-letevals (dir)
(inline-quote
;; `directory-files' is much faster in a temp buffer for whatever reason
(with-temp-buffer
(let* ((file-name-handler-alist '(("\\`/[^/|:]+:" . tramp-autoload-file-name-handler)))
(let* ((file-name-handler-alist treemacs--file-name-handler-alist)
(sort-func (treemacs--get-sort-fuction))
(entries (-> ,dir (directory-files :absolute-names nil :no-sort) (treemacs--filter-files-to-be-shown)))
(dirs-files (-separate #'file-directory-p entries)))
@@ -229,12 +240,13 @@ DEPTH indicates how deep in the filetree the current button is."
(cl-defmacro treemacs--button-open (&key button new-state new-icon open-action post-open-action immediate-insert)
"Building block macro to open a BUTTON.
Gives the button a NEW-STATE, and, optionally, a NEW-ICON. Performs OPEN-ACTION
and, optionally, POST-OPEN-ACTION. If IMMEDIATE-INSERT is non-nil it will concat
and apply `insert' on the items returned from OPEN-ACTION. If it is nil either
OPEN-ACTION or POST-OPEN-ACTION are expected to take over insertion."
and, optionally, POST-OPEN-ACTION. If IMMEDIATE-INSERT is non-nil it will
concat and apply `insert' on the items returned from OPEN-ACTION. If it is nil
either OPEN-ACTION or POST-OPEN-ACTION are expected to take over insertion."
`(prog1
(save-excursion
(-let [p (point)]
(let ((p (point))
lines)
(treemacs-with-writable-buffer
(treemacs-button-put ,button :state ,new-state)
,@(when new-icon
@@ -245,8 +257,9 @@ OPEN-ACTION or POST-OPEN-ACTION are expected to take over insertion."
`((progn
(insert (apply #'concat ,open-action))))
`(,open-action))
,post-open-action)
(count-lines p (point))))
(setf lines (count-lines p (point)))
,post-open-action
lines)))
(when treemacs-move-forward-on-expand
(let* ((parent (treemacs-current-button))
(child (next-button parent)))
@@ -327,7 +340,7 @@ DIRS: List of Collapse Paths. Each Collapse Path is a list of
(-let [beg (point)]
(insert label-to-add)
(add-text-properties beg (point) props)
(unless (memq treemacs-git-mode '(deferred extended))
(unless (memq treemacs--git-mode '(deferred extended))
(add-text-properties
beg (point)
'(face treemacs-directory-collapsed-face)))))))))))
@@ -352,7 +365,7 @@ Maps ITEMS at given index INTERVAL using MAPPER function."
"Create a new treemacs branch under ROOT.
The branch is indented at DEPTH and uses the eventual outputs of
GIT-FUTURE to decide on file buttons' faces and COLLAPSE-PROCESS to determine
which directories should be displayed as one. The buttons' parent property is
which directories should be displayed as one. The buttons' parent property is
set to PARENT."
(inline-letevals (root depth git-future collapse-process parent)
(inline-quote
@@ -361,15 +374,11 @@ set to PARENT."
(dirs (car dirs-and-files))
(files (cadr dirs-and-files))
(parent-node (treemacs-find-in-dom ,root))
(dir-dom-nodes (--map (treemacs-dom-node->create! :parent parent-node :key it) dirs))
(file-dom-nodes (--map (treemacs-dom-node->create! :parent parent-node :key it) files))
(dir-dom-nodes)
(file-dom-nodes)
(git-info)
(file-strings)
(dir-strings))
(setf (treemacs-dom-node->children parent-node)
(nconc dir-dom-nodes file-dom-nodes (treemacs-dom-node->children parent-node)))
(dolist (it (treemacs-dom-node->children parent-node))
(treemacs-dom-node->insert-into-dom! it))
(setq dir-strings
(treemacs--create-buttons
:nodes dirs
@@ -398,7 +407,7 @@ set to PARENT."
;; based on previous invocations
;; if git-mode is disabled there is nothing to do - in this case the git status parse function will always
;; produce an empty hash table
(pcase treemacs-git-mode
(pcase treemacs--git-mode
((or 'simple 'extended)
(setf git-info (treemacs--get-or-parse-git-result ,git-future))
(ht-set! treemacs--git-cache ,root git-info))
@@ -408,26 +417,43 @@ set to PARENT."
(_
(setq git-info (ht))))
(when treemacs-pre-file-insert-predicates
(-let [result nil]
(while file-strings
(let* ((prefix (car file-strings))
(icon (cadr file-strings))
(filename (caddr file-strings))
(filepath (concat ,root "/" filename)))
(unless (--any? (funcall it filepath git-info) treemacs-pre-file-insert-predicates)
(setq result (cons filename (cons icon (cons prefix result))))))
(setq file-strings (cdddr file-strings)))
(setq file-strings (nreverse result)))
(-let [result nil]
(while dir-strings
(let* ((prefix (car dir-strings))
(dirname (cadr dir-strings))
(dirpath (concat ,root "/" dirname)))
(unless (--any? (funcall it dirpath git-info) treemacs-pre-file-insert-predicates)
(setq result (cons dirname (cons prefix result)))))
(setq dir-strings (cddr dir-strings)))
(setq dir-strings (nreverse result))))
(if treemacs-pre-file-insert-predicates
(progn
(-let [result nil]
(while file-strings
(let* ((prefix (car file-strings))
(icon (cadr file-strings))
(filename (caddr file-strings))
(filepath (concat ,root "/" filename)))
(unless (--any? (funcall it filepath git-info) treemacs-pre-file-insert-predicates)
(setq result (cons filename (cons icon (cons prefix result))))
(push (treemacs-dom-node->create! :parent parent-node :key filepath)
file-dom-nodes)))
(setq file-strings (cdddr file-strings)))
(setq file-strings (nreverse result)))
(-let [result nil]
(while dir-strings
(let* ((prefix (car dir-strings))
(dirname (cadr dir-strings))
(dirpath (concat ,root "/" dirname)))
(unless (--any? (funcall it dirpath git-info) treemacs-pre-file-insert-predicates)
(setq result (cons dirname (cons prefix result)))
(push (treemacs-dom-node->create! :parent parent-node :key dirpath)
dir-dom-nodes)))
(setq dir-strings (cddr dir-strings)))
(setq dir-strings (nreverse result))))
(setf
file-dom-nodes
(--map (treemacs-dom-node->create! :parent parent-node :key it) files)
dir-dom-nodes
(--map (treemacs-dom-node->create! :parent parent-node :key it) dirs)))
;; do nodes can only be created *after* any potential fitering has taken place,
;; otherwise we end up with dom entries for files that are not rendered
(setf (treemacs-dom-node->children parent-node)
(nconc dir-dom-nodes file-dom-nodes (treemacs-dom-node->children parent-node)))
(dolist (it (treemacs-dom-node->children parent-node))
(treemacs-dom-node->insert-into-dom! it))
(treemacs--inplace-map-when-unrolled dir-strings 2
(put-text-property
@@ -479,8 +505,12 @@ Run POST-CLOSE-ACTION after everything else is done."
(delete-region pos-start pos-end))))
,post-close-action)))
(defun treemacs--expand-root-node (btn)
"Expand the given root BTN."
(defun treemacs--expand-root-node (btn &optional recursive)
"Expand the given root BTN.
Open every child-directory as well when RECURSIVE is non-nil.
BTN: Button
RECURSIVE: Bool"
(let ((project (treemacs-button-get btn :project)))
(treemacs-with-writable-buffer
(treemacs-project->refresh-path-status! project))
@@ -497,8 +527,7 @@ Run POST-CLOSE-ACTION after everything else is done."
:immediate-insert nil
:button btn
:new-state 'root-node-open
;; TODO(2020/12/30): temporary workaround for issues like #752, to be removed in 2 months
:new-icon (or treemacs-icon-root-open treemacs-icon-root)
:new-icon treemacs-icon-root-open
:open-action
(progn
;; TODO(2019/10/14): go back to post open
@@ -511,7 +540,12 @@ Run POST-CLOSE-ACTION after everything else is done."
;; Performing FS ops on a disconnected Tramp project
;; might have changed the state to connected.
(treemacs-with-writable-buffer
(treemacs-project->refresh-path-status! project)))))))))
(treemacs-project->refresh-path-status! project))
(when (and recursive (treemacs-project->is-readable? project))
(--each (treemacs-collect-child-nodes btn)
(when (eq 'dir-node-closed (treemacs-button-get it :state))
(goto-char (treemacs-button-start it))
(treemacs--expand-dir-node it :git-future git-future :recursive t)))))))))))
(defun treemacs--collapse-root-node (btn &optional recursive)
"Collapse the given root BTN.
@@ -519,8 +553,7 @@ Remove all open entries below BTN when RECURSIVE is non-nil."
(treemacs--button-close
:button btn
:new-state 'root-node-closed
;; TODO(2020/12/30): temporary workaround for issues like #752, to be removed in 2 months
:new-icon (or treemacs-icon-root-closed treemacs-icon-root)
:new-icon treemacs-icon-root-closed
:post-close-action
(-let [path (treemacs-button-get btn :path)]
(treemacs--stop-watching path)
@@ -533,7 +566,7 @@ BTN: Button
GIT-FUTURE: Pfuture|HashMap
RECURSIVE: Bool"
(-let [path (treemacs-button-get btn :path)]
(if (not (f-readable? path))
(if (not (file-readable-p path))
(treemacs-pulse-on-failure
"Directory %s is not readable." (propertize path 'face 'font-lock-string-face))
(let* ((project (treemacs-project-of-node btn))
@@ -585,8 +618,7 @@ Remove all open dir and tag entries under BTN when RECURSIVE."
"Insert a new root node for the given PROJECT node.
PROJECT: Project Struct"
;; TODO(2020/12/30): temporary workaround for issues like #752, to be removed in 2 months
(insert (or treemacs-icon-root-closed treemacs-icon-root))
(insert treemacs-icon-root-closed)
(let* ((pos (point-marker))
(path (treemacs-project->path project))
(dom-node (treemacs-dom-node->create! :key path :position pos)))
@@ -629,8 +661,8 @@ PROJECT: Project Struct"
(define-inline treemacs-do-update-node (path &optional force-expand)
"Update the node identified by its PATH.
Throws an error when the node cannot be found. Does nothing if the node is
not expanded, unless FORCE-EXPAND is non-nil, in which case the node will be
Throws an error when the node cannot be found. Does nothing if the node is not
expanded, unless FORCE-EXPAND is non-nil, in which case the node will be
expanded.
Same as `treemacs-update-node', but does not take care to either save
position or assure hl-line highlighting, so it should be used when making
@@ -640,20 +672,21 @@ PATH: Node Path
FORCE-EXPAND: Boolean"
(inline-letevals (path force-expand)
(inline-quote
(-if-let (btn (if ,force-expand
(treemacs-goto-node ,path)
(-some-> (treemacs-find-visible-node ,path)
(goto-char))))
(if (treemacs-is-node-expanded? btn)
(-let [close-func (alist-get (treemacs-button-get btn :state) treemacs-TAB-actions-config)]
(funcall close-func)
;; close node again if no new lines were rendered
(when (eq 1 (funcall (alist-get (treemacs-button-get btn :state) treemacs-TAB-actions-config)))
(funcall close-func)))
(when ,force-expand
(funcall (alist-get (treemacs-button-get btn :state) treemacs-TAB-actions-config))))
(-when-let (dom-node (treemacs-find-in-dom ,path))
(setf (treemacs-dom-node->refresh-flag dom-node) t))))))
(treemacs-without-recenter
(-if-let (btn (if ,force-expand
(treemacs-goto-node ,path)
(-some-> (treemacs-find-visible-node ,path)
(goto-char))))
(if (treemacs-is-node-expanded? btn)
(-let [close-func (alist-get (treemacs-button-get btn :state) treemacs-TAB-actions-config)]
(funcall close-func)
;; close node again if no new lines were rendered
(when (eq 1 (funcall (alist-get (treemacs-button-get btn :state) treemacs-TAB-actions-config)))
(funcall close-func)))
(when ,force-expand
(funcall (alist-get (treemacs-button-get btn :state) treemacs-TAB-actions-config))))
(-when-let (dom-node (treemacs-find-in-dom ,path))
(setf (treemacs-dom-node->refresh-flag dom-node) t)))))))
(defun treemacs-update-node (path &optional force-expand)
"Update the node identified by its PATH.
@@ -722,7 +755,7 @@ DOM-NODE: Dom Node"
(delete-offset (- (length path) (length new-path)))
(new-label (substring new-path (length key)))
(old-coll-count (car coll-status))
(new-coll-count (length (cdr (f-split new-label)))))
(new-coll-count (length (treemacs-split-path new-label))))
(treemacs-button-put btn :path new-path)
(end-of-line)
;; delete just enough to get rid of the deleted dirs
@@ -804,17 +837,18 @@ SORT-FUNCTION: Button -> Boolean."
PATH: File Path
PARENT-PATH: File Path"
(-when-let (parent-dom-node (treemacs-find-in-dom parent-path))
;; file events can be chaotic to the point that something is "created"
;; that is already present
(unless (treemacs-find-in-dom path)
(let* ((parent-btn (treemacs-dom-node->position parent-dom-node))
(parent-flatten-info (treemacs-button-get parent-btn :collapsed)))
(treemacs-with-writable-buffer
(if parent-flatten-info
(treemacs--insert-node-in-flattened-directory
path parent-btn parent-dom-node parent-flatten-info)
(treemacs--insert-single-node
path parent-btn parent-dom-node)))))))
(if (treemacs-find-in-dom path)
;; "creating" a file that is already present may happen due to an interaction in magit
;; in that case we need to checkthe file's git status
(treemacs-update-single-file-git-state path)
(let* ((parent-btn (treemacs-dom-node->position parent-dom-node))
(parent-flatten-info (treemacs-button-get parent-btn :collapsed)))
(treemacs-with-writable-buffer
(if parent-flatten-info
(treemacs--insert-node-in-flattened-directory
path parent-btn parent-dom-node parent-flatten-info)
(treemacs--insert-single-node
path parent-btn parent-dom-node)))))))
(defun treemacs--insert-single-node (created-path parent-btn parent-dom-node)
"Insert new CREATED-PATH below non-flattened directory at PARENT-BTN.
@@ -884,7 +918,7 @@ FLATTEN-INFO [Int File Path...]"
;; Create the path items of the new `:collapsed' property
(dolist (token new-path-tokens)
(cl-incf new-flatten-info-count)
(setf new-flatten-info-item (f-join new-flatten-info-item token))
(setf new-flatten-info-item (treemacs-join-path new-flatten-info-item token))
(push new-flatten-info-item new-flatten-info))
(setf new-flatten-info (nreverse new-flatten-info))
@@ -963,7 +997,8 @@ WHEN can take the following values:
* on-visibility: Special case for projects: recentering depends on whether the
newly rendered number of NEW-LINES fits the view."
(declare (indent 1))
(when (treemacs-is-treemacs-window? (selected-window))
(when (and (null treemacs--no-recenter)
(treemacs-is-treemacs-window? (selected-window)))
(let* ((current-line (float (treemacs--current-screen-line)))
(all-lines (float (treemacs--lines-in-window))))
(pcase when
@@ -974,24 +1009,16 @@ WHEN can take the following values:
;; if possible recenter only as much as is needed to bring all new lines
;; into view
(recenter (max 0 (round (- current-line (- new-lines lines-left))))))))
((guard (memq when '(t on-distance))) ;; TODO(2019/02/20): t for backward compatibility, remove eventually
('on-distance
(let* ((distance-from-top (/ current-line all-lines))
(distance-from-bottom (- 1.0 distance-from-top)))
(when (or (> treemacs-recenter-distance distance-from-top)
(> treemacs-recenter-distance distance-from-bottom))
(recenter))))))))
(defun treemacs--recursive-refresh ()
"Recursively descend the dom, updating only the refresh-marked nodes."
(pcase-dolist (`(,_ . ,shelf) treemacs--scope-storage)
(-let [workspace (treemacs-scope-shelf->workspace shelf)]
(dolist (project (treemacs-workspace->projects workspace))
(-when-let (root-node (-> project (treemacs-project->path) (treemacs-find-in-dom)))
(treemacs--recursive-refresh-descent root-node project))))))
;; TODO(201/10/30): update of parents
(defun treemacs--recursive-refresh-descent (node project)
"The recursive descent implementation of `treemacs--recursive-refresh'.
"Recursively refresh by descending the dom starting from NODE.
If NODE under PROJECT is marked for refresh and in an open state (since it could
have been collapsed in the meantime) it will simply be collapsed and
re-expanded. If NODE is node marked its children will be recursively
@@ -1016,7 +1043,7 @@ parents' git status can be updated."
(treemacs-do-delete-single-node path project))
('changed
(treemacs-do-update-node path)
(when (memq treemacs-git-mode '(extended deferred))
(when (memq treemacs--git-mode '(extended deferred))
(treemacs-update-single-file-git-state path)))
('created
(treemacs-do-insert-single-node path (treemacs-dom-node->key node)))
@@ -1097,6 +1124,29 @@ GIT-INFO is passed through from the previous branch build."
('root-node-closed (treemacs--expand-root-node btn))
(other (funcall (alist-get other treemacs-TAB-actions-config) btn))))
(defun treemacs--show-single-project (path name)
"Show only a project for the given PATH and NAME in the current workspace."
(-let [ws (treemacs-current-workspace)]
(if (treemacs-workspace->is-empty?)
(progn
(treemacs-do-add-project-to-workspace path name)
(treemacs-select-window)
(treemacs-pulse-on-success))
(setf (treemacs-workspace->projects ws)
(--filter (string= path (treemacs-project->path it))
(treemacs-workspace->projects ws)))
(unless (treemacs-workspace->projects ws)
(let ((treemacs--no-messages t)
(treemacs-pulse-on-success nil))
(treemacs-add-project-to-workspace path name)))
(treemacs-select-window)
(treemacs--consolidate-projects)
(goto-char 2)
(-let [btn (treemacs-current-button)]
(unless (treemacs-is-node-expanded? btn)
(treemacs--expand-root-node btn)))
(treemacs-pulse-on-success))))
(provide 'treemacs-rendering)
;;; treemacs-rendering.el ends here

18
lisp/treemacs/treemacs-scope.el
View File

@@ -16,13 +16,16 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Module that handles uniquely associating treemacs buffers with a certain scope,
;;; like the selected frame, or (to be implemented later) the active eyebrowse or
;;; persp desktop.
;;; This is implemented using a (somewhat) OOP style with eieio and static functions,
;;; where each scope type is expected to know how to query the current scope (e.g. the
;;; selected frame) and how to set up and tear down itself (e.g. deleting a frames
;;; associated buffer when the frame is deleted)
;; Module that handles uniquely associating treemacs buffers with a
;; certain scope, like the selected frame, or (to be implemented
;; later) the active eyebrowse or persp desktop.
;; This is implemented using a (somewhat) OOP style with eieio and
;; static functions, where each scope type is expected to know how to
;; query the current scope (e.g. the selected frame) and how to set up
;; and tear down itself (e.g. deleting a frames associated buffer when
;; the frame is deleted)
;;; Code:
@@ -52,7 +55,6 @@
(treemacs-import-functions-from "treemacs-workspaces"
treemacs--find-workspace)
(cl-defstruct (treemacs-scope-shelf
(:conc-name treemacs-scope-shelf->)
(:constructor treemacs-scope-shelf->create!))

91
lisp/treemacs/treemacs-tag-follow-mode.el
View File

@@ -16,6 +16,7 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Minor mode to follow the tag at point in the treemacs view on an idle timer
;; Finding the current tag is a fairly involved process:
;; * Grab current buffer's imenu output
@@ -26,12 +27,12 @@
;; * Find the last tag whose position begins before point
;; * Jump to that tag path
;; * No jump when there's no buffer file, or no imenu, or buffer file is not seen in treemacs etc.
;;; NOTE: This module is lazy-loaded.
;; NOTE: This module is lazy-loaded.
;;; Code:
(require 'imenu)
(require 'f)
(require 'hl-line)
(require 'treemacs-customization)
(require 'treemacs-core-utils)
@@ -51,7 +52,7 @@ Active while tag follow mode is enabled and nil/cancelled otherwise.")
(defvar-local treemacs--previously-followed-tag-position nil
"Records the last node and path whose tags were expanded by tag follow mode.
Is made up of a cons of the last expanded node and its path. Both are kept to
Is made up of a cons of the last expanded node and its path. Both are kept to
make sure that the position has not become invalidated in the meantime.
When `treemacs-tag-follow-cleanup' it t this button's tags will be closed up
again when tag follow mode moves to another button.")
@@ -69,42 +70,42 @@ saved.")
"Forget the previously followed button when treemacs is killed or rebuilt."
(inline-quote (setq treemacs--previously-followed-tag-position nil)))
(define-inline treemacs--flatten&sort-imenu-index ()
;;;###autoload
(defun treemacs--flatten&sort-imenu-index ()
"Flatten current file's imenu index and sort it by tag position.
The tags are sorted into the order in which they appear, reguardless of section
The tags are sorted into the order in which they appear, regardless of section
or nesting depth."
(inline-quote
(if (eq major-mode 'pdf-view-mode)
'unsupported
(let* ((imenu-auto-rescan t)
(org? (eq major-mode 'org-mode))
(index (-> (buffer-file-name) (treemacs--get-imenu-index)))
(flat-index (if org?
(treemacs--flatten-org-mode-imenu-index index)
(treemacs--flatten-imenu-index index)))
(first (caar flat-index))
;; in org mode buffers the first item may not be a cons since its position
;; is still stored as a text property
(semantic? (and (consp first) (overlayp (cdr first))))
(compare-func (if (memq major-mode '(markdown-mode adoc-mode))
#'treemacs--compare-markdown-tag-paths
#'treemacs--compare-tag-paths)))
(cond
(semantic?
;; go ahead and just transform semantic overlays into markers so we dont
;; have trouble with comparisons when searching a position
(dolist (tag-path flat-index)
(let ((leaf (car tag-path))
(marker (make-marker)))
(setcdr leaf (move-marker marker (overlay-start (cdr leaf)))))))
;; same goes for an org index, since headlines with children store their
;; positions as text properties
(org?
(dolist (tag-path flat-index)
(let ((leaf (car tag-path)))
(when (stringp leaf)
(setcar tag-path (cons leaf (get-text-property 0 'org-imenu-marker leaf))))))))
(sort flat-index compare-func)))))
(if (eq major-mode 'pdf-view-mode)
'unsupported
(let* ((imenu-auto-rescan t)
(org? (eq major-mode 'org-mode))
(index (-> (buffer-file-name) (treemacs--get-imenu-index)))
(flat-index (if org?
(treemacs--flatten-org-mode-imenu-index index)
(treemacs--flatten-imenu-index index)))
(first (caar flat-index))
;; in org mode buffers the first item may not be a cons since its position
;; is still stored as a text property
(semantic? (and (consp first) (overlayp (cdr first))))
(compare-func (if (memq major-mode '(markdown-mode adoc-mode))
#'treemacs--compare-markdown-tag-paths
#'treemacs--compare-tag-paths)))
(cond
(semantic?
;; go ahead and just transform semantic overlays into markers so we dont
;; have trouble with comparisons when searching a position
(dolist (tag-path flat-index)
(let ((leaf (car tag-path))
(marker (make-marker)))
(setcdr leaf (move-marker marker (overlay-start (cdr leaf)))))))
;; same goes for an org index, since headlines with children store their
;; positions as text properties
(org?
(dolist (tag-path flat-index)
(let ((leaf (car tag-path)))
(when (stringp leaf)
(setcar tag-path (cons leaf (get-text-property 0 'org-imenu-marker leaf))))))))
(sort flat-index compare-func))))
(defun treemacs--flatten-imenu-index (index &optional path)
"Flatten a nested imenu INDEX to a flat list of tag paths.
@@ -158,7 +159,7 @@ P2: Tag-Path"
(-> ,p2 (cdar) (marker-position))))))
(define-inline treemacs--compare-markdown-tag-paths (p1 p2)
"Specialized version of `treemacs--compare-tag-paths' for markdown and adoc.
"Specialised version of `treemacs--compare-tag-paths' for markdown and adoc.
P1: Tag-Path
P2: Tag-Path"
(declare (pure t) (side-effect-free t))
@@ -308,23 +309,23 @@ PROJECT: Project Struct"
"Toggle `treemacs-tag-follow-mode'.
This acts as more fine-grained alternative to `treemacs-follow-mode' and will
thus disable `treemacs-follow-mode' on activation. When enabled treemacs will
thus disable `treemacs-follow-mode' on activation. When enabled treemacs will
focus not only the file of the current buffer, but also the tag at point.
The follow action is attached to Emacs' idle timer and will run
`treemacs-tag-follow-delay' seconds of idle time. The delay value is not an
`treemacs-tag-follow-delay' seconds of idle time. The delay value is not an
integer, meaning it accepts floating point values like 1.5.
Every time a tag is followed a rescan of the imenu index is forced by
Every time a tag is followed a re--scan of the imenu index is forced by
temporarily setting `imenu-auto-rescan' to t (though a cache is applied as long
as the buffer is unmodified). This is necessary to assure that creation or
as the buffer is unmodified). This is necessary to assure that creation or
deletion of tags does not lead to errors and guarantees an always up-to-date tag
view.
Note that in order to move to a tag in treemacs the treemacs buffer's window
needs to be temporarily selected, which will reset `blink-cursor-mode's timer if
it is enabled. This will result in the cursor blinking seemingly pausing for a
short time and giving the appereance of the tag follow action lasting much
needs to be temporarily selected, which will reset blink-cursor-mode's timer if
it is enabled. This will result in the cursor blinking seemingly pausing for a
short time and giving the appearance of the tag follow action lasting much
longer than it really does."
:init-value nil
:global t

25
lisp/treemacs/treemacs-tags.el
View File

@@ -16,18 +16,22 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Tags display functionality.
;;; Need to be very careful here - many of the functions in this module need to be run inside the treemacs buffer, while
;;; the `treemacs--execute-button-action' macro that runs them will switch windows before doing so. Heavy use of
;;; `treemacs-safe-button-get' or `treemacs-with-button-buffer' is necessary.
;;; NOTE: This module is lazy-loaded.
;; Tags display functionality.
;; Need to be very careful here - many of the functions in this module
;; need to be run inside the treemacs buffer, while the
;; `treemacs--execute-button-action' macro that runs them will switch
;; windows before doing so. Heavy use of `treemacs-safe-button-get'
;; or `treemacs-with-button-buffer' is necessary.
;; NOTE: This module is lazy-loaded.
;;; Code:
(require 'xref)
(require 'imenu)
(require 'dash)
(require 'f)
(require 'treemacs-core-utils)
(require 'treemacs-rendering)
(require 'treemacs-customization)
@@ -244,7 +248,7 @@ function is also called from the top level vist-node functions like
`treemacs--execute-button-action' macro which includes the determination of
the display window."
(let* ((path (treemacs--nearest-path btn))
(extension (f-ext path)))
(extension (file-name-extension path)))
(pcase extension
("py"
(let* ((first-child (car (treemacs-button-get btn :index)))
@@ -370,7 +374,10 @@ The position can be stored in the following ways:
element's 'org-imenu-marker text property.
* ITEM is a cons: special case for imenu elements of an `pdfview-mode' buffer.
In this case no position is stored directly, navigation to the tag must happen
via callback"
via callback
FILE is the path the tag is in, so far it is only relevant for `pdfview-mode'
tags."
(declare (side-effect-free t))
(pcase (type-of item)
('marker
@@ -499,7 +506,7 @@ headline with sub-elements is saved in an 'org-imenu-marker' text property."
(nreverse result)))
(define-inline treemacs--imenu-goto-node-wrapper (_name _pos key)
"Thin wrapeer around `treemacs-goto-node'.
"Thin wrapper around `treemacs-goto-node'.
Used by imenu to move to the node with the given KEY."
(inline-letevals (key)
(inline-quote

5
lisp/treemacs/treemacs-themes.el
View File

@@ -16,11 +16,12 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Definitions for the theme type, their creation, and, the means to change themes.
;; Definitions for the theme type, their creation, and, the means to
;; change themes.
;;; Code:
(require 'f)
(require 'dash)
(require 'ht)
(require 'treemacs-core-utils)

68
lisp/treemacs/treemacs-visuals.el
View File

@@ -16,7 +16,8 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Handling of visuals in general and icons in particular.
;; Handling of visuals in general and icons in particular.
;;; Code:
@@ -46,6 +47,13 @@
(defvar-local treemacs--indentation-string-cache (vector)
"Cached propertized indentation.")
(defvar treemacs--indent-guide-mode nil)
(defvar treemacs--saved-indent-settings nil
"Saved settings overridden by `treemacs-indent-guide-mode'.
Used to save the values of `treemacs-indentation' and
`treemacs-indentation-string'.")
(define-inline treemacs--forget-last-highlight ()
"Set `treemacs--last-highlight' to nil."
(inline-quote (setq treemacs--last-highlight nil)))
@@ -130,18 +138,28 @@ Optionally issue a log statement with LOG-ARGS."
(defun treemacs--build-indentation-cache (depth)
"Rebuild indentation string cache up to DEPTH levels deep."
(setq treemacs--indentation-string-cache (make-vector (1+ depth) nil)
treemacs--indentation-string-cache-key (cons treemacs-indentation treemacs-indentation-string))
(setq treemacs--indentation-string-cache
(make-vector (1+ depth) nil)
treemacs--indentation-string-cache-key
(cons treemacs-indentation treemacs-indentation-string))
(dotimes (i (1+ depth))
(aset treemacs--indentation-string-cache i
(cond ((integerp treemacs-indentation)
(s-repeat (* i treemacs-indentation) treemacs-indentation-string))
((not window-system)
(s-repeat (* i 2) treemacs-indentation-string))
(t (propertize " "
'display
`(space . (:width (,(* (car treemacs-indentation)
i))))))))))
(cond
((listp treemacs-indentation-string)
(let ((str nil)
(len (length treemacs-indentation-string)))
(dotimes (n i)
(setf str (concat str
(nth (% n len) treemacs-indentation-string))))
str))
((integerp treemacs-indentation)
(s-repeat (* i treemacs-indentation) treemacs-indentation-string))
((not window-system)
(s-repeat (* i 2) treemacs-indentation-string))
(t (propertize " "
'display
`(space . (:width (,(* (car treemacs-indentation)
i))))))))))
(define-inline treemacs--get-indentation (depth)
"Gets an indentation string DEPTH levels deep."
@@ -156,6 +174,34 @@ Optionally issue a log statement with LOG-ARGS."
(treemacs--build-indentation-cache ,depth))
(aref treemacs--indentation-string-cache ,depth)))))
(define-minor-mode treemacs-indent-guide-mode
"Toggle `treemacs-indent-guide-mode'.
When enabled treemacs will show simple indent guides for its folder structure.
The effect is achieved by overriding the values of `treemacs-indentation' and
`treemacs-indentation-string'. Disabling the mode will restore the previously
used settings."
:init-value nil
:global t
:lighter nil
:group 'treemacs
(if treemacs-indent-guide-mode
(progn
(setf
treemacs--saved-indent-settings
(cons treemacs-indentation treemacs-indentation-string)
treemacs-indentation 1
treemacs-indentation-string
(pcase-exhaustive treemacs-indent-guide-style
('line (propertize " ┃ " 'face 'font-lock-comment-face))
('block (list
" "
(propertize "██" 'face 'font-lock-comment-face))))))
(setf treemacs-indentation (car treemacs--saved-indent-settings)
treemacs-indentation-string (cdr treemacs--saved-indent-settings)))
(treemacs-without-messages
(treemacs-run-in-every-buffer
(treemacs--do-refresh (current-buffer) 'all))))
(provide 'treemacs-visuals)
;;; treemacs-visuals.el ends here

103
lisp/treemacs/treemacs-workspaces.el
View File

@@ -16,8 +16,9 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Everything about creating, (re)moving, (re)naming and otherwise editing
;;; projects and workspaces.
;; Everything about creating, (re)moving, (re)naming and otherwise
;; editing projects and workspaces.
;;; Code:
@@ -59,6 +60,9 @@
treemacs--forget-last-highlight
treemacs-pulse-on-failure)
(treemacs-import-functions-from "treemacs-async"
treemacs--prefetch-gitignore-cache)
(cl-defstruct (treemacs-project
(:conc-name treemacs-project->)
(:constructor treemacs-project->create!))
@@ -75,7 +79,9 @@
(defvar treemacs--workspaces (list (treemacs-workspace->create! :name "Default")))
(defvar treemacs--find-user-project-functions (list #'treemacs--default-current-user-project-function)
(defvar treemacs--find-user-project-functions
(list #'treemacs--current-builtin-project-function
#'treemacs--current-directory-project-function)
"List of functions to find the user project for the current buffer.")
(defvar-local treemacs--org-err-ov nil
@@ -99,11 +105,16 @@ To be called whenever a project or workspace changes."
(dolist (buf (buffer-list))
(setf (buffer-local-value 'treemacs--project-of-buffer buf) nil))))
(defun treemacs--default-current-user-project-function ()
(defun treemacs--current-builtin-project-function ()
"Find the current project.el project."
(declare (side-effect-free t))
(-some-> (project-current) (cdr) (file-truename) (treemacs-canonical-path)))
(defun treemacs--current-directory-project-function ()
"Find the current working directory."
(declare (side-effect-free t))
(-some-> default-directory (treemacs--canonical-path)))
(define-inline treemacs-workspaces ()
"Return the list of all workspaces in treemacs."
(declare (side-effect-free t))
@@ -144,16 +155,22 @@ PATH: String"
(declare (side-effect-free t))
(inline-letevals (path)
(inline-quote
(setf (treemacs-current-workspace)
(or (--first (treemacs-is-path ,path :in-workspace it)
treemacs--workspaces)
(car treemacs--workspaces))))))
(let ((ws-for-path (--first (treemacs-is-path ,path :in-workspace it)
treemacs--workspaces)))
(setf (treemacs-current-workspace)
(pcase-exhaustive treemacs-find-workspace-method
('find-for-file-or-pick-first
(or ws-for-path (car treemacs--workspaces)))
('find-for-file-or-manually-select
(or ws-for-path (treemacs--select-workspace-by-name)))
('always-ask
(treemacs--select-workspace-by-name))))))))
;; TODO(2020/11/25): NAME
(define-inline treemacs--find-project-for-buffer (&optional buffer-file)
"In the current workspace find the project current buffer's file falls under.
Optionally supply the BUFFER-FILE in case it is not available by calling
`buffer-file-name' (like in dired).
Optionally supply the BUFFER-FILE in case it is not available by calling the
function `buffer-file-name' (like in Dired).
FILE: Filepath"
(inline-letevals (buffer-file)
@@ -217,7 +234,7 @@ Will return `point-min' if there is no next project."
(define-inline treemacs-project->key (self)
"Get the hash table key of SELF.
SELF may be a project struct or a root key of a top-level extension."
SELF may be a project struct or a root key of a top level extension."
(declare (side-effect-free t))
(inline-letevals (self)
(inline-quote
@@ -328,7 +345,7 @@ Return values may be as follows:
* If only a single workspace remains:
- the symbol `only-one-workspace'
* If the user cancel the deletion:
* If the user cancels the deletion:
- the symbol `user-cancel'
* If the workspace cannot be found:
- the symbol `workspace-not-found'
@@ -460,11 +477,11 @@ Return values may be as follows:
PATH: Filepath
NAME: String"
(treemacs-block
(treemacs-error-return-if (null path)
(treemacs-return-if (null path)
`(invalid-path "Path is nil."))
(let ((path-status (treemacs--get-path-status path))
(added-in-workspace (treemacs-current-workspace)))
(treemacs-error-return-if (not (file-readable-p path))
(treemacs-return-if (not (file-readable-p path))
`(invalid-path "Path is not readable does not exist."))
(setq path (-> path (file-truename) (treemacs-canonical-path)))
(-when-let (project (treemacs--find-project-for-path path))
@@ -504,6 +521,8 @@ NAME: String"
(when treemacs-expand-added-projects
(treemacs--expand-root-node (treemacs-project->position project))))))
(treemacs--persist)
(when (with-no-warnings treemacs-hide-gitignored-files-mode)
(treemacs--prefetch-gitignore-cache path))
(run-hook-with-args 'treemacs-create-project-functions project)
`(success ,project)))))
@@ -511,38 +530,51 @@ NAME: String"
(with-no-warnings
(make-obsolete #'treemacs-add-project-at #'treemacs-do-add-project-to-workspace "v.2.2.1"))
(defun treemacs-do-remove-project-from-workspace (project &optional ignore-last-project-restriction)
"Add the given PROJECT to the current workspace.
(defun treemacs-do-remove-project-from-workspace
(project &optional ignore-last-project-restriction ask-to-confirm)
"Remove the given PROJECT from the current workspace.
PROJECT may either be a `treemacs-project' instance or a string path. In the
latter case the project containing the path will be selected.
When IGNORE-LAST-PROJECT-RESTRICTION removing the last project will not count
as an error. This is meant to be used in non-interactive code, where another
project is immediately added afterwards, as leaving the project list empty is
probably a bad idea.
When IGNORE-LAST-PROJECT-RESTRICTION is non-nil removing the last project will
not count as an error. This is meant to be used in non-interactive code, where
another project is immediately added afterwards, as leaving the project list
empty is generally a bad idea.
Ask the user to confirm the deletion when ASK-TO-CONFIRM is t (it will be when
this is called from `treemacs-remove-project-from-workspace').
Return values may be as follows:
* If the given path is invalid (is nil or does not exist):
- the symbol `invalid-project'
- a string describing the problem
* If the user cancels the deletion:
- the symbol `user-cancel'
* If there is only one project:
- the symbol `cannot-delete-last-project'
* If everything went well:
- the symbol `success'"
(treemacs-block
(unless ignore-last-project-restriction
(treemacs-error-return-if (>= 1 (length (treemacs-workspace->projects (treemacs-current-workspace))))
(treemacs-return-if (>= 1 (length (treemacs-workspace->projects (treemacs-current-workspace))))
'cannot-delete-last-project))
(treemacs-error-return-if (null project)
(treemacs-return-if (null project)
`(invalid-project "Project is nil"))
;; when used from outside treemacs it is much easier to supply a path string than to
;; look up the project instance
(when (stringp project)
(setf project (treemacs-is-path (treemacs-canonical-path project) :in-workspace)))
(treemacs-error-return-if (null project)
`(invalid-project "Given path is not in the workspace"))
(-let [found-project (treemacs-is-path (treemacs-canonical-path project) :in-workspace)]
(treemacs-return-if (null found-project)
`(invalid-project ,(format "Given path '%s' is not in the workspace" project)))
(setf project found-project)))
(treemacs-return-if
(and ask-to-confirm
(not (yes-or-no-p (format "Remove project %s from the current workspace?"
(propertize (treemacs-project->name project)
'face 'font-lock-type-face)))))
'user-cancel)
(treemacs-run-in-every-buffer
(treemacs-with-writable-buffer
(let* ((project-path (treemacs-project->path project))
@@ -623,6 +655,8 @@ Return values may be as follows:
(setf (treemacs-current-workspace) new-workspace)
(treemacs--invalidate-buffer-project-cache)
(treemacs--rerender-after-workspace-change)
(when (with-no-warnings treemacs-hide-gitignored-files-mode)
(treemacs--prefetch-gitignore-cache 'all))
(run-hooks 'treemacs-switch-workspace-hook)
(treemacs-return
`(success ,new-workspace)))))
@@ -709,10 +743,11 @@ PROJECT: Project Struct"
(-let [project-btn (treemacs-project->position project-in-buffer)]
(when (eq 'root-node-open (treemacs-button-get project-btn :state))
(push project-in-buffer expanded-projects-in-buffer)
(goto-char project-btn)
(treemacs--collapse-root-node project-btn))))
;; figure out which ones have been deleted and and remove them from the dom
(dolist (project-in-buffer projects-in-buffer)
(unless (treemacs-is-path (treemacs-project->path project-in-buffer) :in-workspace current-workspace)
(unless (member project-in-buffer projects-in-workspace)
(treemacs-on-collapse (treemacs-project->path project-in-buffer) :purge)
(ht-remove! treemacs-dom (treemacs-project->path project-in-buffer))
(setf projects-in-buffer (delete project-in-buffer projects-in-buffer))))
@@ -775,13 +810,15 @@ PROJECT: Project Struct"
(defun treemacs--select-workspace-by-name (&optional name)
"Interactively select the workspace with the given NAME."
(treemacs--maybe-load-workspaces)
(-let [name (or name
(completing-read
"Workspace: "
(->> treemacs--workspaces
(--map (cons (treemacs-workspace->name it) it)))))]
(--first (string= name (treemacs-workspace->name it))
treemacs--workspaces)))
(if (= 1 (length treemacs--workspaces))
(car treemacs--workspaces)
(-let [name (or name
(completing-read
"Workspace: "
(->> treemacs--workspaces
(--map (cons (treemacs-workspace->name it) it)))))]
(--first (string= name (treemacs-workspace->name it))
treemacs--workspaces))))
(defun treemacs--maybe-clean-buffers-on-workspace-switch (which)
"Delete buffers depending on the value of WHICH.

116
lisp/treemacs/treemacs.el
View File

@@ -3,9 +3,9 @@
;; Copyright (C) 2021 Alexander Miller
;; Author: Alexander Miller <alexanderm@web.de>
;; Package-Requires: ((emacs "26.1") (cl-lib "0.5") (dash "2.11.0") (s "1.12.0") (f "0.11.0") (ace-window "0.9.0") (pfuture "1.7") (hydra "0.13.2") (ht "2.2") (cfrs "1.3.2"))
;; Package-Requires: ((emacs "26.1") (cl-lib "0.5") (dash "2.11.0") (s "1.12.0") (ace-window "0.9.0") (pfuture "1.7") (hydra "0.13.2") (ht "2.2") (cfrs "1.3.2"))
;; Homepage: https://github.com/Alexander-Miller/treemacs
;; Version: 2.8
;; Version: 2.9.5
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
@@ -22,7 +22,7 @@
;;; Commentary:
;;; A powerful and flexible file tree project explorer.
;; A powerful and flexible file tree project explorer.
;;; Code:
@@ -51,7 +51,7 @@
(defconst treemacs-version
(eval-when-compile
(format "v2.8 (installed %s) @ Emacs %s"
(format "v2.9.5 (installed %s) @ Emacs %s"
(format-time-string "%Y.%m.%d" (current-time))
emacs-version)))
@@ -68,19 +68,50 @@
treemacs-version)
;;;###autoload
(defun treemacs ()
(defun treemacs (&optional arg)
"Initialise or toggle treemacs.
* If the treemacs window is visible hide it.
* If a treemacs buffer exists, but is not visible show it.
* If no treemacs buffer exists for the current frame create and show it.
* If the workspace is empty additionally ask for the root path of the first
project to add."
(interactive)
- If the treemacs window is visible hide it.
- If a treemacs buffer exists, but is not visible show it.
- If no treemacs buffer exists for the current frame create and show it.
- If the workspace is empty additionally ask for the root path of the first
project to add.
- With a prefix ARG launch treemacs and force it to select a workspace"
(interactive "P")
(pcase (treemacs-current-visibility)
((guard arg)
(treemacs-do-switch-workspace (treemacs--select-workspace-by-name))
(treemacs-select-window))
('visible (delete-window (treemacs-get-local-window)))
('exists (treemacs-select-window))
('none (treemacs--init))))
;;;###autoload
(defun treemacs-select-directory ()
"Select a directory to open in treemacs.
This command will open *just* the selected directory in treemacs. If there are
other projects in the workspace they will be removed.
To *add* a project to the current workspace use
`treemacs-add-project-to-workspace' or
`treemacs-add-and-display-current-project' instead."
(interactive)
(treemacs-block
(let* ((path (-> "Directory: "
(read-directory-name)
(treemacs-canonical-path)))
(name (treemacs--filename path))
(ws (treemacs-current-workspace)))
(treemacs-return-if
(and (= 1 (length (treemacs-workspace->projects ws)))
(string= path (-> ws
(treemacs-workspace->projects)
(car)
(treemacs-project->path))))
(treemacs-select-window))
(treemacs--show-single-project path name)
(treemacs-pulse-on-success "Now showing %s"
(propertize path 'face 'font-lock-string-face)))))
;;;###autoload
(defun treemacs-find-file (&optional arg)
"Find and focus the current file in the treemacs window.
@@ -141,16 +172,33 @@ visiting a file or Emacs cannot find any tags for the current file."
(treemacs--do-follow-tag index treemacs-window buffer-file project))))
;;;###autoload
(defun treemacs-select-window ()
(defun treemacs-select-window (&optional arg)
"Select the treemacs window if it is visible.
Bring it to the foreground if it is not visible.
Initialise a new treemacs buffer as calling `treemacs' would if there is no
treemacs buffer for this frame."
(interactive)
treemacs buffer for this frame.
In case treemacs is already selected behaviour will depend on
`treemacs-select-when-already-in-treemacs'.
A non-nil prefix ARG will also force a workspace switch."
(interactive "P")
(pcase (treemacs-current-visibility)
('visible (treemacs--select-visible-window))
((guard arg)
(treemacs-do-switch-workspace (treemacs--select-workspace-by-name))
(treemacs-select-window))
('exists (treemacs--select-not-visible-window))
('none (treemacs--init))))
('none (treemacs--init))
('visible
(if (not (eq treemacs--in-this-buffer t))
(treemacs--select-visible-window)
(pcase-exhaustive treemacs-select-when-already-in-treemacs
('stay
(ignore))
('close
(treemacs-quit))
('move-back
(select-window (get-mru-window (selected-frame) nil :not-selected))))))))
;;;###autoload
(defun treemacs-show-changelog ()
@@ -186,7 +234,9 @@ treemacs buffer for this frame."
(defun treemacs-display-current-project-exclusively ()
"Display the current project, and *only* the current project.
Like `treemacs-add-and-display-current-project' this will add the current
project to treemacs based on either projectile or the built-in project.el.
project to treemacs based on either projectile, the built-in project.el, or the
current working directory.
However the 'exclusive' part means that it will make the current project the
only project, all other projects *will be removed* from the current workspace."
(interactive)
@@ -197,34 +247,20 @@ only project, all other projects *will be removed* from the current workspace."
(let* ((path (treemacs-canonical-path root))
(name (treemacs--filename path))
(ws (treemacs-current-workspace)))
(treemacs-return-if (and (= 1 (length (treemacs-workspace->projects ws)))
(string= path (-> ws (treemacs-workspace->projects) (car) (treemacs-project->path))))
(treemacs-pulse-on-success "Current project is already shown."))
(if (treemacs-workspace->is-empty?)
(progn
(treemacs-do-add-project-to-workspace path name)
(treemacs-select-window)
(treemacs-pulse-on-success))
(setf (treemacs-workspace->projects ws)
(--filter (string= path (treemacs-project->path it))
(treemacs-workspace->projects ws)))
(unless (treemacs-workspace->projects ws)
(let ((treemacs--no-messages t)
(treemacs-pulse-on-success nil))
(treemacs-add-project-to-workspace path name)))
(treemacs-select-window)
(treemacs--consolidate-projects)
(goto-char 2)
(-let [btn (treemacs-current-button)]
(unless (treemacs-is-node-expanded? btn)
(treemacs--expand-root-node btn)))
(treemacs-pulse-on-success))))))
(treemacs-return-if
(and (= 1 (length (treemacs-workspace->projects ws)))
(treemacs-is-path path :in-workspace ws))
(treemacs-select-window))
(treemacs--show-single-project path name)
(treemacs-pulse-on-success "Now showing %s"
(propertize path 'face 'font-lock-string-face))))))
;;;###autoload
(defun treemacs-add-and-display-current-project ()
"Open treemacs and add the current project root to the workspace.
The project is determined first by projectile (if treemacs-projectile is
installed), then by project.el.
installed), then by project.el, then by the current working directory.
If the project is already registered with treemacs just move point to its root.
An error message is displayed if the current buffer is not part of any project."
(interactive)