branch: elpa/hyperdrive
commit e9bf65e9475b3c72efcc3a55d606f63e980ce689
Author: Joseph Turner <jos...@ushin.org>
Commit: Joseph Turner <jos...@ushin.org>
Meta: Move hyperdrive-menu into own file
---
hyperdrive-dir.el | 2 +-
hyperdrive-menu.el | 198 +++++++++++++++++++++++++++++++++++++++++++++++++++++
hyperdrive.el | 157 ------------------------------------------
3 files changed, 199 insertions(+), 158 deletions(-)
diff --git a/hyperdrive-dir.el b/hyperdrive-dir.el
index e8cb73915f..702497164a 100644
--- a/hyperdrive-dir.el
+++ b/hyperdrive-dir.el
@@ -235,7 +235,7 @@ With point on header, returns directory entry."
(declare-function hyperdrive-up "hyperdrive")
(declare-function hyperdrive-download "hyperdrive")
(declare-function hyperdrive-describe-hyperdrive "hyperdrive-describe")
-(declare-function hyperdrive-menu "hyperdrive")
+(declare-function hyperdrive-menu "hyperdrive-menu")
(defvar-keymap hyperdrive-dir-mode-map
:parent hyperdrive-ewoc-mode-map
diff --git a/hyperdrive-menu.el b/hyperdrive-menu.el
new file mode 100644
index 0000000000..a6093643b4
--- /dev/null
+++ b/hyperdrive-menu.el
@@ -0,0 +1,198 @@
+;;; hyperdrive.el --- P2P filesystem -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023 USHIN, Inc.
+
+;; Author: Adam Porter <a...@alphapapa.net>
+;; Author: Joseph Turner <jos...@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 'compat)
+
+(require 'hyperdrive-vars)
+(require 'hyperdrive-lib)
+
+;;;;; Transient support
+
+(require 'transient)
+
+;; 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))))
+
+(declare-function hyperdrive-dir--entry-at-point "hyperdrive-dir")
+
+(transient-define-suffix hyperdrive-menu-up ()
+ ;; :transient 'transient--do-call
+ (interactive)
+ (hyperdrive-menu (hyperdrive-parent (oref transient-current-prefix scope))))
+
+(transient-define-prefix hyperdrive-menu (entry)
+ "Show the hyperdrive transient menu."
+
+ [ :class transient-row
+ :description
+ (lambda ()
+ (let ((hyperdrive (hyperdrive-entry-hyperdrive (oref transient--prefix
scope))))
+ (concat (propertize "Drive: " 'face 'transient-heading)
+ (hyperdrive--format-hyperdrive hyperdrive :formats '(short-key
seed domain nickname petname))
+ (format " latest:%s" (hyperdrive-latest-version
hyperdrive)))))
+ ("s p" "Petname" hyperdrive-set-petname
+ :if-non-nil hyperdrive-current-entry
+ :description (lambda ()
+ (format "Petname: %s"
+ (pcase (hyperdrive-petname
+ (hyperdrive-entry-hyperdrive (oref
transient--prefix scope)))
+ (`nil (propertize "none"
+ 'face
'transient-inactive-value))
+ (it (propertize it
+ 'face 'transient-value))))))
+ ("s n" "Nickname" hyperdrive-set-nickname
+ :if (lambda () (and (oref transient--prefix scope)
+ (hyperdrive-writablep (hyperdrive-entry-hyperdrive
(oref transient--prefix scope)))))
+ :description (lambda ()
+ (format "Nickname: %s"
+ ;; TODO: Hyperdrive-metadata accessor (and maybe
gv setter).
+ (pcase (alist-get 'name
+ (hyperdrive-metadata
+ (hyperdrive-entry-hyperdrive
(oref transient--prefix scope))))
+ (`nil (propertize "none"
+ 'face
'transient-inactive-value))
+ (it (propertize it
+ 'face 'transient-value))))))
+ ("?" "Info manual" hyperdrive-info-manual)]
+ [["Gateway"
+ ("g s" "Start" hyperdrive-start)
+ ("g S" "Stop" hyperdrive-stop)
+ ("g v" "Version" hyperdrive-hyper-gateway-version)]
+ ["Drives"
+ ;; TODO: Consider showing current drive's public key or formatted name.
+ ("d n" "New" hyperdrive-new)
+ ("d d" "Describe" hyperdrive-describe-hyperdrive)
+ ("d P" "Purge" hyperdrive-purge)]
+ ["Bookmark"
+ ("b j" "Jump" hyperdrive-bookmark-jump)
+ ("b l" "List" hyperdrive-bookmark-list)
+ ("b s" "Set" bookmark-set)]
+ ["Files"
+ ("f f" "Find" hyperdrive-find-file)
+ ("f v" "View" hyperdrive-view-file)
+ ("f o" "Open URL" hyperdrive-open-url)
+ ("o" "Sort" hyperdrive-dir-sort
+ :if-mode hyperdrive-dir-mode)]
+ ["Upload"
+ ("u f" "File" hyperdrive-upload-file)
+ ("u F" "Files" hyperdrive-upload-files)
+ ("u m" "Mirror" hyperdrive-mirror)]]
+ [ ;; :class transient-row
+ :description
+ (lambda ()
+ (let ((entry (oref transient--prefix scope)))
+ (concat (propertize (if (hyperdrive--entry-directory-p entry)
+ "Directory" "File")
+ 'face 'transient-heading)
+ ": "
+ (propertize (hyperdrive--format-path (hyperdrive-entry-path
entry))
+ 'face 'transient-value))))
+ [ ;; "File"
+ :if (lambda ()
+ (let ((entry (oref transient--prefix scope)))
+ (or (and entry
+ (not (hyperdrive--entry-directory-p entry)))
+ (and (eq major-mode 'hyperdrive-dir-mode)
+ (hyperdrive-dir--entry-at-point)))))
+ ("f d" "Download" hyperdrive-download)
+ ;; FIXME: Enable this as a command.
+ ;; ("f D" "Delete" hyperdrive-delete)
+
+ ("f ^" "Up to parent" hyperdrive-menu-up)
+ ("f w" "Copy URL" hyperdrive-copy-url)
+ ;; ("f g"
+ ;; TODO: Consider whether we want to have a menu entry for revert-buffer.
+ ;; ;; TODO: Learn how to use `transient-setup-children' to
+ ;; ;; set up this group at runtime and include the default
+ ;; ;; `revert-buffer' binding.
+ ;; revert-buffer :description "Revert")
+ ("f s" "Save"
+ ;; TODO: Learn how to use `transient-setup-children' to
+ ;; set up this group at runtime and include the default
+ ;; `save-buffer' binding.
+ save-buffer)
+ ("f W"
+ ;; TODO: Learn how to use `transient-setup-children' to
+ ;; set up this group at runtime and include the default
+ ;; `write-buffer' binding.
+ hyperdrive-write-buffer :description "Write")]
+ ["Version"
+ :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 h" "History" hyperdrive-history)
+ ("v n" "Next" hyperdrive-next-version
+ :if-not (lambda () (oref transient--prefix scope))
+ :inapt-if-not (lambda ()
+ (hyperdrive-entry-version (hyperdrive-entry-next (oref
transient--prefix scope))))
+ ;; :transient t
+ :description (lambda ()
+ (if-let ((entry (oref transient--prefix scope))
+ (hyperdrive (hyperdrive-entry-hyperdrive entry)))
+ (concat "Next" (when-let ((version
(hyperdrive-entry-version (hyperdrive-entry-next entry))))
+ (concat ": " (propertize
(number-to-string version)
+ 'face
'transient-value))))
+ "Next")))
+ ("v p" "Previous" hyperdrive-previous-version
+ :if-not (lambda () (oref transient--prefix scope))
+ :inapt-if-not (lambda ()
+ (pcase (hyperdrive-entry-previous (oref transient--prefix
scope) :cache-only t)
+ ('unknown nil)
+ (it (hyperdrive-entry-version it))))
+ ;; :transient t
+ :description (lambda ()
+ (if-let ((entry (oref transient--prefix scope))
+ (hyperdrive (hyperdrive-entry-hyperdrive entry)))
+ (concat "Previous" (when-let ((version
(hyperdrive-entry-version (hyperdrive-entry-previous entry))))
+ (concat ": " (propertize
(number-to-string version)
+ 'face
'transient-value))))
+ "Previous")))]]
+ (interactive (list (hyperdrive--context-entry)))
+ (transient-setup 'hyperdrive-menu nil nil :scope entry))
+
+;;;; Footer
+
+(provide 'hyperdrive-menu)
+
+;;; hyperdrive-menu.el ends here
diff --git a/hyperdrive.el b/hyperdrive.el
index ea32619db1..3e7ae9c4fd 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -766,163 +766,6 @@ The return value of this function is the retrieval
buffer."
(cl-pushnew #'hyperdrive-kill-buffer-query-function
kill-buffer-query-functions)
-;;;;; Transient support
-
-(require 'transient)
-
-;; TODO: Use something like this later.
-;; (defmacro hyperdrive-transient-lambda (&rest body)
-;; (declare (indent defun))
-;; `(lambda ()
-;; (when hyperdrive-current-entry
-;; (pcase-let (((cl-struct hyperdrive-entry hyperdrive)
-;; hyperdrive-current-entry))
-;; ,@body))))
-
-(declare-function hyperdrive-dir--entry-at-point "hyperdrive-dir")
-
-(transient-define-suffix hyperdrive-menu-up ()
- ;; :transient 'transient--do-call
- (interactive)
- (hyperdrive-menu (hyperdrive-parent (oref transient-current-prefix scope))))
-
-(transient-define-prefix hyperdrive-menu (entry)
- "Show the hyperdrive transient menu."
-
- [ :class transient-row
- :description
- (lambda ()
- (let ((hyperdrive (hyperdrive-entry-hyperdrive (oref transient--prefix
scope))))
- (concat (propertize "Drive: " 'face 'transient-heading)
- (hyperdrive--format-hyperdrive hyperdrive :formats '(short-key
seed domain nickname petname))
- (format " latest:%s" (hyperdrive-latest-version
hyperdrive)))))
- ("s p" "Petname" hyperdrive-set-petname
- :if-non-nil hyperdrive-current-entry
- :description (lambda ()
- (format "Petname: %s"
- (pcase (hyperdrive-petname
- (hyperdrive-entry-hyperdrive (oref
transient--prefix scope)))
- (`nil (propertize "none"
- 'face
'transient-inactive-value))
- (it (propertize it
- 'face 'transient-value))))))
- ("s n" "Nickname" hyperdrive-set-nickname
- :if (lambda () (and (oref transient--prefix scope)
- (hyperdrive-writablep (hyperdrive-entry-hyperdrive
(oref transient--prefix scope)))))
- :description (lambda ()
- (format "Nickname: %s"
- ;; TODO: Hyperdrive-metadata accessor (and maybe
gv setter).
- (pcase (alist-get 'name
- (hyperdrive-metadata
- (hyperdrive-entry-hyperdrive
(oref transient--prefix scope))))
- (`nil (propertize "none"
- 'face
'transient-inactive-value))
- (it (propertize it
- 'face 'transient-value))))))
- ("?" "Info manual" hyperdrive-info-manual)]
- [["Gateway"
- ("g s" "Start" hyperdrive-start)
- ("g S" "Stop" hyperdrive-stop)
- ("g v" "Version" hyperdrive-hyper-gateway-version)]
- ["Drives"
- ;; TODO: Consider showing current drive's public key or formatted name.
- ("d n" "New" hyperdrive-new)
- ("d d" "Describe" hyperdrive-describe-hyperdrive)
- ("d P" "Purge" hyperdrive-purge)]
- ["Bookmark"
- ("b j" "Jump" hyperdrive-bookmark-jump)
- ("b l" "List" hyperdrive-bookmark-list)
- ("b s" "Set" bookmark-set)]
- ["Files"
- ("f f" "Find" hyperdrive-find-file)
- ("f v" "View" hyperdrive-view-file)
- ("f o" "Open URL" hyperdrive-open-url)
- ("o" "Sort" hyperdrive-dir-sort
- :if-mode hyperdrive-dir-mode)]
- ["Upload"
- ("u f" "File" hyperdrive-upload-file)
- ("u F" "Files" hyperdrive-upload-files)
- ("u m" "Mirror" hyperdrive-mirror)]]
- [ ;; :class transient-row
- :description
- (lambda ()
- (let ((entry (oref transient--prefix scope)))
- (concat (propertize (if (hyperdrive--entry-directory-p entry)
- "Directory" "File")
- 'face 'transient-heading)
- ": "
- (propertize (hyperdrive--format-path (hyperdrive-entry-path
entry))
- 'face 'transient-value))))
- [ ;; "File"
- :if (lambda ()
- (let ((entry (oref transient--prefix scope)))
- (or (and entry
- (not (hyperdrive--entry-directory-p entry)))
- (and (eq major-mode 'hyperdrive-dir-mode)
- (hyperdrive-dir--entry-at-point)))))
- ("f d" "Download" hyperdrive-download)
- ;; FIXME: Enable this as a command.
- ;; ("f D" "Delete" hyperdrive-delete)
-
- ("f ^" "Up to parent" hyperdrive-menu-up)
- ("f w" "Copy URL" hyperdrive-copy-url)
- ;; ("f g"
- ;; TODO: Consider whether we want to have a menu entry for revert-buffer.
- ;; ;; TODO: Learn how to use `transient-setup-children' to
- ;; ;; set up this group at runtime and include the default
- ;; ;; `revert-buffer' binding.
- ;; revert-buffer :description "Revert")
- ("f s" "Save"
- ;; TODO: Learn how to use `transient-setup-children' to
- ;; set up this group at runtime and include the default
- ;; `save-buffer' binding.
- save-buffer)
- ("f W"
- ;; TODO: Learn how to use `transient-setup-children' to
- ;; set up this group at runtime and include the default
- ;; `write-buffer' binding.
- hyperdrive-write-buffer :description "Write")]
- ["Version"
- :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 h" "History" hyperdrive-history)
- ("v n" "Next" hyperdrive-next-version
- :if-not (lambda () (oref transient--prefix scope))
- :inapt-if-not (lambda ()
- (hyperdrive-entry-version (hyperdrive-entry-next (oref
transient--prefix scope))))
- ;; :transient t
- :description (lambda ()
- (if-let ((entry (oref transient--prefix scope))
- (hyperdrive (hyperdrive-entry-hyperdrive entry)))
- (concat "Next" (when-let ((version
(hyperdrive-entry-version (hyperdrive-entry-next entry))))
- (concat ": " (propertize
(number-to-string version)
- 'face
'transient-value))))
- "Next")))
- ("v p" "Previous" hyperdrive-previous-version
- :if-not (lambda () (oref transient--prefix scope))
- :inapt-if-not (lambda ()
- (pcase (hyperdrive-entry-previous (oref transient--prefix
scope) :cache-only t)
- ('unknown nil)
- (it (hyperdrive-entry-version it))))
- ;; :transient t
- :description (lambda ()
- (if-let ((entry (oref transient--prefix scope))
- (hyperdrive (hyperdrive-entry-hyperdrive entry)))
- (concat "Previous" (when-let ((version
(hyperdrive-entry-version (hyperdrive-entry-previous entry))))
- (concat ": " (propertize
(number-to-string version)
- 'face
'transient-value))))
- "Previous")))]]
- (interactive (list (hyperdrive--context-entry)))
- (transient-setup 'hyperdrive-menu nil nil :scope entry))
-
;;;; Footer
(provide 'hyperdrive)
