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

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

[nongnu] elpa/hyperdrive 6c295d8b2c 054/102: Add: (--format) Display hyp


From: ELPA Syncer
Subject: [nongnu] elpa/hyperdrive 6c295d8b2c 054/102: Add: (--format) Display hyperdrive according to format string
Date: Wed, 29 Nov 2023 04:00:52 -0500 (EST)

branch: elpa/hyperdrive
commit 6c295d8b2cd13c71555d9fb838121f6a223fba82
Author: Joseph Turner <joseph@ushin.org>
Commit: Joseph Turner <joseph@ushin.org>

    Add: (--format) Display hyperdrive according to format string
    
    This commit allows hyperdrives to be formatted according to format
    strings, just as the previous commits in this branch allowed entries
    to be formatted according to format strings.
---
 doc/hyperdrive.org     |   2 +-
 doc/hyperdrive.texi    |   2 +-
 hyperdrive-describe.el |  25 +++-----
 hyperdrive-lib.el      | 168 ++++++++++++++++++++++++++-----------------------
 hyperdrive-menu.el     |  14 +++--
 hyperdrive-vars.el     |  66 ++++++++++++-------
 hyperdrive.el          |  12 ++--
 7 files changed, 155 insertions(+), 134 deletions(-)

diff --git a/doc/hyperdrive.org b/doc/hyperdrive.org
index 70150f1ec4..d8df353e89 100644
--- a/doc/hyperdrive.org
+++ b/doc/hyperdrive.org
@@ -888,7 +888,7 @@ DIRECTION being one of ~:ascending~ or ~:descending~.
   format is like ~hyperdrive-default-entry-format~ with the entry name
   sans directory instead of the full path.
 
-- ~hyperdrive-format-alist~ :: Alist mapping hyperdrive and hyperdrive
+- ~hyperdrive-formats~ :: Alist mapping hyperdrive and hyperdrive
   entry metadata to a format string, used in
   ~hyperdrive-default-entry-format~ and ~hyperdrive-buffer-name-format~ as
   well as other places hyperdrives or entries are displayed.  By
diff --git a/doc/hyperdrive.texi b/doc/hyperdrive.texi
index 7605ecfa4c..e1be23d24c 100644
--- a/doc/hyperdrive.texi
+++ b/doc/hyperdrive.texi
@@ -1356,7 +1356,7 @@ buffers visiting hyperdrive files/directories.  By 
default, this
 format is like @code{hyperdrive-default-entry-format} with the entry name
 sans directory instead of the full path.
 
-@item @code{hyperdrive-format-alist}
+@item @code{hyperdrive-formats}
 Alist mapping hyperdrive and hyperdrive
 entry metadata to a format string, used in
 @code{hyperdrive-default-entry-format} and 
