branch: elpa/hyperdrive
commit 047abe89e265ac8e52ddb8a20c11ebc92c00b76d
Merge: 4c5fc6ca76 3fff771e5c
Author: Joseph Turner <jos...@ushin.org>
Commit: Joseph Turner <jos...@ushin.org>
Merge: Show how much of a file is downloaded in directory view
Also, move entry filling logic into he//api-then to avoid having to
invoke h//fill in the callback of all requests which download a file
or clear its blob from the local cache.
---
CHANGELOG.org | 2 ++
doc/hyperdrive.org | 22 ++++++++++++++----
doc/hyperdrive.texi | 28 +++++++++++++++++++----
hyperdrive-dir.el | 17 +++++++++-----
hyperdrive-ewoc.el | 18 +++++++++++++++
hyperdrive-history.el | 13 ++++++++---
hyperdrive-lib.el | 62 ++++++++++++++++++++++++++++++++++-----------------
hyperdrive-vars.el | 11 ++++++++-
hyperdrive.el | 31 ++++++++++++--------------
9 files changed, 149 insertions(+), 55 deletions(-)
diff --git a/CHANGELOG.org b/CHANGELOG.org
index 8367842cce..a151fb59ad 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -31,6 +31,8 @@ space by "forgetting" your copy of a file
(~hyperdrive-forget-file~)!
- View hyperdrive disk usage with ~hyperdrive-describe~ and ~hyperdrive-menu~.
- Delete the local copy of a file or directory with
~hyperdrive-forget-file~, also bound in ~hyperdrive-menu~ and menu bar.
+- Indicate how much of a file has already been downloaded based on the
+ color of its file size in the directory view.
** Changed
diff --git a/doc/hyperdrive.org b/doc/hyperdrive.org
index 320fe36026..3d2bc7bfcf 100644
--- a/doc/hyperdrive.org
+++ b/doc/hyperdrive.org
@@ -221,9 +221,18 @@ hyperdrives you've already created or visited:
*** Directory view
-~hyperdrive.el~ offers a Dired-like (see [[info:emacs#Dired]]) interface for
-exploring hyperdrive directories. The following keybindings are
-available inside the directory view by default:
+~hyperdrive.el~ offers a Dired-like (see [[info:emacs#Dired]]) interface
+for exploring hyperdrive directories. In the directory view, the file
+size color indicates how much of a file you have already downloaded:
+
+- green :: fully downloaded (~hyperdrive-size-fully-downloaded~)
+- yellow :: partially downloaded (~hyperdrive-size-partially-downloaded~)
+- red :: not downloaded (~hyperdrive-size-not-downloaded~)
+
+Mouse over the file size to see exactly how many blocks make up the
+file and how many of them you have downloaded.
+
+The following bindings are available in the directory view by default:
#+attr_texinfo: :compact t
- Key: n (hyperdrive-ewoc-next) ::
@@ -463,6 +472,9 @@ This command also has a keybinding in the directory view
(see
** Forget a hyperdrive file
+*Please note that forgetting a file may result in data loss if it
+cannot be loaded from another peer on the network.*
+
It is possible to "forget" your local copy of a hyperdrive file in
order to save disk space. "Forgetting" a file does not delete the
file from the hyperdrive and does not increment the hyperdrive's
@@ -473,7 +485,9 @@ version number.
Delete your local copy of the file for the current buffer.
This command also has a keybinding in the directory view (see
-[[*Directory view]]).
+[[*Directory view]]). When you forget a file, the file size of its
+directory listing will turn red, indicating that you no longer have a
+copy of the file.
** View the hyperdrive version history
diff --git a/doc/hyperdrive.texi b/doc/hyperdrive.texi
index f787d9c931..73dceeb4d2 100644
--- a/doc/hyperdrive.texi
+++ b/doc/hyperdrive.texi
@@ -46,6 +46,7 @@ Repository: @uref{https://git.sr.ht/~ushin/hyperdrive.el}
@end itemize
This manual is for @code{hyperdrive.el} version 0.4-pre.
+
@end ifnottex
@menu
@@ -444,9 +445,23 @@ Like @code{hyperdrive-find-file}, but open the file in
@ref{View Mode,view-mode,
@node Directory view
@subsection Directory view
-@code{hyperdrive.el} offers a Dired-like (see @ref{Dired,,,emacs,}) interface
for
-exploring hyperdrive directories. The following keybindings are
-available inside the directory view by default:
+@code{hyperdrive.el} offers a Dired-like (see @ref{Dired,,,emacs,}) interface
+for exploring hyperdrive directories. In the directory view, the file
+size color indicates how much of a file you have already downloaded:
+
+@table @asis
+@item green
+fully downloaded (@code{hyperdrive-size-fully-downloaded})
+@item yellow
+partially downloaded (@code{hyperdrive-size-partially-downloaded})
+@item red
+not downloaded (@code{hyperdrive-size-not-downloaded})
+@end table
+
+Mouse over the file size to see exactly how many blocks make up the
+file and how many of them you have downloaded.
+
+The following bindings are available in the directory view by default:
@table @asis
@item @kbd{n} (@code{hyperdrive-ewoc-next})
@@ -737,6 +752,9 @@ This command also has a keybinding in the directory view
(see
@node Forget a hyperdrive file
@section Forget a hyperdrive file
+@strong{Please note that forgetting a file may result in data loss if it
+cannot be loaded from another peer on the network.}
+
It is possible to ``forget'' your local copy of a hyperdrive file in
order to save disk space. ``Forgetting'' a file does not delete the
file from the hyperdrive and does not increment the hyperdrive's
@@ -747,7 +765,9 @@ Delete your local copy of the file for the current buffer.
@end deffn
This command also has a keybinding in the directory view (see
-@ref{Directory view}).
+@ref{Directory view}). When you forget a file, the file size of its
+directory listing will turn red, indicating that you no longer have a
+copy of the file.
@node View the hyperdrive version history
@section View the hyperdrive version history
diff --git a/hyperdrive-dir.el b/hyperdrive-dir.el
index 2dd6b622d8..70397ada21 100644
--- a/hyperdrive-dir.el
+++ b/hyperdrive-dir.el
@@ -72,7 +72,6 @@ If THEN, call it in the directory buffer with no arguments."
(json-read-from-string body)
hyperdrive version))
(parent-entry (h/parent directory-entry)))
- (setf directory-entry (he//fill directory-entry headers))
(when parent-entry
(setf (alist-get 'display-name (he/etc parent-entry))
"../")
(push parent-entry entries))
@@ -160,16 +159,24 @@ To be used as the pretty-printer for `ewoc-create'."
(defun h/dir--format-entry (entry)
"Return ENTRY formatted as a string."
(pcase-let*
- (((cl-struct hyperdrive-entry size mtime) entry)
+ (((cl-struct hyperdrive-entry size mtime etc) entry)
(size (and size (file-size-human-readable size)))
(directoryp (h//entry-directory-p entry))
(face (if directoryp 'h/directory 'default))
(timestamp (if mtime
(format-time-string h/timestamp-format mtime)
- (propertize " " 'display '(space :width
h/timestamp-width)))))
+ (propertize " " 'display '(space :width
h/timestamp-width))))
+ ((map block-length block-length-downloaded) etc))
(format "%6s %s %s"
- (propertize (or size "")
- 'face 'h/size)
+ (propertize
+ (or size "")
+ 'face (and block-length-downloaded block-length
+ (pcase block-length-downloaded
+ (0 'h/size-not-downloaded)
+ ((pred (= block-length)) 'h/size-fully-downloaded)
+ (_ 'h/size-partially-downloaded)))
+ 'help-echo (format "%s of %s blocks downloaded"
+ block-length-downloaded block-length))
(propertize timestamp
'face 'h/timestamp)
(propertize (or (alist-get 'display-name (he/etc entry))
diff --git a/hyperdrive-ewoc.el b/hyperdrive-ewoc.el
index 10cc500663..d58e18e5ee 100644
--- a/hyperdrive-ewoc.el
+++ b/hyperdrive-ewoc.el
@@ -51,6 +51,24 @@ last node."
return node
do (setf node (ewoc-prev ewoc node))))
+(defun he//invalidate (entry)
+ "Invalidate the ewoc node for ENTRY in directory buffers."
+ (when-let* ((buffer (hyperdrive--find-buffer-visiting
+ (hyperdrive-parent entry)))
+ (ewoc (buffer-local-value 'h/ewoc buffer))
+ (node (and ewoc
+ (h/ewoc-find-node ewoc entry
+ :predicate #'he/equal-p))))
+ (when node
+ (ewoc-set-data node entry)
+ ;; NOTE: Ensure that the buffer's window is selected,
+ ;; if it has one. (Workaround a possible bug in EWOC.)
+ (if-let ((buffer-window (get-buffer-window (ewoc-buffer ewoc))))
+ (with-selected-window buffer-window
+ (with-silent-modifications (ewoc-invalidate ewoc node)))
+ (with-current-buffer (ewoc-buffer ewoc)
+ (with-silent-modifications (ewoc-invalidate ewoc node)))))))
+
;;;; Mode
(defvar-keymap h/ewoc-mode-map
diff --git a/hyperdrive-history.el b/hyperdrive-history.el
index b6caaeeeff..0cb074ea79 100644
--- a/hyperdrive-history.el
+++ b/hyperdrive-history.el
@@ -61,7 +61,7 @@ value \\+`unknown', and whose cdr is a hyperdrive entry."
(pcase-let*
((`(,range . ,entry) range-entry)
(`(,range-start . ,(map :range-end :existsp)) range)
- ((cl-struct hyperdrive-entry size mtime) entry)
+ ((cl-struct hyperdrive-entry size mtime etc) entry)
(formatted-range (if (eq range-start range-end)
(format "%d" range-start)
(format "%d-%d" range-start range-end)))
@@ -72,7 +72,8 @@ value \\+`unknown', and whose cdr is a hyperdrive entry."
(size (and size (file-size-human-readable size)))
(timestamp (if mtime
(format-time-string h/timestamp-format mtime)
- (propertize " " 'display '(space :width
h/timestamp-width)))))
+ (propertize " " 'display '(space :width
h/timestamp-width))))
+ ((map block-length block-length-downloaded) etc))
;; FIXME: Use dynamic width of range column equal to 2N+1, where N
;; is the width of the hyperdrive's latest version
(format
@@ -91,7 +92,13 @@ value \\+`unknown', and whose cdr is a hyperdrive entry."
('unknown "Load history at version %s"))
range-start))
(propertize (or size "")
- 'face 'h/size)
+ 'face (and block-length-downloaded block-length
+ (pcase block-length-downloaded
+ (0 'h/size-not-downloaded)
+ ((pred (= block-length))
'h/size-fully-downloaded)
+ (_ 'h/size-partially-downloaded)))
+ 'help-echo (format "%s of %s blocks downloaded"
+ block-length-downloaded block-length))
(propertize (or timestamp "")
'face 'h/timestamp))))
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index c750dbf0b4..1c3eac480c 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -74,7 +74,9 @@ Passes ARGS to `format-message'."
;; TODO: Consider adding gv-setters for etc slot keys
(etc nil :documentation "Alist for extra data about the entry.
- display-name :: Displayed in directory view instead of name.
-- target :: Link fragment to jump to."))
+- target :: Link fragment to jump to.
+- block-length :: Number of blocks file blob takes up.
+- block-length-downloaded :: Number of blocks downloaded for file."))
(cl-defstruct (hyperdrive (:constructor h/create)
(:copier nil))
@@ -228,8 +230,11 @@ Sets ENTRY's hyperdrive to the persisted version of the
drive if
it exists. Updates ENTRY's hyperdrive's disk usage and latest
version. Finally, persists ENTRY's hyperdrive."
(pcase-let*
- (((cl-struct plz-response
- (headers (map link allow x-drive-size x-drive-version)))
+ (((cl-struct
+ plz-response
+ (headers (map link allow content-length content-type last-modified
+ x-drive-size x-drive-version
+ x-file-block-length x-file-block-length-downloaded)))
response)
;; RESPONSE is guaranteed to have a "Link" header with the public key,
;; while ENTRY may have a DNSLink domain but no public key yet.
@@ -262,7 +267,30 @@ version. Finally, persists ENTRY's hyperdrive."
(string-to-number x-drive-version)))
;; TODO: Update buffers like h/describe-hyperdrive after updating drive.
;; TODO: Consider debouncing or something for hyperdrive-persist to
minimize I/O.
- (h/persist (he/hyperdrive entry))))
+ (h/persist (he/hyperdrive entry))
+
+ ;; Fill entry.
+ (when content-length
+ (setf (he/size entry)
+ (ignore-errors (cl-parse-integer content-length))))
+ (when content-type
+ (setf (he/type entry) content-type))
+ (when last-modified
+ (setf (he/mtime entry) (encode-time (parse-time-string last-modified))))
+ (when x-file-block-length
+ (setf (map-elt (he/etc entry) 'block-length)
+ (ignore-errors
+ (cl-parse-integer x-file-block-length))))
+ (when x-file-block-length-downloaded
+ (setf (map-elt (he/etc entry) 'block-length-downloaded)
+ (ignore-errors
+ (cl-parse-integer x-file-block-length-downloaded))))
+
+ ;; Redisplay entry.
+ (unless (h//entry-directory-p entry)
+ ;; There's currently never a reason to redisplay directory entries since
+ ;; they don't have block-length{,-downloaded} metadata.
+ (he//invalidate entry))))
(defun h/gateway-needs-upgrade-p ()
"Return non-nil if the gateway is responsive and needs upgraded."
@@ -708,24 +736,10 @@ the given `plz-queue'"
:noquery t))))
(defun he//fill (entry headers)
- "Fill ENTRY slots from HEADERS.
-
-- \\+`type'
-- \\+`mtime'
-- \\+`size'
-
-Also fills existent range in `hyperdrive-version-ranges'.
+ "Fill existent range for ENTRY in `hyperdrive-version-ranges' from HEADERS.
Returns filled ENTRY."
- (pcase-let*
- (((map content-length content-type etag last-modified) headers))
- (when last-modified
- (setf last-modified (encode-time (parse-time-string last-modified))))
- (setf (he/size entry) (and content-length
- (ignore-errors
- (cl-parse-integer content-length))))
- (setf (he/type entry) content-type)
- (setf (he/mtime entry) last-modified)
+ (pcase-let (((map etag) headers))
(when (and etag (not (h//entry-directory-p entry)))
;; Directory version ranges are not supported.
(h/update-existent-version-range entry (string-to-number etag)))
@@ -738,15 +752,21 @@ LISTING should be an alist based on the JSON retrieved
in, e.g.,
`hyperdrive-dir-handler'. Fills existent version ranges for each
entry as a side-effect."
(mapcar
- (pcase-lambda ((map seq key value))
+ (pcase-lambda ((map seq key value blockLengthDownloaded))
(let* ((mtime (map-elt (map-elt value 'metadata) 'mtime))
(size (map-elt (map-elt value 'blob) 'byteLength))
+ (block-length (map-elt (map-elt value 'blob) 'blockLength))
(entry (he/create
:hyperdrive hyperdrive :path key :version version)))
(when mtime ; mtime is milliseconds since epoch
(setf (he/mtime entry) (seconds-to-time (/ mtime 1000.0))))
(when size
(setf (he/size entry) size))
+ (when block-length
+ (setf (map-elt (he/etc entry) 'block-length) block-length))
+ (when blockLengthDownloaded
+ (setf (map-elt (he/etc entry) 'block-length-downloaded)
+ blockLengthDownloaded))
(when seq
;; seq is the hyperdrive version *before* the entry was added/modified
(hyperdrive-update-existent-version-range entry (1+ seq)))
diff --git a/hyperdrive-vars.el b/hyperdrive-vars.el
index 8102ffdb74..fc2ede7c43 100644
--- a/hyperdrive-vars.el
+++ b/hyperdrive-vars.el
@@ -314,6 +314,15 @@ value (and should only be present once in the string).
Used in
(defface h/size '((t (:inherit font-lock-doc-face)))
"File sizes.")
+(defface h/size-fully-downloaded '((t (:inherit success)))
+ "File sizes for entries which have been fully downloaded.")
+
+(defface h/size-not-downloaded '((t (:inherit error)))
+ "File sizes for entries which have not been downloaded.")
+
+(defface h/size-partially-downloaded '((t (:inherit warning)))
+ "File sizes for entries which have been partially downloaded.")
+
(defface h/timestamp '((t (:inherit default)))
"Entry timestamp.")
@@ -372,7 +381,7 @@ values are alists mapping version range starts to plists
with
;;;;; Internals
(defvar h/gateway-version-expected
- '(:name "hyper-gateway-ushin" :version "3.10.2"))
+ '(:name "hyper-gateway-ushin" :version "3.11.0"))
(defvar h/gateway-version-checked-p nil
"Non-nil if the gateway's version has been checked.
diff --git a/hyperdrive.el b/hyperdrive.el
index a29d43727b..d5d98e665f 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -201,8 +201,8 @@ modified; file blobs may be recoverable from other peers."
:headers '(("Cache-Control" . "no-store"))
:else (lambda (err)
(h/error "Unable to clear cache for `%s': %S" (he/url entry)
err))
- :then (lambda (_response)
- (h/message "Cleared `%s'" (h//format-entry entry))))))
+ ;; Make async; `he//api-then' will call `he//invalidate'.
+ :then #'ignore)))
;;;###autoload
(defun hyperdrive-purge (hyperdrive)
@@ -1384,24 +1384,21 @@ Intended for relative (i.e. non-full) URLs."
;;;;; Installation
(defvar h/gateway-urls-and-hashes
- ;; TODO: sr.ht build (<https://builds.sr.ht/~ushin/job/1247130#task-setup>)
- ;; fail due to a kernel issue: https://github.com/nodejs/node/issues/53051
'((gnu/linux
- ( :url
"https://codeberg.org/USHIN/hyper-gateway-ushin/releases/download/v3.10.2/hyper-gateway-ushin-linux";
- :sha256
"4a79a406ab8e6f8f9c4e47bd7f001c6673c81e1357c3977e0dddfac777a57204")
- ( :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.10.2/hyper-gateway-linux-v3.10.2";
- :sha256
"4a79a406ab8e6f8f9c4e47bd7f001c6673c81e1357c3977e0dddfac777a57204"))
+ ( :url
"https://codeberg.org/USHIN/hyper-gateway-ushin/releases/download/v3.11.0/hyper-gateway-ushin-linux";
+ :sha256
"2074ec69c3e699105e132e774996c15ba3d9f14019f0cf5bc1bd15c35f7524c7")
+ ( :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.11.0/hyper-gateway-linux-v3.11.0";
+ :sha256
"69d8ee0bc6442de9e57962bcf151febee6b93607907e846ba8ec5d2ad2605d38"))
(darwin
- ( :url
"https://codeberg.org/USHIN/hyper-gateway-ushin/releases/download/v3.10.2/hyper-gateway-ushin-macos";
- :sha256
"84ee621756dce98597f43b45942af812c9f3b200f31f769a53d077bf7e8b1156")
- ( :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.10.2/hyper-gateway-macos-v3.10.2";
- :sha256
"84ee621756dce98597f43b45942af812c9f3b200f31f769a53d077bf7e8b1156"))
+ ( :url
"https://codeberg.org/USHIN/hyper-gateway-ushin/releases/download/v3.11.0/hyper-gateway-ushin-macos";
+ :sha256
"219d673ea28dbc69f7cb5fbd5a01ed2b69f3f281f1e22f0d20e871c755eb02cf")
+ ( :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.11.0/hyper-gateway-macos-v3.11.0";
+ :sha256
"c7dd08005037e6b27aafffe79d70255179a1c95a4699ba227d4b79f18badf38b"))
(windows-nt
- ( :url
"https://codeberg.org/USHIN/hyper-gateway-ushin/releases/download/v3.10.2/hyper-gateway-ushin-windows.exe";
- :sha256
"691105d1657627d2ac5e56b6b598ce3572beaa601663a55a86135b8cd1c6657d")
- ;; ( :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.10.2/hyper-gateway-windows-v3.10.2.exe";
- ;; :sha256 "")
- ))
+ ( :url
"https://codeberg.org/USHIN/hyper-gateway-ushin/releases/download/v3.11.0/hyper-gateway-ushin-windows.exe";
+ :sha256
"1e4e303766e1043355d27387e487e4296c03a3d6877d5920c6ae4c12d80f7bd4")
+ ( :url
"https://git.sr.ht/~ushin/hyper-gateway-ushin/refs/download/v3.11.0/hyper-gateway-windows-v3.11.0.exe";
+ :sha256
"69277b1748d16d274644151a1c7dbcaa7290689ae44f79ffba94a29f77978f4b")))
"Alist mapping `system-type' to URLs where the gateway can be downloaded.")
;;;###autoload
