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

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

[nongnu] elpa/hyperdrive 69d0d16b18 063/102: Use format-spec to customiz


From: ELPA Syncer
Subject: [nongnu] elpa/hyperdrive 69d0d16b18 063/102: Use format-spec to customize hyperdrive and entry display
Date: Wed, 29 Nov 2023 04:00:54 -0500 (EST)

branch: elpa/hyperdrive
commit 69d0d16b18b8cf25be2f050bc6e4a9228e054c87
Merge: e7a01e7f5a 804ec989d3
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    Use format-spec to customize hyperdrive and entry display
---
 DEV.org                |   2 +-
 doc/hyperdrive.org     |  24 ++++++-
 doc/hyperdrive.texi    |  20 ++++++
 hyperdrive-describe.el |  25 ++-----
 hyperdrive-diff.el     |  10 +--
 hyperdrive-dir.el      |   6 +-
 hyperdrive-history.el  |   6 +-
 hyperdrive-lib.el      | 181 +++++++++++++++++++++++++++++--------------------
 hyperdrive-menu.el     |  14 ++--
 hyperdrive-org.el      |   4 +-
 hyperdrive-vars.el     |  97 +++++++++++++++++++++++++-
 hyperdrive.el          |  37 +++++-----
 12 files changed, 295 insertions(+), 131 deletions(-)

diff --git a/DEV.org b/DEV.org
index 9b2ee312f3..6de2c31d52 100644
--- a/DEV.org
+++ b/DEV.org
@@ -25,7 +25,7 @@
 + *Internals*
   + [X] Add a ~petname~ field to the ~hyperdrive~ struct.
   + [X] Add /petnames/ support to ~hyperdrive--format-host~.
-  + [X] Add petname to ~hyperdrive-default-host-format~.
+  + [X] Add petname to ~hyperdrive-preferred-formats~.
   + [X] Add petname face.
   + [X] Add faces for all types of hostname formats.
   + [X] Change ~public-name~ to ~nickname~ everywhere.
diff --git a/doc/hyperdrive.org b/doc/hyperdrive.org
index d84022528d..7f19d0ff32 100644
--- a/doc/hyperdrive.org
+++ b/doc/hyperdrive.org
@@ -848,9 +848,10 @@ DIRECTION being one of ~:ascending~ or ~:descending~.
 - ~hyperdrive-history-display-buffer-action~ :: Display buffer action
   for hyperdrive history buffers. Passed to ~display-buffer~, which see.
 
-#+vindex: hyperdrive-default-host-format
-- ~hyperdrive-default-host-format~ :: Default format for displaying
-  hyperdrive hostnames. See [[*Naming][Naming]] section for what this means.
+#+vindex: hyperdrive-preferred-formats
+- ~hyperdrive-preferred-formats~ :: List of metadata types used to
+  display hyperdrives.  Hyperdrives are displayed using the first
+  available metadata type.  See [[*Naming][Naming]] section for what this 
means.
 
 #+vindex: hyperdrive-stream-player-command
 - ~hyperdrive-stream-player-command~ :: Command used to play streamable
@@ -877,6 +878,23 @@ DIRECTION being one of ~:ascending~ or ~:descending~.
   version. To have separate buffers for each version of a
   file/directory, use ~same-version~.
 
+- ~hyperdrive-default-entry-format~ :: Format string for displaying
+  hyperdrive entries (files/directories).  By default, entries are
+  displayed with the default host format in brackets, followed by the
+  full entry path, followed by "version: " and version in parentheses.
+
+- ~hyperdrive-buffer-name-format~ :: Format string for buffer names of
+  buffers visiting hyperdrive files/directories.  By default, this
+  format is like ~hyperdrive-default-entry-format~ with the entry name
+  sans directory instead of the full path.
+
+- ~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
+  default, each metadatum is prefixed by its type, e.g., the petname
+  ~foo~ is displayed by default as ~petname:foo~.
+
 ** Additional customization
 
 This section mentions ways to change the behavior of ~hyperdrive.el~
diff --git a/doc/hyperdrive.texi b/doc/hyperdrive.texi
index 5b750f84d7..e1be23d24c 100644
--- a/doc/hyperdrive.texi
+++ b/doc/hyperdrive.texi
@@ -1343,6 +1343,26 @@ By default (@code{any-version}), opening a hyperdrive 
file or directory
 reuses a buffer that is already visiting it, regardless of
 version. To have separate buffers for each version of a
 file/directory, use @code{same-version}.