@code{hyperdrive-buffer-name-format} as
diff --git a/hyperdrive-describe.el b/hyperdrive-describe.el
index 0d9272e85e..0de5c7f5b6 100644
--- a/hyperdrive-describe.el
+++ b/hyperdrive-describe.el
@@ -50,30 +50,19 @@ Universal prefix argument \\[universal-argument] forces
   ;; TODO: Do we want to asynchronously fill the hyperdrive's latest version?
   (hyperdrive-fill-latest-version hyperdrive)
   (with-current-buffer (get-buffer-create
-                        (format "*Hyperdrive: %s*"
-                                (hyperdrive--format-host hyperdrive :format 
'(short-key)
-                                                         :with-label t)))
+                        (format "*Hyperdrive: %s*" (hyperdrive--format 
hyperdrive "%k")))
     (with-silent-modifications
       (hyperdrive-describe-mode)
       (setq-local hyperdrive-describe-current-hyperdrive hyperdrive)
-      (pcase-let (((cl-struct hyperdrive metadata domains writablep) 
hyperdrive))
+      (pcase-let (((cl-struct hyperdrive metadata writablep) hyperdrive))
         (erase-buffer)
         (insert
          (propertize "Hyperdrive: \n" 'face 'bold)
-         (format "Public key: %s\n" (hyperdrive--format-host hyperdrive 
:format '(public-key)))
-         (format "Seed: %s\n" (or (hyperdrive--format-host hyperdrive :format 
'(seed))
-                                  "[none]"))
-         (format "Petname: %s\n" (or (hyperdrive--format-host hyperdrive 
:format '(petname))
-                                     "[none]"))
-         (format "Nickname: %s\n" (or (hyperdrive--format-host hyperdrive 
:format '(nickname))
-                                      "[none]"))
-         (format "Domains: %s\n"
-                 (if domains
-                     (string-join (mapcar (lambda (domain)
-                                            (propertize domain 'face 
'hyperdrive-domain))
-                                          domains)
-                                  ", ")
-                   "[none]"))
+         (hyperdrive--format hyperdrive "Public key %K:\n" 
hyperdrive-raw-formats)
+         (hyperdrive--format hyperdrive "Seed: %S\n" hyperdrive-raw-formats)
+         (hyperdrive--format hyperdrive "Petname: %P\n" hyperdrive-raw-formats)
+         (hyperdrive--format hyperdrive "Nickname: %N\n" 
hyperdrive-raw-formats)
+         (hyperdrive--format hyperdrive "Domains: %D\n" hyperdrive-raw-formats)
          (format "Latest version: %s\n" (hyperdrive-latest-version hyperdrive))
          (format "Writable: %s\n" (if writablep "yes" "no"))
          (format "Metadata: %s\n"
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index 8b99b1032f..b1c1c3fb27 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -926,7 +926,7 @@ Returns URL formatted like:
 
   hyper://HOST-FORMAT/PATH/TO/FILE
 
-HOST-FORMAT is passed to `hyperdrive--format-host', which see.
+HOST-FORMAT is passed to `hyperdrive--preferred-format', which see.
 If WITH-PROTOCOL, \"hyper://\" is prepended.  If WITH-HELP-ECHO,
 propertize string with `help-echo' property showing the entry's
 full URL.  If WITH-TARGET, append the ENTRY's target, stored in
@@ -947,8 +947,8 @@ Path and target fragment are URI-encoded."
                            "hyper://"))
                (host (when host-format
                        ;; FIXME: Update docstring to say that host-format can 
be nil to omit it.
-                       (hyperdrive--format-host (hyperdrive-entry-hyperdrive 
entry)
-                                                :format host-format)))
+                       (hyperdrive--preferred-format 
(hyperdrive-entry-hyperdrive entry)
+                                                     host-format 
hyperdrive-raw-formats)))
                (version-part (and version (format "/$/version/%s" version)))
                ((map target) etc)
                (target-part (when (and with-target target)
@@ -965,37 +965,72 @@ Path and target fragment are URI-encoded."
                                 :with-path with-path :with-help-echo nil 
:with-target with-target))
       url)))
 
-(cl-defun hyperdrive--format-host
-    (hyperdrive &key with-label (format hyperdrive-preferred-naming))
+(defun hyperdrive--format (hyperdrive &optional format formats)
+  "Return HYPERDRIVE formatted according to FORMAT.
+FORMAT is a `format-spec' specifier string which maps to specifications
+according to FORMATS, by default `hyperdrive-formats', which see."
+  (pcase-let* (((cl-struct hyperdrive domains public-key petname seed
+                           (metadata (map ('name nickname))))
+                hyperdrive)
+               (format (or format "%H"))
+               (formats (or formats hyperdrive-formats)))
+    (cl-labels ((fmt (naming value string face)
+                  (if value
+                      (format (alist-get naming formats)
+                              (propertize string 'face face))
+                    "")))
+      (format-spec format
+                   ;; TODO(deprecate-28): Use lambdas in each specifier.
+                   `((?H . ,(and (string-match-p "%H" format)
+                                 ;; HACK: Once using lambdas in this specifier,
+                                 ;; remove the `string-match-p' check.
+                                 (hyperdrive--preferred-format hyperdrive)))
+                     (?P . ,(fmt 'petname petname petname 'hyperdrive-petname))
+                     (?N . ,(fmt 'nickname nickname nickname 
'hyperdrive-nickname))
+                     (?k . ,(fmt 'short-key public-key
+                                 (concat (substring public-key 0 6) "…")
+                                 'hyperdrive-public-key))
+                     (?K . ,(fmt 'public-key public-key
+                                 public-key 'hyperdrive-public-key))
+                     (?S . ,(fmt 'seed seed seed 'hyperdrive-seed))
+                     (?D . ,(if (car domains)
+                                (format (alist-get 'domains formats)
+                                        (string-join
+                                         (mapcar (lambda (domain)
+                                                   (propertize domain
+                                                               'face 
'hyperdrive-domain))
+                                                 domains)
+                                                     ","))
+                              "")))))))
+
+;; TODO: Wherever `hyperdrive--preferred-format' is called, define argument as
+;; `naming', not `host-format'.
+(defun hyperdrive--preferred-format (hyperdrive &optional naming formats)
   "Return HYPERDRIVE's formatted hostname, or nil.
-FORMAT should be one or a list of symbols, by default
+NAMING should be one or a list of symbols, by default
 `hyperdrive-preferred-naming', 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:\")."
+specified NAMING is not available, return nil.
+
+Each item in NAMING is formatted according to FORMATS, set by
+default to `hyperdrive-formats', which see."
   (pcase-let* (((cl-struct hyperdrive petname public-key domains seed
-                           (metadata (map name)))
+                           (metadata (map ('name nickname))))
                 hyperdrive))
-    (cl-flet ((fmt (string label face)
-                (concat (when with-label
-                          label)
-                        (propertize string 'face face))))
-      (cl-loop for f in (ensure-list format)
-               when (pcase f
-                      ((and 'petname (guard petname))
-                       (fmt petname "petname:" 'hyperdrive-petname))
-                      ((and 'nickname (guard name))
-                       (fmt name "nickname:" 'hyperdrive-nickname))
-                      ((and 'domain (guard (car domains)))
-                       ;; TODO: Handle the unlikely case that a drive has 
multiple domains.
-                       (fmt (car domains) "domain:" 'hyperdrive-domain))
-                      ((and 'seed (guard seed))
-                       (fmt seed "seed:" 'hyperdrive-seed))
-                      ((and 'short-key (guard public-key))
-                       ;; TODO: Consider adding a help-echo with the full key.
-                       (fmt (concat (substring public-key 0 6) "…") 
"public-key:" 'hyperdrive-public-key))
-                      ((and 'public-key (guard public-key))
-                       (fmt public-key "public-key:" 'hyperdrive-public-key)))
-               return it))))
+    (cl-loop for f in (ensure-list (or naming hyperdrive-preferred-naming))
+             when (pcase f
+                    ((and 'petname (guard petname))
+                     (hyperdrive--format hyperdrive "%P" formats))
+                    ((and 'nickname (guard nickname))
+                     (hyperdrive--format hyperdrive "%N" formats))
+                    ((and 'domain (guard (car domains)))
+                     (hyperdrive--format hyperdrive "%D" formats))
+                    ((and 'seed (guard seed))
+                     (hyperdrive--format hyperdrive "%S" formats))
+                    ((and 'short-key (guard public-key))
+                     (hyperdrive--format hyperdrive "%k" formats))
+                    ((and 'public-key (guard public-key))
+                     (hyperdrive--format hyperdrive "%K" formats)))
+             return it)))
 
 ;;;; Reading from the user
 
@@ -1053,13 +1088,12 @@ case, when PREDICATE, only offer hyperdrives matching 
it."
         (hyperdrive-user-error "No such hyperdrive.  Use `hyperdrive-new' to 
create a new one"))))
 
 (cl-defun hyperdrive--format-hyperdrive
-    (hyperdrive &key (formats '(petname nickname domain seed short-key)) 
(with-label t))
+    (hyperdrive &key (formats '(petname nickname domain seed short-key)))
   "Return HYPERDRIVE formatted for completion.
-For each of FORMATS, concatenates the value separated by two
-spaces, optionally WITH-LABEL."
+For each of FORMATS, concatenates the value separated by two spaces."
   (string-trim
    (cl-loop for format in formats
-            when (hyperdrive--format-host hyperdrive :format format 
:with-label with-label)
+            when (hyperdrive--preferred-format hyperdrive format)
             concat (concat it "  "))))
 
 (cl-defun hyperdrive-read-entry (&key hyperdrive predicate default-path
@@ -1345,52 +1379,30 @@ Affected by option `hyperdrive-reuse-buffers', which 
see."
   ;; TODO: This function is a workaround for bug#65797
   (lambda (buffer) (hyperdrive--buffer-visiting-entry-p buffer entry)))
 
-(cl-defun hyperdrive--format-entry (entry &optional (format 
hyperdrive-default-entry-format))
+(defun hyperdrive--format-entry (entry &optional format formats)
   "Return ENTRY formatted according to FORMAT.
-FORMAT may be a format string like the value of
-`hyperdrive-buffer-name-format', which see."
+FORMAT is a `format-spec' specifier string which maps to specifications
+according to FORMATS, by default `hyperdrive-formats', which see."
   (pcase-let* (((cl-struct hyperdrive-entry hyperdrive name path version) 
entry)
-               ((cl-struct hyperdrive domains public-key petname seed
-                           (metadata (map ('name nickname))))
-                hyperdrive))
-    (propertize
-     (format-spec format
-                  ;; TODO(deprecate-28): Use lambdas in each specifier.
-                  `((?n . ,name)
-                    (?p . ,path)
-                    (?v . ,(if version
-                               (format (alist-get 'version 
hyperdrive-format-alist)
-                                       version)
-                             ""))
-                    (?D . ,(if domains
-                               (format (alist-get 'domains 
hyperdrive-format-alist)
-                                       (propertize (string-join domains ",")
-                                                   'face 'hyperdrive-domain))
-                             ""))
-                    (?H . ,(hyperdrive--format-host hyperdrive :with-label t))
-                    (?k . ,(format (alist-get 'short-key 
hyperdrive-format-alist)
-                                   (concat (propertize (substring public-key 0 
6)
-                                                       'face 
'hyperdrive-public-key)
-                                           "…")))
-                    (?K . ,(format (alist-get 'public-key 
hyperdrive-format-alist)
-                                   (propertize public-key
-                                               'face 'hyperdrive-public-key)))
-                    (?N . ,(if nickname
-                               (format (alist-get 'nickname 
hyperdrive-format-alist)
-                                       (propertize nickname
-                                                   'face 'hyperdrive-nickname))
-                             ""))
-                    (?P . ,(if petname
-                               (format (alist-get 'petname 
hyperdrive-format-alist)
-                                       (propertize petname
-                                                   'face 'hyperdrive-petname))
-                             ""))
-                    (?S . ,(if seed
-                               (format (alist-get 'seed 
hyperdrive-format-alist)
-                                       (propertize seed
-                                                   'face 'hyperdrive-seed))
-                             ""))))
-     'help-echo (hyperdrive-entry-url entry))))
+               (formats (or formats hyperdrive-formats)))
+    (cl-labels ((fmt (naming value)
+                  (if value
+                      (format (alist-get naming formats) value)
+                    "")))
+      (propertize
+       (format-spec (or format hyperdrive-default-entry-format)
+                    ;; TODO(deprecate-28): Use lambdas in each specifier.
+                    `((?n . ,(fmt 'name name))
+                      (?p . ,(fmt 'path path))
+                      (?v . ,(fmt 'version version))
+                      (?H . ,(hyperdrive--preferred-format hyperdrive nil 
formats))
+                      (?D . ,(hyperdrive--format hyperdrive "%D" formats))
+                      (?k . ,(hyperdrive--format hyperdrive "%k" formats))
+                      (?K . ,(hyperdrive--format hyperdrive "%K" formats))
+                      (?N . ,(hyperdrive--format hyperdrive "%N" formats))
+                      (?P . ,(hyperdrive--format hyperdrive "%P" formats))
+                      (?S . ,(hyperdrive--format hyperdrive "%S" formats))))
+       'help-echo (hyperdrive-entry-url entry)))))
 
 (defun hyperdrive--entry-directory-p (entry)
   "Return non-nil if ENTRY is a directory."
diff --git a/hyperdrive-menu.el b/hyperdrive-menu.el
index 33915a6575..cc278fdbc6 100644
--- a/hyperdrive-menu.el
+++ b/hyperdrive-menu.el
@@ -66,7 +66,7 @@
       (if-let* ((entry (hyperdrive-menu--scope))
                 (hyperdrive (hyperdrive-entry-hyperdrive entry)))
           (concat (propertize "Hyperdrive: " 'face 'transient-heading)
-                  (hyperdrive--format-host hyperdrive :with-label t))
+                  (hyperdrive--format hyperdrive))
         "Hyperdrive"))
     ("h" "Hyperdrive" hyperdrive-menu-hyperdrive)
     ("N" "New drive" hyperdrive-new)
@@ -244,14 +244,16 @@
    :pad-keys t
    ("d" hyperdrive-menu-describe-hyperdrive)
    ("w" hyperdrive-menu-hyperdrive-copy-url)
-   (:info (lambda () (concat "Public key: " (hyperdrive--format-host 
(hyperdrive-menu--scope) :format 'public-key))))
-   (:info (lambda () (concat "Seed: " (hyperdrive--format-host 
(hyperdrive-menu--scope) :format 'seed)))
-    :if (lambda () (hyperdrive-seed (hyperdrive-menu--scope))))
+   (:info (lambda () (hyperdrive--format (hyperdrive-menu--scope) "Public key: 
%K"
+                                         hyperdrive-raw-formats)))
+   (:info (lambda () (hyperdrive--format (hyperdrive-menu--scope) "Seed: %S" 
hyperdrive-raw-formats))
+          :if (lambda () (hyperdrive-seed (hyperdrive-menu--scope))))
    ("p" hyperdrive-menu-set-petname  :transient t)
    ("n" hyperdrive-menu-set-nickname :transient t
     :inapt-if-not (lambda () (hyperdrive-writablep (hyperdrive-menu--scope))))
-   (:info (lambda () (concat "Domain: " (hyperdrive--format-host 
(hyperdrive-menu--scope) :format 'domain)))
-    :if (lambda () (hyperdrive-domains (hyperdrive-menu--scope))))
+   (:info (lambda () (hyperdrive--format (hyperdrive-menu--scope) "Domain: %D"
+                                         hyperdrive-raw-formats))
+          :if (lambda () (hyperdrive-domains (hyperdrive-menu--scope))))
    (:info (lambda () (format "Latest version: %s" (hyperdrive-latest-version 
(hyperdrive-menu--scope)))))]
   [["Open"
     ("f"   "Find file"    hyperdrive-menu-open-file)
diff --git a/hyperdrive-vars.el b/hyperdrive-vars.el
index f175a10de8..9f4426a9b7 100644
--- a/hyperdrive-vars.el
+++ b/hyperdrive-vars.el
@@ -175,26 +175,25 @@ an existing buffer at the same version, or make a new 
buffer."
   "Format string for displaying entries.
 Specifiers:
 
-%n  Entry name
-%p  Entry path
 %H  Preferred hyperdrive naming (see `hyperdrive-preferred-naming')
 
-The format of the following specifiers can be configured using
-`hyperdrive-format-alist':
+To configure the format of the following specifiers, see `hyperdrive-formats':
 
+%n  Entry name
+%p  Entry path
 %v  Entry version
-%D  Hyperdrive domains
-%k  Hyperdrive public key (short)
-%K  Hyperdrive public key (full)
-%N  Hyperdrive nickname
+%S  Hyperdrive seed
 %P  Hyperdrive petname
-%S  Hyperdrive seed"
+%N  Hyperdrive nickname
+%K  Hyperdrive public key (full)
+%k  Hyperdrive public key (short)
+%D  Hyperdrive domains"
   :type 'string)
 
 (defvar hyperdrive-default-entry-format-without-version "[%H] %p"
   "Format string for displaying entries without displaying the version.
 The format of the following specifiers can be configured using
-`hyperdrive-format-alist', which see.")
+`hyperdrive-formats', which see.")
 
 (defcustom hyperdrive-buffer-name-format "[%H] %n%v"
   "Format string for buffer names.
@@ -202,23 +201,42 @@ Specifiers are as in `hyperdrive-default-entry-format', 
which
 see."
   :type 'string)
 
-(defcustom hyperdrive-format-alist '((version    . " (version:%s)")
-                                     (domains    . "domains:%s")
-                                     (nickname   . "nickname:%s")
-                                     (petname    . "petname:%s")
-                                     (public-key . "public-key:%s")
-                                     (short-key  . "public-key:%s")
-                                     (seed       . "seed:%s"))
+(defvar hyperdrive-raw-formats '(;; Entry metadata
+                                 (name    . "%s")
+                                 (path    . "%s")
+                                 (version . "%s")
+                                 ;; Hyperdrive metadata
+                                 (petname    . "%s")
+                                 (nickname   . "%s")
+                                 (public-key . "%s")
+                                 (short-key  . "%s")
+                                 (seed       . "%s")
+                                 (domains    . "%s"))
+  "Like `hyperdrive-formats', without any special formatting.")
+
+(defcustom hyperdrive-formats '(;; Entry metadata
+                                (name       . "%s")
+                                (version    . " (version:%s)")
+                                (path       . "%s")
+                                ;; Hyperdrive metadata
+                                (petname    . "petname:%s")
+                                (nickname   . "nickname:%s")
+                                (public-key . "public-key:%s")
+                                (short-key  . "public-key:%s")
+                                (seed       . "seed:%s")
+                                (domains    . "domains:%s"))
   "Alist mapping hyperdrive and hyperdrive entry metadata item to format 
string.
 Each metadata item may be one of:
 
-- petname
-- nickname
-- version
-- domains
-- public-key
-- short-key
-- seed
+- \\+`name' (Entry name)
+- \\+`path' (Entry path)
+- \\+`version' (Entry version)
+- \\+`petname' (Hyperdrive petname)
+- \\+`nickname' (Hyperdrive nickname)
+- \\+`domains' (Hyperdrive domains)
+- \\+`public-key' (Hyperdrive public key)
+- \\+`short-key' (Hyperdrive short key)
+- \\+`seed' (Hyperdrive seed)
 
 In each corresponding format string, \"%s\" is replaced with the
 metadatum. Used in `hyperdrive-buffer-name-format', which see."
diff --git a/hyperdrive.el b/hyperdrive.el
index b19133bfe6..f9edecab42 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -860,7 +860,7 @@ The return value of this function is the retrieval buffer."
                (cl-labels ((list-drives (drives)
                              (cl-loop for drive in drives
                                       for entry = (hyperdrive-entry-create 
:hyperdrive drive)
-                                      collect (list (hyperdrive--format-host 
drive :with-label t)
+                                      collect (list (hyperdrive--format drive)
                                                     (vector "Describe"
                                                             `(lambda ()
                                                                (interactive)
@@ -949,15 +949,15 @@ The return value of this function is the retrieval 
buffer."
                  (append (list ["Writable" :active nil])
                          (or (list-drives (sort (cl-remove-if-not 
#'hyperdrive-writablep (hash-table-values hyperdrive-hyperdrives))
                                                 (lambda (a b)
-                                                  (string< 
(hyperdrive--format-host a :with-label t)
-                                                           
(hyperdrive--format-host b :with-label t)))))
+                                                  (string< (hyperdrive--format 
a)
+                                                           (hyperdrive--format 
b)))))
                              (list ["none" :active nil]))
                          (list "---")
                          (list ["Read-only" :active nil])
                          (or (list-drives (sort (cl-remove-if 
#'hyperdrive-writablep (hash-table-values hyperdrive-hyperdrives))
                                                 (lambda (a b)
-                                                  (string< 
(hyperdrive--format-host a :with-label t)
-                                                           
(hyperdrive--format-host b :with-label t)))))
+                                                  (string< (hyperdrive--format 
a)
+                                                           (hyperdrive--format 
b)))))
                              (list ["none" :active nil]))))))
     ("Current"
      :active hyperdrive-current-entry
@@ -969,7 +969,7 @@ The return value of this function is the retrieval buffer."
       :active hyperdrive-current-entry
       :label (if-let* ((entry hyperdrive-current-entry)
                        (hyperdrive (hyperdrive-entry-hyperdrive entry)))
-                 (format "Current Drive «%s»" (hyperdrive--format-host 
hyperdrive :with-label t))
+                 (format "Current Drive «%s»" (hyperdrive--format hyperdrive))
                "Current Drive")
       ["Find File"
        (lambda ()



reply via email to

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