[elpa] externals/ztree 8f1ff33 6/8: Reimplemented progress reporting.

[Stefan Monnier]

branch: externals/ztree
commit 8f1ff3365d3b9bed9cf66d00003530824ee4118d
Author: Alexey Veretennikov <fourier@protonmail.ch>
Commit: Alexey Veretennikov <fourier@protonmail.ch>

    Reimplemented progress reporting.
    
    Progress reporting is using Emacs' built in
    progress-reporter
---
 ztree-diff-model.el | 34 ++++++++++++++--------------------
 ztree-diff.el       | 30 ++++--------------------------
 ztree-protocol.el   |  1 +
 ztree-view.el       | 14 ++++++++++----
 4 files changed, 29 insertions(+), 50 deletions(-)

diff --git a/ztree-diff-model.el b/ztree-diff-model.el
index 179f005..8a2faa0 100644
--- a/ztree-diff-model.el
+++ b/ztree-diff-model.el
@@ -45,18 +45,9 @@ Should be a list of strings.
 Example:
 (setq ztree-diff-options '(\"-w\" \"-i\"))")
 
-
 (defvar-local ztree-diff-model-ignore-fun nil
   "Function which determines if the node should be excluded from comparison.")
 
-(defvar-local ztree-diff-model-progress-fun nil
-  "Function which should be called whenever the progress indications is 
updated.")
-
-
-(defun ztree-diff-model-update-progress ()
-  "Update the progress."
-  (when ztree-diff-model-progress-fun
-    (funcall ztree-diff-model-progress-fun)))
 
 ;; Create a record ztree-diff-node with defined fields and getters/setters
 ;; here:
@@ -188,7 +179,7 @@ The node is a either a file or directory with both
 left and right parts existing."
   ;; if a directory - recreate
   (if (ztree-diff-node-is-directory node)
-      (ztree-diff-node-recreate node)
+      (ztree-diff-node-recreate-with-progress node)
     ;; if a file, change a status
     (setf (ztree-diff-node-different node)
           (if (or (ztree-diff-model-ignore-p node) ; if should be ignored
@@ -295,9 +286,16 @@ if parent has ignored status - ignore"
          (or (eql (ztree-diff-node-different parent) 'ignore)
              (ztree-diff-model-ignore-p node)))))
 
+(defun ztree-diff-node-recreate-with-progress (node)
+  "Initiate update of the NODE with a progress printout"
+  (let ((progress-reporter
+         (make-progress-reporter (concat "Comparing " 
(ztree-diff-node-left-path node) " and " (ztree-diff-node-right-path node) " 
..."))))
+    (ztree-diff-node-recreate node progress-reporter)
+    (progress-reporter-done progress-reporter)))
 
-(defun ztree-diff-node-recreate (node)
-  "Traverse 2 paths defined in the NODE updating its children and status."
+(defun ztree-diff-node-recreate (node &optional reporter)
+  "Traverse 2 paths defined in the NODE updating its children and status.
+When REPORTER provided update the progress."
   (let* ((list1 (ztree-directory-files (ztree-diff-node-left-path node))) ;; 
left list of liles
          (list2 (ztree-directory-files (ztree-diff-node-right-path node))) ;; 
right list of files
          (should-ignore (ztree-diff-model-should-ignore node))
@@ -305,7 +303,9 @@ if parent has ignored status - ignore"
          (children-status (if should-ignore 'ignore 'new))
          (children nil))    ;; list of children
     ;; update waiting status
-    (ztree-diff-model-update-progress)
+    (when reporter
+      (sit-for 1)
+      (progress-reporter-update reporter))
     ;; update node status ignore status either inhereted from the
     ;; parent or the own
     (when should-ignore
@@ -383,7 +383,7 @@ if parent has ignored status - ignore"
 
 (defun ztree-diff-model-update-node (node)
   "Refresh the NODE."
-  (ztree-diff-node-recreate node))
+  (ztree-diff-node-recreate-with-progress node))
 
 
 
@@ -395,12 +395,6 @@ with dot etc)."
   (setf ztree-diff-model-ignore-fun ignore-p))
 
 
-(defun ztree-diff-model-set-progress-fun (progress-fun)
-  "Setter for the buffer-local PROGRESS-FUN callback.
-This callback is called to indicate the ongoing activity.
-Callback is a function without arguments."
-  (setf ztree-diff-model-progress-fun progress-fun))
-
 (provide 'ztree-diff-model)
 
 ;;; ztree-diff-model.el ends here
diff --git a/ztree-diff.el b/ztree-diff.el
index 9745053..6b29928 100644
--- a/ztree-diff.el
+++ b/ztree-diff.el
@@ -99,9 +99,6 @@ By default paths starting with dot (like .git) are ignored")
 (defvar-local ztree-diff-show-left-orphan-files t
   "Show or not orphan files/directories on left side.")
 
-(defvar-local ztree-diff-wait-message nil
-  "Message showing while constructing the diff tree.")
-
 (defvar ztree-diff-ediff-previous-window-configurations nil
   "Window configurations prior to calling `ediff'.
 A queue of window configurations, allowing
@@ -197,10 +194,7 @@ to restore last configuration even if there were a couple 
of ediff sessions")
     (if (not parent)
         (when ztree-diff-dirs-pair
           (ztree-diff (car ztree-diff-dirs-pair) (cdr ztree-diff-dirs-pair)))
-      (ztree-diff-update-wait-message
-           (concat "Updating " (ztree-diff-node-short-name common) " ..."))
       (ztree-diff-model-partial-rescan common)
-      (message "Done")
       (ztree-refresh-buffer (line-number-at-pos)))))
 
 
@@ -352,11 +346,8 @@ COPY-TO-RIGHT specifies which side of the NODE to update."
         (if copy-to-right
             (setf (ztree-diff-node-right-path node) target-full-path)
           (setf (ztree-diff-node-left-path node) target-full-path))
-        (ztree-diff-update-wait-message
-         (concat "Updating " (ztree-diff-node-short-name node) " ..."))
         ;; TODO: do not rescan the node. Use some logic like in delete
         (ztree-diff-model-update-node node)
-        (message "Done.")
         (ztree-diff-node-update-all-parents-diff node)
         (ztree-refresh-buffer (line-number-at-pos))))))
 
@@ -555,14 +546,6 @@ unless it is a parent node."
     (message (concat (if show "Show" "Hide") " orphan files"))
     (ztree-refresh-buffer)))
 
-(defun ztree-diff-update-wait-message (&optional msg)
-  "Update the wait message MSG with one more `.' progress indication."
-  (if msg
-      (setq ztree-diff-wait-message msg)
-    (when ztree-diff-wait-message
-      (setq ztree-diff-wait-message (concat ztree-diff-wait-message "."))))
-  (message ztree-diff-wait-message))
-
 ;;
 ;; Implementation of the ztree-protocol
 ;;
@@ -632,21 +615,16 @@ Argument DIR2 right directory."
                            " <--> "
                            (ztree-diff-node-right-short-name model)
                            "*")))
