treemacs update

2022-12-29 12:40:49 +01:00
parent 4fe9a6b7e1
commit d95f45d049
10 changed files with 1599 additions and 59 deletions
--- a/lisp/treemacs/treemacs-annotations.el
+++ b/lisp/treemacs/treemacs-annotations.el
@@ -129,7 +129,7 @@ SOURCE: String"
              (treemacs-annotation->face-value ann)
              (append (mapcar #'cdr new-faces) git-face))
           (setf
-            (treemacs-annotation->face ann) 'deleted
+            (treemacs-annotation->face ann) nil
            (treemacs-annotation->face-value ann) git-face)))))))

 (defun treemacs-clear-annotation-faces (source)
@@ -277,38 +277,25 @@ GIT-FACE is taken from the latest git cache, or nil if it's not known."
               (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)))
+           ;; 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)
--- a/lisp/treemacs/treemacs-hydras.el
+++ b/lisp/treemacs/treemacs-hydras.el
@@ -241,7 +241,7 @@ find the key a command is bound to it will show a blank instead."
             (column-files       (propertize "File Management" 'face 'treemacs-help-column-face))
             (column-ws          (propertize "Workspaces" 'face 'treemacs-help-column-face))
             (column-misc        (propertize "Misc." 'face 'treemacs-help-column-face))
-             (column-window      (propertize "Other Window." 'face 'treemacs-help-column-face))
+             (column-window      (propertize "Other Window" 'face 'treemacs-help-column-face))
             (common-hint        (format "%s %s"
                                         (propertize "For common keybinds see" 'face 'treemacs-help-title-face)
                                         (propertize "treemacs-common-helpful-hydra" 'face 'font-lock-function-name-face)))
@@ -278,7 +278,7 @@ find the key a command is bound to it will show a blank instead."
 %s
 %s (%s)

-%s      ^^^^^^^^^^^^^│ %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
--- a/lisp/treemacs/treemacs-pkg.el
+++ b/lisp/treemacs/treemacs-pkg.el
@@ -1,4 +1,4 @@
-(define-package "treemacs" "20221107.2105" "A tree style file explorer package"
+(define-package "treemacs" "20221221.1301" "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 "b19060f25e55514f3d798d9f5af2dcd5b94a6026" :authors
+  :commit "71e5df66b99ffe16de65fb4783e7484b05aae6cb" :authors
  '(("Alexander Miller" . "alexanderm@web.de"))
  :maintainer
  '("Alexander Miller" . "alexanderm@web.de")
--- a/lisp/treemacs/treemacs-rendering.el
+++ b/lisp/treemacs/treemacs-rendering.el
@@ -468,13 +468,14 @@ set to PARENT."
           (treemacs-dom-node->insert-into-dom! it))

         (treemacs--inplace-map-when-unrolled dir-strings 2
-           (-if-let (ann (treemacs-get-annotation (concat ,root "/" it)))
+           (-if-let* ((ann (treemacs-get-annotation (concat ,root "/" it)))
+                      (face (treemacs-annotation->face-value ann)))
               (progn
                 (put-text-property
                  0
                  (length it)
                  'face
-                  (treemacs-annotation->face-value ann)
+                  face
                  it)
                 (concat it (treemacs-annotation->suffix-value ann)))
             (put-text-property
@@ -489,13 +490,14 @@ set to PARENT."
         (end-of-line)
         (setf file-strings
               (treemacs--inplace-map-when-unrolled file-strings 3
-                 (-if-let (ann (treemacs-get-annotation (concat ,root "/" it)))
+                 (-if-let* ((ann (treemacs-get-annotation (concat ,root "/" it)))
+                            (face (treemacs-annotation->face-value ann)))
                     (progn
                       (put-text-property
                        0
                        (length it)
                        'face
-                        (treemacs-annotation->face-value ann)
+                        face
                        it)
                       (concat it (treemacs-annotation->suffix-value ann)))
                   (put-text-property
--- a/lisp/treemacs/treemacs-treelib.el
+++ b/lisp/treemacs/treemacs-treelib.el
@@ -742,7 +742,7 @@ If a prefix ARG is provided expand recursively."
             (treemacs--do-expand-extension-node
              btn ext async-cache arg)
             (unless busy?
-               (treemacs-update-async-node path))))
+               (treemacs-update-async-node path (marker-buffer btn)))))
          ((treemacs-extension->async? ext)
           (treemacs--do-expand-async-extension-node btn ext arg))
          (t
@@ -956,8 +956,9 @@ EXPAND-DEPTH: Int"
             (goto-char (treemacs-button-start it))
             (treemacs-expand-extension-node expand-depth))))))))

-(defun treemacs-update-async-node (path)
-  "Update an asynchronous node at the given PATH.
+(defun treemacs-update-async-node (path buffer)
+  "Update an asynchronous node at PATH in the given BUFFER.
+
 The update process will asynchronously pre-compute the children for every node
 currently expanded under PATH.  The results of this computation will be cached
 and then used to update the UI in one go."
@@ -973,7 +974,7 @@ and then used to update the UI in one go."
         children-fn btn item
         (lambda (items)
           (treemacs--async-update-part-complete
-            path item-path items)))))))
+            path item-path items buffer)))))))

 (defun treemacs--get-async-update-items (path)
  "Get the items needed for an async update at the given PATH.
@@ -988,18 +989,19 @@ extensions instance."
          (push (cons key ext) items))))
    items))

-(defun treemacs--async-update-part-complete (top-path updated-path items)
+(defun treemacs--async-update-part-complete (top-path updated-path items buffer)
  "Partial completion for an asynchronous update.
 TOP-PATH is the path of the node the update was called for.
 UPDATED-PATH is the path of one of top node's children (may also be TOP-PATH)
 whose content has just been computed.
 ITEMS are the new items for the UPDATED-PATH that will be cached for the next
-update."
+update.
+BUFFER is the buffer where the node is located."
  (ht-set! treemacs--async-update-cache updated-path (or items 'nothing))
  (-let [count (cl-decf (ht-get treemacs--async-update-count top-path))]
    (when (= 0 count)
-      (--when-let (treemacs-get-local-buffer)
-        (with-current-buffer it
+      (--when-let (buffer-live-p buffer)
+        (with-current-buffer buffer
          (treemacs-with-writable-buffer
           (treemacs-update-node top-path)
           (treemacs-button-put (treemacs-find-node updated-path) :busy nil)))))))