- implemented uploading file in filesystem window.

etc/init.lisp

@@ -608,6 +608,8 @@
 
 (define-key "d"         #'file-explorer-download-path *filesystem-explorer-keymap*)
 
+(define-key "u"         #'file-explorer-upload-path   *filesystem-explorer-keymap*)
+
 (define-key "up"        #'file-explorer-go-up         *filesystem-explorer-keymap*)
 
 (define-key "down"      #'file-explorer-go-down       *filesystem-explorer-keymap*)

src/filesystem-tree-window.lisp

@@ -62,8 +62,12 @@
    (filesystem-download-function
     :initform  #'download-local-filesystem-node
     :accessor  filesystem-download-function
+    :type      function)
+   (filesystem-upload-function
+    :initform  #'upload-local-filesystem-node
+    :accessor  filesystem-upload-function
     :type      function))
-  (:documentation "A window that shows and allow intercating with a hierarchical filesystem"))
+  (:documentation "A window that shows and allow interacting with a hierarchical filesystem"))
 
 (defmethod refresh-config :after ((object filesystem-tree-window))
   (with-croatoan-window (croatoan-window object)
@@ -87,9 +91,7 @@
 
 (gen-tree-data-fetcher dir-p :dirp)
 
-(gen-tree-data-fetcher rename-to :rename-to)
-
-(gen-tree-data-fetcher delete :delete)
+(gen-tree-data-fetcher marked-p :markedp)
 
 (defun build-data-for-print (data)
   (tree-path data))
@@ -164,6 +166,25 @@
                    (return-from write-loop t))))))
   destination-file)
 
+(defun upload-local-filesystem-node (source-path matching-node)
+  (with-open-file (input-stream source-path
+                                :direction    :input
+                                :element-type +octect-type+)
+    (with-open-file (output-stream (tree-path (data matching-node))
+                                   :direction         :output
+                                   :if-exists         :error
+                                   :if-does-not-exist :create
+                                   :element-type      +octect-type+)
+      (let* ((buffer (misc:make-array-frame +download-buffer+ 0 '(unsigned-byte 8) t)))
+        (loop named write-loop
+              for read-so-far = (read-sequence buffer input-stream)
+                then (read-sequence buffer input-stream)
+              do
+                 (write-sequence buffer output-stream :start 0 :end read-so-far)
+                 (when (< read-so-far +download-buffer+)
+                   (return-from write-loop t))))))
+  (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)
@@ -323,6 +344,18 @@
               (matching-node (find-node root-node remote-path)))
     (funcall (filesystem-download-function window) matching-node destination-file)))
 
+(defun upload-treenode (window source-file remote-path)
+  (when-let* ((root-node     (filesystem-root window))
+              (matching-node (find-node root-node remote-path))
+              (filep         (not (tree-dir-p (data matching-node))))
+              (parent-node   (find-node root-node (fs:parent-dir-path remote-path)))
+              (parent-path   (tree-path (data parent-node))))
+    (funcall (filesystem-download-function window) source-file matching-node)
+    (remove-all-children parent-node)
+    (expand-treenode window parent-path)
+    (win-clear window :redraw nil)
+    (resync-rows-db window :redraw t :selected-path parent-path)))
+
 (defmethod draw :after ((object filesystem-tree-window))
   (when-window-shown (object)
     (let* ((window-width  (usable-window-width object))

src/package.lisp

@@ -2033,6 +2033,7 @@
    :delete-treenode
    :create-treenode
    :download-treenode
+   :upload-treenode
    :resync-rows-db
    :init))
 
@@ -2791,6 +2792,8 @@
    :file-explorer-close-path
    :file-explorer-rename-path
    :file-explorer-download-path
+   :file-explorer-upload-path
+   :file-explorer-upload-path
    :file-explorer-delete-path
    :file-explorer-create-path
    :file-explorer-go-down

src/ui-goodies.lisp

@@ -2478,6 +2478,37 @@ printed, on the main window."
                         :prompt        (format nil (_ "download ~a to: ") path)
                         :initial-value output-file))))
 
+(defun file-explorer-upload-path ()
+  "Upload a file"
+  (when-let* ((win              *filesystem-explorer-window*)
+              (fields           (line-oriented-window:selected-row-fields win))
+              (destination-file (fstree:tree-path  fields)))
+    (labels ((build-actual-destination-file (source destination)
+               (if (fs:extension-dir-p destination)
+                   (fs:cat-parent-dir destination
+                                      (fs:path-last-element source))
+                   destination))
+             (on-input-complete (source-file)
+               (cond
+                 ((fs:dirp source-file)
+                  (error-message (format nil "~a is a directory" source-file)))
+                 ((not (fs:file-exists-p source-file))
+                  (error-message (format nil "~a does not exists" source-file)))
+                 (t
+                  (when (and (string-not-empty-p source-file)
+                             (not (fs:dirp destination-file)))
+                    (with-enqueued-process ()
+                      (with-blocking-notify-procedure
+                          ((format nil (_ "Staring upload of ~a") source-file)
+                           (format nil (_ "Upload completed in ~a") destination-file))
+                        (fstree:download-treenode win source-file
+                                                  (build-actual-destination-file source-file
+                                                                                 destination-file))
+                        (info-message destination-file))))))))
+      (ask-string-input #'on-input-complete
+                        :prompt        (_ "upload: ")
+                        :complete-fn #'complete:directory-complete))))
+
 (defun file-explorer-create-path ()
   "create a file or directory"
   (when-let* ((win    *filesystem-explorer-window*)