+
+@item @code{hyperdrive-default-entry-format}
+Format string for displaying
+hyperdrive entries (files/directories).  By default, entries are
+displayed with the default host format in brackets, followed by the
+full entry path, followed by ``version: '' and version in parentheses.
+
+@item @code{hyperdrive-buffer-name-format}
+Format string for buffer names of
+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-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
+well as other places hyperdrives or entries are displayed.  By
+default, each metadatum is prefixed by its type, e.g., the petname
+@code{foo} is displayed by default as @code{petname:foo}.
 @end table
 
 @menu
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-diff.el b/hyperdrive-diff.el
index ed4954b916..05c2440ba8 100644
--- a/hyperdrive-diff.el
+++ b/hyperdrive-diff.el
@@ -71,9 +71,11 @@ This function is intended to diff files, not directories."
                             (unless (or old-response new-response)
                               (hyperdrive-error "Files non-existent"))
                             (let ((old-buffer (generate-new-buffer
-                                               (hyperdrive-entry-description 
old-entry)))
+                                               (hyperdrive--format-entry
+                                                old-entry 
hyperdrive-buffer-name-format)))
                                   (new-buffer (generate-new-buffer
-                                               (hyperdrive-entry-description 
new-entry)))
+                                               (hyperdrive--format-entry
+                                                new-entry 
hyperdrive-buffer-name-format)))
                                   ;; TODO: Improve diff buffer name.
                                   (diff-buffer (get-buffer-create 
"*hyperdrive-diff*")))
                               (when old-response
@@ -119,8 +121,8 @@ This function is intended to diff files, not directories."
         (insert (format "No difference between entries:
 %s
 %s"
-                        (hyperdrive-entry-description (car 
hyperdrive-diff-entries))
-                        (hyperdrive-entry-description (cdr 
hyperdrive-diff-entries)))))
+                        (hyperdrive--format-entry (car 
hyperdrive-diff-entries))
+                        (hyperdrive--format-entry (cdr 
hyperdrive-diff-entries)))))
       (goto-char (point-max))
       (forward-line -1)
       (delete-region (point) (point-max)))))
diff --git a/hyperdrive-dir.el b/hyperdrive-dir.el
index 4074f3a008..706f699e0a 100644
--- a/hyperdrive-dir.el
+++ b/hyperdrive-dir.el
@@ -63,7 +63,8 @@ If THEN, call it in the directory buffer with no arguments."
                   ;; of this function (e.g. so it will be available if
                   ;; the user loads a non-directory file directly).
                   (hyperdrive-fill-metadata hyperdrive)
-                  (hyperdrive-dir-column-headers (hyperdrive-entry-description 
directory-entry))))
+                  (hyperdrive-dir-column-headers
+                   (hyperdrive--format-entry directory-entry))))
                (num-entries (length entries)) (num-filled 0)
               ;; (debug-start-time (current-time))
                (metadata-queue) (ewoc) (prev-entry) (prev-point))
@@ -344,7 +345,8 @@ DIRECTORY-SORT should be a valid value of
       (dolist (entry (hyperdrive-sort-entries entries))
         (ewoc-enter-last hyperdrive-ewoc entry))
       (ewoc-set-hf hyperdrive-ewoc
-                   (hyperdrive-dir-column-headers 
(hyperdrive-entry-description hyperdrive-current-entry))
+                   (hyperdrive-dir-column-headers
+                    (hyperdrive--format-entry hyperdrive-current-entry))
                    ""))))
 
 ;;;; Imenu support
