branch: elpa/hyperdrive
commit bd3e8c90ef19e1a8436af6310bfebfa534e6bb7a
Merge: 081513c89a 8d06964e22
Author: Adam Porter <a...@alphapapa.net>
Commit: Adam Porter <a...@alphapapa.net>
Merge branch 'wip/history-fill-version-ranges-2'
---
.dir-locals.el | 2 +-
CHANGELOG.org | 1 +
doc/hyperdrive-manual.org | 10 +-
hyperdrive-diff.el | 2 +-
hyperdrive-dir.el | 2 +-
hyperdrive-history.el | 163 ++++++++++++++++++---------------
hyperdrive-lib.el | 227 ++++++++++++++++++++++++++++------------------
hyperdrive-mirror.el | 4 +-
hyperdrive-vars.el | 6 +-
hyperdrive.el | 7 +-
10 files changed, 250 insertions(+), 174 deletions(-)
diff --git a/.dir-locals.el b/.dir-locals.el
index c0c599d519..daf8a568ac 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,4 +1,4 @@
;;; Directory Local Variables -*- no-byte-compile: t -*-
;;; For more information see (info "(emacs) Directory Variables")
-((nil . ((ispell-buffer-session-localwords . ("dir" "hypercore" "hyperdrive"
"hyperdrives" "hyperdrive's" "args" "systemd" "minibuffer" "petname" "petnames"
"org" "plist" "plists" "alist" "alists" "existsp" "ETag" "streamable" "DNSLink"
"ewoc" "struct" "ENTRY's" "localhost" "imenu" "mtime" "accessor")))))
+((nil . ((ispell-buffer-session-localwords . ("dir" "hypercore" "hyperdrive"
"hyperdrives" "hyperdrive's" "args" "systemd" "minibuffer" "petname" "petnames"
"org" "plist" "plists" "alist" "alists" "existsp" "ETag" "streamable" "DNSLink"
"ewoc" "struct" "ENTRY's" "localhost" "imenu" "mtime" "accessor" "http"
"prepended" "prepend" "hostname" "whitespace" "namespace" "filesystem"
"hostnames" "subdirectories" "unsets")))))
diff --git a/CHANGELOG.org b/CHANGELOG.org
index 084118cd00..525f2eed72 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -19,6 +19,7 @@ This project adheres to
[[https://semver.org/spec/v2.0.0.html][Semantic Versioni
- ~hyperdrive-version-ranges~ is now persisted, speeding up
~hyperdrive-history~
- Fewer buffers are created by default (see ~hyperdrive-reuse-buffers~)
- ~hyperdrive-mode~ keybindings now work when viewing =hyper://= files in EWW
+- History buffer displays right away; press ~+~ to load an unknown range
** Fixed
diff --git a/doc/hyperdrive-manual.org b/doc/hyperdrive-manual.org
index d79c6a7141..36f5ed8423 100644
--- a/doc/hyperdrive-manual.org
+++ b/doc/hyperdrive-manual.org
@@ -296,6 +296,8 @@ For an explanation of the history buffer, see [[*Partial
version data]].
The following keybindings are available inside the directory view by
default:
+#+kindex: hyperdrive-history-fill-version-ranges
+- ~+~ loads version history for unknown ranges
#+kindex: hyperdrive-history-find-file
- ~RET~ opens the file at the start of the range at point
#+kindex: hyperdrive-history-view-file
@@ -498,10 +500,14 @@ DIRECTION being one of ~:ascending~ or ~:descending~.
URLs externally. Default uses [[https://mpv.io/][mpv]]. There also exists a
preconfigured
option for [[https://www.videolan.org/vlc/][VLC media player]].
-#+vindex: hyperdrive-queue-size
-- ~hyperdrive-queue-size~ :: Default number of request sent to
+#+vindex: hyperdrive-queue-limit
+- ~hyperdrive-queue-limit~ :: Default number of request sent to
~hyper-gateway~ at a time in a queues. Defaults to ~20~.
+#+vindex: hyperdrive-fill-version-ranges-limit
+- ~hyperdrive-queue-limit~ :: Default maximum number of requests when
+ filling version history. Defaults to ~10~.
+
#+vindex: hyperdrive-render-html
- ~hyperdrive-render-html~ :: Control how HTML hyperdrive files are
displayed. By default, HTML pages are rendered in Emacs with
[[info:eww#Top][EWW]]. If
diff --git a/hyperdrive-diff.el b/hyperdrive-diff.el
index fe0161efbd..ed4954b916 100644
--- a/hyperdrive-diff.el
+++ b/hyperdrive-diff.el
@@ -66,7 +66,7 @@ This function is intended to diff files, not directories."
(let* (old-response
new-response
(queue (make-plz-queue
- :limit hyperdrive-queue-size
+ :limit hyperdrive-queue-limit
:finally (lambda ()
(unless (or old-response new-response)
(hyperdrive-error "Files non-existent"))
diff --git a/hyperdrive-dir.el b/hyperdrive-dir.el
index 2798e8bafa..0d427dc6d2 100644
--- a/hyperdrive-dir.el
+++ b/hyperdrive-dir.el
@@ -81,7 +81,7 @@ the metadata has been loaded."
metadata-queue (make-plz-queue
;; Experimentation seems to show that a
;; queue size of about 20 performs best.
- :limit hyperdrive-queue-size
+ :limit hyperdrive-queue-limit
:finally (lambda ()
(with-current-buffer (ewoc-buffer
ewoc)
(with-silent-modifications
diff --git a/hyperdrive-history.el b/hyperdrive-history.el
index 160e631a23..f2c83ceb9d 100644
--- a/hyperdrive-history.el
+++ b/hyperdrive-history.el
@@ -119,6 +119,7 @@ and ENTRY's version are nil."
"RET" #'hyperdrive-history-find-file
"v" #'hyperdrive-history-view-file
"=" #'hyperdrive-history-diff
+ "+" #'hyperdrive-history-fill-version-ranges
"w" #'hyperdrive-history-copy-url
"d" #'hyperdrive-history-download-file)
@@ -149,75 +150,89 @@ Universal prefix argument \\[universal-argument] forces
hyperdrive-current-entry)))
;; TODO: Highlight range for ENTRY
(when (hyperdrive--entry-directory-p entry)
- (hyperdrive-user-error "Directory history not yet implemented"))
- (hyperdrive-fill-version-ranges entry :then
- (lambda ()
- (pcase-let* (((cl-struct hyperdrive-entry hyperdrive path) entry)
- (range-entries
- (mapcar (lambda (range)
- ;; Some entries may not exist at
- ;; `range-start', as in the version before
- ;; it was created. See manual:
- ;; [[info:hyperdrive-manual.info#Versioning]]
- (cons range
- (hyperdrive-entry-create
- :hyperdrive hyperdrive
- :path path
- ;; Set version to range-start
- :version (car range))))
- ;; Display in reverse chronological order
- (nreverse (hyperdrive-entry-version-ranges-no-gaps
entry))))
- (main-header (hyperdrive-entry-description entry
:with-version nil))
- (header (concat main-header "\n"
- (format "%7s %13s %6s %s"
- (propertize "Exists?" 'face
'hyperdrive-column-header)
- (propertize "Version Range" 'face
'hyperdrive-column-header)
- (propertize "Size" 'face
'hyperdrive-column-header)
- (format (format "%%%ds"
hyperdrive-timestamp-width)
- (propertize "Last Modified"
'face 'hyperdrive-column-header)))))
- (queue) (ewoc))
- (with-current-buffer (get-buffer-create
- (format "*Hyperdrive-history: %s %s*"
- (hyperdrive--format-host hyperdrive
:format hyperdrive-default-host-format
- :with-label t)
- (url-unhex-string path)))
- (with-silent-modifications
- (hyperdrive-history-mode)
- (setq-local hyperdrive-current-entry entry)
- (setf ewoc hyperdrive-ewoc) ; Bind this for the hyperdrive-fill
lambda.
- (ewoc-filter hyperdrive-ewoc #'ignore)
- (erase-buffer)
- (ewoc-set-hf hyperdrive-ewoc header "")
- (mapc (lambda (range-entry)
- (ewoc-enter-last hyperdrive-ewoc range-entry))
- range-entries))
- ;; TODO: Display files in pop-up window, like magit-diff buffers
appear when selected from magit-log
- (display-buffer (current-buffer)
hyperdrive-history-display-buffer-action)
- (setf queue (make-plz-queue :limit hyperdrive-queue-size
- :finally (lambda ()
- ;; 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
- ;; TODO: Use
`ewoc-invalidate' on individual entries
- ;; (maybe later, as
performance comes to matter more).
-
(with-silent-modifications (ewoc-refresh hyperdrive-ewoc))
- (goto-char (point-min)))
- (with-current-buffer
(ewoc-buffer ewoc)
-
(with-silent-modifications (ewoc-refresh hyperdrive-ewoc))
- (goto-char (point-min))))
- ;; TODO: Accept then argument?
- ;; (with-current-buffer
(ewoc-buffer ewoc)
- ;; (when then
- ;; (funcall then)))
- )))
- (mapc (lambda (range-entry)
- (when (eq t (hyperdrive-range-entry-exists-p range-entry))
- ;; TODO: Handle failures?
- (hyperdrive-fill (cdr range-entry) :queue queue :then
#'ignore)))
- range-entries)
- (set-buffer-modified-p nil)
- (goto-char (point-min)))))))
+ (hyperdrive-user-error "Directory history not implemented"))
+ (pcase-let* (((cl-struct hyperdrive-entry hyperdrive path) entry)
+ (range-entries
+ (mapcar (lambda (range)
+ ;; Some entries may not exist at `range-start',
+ ;; as in the version before it was created, see:
+ ;; (info "(hyperdrive)Versioning")
+ (cons range
+ (hyperdrive-entry-create
+ :hyperdrive hyperdrive
+ :path path
+ ;; Set version to range-start
+ :version (car range))))
+ ;; Display in reverse chronological order
+ (nreverse (hyperdrive-entry-version-ranges-no-gaps
entry))))
+ (main-header (hyperdrive-entry-description entry :with-version
nil))
+ (header (concat main-header "\n"
+ (format "%7s %13s %6s %s"
+ (propertize "Exists?" 'face
'hyperdrive-column-header)
+ (propertize "Version Range" 'face
'hyperdrive-column-header)
+ (propertize "Size" 'face
'hyperdrive-column-header)
+ (format (format "%%%ds"
hyperdrive-timestamp-width)
+ (propertize "Last Modified"
'face 'hyperdrive-column-header)))))
+ (queue) (ewoc))
+ (with-current-buffer (get-buffer-create
+ (format "*Hyperdrive-history: %s %s*"
+ (hyperdrive--format-host hyperdrive :format
hyperdrive-default-host-format
+ :with-label t)
+ (url-unhex-string path)))
+ (with-silent-modifications
+ (hyperdrive-history-mode)
+ (setq-local hyperdrive-current-entry entry)
+ (setf ewoc hyperdrive-ewoc) ; Bind this for the hyperdrive-fill lambda.
+ (ewoc-filter hyperdrive-ewoc #'ignore)
+ (erase-buffer)
+ (ewoc-set-hf hyperdrive-ewoc header "")
+ (mapc (lambda (range-entry)
+ (ewoc-enter-last hyperdrive-ewoc range-entry))
+ range-entries))
+ ;; TODO: Display files in pop-up window, like magit-diff buffers appear
when selected from magit-log
+ (display-buffer (current-buffer)
hyperdrive-history-display-buffer-action)
+ (setf queue (make-plz-queue :limit hyperdrive-queue-limit
+ :finally (lambda ()
+ ;; 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
+ ;; TODO: Use
`ewoc-invalidate' on individual entries
+ ;; (maybe later, as
performance comes to matter more).
+ (with-silent-modifications
(ewoc-refresh hyperdrive-ewoc))
+ (goto-char (point-min)))
+ (with-current-buffer
(ewoc-buffer ewoc)
+ (with-silent-modifications
(ewoc-refresh hyperdrive-ewoc))
+ (goto-char (point-min))))
+ ;; TODO: Accept then argument?
+ ;; (with-current-buffer
(ewoc-buffer ewoc)
+ ;; (when then
+ ;; (funcall then)))
+ )))
+ (mapc (lambda (range-entry)
+ (when (eq t (hyperdrive-range-entry-exists-p range-entry))
+ ;; TODO: Handle failures?
+ (hyperdrive-fill (cdr range-entry) :queue queue :then
#'ignore)))
+ range-entries)
+ (set-buffer-modified-p nil)
+ (goto-char (point-min)))))
+
+;; TODO: Add pcase-defmacro for destructuring range-entry
+(defun hyperdrive-history-fill-version-ranges (range-entry)
+ "Fill version ranges starting from RANGE-ENTRY at point."
+ (interactive (list (hyperdrive-history-range-entry-at-point)))
+ (pcase-let* ((`(,range . ,entry) range-entry)
+ (`(,_range-start . ,(map (:range-end range-end))) range)
+ (range-end-entry (hyperdrive-copy-tree entry))
+ (ov (make-overlay (pos-bol) (+ (pos-bol) (length "Loading")))))
+ (setf (hyperdrive-entry-version range-end-entry) range-end)
+ (overlay-put ov 'display "Loading")
+ (hyperdrive-fill-version-ranges range-end-entry
+ :finally (lambda ()
+ ;; TODO: Should we open the history buffer for entry
+ ;; or range-end-entry or...?
+ (delete-overlay ov)
+ (hyperdrive-history entry)))))
(declare-function hyperdrive-diff-file-entries "hyperdrive-diff")
(defun hyperdrive-history-diff (old-entry new-entry)
@@ -254,9 +269,8 @@ buffer."
;; Known to not exist: warn user.
(hyperdrive-user-error "File does not exist!"))
('unknown
- ;; Not known to exist: prompt user
- ;; TODO: Design options
- (hyperdrive-message "File not known to exist. What do you want to do?"))))
+ ;; Not known to exist: fill version ranges:
+ (hyperdrive-history-fill-version-ranges range-entry))))
(declare-function hyperdrive-view-file "hyperdrive")
(defun hyperdrive-history-view-file (range-entry)
@@ -276,9 +290,8 @@ buffer."
;; Known to not exist: warn user.
(hyperdrive-user-error "File does not exist!"))
('unknown
- ;; Not known to exist: prompt user
- ;; TODO: Design options
- (hyperdrive-message "File not known to exist. What do you want to do?"))))
+ ;; Not known to exist: fill version ranges:
+ (hyperdrive-history-fill-version-ranges range-entry))))
(declare-function hyperdrive-copy-url "hyperdrive")
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index 62edca6ec7..82fa36be69 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -323,18 +323,21 @@ Intended to be used as hash table key in
`hyperdrive-version-ranges'."
hyperdrive-version-ranges)
(persist-save 'hyperdrive-version-ranges))
-(defun hyperdrive-entry-version-range (entry)
+(cl-defun hyperdrive-entry-version-range (entry &key version)
"Return the version range containing ENTRY.
-Returns nil when ENTRY is not known to exist at its version."
+Returns nil when ENTRY is not known to exist at its version.
+
+With non-nil VERSION, use it instead of ENTRY's version."
+ (declare (indent defun))
(pcase-let* (((cl-struct hyperdrive-entry hyperdrive (version
entry-version)) entry)
- (version (or entry-version (hyperdrive-latest-version
hyperdrive)))
+ (version (or version entry-version (hyperdrive-latest-version
hyperdrive)))
(ranges (hyperdrive-entry-version-ranges entry)))
(when ranges
(cl-find-if (pcase-lambda (`(,range-start . ,(map (:range-end
range-end))))
(<= range-start version range-end))
ranges))))
-(defun hyperdrive-entry-exists-p (entry)
+(cl-defun hyperdrive-entry-exists-p (entry &key version)
"Return status of ENTRY's existence at its version.
- t :: ENTRY is known to exist.
@@ -342,8 +345,9 @@ Returns nil when ENTRY is not known to exist at its
version."
- unknown :: ENTRY is not known to exist.
Does not make a request to the gateway; checks the cached value
-in `hyperdrive-version-ranges'."
- (if-let ((range (hyperdrive-entry-version-range entry)))
+in `hyperdrive-version-ranges'.
+With non-nil VERSION, use it instead of ENTRY's version."
+ (if-let ((range (hyperdrive-entry-version-range entry :version version)))
(pcase-let ((`(,_range-start . ,(map (:existsp existsp))) range))
existsp)
'unknown))
@@ -379,18 +383,33 @@ hyperdrive's latest-version slot, the final gap is
filled."
(push `(,(1+ final-known-range-end) . (:range-end ,latest-version ,
:existsp unknown)) ranges)))
(nreverse ranges)))
-(defun hyperdrive-entry-previous (entry)
+(cl-defun hyperdrive-entry-previous (entry &key cache-only)
"Return ENTRY at its hyperdrive's previous version, or nil.
-If ENTRY is a directory, return a copy with decremented version."
+If ENTRY is a directory, return a copy with decremented version.
+If CACHE-ONLY, don't send a request to the gateway; only check
+`hyperdrive-version-ranges'. In this case, return value may also
+be \\+`unknown'."
(if (hyperdrive--entry-directory-p entry)
(pcase-let* (((cl-struct hyperdrive-entry hyperdrive path version) entry)
(version (or version (hyperdrive-latest-version
hyperdrive))))
(when (> version 1)
(hyperdrive-entry-create :hyperdrive hyperdrive :path path :version
(1- version))))
- (when-let ((previous-entry (hyperdrive-entry-at (1- (car
(hyperdrive-entry-version-range entry))) entry)))
- ;; Entry version is currently its range end, but it should be its
version range start.
- (setf (hyperdrive-entry-version previous-entry) (car
(hyperdrive-entry-version-range previous-entry)))
- previous-entry)))
+ (let ((previous-version (1- (car (hyperdrive-entry-version-range entry)))))
+ (pcase-exhaustive (hyperdrive-entry-version-range entry :version
previous-version)
+ (`(,range-start . ,(map (:existsp existsp)))
+ (if existsp
+ ;; Return entry if it's known existent.
+ (hyperdrive-entry-at range-start entry)
+ ;; Return nil if it's known nonexistent.
+ nil))
+ ('nil
+ ;; Entry is not known to exist, optionally send a request.
+ (if cache-only
+ 'unknown
+ (when-let ((previous-entry (hyperdrive-entry-at previous-version
entry)))
+ ;; Entry version is currently its range end, but it should be its
version range start.
+ (setf (hyperdrive-entry-version previous-entry) (car
(hyperdrive-entry-version-range previous-entry)))
+ previous-entry)))))))
(defun hyperdrive-entry-at (version entry)
"Return ENTRY at its hyperdrive's VERSION, or nil if not found.
@@ -466,7 +485,7 @@ Sends a request to the gateway for hyperdrive's latest
version."
(cl-defun hyperdrive-open (entry &key then recurse (createp t))
"Open hyperdrive ENTRY.
If RECURSE, proceed up the directory hierarchy if given path is
-not found. THEN is a function to pass to the handler which will
+not found. THEN is a function to pass to the handler which will
be called with no arguments in the buffer opened by the handler.
When a writable ENTRY is not found and CREATEP is non-nil, create
a new buffer for ENTRY."
@@ -524,7 +543,7 @@ a new buffer for ENTRY."
;; alert the user that the entry no longer exists.
(progn
(switch-to-buffer buffer)
- (message "Entry no longer exists! %s"
(hyperdrive-entry-description entry)))
+ (hyperdrive-message "Entry no longer exists! %s"
(hyperdrive-entry-description entry)))
;; Make and switch to new buffer.
(switch-to-buffer (hyperdrive--get-buffer-create
entry))))
(t
@@ -581,6 +600,7 @@ the given `plz-queue'"
:else (lambda (&rest args)
(when (hyperdrive-entry-version entry)
;; If request is canceled, the entry may not have a version.
+ ;; FIXME: Only update nonexistent range on 404.
(hyperdrive-update-nonexistent-version-range entry))
(apply else args))
:noquery t))))
@@ -589,15 +609,15 @@ the given `plz-queue'"
"Fill ENTRY and its hyperdrive from HEADERS.
The following ENTRY slots are filled:
-- type
-- mtime
-- size
-- hyperdrive (from persisted value if it exists)
+- \\+`type'
+- \\+`mtime'
+- \\+`size'
+- \\+`hyperdrive' (from persisted value if it exists)
The following ENTRY hyperdrive slots are filled:
-- public-key
-- writablep (when headers include Allow)
-- domains (merged with current persisted value)
+- \\+`public-key'
+- \\+`writablep' (when headers include Allow)
+- \\+`domains' (merged with current persisted value)
Returns filled ENTRY."
(pcase-let* (((cl-struct hyperdrive-entry hyperdrive) entry)
@@ -711,10 +731,10 @@ Returns the ranges cons cell for ENTRY."
((cl-struct hyperdrive-entry hyperdrive path version) entry)
(version (or version (hyperdrive-latest-version hyperdrive)))
(previous-range (hyperdrive-entry-version-range
- (hyperdrive-entry-create :hyperdrive
hyperdrive :path path :version (1- version))))
+ (hyperdrive-entry-create :hyperdrive
hyperdrive :path path :version (1- version))))
(`(,previous-range-start . ,(map (:existsp
previous-exists-p))) previous-range)
(next-range (hyperdrive-entry-version-range
- (hyperdrive-entry-create :hyperdrive hyperdrive
:path path :version (1+ version))))
+ (hyperdrive-entry-create :hyperdrive hyperdrive
:path path :version (1+ version))))
(`(,next-range-start . ,(map (:existsp next-exists-p)
(:range-end next-range-end))) next-range)
(range-start (if (and previous-range (null previous-exists-p))
;; Extend previous nonexistent range
@@ -730,74 +750,103 @@ Returns the ranges cons cell for ENTRY."
(setf (map-elt ranges range-start) `(:existsp nil :range-end ,range-end)
(hyperdrive-entry-version-ranges entry) (cl-sort ranges #'< :key
#'car)))))
-(cl-defun hyperdrive-fill-version-ranges (entry &key then)
- "Asynchronously fill in versions ranges for ENTRY and call THEN.
-First fill latest version of ENTRY's hyperdrive. Then recurse
-backward through some unknown ranges and fill them. Once all
-requests return, call THEN with no arguments."
- ;; TODO: Limit the number of recursive calls made.
+(cl-defun hyperdrive-fill-version-ranges (entry &key (finally #'ignore))
+ "Asynchronously fill in versions ranges before ENTRY.
+Once all requests return, call FINALLY with no arguments."
(declare (indent defun))
- ;; Filling drive's latest version lets us display the full history,
- ;; and it ensures that the final range is not unknown.
- (hyperdrive-fill-latest-version (hyperdrive-entry-hyperdrive entry))
- (let* ((ranges-no-gaps (hyperdrive-entry-version-ranges-no-gaps entry))
- (ranges-to-fill
- (cl-delete-if-not
- ;; Select certain unknown ranges to be filled. Unknown
- ;; ranges are filled by requesting the version at its
- ;; range-end. The entry at the range-end of an unknown
- ;; ranges which is followed by a nonexistent entry is
- ;; likely to also be nonexistent. By only attempting to
- ;; fill unknown ranges which are either followed by a
- ;; existent range or are themselves the final range, we
- ;; minimize the number of unnecessary requests.
- (pcase-lambda (`(,_range-start . ,(map (:existsp existsp)
(:range-end range-end))))
- (and (eq 'unknown existsp)
- (if-let ((next-range (map-elt ranges-no-gaps (1+
range-end))))
- ;; If next range exists, fill it.
- (eq t (map-elt next-range :existsp))
- ;; This is the final range: fill it.
- t)))
- ranges-no-gaps))
- queue)
- (if ranges-to-fill
- (progn
- ;; TODO: When `plz' lets us handle errors in the queue finalizer,
add that here.
- (setf queue (make-plz-queue :limit hyperdrive-queue-size :finally
then))
- (cl-labels ((fill-recursively (unknown-entry)
- ;; NOTE: `fill-recursively' is recursive logically but
- ;; not technically, because each call is in the async
callback.
- ;; Fill entry at its version, then if its previous
- ;; version is unknown, recurse on previous version.
- (hyperdrive-fill unknown-entry
- ;; `hyperdrive-fill' is only used here for updating
- ;; `hyperdrive-version-ranges'. The copied entry is
thrown away.
- :then (lambda (filled-entry)
- ;; Don't use `hyperdrive-entry-previous'
here, since it makes a sync request
- (pcase-let ((`(,range-start . ,_plist)
(hyperdrive-entry-version-range filled-entry)))
- (setf (hyperdrive-entry-version
filled-entry) (1- range-start))
- (when (eq 'unknown
(hyperdrive-entry-exists-p filled-entry))
- ;; Recurse backward through history,
filling unknown
- ;; entries. Stop recursing at known
nonexistent entry.
- (fill-recursively filled-entry))))
+ (let* ((outstanding-nonexistent-requests-p)
+ (total-requests-limit hyperdrive-fill-version-ranges-limit)
+ (fill-entry-queue (make-plz-queue :limit hyperdrive-queue-limit
+ :finally (lambda ()
+ (unless
outstanding-nonexistent-requests-p
+ (funcall finally)))))
+ ;; Flag used in the nonexistent-queue finalizer.
+ finishedp)
+ (cl-labels ((fill-existent-at (version)
+ (let ((prev-range-end (1- (car
(hyperdrive-entry-version-range entry :version version)))))
+ (if (and (cl-plusp total-requests-limit)
+ (eq 'unknown (hyperdrive-entry-exists-p entry
:version prev-range-end)))
+ ;; Recurse backward through history.
+ (fill-entry-at prev-range-end)
+ (setf finishedp t))))
+ (fill-nonexistent-at (version)
+ (let ((nonexistent-queue
+ (make-plz-queue
+ :limit hyperdrive-queue-limit
+ :finally (lambda ()
+ (setf outstanding-nonexistent-requests-p
nil)
+ (if finishedp
+ ;; If the fill-nonexistent-at loop
stopped
+ ;; prematurely, stop filling and call
`finally'.
+ (funcall finally)
+ (let ((last-requested-version (-
version hyperdrive-queue-limit)))
+ (cl-decf total-requests-limit
hyperdrive-queue-limit)
+ (pcase-exhaustive
(hyperdrive-entry-exists-p entry :version last-requested-version)
+ ('t (fill-existent-at
last-requested-version))
+ ('nil (fill-nonexistent-at
last-requested-version))
+ ('unknown
+ (hyperdrive-error "Entry should
have been filled at version: %s" last-requested-version))))))))
+ ;; Make a copy of the version ranges for use in the
HEAD request callback.
+ (copy-entry-version-ranges (copy-sequence
(hyperdrive-entry-version-ranges entry))))
+ ;; For nonexistent entries, send requests in parallel.
+ (cl-dotimes (i hyperdrive-queue-limit)
+ ;; Send the maximum number of simultaneous requests.
+ (let ((prev-entry (hyperdrive-copy-tree entry t)))
+ (setf (hyperdrive-entry-version prev-entry) (- version
i 1))
+ (unless (and (cl-plusp (hyperdrive-entry-version
prev-entry))
+ (eq 'unknown (hyperdrive-entry-exists-p
prev-entry))
+ (> total-requests-limit i))
+ ;; Stop at the beginning of the history, at a known
+ ;; existent/nonexistent entry, or at the limit.
+ (setf finishedp t)
+ (cl-return))
+ (hyperdrive-api 'head (hyperdrive-entry-url prev-entry)
+ :queue nonexistent-queue
+ :as 'response
+ :then (pcase-lambda ((cl-struct plz-response
(headers (map etag))))
+ (pcase-let* ((range-start (string-to-number
etag))
+ ((map (:existsp existsp))
(map-elt copy-entry-version-ranges range-start)))
+ (when (eq 'unknown existsp)
+ ;; Stop if the requested entry has a
+ ;; range-start that was already known
+ ;; before this batch of parallel
requests.
+ (setf finishedp t))
+ (hyperdrive-update-existent-version-range
prev-entry range-start)))
:else (lambda (err)
+ ;; TODO: Better error handling.
(pcase (plz-response-status
(plz-error-response err))
;; FIXME: If plz-error is a curl-error,
this block will fail.
- ;; TODO: How to handle entries which have
never been known
- ;; existent. From a UI perspective, the
history buffer
- ;; should display the versions at which
the entry is known
- ;; non-existent. However, we don't want to
store loads of
- ;; non-existent entries in
`hyperdrive-version-ranges'.
- (404 nil)
- (_ (signal (car err) (cdr err))))
- err)
- :queue queue)))
- (pcase-dolist (`(,_range-start . ,(map (:range-end range-end)))
ranges-to-fill)
- ;; TODO: Consider using async iterator instead (with
`iter-defun' or `aio'?)
- (let ((range-end-entry (hyperdrive-copy-tree entry t)))
- (setf (hyperdrive-entry-version range-end-entry) range-end)
- (fill-recursively range-end-entry)))))
- (funcall then))))
+ (404
(hyperdrive-update-nonexistent-version-range prev-entry))
+ (_ (signal (car err) (cdr err)))))
+ :noquery t)
+ (setf outstanding-nonexistent-requests-p t)))))
+ (fill-entry-at (version)
+ (let ((copy-entry (hyperdrive-copy-tree entry t)))
+ (setf (hyperdrive-entry-version copy-entry) version)
+ (cl-decf total-requests-limit)
+ (hyperdrive-api 'head (hyperdrive-entry-url copy-entry)
+ :queue fill-entry-queue
+ :as 'response
+ :then (pcase-lambda ((cl-struct plz-response (headers
(map etag))))
+ (pcase-let* ((range-start (string-to-number
etag))
+ ((map (:existsp existsp))
+ (map-elt
(hyperdrive-entry-version-ranges copy-entry) range-start)))
+ (hyperdrive-update-existent-version-range
copy-entry range-start)
+ (if (eq 't existsp)
+ ;; Stop if the requested entry has a
+ ;; range-start that was already known
+ ;; before this batch of parallel requests.
+ (setf finishedp t)
+ (fill-existent-at version))))
+ :else (lambda (err)
+ (pcase (plz-response-status (plz-error-response
err))
+ ;; FIXME: If plz-error is a curl-error, this
block will fail.
+ (404
+ (hyperdrive-update-nonexistent-version-range
copy-entry)
+ (fill-nonexistent-at version))
+ (_ (signal (car err) (cdr err)))))
+ :noquery t))))
+ (fill-entry-at (hyperdrive-entry-version entry)))))
(defun hyperdrive-fill-metadata (hyperdrive)
"Fill HYPERDRIVE's public metadata and return it.
@@ -1268,7 +1317,7 @@ Affected by option `hyperdrive-reuse-buffers', which see."
(buffer-local-value 'hyperdrive-current-entry
buffer))))
(defun hyperdrive--buffer-for-entry (entry)
- "Return a predicate to match buffer against ENTRY"
+ "Return a predicate to match buffer against ENTRY."
;; TODO: This function is a workaround for bug#65797
(lambda (buffer) (hyperdrive--entry-buffer-p entry buffer)))
@@ -1347,7 +1396,7 @@ When BASE is non-nil, PATH will be expanded against BASE
instead."
(defun hyperdrive--clean-buffer (&optional buffer)
"Remove all local variables, overlays, and text properties in BUFFER.
- When BUFFER is nil, act on current buffer."
+When BUFFER is nil, act on current buffer."
(with-current-buffer (or buffer (current-buffer))
(kill-all-local-variables t)
(let ((inhibit-read-only t))
diff --git a/hyperdrive-mirror.el b/hyperdrive-mirror.el
index 809507a163..8399584ae7 100644
--- a/hyperdrive-mirror.el
+++ b/hyperdrive-mirror.el
@@ -54,7 +54,7 @@ uploading files, open PARENT-ENTRY."
(progress-reporter
(make-progress-reporter (format "Uploading %s files: " (length
upload-files-and-urls)) 0 (length upload-files-and-urls)))
(queue (make-plz-queue
- :limit hyperdrive-queue-size
+ :limit hyperdrive-queue-limit
:finally (lambda ()
(progress-reporter-done progress-reporter)
(hyperdrive-open parent-entry)
@@ -163,7 +163,7 @@ predicate and set NO-CONFIRM to t."
`(,source ,hyperdrive :target-dir ,target-dir
:predicate ,predicate)
hyperdrive-mirror-parent-entry parent-entry)
(setf metadata-queue (make-plz-queue
- :limit hyperdrive-queue-size
+ :limit hyperdrive-queue-limit
:finally (lambda ()
(with-current-buffer buffer
(with-silent-modifications
diff --git a/hyperdrive-vars.el b/hyperdrive-vars.el
index f1541117c6..0527bb5c3a 100644
--- a/hyperdrive-vars.el
+++ b/hyperdrive-vars.el
@@ -145,12 +145,16 @@ through a shell)."
(const :tag "VLC" "vlc %s")
(string :tag "Other command")))
-(defcustom hyperdrive-queue-size 20
+(defcustom hyperdrive-queue-limit 20
"Default size of request queues."
;; TODO: Consider a separate option for metadata queue size (e.g. used in
the dir handler).
;; TODO: Consider a separate option for upload queue size, etc.
:type 'natnum)
+(defcustom hyperdrive-fill-version-ranges-limit 10
+ "Default maximum number of requests when filling version history."
+ :type 'natnum)
+
(defcustom hyperdrive-render-html t
"Render HTML hyperdrive files with EWW."
:type 'boolean)
diff --git a/hyperdrive.el b/hyperdrive.el
index 279935777b..ecdd5a00bc 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -496,7 +496,10 @@ hyperdrive directory listing or a `hyperdrive-mode' file
buffer."
(interactive (list hyperdrive-current-entry))
(if-let ((previous-entry (hyperdrive-entry-previous entry)))
(hyperdrive-open previous-entry)
- (hyperdrive-message "At earliest known version of %s"
(hyperdrive-entry-description entry :with-version nil))))
+ (hyperdrive-message (substitute-command-keys "%s does not exist at version
%s. Try \\[hyperdrive-history]")
+ (hyperdrive-entry-description entry :with-version nil)
+ (1- (or (hyperdrive-entry-version entry)
+ (hyperdrive-latest-version
(hyperdrive-entry-hyperdrive entry)))))))
(defun hyperdrive-next-version (entry)
"Show next version of ENTRY."
@@ -624,7 +627,7 @@ Universal prefix argument \\[universal-argument] forces
(hyperdrive-user-error "Can't upload multiple files with same name: %S"
(file-name-nondirectory file))))
(setf target-directory (hyperdrive--format-path target-directory :directoryp
t))
(let ((queue (make-plz-queue
- :limit hyperdrive-queue-size
+ :limit hyperdrive-queue-limit
:finally (lambda ()
;; FIXME: Offer more informative message in case of
errors?
(hyperdrive-open (hyperdrive-entry-create
:hyperdrive hyperdrive
