mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-02 04:36:43 +01:00
- implemented mark and deletion of tree in filesystem window.
This commit is contained in:
parent
7619408c0f
commit
2061880a16
@ -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*)
|
||||
|
||||
|
@ -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))
|
||||
|
@ -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
|
||||
|
@ -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? ")))))
|
||||
|
Loading…
x
Reference in New Issue
Block a user