mirror of
https://codeberg.org/cage/tinmop/
synced 2025-02-11 07:30:34 +01:00
- implemented creating paths in filesystem window.
This commit is contained in:
parent
af48cde4a8
commit
9fa4b72548
@ -604,10 +604,14 @@
|
||||
|
||||
(define-key "d" #'file-explorer-delete-path *filesystem-explorer-keymap*)
|
||||
|
||||
(define-key "a" #'file-explorer-create-path *filesystem-explorer-keymap*)
|
||||
|
||||
(define-key "up" #'file-explorer-go-up *filesystem-explorer-keymap*)
|
||||
|
||||
(define-key "down" #'file-explorer-go-down *filesystem-explorer-keymap*)
|
||||
|
||||
|
||||
|
||||
;;;; hooks
|
||||
|
||||
;; this module will install an hook to rewrite urls; By default it
|
||||
|
@ -47,13 +47,17 @@
|
||||
:initform #'expand-local-filesystem-node
|
||||
:accessor filesystem-expand-function
|
||||
:type function)
|
||||
(filesystem-rename-function
|
||||
(filesystem-rename-function
|
||||
:initform #'rename-local-filesystem-node
|
||||
:accessor filesystem-rename-function
|
||||
:type function)
|
||||
(filesystem-delete-function
|
||||
(filesystem-delete-function
|
||||
:initform #'delete-local-filesystem-node
|
||||
:accessor filesystem-delete-function
|
||||
:type function)
|
||||
(filesystem-create-function
|
||||
:initform #'create-local-filesystem-node
|
||||
:accessor filesystem-create-function
|
||||
:type function))
|
||||
(:documentation "A window that shows and allow intercating with a hierarchical filesystem"))
|
||||
|
||||
@ -116,6 +120,12 @@
|
||||
(make-instance 'm-tree :data (make-node-data file nil)))))
|
||||
matching-node)))
|
||||
|
||||
(defun create-local-filesystem-node (path dirp)
|
||||
(assert path)
|
||||
(if dirp
|
||||
(fs:make-directory path)
|
||||
(fs:create-a-file path)))
|
||||
|
||||
(defun rename-local-filesystem-node (matching-node new-path)
|
||||
(let ((path (tree-path (data matching-node))))
|
||||
(assert path)
|
||||
@ -270,6 +280,15 @@
|
||||
(win-clear window :redraw nil)
|
||||
(resync-rows-db window :redraw t :selected-path path)))
|
||||
|
||||
(defun create-treenode (window path dirp)
|
||||
(when-let* ((root-node (filesystem-root window))
|
||||
(parent-node (find-node root-node (fs:parent-dir-path path))))
|
||||
(funcall (filesystem-create-function window) path dirp)
|
||||
(remove-all-children parent-node)
|
||||
(expand-treenode window (tree-path (data parent-node)))
|
||||
(win-clear window :redraw nil)
|
||||
(resync-rows-db window :redraw t :selected-path path)))
|
||||
|
||||
(defmethod draw :after ((object filesystem-tree-window))
|
||||
(when-window-shown (object)
|
||||
(let* ((window-width (usable-window-width object))
|
||||
|
@ -39,6 +39,9 @@
|
||||
out)
|
||||
nil))
|
||||
|
||||
(defun create-a-file (path)
|
||||
(open path :direction :probe :if-does-not-exist :create))
|
||||
|
||||
(defun rename-a-file (old new)
|
||||
(nix:rename old new))
|
||||
|
||||
@ -95,6 +98,10 @@
|
||||
(let ((re (concatenate 'string ext "$")))
|
||||
(cl-ppcre:scan re path)))
|
||||
|
||||
(defun extension-dir-p (path)
|
||||
(let ((re (concatenate 'string *directory-sep-regexp* "$")))
|
||||
(cl-ppcre:scan re path)))
|
||||
|
||||
(defun strip-extension (file &key (strip-all nil))
|
||||
(let ((new (cl-ppcre:regex-replace "(?i)[a-z0-9]\\.[^.]+$" file "")))
|
||||
(if (string= file new)
|
||||
|
@ -272,6 +272,7 @@
|
||||
:+s-isgid+
|
||||
:*directory-sep-regexp*
|
||||
:*directory-sep*
|
||||
:create-a-file
|
||||
:copy-a-file
|
||||
:rename-a-file
|
||||
:file-size
|
||||
@ -281,6 +282,7 @@
|
||||
:cat-parent-dir
|
||||
:has-extension
|
||||
:get-extension
|
||||
:extension-dir-p
|
||||
:strip-extension
|
||||
:add-extension
|
||||
:do-directory
|
||||
@ -2029,6 +2031,7 @@
|
||||
:expand-treenode
|
||||
:rename-treenode
|
||||
:delete-treenode
|
||||
:create-treenode
|
||||
:resync-rows-db
|
||||
:init))
|
||||
|
||||
@ -2787,6 +2790,7 @@
|
||||
:file-explorer-close
|
||||
:file-explorer-rename
|
||||
:file-explorer-delete-path
|
||||
:file-explorer-create-path
|
||||
:file-explorer-go-down
|
||||
:file-explorer-go-up))
|
||||
|
||||
|
@ -2453,12 +2453,27 @@ printed, on the main window."
|
||||
(fields (line-oriented-window:selected-row-fields win))
|
||||
(path (fstree:tree-path fields)))
|
||||
(flet ((on-input-complete (new-path)
|
||||
(with-enqueued-process ()
|
||||
(fstree:rename-treenode win path new-path))))
|
||||
(when (string-not-empty-p new-path)
|
||||
(with-enqueued-process ()
|
||||
(fstree:rename-treenode win path new-path)))))
|
||||
(ask-string-input #'on-input-complete
|
||||
:prompt
|
||||
(format nil (_ "rename ~a to: ") path)))))
|
||||
|
||||
(defun file-explorer-create-path ()
|
||||
"create a file or directory"
|
||||
(when-let* ((win *filesystem-explorer-window*)
|
||||
(fields (line-oriented-window:selected-row-fields win))
|
||||
(path (fstree:tree-path fields)))
|
||||
(flet ((on-input-complete (new-path)
|
||||
(when (string-not-empty-p new-path)
|
||||
(with-enqueued-process ()
|
||||
(let ((dirp (fs:extension-dir-p new-path)))
|
||||
(fstree:create-treenode win new-path dirp))))))
|
||||
(ask-string-input #'on-input-complete
|
||||
:prompt (_ "create: ")
|
||||
:initial-value path))))
|
||||
|
||||
(defun file-explorer-move (amount)
|
||||
(ignore-errors
|
||||
(line-oriented-window:unselect-all *filesystem-explorer-window*)
|
||||
|
Loading…
x
Reference in New Issue
Block a user