diff --git a/hyperdrive-history.el b/hyperdrive-history.el
index 4ff74e2ee9..44f098e8cc 100644
--- a/hyperdrive-history.el
+++ b/hyperdrive-history.el
@@ -179,7 +179,7 @@ prefix argument \\[universal-argument], prompt for ENTRY."
                                  :version (car range))))
                         ;; Display in reverse chronological order
                         (nreverse (hyperdrive-entry-version-ranges-no-gaps 
entry))))
-               (main-header (hyperdrive-entry-description entry :with-version 
nil))
+               (main-header (hyperdrive--format-entry entry "[%H] %p"))
                (header (concat main-header "\n"
                                (format "%7s  %19s  %6s  %s"
                                        (propertize "Exists" 'face 
'hyperdrive-column-header)
@@ -189,8 +189,8 @@ prefix argument \\[universal-argument], prompt for ENTRY."
                                                (propertize "Last Modified" 
'face 'hyperdrive-column-header)))))
                (queue) (ewoc))
     (with-current-buffer (get-buffer-create
-                          (format "*Hyperdrive-history: %s %s*"
-                                  (hyperdrive--format-host hyperdrive 
:with-label t) path))
+                          (format "*Hyperdrive-history: %s*"
+                                  (hyperdrive--format-entry entry "[%H] %p")))
       (with-silent-modifications
         (hyperdrive-history-mode)
         (setq-local hyperdrive-current-entry entry)
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index 78c7f21a4a..3097e1841c 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -305,8 +305,9 @@ before making the entry struct."
 Intended to be used as hash table key in `hyperdrive-version-ranges'."
   (pcase-let* (((cl-struct hyperdrive-entry hyperdrive path) entry)
                (version-less (hyperdrive-entry-create :hyperdrive hyperdrive 
:path path)))
-    (hyperdrive--format-entry-url version-less :host-format '(public-key) 
:with-protocol nil
-                                  :with-help-echo nil :with-target nil 
:with-faces nil)))
+    (substring-no-properties
+     (hyperdrive--format-entry-url version-less :host-format '(public-key)
+                                   :with-protocol nil :with-target nil))))
 
 ;; TODO: Add tests for version range functions
 (defun hyperdrive-entry-version-ranges (entry)
@@ -549,13 +550,16 @@ echo area when the request for the file is made."
                           (not (hyperdrive-entry-version entry)))
                      ;; Entry is a writable file: create a new buffer
                      ;; that will be saved to its path.
-                     (if-let ((buffer (get-buffer 
(hyperdrive--entry-buffer-name entry))))
+                     (if-let ((buffer
+                               (get-buffer
+                                (hyperdrive--format-entry entry 
hyperdrive-buffer-name-format))))
                          ;; Buffer already exists: likely the user deleted the 
entry
                          ;; without killing the buffer.  Switch to the buffer 
and
                          ;; alert the user that the entry no longer exists.
                          (progn
                            (switch-to-buffer buffer)
-                           (hyperdrive-message "Entry no longer exists!  %s" 
(hyperdrive-entry-description entry)))
+                           (hyperdrive-message "Entry no longer exists!  %s"
+                                               (hyperdrive--format-entry 
entry)))
                        ;; Make and switch to new buffer.
                        (switch-to-buffer (hyperdrive--get-buffer-create 
entry))))
                     (t
@@ -914,42 +918,18 @@ Call ELSE if request fails."
   (hyperdrive--write (hyperdrive-entry-url entry)
     :body body :then then :else else :queue queue))
 
-(cl-defun hyperdrive-entry-description (entry &key (format-path 'path) 
(with-version t))
-  "Return description for ENTRY.
-When ENTRY has a non-nil VERSION slot, include it.  Returned
-string looks like:
-
-  FORMAT-PATH [HOST] (version:VERSION)
-
-When FORMAT-PATH is `path', use full path to entry.  When
-FORMAT-PATH is `name', use only last part of path, as in
-`file-name-non-directory'.
-
-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 :with-label t)))
-    (propertize (concat (format "[%s] " handle)
-                        (pcase format-path
-                          ('path path)
-                          ('name name))
-                        (when (and version with-version)
-                          (format " (version:%s)" version)))
-                'help-echo (hyperdrive-entry-url entry))))
-
 (cl-defun hyperdrive--format-entry-url
     (entry &key (host-format '(public-key domain))
-           (with-path t) (with-protocol t) (with-help-echo t)
-           (with-target t) (with-faces t))
+           (with-path t) (with-protocol t) (with-help-echo t) (with-target t))
   "Return ENTRY's URL.
 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.  When WITH-FACES is nil, don't add face text
-properties.  If WITH-TARGET, append the ENTRY's target, stored in
+full URL.  If WITH-TARGET, append the ENTRY's target, stored in
 its :etc slot.  If WITH-PATH, include the path portion.  When
 ENTRY has non-nil `version' slot, include version number in URL.
 
@@ -967,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 
:with-faces with-faces)))
+                       (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)
@@ -982,44 +962,76 @@ Path and target fragment are URI-encoded."
         (propertize url
                     'help-echo (hyperdrive--format-entry-url
                                 entry :with-protocol t :host-format 
'(public-key domain)
-                                :with-path with-path :with-help-echo nil 
:with-target with-target
-                                :with-faces with-faces))
+                                :with-path with-path :with-help-echo nil 
:with-target with-target))
       url)))
 
-(cl-defun hyperdrive--format-host
-    (hyperdrive &key with-label (format hyperdrive-default-host-format) 
(with-faces t))
+(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 face)
+                  (if value
+                      (format (alist-get naming formats)
+                              (propertize value 'face face))
+                    "")))
+      (format-spec format
+                   ;; TODO(deprecate-28): Use lambdas in each specifier.
+                   `((?H . ,(and (string-match-p (rx "%"
+                                                     ;; Flags
+                                                     (optional (1+ (or " " "0" 
"-" "<" ">" "^" "_")))
+                                                     (0+ digit) ;; Width
+                                                     (0+ digit) ;; Precision
+                                                     "H")
+                                                 format)
+                                 ;; HACK: Once using lambdas in this specifier,
+                                 ;; remove the `string-match-p' check.
+                                 (hyperdrive--preferred-format hyperdrive)))
+                     (?P . ,(fmt 'petname petname 'hyperdrive-petname))
+                     (?N . ,(fmt 'nickname nickname 'hyperdrive-nickname))
+                     (?k . ,(fmt 'short-key public-key 'hyperdrive-public-key))
+                     (?K . ,(fmt 'public-key public-key 
'hyperdrive-public-key))
+                     (?S . ,(fmt 'seed seed 'hyperdrive-seed))
+                     (?D . ,(if (car domains)
+                                (format (alist-get 'domains formats)
+                                        (string-join
+                                         (mapcar (lambda (domain)
+                                                   (propertize domain
+                                                               'face 
'hyperdrive-domain))
+                                                 domains)
+                                         ","))
+                              "")))))))
+
+(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
-`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."
+NAMING should be one or a list of symbols, by default
+`hyperdrive-preferred-formats', which see for choices.  If the
+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)
-                        (if with-faces
-                            (propertize string 'face face)
-                          string))))
-      (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-formats))
+             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
 
@@ -1077,13 +1089,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
@@ -1336,7 +1347,8 @@ In other words, this avoids the situation where a buffer 
called
 both point to the same content.
 
 Affected by option `hyperdrive-reuse-buffers', which see."
-  (let* ((buffer-name (hyperdrive--entry-buffer-name entry))
+  (let* ((buffer-name (hyperdrive--format-entry
+                       entry hyperdrive-buffer-name-format))
          (buffer
           (or (when (eq 'any-version hyperdrive-reuse-buffers)
                 (cl-loop for buffer in (buffer-list)
@@ -1368,9 +1380,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)))
 
-(defun hyperdrive--entry-buffer-name (entry)
-  "Return buffer name for ENTRY."
-  (hyperdrive-entry-description entry :format-path 'name))
+(defun hyperdrive--format-entry (entry &optional format formats)
+  "Return ENTRY 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-entry hyperdrive name path version) 
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-org.el b/hyperdrive-org.el
index 235a729b20..dcf3130c69 100644
--- a/hyperdrive-org.el
+++ b/hyperdrive-org.el
@@ -64,10 +64,10 @@ which see."
                     (let ((entry (hyperdrive-dir--entry-at-point)))
                       `((type . "hyper://")
                         (link . ,(hyperdrive-entry-url entry))
-                        (description . ,(hyperdrive-entry-description 
entry)))))
+                        (description . ,(hyperdrive--format-entry entry)))))
                    (_ `((type . "hyper://")
                         (link . ,(hyperdrive-entry-url 
hyperdrive-current-entry))
-                        (description . ,(hyperdrive-entry-description 
hyperdrive-current-entry)))))))
+                        (description . ,(hyperdrive--format-entry 
hyperdrive-current-entry)))))))
       (org-link-store-props :type type :link link :description description)
       t)))
 
diff --git a/hyperdrive-vars.el b/hyperdrive-vars.el
index b5efc769ba..0a2622262e 100644
--- a/hyperdrive-vars.el
+++ b/hyperdrive-vars.el
@@ -118,7 +118,7 @@ Passed to `display-buffer', which see."
                  (const :tag "Pop up window" (display-buffer-pop-up-window))
                  (sexp :tag "Other")))
 
-(defcustom hyperdrive-default-host-format
+(defcustom hyperdrive-preferred-formats
   '(petname nickname domain seed short-key public-key)
   "Default format for displaying hyperdrive hostnames.
 Each option is checked in order, and the first available type is
@@ -165,6 +165,101 @@ an existing buffer at the same version, or make a new 
buffer."
   :type '(choice (const :tag "Use an existing buffer at any version" 
any-version)
                  (const :tag "Use an existing buffer at the same version" 
same-version)))
 
+;;;;;; Entry formatting
+
+(defgroup hyperdrive-entry-format nil
+  "Formatting of entries for buffer names, etc."
+  :group 'hyperdrive)
+
+(defcustom hyperdrive-default-entry-format "[%H] %p%v"
+  "Format string for displaying entries.
+Specifiers:
+
+%H  Preferred hyperdrive naming (see `hyperdrive-preferred-formats')
+
+To configure the format of the following specifiers, see `hyperdrive-formats':
+
+%n  Entry name
+%p  Entry path
+%v  Entry version
+%S  Hyperdrive seed
+%P  Hyperdrive petname
+%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-formats', which see.")
+
+(defcustom hyperdrive-buffer-name-format "[%H] %n%v"
+  "Format string for buffer names.
+Specifiers are as in `hyperdrive-default-entry-format', which
+see."
+  :type 'string)
+
+(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:%.8s…")
+                                (seed       . "seed:%s")
+                                (domains    . "domains:%s"))
+  "Alist mapping hyperdrive and hyperdrive entry metadata item to format 
string.
+Each metadata item may be one of:
+
+- \\=`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
+value (and should only be present once in the string).  Used in
+`hyperdrive-buffer-name-format', which see."
+  :type '(list (cons :tag "Entry name" (const name)
+                     (string :tag "Format string"))
+               (cons :tag "Entry version" (const version)
+                     (string :tag "Format string"))
+               (cons :tag "Entry path" (const path)
+                     (string :tag "Format string"))
+               (cons :tag "Hyperdrive petname" (const petname)
+                     (string :tag "Format string"))
+               (cons :tag "Hyperdrive nickname" (const nickname)
+                     (string :tag "Format string"))
+               (cons :tag "Hyperdrive public key" (const public-key)
+                     (string :tag "Format string"))
+               (cons :tag "Hyperdrive short key" (const short-key)
+                     (string :tag "Format string"))
+               (cons :tag "Hyperdrive seed" (const seed)
+                     (string :tag "Format string"))
+               (cons :tag "Hyperdrive domains" (const domains)
+                     (string :tag "Format string"))))
+
 ;;;;; Faces
 
 (defgroup hyperdrive-faces nil
diff --git a/hyperdrive.el b/hyperdrive.el
index 75425d0db7..f9edecab42 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -361,7 +361,7 @@ directory.  Otherwise, or with universal prefix argument
   (declare (indent defun))
   (interactive
    (let* ((entry (hyperdrive--context-entry :latest-version t))
-          (description (hyperdrive-entry-description entry))
+          (description (hyperdrive--format-entry entry))
           (buffer (current-buffer)))
      (when (and (hyperdrive--entry-directory-p entry)
                 (or (eq entry hyperdrive-current-entry)
@@ -450,11 +450,11 @@ use, see `hyperdrive-write'."
                      current-prefix-arg))
   (unless (or overwritep (not (hyperdrive-entry-at nil entry)))
     (unless (y-or-n-p
-            (format "File %s exists; overwrite?" (hyperdrive-entry-description 
entry)))
+            (format "File %s exists; overwrite?" (hyperdrive--format-entry 
entry)))
       (hyperdrive-user-error "Canceled"))
     (when-let ((buffers (match-buffers (hyperdrive--buffer-for-entry entry))))
       (unless (y-or-n-p
-              (format "A buffer is visiting %s; proceed?" 
(hyperdrive-entry-description entry)))
+              (format "A buffer is visiting %s; proceed?" 
(hyperdrive--format-entry entry)))
         (hyperdrive-user-error "Aborted"))
       ;; TODO: In BUFFERS, when user attempts to modify the buffer,
       ;; offer warning like "FILE has been modified in hyperdrive; are
@@ -494,7 +494,9 @@ use, see `hyperdrive-write'."
                   (setf (hyperdrive-entry-type entry) "text/plain; 
charset=utf-8")
                   (setq-local hyperdrive-current-entry entry)
                   (setf buffer-file-name nil)
-                  (rename-buffer (hyperdrive--entry-buffer-name entry) 'unique)
+                  (rename-buffer
+                   (hyperdrive--format-entry entry 
hyperdrive-buffer-name-format)
+                   'unique)
                   (set-buffer-modified-p nil)
                   ;; Update the visited file modtime so undo commands
                   ;; correctly set the buffer-modified flag.  We just
@@ -555,7 +557,7 @@ it to `hyperdrive-open'."
   (if-let ((previous-entry (hyperdrive-entry-previous entry)))
       (hyperdrive-open previous-entry)
     (hyperdrive-message (substitute-command-keys "%s does not exist at version 
%s. Try \\[hyperdrive-history]")
-                        (hyperdrive-entry-description entry :with-version nil)
+                        (hyperdrive--format-entry entry "[%H] %p")
                         (1- (car (hyperdrive-entry-version-range entry))))))
 
 (defun hyperdrive-open-next-version (entry)
@@ -589,11 +591,12 @@ Nil VERSION means open the entry at its hyperdrive's 
latest version."
                  (list entry (hyperdrive-read-version
                               :hyperdrive (hyperdrive-entry-hyperdrive entry)
                               :prompt (format "Open «%s» at version (leave 
blank for latest version)"
-                                              (hyperdrive-entry-description 
entry :with-version nil))))))
+                                              (hyperdrive--format-entry 
entry))))))
   (if-let ((latest-entry (hyperdrive-entry-at version entry)))
       (hyperdrive-open latest-entry)
     (hyperdrive-message (substitute-command-keys "%s does not exist at version 
%s. Try \\[hyperdrive-history]")
-                        (hyperdrive-entry-description entry :with-version nil)
+                        (hyperdrive--format-entry
+                         entry hyperdrive-default-entry-format-without-version)
                         version)))
 
 ;;;; Bookmark support
@@ -607,7 +610,7 @@ Works in `hyperdrive-mode' and `hyperdrive-dir-mode' 
buffers."
   (let ((bookmark (bookmark-make-record-default 'no-file)))
     (setf (alist-get 'handler bookmark) #'hyperdrive-bookmark-handler
           (alist-get 'location bookmark) (hyperdrive-entry-url 
hyperdrive-current-entry))
-    (cons (format "hyperdrive: %s" (hyperdrive-entry-description 
hyperdrive-current-entry)) bookmark)))
+    (cons (format "hyperdrive: %s" (hyperdrive--format-entry 
hyperdrive-current-entry)) bookmark)))
 
 ;;;###autoload
 (defun hyperdrive-bookmark-handler (bookmark)
@@ -797,14 +800,14 @@ The return value of this function is the retrieval 
buffer."
           (if (< emacs-major-version 28)
               (read-multiple-choice
                (format "Hyperdrive file %s modified; kill anyway?"
-                       (hyperdrive-entry-description hyperdrive-current-entry))
+                       (hyperdrive--format-entry hyperdrive-current-entry))
                '((?y "yes" "kill buffer without saving")
                  (?n "no" "exit without doing anything")
                  (?s "save and then kill" "save the buffer and then kill it")))
             (with-suppressed-warnings ((free-vars use-short-answers))
               (compat-call read-multiple-choice
                            (format "Hyperdrive file %s modified; kill anyway?"
-                                   (hyperdrive-entry-description 
hyperdrive-current-entry))
+                                   (hyperdrive--format-entry 
hyperdrive-current-entry))
                            '((?y "yes" "kill buffer without saving")
                              (?n "no" "exit without doing anything")
                              (?s "save and then kill" "save the buffer and 
then kill it"))
@@ -857,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)
@@ -946,27 +949,27 @@ 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
      :label (if-let* ((entry hyperdrive-current-entry))
                 (format "Current: «%s»"
-                        (hyperdrive-entry-description entry))
+                        (hyperdrive--format-entry entry))
               "Current")
      ("Current Drive"
       :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]