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

update packages

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

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

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