mirror of https://codeberg.org/cage/tinmop/
- implemented querying file's metadata in filesystem window.
This commit is contained in:
parent
429acc7efe
commit
c6f741d3a8
|
@ -66,7 +66,14 @@
|
|||
(filesystem-upload-function
|
||||
:initform #'upload-local-filesystem-node
|
||||
:accessor filesystem-upload-function
|
||||
:type function))
|
||||
:type function)
|
||||
(filesystem-query-path-function
|
||||
:initform #'query-local-filesystem-path
|
||||
:accessor filesystem-query-path-function
|
||||
:type function
|
||||
:documentation "function with two parameter the path and a feature to query
|
||||
Valid feature vaule are :size.
|
||||
Returns nil if Returns nil if the path does not point to an actual file."))
|
||||
(:documentation "A window that shows and allow interacting with a hierarchical filesystem"))
|
||||
|
||||
(defmethod refresh-config :after ((object filesystem-tree-window))
|
||||
|
@ -105,6 +112,14 @@
|
|||
(bgcolor window)
|
||||
(fgcolor window)))
|
||||
|
||||
(defun query-local-filesystem-path (path what)
|
||||
(case what
|
||||
(:size
|
||||
(and (fs:file-exists-p path)
|
||||
(fs:file-size path)))
|
||||
(otherwise
|
||||
nil)))
|
||||
|
||||
(defun expand-local-filesystem-node (matching-node)
|
||||
(let ((path (tree-path (data matching-node))))
|
||||
(assert path)
|
||||
|
@ -356,6 +371,23 @@
|
|||
(win-clear window :redraw nil)
|
||||
(resync-rows-db window :redraw t :selected-path parent-path)))
|
||||
|
||||
(defun filesystem-query-treenode (window path what)
|
||||
(assert (member what '(:size)))
|
||||
(when-let* ((root-node (filesystem-root window))
|
||||
(matching-node (find-node root-node path))
|
||||
(filep (not (tree-dir-p (data matching-node))))
|
||||
(octects (funcall (filesystem-query-path-function window)
|
||||
(tree-path (data matching-node))
|
||||
what)))
|
||||
(flet ((to-string (octects-data units)
|
||||
(multiple-value-bind (size unit-measurement)
|
||||
(fs:octects->units octects-data units)
|
||||
(format nil "~,2f~a" size unit-measurement))))
|
||||
(values octects
|
||||
(to-string octects :kib)
|
||||
(to-string octects :mib)
|
||||
(to-string octects :gib)))))
|
||||
|
||||
(defmethod search-row ((object filesystem-tree-window) regex &key (redraw t))
|
||||
(handler-case
|
||||
(with-accessors ((row-selected-index row-selected-index)) object
|
||||
|
|
|
@ -477,3 +477,15 @@
|
|||
(flet ((strip (a) (strip-dirs-from-path (pathname->namestring a))))
|
||||
(string= (strip a)
|
||||
(strip b))))
|
||||
|
||||
(define-constant +file-size-units+ '("KiB" "MiB" "GiB") :test #'equalp)
|
||||
|
||||
(defun octects->units (octects units)
|
||||
(let* ((exponent (case units
|
||||
(:kib 1)
|
||||
(:mib 2)
|
||||
(:gib 3)
|
||||
(otherwise 1)))
|
||||
(scaled (/ octects (expt 1024 exponent))))
|
||||
(values scaled
|
||||
(elt +file-size-units+ (1- exponent)))))
|
||||
|
|
|
@ -331,7 +331,8 @@
|
|||
:pathname->namestring
|
||||
:namestring->pathname
|
||||
:read-single-form
|
||||
:eq-filename))
|
||||
:eq-filename
|
||||
:octects->units))
|
||||
|
||||
(defpackage :os-utils
|
||||
(:use
|
||||
|
@ -2035,6 +2036,7 @@
|
|||
:create-treenode
|
||||
:download-treenode
|
||||
:upload-treenode
|
||||
:filesystem-query-treenode
|
||||
:resync-rows-db
|
||||
:init))
|
||||
|
||||
|
|
Loading…
Reference in New Issue