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

pkg update and first config fix

Browse Source 
org-brain not working, add org-roam
This commit is contained in:
Daniel Weschke
2022-12-19 23:02:34 +01:00
parent 02b3e07185
commit 82f05baffe
885 changed files with 356098 additions and 36993 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
lisp/treemacs/Changelog.org
View File

@@ -3,6 +3,15 @@
* Changelog
** current master
- Treemacs can now be resized with the mouse, even when it width is locked
- Bug fixes
** v3
- Complete rewrite of the extension api
- Added ~treemacs-bulk-file-actions~
- Added support for moving files via mouse drag
- Added ~treemacs-hide-dot-git-directory~
- Added ~treemacs-git-commit-diff-mode~
** v2.10
- 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
@@ -15,6 +24,7 @@
- Added ~detailed~ option for ~treemacs-eldoc-display~
- Added ~treemacs-select-directory~
- Added option to select workspace when starting/selecting treemacs
- Added ~treemacs-indicate-top-scroll-mode~
- Promoted peeking into a proper minor mode
** v2.9
- Published ~treemacs-all-the-icons~
@@ -44,6 +54,7 @@
selected
- Implemented one hand navigation with ~h~ collapsing nodes and ~l~ functioning like ~RET~, ~M-H/L~
is used now for changing root nodes.
- Reduced ~treemacs-file-event-delay~ to 2000ms
- New icons
- Bug Fixes
** v2.8

BIN
lisp/treemacs/icons/default/mail-mark-read.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 514 B

BIN
lisp/treemacs/icons/default/mail-mark-unread.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 620 B

BIN
lisp/treemacs/icons/default/mail.png
View File

Binary file not shown.
Side by Side

Before

Width:  |  Height:  |  Size: 498 B

BIN
lisp/treemacs/icons/default/svgrepo/mail-plus.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 27 KiB

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

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 17 KiB

382
lisp/treemacs/treemacs-annotations.el Normal file
View File

