[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/ztree 8f1ff33 6/8: Reimplemented progress reporting.
From: |
Stefan Monnier |
Subject: |
[elpa] externals/ztree 8f1ff33 6/8: Reimplemented progress reporting. |
Date: |
Mon, 15 Mar 2021 22:26:16 -0400 (EDT) |
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)
- [elpa] externals/ztree updated (0a5b25f -> dc5f769), Stefan Monnier, 2021/03/15
- [elpa] externals/ztree f658f5a 1/8: Issue #71: Warning: Package cl is deprecated, Stefan Monnier, 2021/03/15
- [elpa] externals/ztree 79a0d6e 2/8: Renamed cl function incf to cl-incf, Stefan Monnier, 2021/03/15
- [elpa] externals/ztree 6eee81d 3/8: Issue #67: LICENSE / COPYING file missing, Stefan Monnier, 2021/03/15
- [elpa] externals/ztree 8f1ff33 6/8: Reimplemented progress reporting.,
Stefan Monnier <=
- [elpa] externals/ztree dc5f769 8/8: Finalized the refactoring with protocol usage., Stefan Monnier, 2021/03/15
- [elpa] externals/ztree 0be261d 5/8: Refactored using generics instead of function variables, Stefan Monnier, 2021/03/15
- [elpa] externals/ztree 51b1604 7/8: Fixed bug with not expanded root, Stefan Monnier, 2021/03/15
- [elpa] externals/ztree 07bca6c 4/8: Unified creation of callback functions, Stefan Monnier, 2021/03/15