mirror of
https://codeberg.org/cage/tinmop/
synced 2025-03-11 11:10: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 "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*)
|
(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)))
|
(tree-path (data matching-node)))
|
||||||
|
|
||||||
(defun %expand-treenode (root path-to-expand expand-fn)
|
(defun %expand-treenode (root path-to-expand expand-fn)
|
||||||
(when-let ((matching-node (first (mtree:find-child-if root
|
(when-let ((matching-node (find-node root path-to-expand)))
|
||||||
(lambda (a)
|
|
||||||
(string= (tree-path (data a))
|
|
||||||
path-to-expand))))))
|
|
||||||
(funcall expand-fn matching-node)))
|
(funcall expand-fn matching-node)))
|
||||||
|
|
||||||
(defun %build-annotated-tree-rows (window root-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)
|
(win-clear window :redraw nil)
|
||||||
(resync-rows-db window :redraw t :selected-path parent-path)))
|
(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)
|
(defun filesystem-query-treenode (window path what)
|
||||||
(assert (member what '(:size)))
|
(assert (member what '(:size)))
|
||||||
(when-let* ((root-node (filesystem-root window))
|
(when-let* ((root-node (filesystem-root window))
|
||||||
|
@ -2030,6 +2030,7 @@
|
|||||||
:filesystem-root
|
:filesystem-root
|
||||||
:tree-path
|
:tree-path
|
||||||
:tree-dir-p
|
:tree-dir-p
|
||||||
|
:tree-marked-p
|
||||||
:close-treenode
|
:close-treenode
|
||||||
:expand-treenode
|
:expand-treenode
|
||||||
:rename-treenode
|
:rename-treenode
|
||||||
@ -2037,6 +2038,7 @@
|
|||||||
:create-treenode
|
:create-treenode
|
||||||
:download-treenode
|
:download-treenode
|
||||||
:upload-treenode
|
:upload-treenode
|
||||||
|
:recursive-delete-node
|
||||||
:filesystem-query-treenode
|
:filesystem-query-treenode
|
||||||
:mark-node
|
:mark-node
|
||||||
:resync-rows-db
|
:resync-rows-db
|
||||||
@ -2804,7 +2806,9 @@
|
|||||||
:file-explorer-go-down
|
:file-explorer-go-down
|
||||||
:file-explorer-go-up
|
:file-explorer-go-up
|
||||||
:file-explorer-search
|
:file-explorer-search
|
||||||
:file-explorer-mark-entry))
|
:file-explorer-mark-entry
|
||||||
|
:file-explorer-delete-tree
|
||||||
|
:file-explorer-delete-marked))
|
||||||
|
|
||||||
(defpackage :scheduled-events
|
(defpackage :scheduled-events
|
||||||
(:use
|
(:use
|
||||||
|
@ -2550,5 +2550,39 @@ printed, on the main window."
|
|||||||
(path (fstree:tree-path fields)))
|
(path (fstree:tree-path fields)))
|
||||||
(with-enqueued-process ()
|
(with-enqueued-process ()
|
||||||
(fstree:mark-node win path)
|
(fstree:mark-node win path)
|
||||||
|
(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:win-clear win)
|
||||||
(windows:draw 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