@@ -0,0 +1,382 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2022 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:
;; Code for adding, removing, and displaying "annotations" for treemacs'
;; nodes. As of now only suffix annotations in extensions are implemented.
;;; Code:
(require 'ht)
(require 'dash)
(require 'treemacs-async)
(require 'treemacs-core-utils)
(require 'treemacs-workspaces)
(require 'treemacs-async)
(eval-when-compile
(require 'treemacs-macros)
(require 'inline)
(require 'cl-lib))
(eval-when-compile
(cl-declaim (optimize (speed 3) (safety 0))))
(defconst treemacs--annotation-store (make-hash-table :size 200 :test 'equal))
;; TODO(2022/02/23): clear on file delete
(cl-defstruct (treemacs-annotation
(:conc-name treemacs-annotation->)
(:constructor treemacs-annotation->create!)
(:copier nil))
suffix
suffix-value
git-face
face
face-value)
(define-inline treemacs-get-annotation (path)
"Get annotation data for the given PATH.
Will return nil if no annotations exists.
PATH: Node Path"
(declare (side-effect-free t))
(inline-letevals (path)
(inline-quote
(ht-get treemacs--annotation-store ,path))))
(define-inline treemacs--remove-annotation-if-empty (ann path)
"Remove annotation ANN for PATH from the store if it is empty."
(inline-letevals (ann path)
(inline-quote
(when (and (null (treemacs-annotation->face ,ann))
(null (treemacs-annotation->git-face ,ann))
(null (treemacs-annotation->suffix ,ann)))
(ht-remove! treemacs--annotation-store ,path)))))
(define-inline treemacs--delete-annotation (path)
"Complete delete annotation information for PATH."
(inline-letevals (path)
(inline-quote
(ht-remove! treemacs--annotation-store ,path))))
;;; Faces
(define-inline treemacs-set-annotation-face (path face source)
"Annotate PATH with the given FACE.
Will save the FACE as coming from SOURCE so it can be combined with faces coming
from other sources.
Source must be a *string* so that multiple face annotations on the same node can
be sorted to always be applied in the same order, regardless of when they were
added.
PATH: Node Path
FACE: Face
SOURCE: String"
(inline-letevals (source path face)
(inline-quote
(-if-let* ((ann (treemacs-get-annotation ,path)))
(let* ((face-list (treemacs-annotation->face ann))
(old-face (--first (string= ,source (car it)) face-list)))
(if old-face
(setcdr old-face ,face)
(setf (treemacs-annotation->face ann)
(--sort (string< (car it) (car other))
(cons (cons ,source ,face) face-list))))
(setf (treemacs-annotation->face-value ann)
(append (mapcar #'cdr (treemacs-annotation->face ann))
(treemacs-annotation->git-face ann))))
(ht-set! treemacs--annotation-store ,path
(treemacs-annotation->create!
:face (list (cons ,source ,face))
:face-value (list ,face)))))))
(define-inline treemacs-remove-annotation-face (path source)
"Remove PATH's face annotation for the given SOURCE.
PATH: Node Path
SOURCE: String"
(inline-letevals (path source)
(inline-quote
(-when-let (ann (treemacs-get-annotation ,path))
(let* ((git-face (treemacs-annotation->git-face ann))
(old-faces (treemacs-annotation->face ann))
(new-faces (--reject-first
(string= ,source (car it))
old-faces)))
(if new-faces
(setf
(treemacs-annotation->face ann)
new-faces
(treemacs-annotation->face-value ann)
(append (mapcar #'cdr new-faces) git-face))
(setf
(treemacs-annotation->face ann) 'deleted
(treemacs-annotation->face-value ann) git-face)))))))
(defun treemacs-clear-annotation-faces (source)
"Remove all face annotations of the given SOURCE."
(treemacs--maphash treemacs--annotation-store (path ann)
(-when-let (face-list (treemacs-annotation->face ann))
(setf
(treemacs-annotation->face ann)
(--reject-first (string= source (car it)) face-list)
(treemacs-annotation->face-value ann)
(append
(mapcar #'cdr (treemacs-annotation->face ann))
(treemacs-annotation->git-face ann)))
(treemacs--remove-annotation-if-empty ann path))))
;; Suffixes
(define-inline treemacs-set-annotation-suffix (path suffix source)
"Annotate PATH with the given SUFFIX.
Will save the SUFFIX as coming from SOURCE so it can be combined with suffixes
coming from other sources.
Source must be a *string* so that multiple suffix annotations on the same node
can be sorted to always appear in the same order, regardless of when they were
added.
Treemacs does not prescribe using a specific face for suffix annotations, users
of this api can propertize suffixes as they see fit.
PATH: Node Path
SUFFIX: String
SOURCE: String"
(inline-letevals (source path suffix)
(inline-quote
(progn
(put-text-property 0 (length ,suffix) 'treemacs-suffix-annotation t ,suffix)
(-if-let (ann (treemacs-get-annotation ,path))
(let* ((suffix-list (treemacs-annotation->suffix ann))
(old-suffix (--first (string= ,source (car it)) suffix-list)))
(if old-suffix
(setcdr old-suffix ,suffix)
(setf (treemacs-annotation->suffix ann)
(--sort (string< (car it) (car other))
(cons (cons ,source ,suffix) suffix-list))))
(setf (treemacs-annotation->suffix-value ann)
(mapconcat #'identity (mapcar #'cdr (treemacs-annotation->suffix ann)) " ")))
(ht-set! treemacs--annotation-store ,path
(treemacs-annotation->create!
:suffix (list (cons ,source ,suffix))
:suffix-value ,suffix)))))))
(define-inline treemacs-remove-annotation-suffix (path source)
"Remove PATH's suffix annotation for the given SOURCE.
PATH: Node Path
SOURCE: String"
(inline-letevals (path source)
(inline-quote
(-when-let (ann (treemacs-get-annotation ,path))
(let* ((old-suffixes (treemacs-annotation->suffix ann))
(new-suffixes (--reject-first
(string= ,source (car it))
old-suffixes)))
(if new-suffixes
(setf
(treemacs-annotation->suffix ann)
new-suffixes
(treemacs-annotation->suffix-value ann)
(mapconcat #'identity (mapcar #'cdr (treemacs-annotation->suffix ann)) " "))
(setf
(treemacs-annotation->suffix ann) nil
(treemacs-annotation->suffix-value ann) nil)))))))
(defun treemacs-clear-annotation-suffixes (source)
"Remove all suffix annotations of the given SOURCE."
(treemacs--maphash treemacs--annotation-store (path ann)
(-when-let (suffix-list (treemacs-annotation->suffix ann))
(setf
(treemacs-annotation->suffix ann)
(--reject-first (string= source (car it)) suffix-list)
(treemacs-annotation->suffix-value ann)
(mapconcat #'identity (mapcar #'cdr (treemacs-annotation->suffix ann)) " "))
(treemacs--remove-annotation-if-empty ann path))))
(defun treemacs--apply-annotations-deferred (btn path buffer git-future)
"Deferred application for annotations for BTN and PATH.
Runs on a timer after BTN was expanded and will apply annotations for all of
BTN's *immediate* children.
Change will happen in BUFFER, given that it is alive.
GIT-FUTURE is only awaited when `deferred' git-mode is used.
BTN: Button
PATH: Node Path
BUFFER: Buffer
GIT-FUTURE: Pfuture"
(when (eq 'deferred treemacs--git-mode)
(ht-set! treemacs--git-cache path
(treemacs--get-or-parse-git-result git-future)))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(save-excursion
(treemacs-with-writable-buffer
(let* ((depth (1+ (treemacs-button-get btn :depth)))
(git-info (or (ht-get treemacs--git-cache (treemacs-button-get btn :key))
treemacs--empty-table)))
;; the depth check ensures that we only iterate over the nodes that
;; are below parent-btn and stop when we've moved on to nodes that
;; are above or belong to the next project
(while (and (setq btn (next-button btn))
(>= (treemacs-button-get btn :depth) depth))
(when (= depth (treemacs-button-get btn :depth))
(treemacs--do-apply-annotation
btn
(ht-get git-info (treemacs-button-get btn :key)))))))))))
(define-inline treemacs--do-apply-annotation (btn git-face)
"Apply a single BTN's annotations.
GIT-FACE is taken from the latest git cache, or nil if it's not known."
(inline-letevals (btn git-face)
(inline-quote
(let* ((path (treemacs-button-get ,btn :key))
(ann (treemacs-get-annotation path))
(btn-start (treemacs-button-start ,btn))
(btn-end (treemacs-button-end ,btn)))
(if (null ann)
;; No annotation - just put git face
(when ,git-face
(put-text-property btn-start btn-end 'face ,git-face)
;; git face must be known for initial render
(ht-set!
treemacs--annotation-store
path
(treemacs-annotation->create!
:git-face ,git-face
:face-value ,git-face)))
(let ((face-value (treemacs-annotation->face-value ann))
(suffix-value (treemacs-annotation->suffix-value ann))
(faces (treemacs-annotation->face ann))
(old-git-face (treemacs-annotation->git-face ann)))
;; Faces
(if (eq 'deleted faces)
;; face annotation was deleted - only the git face remains
;; as the annotation value
(progn
(setf
(treemacs-annotation->face ann) nil
(treemacs-annotation->face-value ann) ,git-face
(treemacs-annotation->git-face ann) ,git-face)
(unless ,git-face
(treemacs--remove-annotation-if-empty ann path))
(put-text-property
btn-start btn-end 'face
,git-face))
;; annotations are present, value needs updating if the git face
;; has changed
(let ((new-face-value
(or
(cond
((and ,git-face (not (equal ,git-face old-git-face)))
(append (mapcar #'cdr faces)
(list ,git-face)))
((and old-git-face (null ,git-face))
(mapcar #'cdr faces))
(t face-value))
(treemacs-button-get ,btn :default-face))))
(setf (treemacs-annotation->face-value ann)
new-face-value
(treemacs-annotation->git-face ann)
,git-face)
(put-text-property
btn-start btn-end 'face
new-face-value)))
;; Suffix
(goto-char ,btn)
(goto-char (or (next-single-property-change
,btn
'treemacs-suffix-annotation
(current-buffer)
(line-end-position))
btn-end))
(delete-region (point) (line-end-position))
(when suffix-value (insert suffix-value))))))))
(defun treemacs-apply-single-annotation (path)
"Apply annotations for a single node at given PATH in all treemacs buffers."
(treemacs-run-in-all-derived-buffers
(-when-let (btn (treemacs-find-node path))
(treemacs-with-writable-buffer
(save-excursion
(treemacs--do-apply-annotation
btn
(-when-let (git-cache
(->> path
(treemacs--parent-dir)
(ht-get treemacs--git-cache)))
(ht-get git-cache path))))))))
(defun treemacs-apply-annotations-in-buffer (buffer)
"Apply annotations for all nodes in the given BUFFER."
(when (buffer-live-p buffer)
(with-current-buffer buffer
(treemacs-with-writable-buffer
(save-excursion
(goto-char (point-min))
(let* ((btn (point)))
(while (setf btn (next-button btn))
(-let [path (treemacs-button-get btn :key)]
(treemacs--do-apply-annotation
btn
(-when-let (git-cache
(->> path
(treemacs--parent-dir)
(ht-get treemacs--git-cache)))
(ht-get git-cache path)))))))))))
(defun treemacs-apply-annotations (path)
"Apply annotations for all nodes under the given PATH.
PATH: Node Path"
(treemacs-run-in-all-derived-buffers
(treemacs-with-writable-buffer
(save-excursion
(goto-char (treemacs-find-node path))
(let ((git-info (ht-get treemacs--git-cache path treemacs--empty-table))
(btn (point)))
(treemacs--do-apply-annotation
btn
(ht-get git-info (treemacs-button-get btn :key)))
(while (and (setf btn (next-button btn))
(/= 0 (treemacs-button-get btn :depth)))
(-let [parent-path (treemacs-button-get
(treemacs-button-get btn :parent)
:key)]
(treemacs--do-apply-annotation
btn
(ht-get
(ht-get treemacs--git-cache parent-path git-info)
(treemacs-button-get btn :key))))))))))
(provide 'treemacs-annotations)
;;; treemacs-annotations.el ends here

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -40,6 +40,9 @@
(treemacs-import-functions-from treemacs-rendering
treemacs-do-delete-single-node)
(treemacs-import-functions-from treemacs-annotations
treemacs--do-apply-annotation)
(defconst treemacs--dirs-to-collapse.py
(if (member "treemacs-dirs-to-collapse.py" (directory-files treemacs-dir))
(treemacs-join-path treemacs-dir "treemacs-dirs-to-collapse.py")
@@ -60,6 +63,9 @@
(treemacs-join-path treemacs-dir "treemacs-find-ignored-files.py")
(treemacs-join-path treemacs-dir "src/scripts/treemacs-find-ignored-files.py")))
(defconst treemacs--single-git-update-debouce-store (make-hash-table :size 10)
"Table to keep track of files that will already be updated.")
(defvar treemacs--git-cache-max-size 60
"Maximum size for `treemacs--git-cache'.
If it does reach that size it will be cut back to 30 entries.")
@@ -75,6 +81,8 @@ face changes, especially when a full project is refreshed.
Since this table is a global value that can effectively grow indefinitely its
value is limited by `treemacs--git-cache-max-size'.")
(defvar treemacs-git-mode)
(define-inline treemacs--git-status-face (status default)
"Get the git face for the given STATUS.
Use DEFAULT as default match.
@@ -97,18 +105,6 @@ DEFAULT: Face"
"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: Hash-Table
DEFAULT: Face"
(declare (pure t) (side-effect-free t))
(inline-letevals (path git-info default)
(inline-quote
(treemacs--git-status-face (ht-get ,git-info ,path) ,default))))
(defun treemacs--resize-git-cache ()
"Cuts `treemacs--git-cache' back down to size.
Specifically its size will be reduced to half of `treemacs--git-cache-max-size'."
@@ -134,7 +130,7 @@ Remote projects are ignored."
(defun treemacs--git-status-parse-function (_future)
"Dummy with FUTURE.
Real implementation will be `fset' based on `treemacs-git-mode' value."
(ht))
treemacs--empty-table)
(defun treemacs--git-status-process-extended (path)
"Start an extended python-parsed git status process for files under PATH."
@@ -190,13 +186,13 @@ GIT-FUTURE: Pfuture"
(treemacs-log-err "treemacs-git-status.py output: %s" git-output))
(treemacs-log-err "treemacs-git-status.py did not output a valid hash table. See full output in *Messages*.")
nil)))))
(ht)))
treemacs--empty-table))
(defun treemacs--git-status-process-simple (path)
"Start a simple git status process for files under PATH."
(let* ((default-directory (file-truename path))
(process-environment (cons "GIT_OPTIONAL_LOCKS=0" process-environment))
(future (pfuture-new "git" "status" "--porcelain" "--ignored" "-z" ".")))
(future (pfuture-new "git" "status" "--porcelain" "--ignored=matching" "-z" ".")))
(process-put future 'default-directory default-directory)
future))
@@ -230,45 +226,12 @@ GIT-FUTURE: Pfuture"
(setq i (1+ i))
(ht-set! git-info-hash
(treemacs-join-path git-root (s-trim-left path))
(substring (s-trim-left status) 0 1)))))
(treemacs--git-status-face
(substring (s-trim-left status) 0 1)
'treemacs-git-unmodified-face)))))
(setq i (1+ i)))))))))
git-info-hash))
;; TODO(2019/11/06): re-get git status when btn is flattened
(defun treemacs--apply-deferred-git-state (parent-btn git-future buffer)
"Apply the git fontification for direct children of PARENT-BTN.
GIT-FUTURE is parsed the same way as in `treemacs--create-branch'. Additionally
since this function is run on an idle timer the BUFFER to work on must be passed
as well since the user may since select a different buffer, window or frame.
PARENT-BTN: Button
GIT-FUTURE: Pfuture|HashMap
BUFFER: Buffer"
(when (and (buffer-live-p buffer) git-future)
(with-current-buffer buffer
;; cut the cache down to size if it grows too large
(when (> (ht-size treemacs--git-cache) treemacs--git-cache-max-size)
(run-with-idle-timer 2 nil #'treemacs--resize-git-cache))
(-let [parent-path (treemacs-button-get parent-btn :path)]
;; the node may have been closed or deleted by now
(when (and (treemacs-find-in-dom parent-path)
(memq (treemacs-button-get parent-btn :state) '(dir-node-open root-node-open)))
(let ((depth (1+ (treemacs-button-get parent-btn :depth)))
(git-info (treemacs--get-or-parse-git-result git-future))
(btn parent-btn))
(ht-set! treemacs--git-cache parent-path git-info)
(treemacs-with-writable-buffer
;; the depth check ensures that we only iterate over the nodes that are below parent-btn
;; and stop when we've moved on to nodes that are above or belong to the next project
(while (and (setq btn (next-button btn))
(>= (treemacs-button-get btn :depth) depth))
(-let [path (treemacs-button-get btn :key)]
(when (and (= depth (treemacs-button-get btn :depth))
(not (treemacs-button-get btn :no-git)))
(treemacs-button-put
btn 'face
(treemacs--get-node-face path git-info (treemacs-button-get btn :default-face)))))))))))))
(defun treemacs-update-single-file-git-state (file)
"Update the FILE node's git state, wrapped in `treemacs-save-position'.
Internally calls `treemacs-do-update-single-file-git-state'.
@@ -297,8 +260,13 @@ OVERRIDE-STATUS: Boolean"
(let* ((local-buffer (current-buffer))
(parent (treemacs--parent file))
(parent-node (treemacs-find-in-dom parent)))
(when parent-node
(when (and
treemacs-git-mode
parent-node
(null (ht-get treemacs--single-git-update-debouce-store file)))
(ht-set! treemacs--single-git-update-debouce-store file t)
(let* ((parents (unless (or exclude-parents
(eq 'simple treemacs--git-mode)
(null (treemacs-dom-node->parent parent-node)))
;; include the first parent...
(cons (treemacs-dom-node->key parent-node)
@@ -306,45 +274,56 @@ OVERRIDE-STATUS: Boolean"
(cdr (-map #'treemacs-dom-node->key
(treemacs-dom-node->all-parents parent-node))))))
(git-cache (ht-get treemacs--git-cache parent))
(current-state (if override-status
"OVERRIDE"
(or (-some-> git-cache (ht-get file)) "0")))
(current-face (if override-status
"OVERRIDE"
(or (-some-> git-cache (ht-get file) (symbol-name))
"NONE")))
(cmd `(,treemacs-python-executable
"-O"
,treemacs--single-file-git-status.py ,file ,current-state ,@parents)))
,treemacs--single-file-git-status.py ,file ,current-face ,@parents)))
(pfuture-callback cmd
:directory parent
:name "Treemacs Update Single File Process"
:on-success
(when (buffer-live-p local-buffer)
(with-current-buffer local-buffer
(treemacs-with-writable-buffer
;; first the file node with its own default face
(-let [output (read (pfuture-callback-output))]
(-let [(file . state) (pop output)]
(when git-cache
(ht-set! git-cache file state))
(-when-let (pos (treemacs-find-visible-node file))
(let* ((default (if (file-directory-p file) 'treemacs-directory-face 'treemacs-git-unmodified-face))
(face (treemacs--git-status-face state default)))
(put-text-property
(treemacs-button-start pos) (treemacs-button-end pos)
'face face))))
;; then the directories
(pcase-dolist (`(,file . ,state) output)
(-when-let (pos (treemacs-find-visible-node file))
(-let [face (treemacs--git-status-face state 'treemacs-directory-face)]
(put-text-property
(treemacs-button-start pos) (treemacs-button-end pos)
'face face))))))))
(progn
(ht-remove! treemacs--single-git-update-debouce-store file)
(when (buffer-live-p local-buffer)
(with-current-buffer local-buffer
(treemacs-with-writable-buffer
(save-excursion
;; first the file node with its own default face
(-let [output (read (pfuture-callback-output))]
(-let [(path . face) (pop output)]
(treemacs--git-face-quick-change path face git-cache))
;; then the directories
(pcase-dolist (`(,path . ,face) output)
(treemacs--git-face-quick-change path face))))))))
:on-error
(pcase (process-exit-status process)
(2 (ignore "No Change, Do Nothing"))
(_
(-let [err-str (treemacs--remove-trailing-newline (pfuture-output-from-buffer pfuture-buffer))]
(treemacs-log-err "Update of node \"%s\" failed with status \"%s\" and result"
file (treemacs--remove-trailing-newline status))
(treemacs-log-err "\"%s\"" (treemacs--remove-trailing-newline err-str))))))))))
(progn
(ht-remove! treemacs--single-git-update-debouce-store file)
(pcase (process-exit-status process)
(2 (ignore "No Change, Do Nothing"))
(_
(-let [err-str (treemacs--remove-trailing-newline (pfuture-output-from-buffer pfuture-buffer))]
(treemacs-log-err "Update of node \"%s\" failed with status \"%s\" and result"
file (treemacs--remove-trailing-newline status))
(treemacs-log-err "\"%s\"" (treemacs--remove-trailing-newline err-str)))))))))))
(define-inline treemacs--git-face-quick-change (path git-face &optional git-cache)
"Quick-change of PATH's GIT-FACE.
Updates the visible face and git-cache + annotation store entries. GIT-CACHE
might be already known or not. If not it will be pulled from BTN's parent.
Used when asynchronous processes report back git changes."
(inline-letevals (path git-face git-cache)
(inline-quote
(let ((git-cache (or ,git-cache
(ht-get treemacs--git-cache
(treemacs--parent-dir ,path))))
(btn (treemacs-find-visible-node ,path)))
(when git-cache
(ht-set! git-cache ,path ,git-face))
(when btn
(treemacs--do-apply-annotation btn ,git-face))))))
(defun treemacs--collapsed-dirs-process (path project)
"Start a new process to determine directories to collapse under PATH.
@@ -418,7 +397,7 @@ run because the git cache has yet to be filled."
(treemacs-run-in-every-buffer
(treemacs-save-position
(dolist (file ignored-files)
(when-let (treemacs-is-path-visible? file)
(-when-let (treemacs-is-path-visible? file)
(treemacs-do-delete-single-node file))))))))
(define-minor-mode treemacs-git-mode
@@ -477,13 +456,13 @@ Use either ARG as git integration value of read it interactively."
(fset 'treemacs--git-status-parse-function #'treemacs--parse-git-status-simple))
(_
(fset 'treemacs--git-status-process-function #'ignore)
(fset 'treemacs--git-status-parse-function (lambda (_) (ht))))))
(fset 'treemacs--git-status-parse-function (lambda (_) treemacs--empty-table)))))
(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))))
(fset 'treemacs--git-status-parse-function (lambda (_) treemacs--empty-table)))
(define-inline treemacs--get-or-parse-git-result (future)
"Get the parsed git result of FUTURE.
@@ -499,7 +478,7 @@ FUTURE: Pfuture process"
(let ((result (treemacs--git-status-parse-function ,future)))
(process-put ,future 'git-table result)
result))
(ht)))))
treemacs--empty-table))))
(define-minor-mode treemacs-hide-gitignored-files-mode
"Toggle `treemacs-hide-gitignored-files-mode'.

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

@@ -1,6 +1,6 @@
;;; treemacs-bookmarks.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -143,7 +143,8 @@ width of the new window when the treemacs window is visible."
(add-hook 'org-store-link-functions #'treemacs-store-org-link))))
(with-eval-after-load 'evil-escape
(when (boundp 'evil-escape-excluded-major-modes)
;; Disable old versions of evil-escape but keep newer versions active
(when (and (boundp 'evil-escape-excluded-major-modes) (not (boundp 'evil-escape-version)))
(add-to-list 'evil-escape-excluded-major-modes 'treemacs-mode)))
(defun treemacs-load-all-the-icons-with-workaround-font (font)

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -105,7 +105,6 @@
treemacs-workspace->projects
treemacs-workspace->is-empty?
treemacs-do-add-project-to-workspace
treemacs-project->is-expanded?
treemacs-project->path
treemacs-project->name
treemacs-project->refresh!
@@ -119,8 +118,15 @@
(treemacs-import-functions-from "treemacs-persistence"
treemacs--maybe-load-workspaces)
(treemacs-import-functions-from "treemacs-annotations"
treemacs--delete-annotation)
(declare-function treemacs-mode "treemacs-mode")
(defconst treemacs--empty-table (ht)
"Constant value of an empty hash table.
Used to avoid creating unnecessary garbage.")
(defvar treemacs--closed-node-states
'(root-node-closed
dir-node-closed
@@ -130,7 +136,8 @@
Used in `treemacs-is-node-collapsed?'")
(defvar treemacs--open-node-states
'(root-node-open
'(project-node-open
root-node-open
dir-node-open
file-node-open
tag-node-open)
@@ -147,6 +154,35 @@ Used in `treemacs-is-node-expanded?'")
(substring ,path 0 -1)
,path))))
(define-inline treemacs--prefix-arg-to-recurse-depth (arg)
"Translates prefix ARG into a number.
Used for depth-based expansion of nodes - a numeric prefix will translate to
itself, the default representation translates to 9999."
(declare (pure t) (side-effect-free t))
(inline-letevals (arg)
(inline-quote
(cond
((null ,arg) 0)
((integerp ,arg) ,arg)
(t 999)))))
(defun treemacs--all-buttons-with-depth (depth)
"Get all buttons with the given DEPTH."
(declare (side-effect-free t))
(save-excursion
(goto-char (point-min))
(let ((current-btn (treemacs-current-button))
(result))
(when (and current-btn
(= depth (treemacs-button-get current-btn :depth)))
(push current-btn result))
(while (= 0 (forward-line 1))
(setf current-btn (treemacs-current-button))
(when (and current-btn
(= depth (treemacs-button-get current-btn :depth)))
(push current-btn result)))
result)))
(define-inline treemacs--parent-dir (path)
"Return the parent of PATH is it's a file, or PATH if it is a directory.
@@ -202,7 +238,7 @@ If STR already has a slash return it unchanged."
"Delete the current line.
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))))))
(delete-region (line-beginning-position) (min (point-max) (1+ (line-end-position))))))
(define-inline treemacs-current-button ()
"Get the button in the current line.
@@ -210,7 +246,7 @@ Returns nil when point is between projects."
(declare (side-effect-free error-free))
(inline-quote
(-some->
(text-property-not-all (point-at-bol) (point-at-eol) 'button nil)
(text-property-not-all (line-beginning-position) (line-end-position) 'button nil)
(copy-marker t))))
(defalias 'treemacs-node-at-point #'treemacs-current-button)
@@ -317,7 +353,7 @@ EXCLUDE-PREFIX: File Path"
(inline-quote
(save-excursion
(let ((len (length ,new-symbol)))
(goto-char (- (treemacs-button-start (next-button (point-at-bol) t)) len))
(goto-char (- (treemacs-button-start (next-button (line-beginning-position) t)) len))
(insert ,new-symbol)
(delete-char len))))))
@@ -423,6 +459,7 @@ being edited to trigger."
(inline-letevals (path no-buffer-delete)
(inline-quote
(progn
(treemacs--delete-annotation ,path)
(unless ,no-buffer-delete (treemacs--kill-buffers-after-deletion ,path t))
(treemacs--stop-watching ,path t)
;; filewatch mode needs the node's information to be in the dom
@@ -459,7 +496,7 @@ In practice this means expand PATH and remove its final slash."
"Determined if FILE is ignored by git by means of GIT-INFO."
(declare (side-effect-free t))
(inline-letevals (file git-info)
(inline-quote (string= "!" (ht-get ,git-info ,file)))))
(inline-quote (eq 'treemacs-git-ignored-face (ht-get ,git-info ,file)))))
(define-inline treemacs-is-treemacs-window-selected? ()
"Return t when the treemacs window is selected."
@@ -529,6 +566,7 @@ Add a project for ROOT and NAME if they are non-nil."
(treemacs-do-add-project-to-workspace path name)
(treemacs-log "Created first project.")))
(goto-char 2)
(run-hooks 'treemacs-post-buffer-init-hook)
(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))
@@ -623,7 +661,7 @@ failed. PROJECT is used for determining whether Git actions are appropriate."
;; first a plain text-based search for the current dir-part string
;; then we grab the node we landed at and see what's going on
;; there's a couple ways this can go
(while (progn (goto-char (point-at-eol)) (search-forward dir-part nil :no-error))
(while (progn (goto-char (line-end-position)) (search-forward dir-part nil :no-error))
(setq current-btn (treemacs-current-button))
(cond
;; somehow we landed on a line where there isn't even anything to look at
@@ -763,39 +801,69 @@ 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.
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
`treemacs-goto-file-node'. PATH is a filepath string while PROJECT is fully
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.
The first one is for movement towards a node that identifies a normal file. In
this case the signature is applied as is, and this function diverges simply into
`treemacs-goto-file-node'. PATH is a file path string while PROJECT is a
`treemacs-project' struct instance and fully optional, as treemacs is able to
determine which project, if any, a given file belongs to. Providing the project
when it happens to be available is therefore only a small optimisation. If
PROJECT is not given it will be found with `treemacs--find-project-for-path'.
No attempt is made to verify that PATH actually falls 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.
to the node to be moved to and PROJECT is not used.
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
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.
Either way this function will return a marker to the moved to position if it was
Either way this function will return a marker to the moved-to position if it was
successful.
PATH: Filepath | Node Path
PROJECT Project Struct"
(treemacs-with-path path
:file-action (when (file-exists-p path) (treemacs-find-file-node path project))
:top-level-extension-action (treemacs--find-custom-top-level-node path)
:directory-extension-action (treemacs--find-custom-dir-node path)
:project-extension-action (treemacs--find-custom-project-node path)))
(save-excursion
(treemacs-with-path path
:file-action (when (and (eq t treemacs--in-this-buffer)
(file-exists-p path))
(treemacs-find-file-node path project))
:extension-action (treemacs--find-custom-node path))))
(defun treemacs--find-custom-node (path)
"Specialisation to find a custom node at the given PATH."
(let* (;; go back here if the search fails
(start (point))
;; (top-pos (treemacs-dom-node->position (treemacs-find-in-dom (car path))))
;; making a copy since the variable is a reference to a node actual path
;; and will be changed in-place here
(goto-path (if (listp path) (copy-sequence path) (list path)))
;; manual as in to be expanded manually after we moved to the next closest node we can find
;; in the dom
(manual-parts nil)
(dom-node nil))
(-let [continue t]
(while continue
(setf dom-node (treemacs-find-in-dom goto-path))
(if (or (null dom-node)
;; dom node might exist, but a leaf's position is not always known
(null (treemacs-dom-node->position dom-node)))
(if (cdr goto-path)
(progn
(push (-last-item goto-path) manual-parts)
(setf goto-path (-butlast goto-path)))
(setf goto-path (car goto-path)))
(setf continue nil))))
(let* ((btn (treemacs-dom-node->position dom-node))
;; do the rest manually
(search-result (if manual-parts (treemacs--follow-path-elements btn manual-parts)
(goto-char btn))))
(if (eq 'follow-failed search-result)
(prog1 nil
(goto-char start))
(treemacs-dom-node->set-position! (treemacs-find-in-dom path) search-result)
search-result))))
(defun treemacs-goto-node (path &optional project ignore-file-exists)
"Move point to button identified by PATH under PROJECT in the current buffer.
@@ -807,10 +875,23 @@ PATH: Filepath | Node Path
PROJECT Project Struct
IGNORE-FILE-EXISTS Boolean"
(treemacs-with-path path
:file-action (when (or ignore-file-exists (file-exists-p path)) (treemacs-goto-file-node path project))
:top-level-extension-action (treemacs--goto-custom-top-level-node path)
:directory-extension-action (treemacs--goto-custom-dir-node path)
:project-extension-action (treemacs--goto-custom-project-node path)))
:file-action (when (or ignore-file-exists (file-exists-p path))
(treemacs-goto-file-node path project))
:extension-action (treemacs-goto-extension-node path)))
(define-inline treemacs-goto-extension-node (path)
"Move to an extension node at the given PATH.
Small short-cut over `treemacs-goto-node' if you know for certain that PATH
leads to an extension node."
(inline-letevals (path)
(inline-quote
(-when-let (result (treemacs--find-custom-node ,path))
(treemacs--evade-image)
(hl-line-highlight)
;; Only change window point if the current buffer is actually visible
(-when-let (window (get-buffer-window))
(set-window-point window (point)))
result))))
(defun treemacs-find-file-node (path &optional project)
"Find position of node identified by PATH under PROJECT in the current buffer.
@@ -909,7 +990,7 @@ PROJECT: Project Struct")
"Set the width of the treemacs buffer to WIDTH."
(unless (one-window-p)
(let ((window-size-fixed)
(w (max width window-min-width)))
(w (max width window-safe-min-width)))
(cond
((> (window-width) w)
(shrink-window-horizontally (- (window-width) w)))
@@ -928,12 +1009,12 @@ The second test not apply if `treemacs-show-hidden-files' is t."
(define-inline treemacs--std-ignore-file-predicate (file _)
"The default predicate to detect ignored files.
Will return t when FILE
1) starts with '.#' (lockfiles)
2) starts with 'flycheck_' (flycheck temp files)
3) ends with '~' (backup files)
4) is surrounded with # (auto save files)
5) is '.git'
6) is '.' or '..' (default dirs)"
1) starts with \".#\" (lockfiles)
2) starts with \"flycheck_\" (flycheck temp files)
3) ends with \"~\" (backup files)
4) is surrounded with \"#\" (auto save files)
5) is \".git\" (see also `treemacs-hide-dot-git-directory')
6) is \".\" or \"..\" (default dirs)"
(declare (side-effect-free t) (pure t))
(inline-letevals (file)
(inline-quote
@@ -943,7 +1024,8 @@ Will return t when FILE
(eq ?~ last)
(string-equal ,file ".")
(string-equal ,file "..")
(string-equal ,file ".git")
(and treemacs-hide-dot-git-directory
(string-equal ,file ".git"))
(string-prefix-p "flycheck_" ,file))))))
(define-inline treemacs--mac-ignore-file-predicate (file _)
@@ -978,9 +1060,9 @@ Will be added to `treemacs-ignored-file-predicates' on Macs."
;; workaround for LV windows like spacemacs' transient states preventing
;; side windows from popping up right
;; see https://github.com/abo-abo/hydra/issues/362
(setf (buffer-local-value 'window-size-fixed lv-buffer) nil)
(with-current-buffer lv-buffer (setf window-size-fixed nil))
(treemacs--popup-window)
(setf (buffer-local-value 'window-size-fixed lv-buffer) t))
(with-current-buffer lv-buffer (setf window-size-fixed t)))
(treemacs--popup-window))
(treemacs--forget-last-highlight)
(set-window-dedicated-p (selected-window) t)
@@ -997,9 +1079,8 @@ PATH: Node Path"
(inline-quote
(treemacs-with-path ,path
:file-action (treemacs--parent-dir ,path)
:top-level-extension-action (when (> (length ,path) 2) (butlast ,path))
:directory-extension-action (if (> (length ,path) 2) (butlast ,path) (car ,path))
:project-extension-action (if (> (length ,path) 2) (butlast ,path) (treemacs-project->path (car ,path)))))))
:extension-action (-butlast ,path)
:no-match-action (user-error "Path %s appears to be neither a file nor an extension" ,path)))))
(define-inline treemacs--evade-image ()
"The cursor visibly blinks when on top of an icon.
@@ -1069,7 +1150,7 @@ through the buffer list and kill buffer if PATH is a prefix."
"Execute the refresh process for BUFFER and PROJECT in that buffer.
Specifically extracted with the buffer to refresh being supplied so that
filewatch mode can refresh multiple buffers at once.
Will refresh every project when PROJECT is 'all."
Will refresh every project when PROJECT is \\='all."
(with-current-buffer buffer
(treemacs-save-position
(progn
@@ -1147,6 +1228,20 @@ INITIAL-INPUT: String"
(inline-letevals (path)
(inline-quote (split-string ,path "/" :omit-nulls))))
(defun treemacs--jump-to-next-treemacs-window ()
"Jump from the current to the next treemacs-based window.
Will do nothing and return nil if no such window exists, or if there is only one
treemacs window."
(let* ((current-window (selected-window))
(treemacs-windows
(--filter
(buffer-local-value 'treemacs--in-this-buffer (window-buffer it))
(window-list))))
(-when-let (idx (--find-index (equal it current-window) treemacs-windows))
(-let [next-window (nth (% (1+ idx) (length treemacs-windows)) treemacs-windows)]
(unless (eq next-window current-window)
(select-window next-window))))))
(provide 'treemacs-core-utils)
;;; treemacs-core-utils.el ends here

49
lisp/treemacs/treemacs-count-mail.py Normal file
View File

@@ -0,0 +1,49 @@
from subprocess import Popen, PIPE
import sys
# mu4e-headers-include-related
REL_FLAG = "-r" if sys.argv[1] == "True" else ""
UNREAD_CMD = "mu find maildir:'{}' " + REL_FLAG + " --fields 'i' flag:'unread' 2> /dev/null | wc -l"
PATH_PREFIX = "treemacs-mu4e"
# First arg indicates whether 'mu4e-headers-include-related' is t and mu's '-r' flag should be set
# to also count related messages
# The remaining arguments are a list of maildirs
# The output is a list of items in the form '((P1 A1) (P2 A2))' where P is the node path for a maildir
# node, and A is the mail count annotation text
# Exmaple: '(((treemacs-mu4e "/web" "/web/") " (176)")((treemacs-mu4e "/web" "/web/Inbox") " (161)"))'
def main():
maildirs = sys.argv[2:]
ret = ["("]
for maildir in maildirs:
unread = Popen(UNREAD_CMD.format(maildir), shell=True, stdout=PIPE, bufsize=100, encoding='utf-8').communicate()[0][:-1]
if unread == "0":
continue
path = []
path_item = ""
split_path = maildir.split("/")[1:]
# the script must have access to the true folder for the count to work
# when passing things back to elisp the pseudo-hierarchy must be re-established
if len(split_path) == 1:
split_path.insert(0, "Local Folders")
for split_part in split_path:
path_item = path_item + "/" + split_part
path.append("\"" + path_item + "\"")
suffix = '" ({})"'.format(unread)
ret.append('(({} {}) {})'.format(
PATH_PREFIX, " ".join(path), suffix
))
ret.append(")")
print("".join(ret))
main()

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -113,7 +113,7 @@
(defcustom treemacs-indentation 2
"The number of spaces or pixels each level is indented in the file tree.
If the value is integer, indentation is created by repeating
`treemacs-indentation-string'. If the value is a list of form '(INTEGER px),
`treemacs-indentation-string'. If the value is a list of form \\='(INTEGER px),
indentation will be a space INTEGER pixels wide."
:type '(choice (integer :tag "Spaces" :value 2)
(list :tag "Pixels"
@@ -142,8 +142,8 @@ There are 2 options:
minibuffer input is used.
- `from-minibuffer': will read input from the minibuffer, same as baseline
Emacs."
:type '(choice (const :tag "With Child Frame Popup" 'from-child-frame)
(const :tag "From the Minibuffer (Emacs Default)" 'from-minibuffer))
:type '(choice (const :tag "With Child Frame Popup" from-child-frame)
(const :tag "From the Minibuffer (Emacs Default)" from-minibuffer))
:group 'treemacs)
(defcustom treemacs-move-forward-on-expand nil
@@ -160,8 +160,8 @@ There are 2 options:
permissions of the file at point
Requires eldoc mode to be enabled."
:type '(choice (const :tag "Simple" 'simple)
(const :tag "Detailed" 'detailed))
:type '(choice (const :tag "Simple" simple)
(const :tag "Detailed" detailed))
:group 'treemacs)
(defcustom treemacs-indent-guide-style 'line
@@ -171,7 +171,8 @@ The choices are
level
- `block' to use a thick '██' block interspersed at every second indentation
level"
:type '(choice (const :tag "Line" 'line) (const :tag "Block" 'block))
:type '(choice (const :tag "Line" line)
(const :tag "Block" block))
:group 'treemacs)
(defcustom treemacs-indentation-string " "
@@ -256,7 +257,7 @@ single argument.
To keep the alist clean changes should not be made directly, but with
`treemacs-define-RET-action', for example like this:
\(treemacs-define-RET-action 'file-node-closed #'treemacs-visit-node-ace\)"
\(treemacs-define-RET-action \\='file-node-closed #\\='treemacs-visit-node-ace)"
:type '(alist :key-type symbol :value-type treemacs-ret-action)
:group 'treemacs)
@@ -278,10 +279,18 @@ of how this config works and how to modify it."
:group 'treemacs)
(defcustom treemacs-dotfiles-regex (rx bol "." (1+ any))
"Files matching this regular expression count as dotfiles."
"Files matching this regular expression count as dotfiles.
This controls the matching behaviour of `treemacs-toggle-show-dotfiles'."
:type 'regexp
:group 'treemacs)
(defcustom treemacs-hide-dot-git-directory t
"Indicates whether the .git directory should be hidden.
When this is non-nil the .git dir will be hidden regardless of current setting
of `treemacs-toggle-show-dotfiles'."
:type 'list
:group 'treemacs)
(defcustom treemacs-sorting 'alphabetic-asc
"Indicates how treemacs will sort its files and directories.
Files will still always be shown after directories.
@@ -307,7 +316,7 @@ Deciding on the order in which its nodes are inserted is a part of this path.
As such certain trade-offs need to be accounted far.
In plaintext: some sort settings are much slower than others. Alphabetic
sorting \(the default) is fastest and causes no additional overhead (even when
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
@@ -342,9 +351,9 @@ 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.
This means that this variable should *not* be set directly, but instead modified
with functions like `add-to-list'.
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')."
@@ -363,7 +372,7 @@ 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')
map map as follows: (the pattern is derived from \\='git status --porcelain\\=')
* M - file is modified
* U - file is in conflict
@@ -378,7 +387,7 @@ be rendered."
:type 'list
:group 'treemacs)
(defcustom treemacs-file-event-delay 5000
(defcustom treemacs-file-event-delay 2000
"How long (in milliseconds) to collect file events before refreshing.
When treemacs receives a file change notification it doesn't immediately refresh
and instead waits `treemacs-file-event-delay' milliseconds to collect further
@@ -464,8 +473,8 @@ Specifically applies to calling `treemacs-next-project' and
Possible values are:
* nil: never recenter
* 'always: always recenter
* 'on-distance: recenter based on `treemacs-recenter-distance'"
* \\='always: always recenter
* \\='on-distance: recenter based on `treemacs-recenter-distance'"
:type '(choice (const :tag "Always" always)
(const :tag "Based on Distance" on-distance)
(const :tag "Never" nil))
@@ -476,9 +485,9 @@ Possible values are:
Possible values are:
* nil: never recenter
* 'always: always recenter
* 'on-distance: recenter based on `treemacs-recenter-distance'
* 'on-visibility: recenter only when the newly rendered lines don't fit the
* \\='always: always recenter
* \\='on-distance: recenter based on `treemacs-recenter-distance'
* \\='on-visibility: recenter only when the newly rendered lines don't fit the
current screen"
:type '(choice (const :tag "Always" always)
(const :tag "Based on Distance" on-distance)
@@ -572,7 +581,8 @@ Can be set to nil to use the default value."
(defcustom treemacs-persist-file
(expand-file-name ".cache/treemacs-persist" user-emacs-directory)
"Path to the file treemacs uses to persist its state."
"Path to the file treemacs uses to persist its state.
Can be set to nil to disable workspace persistence."
:group 'treemacs
:type 'string)
@@ -676,8 +686,8 @@ flooded with their tags."
"Decides when to recenter view after following a file.
Possible values are:
* nil: never recenter
* 'always: always recenter
* 'on-distance: recenter based on `treemacs-recenter-distance'"
* \\='always: always recenter
* \\='on-distance: recenter based on `treemacs-recenter-distance'"
:type '(choice (const :tag "Always" always)
(const :tag "Based on Distance" on-distance)
(const :tag "Never" nil))
@@ -687,8 +697,8 @@ Possible values are:
"Decides when to recenter view after following a tag.
Possible values are:
* nil: never recenter
* 'always: always recenter
* 'on-distance: recenter based on `treemacs-recenter-distance'"
* \\='always: always recenter
* \\='on-distance: recenter based on `treemacs-recenter-distance'"
:type '(choice (const :tag "Always" always)
(const :tag "Based on Distance" on-distance)
(const :tag "Never" nil))
@@ -713,9 +723,9 @@ This is only relevant when using the deferred variant of git-mode."
(defcustom treemacs-max-git-entries 5000
"Maximum number of git status entries treemacs will process.
Information for entries that number will be silently ignored. The 'entries'
refer to the lines output by `git status --porcelain --ignored'. The limit does
not apply to the simple `treemacs-git-mode.'"
Information for entries that number will be silently ignored. The \"entries\"
refer to the lines output by `git status --porcelain --ignored=matching'. The
limit does not apply to the simple `treemacs-git-mode.'"
:type 'number
:group 'treemacs-git)
@@ -733,13 +743,14 @@ the python3 binary."
(defcustom treemacs-git-command-pipe ""
"Text to be appended to treemacs' git command.
With `treemacs-git-mode' the command `git status --porcelain --ignored .' is
run to fetch a directory's git information. The content of this variable will
be appended to this git command. This might be useful in cases when the output
produced by git is so large that it leads to palpable delays, while setting
`treemacs-max-git-entries' leads to loss of information. In such a scenario an
additional filter statement (for example `| grep -v \"/vendor_dir/\"') can be
used to reduce the size of the output to a manageable volume for treemacs."
With `treemacs-git-mode' the command
`git status --porcelain --ignored=matching .' is run to fetch a directory's git
information. The content of this variable will be appended to this git command.
This might be useful in cases when the output produced by git is so large that
it leads to palpable delays, while setting `treemacs-max-git-entries' leads to
loss of information. In such a scenario an additional filter statement (for
example `| grep -v \"/vendor_dir/\"') can be used to reduce the size of the
output to a manageable volume for treemacs."
:type 'string
:group 'treemacs-git)
@@ -817,14 +828,25 @@ negative values are possible."
:type 'integer
:group 'treemacs-window)
(defcustom treemacs-header-scroll-indicators '(nil . "^^^^^^")
"The strings used for `treemacs-indicate-top-scroll-mode'.
The value must be a cons, where the car is the string used when treemacs is
scrolled all the way to the top, and the cdr is used when it isn't."
:type '(cons string string)
: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
- `goto-next' - jump to the next treemacs-based window (e.g. treemacs-mu4e)
- `move-back' - move point back to the most recently used window (as selected
by `get-mru-window')"
by `get-mru-window')
- `next-or-back' - a combination of the two previous options. First try to
move to the next treemacs-based window, if none exists move back to the most
recently used window"
:type '(choice (const stay)
(const close)
(const move-back))
@@ -834,12 +856,24 @@ Possible values are:
"Position of treemacs buffer.
Valid values are
* left,
* right."
* `left',
* `right'"
:type '(choice (const left)
(const right))
:group 'treemacs)
(defcustom treemacs-post-buffer-init-hook nil
"Hook run after a treemacs buffer is first initialised.
Only applies to treemacs filetree buffers, not extensions."
:type 'hook
:group 'treemacs-hooks)
(defcustom treemacs-post-project-refresh-functions nil
"Hook that runs after a project was updated with `treemacs-refresh'.
Will be called with the new project as the sole argument."
:type 'hook
:group 'treemacs-hooks)
(defcustom treemacs-create-project-functions nil
"Hooks to run whenever a project is created.
Will be called with the new project as the sole argument."
@@ -976,7 +1010,7 @@ During the refresh the project is effectively collapsed and then expanded again.
This hook runs *before* that happens. It runs with treemacs as the
`current-buffer' and receives as its arguments all the information that treemacs
collects for its refresh process:
* The project being refreshed (might be 'all)
* The project being refreshed (might be \\='all)
* The current screen-line number (can be nil).
* The current button. Might be nil if point is on the header line.
* The current button's state. See also `treemacs-valid-button-states'. Is nil
@@ -995,7 +1029,7 @@ This hook runs *after* that has happened. It runs with treemacs as the
collects for its refresh process. Note that these values were collected at the
start of the refresh, and may now be longer valid (for example the current
button's position will be wrong, even if it wasn't deleted outright):
* The project being refreshed (might be 'all)
* The project being refreshed (might be \\='all)
* The current screen-line number (can be nil).
* The current button. Might be nil if point was on the header line.
* The current button's state. See also `treemacs-valid-button-states'. Is nil

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

@@ -1,6 +1,6 @@
;;; treemacs-diagnostics.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -80,9 +80,9 @@ not expected to be a major issue.
A basic example use would look like this:
\(treemacs-apply-diagnostics
(thunk-delay '(\"/path/to/file/x\" 'treemacs-diagnostic-warning-face
\"/path/to/file/y\" 'treemacs-diagnostic-error-face
\"/path/to/file/z\" '((:underline \"green\")))))"
(thunk-delay \\='(\"/path/to/file/x\" \\='treemacs-diagnostic-warning-face
\"/path/to/file/y\" \\='treemacs-diagnostic-error-face
\"/path/to/file/z\" \\='((:underline \"green\")))))"
(treemacs-debounce treemacs--diagnostic-timer treemacs--apply-diagnostics-delay
(treemacs-run-in-every-buffer
(save-excursion

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -225,7 +225,7 @@ node for quick retrieval later."
Based on the given NAME this macro will define a `treemacs-${name}-state' state
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.
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'.
@@ -270,11 +270,12 @@ 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.
@@ -476,7 +477,6 @@ additional keys."
(dom-node (treemacs-dom-node->create!
:key ,root-key-form
:position button-start)))
(treemacs--set-project-position ,root-key-form (point-marker))
(treemacs-dom-node->insert-into-dom! dom-node)
(insert (propertize "Hidden Node\n"
'button '(t)
@@ -501,7 +501,6 @@ additional keys."
:path ,root-key-form
:path-status 'extension)]
(insert ,(if icon-closed closed-icon-name icon-closed-form))
(treemacs--set-project-position ,root-key-form (point-marker))
(insert (propertize ,root-label
'button '(t)
'category 'default-button
@@ -552,6 +551,8 @@ and rules apply for QUERY-FUNCTION, RENDER-ACTION and ROOT-KEY-FORM."
(treemacs-mode))
(setq-local treemacs--in-this-buffer :extension))
(treemacs-log "The treemacs-extensions module is obsolete, treemacs-treelib should be used instead.")
(provide 'treemacs-extensions)
;;; treemacs-extensions.el ends here

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -29,8 +29,8 @@
(defface treemacs-directory-collapsed-face
'((t :inherit treemacs-directory-face))
"Face used by treemacs for collapsed directories.
This is the face used for the collapsed part of nodes, so
if the node is 'foo/bar/baz', the face is used for 'foo/bar/'.
This is the face used for the collapsed part of nodes, so if the node is
\"foo/bar/baz\", the face is used for \"foo/bar/\".
Using this face is incompatible with `treemacs-git-mode' (exept for the simple
variant), so it will only be used if git-mode is disabled or set to simple."
@@ -152,6 +152,21 @@ Applies to buttons like
"Face used to indicate that `treemacs-peek-mode' is enabled."
:group 'treemacs-faces)
(defface treemacs-marked-file-face
'((t :foreground "#F0C674" :background "#AB3737" :bold t))
"Face for files marked by treemacs."
:group 'treemacs-faces)
(defface treemacs-git-commit-diff-face
'((t :inherit 'font-lock-comment-face))
"Face for `treemacs-git-commit-diff-mode' annotations."
:group 'treemacs-faces)
(defface treemacs-async-loading-face
'((t :inherit 'font-lock-comment-face :height 0.8))
"Face used for the \"Loading…\" string used by asynchronous extensions."
:group 'treemacs-faces)
(provide 'treemacs-faces)
;;; treemacs-faces.el ends here

423
lisp/treemacs/treemacs-file-management.el
View File

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -25,16 +25,24 @@
;;; Code:
(require 'dash)
(require 'hydra)
(require 'treemacs-core-utils)
(require 'treemacs-visuals)
(require 'treemacs-filewatch-mode)
(require 'treemacs-logging)
(require 'treemacs-rendering)
(require 'treemacs-annotations)
(eval-when-compile
(require 'inline)
(require 'treemacs-macros))
(declare-function string-join "subr-x.el")
(defconst treemacs--mark-annotation-source "treemacs-marked-paths")
(defvar-local treemacs--marked-paths nil)
(with-eval-after-load 'recentf
(declare-function recentf-remove-if-non-kept "recentf")
@@ -107,81 +115,230 @@ they will instead be wiped irreversibly."
(defalias 'treemacs-delete #'treemacs-delete-file)
(make-obsolete #'treemacs-delete #'treemacs-delete-file "v2.9.3")
;;;###autoload
(defun treemacs-delete-marked-files (&optional arg)
"Delete all marked files.
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.
For marking files see `treemacs-bulk-file-actions'."
(interactive "P")
(treemacs-block
(let ((delete-by-moving-to-trash (not arg))
(to-delete (-filter #'file-exists-p treemacs--marked-paths)))
(treemacs-error-return-if (null treemacs--marked-paths)
"There are no marked files")
(unless (yes-or-no-p (format "Really delete %s marked files?"
(length to-delete)))
(treemacs-return (treemacs-log "Cancelled.")))
(treemacs--without-filewatch
(dolist (path to-delete)
;; 2nd check in case of recursive deletes
(when (file-exists-p path)
(cond
((or (file-symlink-p path) (file-regular-p path))
(delete-file path delete-by-moving-to-trash))
((file-directory-p path)
(delete-directory path t delete-by-moving-to-trash))))
(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--evade-image)
(setf treemacs--marked-paths (-difference treemacs--marked-paths to-delete))
(treemacs-log "Deleted %s files." (length to-delete))))))
;;;###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."
If the selected target is an existing directory the source file will be directly
moved into this directory. If the given target instead does not exist then it
will be treated as the moved file's new name, meaning the original source file
will be both moved and renamed."
(interactive)
(treemacs--copy-or-move :move))
(treemacs--copy-or-move
:action 'move
:no-node-msg "There is nothing to move here."
:wrong-type-msg "Only files and directories can be moved."
:action-fn #'rename-file
:prompt "Move to: "
:flat-prompt "File to copy: "
:finish-verb "Moved"))
;;;###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)
If the selected target is an existing directory the source file will be directly
copied into this directory. If the given target instead does not exist then it
will be treated as the copied file's new name, meaning the original source file
will be both copied and renamed."
(interactive)
(treemacs--copy-or-move
:action 'copy
:no-node-msg "There is nothing to move here."
:wrong-type-msg "Only files and directories can be copied."
:action-fn (lambda (from to)
(if (file-directory-p from)
(copy-directory from to)
(copy-file from to)))
:prompt "Copy to: "
:flat-prompt "File to copy: "
:finish-verb "Copied"))
(cl-defun treemacs--copy-or-move
(&key
action
no-node-msg
wrong-type-msg
action-fn
prompt
flat-prompt
finish-verb)
"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)))))))
ACTION: either `copy' or `move'
NO-NODE-MSG: error message in case there is no node in the current line
WRONG-TYPE-MSG: error message in case current node is not a file
ACTION-FN: function to actually copy or move a file
PROMPT: prompt to read the target directory
FLAT-PROMPT: prompt to select source file when node is flattened
FINISH-VERB: finisher for the success message."
(treemacs-block
(let ((btn (treemacs-current-button)))
(treemacs-error-return-if (null btn)
no-node-msg)
(treemacs-error-return-if
(not (memq (treemacs-button-get btn :state)
'(file-node-open file-node-closed dir-node-open dir-node-closed)))
wrong-type-msg)
(let* ((source (treemacs--select-file-from-btn btn flat-prompt))
(destination (treemacs--canonical-path
(read-directory-name prompt nil default-directory)))
(destination-dir (if (file-directory-p destination)
destination
(treemacs--parent-dir destination)))
(target-name (treemacs--filename
(if (file-directory-p destination)
source
destination)))
(target (->> target-name
(treemacs-join-path destination-dir)
(treemacs--find-repeated-file-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-fn source target))
(pcase action
('move
(run-hook-with-args 'treemacs-copy-file-functions source target)
(treemacs--on-file-deletion source))
('copy
(run-hook-with-args 'treemacs-move-file-functions source target)
(treemacs-remove-annotation-face source "treemacs-marked-paths")))
(treemacs-update-node destination-dir)
(when (treemacs-is-path target :in-workspace)
(treemacs-goto-file-node target))
(treemacs-pulse-on-success "%s %s to %s"
finish-verb
(propertize (treemacs--filename target) 'face 'font-lock-string-face)
(propertize destination-dir 'face 'font-lock-string-face))))))
;;;###autoload
(defun treemacs-move-marked-files ()
"Move all marked files.
For marking files see `treemacs-bulk-file-actions'."
(interactive)
(treemacs--bulk-copy-or-move
:action 'move
:action-fn #'rename-file
:prompt "Move to: "
:finish-verb "Moved"))
;;;###autoload
(defun treemacs-copy-marked-files ()
"Copy all marked files.
For marking files see `treemacs-bulk-file-actions'."
(interactive)
(treemacs--bulk-copy-or-move
:action 'copy
:action-fn (lambda (from to)
(if (file-directory-p from)
(copy-directory from to)
(copy-file from to)))
:prompt "Copy to: "
:finish-verb "Copied"))
(cl-defun treemacs--bulk-copy-or-move
(&key
action
action-fn
prompt
finish-verb)
"Internal implementation for bulk-copying and -moving files.
ACTION: either `copy' or `move'
ACTION-FN: function to actually copy or move a file
PROMPT: prompt to read the target directory
FINISH-VERB: finisher for the success message."
(treemacs-block
(let* ((to-move (-filter #'file-exists-p treemacs--marked-paths))
(destination-dir (treemacs--canonical-path
(read-directory-name prompt nil default-directory)))
(projects (->> to-move
(-map #'treemacs--find-project-for-path)
(cl-remove-duplicates)
(-filter #'identity))))
(treemacs-save-position
(dolist (source to-move)
(let ((target (->> source
(treemacs--filename)
(treemacs-join-path destination-dir)
(treemacs--find-repeated-file-name))))
(unless (string= source target)
(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-fn source target))
(pcase action
('move
(run-hook-with-args 'treemacs-copy-file-functions source target)
(treemacs--on-file-deletion source))
('copy
(run-hook-with-args 'treemacs-move-file-functions source target)
(treemacs-remove-annotation-face source "treemacs-marked-paths"))))))
(dolist (project projects)
(treemacs-project->refresh! project)))
(when (treemacs-is-path destination-dir :in-workspace)
(treemacs-goto-file-node destination-dir))
(setf treemacs--marked-paths (-difference treemacs--marked-paths to-move))
(treemacs-pulse-on-success "%s %s files to %s"
finish-verb
(propertize (number-to-string (length to-move)) 'face 'font-lock-constant-face)
(propertize destination-dir 'face 'font-lock-string-face)))))
;;;###autoload
(cl-defun treemacs-rename-file ()
@@ -219,7 +376,10 @@ will likewise be updated."
(-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)))))
;; save-excursion does not work for whatever reason
(-let [p (point)]
(treemacs-do-update-node (treemacs-button-get parent :path))
(goto-char p)))))
(treemacs--reload-buffers-after-rename old-path new-path)
(run-hook-with-args
'treemacs-rename-file-functions
@@ -231,6 +391,103 @@ will likewise be updated."
(defalias 'treemacs-rename #'treemacs-rename-file)
(make-obsolete #'treemacs-rename #'treemacs-rename-file "v2.9.3")
;;; Bulk Actions
;;;###autoload
(defun treemacs-show-marked-files ()
"Print a list of all files marked by treemacs."
(interactive)
(let* ((len (length treemacs--marked-paths))
(message
(pcase len
(0 "There are currently no marked files.")
(1 (format "There is currently 1 marked file:\n%s"
(car treemacs--marked-paths)))
(_ (format "There are currently %s marked files:\n%s"
len
(string-join treemacs--marked-paths "\n"))))))
(treemacs-log message)))
;;;###autoload
(defun treemacs-mark-or-unmark-path-at-point ()
"Mark or unmark the absolute path of the node at point."
(interactive)
(treemacs-block
(-let [path (treemacs--prop-at-point :path)]
(treemacs-error-return-if (null path)
"There is nothing to mark here")
(treemacs-error-return-if
(or (not (stringp path)) (not (file-exists-p path)))
"Path at point is not a file or directory.")
(if (member path treemacs--marked-paths)
(progn
(setq treemacs--marked-paths
(remove path treemacs--marked-paths))
(treemacs-log "Unmarked path: %s" (propertize path 'face 'font-lock-string-face))
(treemacs-remove-annotation-face path "treemacs-marked-paths"))
(progn
(setq treemacs--marked-paths
(append treemacs--marked-paths (list path)))
(treemacs-log "Marked path: %s" (propertize path 'face 'font-lock-string-face))
(treemacs-set-annotation-face path 'treemacs-marked-file-face "treemacs-marked-paths")))
(treemacs-apply-annotations (treemacs--parent-dir path)))))
;;;###autoload
(defun treemacs-reset-marks ()
"Unmark all previously marked files in the current buffer."
(interactive)
(let ((count (length treemacs--marked-paths))
(projects))
(dolist (path treemacs--marked-paths)
(treemacs-remove-annotation-face path treemacs--mark-annotation-source)
(push (treemacs--find-project-for-path path) projects))
(setf treemacs--marked-paths nil)
(dolist (project (-uniq projects))
(treemacs-apply-annotations (treemacs-project->path project)))
(treemacs-pulse-on-success "Unmarked %s file(s)." count)))
;;;###autoload
(defun treemacs-delete-marked-paths ()
"Delete all previously marked files."
(interactive)
(treemacs-save-position
(when (yes-or-no-p
(format "Really delete %s marked file(s)?"
(length treemacs--marked-paths)))
(-let [count (length treemacs--marked-paths)]
(dolist (path treemacs--marked-paths)
(if (file-directory-p path)
(delete-directory path t)
(delete-file path))
(treemacs-do-delete-single-node path)
(treemacs-remove-annotation-face path treemacs--mark-annotation-source))
(setf treemacs--marked-paths nil)
(hl-line-highlight)
(treemacs-log "Deleted %s files." count)))))
;; shut down docstring width warnings
(with-no-warnings
(defhydra treemacs-bulk-file-actions-hydra (:exit t :hint nil)
("m" #'treemacs-mark-or-unmark-path-at-point "(un)mark")
("u" #'treemacs-reset-marks "unmark all")
("s" #'treemacs-show-marked-files "show")
("d" #'treemacs-delete-marked-files "delete")
("c" #'treemacs-copy-marked-files "copy")
("o" #'treemacs-move-marked-files "move")
("q" nil "cancel")))
;;;###autoload
(defun treemacs-bulk-file-actions ()
"Activate the bulk file actions hydra.
This interface allows to quickly (unmark) files, so as to copy, move or delete
them in bulk.
Note that marking files is *permanent*, files will stay marked until they are
either manually unmarked or deleted. You can show a list of all currently
marked files with `treemacs-show-marked-files' or `s' in the hydra."
(interactive)
(treemacs-bulk-file-actions-hydra/body))
;;;###autoload
(defun treemacs-create-file ()
"Create a new file.
@@ -256,9 +513,9 @@ itself, using $HOME when there is no path at or near point to grab."
IS-FILE?: Bool"
(interactive)
(let* ((curr-path (--if-let (treemacs-current-button)
(treemacs--select-file-from-btn it "Create in: ")
(expand-file-name "~")))
(let* ((curr-path (treemacs--select-file-from-btn
(treemacs-current-button)
"Create in: " :dir-only))
(path-to-create (treemacs-canonical-path
(read-file-name
(if is-file? "Create File: " "Create Directory: ")
@@ -291,13 +548,27 @@ IS-FILE?: Bool"
(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."
(defun treemacs--select-file-from-btn (btn prompt &optional dir-only)
"Select the file at BTN for file management.
Offer a specifying dialogue with PROMPT when the button is flattened.
Pick only directories when DIR-ONLY is non-nil."
(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)))
(let* ((path (and btn (treemacs-button-get btn :path)))
(collapse-info (and btn (treemacs-button-get btn :collapsed)))
(is-str (and path (stringp path)))
(is-dir (and is-str (file-directory-p path)))
(is-file (and is-str (file-regular-p path))))
(cond
(collapse-info
(completing-read prompt collapse-info nil :require-match))
(is-dir
path)
((and is-file dir-only)
(treemacs--parent-dir path))
(is-file
path)
(t
(expand-file-name "~")))))
(provide 'treemacs-file-management)

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -46,8 +46,8 @@ Collapsed directories require special handling since all directories of a series
need to be put under watch so as to be notified when the collapsed structure
needs to change, but removing the file watch is not straightforward:
Assume a series of directories are collapsed into one as '/c1/c2/c3/c4' and a
new file is created in '/c1/c2'. A refresh is started and only '/c1/c2' is
Assume a series of directories are collapsed into one as \"/c1/c2/c3/c4\" and a
new file is created in \"/c1/c2\". A refresh is started and only \"/c1/c2\" is
collapsed now, c3 and c4 are no longer part of the treemacs view and must be
removed from the filewatch list. However the event that triggered the refresh
was one of a file being created, so it is not possible to know that c3 and c4
@@ -158,7 +158,7 @@ An event counts as relevant when
(let* ((file (caddr ,event))
(parent (treemacs--parent-dir file))
(cache (ht-get treemacs--git-cache parent)))
(and cache (not (string= "!" (ht-get cache file))))))
(and cache (eq 'treemacs-git-ignored-face (ht-get cache file)))))
(let* ((dir (caddr ,event))
(filename (treemacs--filename dir)))
(--any? (funcall it filename dir) treemacs-ignored-file-predicates)))))))))

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -57,13 +57,15 @@ not visible."
(treemacs-without-following
(let* ((treemacs-window (treemacs-get-local-window))
(current-buffer (current-buffer))
(buffer-name (buffer-name current-buffer))
(current-file (or (buffer-file-name current-buffer)
(when (eq major-mode 'dired-mode)
(treemacs-canonical-path (dired-current-directory))))))
(when (and treemacs-window
current-file
(not (s-starts-with? treemacs--buffer-name-prefix (buffer-name current-buffer)))
(file-exists-p current-file))
(not (s-starts-with? treemacs--buffer-name-prefix buffer-name))
(file-exists-p current-file)
(not (string= buffer-name "COMMIT_EDITMSG")))
(-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)

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -42,7 +42,7 @@
"Move the fringe indicator to the position of point."
(inline-quote
(when treemacs--fringe-indicator-overlay
(-let [pabol (point-at-bol)]
(-let [pabol (line-beginning-position)]
(move-overlay treemacs--fringe-indicator-overlay pabol (1+ pabol))))))
(defun treemacs--enable-fringe-indicator ()

118
lisp/treemacs/treemacs-git-commit-diff-mode.el Normal file
View File

@@ -0,0 +1,118 @@
;;; treemacs-git-commit-diff-mode.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2022 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 annotate project with the number of commits a repo is ahead
;; and/or behind its remote.
;; NOTE: This module is lazy-loaded.
;;; Code:
(require 'vc-git)
(require 'dash)
(require 'pfuture)
(require 'treemacs-customization)
(require 'treemacs-workspaces)
(require 'treemacs-annotations)
(eval-when-compile
(require 'treemacs-macros))
(defconst treemacs--git-commit-diff.py
(if (member "treemacs-git-commit-diff.py" (directory-files treemacs-dir))
(treemacs-join-path treemacs-dir "treemacs-git-commit-diff.py")
(treemacs-join-path treemacs-dir "src/scripts/treemacs-git-commit-diff.py")))
(defconst treemacs--commit-diff-ann-source "treemacs-commit-diff"
"Annotation source name for commit diffs.")
(defun treemacs--update-git-commit-diff (project &optional buffer)
"Update the commit diff for a single PROJECT.
Look for the PROJECT either in BUFFER or the local treemacs buffer."
(let ((path (treemacs-project->path project))
(buffer (or buffer (treemacs-get-local-buffer))))
(treemacs-with-path path
:no-match-action
(ignore)
:file-action
(pfuture-callback `(,treemacs-python-executable "-O" ,treemacs--git-commit-diff.py ,path)
:directory path
:on-success
(when (buffer-live-p buffer)
(-let [out (-> (pfuture-callback-output)
(string-trim-right)
(read))]
(with-current-buffer buffer
(if out
(treemacs-set-annotation-suffix path out treemacs--commit-diff-ann-source)
(treemacs-remove-annotation-suffix path treemacs--commit-diff-ann-source))
(treemacs-apply-single-annotation path))))))))
(defun treemacs--update-commit-diff-in-every-project ()
"Update diffs for every project in the current scope.
To be run when commt-diff-mode is activated or a treemacs buffer is created."
(dolist (project (treemacs-workspace->projects (treemacs-current-workspace)))
(when (vc-git-responsible-p (treemacs-project->path project))
(treemacs--update-git-commit-diff project))))
(defun treemacs--enable-git-commit-diff-mode ()
"Setup for `treemacs-comit-diff-mode'."
(add-hook 'treemacs-post-project-refresh-functions #'treemacs--update-git-commit-diff)
(add-hook 'treemacs-post-buffer-init-hook #'treemacs--update-commit-diff-in-every-project)
(treemacs-run-in-every-buffer
(treemacs--update-commit-diff-in-every-project)))
(defun treemacs--disable-git-commit-diff-mode ()
"Tear-down for `treemacs-comit-diff-mode'."
(remove-hook 'treemacs-post-project-refresh-functions #'treemacs--update-git-commit-diff)
(remove-hook 'treemacs-post-buffer-init-hook #'treemacs--update-commit-diff-in-every-project)
(treemacs-run-in-every-buffer
(dolist (project (treemacs-workspace->projects (treemacs-current-workspace)))
(-let [path (treemacs-project->path project)]
(treemacs-remove-annotation-suffix path treemacs--commit-diff-ann-source)
(treemacs-apply-single-annotation path)))))
;;;###autoload
(define-minor-mode treemacs-git-commit-diff-mode
"Minor mode to display commit differences for your git-tracked projects.
When enabled treemacs will add an annotation next to every git project showing
how many commits ahead or behind your current branch is compared to its remote
counterpart.
The difference will be shown using the format `↑x ↓y', where `x' and `y' are the
numbers of commits a project is ahead or behind. The numbers are determined
based on the output of `git status -sb'.
By default the annotation is only updated when manually updating a project with
`treemacs-refresh'. You can install `treemacs-magit' to enable automatic
updates whenever you commit/fetch/rebase etc. in magit.
Does not require `treemacs-git-mode' to be active."
:init-value nil
:global t
:lighter nil
:group 'treemacs
(if treemacs-git-commit-diff-mode
(treemacs--enable-git-commit-diff-mode)
(treemacs--disable-git-commit-diff-mode)))
(provide 'treemacs-git-commit-diff-mode)
;;; treemacs-git-commit-diff-mode.el ends here

47
lisp/treemacs/treemacs-git-commit-diff.py Normal file
View File

@@ -0,0 +1,47 @@
from subprocess import Popen, PIPE
import sys
STATUS_CMD = "git status -sb"
def main():
proc = Popen(STATUS_CMD, shell=True, stdout=PIPE, bufsize=100)
if (proc.wait() != 0):
sys.exit(2)
line = proc.stdout.readline()
i_open = line.find(b"[")
i_close = line.find(b"]")
if (i_open == -1):
print("nil")
sys.exit(0)
ahead = 0
ahead_len = 0
behind = 0
behind_len = 0
for inf in line[i_open+1 : i_close].split(b", "):
split = inf.split(b" ")
status = split[0]
text = split[1]
number = int(text)
if status == b"ahead":
ahead = number
ahead_len = len(text)
elif status == b"behind":
behind = number
behind_len = len(text)
if ahead == 0 and behind != 0:
face_len = 2 + behind_len
print('#(" ↓{}" 0 {} (face treemacs-git-commit-diff-face))'.format(behind, face_len))
elif ahead != 0 and behind == 0:
face_len = 2 + ahead_len
print('#(" ↑{}" 0 {} (face treemacs-git-commit-diff-face))'.format(ahead, face_len))
else:
face_len = 4 + ahead_len + behind_len
print('#(" ↑{} ↓{}" 0 {} (face treemacs-git-commit-diff-face))'.format(ahead, behind, face_len))
main()

28
lisp/treemacs/treemacs-git-status.py
View File

@@ -16,18 +16,34 @@ import sys
GIT_ROOT = str.encode(sys.argv[1])
LIMIT = int(sys.argv[2])
GIT_CMD = "git status --porcelain --ignored . " + sys.argv[3]
GIT_CMD = "git status --porcelain --ignored=matching . " + sys.argv[3]
STDOUT = sys.stdout.buffer
RECURSE_DIRS = set([str.encode(it[(len(GIT_ROOT)):]) + b"/" for it in sys.argv[4:]]) if len(sys.argv) > 4 else []
QUOTE = b'"'
output = []
ht_size = 0
def face_for_status(status):
if status == b"M":
return b"treemacs-git-modified-face"
elif status == b"U":
return b"treemacs-git-conflict-face"
elif status == b"?":
return b"treemacs-git-untracked-face"
elif status == b"!":
return b"treemacs-git-ignored-face"
elif status == b"A":
return b"treemacs-git-added-face"
elif status == b"R":
return b"treemacs-git-renamed-face"
else:
return b"font-lock-keyword-face"
def find_recursive_entries(path, state):
global output, ht_size
for item in listdir(path):
full_path = join(path, item)
output.append(full_path + QUOTE + QUOTE + state)
output.append(QUOTE + full_path + QUOTE + face_for_status(state))
ht_size += 1
if ht_size > LIMIT:
break
@@ -69,7 +85,7 @@ def main():
if abs_path.endswith(b'/'):
abs_path = abs_path[:-1]
dirs_added[abs_path] = True
output.append(abs_path + QUOTE + QUOTE + state)
output.append(QUOTE + abs_path + QUOTE + face_for_status(state))
ht_size += 1
# for files deeper down in the file hierarchy also print all their directories
@@ -83,7 +99,7 @@ def main():
# directories should not be printed more than once, which would happen if
# e.g. both /A/B/C/x and /A/B/C/y have changes
if full_dirname not in dirs_added:
output.append(full_dirname + QUOTE + QUOTE + b'M')
output.append(QUOTE + full_dirname + QUOTE + b"treemacs-git-modified-face")
ht_size += 1
dirs_added[full_dirname] = True
# for untracked and ignored directories we need to find an entry for every single file
@@ -100,8 +116,8 @@ def main():
b" test equal rehash-size 1.5 rehash-threshold 0.8125 data ("
)
if ht_size > 0:
STDOUT.write(QUOTE + (QUOTE + QUOTE).join(output) + QUOTE)
STDOUT.write( b"))")
STDOUT.write(b"".join(output))
STDOUT.write(b"))")
sys.exit(proc.poll())

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -116,6 +116,34 @@ Consists for 4 different buttons:
- `treemacs-header-workspace-button'
- `treemacs-header-toggles-button'")
(defun treemacs--header-top-scroll-indicator ()
"Determine header line for `treemacs-indicate-top-scroll-mode'."
(if (= (window-start) (point-min))
(car treemacs-header-scroll-indicators)
(cdr treemacs-header-scroll-indicators)))
;;;###autoload
(define-minor-mode treemacs-indicate-top-scroll-mode
"Minor mode which shows whether treemacs is scrolled all the way to the top.
When this mode is enabled the header line of the treemacs window will display
whether the window's first line is visible or not.
The strings used for the display are determined by
`treemacs-header-scroll-indicators'.
This mode makes use of `treemacs-user-header-line-format' - and thus
`header-line-format' - and is therefore incompatible with other modifications to
these options."
:init-value nil
:global t
:group 'treemacs
(setf treemacs-user-header-line-format
(when treemacs-indicate-top-scroll-mode
'("%e" (:eval (treemacs--header-top-scroll-indicator)))))
(treemacs-run-in-every-buffer
(setf header-line-format treemacs-user-header-line-format)))
(provide 'treemacs-header-line)
;;; treemacs-header-line.el ends here

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -42,7 +42,8 @@
treemacs-create-dir
treemacs-copy-file
treemacs-move-file
treemacs-delete-file)
treemacs-delete-file
treemacs-bulk-file-actions)
(treemacs-import-functions-from "treemacs-hydras"
treemacs--common-helpful-hydra/body
@@ -51,6 +52,12 @@
(treemacs-import-functions-from "treemacs-peek-mode"
treemacs-peek-mode)
(treemacs-import-functions-from "treemacs-header-line"
treemacs-indicate-top-scroll-mode)
(treemacs-import-functions-from "treemacs-git-commit-diff-mode"
treemacs-git-commit-diff-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
@@ -124,8 +131,10 @@ find the key a command is bound to it will show a blank instead."
(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-header-mode (treemacs--find-keybind #'treemacs-indicate-top-scroll-mode))
(key-fringe-mode (treemacs--find-keybind #'treemacs-fringe-indicator-mode))
(key-fwatch-mode (treemacs--find-keybind #'treemacs-filewatch-mode))
(key-commit-diff (treemacs--find-keybind #'treemacs-git-commit-diff-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))
@@ -142,7 +151,7 @@ find the key a command is bound to it will show a blank instead."
%s ^^^^^^^^│ %s ^^^^^^^^^^^│ %s ^^^^^^│ %s
――――――――――――――――――――――――┼――――――――――――――――――――――――――――┼――――――――――――――――――――――――――――――┼――――――――――――――――――――――――――
%s next Line ^^^^│ %s dwim TAB ^^^^│ %s follow mode ^^^^│ %s add project
%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 ^^^^│
@@ -150,8 +159,8 @@ find the key a command is bound to it will show a blank instead."
%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 root down ^^^^│ %s open mru window ^^^^│ %s top scroll indicator ^^^^│
│ %s open externally ^^^^│ %s git commit difference ^^^^│
│ %s open close treemacs ^^^^│ │
│ %s close parent ^^^^│ │
"
@@ -166,8 +175,8 @@ find the key a command is bound to it will show a blank instead."
(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-root-down) (car key-open-mru) (car key-header-mode)
(car key-open-ext) (car key-commit-diff)
(car key-open-close)
(car key-close-above))))
(eval
@@ -196,9 +205,11 @@ find the key a command is bound to it will show a blank instead."
(,(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-header-mode) #'treemacs-indicate-top-scroll-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-commit-diff) #'treemacs-git-commit-diff-mode)
(,(cdr key-fringe-mode) #'treemacs-fringe-indicator-mode)
(,(cdr key-indent-guide) #'treemacs-indent-guide-mode)
(,(cdr key-git-mode) #'treemacs-git-mode)
@@ -260,21 +271,22 @@ find the key a command is bound to it will show a blank instead."
(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))
(key-bulk-actions (treemacs--find-keybind #'treemacs-bulk-file-actions))
(hydra-str
(format
"
%s
%s (%s)
%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
%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 bulk actions ^^^^│ %s Set Fallback ^^^^^^^^│ │ %s bookmark
"
title
@@ -286,7 +298,7 @@ find the key a command is bound to it will show a blank instead."
(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))))
(car key-bulk-actions) (car key-fallback-ws) (car key-bookmark))))
(eval
`(defhydra treemacs--advanced-helpful-hydra (:exit nil :hint nil :columns 3)
,hydra-str
@@ -316,6 +328,7 @@ find the key a command is bound to it will show a blank instead."
(,(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)
(,(cdr key-bulk-actions) #'treemacs-bulk-file-actions)
("<escape>" nil "Exit"))))
(treemacs--advanced-helpful-hydra/body))
(treemacs-log-failure "The helpful hydra cannot be summoned without an existing treemacs buffer.")))

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -239,33 +239,38 @@ Necessary since root icons are not rectangular."
accessible."
(treemacs-static-assert (or (null icon) (null file))
"FILE and ICON arguments are mutually exclusive")
(-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)))))
(when (and (consp extensions) (or (symbolp (car extensions))
(stringp (car extensions))))
(setf extensions `(quote (,@extensions))))
;; (setf extensions (--map (if (stringp it) (downcase it) it) extensions))
`(let* ((xs (--map (if (stringp it) (downcase it) it) ,extensions))
(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)))
(dolist (ext xs)
(when (symbolp ext)
(-let [symbol (intern (format "treemacs-icon-%s" ext))]
(add-to-list 'treemacs--icon-symbols ext)
(set symbol nil))))
(--each xs
(ht-set! gui-icons it gui-icon)
(ht-set! tui-icons it tui-icon))))
(treemacs-create-theme "Default"
:icon-directory (treemacs-join-path treemacs-dir "icons/default")
@@ -282,7 +287,6 @@ Necessary since root icons are not rectangular."
(treemacs-create-icon :file "error.png" :extensions (error) :fallback (propertize "• " 'face 'font-lock-string-face))
(treemacs-create-icon :file "warning.png" :extensions (warning) :fallback (propertize "• " 'face 'font-lock-string-face))
(treemacs-create-icon :file "info.png" :extensions (info) :fallback (propertize "• " 'face 'font-lock-string-face))
(treemacs-create-icon :file "mail.png" :extensions (mail) :fallback " ")
(treemacs-create-icon :file "bookmark.png" :extensions (bookmark) :fallback " ")
(treemacs-create-icon :file "svgrepo/screen.png" :extensions (screen) :fallback " ")
(treemacs-create-icon :file "svgrepo/house.png" :extensions (house) :fallback " ")
@@ -292,10 +296,12 @@ Necessary since root icons are not rectangular."
(treemacs-create-icon :file "svgrepo/close.png" :extensions (close) :fallback " ")
(treemacs-create-icon :file "svgrepo/cal.png" :extensions (calendar) :fallback " ")
(treemacs-create-icon :file "svgrepo/briefcase.png" :extensions (briefcase) :fallback " ")
(treemacs-create-icon :file "svgrepo/mail.png" :extensions (mail) :fallback " ")
(treemacs-create-icon :file "svgrepo/mail-plus.png" :extensions (mail-plus) :fallback " ")
;; file icons
(treemacs-create-icon :file "txt.png" :extensions (fallback))
(treemacs-create-icon :file "emacs.png" :extensions ("el" "elc"))
(treemacs-create-icon :file "emacs.png" :extensions ("el" "elc" "eln"))
(treemacs-create-icon :file "ledger.png" :extensions ("ledger"))
(treemacs-create-icon :file "yaml.png" :extensions ("yml" "yaml" "travis.yml"))
(treemacs-create-icon
@@ -312,7 +318,7 @@ 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 "clojure.png" :extensions ("clj" "cljs" "cljc"))
(treemacs-create-icon :file "clojure.png" :extensions ("clj" "cljs" "cljc" "edn"))
(treemacs-create-icon :file "ts.png" :extensions ("ts" "tsx"))
(treemacs-create-icon :file "vue.png" :extensions ("vue"))
(treemacs-create-icon :file "css.png" :extensions ("css"))
@@ -334,7 +340,7 @@ Necessary since root icons are not rectangular."
(treemacs-create-icon :file "json.png" :extensions ("json"))
(treemacs-create-icon :file "julia.png" :extensions ("jl"))
(treemacs-create-icon :file "elx.png" :extensions ("ex"))
(treemacs-create-icon :file "elx-light.png" :extensions ("exs" "eex" "leex"))
(treemacs-create-icon :file "elx-light.png" :extensions ("exs" "eex" "leex" "heex"))
(treemacs-create-icon :file "ocaml.png" :extensions ("ml" "mli" "merlin" "ocaml"))
(treemacs-create-icon :file "direnv.png" :extensions ("envrc"))
(treemacs-create-icon :file "puppet.png" :extensions ("pp"))
@@ -383,7 +389,7 @@ Necessary since root icons are not rectangular."
(treemacs-create-icon :file "vsc/cobol.png" :extensions ("cobol"))
(treemacs-create-icon :file "vsc/cfscript.png" :extensions ("coffeescript"))
(treemacs-create-icon :file "vsc/cpp.png" :extensions ("cpp" "cxx" "tpp" "cc"))
(treemacs-create-icon :file "vsc/cpph.png" :extensions ("hpp" "hh"))
(treemacs-create-icon :file "vsc/cpph.png" :extensions ("hpp" "hxx" "hh"))
(treemacs-create-icon :file "vsc/cucumber.png" :extensions ("feature"))
(treemacs-create-icon :file "vsc/cython.png" :extensions ("cython"))
(treemacs-create-icon :file "vsc/delphi.png" :extensions ("pascal" "objectpascal"))
@@ -460,8 +466,8 @@ Uses `treemacs-icon-fallback' as fallback."
(defun treemacs-resize-icons (size)
"Resize the current theme's icons to the given SIZE.
If SIZE is 'nil' the icons are not resized and will retain their default size of
22 pixels.
If SIZE is \\='nil' the icons are not resized and will retain their default size
of 22 pixels.
There is only one size, the icons are square and the aspect ratio will be
preserved when resizing them therefore width and height are the same.
@@ -552,18 +558,17 @@ should be used for."
(defun treemacs-map-icons-with-auto-mode-alist (extensions mode-icon-alist)
"Remaps icons for EXTENSIONS according to `auto-mode-alist'.
EXTENSIONS should be a list of file extensions such that they match the regex
stored in `auto-mode-alist', for example '\(\".cc\"\).
stored in `auto-mode-alist', for example \\='(\".cc\").
MODE-ICON-ALIST is an alist that maps which mode from `auto-mode-alist' should
be assigned which treemacs icon, for example
'\(\(c-mode . treemacs-icon-c\)
\(c++-mode . treemacs-icon-cpp\)\)"
`((c-mode . ,(treemacs-get-icon-value \"c\"))
(c++-mode . ,(treemacs-get-icon-value \"cpp\")))"
(dolist (extension extensions)
(-when-let* ((mode (cdr (--first (s-matches? (car it) extension) auto-mode-alist)))
(icon (cdr (assq mode mode-icon-alist))))
(treemacs-log "Map %s to %s" extension (symbol-name icon))
(ht-set! (treemacs-theme->gui-icons treemacs--current-theme)
(substring extension 1)
(symbol-value icon)))))
icon))))
(treemacs-only-during-init
(treemacs-load-theme "Default"))

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -33,7 +33,6 @@
(require 'treemacs-customization)
(require 'treemacs-workspaces)
(require 'treemacs-persistence)
(require 'treemacs-extensions)
(require 'treemacs-logging)
(eval-when-compile
@@ -122,7 +121,8 @@ them instead."
:on-tag-node-open (treemacs--collapse-tag-node btn arg)
:on-tag-node-closed (treemacs--expand-tag-node btn arg)
:on-tag-node-leaf (progn (other-window 1) (treemacs--goto-tag btn))
:on-nil (treemacs-pulse-on-failure "There is nothing to do here.")))
:on-nil (treemacs-pulse-on-failure "There is nothing to do here.")
:fallback (treemacs-TAB-action)))
(defun treemacs-toggle-node-prefer-tag-visit (&optional arg)
"Same as `treemacs-toggle-node' but will visit a tag node in some conditions.
@@ -133,7 +133,7 @@ conditions:
ends in \" definition*\". This indicates the section is the parent element in
a nested class/function definition and can be moved to.
* Tags belong to a .org file and the tag section element possesses a
'org-imenu-marker text property. This indicates that the section is a
\\='org-imenu-marker text property. This indicates that the section is a
headline with further org elements below it.
The prefix argument ARG is treated the same way as with `treemacs-toggle-node'."
@@ -509,7 +509,8 @@ With a prefix ARG substract the increment value multiple times."
"Path at point is not a file.")
(when (file-directory-p path)
(setf path (treemacs--add-trailing-slash path)))
(-let [copied (-> path (file-relative-name (treemacs-project->path project)) (kill-new))]
(-let [copied (-> path (file-relative-name (treemacs-project->path project)))]
(kill-new copied)
(treemacs-pulse-on-success "Copied relative path: %s" (propertize copied 'face 'font-lock-string-face))))))
(defun treemacs-copy-project-path-at-point ()
@@ -521,7 +522,8 @@ With a prefix ARG substract the increment value multiple times."
"There is nothing to copy here")
(treemacs-error-return-if (not (stringp (treemacs-project->path project)))
"Project at point is not a file.")
(-let [copied (-> project (treemacs-project->path) (kill-new))]
(-let [copied (-> project (treemacs-project->path))]
(kill-new copied)
(treemacs-pulse-on-success "Copied project path: %s" (propertize copied 'face 'font-lock-string-face))))))
(defun treemacs-delete-other-windows ()
@@ -708,7 +710,7 @@ For slower scrolling see `treemacs-previous-line-other-window'"
(treemacs--forget-last-highlight)
;; after renaming, delete and redisplay the project
(goto-char (treemacs-button-end project-btn))
(delete-region (point-at-bol) (point-at-eol))
(delete-region (line-beginning-position) (line-end-position))
(treemacs--add-root-element project)
(when (eq state 'root-node-open)
(treemacs--collapse-root-node (treemacs-project->position project))
@@ -748,7 +750,7 @@ auto-selected name already exists."
(propertize (treemacs-project->path duplicate) 'face 'font-lock-string-face)))
(`(includes-project ,project)
(goto-char (treemacs-project->position project))
(treemacs-pulse-on-failure "Project '%s' is included in '%s'. Projects May not overlap."
(treemacs-pulse-on-failure "Project '%s' is included in '%s'. Projects may not overlap."
(propertize (treemacs-project->name project) 'face 'font-lock-type-face)
(propertize path 'face 'font-lock-string-face)))
(`(duplicate-name ,duplicate)
@@ -872,8 +874,10 @@ workspaces."
(interactive)
(treemacs-unless-let (btn (treemacs-current-button))
(treemacs-log-failure "There is nothing to refresh.")
(treemacs-without-recenter
(treemacs--do-refresh (current-buffer) (treemacs-project-of-node btn)))))
(-let [project (treemacs-project-of-node btn)]
(treemacs-without-recenter
(treemacs--do-refresh (current-buffer) project))
(run-hook-with-args 'treemacs-post-project-refresh-functions project))))
(defun treemacs-collapse-project (&optional arg)
"Close the project at point.
@@ -891,17 +895,19 @@ With a prefix ARG also forget about all the nodes opened in the project."
(defun treemacs-collapse-all-projects (&optional arg)
"Collapses all projects.
With a prefix ARG also forget about all the nodes opened in the projects."
With a prefix ARG remember which nodes were expanded."
(interactive "P")
(save-excursion
(treemacs--forget-last-highlight)
(dolist (project (treemacs-workspace->projects (treemacs-current-workspace)))
(-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-pulse-on-success "Collapsed all projects"))
(-when-let (buffer (treemacs-get-local-buffer))
(with-current-buffer buffer
(save-excursion
(treemacs--forget-last-highlight)
(dolist (project (treemacs-workspace->projects (treemacs-current-workspace)))
(-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 (not arg))))))
(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.
@@ -1074,7 +1080,7 @@ Only works with a single project in the workspace."
treemacs-persist-file
nil :silent)
(treemacs--restore)
(-if-let (ws (treemacs--select-workspace-by-name
(-if-let (ws (treemacs--find-workspace-by-name
(treemacs-workspace->name (treemacs-current-workspace))))
(setf (treemacs-current-workspace) ws)
(treemacs--find-workspace))
@@ -1262,7 +1268,7 @@ visible."
(save-excursion
(goto-char (point-min))
(while (= 0 (forward-line 1))
(-let [new-len (- (point-at-eol) (point-at-bol))]
(-let [new-len (- (line-end-position) (line-beginning-position))]
(when (> new-len longest)
(setf longest new-len
depth (treemacs--prop-at-point :depth))))))

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -88,7 +88,7 @@ Delegates VAR-VAL and the given FORMS to `-if-let-'."
`(-if-let ,var-val (progn ,@then) ,else)))
(defmacro treemacs-with-current-button (error-msg &rest body)
"Execute an action with the current button bound to 'current-btn'.
"Execute an action with the current button bound to \\='current-btn'.
Log ERROR-MSG if no button is selected, otherwise run BODY."
(declare (debug (form body)))
`(-if-let (current-btn (treemacs-current-button))
@@ -105,6 +105,7 @@ Log ERROR-MSG if no button is selected, otherwise run BODY."
(cl-defmacro treemacs-do-for-button-state
(&key no-error
fallback
on-root-node-open
on-root-node-closed
on-file-node-open
@@ -115,15 +116,21 @@ Log ERROR-MSG if no button is selected, otherwise run BODY."
on-tag-node-closed
on-tag-node-leaf
on-nil)
"Building block macro to execute a form based on the current node state.
Will bind to current button to 'btn' for the execution of the action forms.
"Building block macro to execute a form based on the current node state.
Will bind to current button to \\='btn' for the execution of the action forms.
When NO-ERROR is non-nil no error will be thrown if no match for the button
state is achieved.
state is achieved. A general FALLBACK can also be used instead of NO-ERROR. In
that case the unknown state will be bound as `state' in the FALLBACK form.
Otherwise either one of ON-ROOT-NODE-OPEN, ON-ROOT-NODE-CLOSED,
ON-FILE-NODE-OPEN, ON-FILE-NODE-CLOSED, ON-DIR-NODE-OPEN, ON-DIR-NODE-CLOSED,
ON-TAG-NODE-OPEN, ON-TAG-NODE-CLOSED, ON-TAG-NODE-LEAF or ON-NIL will be
executed."
(declare (debug (&rest [sexp form])))
(treemacs-static-assert (or (null no-error) (null fallback))
"no-error and fallback arguments are mutually exclusive.")
`(-if-let (btn (treemacs-current-button))
(pcase (treemacs-button-get btn :state)
,@(when on-root-node-open
@@ -153,7 +160,11 @@ executed."
,@(when on-tag-node-leaf
`((`tag-node
,on-tag-node-leaf)))
,@(unless no-error
,@(when fallback
`((state
(ignore state)
,fallback)))
,@(unless (or fallback no-error)
`((state (error "[Treemacs] Unexpected button state %s" state)))))
,on-nil))
@@ -267,7 +278,7 @@ not work keep it on the same line."
(curr-state (-some-> curr-btn (treemacs-button-get :state)))
(collapse (-some-> curr-btn (treemacs-button-get :collapsed)))
(curr-file (if collapse (treemacs-button-get curr-btn :key) (-some-> curr-btn (treemacs--nearest-path))))
(curr-window (treemacs-get-local-window))
(curr-window (get-buffer-window (current-buffer)))
(curr-win-line (when curr-window
(with-selected-window curr-window
(treemacs--current-screen-line)))))
@@ -358,7 +369,7 @@ Includes *all* treemacs-mode-derived buffers, including extensions."
(defmacro treemacs-only-during-init (&rest body)
"Run BODY only when treemacs has not yet been loaded.
Specifically only run it when (featurep 'treemacs) returns nil."
Specifically only run it when (featurep \\='treemacs) returns nil."
(declare (debug t))
`(unless (featurep 'treemacs)
,@body))
@@ -404,7 +415,7 @@ When PREDICATE returns non-nil RET will be returned."
(cl-defmacro treemacs-first-child-node-where (btn &rest predicate)
"Among the *direct* children of BTN find the first child matching PREDICATE.
For the PREDICATE call the button being checked is bound as 'child-btn'."
For the PREDICATE call the button being checked is bound as \\='child-btn'."
(declare (indent 1) (debug (sexp body)))
`(cl-block __search__
(let* ((child-btn (next-button (treemacs-button-end ,btn) t))
@@ -435,10 +446,11 @@ This pattern is oftentimes used in treemacs, see also `treemacs-return-if',
LEFT is a file path, OP is the operator and RIGHT is either a path, project, or
workspace. OP can be one of the following:
* `:same-as' will check for string equality
* `:same-as' will check for string equality.
* `:in' will check will check whether LEFT is a child or the same as RIGHT.
* `:parent-of' will check whether LEFT is a parent of, and not equal to, RIGHT
* `:in-project' will check whether LEFT is part of the project RIGHT
* `:directly-in' will check will check whether LEFT is *direct* child of RIGHT.
* `:parent-of' will check whether LEFT is a parent of, and not equal to, RIGHT.
* `:in-project' will check whether LEFT is part of the project RIGHT.
* `:in-workspace' will check whether LEFT is part of the workspace RIGHT and
return the appropriate project when it is. If RIGHT is not given it will
default to calling `treemacs-current-workspace'.
@@ -449,10 +461,10 @@ also `treemacs-canonical-path').
Even if LEFT or RIGHT should be a form and not a variable it is guaranteed that
they will be evaluated only once."
(declare (debug (&rest form)))
(treemacs-static-assert (memq op '(:same-as :in :parent-of :in-project :in-workspace))
(treemacs-static-assert (memq op '(:same-as :in :directly-in :parent-of :in-project :in-workspace))
"Invalid treemacs-is-path operator: `%s'" op)
(treemacs-static-assert (or (eq op :in-workspace) right)
":in-workspace operator requires right-side argument.")
"Right-side argument is required")
(macroexp-let2* nil
((left left)
(right right))
@@ -462,6 +474,11 @@ they will be evaluated only once."
(:in
`(or (string= ,left ,right)
(s-starts-with? (treemacs--add-trailing-slash ,right) ,left)))
(:directly-in
`(let ((l (length ,right)))
(and (> (length ,left) l)
(string= (treemacs--filename ,left) (substring ,left (1+ l)))
(string-prefix-p ,right ,left))))
(:parent-of
`(and (s-starts-with? (treemacs--add-trailing-slash ,left) ,right)
(not (string= ,left ,right))))
@@ -472,12 +489,11 @@ they will be evaluated only once."
`(--first (treemacs-is-path ,left :in-project it)
(treemacs-workspace->projects ,ws)))))))
(cl-defmacro treemacs-with-path (path &key file-action top-level-extension-action directory-extension-action project-extension-action no-match-action)
(cl-defmacro treemacs-with-path (path &key file-action extension-action no-match-action)
"Execute an action depending on the type of PATH.
FILE-ACTION is the action to perform when PATH is a regular file node.
TOP-LEVEL-EXTENSION-ACTION, DIRECTORY-EXTENSION-ACTION, and
PROJECT-EXTENSION-ACTION operate on paths for the different extension types.
EXTENSION-ACTION is performed on extension-created nodes.
If none of the path types matches, NO-MATCH-ACTION is executed."
(declare (indent 1))
@@ -486,12 +502,11 @@ If none of the path types matches, NO-MATCH-ACTION is executed."
(cond
,@(when file-action
`(((stringp ,path-symbol) ,file-action)))
,@(when top-level-extension-action
`(((eq :custom (car ,path-symbol)) ,top-level-extension-action)))
,@(when directory-extension-action
`(((stringp (car ,path-symbol)) ,directory-extension-action)))
,@(when project-extension-action
`(((treemacs-project-p (car ,path-symbol)) ,project-extension-action)))
,@(when extension-action
`(((or (symbolp ,path)
(symbolp (car ,path))
(stringp (car ,path)))
,extension-action)))
(t
,(if no-match-action
no-match-action
@@ -537,7 +552,7 @@ Based on a timer GUARD variable run function with the given DELAY and BODY."
(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
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))

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

@@ -1,6 +1,6 @@
;;; treemacs-mode.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -56,7 +56,7 @@
treemacs-advanced-helpful-hydra)
(treemacs-import-functions-from "treemacs-tags"
treemacs--create-imenu-index-functione)
treemacs--create-imenu-index-function)
(defvar bookmark-make-record-function)
@@ -130,6 +130,8 @@ Will be set by `treemacs--post-command'.")
(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)
(define-key map (kbd "c") 'treemacs-indicate-top-scroll-mode)
(define-key map (kbd "d") 'treemacs-git-commit-diff-mode)
map)
"Keymap for commands that toggle state in `treemacs-mode'.")
@@ -200,6 +202,9 @@ Will be set by `treemacs--post-command'.")
(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)
(define-key map (kbd "M-m") 'treemacs-bulk-file-actions)
(unless (window-system)
(define-key map [C-i] 'treemacs-TAB-action))
map)
"Keymap for `treemacs-mode'.")
@@ -225,7 +230,8 @@ Will be set by `treemacs--post-command'.")
(doom-modeline-def-modeline 'treemacs '(bar " " major-mode))
(doom-modeline 'treemacs))
(t
'(" Treemacs ")))))
'(:eval (format " Treemacs: %s"
(treemacs-workspace->name (treemacs-current-workspace))))))))
(defun treemacs--post-command ()
"Set the default directory to the nearest directory of the current node.
@@ -239,7 +245,12 @@ Used as a post command hook."
(treemacs-with-writable-buffer
(save-excursion
(goto-char point-max)
(insert newline-char)))))
(insert newline-char)
;; make sure that the projects-end marker keeps pointing at
;; the end of the last project button
(when (and (eq t treemacs--in-this-buffer)
(equal (point) (marker-position (treemacs--projects-end))))
(move-marker (treemacs--projects-end) (1- (point))))))))
(-when-let (btn (treemacs-current-button))
(when (treemacs-button-get btn 'invisible)
(treemacs-next-line 1))
@@ -251,8 +262,9 @@ Used as a post command hook."
(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 "~/"))))
(setf treemacs--eldoc-msg nil)
(when (eq t treemacs--in-this-buffer)
(setf default-directory "~/")))))
(defun treemacs--get-eldoc-message (path)
"Set the eldoc message for given PATH.
@@ -368,8 +380,7 @@ Will simply return `treemacs--eldoc-msg'."
(treemacs--setup-icon-highlight)
(treemacs--setup-icon-background-colors)
(treemacs--setup-mode-line)
(treemacs--reset-dom)
(treemacs--reset-project-positions))
(treemacs--reset-dom))
(defun treemacs--mode-check-advice (mode-activation &rest args)
"Verify that `treemacs-mode' is called in the right place.

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -43,6 +43,17 @@
(defvar treemacs--mouse-project-list-functions
'(("Add Project.el project" . treemacs--builtin-project-mouse-selection-menu)))
(defun treemacs--mouse-drag-advice (fn &rest args)
"Advice to wrap `adjust-window-trailing-edge' as FN and its ARGS.
Ensure that treemacs' window width can be changed with the mouse, even if it is
locked."
(with-selected-window (or (treemacs-get-local-window) (selected-window))
(let ((treemacs--width-is-locked)
(window-size-fixed))
(apply fn args))))
(advice-add #'adjust-window-trailing-edge :around #'treemacs--mouse-drag-advice)
(defun treemacs--builtin-project-mouse-selection-menu ()
"Build a mouse selection menu for project.el projects."
(pcase (if (fboundp 'project-known-project-roots)
@@ -137,13 +148,51 @@ Clicking on icons will expand a file's tags, just like
Must be bound to a mouse click, or EVENT will not be supplied."
(interactive "e")
(when (eq 'drag-mouse-1 (elt event 0))
(-when-let (treemacs-buffer (treemacs-get-local-buffer))
(let* ((node (with-current-buffer treemacs-buffer (treemacs-node-at-point)))
(path (-some-> node (treemacs-button-get :path))))
(treemacs-with-path path
:file-action (progn (select-window (elt (elt event 2) 0))
(find-file path))
:no-match-action (ignore))))))
(let* ((info1 (elt (cdr event) 0))
(info2 (elt (cdr event) 1))
(source-window (elt info1 0))
(target-window (elt info2 0))
(source-pos (elt info1 1))
(target-pos (elt info2 1))
(treemacs-buffer (treemacs-get-local-buffer)))
(if (eq source-window target-window)
(treemacs--drag-move-files source-pos target-pos)
(let* ((node (with-current-buffer treemacs-buffer (treemacs-node-at-point)))
(path (-some-> node (treemacs-button-get :path))))
(treemacs-with-path path
:file-action (progn (select-window target-window)
(find-file path))
:no-match-action (ignore)))))))
(defun treemacs--drag-move-files (source-pos target-pos)
"Move files with a mouse-drag action.
SOURCE-POS: Start position of the mouse drag.
TARGET-POS: End position of the mouse drag."
(let* ((source-btn (treemacs--button-in-line source-pos))
(target-btn (treemacs--button-in-line target-pos))
(source-key (-some-> source-btn (treemacs-button-get :key)))
(target-key (-some-> target-btn (treemacs-button-get :key)))
(target-dir (and target-key
(if (file-directory-p target-key)
target-key
(treemacs--parent-dir target-key))))
(target-file (and source-key target-key
(treemacs-join-path target-dir (treemacs--filename source-key)))))
(when (and source-key target-key
(not (string= source-key target-key))
(not (treemacs-is-path source-key :directly-in target-dir)))
(treemacs-do-delete-single-node source-key)
(treemacs--without-filewatch
(rename-file source-key target-file))
(run-hook-with-args 'treemacs-copy-file-functions source-key target-dir)
(treemacs-do-insert-single-node target-file target-dir)
(treemacs-update-single-file-git-state source-key)
(treemacs-update-single-file-git-state target-file)
(treemacs--on-file-deletion source-key)
(treemacs-goto-file-node target-file)
(treemacs-pulse-on-success "Moved %s to %s"
(propertize (treemacs--filename target-file) 'face 'font-lock-string-face)
(propertize target-dir 'face 'font-lock-string-face)))))
;;;###autoload
(defun treemacs-define-doubleclick-action (state action)

5
lisp/treemacs/treemacs-peek-mode.el
View File

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -44,7 +44,8 @@
(defun treemacs--setup-peek-buffer (path)
"Setup the peek buffer and window for PATH."
(let* ((file-buffer (get-file-buffer path))
(let* ((inhibit-message t)
(file-buffer (get-file-buffer path))
(next-window (next-window (selected-window)))
(window (if file-buffer
(or (get-buffer-window file-buffer)

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -86,7 +86,7 @@ SELF: Treemacs-Iter struct."
(define-inline treemacs--should-not-run-persistence? ()
"No saving and loading in noninteractive and CI environments."
(inline-quote (or noninteractive (getenv "CI"))))
(inline-quote (or noninteractive (getenv "CI") (null treemacs-persist-file))))
(defun treemacs--read-workspaces (iter)
"Read a list of workspaces from the lines in ITER.
@@ -169,7 +169,8 @@ ITER: Treemacs-Iter Struct"
(no-kill nil)
;; no surprisese when using `abbreviate-file-name'
(directory-abbrev-alist nil)
(abbreviated-home-dir nil))
(abbreviated-home-dir nil)
(file-precious-flag t))
(--if-let (get-file-buffer treemacs-persist-file)
(setq buffer it
no-kill t)
@@ -221,10 +222,10 @@ than once.
PROJ-COUNT counts the number of non-disabled projects in a workspace to make
sure that there is at least of project that will be displayed.
A successful validation returns just the symbol 'success, in case of an error a
list of 3 items is returned: the symbol 'error, the exact line where the error
happened, and the error message. In some circumstances (for example when a
project is missing a path property) it makes sense to display the error not in
A successful validation returns just the symbol \\='success, in case of an error
a list of 3 items is returned: the symbol \\='error, the exact line where the
error happened, and the error message. In some circumstances (for example when
a project is missing a path property) it makes sense to display the error not in
the currently looked at line, but the one above, which is why the previously
looked at line PREV is given as well.

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

@@ -1,4 +1,4 @@
(define-package "treemacs" "20220104.1302" "A tree style file explorer package"
(define-package "treemacs" "20221107.2105" "A tree style file explorer package"
'((emacs "26.1")
(cl-lib "0.5")
(dash "2.11.0")
@@ -8,7 +8,7 @@
(hydra "0.13.2")
(ht "2.2")
(cfrs "1.3.2"))
:commit "deb7f2cd9eb06960798edd7393df2602902ed071" :authors
:commit "b19060f25e55514f3d798d9f5af2dcd5b94a6026" :authors
'(("Alexander Miller" . "alexanderm@web.de"))
:maintainer
'("Alexander Miller" . "alexanderm@web.de")

73
lisp/treemacs/treemacs-project-follow-mode.el
View File

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -26,9 +26,8 @@
(require 'treemacs-scope)
(require 'treemacs-follow-mode)
(require 'treemacs-core-utils)
(treemacs-import-functions-from "treemacs"
treemacs-display-current-project-exclusively)
(eval-when-compile
(require 'treemacs-macros))
(defvar treemacs--project-follow-timer nil
"Idle timer for `treemacs-project-follow-mode'.")
@@ -40,44 +39,54 @@
"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)))))))
(treemacs--do-follow-project)))
(defun treemacs--do-follow-project()
"Actual, un-debounced, implementation of project following."
(-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)
(string= (expand-file-name "~")
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))))
(save-selected-window
(treemacs--show-single-project
new-project-path (treemacs--filename new-project-path))
(treemacs--follow)
(hl-line-highlight))))))
(defun treemacs--follow-project-after-buffer-init ()
"Hook to follow the current project when a treemacs buffer is created.
Used for `treemacs-post-buffer-init-hook', so it will run inside the treemacs
window."
(with-selected-window (next-window (selected-window))
(treemacs--do-follow-project)))
(defun treemacs--setup-project-follow-mode ()
"Setup all the hooks needed for `treemacs-project-follow-mode'."
(when treemacs--project-follow-timer (cancel-timer treemacs--project-follow-timer))
(setf treemacs--project-follow-timer nil)
(add-hook 'window-buffer-change-functions #'treemacs--follow-project)
(add-hook 'window-selection-change-functions #'treemacs--follow-project)
(treemacs--follow-project nil))
(add-hook 'treemacs-post-buffer-init-hook #'treemacs--follow-project-after-buffer-init))
(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))
(remove-hook 'window-selection-change-functions #'treemacs--follow-project)
(remove-hook 'treemacs-post-buffer-init-hook #'treemacs--follow-project-after-buffer-init))
;;;###autoload
(define-minor-mode treemacs-project-follow-mode

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -33,6 +33,7 @@
(require 'treemacs-workspaces)
(require 'treemacs-visuals)
(require 'treemacs-logging)
(require 'treemacs-annotations)
(eval-when-compile
(require 'cl-lib)
@@ -53,14 +54,6 @@
treemacs-add-project-to-workspace
treemacs-TAB-action)
(treemacs-import-functions-from "treemacs-extensions"
treemacs--apply-root-top-extensions
treemacs--apply-root-bottom-extensions
treemacs--apply-project-top-extensions
treemacs--apply-project-bottom-extensions
treemacs--apply-directory-top-extensions
treemacs--apply-directory-bottom-extensions)
(treemacs-import-functions-from "treemacs-tags"
treemacs--expand-file-node
treemacs--expand-tag-node)
@@ -92,11 +85,24 @@ is a marker pointing to POS."
(inline-letevals (pos)
(inline-quote (copy-marker ,pos t))))
(define-inline treemacs--button-in-line (pos)
"Return the button in the line at POS in the current buffer, or nil.
If the button at POS is a text property button, the return value
is a marker pointing to POS."
(inline-letevals (pos)
(inline-quote
(save-excursion
(goto-char ,pos)
(copy-marker
(next-single-property-change
(line-beginning-position) 'button nil (line-end-position))
t)))))
(define-inline treemacs--current-screen-line ()
"Get the current screen line in the selected window."
(declare (side-effect-free t))
(inline-quote
(max 1 (count-screen-lines (window-start) (point-at-eol)))))
(max 1 (count-screen-lines (window-start) (line-end-position)))))
(define-inline treemacs--lines-in-window ()
"Determine the number of lines visible in the current (treemacs) window.
@@ -252,7 +258,7 @@ either OPEN-ACTION or POST-OPEN-ACTION are expected to take over insertion."
,@(when new-icon
`((beginning-of-line)
(treemacs--button-symbol-switch ,new-icon)))
(goto-char (treemacs-button-end ,button))
(goto-char (line-end-position))
,@(if immediate-insert
`((progn
(insert (apply #'concat ,open-action))))
@@ -357,9 +363,11 @@ Maps ITEMS at given index INTERVAL using MAPPER function."
(_ (error "Interval %s is not handled yet" interval)))))
`(let ((,l ,items))
(while ,l
(setq ,l (,tail-op ,l))
(let ((it (pop ,l)))
,@mapper)))))
(setq ,l (,tail-op ,l))
(let ((it (car ,l)))
(setf (car ,l) ,@mapper)
(pop ,l)))
,items)))
(define-inline treemacs--create-branch (root depth git-future collapse-process &optional parent)
"Create a new treemacs branch under ROOT.
@@ -412,10 +420,14 @@ set to PARENT."
(setf git-info (treemacs--get-or-parse-git-result ,git-future))
(ht-set! treemacs--git-cache ,root git-info))
('deferred
(setq git-info (or (ht-get treemacs--git-cache ,root) (ht)))
(run-with-timer 0.5 nil #'treemacs--apply-deferred-git-state ,parent ,git-future (current-buffer)))
(setf git-info (or (ht-get treemacs--git-cache ,root) treemacs--empty-table)))
(_
(setq git-info (ht))))
(setf git-info treemacs--empty-table)))
(run-with-timer
0.5 nil
#'treemacs--apply-annotations-deferred
,parent ,root (current-buffer) ,git-future)
(if treemacs-pre-file-insert-predicates
(progn
@@ -456,28 +468,49 @@ set to PARENT."
(treemacs-dom-node->insert-into-dom! it))
(treemacs--inplace-map-when-unrolled dir-strings 2
(put-text-property
0
(length it)
'face
(treemacs--get-node-face (concat ,root "/" it) git-info 'treemacs-directory-face)
it))
(-if-let (ann (treemacs-get-annotation (concat ,root "/" it)))
(progn
(put-text-property
0
(length it)
'face
(treemacs-annotation->face-value ann)
it)
(concat it (treemacs-annotation->suffix-value ann)))
(put-text-property
0
(length it)
'face
'treemacs-directory-face
it)
it))
(insert (apply #'concat dir-strings))
(end-of-line)
(treemacs--inplace-map-when-unrolled file-strings 3
(put-text-property
0
(length it)
'face
(treemacs--get-node-face (concat ,root "/" it) git-info 'treemacs-git-unmodified-face)
it))
(setf file-strings
(treemacs--inplace-map-when-unrolled file-strings 3
(-if-let (ann (treemacs-get-annotation (concat ,root "/" it)))
(progn
(put-text-property
0
(length it)
'face
(treemacs-annotation->face-value ann)
it)
(concat it (treemacs-annotation->suffix-value ann)))
(put-text-property
0
(length it)
'face
'treemacs-git-unmodified-face
it)
it)))
(insert (apply #'concat file-strings))
(save-excursion
(treemacs--flatten-dirs (treemacs--parse-collapsed-dirs ,collapse-process))
(treemacs--reentry ,root ,git-future))
(point-at-eol))))))
(line-end-position))))))
(cl-defmacro treemacs--button-close (&key button new-icon new-state post-close-action)
"Close node given by BUTTON, use NEW-ICON and BUTTON's state to NEW-STATE.
@@ -487,7 +520,7 @@ Run POST-CLOSE-ACTION after everything else is done."
,@(when new-icon
`((treemacs--button-symbol-switch ,new-icon)))
(treemacs-button-put ,button :state ,new-state)
(-let [next (next-button (point-at-eol))]
(-let [next (next-button (button-end ,button))]
(if (or (null next)
(/= (1+ (treemacs-button-get ,button :depth))
(treemacs-button-get (copy-marker next t) :depth)))
@@ -497,7 +530,7 @@ Run POST-CLOSE-ACTION after everything else is done."
;; current button, making the treemacs--projects-end marker track
;; properly when collapsing the last project or a last directory of the
;; last project.
(let* ((pos-start (treemacs-button-end ,button))
(let* ((pos-start (line-end-position))
(next (treemacs--next-non-child-button ,button))
(pos-end (if next
(-> next (treemacs-button-start) (previous-button) (treemacs-button-end))
@@ -521,7 +554,8 @@ RECURSIVE: Bool"
(let* ((path (treemacs-button-get btn :path))
(git-path (if (treemacs-button-get btn :symlink) (file-truename path) path))
(git-future (treemacs--git-status-process git-path project))
(collapse-future (treemacs--collapsed-dirs-process path project)))
(collapse-future (treemacs--collapsed-dirs-process path project))
(recursive (treemacs--prefix-arg-to-recurse-depth recursive)) )
(treemacs--maybe-recenter treemacs-recenter-after-project-expand
(treemacs--button-open
:immediate-insert nil
@@ -533,19 +567,23 @@ RECURSIVE: Bool"
;; TODO(2019/10/14): go back to post open
;; expand first because it creates a dom node entry
(treemacs-on-expand path btn)
(treemacs--apply-project-top-extensions btn project)
(goto-char (treemacs--create-branch path (1+ (treemacs-button-get btn :depth)) git-future collapse-future btn))
(treemacs--apply-project-bottom-extensions btn project)
(when (fboundp 'treemacs--apply-project-top-extensions)
(treemacs--apply-project-top-extensions btn project))
(when (fboundp 'treemacs--apply-project-bottom-extensions)
(save-excursion
(treemacs--apply-project-bottom-extensions btn project)))
(treemacs--create-branch path (1+ (treemacs-button-get btn :depth)) git-future collapse-future btn)
(treemacs--start-watching path)
;; 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))
(when (and recursive (treemacs-project->is-readable? project))
(when (and (> recursive 0) (treemacs-project->is-readable? project))
(cl-decf recursive)
(--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)))))))))))
(treemacs--expand-dir-node it :git-future git-future :recursive recursive)))))))))))
(defun treemacs--collapse-root-node (btn &optional recursive)
"Collapse the given root BTN.
@@ -573,7 +611,8 @@ RECURSIVE: Bool"
(git-future (if (treemacs-button-get btn :symlink)
(treemacs--git-status-process (file-truename path) project)
(or git-future (treemacs--git-status-process path project))))
(collapse-future (treemacs--collapsed-dirs-process path project)))
(collapse-future (treemacs--collapsed-dirs-process path project))
(recursive (treemacs--prefix-arg-to-recurse-depth recursive)))
(treemacs--button-open
:immediate-insert nil
:button btn
@@ -583,15 +622,18 @@ RECURSIVE: Bool"
(progn
;; do on-expand first so buttons that need collapsing can quickly find their parent
(treemacs-on-expand path btn)
(treemacs--apply-directory-top-extensions btn path)
(when (fboundp 'treemacs--apply-directory-top-extensions)
(treemacs--apply-directory-top-extensions btn path))
(goto-char (treemacs--create-branch path (1+ (treemacs-button-get btn :depth)) git-future collapse-future btn))
(treemacs--apply-directory-bottom-extensions btn path)
(when (fboundp 'treemacs--apply-directory-bottom-extensions)
(treemacs--apply-directory-bottom-extensions btn path))
(treemacs--start-watching path)
(when recursive
(when (> recursive 0)
(cl-decf recursive)
(--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))))))))))
(treemacs--expand-dir-node it :git-future git-future :recursive recursive))))))))))
(defun treemacs--collapse-dir-node (btn &optional recursive)
"Close node given by BTN.
@@ -623,13 +665,14 @@ PROJECT: Project Struct"
(path (treemacs-project->path project))
(dom-node (treemacs-dom-node->create! :key path :position pos)))
(treemacs-dom-node->insert-into-dom! dom-node)
(treemacs--set-project-position project pos)
(insert
(propertize (treemacs-project->name project)
'button '(t)
'category 'default-button
'face (treemacs--root-face project)
:project project
:default-face 'treemacs-root-face
:key path
:symlink (when (treemacs-project->is-readable? project)
(file-symlink-p path))
:state 'root-node-closed
@@ -643,7 +686,8 @@ PROJECT: Project Struct"
(setq treemacs--projects-end (make-marker)))
(let* ((projects (-reject #'treemacs-project->is-disabled? projects))
(current-workspace (treemacs-current-workspace))
(has-previous (treemacs--apply-root-top-extensions current-workspace)))
(has-previous (when (fboundp 'treemacs--apply-root-top-extensions)
(treemacs--apply-root-top-extensions current-workspace))))
(--each projects
(when has-previous (treemacs--insert-root-separator))
@@ -653,7 +697,8 @@ PROJECT: Project Struct"
;; Set the end marker after inserting the extensions. Otherwise, the
;; extensions would move the marker.
(let ((projects-end-point (point)))
(treemacs--apply-root-bottom-extensions current-workspace has-previous)
(when (fboundp 'treemacs--apply-root-bottom-extensions)
(treemacs--apply-root-bottom-extensions current-workspace has-previous))
;; If the marker lies at the start of the buffer, expanding extensions would
;; move the marker. Make sure that the marker does not move when doing so.
(set-marker-insertion-type treemacs--projects-end has-previous)
@@ -941,7 +986,7 @@ FLATTEN-INFO [Int File Path...]"
;; Insert new label
(goto-char parent-btn)
(delete-region (point) (point-at-eol))
(delete-region (point) (line-end-position))
(insert (apply #'propertize new-button-label properties))
;; Fixing marker probably necessary since it's also in the dom
@@ -1043,8 +1088,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))
(treemacs-update-single-file-git-state path)))
(treemacs-update-single-file-git-state path))
('created
(treemacs-do-insert-single-node path (treemacs-dom-node->key node)))
('force-refresh
@@ -1126,26 +1170,22 @@ GIT-INFO is passed through from the previous branch build."
(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))))
(let* ((ws (treemacs-current-workspace)))
(setf (treemacs-workspace->projects ws)
(list (treemacs-project->create!
:name name
:path path
:path-status (treemacs--get-path-status path))))
(--when-let (treemacs-get-local-buffer)
(with-current-buffer it
(treemacs--consolidate-projects)))
(-let [treemacs-select-when-already-in-treemacs 'stay]
(treemacs-select-window))
(goto-char (point-min))
(-if-let (btn (treemacs-current-button))
(unless (treemacs-is-node-expanded? btn)
(treemacs--expand-root-node btn)))
(treemacs--evade-image)))
(provide 'treemacs-rendering)

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -180,13 +180,14 @@ NEW-SCOPE-TYPE: T: treemacs-scope"
(defun treemacs--on-buffer-kill ()
"Cleanup to run when a treemacs buffer is killed."
;; stop watch must come first since we need a reference to the killed buffer
;; to remove it from the filewatch list
(treemacs--stop-filewatch-for-current-buffer)
(treemacs--tear-down-icon-highlight)
;; not present for extension buffers
(-when-let (shelf (treemacs-current-scope-shelf))
(setf (treemacs-scope-shelf->buffer shelf) nil)))
(when (eq t treemacs--in-this-buffer)
;; stop watch must come first since we need a reference to the killed buffer
;; to remove it from the filewatch list
(treemacs--stop-filewatch-for-current-buffer)
;; not present for extension buffers
(-when-let (shelf (treemacs-current-scope-shelf))
(setf (treemacs-scope-shelf->buffer shelf) nil))))
(defun treemacs--on-scope-kill (scope)
"Kill and remove the buffer assigned to the given SCOPE."
@@ -255,7 +256,7 @@ Returns nil if no treemacs buffer is visible."
(define-inline treemacs-current-visibility ()
"Return whether the current visibility state of the treemacs buffer.
Valid states are 'visible, 'exists and 'none."
Valid states are \\='visible, \\='exists and \\='none."
(declare (side-effect-free t))
(inline-quote
(cond

34
lisp/treemacs/treemacs-single-file-git-status.py
View File

@@ -1,5 +1,6 @@
from subprocess import Popen, PIPE, DEVNULL
import sys
import os
# There are 3+ command line arguments:
# 1) the file to update
@@ -7,22 +8,41 @@ import sys
# 3) the file's parents that need to be updated as well
FILE = sys.argv[1]
OLD_STATE = sys.argv[2]
OLD_FACE = sys.argv[2]
PARENTS = [p for p in sys.argv[3:]]
FILE_STATE_CMD = "git status --porcelain --ignored "
FILE_STATE_CMD = "git status --porcelain --ignored=matching "
IS_IGNORED_CMD = "git check-ignore "
IS_TRACKED_CMD = "git ls-files --error-unmatch "
IS_CHANGED_CMD = "git diff-index --quiet HEAD "
IS_CHANGED_CMD = "git ls-files --modified --others --exclude-standard "
def face_for_status(path, status):
if status == "M":
return "treemacs-git-modified-face"
elif status == "U":
return "treemacs-git-conflict-face"
elif status == "?":
return "treemacs-git-untracked-face"
elif status == "!":
return "treemacs-git-ignored-face"
elif status == "A":
return "treemacs-git-added-face"
elif status == "R":
return "treemacs-git-renamed-face"
elif os.path.isdir(path):
return "treemacs-directory-face"
else:
return "treemacs-git-unmodified-face"
def main():
if '"' in FILE or '\\' in FILE:
sys.exit(2)
new_state = determine_file_git_state()
old_state = face_for_status(FILE, OLD_FACE)
# nothing to do
if OLD_STATE == new_state:
if old_state == new_state:
sys.exit(2)
proc_list = []
@@ -53,7 +73,7 @@ def main():
propagate_state = "?"
result_list.append((path, propagate_state))
break
elif changed_proc.wait() == 1:
elif (changed_proc.wait() == 0 and changed_proc.stdout.read1(1) != b''):
result_list.append((path, "M"))
else:
result_list.append((path, "0"))
@@ -65,14 +85,14 @@ def main():
result_list.append((proc_list[i][0], propagate_state))
i += 1
elisp_conses = "".join(['("{}" . "{}")'.format(path, state) for path,state in result_list])
elisp_conses = "".join(['("{}" . {})'.format(path, face_for_status(path, state)) for path, state in result_list])
elisp_alist = "({})".format(elisp_conses)
print(elisp_alist)
def add_git_processes(status_listings, path):
ignored_proc = Popen(IS_IGNORED_CMD + path, shell=True, stdout=DEVNULL, stderr=DEVNULL)
tracked_proc = Popen(IS_TRACKED_CMD + path, shell=True, stdout=DEVNULL, stderr=DEVNULL)
changed_proc = Popen(IS_CHANGED_CMD + path, shell=True, stdout=DEVNULL, stderr=DEVNULL)
changed_proc = Popen(IS_CHANGED_CMD + path, shell=True, stdout=PIPE, stderr=DEVNULL)
status_listings.append((path, ignored_proc, tracked_proc, changed_proc))

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -185,7 +185,8 @@ DEPTH: Int"
"Open tag items for file BTN.
Recursively open all tags below BTN when RECURSIVE is non-nil."
(let* ((path (treemacs-button-get btn :path))
(parent-dom-node (treemacs-find-in-dom path)))
(parent-dom-node (treemacs-find-in-dom path))
(recursive (treemacs--prefix-arg-to-recurse-depth recursive)))
(-if-let (index (treemacs--get-imenu-index path))
(treemacs--button-open
:button btn
@@ -215,7 +216,8 @@ Recursively open all tags below BTN when RECURSIVE is non-nil."
(treemacs-on-expand path btn)
(treemacs--reentry path)
(end-of-line)
(when recursive
(when (> recursive 0)
(cl-decf recursive)
(--each (treemacs-collect-child-nodes btn)
(when (eq 'tag-node-closed (treemacs-button-get it :state))
(goto-char (treemacs-button-start it))
@@ -302,7 +304,8 @@ the display window."
Open all tag section under BTN when call is RECURSIVE."
(let* ((index (treemacs-button-get btn :index))
(tag-path (treemacs-button-get btn :path))
(parent-dom-node (treemacs-find-in-dom tag-path)))
(parent-dom-node (treemacs-find-in-dom tag-path))
(recursive (treemacs--prefix-arg-to-recurse-depth recursive)))
(treemacs--button-open
:button btn
:immediate-insert t
@@ -330,11 +333,13 @@ Open all tag section under BTN when call is RECURSIVE."
(setf (treemacs-dom-node->children parent-dom-node)
(nconc dom-nodes (treemacs-dom-node->children parent-dom-node))))
(treemacs-on-expand tag-path btn)
(if recursive
(--each (treemacs-collect-child-nodes btn)
(when (eq 'tag-node-closed (treemacs-button-get it :state))
(goto-char (treemacs-button-start it))
(treemacs--expand-tag-node it t)))
(if (> recursive 0)
(progn
(cl-decf recursive)
(--each (treemacs-collect-child-nodes btn)
(when (eq 'tag-node-closed (treemacs-button-get it :state))
(goto-char (treemacs-button-start it))
(treemacs--expand-tag-node it t))))
(treemacs--reentry tag-path))))))
(defun treemacs--collapse-tag-node-recursive (btn)
@@ -371,7 +376,7 @@ The position can be stored in the following ways:
* ITEM is a raw number pointing to a buffer position.
* ITEM is a cons: special case for imenu elements of an `org-mode' buffer.
ITEM is an imenu sub-tree and the position is stored as a marker in the first
element's 'org-imenu-marker text property.
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
@@ -399,7 +404,7 @@ tags."
"Call the imenu index of the tag at TAG-PATH and go to its position.
ORG? should be t when this function is called for an org buffer and index since
org requires a slightly different position extraction because the position of a
headline with sub-elements is saved in an 'org-imenu-marker' text property."
headline with sub-elements is saved in an `org-imenu-marker' text property."
(let* ((file (car tag-path))
(path (-butlast (cdr tag-path)))
(tag (-last-item tag-path)))
@@ -498,11 +503,15 @@ headline with sub-elements is saved in an 'org-imenu-marker' text property."
(let (result)
(treemacs-walk-dom project-dom-node
(lambda (node)
(push (list (file-relative-name (treemacs-dom-node->key node) (treemacs-dom-node->key project-dom-node))
(or (treemacs-dom-node->position node) -1)
#'treemacs--imenu-goto-node-wrapper
(treemacs-dom-node->key node))
result)))
(-let [node-btn (or (treemacs-dom-node->position node)
(treemacs-find-node (treemacs-dom-node->key node)))]
(push (list (if (treemacs-button-get node-btn :custom)
(treemacs--get-label-of node-btn)
(file-relative-name (treemacs-dom-node->key node) (treemacs-dom-node->key project-dom-node)))
(or node-btn -1)
#'treemacs--imenu-goto-node-wrapper
(treemacs-dom-node->key node))
result))))
(nreverse result)))
(define-inline treemacs--imenu-goto-node-wrapper (_name _pos key)

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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

1064
lisp/treemacs/treemacs-treelib.el Normal file
View File

File diff suppressed because it is too large Load Diff

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -67,7 +67,9 @@ Used to save the values of `treemacs-indentation' and
(defun treemacs--tear-down-icon-highlight ()
"Tear down highlighting advice when no treemacs buffer exists anymore."
(treemacs--forget-last-highlight)
(unless treemacs--scope-storage
(unless (or treemacs--scope-storage
(--any (buffer-local-value 'treemacs--in-this-buffer it)
(buffer-list)))
(advice-remove #'hl-line-highlight #'treemacs--update-icon-selection)
(advice-remove #'enable-theme #'treemacs--setup-icon-background-colors)
(advice-remove #'disable-theme #'treemacs--setup-icon-background-colors)))
@@ -80,7 +82,7 @@ Used to save the values of `treemacs-indentation' and
(when treemacs-fringe-indicator-mode
(treemacs--move-fringe-indicator-to-point))
(-when-let (btn (treemacs-current-button))
(let* ((pos (max (point-at-bol) (- (treemacs-button-start btn) 2)))
(let* ((pos (max (line-beginning-position) (- (treemacs-button-start btn) 2)))
(img-selected (get-text-property pos 'img-selected)))
(treemacs-with-writable-buffer
(when (and treemacs--last-highlight
@@ -99,7 +101,7 @@ Used to save the values of `treemacs-indentation' and
(when (eq 'treemacs-mode major-mode)
(treemacs-with-writable-buffer
(-when-let (btn (treemacs-current-button))
(let* ((start (max (point-at-bol) (- (treemacs-button-start btn) 2)))
(let* ((start (max (line-beginning-position) (- (treemacs-button-start btn) 2)))
(end (1+ start))
(img (get-text-property start 'display))
(cp (copy-sequence img)))

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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
@@ -27,6 +27,7 @@
(require 'treemacs-core-utils)
(require 'treemacs-dom)
(require 'treemacs-scope)
(require 'treemacs-customization)
(eval-when-compile
(require 'cl-lib)
@@ -87,8 +88,6 @@
(defvar-local treemacs--org-err-ov nil
"The overlay that will display validations when org-editing.")
(defvar-local treemacs--project-positions nil)
(defvar-local treemacs--project-of-buffer nil
"The project that the current buffer falls under, if any.")
@@ -103,12 +102,16 @@ rely on the current buffer and workspace being aligned.")
To be called whenever a project or workspace changes."
(inline-quote
(dolist (buf (buffer-list))
(setf (buffer-local-value 'treemacs--project-of-buffer buf) nil))))
(with-current-buffer buf
(setf treemacs--project-of-buffer nil)))))
(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)))
(-when-let (project (project-current))
(if (fboundp 'project-root)
(-> project (project-root) (file-truename) (treemacs-canonical-path))
(-> project (cdr) (file-truename) (treemacs-canonical-path)))))
(defun treemacs--current-directory-project-function ()
"Find the current working directory."
@@ -219,18 +222,13 @@ FILE: Filepath"
"Get the position of the next project.
Will return `point-max' if there is no next project."
(declare (side-effect-free t))
(inline-quote (next-single-char-property-change (point-at-eol) :project)))
(inline-quote (next-single-char-property-change (line-end-position) :project)))
(define-inline treemacs--prev-project-pos ()
"Get the position of the next project.
Will return `point-min' if there is no next project."
(declare (side-effect-free t))
(inline-quote (previous-single-char-property-change (point-at-bol) :project)))
(define-inline treemacs--reset-project-positions ()
"Reset `treemacs--project-positions'."
(inline-quote
(setq treemacs--project-positions (make-hash-table :test #'equal :size 20))))
(inline-quote (previous-single-char-property-change (line-beginning-position) :project)))
(define-inline treemacs-project->key (self)
"Get the hash table key of SELF.
@@ -244,58 +242,51 @@ SELF may be a project struct or a root key of a top level extension."
(treemacs-project->path ,self)
,self))))
(define-inline treemacs--set-project-position (project position)
"Insert PROJECT's POSITION into `treemacs--project-positions'."
(inline-letevals (project position)
(inline-quote
(ht-set! treemacs--project-positions (treemacs-project->key ,project) ,position))))
(define-inline treemacs-project->position (self)
"Return the position of project SELF in the current buffer."
(declare (side-effect-free t))
(inline-letevals (self)
(inline-quote
(ht-get treemacs--project-positions (treemacs-project->key ,self)))))
(treemacs-dom-node->position
(treemacs-find-in-dom (treemacs-project->path ,self))))))
(define-inline treemacs-project->is-expanded? (self)
"Return non-nil if project SELF is expanded in the current buffer."
(declare (side-effect-free t))
(inline-letevals (self)
(inline-quote
(eq 'root-node-open
(-> ,self (treemacs-project->position) (treemacs-button-get :state))))))
(memq (-> ,self (treemacs-project->position) (treemacs-button-get :state))
treemacs--open-node-states))))
(define-inline treemacs-project->refresh-path-status! (self)
(defun treemacs-project->refresh-path-status! (self)
"Refresh the path status of project SELF in the current buffer.
Does not preserve the current position in the buffer."
(inline-letevals (self)
(inline-quote
(let ((old-path-status (treemacs-project->path-status ,self))
(new-path-status (treemacs--get-path-status (treemacs-project->path ,self))))
(unless (eq old-path-status new-path-status)
(setf (treemacs-project->path-status ,self) new-path-status)
;; When the path transforms from unreadable or disconnected to readable,
;; update the :symlink status on its button.
(let ((pos (treemacs-project->position ,self))
(path (treemacs-project->path ,self)))
(when (treemacs-project->is-readable? ,self)
(treemacs-button-put pos :symlink (file-symlink-p path)))
(treemacs-button-put pos 'face (treemacs--root-face ,self))))))))
(let ((old-path-status (treemacs-project->path-status self))
(new-path-status (treemacs--get-path-status (treemacs-project->path self))))
(unless (eq old-path-status new-path-status)
(setf (treemacs-project->path-status self) new-path-status)
;; When the path transforms from unreadable or disconnected to readable,
;; update the :symlink status on its button.
(let ((pos (treemacs-project->position self))
(path (treemacs-project->path self)))
(when (treemacs-project->is-readable? self)
(treemacs-button-put pos :symlink (file-symlink-p path)))
(treemacs-button-put pos 'face (treemacs--root-face self))))))
(define-inline treemacs-project->refresh! (self)
;; TODO(2021/08/17): -> rendering
(defun treemacs-project->refresh! (self)
"Refresh project SELF in the current buffer.
Does not preserve the current position in the buffer."
(inline-letevals (self)
(inline-quote
(progn
(treemacs-project->refresh-path-status! ,self)
(when (treemacs-project->is-expanded? ,self)
(let ((root-btn (treemacs-project->position ,self)))
(goto-char root-btn)
(treemacs--forget-last-highlight)
(treemacs--collapse-root-node root-btn)
(unless (treemacs-project->is-unreadable? ,self)
(treemacs--expand-root-node root-btn))))))))
(treemacs-project->refresh-path-status! self)
(when (treemacs-project->is-expanded? self)
(let ((root-btn (treemacs-project->position self)))
(goto-char root-btn)
(treemacs--forget-last-highlight)
(funcall (alist-get (treemacs-button-get root-btn :state)
treemacs-TAB-actions-config))
(unless (treemacs-project->is-unreadable? self)
(funcall (alist-get (treemacs-button-get root-btn :state)
treemacs-TAB-actions-config))))))
(define-inline treemacs-project->is-last? (self)
"Return t when root node of project SELF is the last in the view."
@@ -405,6 +396,7 @@ Returns either
* `remote-unreadable' when PATH is a remote unreadable file or directory,
* `remote-disconnected' when PATH is remote, but the connection is down, or
* `extension' when PATH is not a string."
(declare (side-effect-free t))
(cond
((not (stringp path)) 'extension)
((not (file-remote-p path))
@@ -414,14 +406,15 @@ Returns either
(t 'remote-unreadable)))
(define-inline treemacs-project->is-unreadable? (self)
"Return t if the project SELF is definitely unreadable.
"Return non-nil if the project SELF is definitely unreadable.
If `path-status' of the project is `remote-disconnected', the return value will
be nil even though the path might still be unreadable. Does not verify the
readability, the cached path-state is used."
readability, the cached path-state is used. Extension projects will count as
readable."
(declare (side-effect-free t))
(inline-quote (memq (treemacs-project->path-status ,self)
'(local-unreadable remote-unreadable extension))))
'(local-unreadable remote-unreadable))))
(define-inline treemacs-project->is-readable? (self)
"Return t if the project SELF is definitely readable for file operations.
@@ -521,6 +514,7 @@ NAME: String"
(when treemacs-expand-added-projects
(treemacs--expand-root-node (treemacs-project->position project))))))
(treemacs--persist)
(treemacs--invalidate-buffer-project-cache)
(when (with-no-warnings treemacs-hide-gitignored-files-mode)
(treemacs--prefetch-gitignore-cache path))
(run-hook-with-args 'treemacs-create-project-functions project)
@@ -577,8 +571,7 @@ Return values may be as follows:
'user-cancel)
(treemacs-run-in-every-buffer
(treemacs-with-writable-buffer
(let* ((project-path (treemacs-project->path project))
(project-pos (goto-char (treemacs-project->position project-path)))
(let* ((project-pos (goto-char (treemacs-project->position project)))
(prev-project-pos (move-marker (make-marker) (treemacs--prev-project-pos)))
(next-project-pos (move-marker (make-marker) (treemacs--next-project-pos))))
(when (treemacs-project->is-expanded? project)
@@ -592,7 +585,7 @@ Return values may be as follows:
;; the end of the previous button's line. If the `treemacs--projects-end'
;; is at the EOL of the it will move to EOL of the previous button.
(previous-button
(delete-region (treemacs-button-end previous-button) (point-at-eol))
(delete-region (treemacs-button-end previous-button) (line-end-position))
(when next-button (forward-button 1)))
;; Previous project does not exist, but a next button exists. Delete from
;; BOL to the start of the next buttons line.
@@ -601,16 +594,17 @@ Return values may be as follows:
;; The first item after the deletion will be bottom extensions. Project
;; end will be at its BOL, making it move upon expand/collapse. Lock the marker.
(set-marker-insertion-type (treemacs--projects-end) nil))
(delete-region (point-at-bol) (progn (goto-char next-button) (forward-line 0) (point))))
(delete-region (line-beginning-position) (progn (goto-char next-button) (forward-line 0) (point))))
;; Neither the previous nor the next button exists. Simply delete the
;; current line.
(t
(delete-region (point-at-bol) (point-at-eol)))))
(delete-region (line-beginning-position) (line-end-position)))))
(if (equal (point-min) prev-project-pos)
(goto-char next-project-pos)
(goto-char prev-project-pos)))
(treemacs--forget-last-highlight)
(treemacs--invalidate-buffer-project-cache)
(--when-let (treemacs-get-local-window)
(with-selected-window it
(recenter)))
@@ -714,13 +708,17 @@ PROJECT: Project Struct"
(interactive)
(save-excursion
(goto-char (treemacs-project->position project))
(let* ((start (point-at-bol))
(let* ((start (line-beginning-position))
(next (treemacs--next-non-child-button (treemacs-project->position project)))
(end (if next (-> next (treemacs-button-start) (previous-button) (treemacs-button-end)) (point-max))))
(end (if next
(-> next (treemacs-button-start) (previous-button) (treemacs-button-end))
;; final position minus the final newline
(1- (point-max)))))
(cons start end))))
(defun treemacs--consolidate-projects ()
"Correct treemacs buffers' content after the workspace was edited."
(treemacs--invalidate-buffer-project-cache)
(treemacs-run-in-every-buffer
(let* ((current-file (--when-let (treemacs-current-button) (treemacs--nearest-path it)))
(current-workspace (treemacs-current-workspace))
@@ -753,6 +751,7 @@ PROJECT: Project Struct"
(setf projects-in-buffer (delete project-in-buffer projects-in-buffer))))
(treemacs-with-writable-buffer
(treemacs--forget-last-highlight)
(treemacs--reset-dom)
;; delete everything's that's visible and render it again - the order of projects could
;; have been changed
(erase-buffer)
@@ -787,7 +786,7 @@ PROJECT: Project Struct"
(_
(goto-char 0)
(search-forward-regexp (rx-to-string `(seq bol ,line eol)))))
(setf treemacs--org-err-ov (make-overlay (point-at-eol) (point-at-eol)))
(setf treemacs--org-err-ov (make-overlay (line-end-position) (line-end-position)))
(overlay-put treemacs--org-err-ov 'after-string
(concat (propertize " ← " 'face 'error) message))
(add-hook 'after-change-functions #'treemacs--org-edit-remove-validation-msg nil :local)))
@@ -807,18 +806,27 @@ PROJECT: Project Struct"
(--when-let (funcall fun)
(treemacs-return it)))))
(defun treemacs--select-workspace-by-name (&optional name)
"Interactively select the workspace with the given NAME."
(defun treemacs--find-workspace-by-name (name)
"Find a workspace with the given NAME.
Returns nil when there is no match."
(treemacs--maybe-load-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))))
(--first (string= name (treemacs-workspace->name it))
treemacs--workspaces))
(defun treemacs--select-workspace-by-name ()
"Interactively select the workspace.
Selection is based on the list of names of all workspaces and still happens
when there is only one workspace."
(treemacs--maybe-load-workspaces)
(let (name)
(while (or (null name) (string= "" name))
(setf name (completing-read
"Workspace: "
(->> treemacs--workspaces
(--map (cons (treemacs-workspace->name it) it)))
nil :require-match)))
(--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.

26
lisp/treemacs/treemacs.el
View File

@@ -1,11 +1,11 @@
;;; treemacs.el --- A tree style file explorer package -*- lexical-binding: t -*-
;; Copyright (C) 2021 Alexander Miller
;; Copyright (C) 2022 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") (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.9.5
;; Version: 3.0
;; 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
@@ -47,11 +47,11 @@
(require 'treemacs-workspaces)
(require 'treemacs-fringe-indicator)
(require 'treemacs-header-line)
(require 'treemacs-extensions)
(require 'treemacs-annotations)
(defconst treemacs-version
(eval-when-compile
(format "v2.9.5 (installed %s) @ Emacs %s"
(format "v3.0 (installed %s) @ Emacs %s"
(format-time-string "%Y.%m.%d" (current-time))
emacs-version)))
@@ -197,9 +197,16 @@ A non-nil prefix ARG will also force a workspace switch."
(ignore))
('close
(treemacs-quit))
('goto-next
(treemacs--jump-to-next-treemacs-window))
('next-or-back
(or
(treemacs--jump-to-next-treemacs-window)
(select-window (get-mru-window (selected-frame) nil :not-selected))))
('move-back
(select-window (get-mru-window (selected-frame) nil :not-selected))))))))
(setf treemacs-select-when-already-in-treemacs 'next-or-back)
;;;###autoload
(defun treemacs-show-changelog ()
"Show the changelog of treemacs."
@@ -231,14 +238,15 @@ A non-nil prefix ARG will also force a workspace switch."
(goto-char 0))
;;;###autoload
(defun treemacs-display-current-project-exclusively ()
(defun treemacs-add-and-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, 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."
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)
(treemacs-block
(treemacs-unless-let (root (treemacs--find-current-user-project))
@@ -254,6 +262,10 @@ only project, all other projects *will be removed* from the current workspace."
(treemacs--show-single-project path name)
(treemacs-pulse-on-success "Now showing %s"
(propertize path 'face 'font-lock-string-face))))))
(define-obsolete-function-alias
'treemacs-display-current-project-exclusively
#'treemacs-add-and-display-current-project-exclusively
"v2.9")
;;;###autoload
(defun treemacs-add-and-display-current-project ()