From 2061880a166e543a02c5ca160fc95ab0d7fbfd3a Mon Sep 17 00:00:00 2001
From: cage <cage@invalid>
Date: Tue, 14 Dec 2021 13:05:40 +0100
Subject: [PATCH] - implemented mark and deletion of tree in filesystem window.

---
 etc/init.lisp                   |  4 +++-
 src/filesystem-tree-window.lisp | 23 ++++++++++++++++----
 src/package.lisp                |  6 +++++-
 src/ui-goodies.lisp             | 38 +++++++++++++++++++++++++++++++--
 4 files changed, 63 insertions(+), 8 deletions(-)

diff --git a/etc/init.lisp b/etc/init.lisp
index 5385ce1..4ba05f9 100644
--- a/etc/init.lisp
+++ b/etc/init.lisp
@@ -602,7 +602,9 @@
 
 (define-key "m"         #'file-explorer-rename-path   *filesystem-explorer-keymap*)
 
-(define-key "D"         #'file-explorer-delete-path   *filesystem-explorer-keymap*)
+(define-key "D"         #'file-explorer-delete-tree   *filesystem-explorer-keymap*)
+
+(define-key "X"         #'file-explorer-delete-marked *filesystem-explorer-keymap*)
 
 (define-key "a"         #'file-explorer-create-path   *filesystem-explorer-keymap*)
 
diff --git a/src/filesystem-tree-window.lisp b/src/filesystem-tree-window.lisp
index 0ab2bbf..6b58ccf 100644
--- a/src/filesystem-tree-window.lisp
+++ b/src/filesystem-tree-window.lisp
@@ -203,10 +203,7 @@ Returns nil if Returns nil if the path does not point to an actual file."))
   (tree-path (data matching-node)))
 
 (defun %expand-treenode (root path-to-expand expand-fn)
-  (when-let ((matching-node (first (mtree:find-child-if root
-                                                        (lambda (a)
-                                                          (string= (tree-path (data a))
-                                                                   path-to-expand))))))
+  (when-let ((matching-node (find-node root path-to-expand)))
     (funcall expand-fn matching-node)))
 
 (defun %build-annotated-tree-rows (window root-node)
@@ -369,6 +366,24 @@ Returns nil if Returns nil if the path does not point to an actual file."))
     (win-clear window :redraw nil)
     (resync-rows-db window :redraw t :selected-path parent-path)))
 
+(defun recursive-delete-node (window path)
+  (with-accessors ((root-node                  filesystem-root)
+                   (filesystem-expand-function filesystem-expand-function)) window
+    (let* ((matching-node (find-node root-node path))
+           (filep         (not (tree-dir-p (data matching-node)))))
+      (if filep
+          (delete-treenode window path)
+          (when (not (or (fs:loopback-reference-dir-p path)
+                         (fs:backreference-dir-p      path)))
+            (%expand-treenode root-node
+                              (tree-path (data matching-node))
+                              filesystem-expand-function)
+            (setf matching-node (find-node root-node path))
+            (do-children (child matching-node)
+              (let ((path-to-recurse (tree-path (data child))))
+                (recursive-delete-node window path-to-recurse)))
+            (delete-treenode window path))))))
+
 (defun filesystem-query-treenode (window path what)
   (assert (member what '(:size)))
   (when-let* ((root-node     (filesystem-root window))
diff --git a/src/package.lisp b/src/package.lisp
index eac96b9..3b7cb5e 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -2030,6 +2030,7 @@
    :filesystem-root
    :tree-path
    :tree-dir-p
+   :tree-marked-p
    :close-treenode
    :expand-treenode
    :rename-treenode
@@ -2037,6 +2038,7 @@
    :create-treenode
    :download-treenode
    :upload-treenode
+   :recursive-delete-node
    :filesystem-query-treenode
    :mark-node
    :resync-rows-db
@@ -2804,7 +2806,9 @@
    :file-explorer-go-down
    :file-explorer-go-up
    :file-explorer-search
-   :file-explorer-mark-entry))
+   :file-explorer-mark-entry
+   :file-explorer-delete-tree
+   :file-explorer-delete-marked))
 
 (defpackage :scheduled-events
   (:use
diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp
index 127e716..a2f0313 100644
--- a/src/ui-goodies.lisp
+++ b/src/ui-goodies.lisp
@@ -2550,5 +2550,39 @@ printed, on the main window."
               (path   (fstree:tree-path  fields)))
     (with-enqueued-process ()
       (fstree:mark-node win path)
-      (windows:win-clear win)
-      (windows:draw win))))
+      (file-explorer-go-down))))
+
+(defun file-explorer-delete-tree ()
+    (when-let* ((win    *filesystem-explorer-window*)
+              (fields (line-oriented-window:selected-row-fields win))
+              (path   (fstree:tree-path  fields)))
+    (flet ((on-input-complete (maybe-accepted)
+             (with-valid-yes-at-prompt (maybe-accepted y-pressed-p)
+               (when y-pressed-p
+                 (with-enqueued-process ()
+                   (fstree:recursive-delete-node win path)
+                   (fstree:resync-rows-db win
+                                          :selected-path (fs:parent-dir-path path)
+                                          :redraw nil)
+                   (windows:win-clear win)
+                   (windows:draw win))))))
+      (ask-string-input #'on-input-complete
+                        :prompt
+                        (format nil (_ "delete ~a? ") path)))))
+
+(defun file-explorer-delete-marked ()
+  (when-let* ((win    *filesystem-explorer-window*))
+    (flet ((on-input-complete (maybe-accepted)
+             (with-valid-yes-at-prompt (maybe-accepted y-pressed-p)
+               (when y-pressed-p
+                 (line-oriented-window:loop-rows
+                     (win row
+                          when (fstree:tree-marked-p (line-oriented-window:fields row)) do)
+                   (let ((path (fstree:tree-path (line-oriented-window:fields row))))
+                     (fstree:recursive-delete-node win path)))
+                 (let ((root (fstree:tree-path (mtree:data (fstree:filesystem-root win)))))
+                 (fstree:resync-rows-db win
+                                        :selected-path root
+                                        :redraw t))))))
+      (ask-string-input #'on-input-complete
+                        :prompt (_ "delete marked items? ")))))