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

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

[nongnu] elpa/hyperdrive b5dc019164 123/123: Merge: Add Transient menu i


From: ELPA Syncer
Subject: [nongnu] elpa/hyperdrive b5dc019164 123/123: Merge: Add Transient menu interface
Date: Fri, 6 Oct 2023 01:01:14 -0400 (EDT)

branch: elpa/hyperdrive
commit b5dc019164ff6faad32b80039070c2bea043cf1a
Merge: 653bbf6706 28efe94c8f
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    Merge: Add Transient menu interface
---
 doc/hyperdrive-manual.org  |   4 +-
 doc/hyperdrive-manual.texi |   6 +-
 hyperdrive-dir.el          |  45 ++------
 hyperdrive-history.el      |   7 +-
 hyperdrive-lib.el          |  72 ++++++++++---
 hyperdrive-menu.el         | 264 +++++++++++++++++++++++++++++++++++++++++++++
 hyperdrive-mirror.el       |   2 +
 hyperdrive.el              |  40 ++++---
 8 files changed, 360 insertions(+), 80 deletions(-)

diff --git a/doc/hyperdrive-manual.org b/doc/hyperdrive-manual.org
index a4cc2ff5f6..f36e2e6fff 100644
--- a/doc/hyperdrive-manual.org
+++ b/doc/hyperdrive-manual.org
@@ -358,11 +358,11 @@ stream that video from the network.  After the stream 
finishes, the
 audio/video file is stored locally.
 
 ** Download hyperdrive files
-#+findex: hyperdrive-download-entry
+#+findex: hyperdrive-download
 #+findex: hyperdrive-download-url
 
 You can download a hyperdrive file to your local filesystem. Download
-the current hyperdrive file with ~hyperdrive-download-entry~ or paste
+the current hyperdrive file with ~hyperdrive-download~ or paste
 in a ~hyper://~ URL after ~hyperdrive-download-url~.
 
 ** Upload files from your filesystem
diff --git a/doc/hyperdrive-manual.texi b/doc/hyperdrive-manual.texi
index 108e2252bf..4a8b132a02 100644
--- a/doc/hyperdrive-manual.texi
+++ b/doc/hyperdrive-manual.texi
@@ -579,11 +579,11 @@ audio/video file is stored locally.
 @node Download hyperdrive files
 @section Download hyperdrive files
 
-@findex hyperdrive-download-entry
+@findex hyperdrive-download
 @findex hyperdrive-download-url
 
 You can download a hyperdrive file to your local filesystem. Download
