[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
- [nongnu] elpa/hyperdrive d138f92165 093/123: Change: (hyperdrive-menu-hyperdrive) Rename Drive -> Hyperdrive, (continued)
- [nongnu] elpa/hyperdrive d138f92165 093/123: Change: (hyperdrive-menu-hyperdrive) Rename Drive -> Hyperdrive, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive cca8fa76cc 116/123: Comment: Remove FIXME, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 0c205cdb4c 114/123: Comment: Add TODO, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive f7d7cec5b0 097/123: Comment: Add TODO, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive f5013519c5 101/123: Change: Rearrange some commands, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 785ebe8edd 110/123: Fix: (hyperdrive-menu) Update next/prev between files/dirs, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive f83e955abc 108/123: Change: (hyperdrive-menu-set-pet/nickname) :transient t, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive ec3692c439 120/123: Change: (hyperdrive-menu) Add hyperdrive-delete, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 247afd42e4 090/123: Change: (hyperdrive-menu) Rename Info manual -> Help, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 665e8f289c 016/123: WIP, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive b5dc019164 123/123: Merge: Add Transient menu interface,
ELPA Syncer <=
- [nongnu] elpa/hyperdrive 30f7bc0928 069/123: Change: (hyperdrive-menu) Just use w for hyperdrive-copy-url, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 87647b12ce 025/123: Change: (hyperdrive-up) Take ENTRY as argument, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 9ff6b945ce 086/123: Change: (-menu) Add Hyperdrive group description, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 8593993edb 083/123: Tidy: Remove unnecessary let-bindingc, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 28efe94c8f 122/123: Tidy: Checkdoc, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 7276398ace 098/123: Comment: Add TODO, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 094254c47f 014/123: WIP, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 8d19126e2b 033/123: WIP checkpoint, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 3b688528df 020/123: WIP, ELPA Syncer, 2023/10/06
- [nongnu] elpa/hyperdrive 621268b2a9 024/123: Add: (hyperdrive--context-entry), ELPA Syncer, 2023/10/06