+    (ztree-diff-model-set-ignore-fun #'ztree-diff-node-ignore-p)
+    (setq ztree-diff-dirs-pair (cons dir1 dir2))
+    (ztree-diff-node-recreate-with-progress model)
     ;; after this command we are in a new buffer,
     ;; so all buffer-local vars are valid
     (ztree-view buf-name
                 #'ztree-diff-insert-buffer-header
                 model
                 t)
-    (ztreediff-mode)
-    (ztree-diff-model-set-ignore-fun #'ztree-diff-node-ignore-p)
-    (ztree-diff-model-set-progress-fun #'ztree-diff-update-wait-message)
-    (setq ztree-diff-dirs-pair (cons dir1 dir2))
-    (ztree-diff-update-wait-message (concat "Comparing " dir1 " and " dir2 " 
..."))
-    (ztree-diff-node-recreate model)
-    (message "Done.")
-
-    (ztree-refresh-buffer)))
+    (ztreediff-mode)))
 
 
 (provide 'ztree-diff)
diff --git a/ztree-protocol.el b/ztree-protocol.el
index b458008..3958aeb 100644
--- a/ztree-protocol.el
+++ b/ztree-protocol.el
@@ -33,6 +33,7 @@
 
 (eval-when-compile (require 'cl-lib))
 
+;;; Node protocol
 
 ;;; Obligatory to implement
 
diff --git a/ztree-view.el b/ztree-view.el
index dfc23e4..68cca1c 100644
--- a/ztree-view.el
+++ b/ztree-view.el
@@ -89,6 +89,9 @@ or both sides
   "The cons pair of the previous line and column. Used
 to restore cursor position after refresh")
 
+(defvar-local ztree-last-window-width nil
+  "The window width at the last refresh")
+
 (defvar-local ztree-two-sided-p nil
   "If the tree is 2 sided, 2 trees shall be drawn side by side")
 
@@ -691,7 +694,8 @@ Optional argument LINE scroll to the line given."
                ;; restore cursor position if possible
                (ztree-scroll-to-line (car ztree-prev-position))
                (beginning-of-line)
-               (goto-char (+ (cdr ztree-prev-position) (point)))))))))
+               (goto-char (+ (cdr ztree-prev-position) (point)))))))
+    (setq ztree-last-window-width (window-width))))
 
              
 
@@ -730,7 +734,9 @@ change the root node to the node specified."
   (walk-windows (lambda (win) 
                   (with-current-buffer (window-buffer win)
                     (when (derived-mode-p 'ztree-mode)
-                      (ztree-refresh-buffer))))
+                      (when (and ztree-last-window-width
+                                 (/= ztree-last-window-width (window-width)))
+                        (ztree-refresh-buffer)))))
                 nil 'visible))
 
 (defun ztree-view (buffer-name header-fun start-node &optional two-sided-p)
@@ -747,8 +753,8 @@ Optional argument TWO-SIDED-P Determines if the tree is 
2-sided (nil by default)
     (setq ztree-start-node start-node)
     (setq ztree-tree-header-fun header-fun)
     (setq ztree-two-sided-p two-sided-p)
-    (add-hook 'window-configuration-change-hook 
#'ztree-view-on-window-configuration-changed)
-    (ztree-refresh-buffer)))
+    (ztree-refresh-buffer)
+    (add-hook 'window-configuration-change-hook 
#'ztree-view-on-window-configuration-changed)))
 
 
 (provide 'ztree-view)