-the current hyperdrive file with @code{hyperdrive-download-entry} or paste
+the current hyperdrive file with @code{hyperdrive-download} or paste
 in a @code{hyper://} URL after @code{hyperdrive-download-url}.
 
 @node Upload files from your filesystem
@@ -1768,4 +1768,4 @@ recommend releasing these examples in parallel under your 
choice of
 free software license, such as the GNU General Public License, to
 permit their use in free software.
 
-@bye
\ No newline at end of file
+@bye
diff --git a/hyperdrive-dir.el b/hyperdrive-dir.el
index 0392775bc7..018a0da7a6 100644
--- a/hyperdrive-dir.el
+++ b/hyperdrive-dir.el
@@ -233,7 +233,11 @@ With point on header, returns directory entry."
 
 (declare-function hyperdrive-find-file "hyperdrive")
 (declare-function hyperdrive-up "hyperdrive")
+(declare-function hyperdrive-download "hyperdrive")
 (declare-function hyperdrive-describe-hyperdrive "hyperdrive-describe")
+;; `hyperdrive-menu' is defined with `transient-define-prefix', which
+;; `check-declare' doesn't recognize.
+(declare-function hyperdrive-menu "hyperdrive-menu" nil t)
 
 (defvar-keymap hyperdrive-dir-mode-map
   :parent hyperdrive-ewoc-mode-map
@@ -243,12 +247,13 @@ With point on header, returns directory entry."
   "v"   #'hyperdrive-dir-view-file
   "j"   #'imenu
   "w"   #'hyperdrive-dir-copy-url
-  "d"   #'hyperdrive-dir-download-file
+  "d"   #'hyperdrive-download
   "^"   #'hyperdrive-up
-  "D"   #'hyperdrive-dir-delete
+  ;; TODO(doc): hyperdrive-dir-delete replaced by hyperdrive-delete
+  "D"   #'hyperdrive-delete
   "H"   #'hyperdrive-dir-history
   "o"   #'hyperdrive-dir-sort
-  "?"   #'hyperdrive-describe-hyperdrive
+  "?"   #'hyperdrive-menu
   "+"   #'hyperdrive-create-directory-no-op)
 
 (define-derived-mode hyperdrive-dir-mode hyperdrive-ewoc-mode
@@ -289,40 +294,6 @@ Interactively, opens file or directory at point in
   (interactive (list (hyperdrive-dir--entry-at-point)))
   (hyperdrive-copy-url entry))
 
-(declare-function hyperdrive-download-entry "hyperdrive")
-
-(defun hyperdrive-dir-download-file (entry filename)
-  "Download ENTRY at point to FILENAME on disk."
-  (declare (modes hyperdrive-dir-mode))
-  (interactive
-   (pcase-let* ((entry (hyperdrive-dir--entry-at-point))
-                ((cl-struct hyperdrive-entry name) entry)
-                (read-filename (read-file-name "Filename: " (expand-file-name 
name hyperdrive-download-directory))))
-     (list entry read-filename)))
-  (hyperdrive-download-entry entry filename))
-
-(defun hyperdrive-dir-delete (entry)
-  "Delete ENTRY."
-  (declare (modes hyperdrive-dir-mode))
-  (interactive (list (hyperdrive-dir--entry-at-point)))
-  (when (or (eq entry hyperdrive-current-entry)
-            (string= ".." (alist-get 'display-name
-                                     (hyperdrive-entry-etc entry))))
-    (hyperdrive-user-error "Won't delete from within"))
-  (pcase-let (((cl-struct hyperdrive-entry name) entry)
-              (buffer (current-buffer)))
-    (when (and (yes-or-no-p (format "Delete %S? " name))
-               (or (not (hyperdrive--entry-directory-p entry))
-                   (yes-or-no-p (format "Recursively delete %S? " name))))
-      (hyperdrive-delete entry
-        :then (lambda (_)
-                (when (buffer-live-p buffer)
-                  (with-current-buffer buffer
-                    (revert-buffer)))
-                (hyperdrive-message "Deleted: %S (Deleted files can be 
accessed from prior versions of the hyperdrive.)" name))
-        :else (lambda (plz-error)
-                (hyperdrive-message "Unable to delete: %S: %S" name 
plz-error))))))
-
 (declare-function hyperdrive-history "hyperdrive-history")
 
 (defun hyperdrive-dir-history (entry)
diff --git a/hyperdrive-history.el b/hyperdrive-history.el
index f2c83ceb9d..25f0924659 100644
--- a/hyperdrive-history.el
+++ b/hyperdrive-history.el
@@ -176,8 +176,7 @@ Universal prefix argument \\[universal-argument] forces
                (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)
+                                  (hyperdrive--format-host hyperdrive 
:with-label t)
                                   (url-unhex-string path)))
       (with-silent-modifications
         (hyperdrive-history-mode)
@@ -310,7 +309,7 @@ buffer."
      ;; Not known to exist: warn user.
      (hyperdrive-user-error "File not known to exist!"))))
 
-(declare-function hyperdrive-download-entry "hyperdrive")
+(declare-function hyperdrive-download "hyperdrive")
 
 (defun hyperdrive-history-download-file (range-entry filename)
   "Download entry in RANGE-ENTRY at point to FILENAME on disk."
@@ -332,7 +331,7 @@ buffer."
   (pcase-exhaustive (hyperdrive-range-entry-exists-p range-entry)
     ('t
      ;; Known to exist: download it.
-     (hyperdrive-download-entry (cdr range-entry) filename))
+     (hyperdrive-download (cdr range-entry) filename))
     ('nil
      ;; Known to not exist: warn user.
      (hyperdrive-user-error "File does not exist!"))
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index cb90867ba9..f7cca8064b 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -450,6 +450,9 @@ Sends a request to the gateway for hyperdrive's latest 
version."
     ;; ENTRY is a directory: increment the version number by one.
     (when (hyperdrive--entry-directory-p entry)
       (cl-incf (hyperdrive-entry-version next-entry))
+      (when (eq latest-version (hyperdrive-entry-version next-entry))
+        ;; Next ENTRY is the latest version: return ENTRY with nil version.
+        (setf (hyperdrive-entry-version next-entry) nil))
       (cl-return-from hyperdrive-entry-next next-entry))
 
     ;; ENTRY is a file...
@@ -876,17 +879,41 @@ HYPERDRIVE's public metadata file."
 
 (cl-defun hyperdrive-delete (entry &key (then #'ignore) (else #'ignore))
   "Delete ENTRY, then call THEN with response.
-Call ELSE with `plz-error' struct if request fails."
+Call ELSE with `plz-error' struct if request fails.
+Interactively, read ENTRY with `hyperdrive-read-entry'."
   (declare (indent defun))
+  (interactive
+   (let* ((entry (hyperdrive--context-entry))
+          (description (hyperdrive-entry-description entry))
+          (buffer (current-buffer)))
+     (when (and (hyperdrive--entry-directory-p entry)
+                (or (eq entry hyperdrive-current-entry)
+                    (string= ".." (alist-get 'display-name 
(hyperdrive-entry-etc entry)))))
+       (hyperdrive-user-error "Won't delete from within"))
+     (when (and (yes-or-no-p (format "Delete «%s»? " description))
+                (or (not (hyperdrive--entry-directory-p entry))
+                    (yes-or-no-p (format "Recursively delete «%s»? " 
description))))
+       (list entry
+             :then (lambda (_)
+                     (when (and (buffer-live-p buffer)
+                                (eq 'hyperdrive-dir-mode (buffer-local-value 
'major-mode buffer)))
+                       (with-current-buffer buffer
+                         (revert-buffer)))
+                     (hyperdrive-message "Deleted: «%s» (Deleted files can be 
accessed from prior versions of the hyperdrive.)" description))
+             :else (lambda (plz-error)
+                     (hyperdrive-message "Unable to delete «%s»: %S" 
description plz-error))))))
   (hyperdrive-api 'delete (hyperdrive-entry-url entry)
     :as 'response
     :then (lambda (response)
             (pcase-let* (((cl-struct plz-response headers) response)
                          ((map etag) headers)
                          (nonexistent-entry (hyperdrive-copy-tree entry t)))
-              (setf (hyperdrive-entry-version nonexistent-entry) 
(string-to-number etag))
-              (hyperdrive--fill-latest-version (hyperdrive-entry-hyperdrive 
entry) headers)
-              (hyperdrive-update-nonexistent-version-range nonexistent-entry)
+              (unless (hyperdrive--entry-directory-p entry)
+                ;; FIXME: hypercore-fetch bug doesn't update version
+                ;; number when deleting a directory.
+                (setf (hyperdrive-entry-version nonexistent-entry) 
(string-to-number etag))
+                (hyperdrive--fill-latest-version (hyperdrive-entry-hyperdrive 
entry) headers)
+                (hyperdrive-update-nonexistent-version-range 
nonexistent-entry))
               (funcall then response)))
     :else else))
 
@@ -927,9 +954,7 @@ FORMAT-PATH is `name', use only last part of path, as in
 
 When WITH-VERSION or ENTRY's version is nil, omit (version:VERSION)."
   (pcase-let* (((cl-struct hyperdrive-entry hyperdrive version path name) 
entry)
-               (handle (hyperdrive--format-host hyperdrive
-                                                :format 
hyperdrive-default-host-format
-                                                :with-label t)))
+               (handle (hyperdrive--format-host hyperdrive :with-label t)))
     (propertize (concat (format "[%s] " handle)
                         (pcase format-path
                           ('path (url-unhex-string path))
@@ -988,12 +1013,13 @@ Path and target fragment are URI-encoded."
                                 :with-faces with-faces))
       url)))
 
-(cl-defun hyperdrive--format-host (hyperdrive &key format with-label 
(with-faces t))
+(cl-defun hyperdrive--format-host
+    (hyperdrive &key with-label (format hyperdrive-default-host-format) 
(with-faces t))
   "Return HYPERDRIVE's formatted hostname, or nil.
-FORMAT should be a list of symbols; see
-`hyperdrive-default-host-format' for choices.  If the specified
-FORMAT is not available, returns nil.  If WITH-LABEL, prepend a
-label for the kind of format used (e.g. \"petname:\").
+FORMAT should be one or a list of symbols, by default
+`hyperdrive-default-host-format', which see for choices.  If the
+specified FORMAT is not available, returns nil.  If WITH-LABEL,
+prepend a label for the kind of format used (e.g. \"petname:\").
 When WITH-FACES is nil, don't add face text properties."
   (pcase-let* (((cl-struct hyperdrive petname public-key domains seed
                            (metadata (map name)))
@@ -1004,7 +1030,7 @@ When WITH-FACES is nil, don't add face text properties."
                         (if with-faces
                             (propertize string 'face face)
                           string))))
-      (cl-loop for f in format
+      (cl-loop for f in (ensure-list format)
                when (pcase f
                       ((and 'petname (guard petname))
                        (fmt petname "petname:" 'hyperdrive-petname))
@@ -1024,6 +1050,15 @@ When WITH-FACES is nil, don't add face text properties."
 
 ;;;; Reading from the user
 
+(declare-function hyperdrive-dir--entry-at-point "hyperdrive-dir")
+(defun hyperdrive--context-entry ()
+  "Return the current entry in the current context."
+  (pcase major-mode
+    ((guard current-prefix-arg)
+     (hyperdrive-read-entry :force-prompt current-prefix-arg))
+    ('hyperdrive-dir-mode (hyperdrive-dir--entry-at-point))
+    (_ (or hyperdrive-current-entry (hyperdrive-read-entry)))))
+
 (cl-defun hyperdrive-complete-hyperdrive (&key predicate force-prompt)
   "Return hyperdrive for current entry when it matches PREDICATE.
 
@@ -1053,11 +1088,14 @@ case, when PREDICATE, only offer hyperdrives matching 
it."
         (or (alist-get selected candidates nil nil #'equal)
             (hyperdrive-user-error "No such hyperdrive.  Use `hyperdrive-new' 
to create a new one"))))))
 
-(cl-defun hyperdrive--format-hyperdrive (hyperdrive)
-  "Return HYPERDRIVE formatted for completion."
+(cl-defun hyperdrive--format-hyperdrive
+    (hyperdrive &key (formats '(petname nickname domain seed short-key)) 
(with-label t))
+  "Return HYPERDRIVE formatted for completion.
+For each of FORMATS, concatenates the value separated by two
+spaces, optionally WITH-LABEL."
   (string-trim
-   (cl-loop for format in '(petname nickname domain seed short-key)
-            when (hyperdrive--format-host hyperdrive :format (list format) 
:with-label t)
+   (cl-loop for format in formats
+            when (hyperdrive--format-host hyperdrive :format format 
:with-label with-label)
             concat (concat it "  "))))
 
 (cl-defun hyperdrive-read-entry (&key predicate default-path (allow-version-p 
t) force-prompt)
diff --git a/hyperdrive-menu.el b/hyperdrive-menu.el
new file mode 100644
index 0000000000..ac4cf54e43
--- /dev/null
+++ b/hyperdrive-menu.el
@@ -0,0 +1,264 @@
+;;; hyperdrive.el --- P2P filesystem  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023 USHIN, Inc.
+
+;; Author: Adam Porter <adam@alphapapa.net>
+;; Author: Joseph Turner <joseph@ushin.org>
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Affero General Public License
+;; as published by the Free Software Foundation; either version 3 of
+;; the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public
+;; License along with this program. If not, see
+;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file adds a transient.el menu for hyperdrive entries.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'cl-lib)
+(require 'pcase)
+(require 'transient)
+(require 'compat)
+
+(require 'hyperdrive-vars)
+(require 'hyperdrive-lib)
+
+;;;; Declarations
+
+(declare-function hyperdrive-dir--entry-at-point "hyperdrive-dir")
+(declare-function hyperdrive-set-nickname "hyperdrive")
+(declare-function hyperdrive-set-petname "hyperdrive")
+
+;;;;; hyperdrive-menu: Transient for entries
+
+;; TODO: Use something like this later.
+;; (defmacro hyperdrive-menu-lambda (&rest body)
+;;   (declare (indent defun))
+;;   `(lambda ()
+;;      (when hyperdrive-current-entry
+;;        (pcase-let (((cl-struct hyperdrive-entry hyperdrive)
+;;                     hyperdrive-current-entry))
+;;          ,@body))))
+
+;; TODO: Add macro that expands `entry' into (oref transient--prefix scope)
+;; or (oref transient-current-prefix scope) as appropriate.
+;;;###autoload (autoload 'hyperdrive-menu "hyperdrive-menu" nil t)
+(transient-define-prefix hyperdrive-menu (entry)
+  "Show the hyperdrive transient menu."
+  :info-manual "(Hyperdrive)"
+  [ :class transient-row
+    :description
+    (lambda ()
+      (if-let* ((entry (oref transient--prefix scope))
+                (hyperdrive (hyperdrive-entry-hyperdrive entry)))
+          (concat (propertize "Hyperdrive: " 'face 'transient-heading)
+                  (hyperdrive--format-host hyperdrive :with-label t))
+        "Hyperdrive"))
+    ("h" "Hyperdrive menu" hyperdrive-menu-hyperdrive)
+    ("N" "New drive" hyperdrive-new)]
+  [ :if (lambda () (oref transient--prefix scope))
+
+    ["Version"
+     :class transient-row
+     :description (lambda ()
+                    (if-let ((entry (oref transient--prefix scope))
+                             (hyperdrive (hyperdrive-entry-hyperdrive entry)))
+                        (concat (propertize "Version: "
+                                            'face 'transient-heading)
+                                (propertize (format "%s"
+                                                    (or 
(hyperdrive-entry-version entry)
+                                                        "latest"))
+                                            'face 'transient-value))
+                      "Version"))
+     ("V p" "Previous" hyperdrive-previous-version
+      :inapt-if-not (lambda ()
+                      (hyperdrive-entry-previous (oref transient--prefix 
scope) :cache-only t))
+      ;; :transient t
+      :description (lambda ()
+                     (if-let ((entry (oref transient--prefix scope))
+                              (hyperdrive (hyperdrive-entry-hyperdrive entry)))
+                         (concat "Previous"
+                                 (pcase-exhaustive (hyperdrive-entry-previous 
entry :cache-only t)
+                                   ('unknown (concat ": " (propertize "?" 
'face 'transient-value)))
+                                   ('nil nil)
+                                   ((cl-struct hyperdrive-entry version)
+                                    (concat ": " (propertize (number-to-string 
version)
+                                                             'face 
'transient-value)))))
+                       "Previous")))
+     ("V n" "Next" hyperdrive-next-version
+      :inapt-if-not (lambda  ()
+                      (let ((entry (oref transient--prefix scope)))
+                        (and (hyperdrive-entry-version entry)
+                             (hyperdrive-entry-next entry))))
+      ;; :transient t
+      :description (lambda ()
+                     (concat "Next"
+                             (when-let* ((entry (oref transient--prefix scope))
+                                         (hyperdrive 
(hyperdrive-entry-hyperdrive entry))
+                                         (next-entry (hyperdrive-entry-next 
entry))
+                                         ;; Don't add ": latest" if we're 
already at the latest version
+                                         ((not (eq entry next-entry)))
+                                         (display-version (if-let 
((next-version (hyperdrive-entry-version next-entry)))
+                                                              
(number-to-string next-version)
+                                                            "latest")))
+                               (concat ": " (propertize display-version 'face 
'transient-value))))))
+     ("V h" "History" hyperdrive-history)]
+    [ ;; Current
+     :description
+     (lambda ()
+       (let ((entry (oref transient--prefix scope)))
+         (concat (propertize "Current: " 'face 'transient-heading)
+                 (propertize (hyperdrive--format-path (hyperdrive-entry-path 
entry))
+                             'face 'transient-value))))
+     ("^" "Up to parent" (lambda ()
+                           (interactive)
+                           (hyperdrive-up (oref transient-current-prefix scope)
+                                          :then (lambda ()
+                                                  (call-interactively 
#'hyperdrive-menu))))
+      :inapt-if-not (lambda ()
+                      (hyperdrive-parent (oref transient--prefix scope))))
+     ("o" "Sort" hyperdrive-dir-sort
+      :if (lambda ()
+            (eq major-mode 'hyperdrive-dir-mode))
+      :transient t)
+     ;; TODO: Combine previous and next commands on the same line?
+     ;; TODO: See "predicate refreshing" 
<https://github.com/magit/transient/issues/157>.
+     ("p" "previous" (lambda ()
+                       (interactive)
+                       (hyperdrive-ewoc-previous)
+                       (hyperdrive-menu (oref transient--prefix scope)))
+      :if (lambda ()
+            (eq major-mode 'hyperdrive-dir-mode))
+      :transient t)
+     ("n" "next" (lambda ()
+                   (interactive)
+                   (hyperdrive-ewoc-next)
+                   (hyperdrive-menu (oref transient--prefix scope)))
+      :if (lambda ()
+            (eq major-mode 'hyperdrive-dir-mode))
+      :transient t)
+     ("w" "Copy URL" hyperdrive-copy-url
+      :if (lambda ()
+            (not (eq major-mode 'hyperdrive-dir-mode))))
+     ("D" "Delete" hyperdrive-delete)
+     ("d" "Download" hyperdrive-download
+      :if (lambda ()
+            (not (eq major-mode 'hyperdrive-dir-mode))))]
+    [ ;; Selected
+     :if (lambda ()
+           (and (oref transient--prefix scope)
+                (eq major-mode 'hyperdrive-dir-mode)))
+     :description
+     (lambda ()
+       (concat (propertize "Selected: " 'face 'transient-heading)
+               (propertize (hyperdrive-entry-name 
(hyperdrive-dir--entry-at-point))
+                           'face 'transient-value)))
+     :pad-keys t
+     ("d" "Download" hyperdrive-download
+      :if (lambda ()
+            (when-let ((entry-at-point (hyperdrive-dir--entry-at-point)))
+              (not (hyperdrive--entry-directory-p entry-at-point)))))
+     ("D" "Delete" hyperdrive-delete)
+     ("w" "Copy URL" (lambda ()
+                       (interactive)
+                       (hyperdrive-copy-url (hyperdrive--context-entry))))
+     ;; FIXME: The sequence "? ? RET" says "Unbound suffix" instead of showing 
the help for that command.  Might be an issue in Transient.
+     ("RET" "Open" hyperdrive-dir-find-file)
+     ("v" "View" hyperdrive-dir-view-file
+      :if (lambda ()
+            (when-let ((entry-at-point (hyperdrive-dir--entry-at-point)))
+              (not (hyperdrive--entry-directory-p entry-at-point)))))]]
+  [["Gateway"
+    ("g s" "Start" hyperdrive-start)
+    ("g S" "Stop" hyperdrive-stop)
+    ("g v" "Version" hyperdrive-hyper-gateway-version)]
+   ["Bookmark"
+    ("b j" "Jump" hyperdrive-bookmark-jump)
+    ("b l" "List" hyperdrive-bookmark-list)
+    ("b s" "Set" bookmark-set
+     :if (lambda ()
+           (oref transient--prefix scope)))]
+   ["Files"
+    ("f f" "Find" hyperdrive-find-file)
+    ("f v" "View" hyperdrive-view-file)
+    ("f o" "Open URL" hyperdrive-open-url)]
+   ["Upload"
+    ("u f" "File" hyperdrive-upload-file)
+    ("u F" "Files" hyperdrive-upload-files)
+    ("u m" "Mirror" hyperdrive-mirror)]]
+  (interactive (list hyperdrive-current-entry))
+  (transient-setup 'hyperdrive-menu nil nil :scope entry))
+
+;;;;; hyperdrive-menu-hyperdrive: Transient for hyperdrives
+
+(transient-define-prefix hyperdrive-menu-hyperdrive (hyperdrive)
+  "Show menu for editing HYPERDRIVE."
+  [:description
+   (lambda ()
+     (let ((hyperdrive (oref transient--prefix scope)))
+       (concat (propertize "Hyperdrive: " 'face 'transient-heading)
+               (hyperdrive--format-hyperdrive hyperdrive :formats '(public-key 
seed domain))
+               (format "  latest-version:%s" (hyperdrive-latest-version 
hyperdrive)))))
+   [("d" "Describe" hyperdrive-describe-hyperdrive)
+    ("C-M-P" "Purge" hyperdrive-purge)]
+   [("p" "Petname" hyperdrive-menu-set-petname
+     :transient t
+     :description (lambda ()
+                    (format "Petname: %s"
+                            (pcase (hyperdrive-petname
+                                    (oref transient--prefix scope))
+                              (`nil (propertize "none"
+                                                'face 
'transient-inactive-value))
+                              (it (propertize it
+                                              'face 'transient-value))))))
+    ("n" "set nickname" hyperdrive-menu-set-nickname
+     :transient t
+     :inapt-if-not (lambda ()
+                     (hyperdrive-writablep (oref transient--prefix scope)))
+     :description (lambda ()
+                    (format "Nickname: %s"
+                            ;; TODO: Hyperdrive-metadata accessor (and maybe 
gv setter).
+                            (pcase (alist-get 'name
+                                              (hyperdrive-metadata
+                                               (oref transient--prefix scope)))
+                              ('nil (propertize "none"
+                                                'face 
'transient-inactive-value))
+                              (it (propertize it
+                                              'face 'transient-value))))))]]
+  (interactive (list (hyperdrive-complete-hyperdrive :force-prompt 
current-prefix-arg)))
+  (transient-setup 'hyperdrive-menu-hyperdrive nil nil :scope hyperdrive))
+
+(transient-define-suffix hyperdrive-menu-set-petname (petname)
+  (interactive
+   (list (hyperdrive-read-name
+          :prompt "New petname"
+          :initial-input (hyperdrive-petname (oref transient-current-prefix 
scope)))))
+  (let ((hyperdrive (oref transient-current-prefix scope)))
+    (hyperdrive-set-petname petname hyperdrive)))
+
+(transient-define-suffix hyperdrive-menu-set-nickname (nickname)
+  (interactive
+   (list (hyperdrive-read-name
+          :prompt "New nickname"
+          :initial-input (alist-get 'name (hyperdrive-metadata (oref 
transient-current-prefix scope))))))
+  (hyperdrive-set-nickname nickname (oref transient-current-prefix scope)
+                           :then (lambda (hyperdrive)
+                                   (hyperdrive-menu-hyperdrive hyperdrive))))
+
+;;;; Footer
+
+(provide 'hyperdrive-menu)
+
+;;; hyperdrive-menu.el ends here
diff --git a/hyperdrive-mirror.el b/hyperdrive-mirror.el
index 7a6fe52a28..081155985d 100644
--- a/hyperdrive-mirror.el
+++ b/hyperdrive-mirror.el
@@ -76,6 +76,8 @@ Runs `hyperdrive-mirror' again with the same query."
 
 ;;;; Commands
 
+;; TODO: Rewrite `hyperdrive-mirror' as a Transient.
+
 ;;;###autoload
 (cl-defun hyperdrive-mirror
     (source hyperdrive &key target-dir (predicate #'always) no-confirm)
diff --git a/hyperdrive.el b/hyperdrive.el
index d75cca88b4..fed152a496 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -7,7 +7,7 @@
 ;; Maintainer: Joseph Turner <~ushin/ushin@lists.sr.ht>
 ;; Created: 2022
 ;; Version: 0.2-pre
-;; Package-Requires: ((emacs "27.1") (map "3.0") (compat "29.1.4.0") (plz 
"0.7") (persist "0.5"))
+;; Package-Requires: ((emacs "27.1") (map "3.0") (compat "29.1.4.0") (plz 
"0.7") (persist "0.5") (transient "0.4.3"))
 ;; Homepage: https://git.sr.ht/~ushin/hyperdrive.el
 
 ;; This program is free software; you can redistribute it and/or
@@ -177,6 +177,7 @@ hyperdrive, the new hyperdrive's petname will be set to 
SEED."
       :else (lambda (plz-error)
               (hyperdrive-error "Unable to purge drive: %s %S" 
(hyperdrive--format-hyperdrive hyperdrive) plz-error)))))
 
+;;;###autoload
 (defun hyperdrive-set-petname (petname hyperdrive)
   "Set HYPERDRIVE's PETNAME.
 Entering an empty or blank string unsets PETNAME.
@@ -207,10 +208,14 @@ Universal prefix argument \\[universal-argument] forces
   ;; TODO: Consider refreshing buffer names, directory headers, etc.
   hyperdrive)
 
-(defun hyperdrive-set-nickname (nickname hyperdrive)
+;;;###autoload
+(cl-defun hyperdrive-set-nickname (nickname hyperdrive &key (then #'ignore))
   "Set HYPERDRIVE's NICKNAME.
 Returns HYPERDRIVE.
 
+Asynchronous callback calls THEN with the updated hyperdrive as
+its only argument.
+
 Universal prefix argument \\[universal-argument] forces
 `hyperdrive-complete-hyperdrive' to prompt for a hyperdrive."
   (interactive
@@ -231,17 +236,15 @@ Universal prefix argument \\[universal-argument] forces
           (cl-callf map-delete (hyperdrive-metadata hyperdrive) 'name)
           (hyperdrive-put-metadata hyperdrive
             :then (pcase-lambda ((cl-struct plz-response headers))
-                    (hyperdrive-message "Unset nickname")
                     (hyperdrive--fill-latest-version hyperdrive headers)
-                    (hyperdrive-persist hyperdrive))))
+                    (hyperdrive-persist hyperdrive)
+                    (funcall then hyperdrive))))
       (setf (alist-get 'name (hyperdrive-metadata hyperdrive)) nickname)
       (hyperdrive-put-metadata hyperdrive
         :then (pcase-lambda ((cl-struct plz-response headers))
-                (hyperdrive-message "Set nickname for «%s» to %s"
-                                    (hyperdrive--format-hyperdrive hyperdrive)
-                                    (hyperdrive--format-host hyperdrive 
:format '(nickname)))
                 (hyperdrive--fill-latest-version hyperdrive headers)
-                (hyperdrive-persist hyperdrive))))
+                (hyperdrive-persist hyperdrive)
+                (funcall then hyperdrive))))
     ;; TODO: Consider refreshing buffer names, directory headers, etc, 
especially host-meta.json entry buffer.
     )
   hyperdrive)
@@ -360,7 +363,7 @@ for more information.  See `hyperdrive-read-entry' and
   (hyperdrive-open (hyperdrive-url-entry url)))
 
 ;;;###autoload
-(defun hyperdrive-download-entry (entry filename)
+(defun hyperdrive-download (entry filename)
   "Download ENTRY to FILENAME on disk.
 Interactively, downloads current hyperdrive file.  If current
 buffer is not a hyperdrive file, prompts with
@@ -370,9 +373,7 @@ With universal prefix argument \\[universal-argument], 
prompts
 for more information.  See `hyperdrive-read-entry' and
 `hyperdrive-complete-hyperdrive'."
   (interactive
-   (pcase-let* ((entry (if hyperdrive-mode
-                           hyperdrive-current-entry
-                         (hyperdrive-read-entry :force-prompt 
current-prefix-arg)))
+   (pcase-let* ((entry (hyperdrive--context-entry))
                 ((cl-struct hyperdrive-entry name) entry)
                 (read-filename (read-file-name "Filename: " (expand-file-name 
name hyperdrive-download-directory))))
      (list entry read-filename)))
@@ -484,13 +485,18 @@ hyperdrive directory listing or a `hyperdrive-mode' file 
buffer."
     (kill-new url)
     (hyperdrive-message "%s" url)))
 
-(defun hyperdrive-up ()
-  "Go up to parent directory."
+(cl-defun hyperdrive-up (entry &key then)
+  "Go up to parent directory of ENTRY.
+Interactively, use the `hyperdrive-current-entry'.  If THEN, pass
+it to `hyperdrive-open'."
   (declare (modes hyperdrive-mode))
-  (interactive)
-  (if-let ((parent (hyperdrive-parent hyperdrive-current-entry)))
+  (interactive (progn
+                 (unless (and hyperdrive-mode hyperdrive-current-entry)
+                   (user-error "Not a hyperdrive buffer"))
+                 (list hyperdrive-current-entry)))
+  (if-let ((parent (hyperdrive-parent entry)))
       ;; TODO: Go to entry in parent directory.
-      (hyperdrive-open parent)
+      (hyperdrive-open parent :then then)
     (hyperdrive-user-error "At root directory")))
 
 (defvar-keymap hyperdrive-up-map



reply via email to

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