emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[nongnu] elpa/hyperdrive bd3e8c90ef 48/49: Merge branch 'wip/history-fil


From: ELPA Syncer
Subject: [nongnu] elpa/hyperdrive bd3e8c90ef 48/49: Merge branch 'wip/history-fill-version-ranges-2'
Date: Wed, 20 Sep 2023 19:01:35 -0400 (EDT)

branch: elpa/hyperdrive
commit bd3e8c90ef19e1a8436af6310bfebfa534e6bb7a
Merge: 081513c89a 8d06964e22
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]