diff --git a/etc/init.lisp b/etc/init.lisp index 3a7f5c1..c56abd9 100644 --- a/etc/init.lisp +++ b/etc/init.lisp @@ -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 diff --git a/src/filesystem-tree-window.lisp b/src/filesystem-tree-window.lisp index fdb5ff2..5a1cefe 100644 --- a/src/filesystem-tree-window.lisp +++ b/src/filesystem-tree-window.lisp @@ -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)) diff --git a/src/filesystem-utils.lisp b/src/filesystem-utils.lisp index 553623e..0f95b4f 100644 --- a/src/filesystem-utils.lisp +++ b/src/filesystem-utils.lisp @@ -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) diff --git a/src/package.lisp b/src/package.lisp index 36da583..d6fae91 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -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)) diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index e6b0f7b..59343ea 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -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*)