[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/hyperdrive 902e52ad58 098/102: Merge: Add hyperdrive-menu
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/hyperdrive 902e52ad58 098/102: Merge: Add hyperdrive-menu transient, shorthands... |
|
Date: |
Wed, 29 Nov 2023 04:00:58 -0500 (EST) |
branch: elpa/hyperdrive
commit 902e52ad58971ff89e52ece60303445ee8d117ca
Merge: 040fc00500 6b426b2d9e
Author: Joseph Turner <joseph@ushin.org>
Commit: Joseph Turner <joseph@ushin.org>
Merge: Add hyperdrive-menu transient, shorthands...
Make hyperdrive and hyperdrive entry display customizable.
Support Emacs 28.1+.
---
.builds/emacs-27.2.yml | 23 -
.dir-locals.el | 2 +-
CHANGELOG.org | 6 +
DEV.org | 18 +-
README.md | 1 -
doc/hyperdrive.org | 174 ++++---
doc/hyperdrive.texi | 187 +++++---
hyperdrive-describe.el | 57 ++-
hyperdrive-diff.el | 40 +-
hyperdrive-dir.el | 280 ++++++------
hyperdrive-ewoc.el | 50 +-
hyperdrive-history.el | 234 +++++-----
hyperdrive-lib.el | 919 +++++++++++++++++++------------------
hyperdrive-menu.el | 539 +++++++++++++---------
hyperdrive-mirror.el | 202 +++++----
hyperdrive-org.el | 127 +++---
hyperdrive-vars.el | 257 ++++++++---
hyperdrive.el | 931 +++++++++++++++++++-------------------
tests/test-hyperdrive-markdown.el | 79 ++--
tests/test-hyperdrive-org.el | 169 ++++---
tests/test-hyperdrive.el | 55 ++-
21 files changed, 2366 insertions(+), 1984 deletions(-)
diff --git a/.builds/emacs-27.2.yml b/.builds/emacs-27.2.yml
deleted file mode 100644
index 4c9a706dbc..0000000000
--- a/.builds/emacs-27.2.yml
+++ /dev/null
@@ -1,23 +0,0 @@
-image: nixos/latest
-environment:
- NIX_CONFIG: "experimental-features = nix-command flakes \n
accept-flake-config = true"
-sources:
- - https://git.sr.ht/~ushin/hyperdrive.el
-tasks:
- - setup-emacs: |
- nix profile install 'github:purcell/nix-emacs-ci#emacs-27-2'
-
- - initialize-sandbox: |
- cd hyperdrive.el
- ./makem/makem.sh -vvv --sandbox=.sandbox --install-deps --install-linters
-
- - all: |
- # We specify the rules so we can omit lint-checkdoc and
- # lint-indent, which we'll just run locally.
-
- # TODO: Re-enable package-lint rule when
- # <https://github.com/purcell/package-lint/issues/227> is
- # solved.
- cd hyperdrive.el
- ./makem/makem.sh -vvv --sandbox=.sandbox lint-compile lint-declare
lint-regexps tests
-
diff --git a/.dir-locals.el b/.dir-locals.el
index 38069bb759..6dafb9b28d 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,6 +1,6 @@
;;; Directory Local Variables -*- no-byte-compile: t -*-
;;; For more information see (info "(emacs) Directory Variables")
-((nil . ((ispell-buffer-session-localwords . ("dir" "hypercore" "hyperdrive"
"hyperdrives" "hyperdrive's" "args" "systemd" "minibuffer" "petname" "petnames"
"org" "plist" "plists" "alist" "alists" "existsp" "ETag" "streamable" "DNSLink"
"ewoc" "struct" "ENTRY's" "localhost" "imenu" "mtime" "accessor" "http"
"prepended" "prepend" "hostname" "whitespace" "namespace" "filesystem"
"hostnames" "subdirectories" "unsets"))))
+((nil . ((ispell-buffer-session-localwords . ("dir" "hypercore" "hyperdrive"
"hyperdrives" "hyperdrive's" "args" "systemd" "minibuffer" "petname" "petnames"
"org" "plist" "plists" "alist" "alists" "existsp" "ETag" "streamable" "DNSLink"
"ewoc" "struct" "ENTRY's" "localhost" "imenu" "mtime" "accessor" "http"
"prepended" "prepend" "hostname" "whitespace" "namespace" "filesystem"
"hostnames" "subdirectories" "unsets" "finalizer"))))
(emacs-lisp-mode . ((eval . (display-fill-column-indicator-mode))
(fill-column . 80))))
diff --git a/CHANGELOG.org b/CHANGELOG.org
index a12b39cbbe..4c2da7e73d 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -24,6 +24,8 @@ This project adheres to
[[https://semver.org/spec/v2.0.0.html][Semantic Versioni
- Simplified ~hyperdrive-menu~ by moving commands which required
selecting a hyperdrive into ~hyperdrive-menu-hyperdrive~.
- Refactored the ~*hyperdrive-mirror*~ buffer to use
[[https://github.com/alphapapa/taxy.el/tree/package/taxy-magit-section][taxy-magit-section]]
+- Removed ~rx~ form option in ~hyperdrive-mirror~
+- Require at least Emacs 28.1+
** Fixed
@@ -32,6 +34,10 @@ This project adheres to
[[https://semver.org/spec/v2.0.0.html][Semantic Versioni
entry's next version was ~unknown~.
- Uploaded files now retain the timestamp of the local file
+** Internal
+
+- Use Emacs 28 shorthands
+
* 0.2 [2023-10-14 Sat]
** Added
diff --git a/DEV.org b/DEV.org
index 9b2ee312f3..44f5c32c54 100644
--- a/DEV.org
+++ b/DEV.org
@@ -1,5 +1,21 @@
#+title: Hyperdrive.el notes
+* Reference
+
+/Information for future reference./
+
+** ~check-declare~ library does not account for symbol shorthands
+
+So, e.g. ~makem~'s ~lint-declare~ rule, which uses ~check-declare~, gives
false warnings.
+
+*** TODO File bug report to Emacs about this
+:PROPERTIES:
+:assignee: Joseph
+:END:
+:LOGBOOK:
+- State "TODO" from [2023-11-28 Tue 16:31]
+:END:
+
* PROJECT Petnames
:PROPERTIES:
:ID: e5b0c0f1-7ebc-4e8c-9712-cd2cd4a055ce
@@ -25,7 +41,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/README.md b/README.md
index 9b8ee27e7a..decfedcc00 100644
--- a/README.md
+++ b/README.md
@@ -1,6 +1,5 @@
# hyperdrive.el - P2P filesystem in Emacs
-27.2: [](https://builds.sr.ht/~ushin/hyperdrive.el/commits/master/emacs-27.2.yml?)
28.2: [](https://builds.sr.ht/~ushin/hyperdrive.el/commits/master/emacs-28.2.yml?)
29.1: [](https://builds.sr.ht/~ushin/hyperdrive.el/commits/master/emacs-29.1.yml?)
snapshot: [](https://builds.sr.ht/~ushin/hyperdrive.el/commits/master/emacs-snapshot.yml?)
diff --git a/doc/hyperdrive.org b/doc/hyperdrive.org
index 75b011c636..52af7fde94 100644
--- a/doc/hyperdrive.org
+++ b/doc/hyperdrive.org
@@ -117,9 +117,7 @@ you can use the following snippet to install from that
repository:
In your ~init.el~, type ~M-x eval-buffer RET~.
-# TODO: Change "commands like ..." to reference easy menu
-# functionality once implemented.
-If all goes well, ~hyperdrive.el~ commands like ~M-x hyperdrive-start~
+If all goes well, ~hyperdrive.el~ commands like ~M-x hyperdrive-menu~
should now be available. The documentation for ~hyperdrive.el~ should
also be installed.
@@ -303,12 +301,8 @@ URL.
You can have multiple hyperdrives, each one containing its own set of
files. Run ~M-x hyperdrive-new~ then type in a ~seed~ (see [[*Seeds]]) to
create a new hyperdrive. That seed will be combined with your secret
-master key, which is generated for you by ~hyper-gateway~, to produce a
-public key (see [[*Public keys]]) that uniquely identifies that
-hyperdrive. ~hyperdrive-new~ is idempotent since the same seed will
-always produce the same public key. For this reason, a hyperdrive's
-seed cannot be changed.
-# TODO: Move conceptual master key stuff into *Concepts
+master key (see [[*Master key]]) to produce a public key (see [[*Public
+keys]]) that uniquely identifies that hyperdrive.
** Write to a hyperdrive
#+findex: hyperdrive-write-buffer
@@ -320,7 +314,7 @@ You can write a buffer to a hyperdrive with
~hyperdrive-write-buffer~,
which will prompt you for one of hyperdrives you have created as well
as the path in that hyperdrive where you want to store the file. If
you are editing an existing hyperdrive file, ~save-buffer~ will
-silently update the current hyperdrive entry with the new content.
+silently update the current hyperdrive file with the new content.
~hyperdrive.el~ will prompt to save modified hyperdrive files before
exiting Emacs. If you want the command ~save-some-buffers~ to always
@@ -370,8 +364,8 @@ all point to ~hyper://PUBLIC-KEY/bar.md~.
You can use ~hyperdrive-delete~ to delete the hyperdrive file in the
current buffer. This command has a keybinding in the [[*Directory
view][directory view]].
-*Note that deleted files can be accessed by [[*View the hyperdrive version
history][loading a prior version]] of
-the hyperdrive.*
+*Please note that deleted files can be accessed by [[*View the hyperdrive
version history][loading a prior version]]
+of the hyperdrive.*
** View the hyperdrive version history
#+findex: hyperdrive-open-previous-version
@@ -491,37 +485,37 @@ t~. Interactively, use two universal prefix arguments
~C-u C-u~.
*** Mirror files by tag or other attributes
-~hyperdrive-mirror~ can accept a ~PREDICATE~ argument, which you can
+~hyperdrive-mirror~ can accept a ~FILTER~ argument, which you can
use to upload only certain files. Interactively, one universal prefix
-argument ~C-u~ make this command prompt you for ~PREDICATE~.
+argument ~C-u~ make this command prompt you for ~FILTER~.
Let's say that you have some files on your filesystem in the ~~/blog/~
directory, but you only want to upload those files which have been
tagged as "public" using Protesilaos Stavrou's
[[https://protesilaos.com/emacs/denote][Denote]] file-naming
scheme.
-The following snippet includes a ~PREDICATE~ key whose value is a
+The following snippet includes a ~FILTER~ key whose value is a
regular expression against which every expanded filename inside will
be tested.
#+begin_src elisp
(hyperdrive-mirror "~/blog/" (hyperdrive-by-slot 'petname "foo")
:target-dir "/blog/"
- :predicate ".*_public.*")
+ :filter ".*_public.*")
#+end_src
Alternatively, you could select files by tag with Karl Voit's
[[https://github.com/novoid/filetags/][filetags]]. Either way allows for a
"non-splitting" approach where
public and private files exist in the same directory.
-~PREDICATE~ may also be a function, which receives the expanded filename
+~FILTER~ may also be a function, which receives the expanded filename
as its only argument. For example, the following snippet will mirror
only those files in ~~/blog/~ which are smaller than 5MB:
#+begin_src elisp
(hyperdrive-mirror "~/blog/" (hyperdrive-by-slot 'petname "foo")
:target-dir "/blog/"
- :predicate (lambda (file) (> (* 5 1024 1024)
+ :filter (lambda (file) (> (* 5 1024 1024)
(file-attribute-size
(file-attributes file)))))
#+end_src
@@ -540,8 +534,8 @@ available on the network.*
#+findex: hyperdrive-by-slot
In writing your own functions to extend ~hyperdrive.el~, you can use
-~hyperdrive-by-slot~ to access a hyperdrive entry by its seed, petname,
-or public key.
+~hyperdrive-by-slot~ to access a hyperdrive by its seed, petname, or
+public key.
For examples, see [[*Mirror a whole directory]] and [[*Mirror files by tag or
other attributes]].
@@ -611,19 +605,23 @@ Hyperdrives are versioned, meaning that it is possible to
explore a
hyperdrive as it was in the past. Version numbers indicate the
hyperdrive's version. For example, ~hyper://PUBLIC-KEY/$/version/50/~
refers to the fiftieth version of the hyperdrive identified by
-~PUBLIC-KEY~. Loading a hyperdrive entry without specifying a version
-number always loads the most recent version of that hyperdrive. If you
-pass ~hyper://PUBLIC-KEY/foo.org~ to ~hyperdrive-open-url~, ~hyperdrive.el~
-will always attempt to find ~/foo.org~ inside the latest version of that
-hyperdrive.
-
-Whenever you update an entry, the hyperdrive's version number gets
-incremented by 1. The version number tells you how many times the
-hyperdrive has been modified, not how many times a particular entry
-has been modified. For example, let's say that the current version of
-your hyperdrive at ~hyper://PUBLIC-KEY/~ is 50. If you add a new entry
-at ~hyper://PUBLIC-KEY/bar.org~, the latest version of your hyperdrive
-will become 51.
+~PUBLIC-KEY~. If you want to load the latest version, leave out the
+~/$/version/N~ part. For example, if you run...
+
+#+begin_example
+M-x hyperdrive-open-url RET hyper://PUBLIC-KEY/foo.org RET
+#+end_example
+
+...then ~hyperdrive.el~ will attempt to find ~/foo.org~ inside the latest
version
+of that hyperdrive.
+
+Whenever you add a file, remove a file, or change a file, the
+hyperdrive's version number gets incremented by 1. The version number
+tells you how many times the hyperdrive has been modified, not how
+many times a particular file has been modified. For example, let's say
+that the current version of your hyperdrive at ~hyper://PUBLIC-KEY/~
+is 50. If you add a new file at ~hyper://PUBLIC-KEY/bar.org~, the latest
+version of your hyperdrive will become 51.
Since ~/bar.org~ did not exist before version 51, ~hyperdrive.el~ should
warn you that nothing exists at
@@ -631,10 +629,9 @@ warn you that nothing exists at
~hyper://PUBLIC-KEY/quux.org~, your hyperdrive's latest version will
become 52. For the moment, ~hyper://PUBLIC-KEY/bar.org~,
~hyper://PUBLIC-KEY/$/version/51/bar.org~, and
-~hyper://PUBLIC-KEY/$/version/52/bar.org~, all point to the same
-version of ~/bar.org~. If you then make a change to ~/bar.org~, your
-hyperdrive's latest version will become 53. Now
-~hyper://PUBLIC-KEY/bar.org~ and
+~hyper://PUBLIC-KEY/$/version/52/bar.org~, all point to the same version
+of ~/bar.org~. If you then make a change to ~/bar.org~, your hyperdrive's
+latest version will become 53. Now ~hyper://PUBLIC-KEY/bar.org~ and
~hyper://PUBLIC-KEY/$/version/53/bar.org~ will point to the latest
version of ~/bar.org~, while the 51- and 52-versioned URLs will continue
to point to the original version.
@@ -653,10 +650,13 @@ hyperdrive history until version 51 (when it was created)
and that it
was modified at version 53. Since the final range number in the table
is 53, we also know that the hyperdrive's latest version is 53.
-If you delete ~/bar.org~, ~hyper://PUBLIC-KEY/bar.org~ will no longer
-point to anything, but the versioned URLs will still work.
+If you delete ~/bar.org~ then try to load ~hyper://PUBLIC-KEY/bar.org~,
+~hyperdrive.el~ will open an empty buffer for you to author a new file.
+If another user (not you) attempts to load that URL, ~hyperdrive.el~
+will warn ~"URL not found"~. All users can still access the old file
+contents at the versioned URLs.
-Since only the current version of a hyperdrive entry can be updated,
+Since only the current version of a hyperdrive file can be updated,
~hyperdrive.el~ sets the buffer to read-only whenever a version number
is specified in a hyper URL.
@@ -719,6 +719,13 @@ and technical reason:
2. generating directory history based on the history of the files it
contains, which can never prove that a directory doesn't exist.
+*** Master key
+# TODO: Link to this node once we've added backup/restore.
+
+The secret master key is combined with a seed (see [[*Seeds]]) to generate
+a new public key for a hyperdrive when you run ~hyperdrive-new~. Your
+master key is generated automatically by ~hyper-gateway~.
+
** Hyper-gateway
#+cindex: Hyper-gateway
@@ -730,6 +737,7 @@ to write files to a hyperdrive.
** Naming
#+cindex: Naming
+#+vindex: hyperdrive-formats
Inspired by Marc Stiegler's
[[http://www.skyhunter.com/marcs/petnames/IntroPetNames.html][An Introduction
to Petname Systems]],
~hyperdrive.el~ names drives in a three different ways:
@@ -751,28 +759,25 @@ Each drive may also have one or both of the following
attributes:
#+cindex: Public keys
#+findex: hyperdrive-new
-Public keys are 52-character-long,
[[https://en.wikipedia.org/wiki/Base32#z-base-32][z-base-32]] encoded keys
generated
-from your secret master key and a seed string. ~hyper-gateway~ generates
-the secret key for you, and you provide a seed (see [[*Seeds]]) when
-generating a new drive with ~hyperdrive-new~.
-
-Public keys allow for permanent links to hyperdrive content. When
-sharing a hyperdrive with someone else, you will need to copy its full
-URL. Peers can load your hyperdrive files directly from your computer
-or from other peers who previously loaded those files.
+Public keys are globally unique identifiers for hyperdrives. They
+make up the first part of a ~hyper://~ URL. Public keys are
+52-character-long
[[https://en.wikipedia.org/wiki/Base32#z-base-32][z-base-32]] encoded keys
generated from your master
+key (see [[*Master key]]) and a [[*Seeds][seed]] string. When you run
~hyperdrive-new~
+and type a new seed, ~hyper-gateway~ automatically generates a new
+public key.
*** Nicknames
#+cindex: Nicknames
#+findex: hyperdrive-set-nickname
-Nicknames are public, memorable names which users can give to their
-own hyperdrives. Other users can see the nicknames you give to your
-hyperdrives.
+Nicknames are public, memorable names which you can give to your own
+hyperdrives to make them easier for others to recognize. Other users
+can see your nicknames but cannot change them.
Nicknames are stored in each hyperdrive inside
~/.well-known/host-meta.json~ under the ~name~ key, as specified in
-RFC6415. You can only assign a nickname to hyperdrives which you have
-created. Nicknames can be changed with ~hyperdrive-set-nickname~.
+[[https://www.rfc-editor.org/rfc/rfc6415#section-6.1][RFC6415]]. You can
update a hyperdrive's nickname with
+~hyperdrive-set-nickname~.
*** Petnames
#+cindex: Petnames
@@ -788,10 +793,11 @@ petname by default. Petnames can be changed with
*** Seeds
#+cindex: Seeds
-Along with your secret master key, seeds are used to generate public
-keys (see [[*Public keys]]). A seed has a one-to-one relationship with a
-drive. Seeds are local but not secret. To share a drive, you must use
-a public key or DNS domain (see [[*DNS domains]]).
+Seeds are used in tandem with your secret master key (see [[*Master key]])
+to generate public keys (see [[*Public keys]]). The same seed and master
+key will always produce the same public key, so a hyperdrive's seed
+cannot be changed. Seeds are local but not secret. To share a drive,
+you must use a public key or DNS domain (see [[*DNS domains]]).
*** DNS domains
#+cindex: DNS domains
@@ -850,10 +856,6 @@ 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-stream-player-command
- ~hyperdrive-stream-player-command~ :: Command used to play streamable
URLs externally. Default uses [[https://mpv.io/][mpv]]. There also exists a
preconfigured
@@ -879,6 +881,50 @@ DIRECTION being one of ~:ascending~ or ~:descending~.
version. To have separate buffers for each version of a
file/directory, use ~same-version~.
+#+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-default-entry-format
+- ~hyperdrive-default-entry-format~ :: Format string for displaying
+ hyperdrive entries (files/directories). By default, entries are
+ displayed with the preferred hyperdrive format in brackets (see
+ ~hyperdrive-preferred-formats~), followed by the full entry path,
+ followed by "version: " and version in parentheses.
+
+#+vindex: hyperdrive-buffer-name-format
+- ~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.
+
+#+vindex: hyperdrive-formats
+- ~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~.
+
+ Feel free to adjust the following example configuration for
+ abbreviated labels:
+
+ #+begin_src emacs-lisp
+ (setq hyperdrive-formats '((name . "%s")
+ (version . " (%s)")
+ (path . "%s")
+ (petname . "p:%s")
+ (nickname . "n:%s")
+ (public-key . "k:%s")
+ (short-key . "k:%.8s…")
+ (seed . "s:%s")
+ (domains . "d:%s")))
+ #+end_src
+
+ With this snippet, the petname ~foo~ now displays as ~p:foo~. For further
+ customization, run ~M-x customize-group RET ~hyperdrive-entry-format~.
+
** Additional customization
This section mentions ways to change the behavior of ~hyperdrive.el~
@@ -966,9 +1012,7 @@ world of p2p as well as the development of ~hyper-gateway~.
[[https://protesilaos.com][Protesilaos Stavrou]] for design input and
user-testing ~hyperdrive.el~.
-[[https://karl-voit.at/][Karl Voit]] for his feedback, especially the
-suggestion that we allow for a non-splitting approach for uploading
-files from the filesystem.
+[[https://karl-voit.at/][Karl Voit]] for his feedback which inspired the
design of ~hyperdrive-mirror~.
[[https://www.sanityinc.com/][Steve Purcell]] and
[[https://github.com/akirak][Akira Komamura]] for suggestions to improve our CI
build manifests.
diff --git a/doc/hyperdrive.texi b/doc/hyperdrive.texi
index 15035ec49c..6037aeeba6 100644
--- a/doc/hyperdrive.texi
+++ b/doc/hyperdrive.texi
@@ -133,6 +133,7 @@ Hyperdrive
* Sparse replication::
* Versioning::
+* Master key::
Versioning
@@ -295,7 +296,7 @@ you can use the following snippet to install from that
repository:
In your @code{init.el}, type @code{M-x eval-buffer RET}.
-If all goes well, @code{hyperdrive.el} commands like @code{M-x
hyperdrive-start}
+If all goes well, @code{hyperdrive.el} commands like @code{M-x hyperdrive-menu}
should now be available. The documentation for @code{hyperdrive.el} should
also be installed.
@@ -572,11 +573,7 @@ URL@.
You can have multiple hyperdrives, each one containing its own set of
files. Run @code{M-x hyperdrive-new} then type in a @code{seed} (see
@ref{Seeds}) to
create a new hyperdrive. That seed will be combined with your secret
-master key, which is generated for you by @code{hyper-gateway}, to produce a
-public key (see @ref{Public keys}) that uniquely identifies that
-hyperdrive. @code{hyperdrive-new} is idempotent since the same seed will
-always produce the same public key. For this reason, a hyperdrive's
-seed cannot be changed.
+master key (see @ref{Master key}) to produce a public key (see @ref{Public
keys}) that uniquely identifies that hyperdrive.
@node Write to a hyperdrive
@section Write to a hyperdrive
@@ -590,7 +587,7 @@ You can write a buffer to a hyperdrive with
@code{hyperdrive-write-buffer},
which will prompt you for one of hyperdrives you have created as well
as the path in that hyperdrive where you want to store the file. If
you are editing an existing hyperdrive file, @code{save-buffer} will
-silently update the current hyperdrive entry with the new content.
+silently update the current hyperdrive file with the new content.
@code{hyperdrive.el} will prompt to save modified hyperdrive files before
exiting Emacs. If you want the command @code{save-some-buffers} to always
@@ -651,8 +648,8 @@ all point to @code{hyper://PUBLIC-KEY/bar.md}.
You can use @code{hyperdrive-delete} to delete the hyperdrive file in the
current buffer. This command has a keybinding in the @ref{Directory view, ,
directory view}.
-@strong{Note that deleted files can be accessed by @ref{View the hyperdrive
version history, , loading a prior version} of
-the hyperdrive.}
+@strong{Please note that deleted files can be accessed by @ref{View the
hyperdrive version history, , loading a prior version}
+of the hyperdrive.}
@node View the hyperdrive version history
@section View the hyperdrive version history
@@ -818,37 +815,37 @@ t}. Interactively, use two universal prefix arguments
@code{C-u C-u}.
@node Mirror files by tag or other attributes
@subsection Mirror files by tag or other attributes
-@code{hyperdrive-mirror} can accept a @code{PREDICATE} argument, which you can
+@code{hyperdrive-mirror} can accept a @code{FILTER} argument, which you can
use to upload only certain files. Interactively, one universal prefix
-argument @code{C-u} make this command prompt you for @code{PREDICATE}.
+argument @code{C-u} make this command prompt you for @code{FILTER}.
Let's say that you have some files on your filesystem in the @code{~/blog/}
directory, but you only want to upload those files which have been
tagged as ``public'' using Protesilaos Stavrou's
@uref{https://protesilaos.com/emacs/denote, Denote} file-naming
scheme.
-The following snippet includes a @code{PREDICATE} key whose value is a
+The following snippet includes a @code{FILTER} key whose value is a
regular expression against which every expanded filename inside will
be tested.
@lisp
(hyperdrive-mirror "~/blog/" (hyperdrive-by-slot 'petname "foo")
:target-dir "/blog/"
- :predicate ".*_public.*")
+ :filter ".*_public.*")
@end lisp
Alternatively, you could select files by tag with Karl Voit's
@uref{https://github.com/novoid/filetags/, filetags}. Either way allows for a
``non-splitting'' approach where
public and private files exist in the same directory.
-@code{PREDICATE} may also be a function, which receives the expanded filename
+@code{FILTER} may also be a function, which receives the expanded filename
as its only argument. For example, the following snippet will mirror
only those files in @code{~/blog/} which are smaller than 5MB:
@lisp
(hyperdrive-mirror "~/blog/" (hyperdrive-by-slot 'petname "foo")
:target-dir "/blog/"
- :predicate (lambda (file) (> (* 5 1024 1024)
+ :filter (lambda (file) (> (* 5 1024 1024)
(file-attribute-size
(file-attributes file)))))
@end lisp
@@ -871,8 +868,8 @@ available on the network.}
@findex hyperdrive-by-slot
In writing your own functions to extend @code{hyperdrive.el}, you can use
-@code{hyperdrive-by-slot} to access a hyperdrive entry by its seed, petname,
-or public key.
+@code{hyperdrive-by-slot} to access a hyperdrive by its seed, petname, or
+public key.
For examples, see @ref{Mirror a whole directory} and @ref{Mirror files by tag
or other attributes}.
@@ -948,6 +945,7 @@ be accessed. See @ref{Versioning} for more information.
@menu
* Sparse replication::
* Versioning::
+* Master key::
@end menu
@node Sparse replication
@@ -968,19 +966,23 @@ Hyperdrives are versioned, meaning that it is possible to
explore a
hyperdrive as it was in the past. Version numbers indicate the
hyperdrive's version. For example, @code{hyper://PUBLIC-KEY/$/version/50/}
refers to the fiftieth version of the hyperdrive identified by
-@code{PUBLIC-KEY}. Loading a hyperdrive entry without specifying a version
-number always loads the most recent version of that hyperdrive. If you
-pass @code{hyper://PUBLIC-KEY/foo.org} to @code{hyperdrive-open-url},
@code{hyperdrive.el}
-will always attempt to find @code{/foo.org} inside the latest version of that
-hyperdrive.
-
-Whenever you update an entry, the hyperdrive's version number gets
-incremented by 1. The version number tells you how many times the
-hyperdrive has been modified, not how many times a particular entry
-has been modified. For example, let's say that the current version of
-your hyperdrive at @code{hyper://PUBLIC-KEY/} is 50. If you add a new entry
-at @code{hyper://PUBLIC-KEY/bar.org}, the latest version of your hyperdrive
-will become 51.
+@code{PUBLIC-KEY}. If you want to load the latest version, leave out the
+@code{/$/version/N} part. For example, if you run@dots{}
+
+@example
+M-x hyperdrive-open-url RET hyper://PUBLIC-KEY/foo.org RET
+@end example
+
+@dots{}then @code{hyperdrive.el} will attempt to find @code{/foo.org} inside
the latest version
+of that hyperdrive.
+
+Whenever you add a file, remove a file, or change a file, the
+hyperdrive's version number gets incremented by 1. The version number
+tells you how many times the hyperdrive has been modified, not how
+many times a particular file has been modified. For example, let's say
+that the current version of your hyperdrive at @code{hyper://PUBLIC-KEY/}
+is 50. If you add a new file at @code{hyper://PUBLIC-KEY/bar.org}, the latest
+version of your hyperdrive will become 51.
Since @code{/bar.org} did not exist before version 51, @code{hyperdrive.el}
should
warn you that nothing exists at
@@ -988,10 +990,9 @@ warn you that nothing exists at
@code{hyper://PUBLIC-KEY/quux.org}, your hyperdrive's latest version will
become 52. For the moment, @code{hyper://PUBLIC-KEY/bar.org},
@code{hyper://PUBLIC-KEY/$/version/51/bar.org}, and
-@code{hyper://PUBLIC-KEY/$/version/52/bar.org}, all point to the same
-version of @code{/bar.org}. If you then make a change to @code{/bar.org}, your
-hyperdrive's latest version will become 53. Now
-@code{hyper://PUBLIC-KEY/bar.org} and
+@code{hyper://PUBLIC-KEY/$/version/52/bar.org}, all point to the same version
+of @code{/bar.org}. If you then make a change to @code{/bar.org}, your
hyperdrive's
+latest version will become 53. Now @code{hyper://PUBLIC-KEY/bar.org} and
@code{hyper://PUBLIC-KEY/$/version/53/bar.org} will point to the latest
version of @code{/bar.org}, while the 51- and 52-versioned URLs will continue
to point to the original version.
@@ -1015,10 +1016,13 @@ hyperdrive history until version 51 (when it was
created) and that it
was modified at version 53. Since the final range number in the table
is 53, we also know that the hyperdrive's latest version is 53.
-If you delete @code{/bar.org}, @code{hyper://PUBLIC-KEY/bar.org} will no longer
-point to anything, but the versioned URLs will still work.
+If you delete @code{/bar.org} then try to load
@code{hyper://PUBLIC-KEY/bar.org},
+@code{hyperdrive.el} will open an empty buffer for you to author a new file.
+If another user (not you) attempts to load that URL, @code{hyperdrive.el}
+will warn @code{"URL not found"}. All users can still access the old file
+contents at the versioned URLs.
-Since only the current version of a hyperdrive entry can be updated,
+Since only the current version of a hyperdrive file can be updated,
@code{hyperdrive.el} sets the buffer to read-only whenever a version number
is specified in a hyper URL@.
@@ -1111,6 +1115,13 @@ contains, which can never prove that a directory doesn't
exist.
@end enumerate
@end itemize
+@node Master key
+@subsection Master key
+
+The secret master key is combined with a seed (see @ref{Seeds}) to generate
+a new public key for a hyperdrive when you run @code{hyperdrive-new}. Your
+master key is generated automatically by @code{hyper-gateway}.
+
@node Hyper-gateway
@section Hyper-gateway
@@ -1126,6 +1137,7 @@ to write files to a hyperdrive.
@section Naming
@cindex Naming
+@vindex hyperdrive-formats
Inspired by Marc Stiegler's
@uref{http://www.skyhunter.com/marcs/petnames/IntroPetNames.html, An
Introduction to Petname Systems},
@code{hyperdrive.el} names drives in a three different ways:
@@ -1166,15 +1178,12 @@ public, globally unique, human-memorable
@cindex Public keys
@findex hyperdrive-new
-Public keys are 52-character-long,
@uref{https://en.wikipedia.org/wiki/Base32#z-base-32, z-base-32} encoded keys
generated
-from your secret master key and a seed string. @code{hyper-gateway} generates
-the secret key for you, and you provide a seed (see @ref{Seeds}) when
-generating a new drive with @code{hyperdrive-new}.
-
-Public keys allow for permanent links to hyperdrive content. When
-sharing a hyperdrive with someone else, you will need to copy its full
-URL@. Peers can load your hyperdrive files directly from your computer
-or from other peers who previously loaded those files.
+Public keys are globally unique identifiers for hyperdrives. They
+make up the first part of a @code{hyper://} URL@. Public keys are
+52-character-long @uref{https://en.wikipedia.org/wiki/Base32#z-base-32,
z-base-32} encoded keys generated from your master
+key (see @ref{Master key}) and a @ref{Seeds, , seed} string. When you run
@code{hyperdrive-new}
+and type a new seed, @code{hyper-gateway} automatically generates a new
+public key.
@node Nicknames
@subsection Nicknames
@@ -1182,14 +1191,14 @@ or from other peers who previously loaded those files.
@cindex Nicknames
@findex hyperdrive-set-nickname
-Nicknames are public, memorable names which users can give to their
-own hyperdrives. Other users can see the nicknames you give to your
-hyperdrives.
+Nicknames are public, memorable names which you can give to your own
+hyperdrives to make them easier for others to recognize. Other users
+can see your nicknames but cannot change them.
Nicknames are stored in each hyperdrive inside
@code{/.well-known/host-meta.json} under the @code{name} key, as specified in
-RFC6415. You can only assign a nickname to hyperdrives which you have
-created. Nicknames can be changed with @code{hyperdrive-set-nickname}.
+@uref{https://www.rfc-editor.org/rfc/rfc6415#section-6.1, RFC6415}. You can
update a hyperdrive's nickname with
+@code{hyperdrive-set-nickname}.
@node Petnames
@subsection Petnames
@@ -1209,10 +1218,11 @@ petname by default. Petnames can be changed with
@cindex Seeds
-Along with your secret master key, seeds are used to generate public
-keys (see @ref{Public keys}). A seed has a one-to-one relationship with a
-drive. Seeds are local but not secret. To share a drive, you must use
-a public key or DNS domain (see @ref{DNS domains}).
+Seeds are used in tandem with your secret master key (see @ref{Master key})
+to generate public keys (see @ref{Public keys}). The same seed and master
+key will always produce the same public key, so a hyperdrive's seed
+cannot be changed. Seeds are local but not secret. To share a drive,
+you must use a public key or DNS domain (see @ref{DNS domains}).
@node DNS domains
@subsection DNS domains
@@ -1298,13 +1308,6 @@ Display buffer action
for hyperdrive history buffers. Passed to @code{display-buffer}, which see.
@end table
-@vindex hyperdrive-default-host-format
-@table @asis
-@item @code{hyperdrive-default-host-format}
-Default format for displaying
-hyperdrive hostnames. See @ref{Naming} section for what this means.
-@end table
-
@vindex hyperdrive-stream-player-command
@table @asis
@item @code{hyperdrive-stream-player-command}
@@ -1345,6 +1348,62 @@ version. To have separate buffers for each version of a
file/directory, use @code{same-version}.
@end table
+@vindex hyperdrive-preferred-formats
+@table @asis
+@item @code{hyperdrive-preferred-formats}
+List of metadata types used to
+display hyperdrives. Hyperdrives are displayed using the first
+available metadata type. See @ref{Naming} section for what this means.
+@end table
+
+@vindex hyperdrive-default-entry-format
+@table @asis
+@item @code{hyperdrive-default-entry-format}
+Format string for displaying
+hyperdrive entries (files/directories). By default, entries are
+displayed with the preferred hyperdrive format in brackets (see
+@code{hyperdrive-preferred-formats}), followed by the full entry path,
+followed by ``version: '' and version in parentheses.
+@end table
+
+@vindex hyperdrive-buffer-name-format
+@table @asis
+@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.
+@end table
+
+@vindex hyperdrive-formats
+@table @asis
+@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}.
+
+Feel free to adjust the following example configuration for
+abbreviated labels:
+
+@lisp
+(setq hyperdrive-formats '((name . "%s")
+ (version . " (%s)")
+ (path . "%s")
+ (petname . "p:%s")
+ (nickname . "n:%s")
+ (public-key . "k:%s")
+ (short-key . "k:%.8s…")
+ (seed . "s:%s")
+ (domains . "d:%s")))
+@end lisp
+
+With this snippet, the petname @code{foo} now displays as @code{p:foo}. For
further
+customization, run @code{M-x customize-group RET ~hyperdrive-entry-format}.
+@end table
+
@menu
* Additional customization::
@end menu
@@ -1468,9 +1527,7 @@ world of p2p as well as the development of
@code{hyper-gateway}.
@uref{https://protesilaos.com, Protesilaos Stavrou} for design input and
user-testing @code{hyperdrive.el}.
-@uref{https://karl-voit.at/, Karl Voit} for his feedback, especially the
-suggestion that we allow for a non-splitting approach for uploading
-files from the filesystem.
+@uref{https://karl-voit.at/, Karl Voit} for his feedback which inspired the
design of @code{hyperdrive-mirror}.
@uref{https://www.sanityinc.com/, Steve Purcell} and
@uref{https://github.com/akirak, Akira Komamura} for suggestions to improve our
CI
build manifests.
diff --git a/hyperdrive-describe.el b/hyperdrive-describe.el
index 0d9272e85e..e5ce9a0bfc 100644
--- a/hyperdrive-describe.el
+++ b/hyperdrive-describe.el
@@ -32,9 +32,9 @@
;;;; Variables
-(defvar-local hyperdrive-describe-current-hyperdrive nil
+(defvar-local h/describe-current-hyperdrive nil
"Hyperdrive for current `hyperdrive-describe-mode' buffer.")
-(put 'hyperdrive-describe-current-hyperdrive 'permanent-local t)
+(put 'h/describe-current-hyperdrive 'permanent-local t)
;;;; Commands
@@ -46,35 +46,24 @@
Universal prefix argument \\[universal-argument] forces
`hyperdrive-complete-hyperdrive' to prompt for a hyperdrive."
- (interactive (list (hyperdrive-complete-hyperdrive :force-prompt
current-prefix-arg)))
+ (interactive (list (h/complete-hyperdrive :force-prompt current-prefix-arg)))
;; TODO: Do we want to asynchronously fill the hyperdrive's latest version?
- (hyperdrive-fill-latest-version hyperdrive)
+ (h/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*" (h//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))
+ (h/describe-mode)
+ (setq-local h/describe-current-hyperdrive 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]"))
- (format "Latest version: %s\n" (hyperdrive-latest-version hyperdrive))
+ (h//format hyperdrive "Public key %K:\n" h/raw-formats)
+ (h//format hyperdrive "Seed: %S\n" h/raw-formats)
+ (h//format hyperdrive "Petname: %P\n" h/raw-formats)
+ (h//format hyperdrive "Nickname: %N\n" h/raw-formats)
+ (h//format hyperdrive "Domains: %D\n" h/raw-formats)
+ (format "Latest version: %s\n" (h/latest-version hyperdrive))
(format "Writable: %s\n" (if writablep "yes" "no"))
(format "Metadata: %s\n"
(if metadata
@@ -94,22 +83,30 @@ Universal prefix argument \\[universal-argument] forces
;;;; Mode
-(defun hyperdrive-describe-revert-buffer (&optional _ignore-auto _noconfirm)
+(defun h/describe-revert-buffer (&optional _ignore-auto _noconfirm)
"Revert `hyperdrive-describe-mode' buffer.
Gets latest metadata from hyperdrive."
- (hyperdrive-fill-metadata hyperdrive-describe-current-hyperdrive)
- (hyperdrive-describe-hyperdrive hyperdrive-describe-current-hyperdrive))
+ (h/fill-metadata h/describe-current-hyperdrive)
+ (h/describe-hyperdrive h/describe-current-hyperdrive))
-(define-derived-mode hyperdrive-describe-mode special-mode
+(define-derived-mode h/describe-mode special-mode
`("Hyperdrive-describe"
;; TODO: Add more to lighter, e.g. URL.
)
"Major mode for buffers for describing hyperdrives."
:group 'hyperdrive
:interactive nil
- (setq-local revert-buffer-function #'hyperdrive-describe-revert-buffer))
+ (setq-local revert-buffer-function #'h/describe-revert-buffer))
;;;; Footer
(provide 'hyperdrive-describe)
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
;;; hyperdrive-describe.el ends here
diff --git a/hyperdrive-diff.el b/hyperdrive-diff.el
index ed4954b916..3470697fba 100644
--- a/hyperdrive-diff.el
+++ b/hyperdrive-diff.el
@@ -36,14 +36,14 @@
;;;; Internal variables
-(defvar-local hyperdrive-diff-entries nil
+(defvar-local h/diff-entries nil
"Entries to be diffed in `hyperdrive-diff' buffer.
A cons cell whose car is OLD-ENTRY and whose cdr is NEW-ENTRY.")
-(put 'hyperdrive-diff-entries 'permanent-local t)
+(put 'h/diff-entries 'permanent-local t)
;;;; Functions
-(defun hyperdrive-diff-empty-diff-p (buffer)
+(defun h/diff-empty-diff-p (buffer)
"Return t if `hyperdrive-diff-mode' BUFFER has no differences."
(with-current-buffer buffer
(save-excursion
@@ -66,14 +66,16 @@ This function is intended to diff files, not directories."
(let* (old-response
new-response
(queue (make-plz-queue
- :limit hyperdrive-queue-limit
+ :limit h/queue-limit
:finally (lambda ()
(unless (or old-response new-response)
- (hyperdrive-error "Files non-existent"))
+ (h/error "Files non-existent"))
(let ((old-buffer (generate-new-buffer
- (hyperdrive-entry-description
old-entry)))
+ (h//format-entry
+ old-entry
h/buffer-name-format)))
(new-buffer (generate-new-buffer
- (hyperdrive-entry-description
new-entry)))
+ (h//format-entry
+ new-entry
h/buffer-name-format)))
;; TODO: Improve diff buffer name.
(diff-buffer (get-buffer-create
"*hyperdrive-diff*")))
(when old-response
@@ -87,26 +89,26 @@ This function is intended to diff files, not directories."
(progn
(diff-no-select old-buffer new-buffer
nil t diff-buffer)
(with-current-buffer diff-buffer
- (setf hyperdrive-diff-entries (cons
old-entry new-entry))
- (hyperdrive-diff-mode)
+ (setf h/diff-entries (cons old-entry
new-entry))
+ (h/diff-mode)
(when then
(funcall then))))
(error (kill-buffer diff-buffer)
(signal (car err) (cdr err))))
(kill-buffer old-buffer)
(kill-buffer new-buffer)))))))
- (hyperdrive-api 'get (hyperdrive-entry-url old-entry)
+ (h/api 'get (he/url old-entry)
:queue queue :as 'response :else #'ignore
:then (lambda (response)
(setf old-response response)))
- (hyperdrive-api 'get (hyperdrive-entry-url new-entry)
+ (h/api 'get (he/url new-entry)
:queue queue :as 'response :else #'ignore
:then (lambda (response)
(setf new-response response)))))
;;;; Mode
-(define-derived-mode hyperdrive-diff-mode diff-mode "hyperdrive-diff"
+(define-derived-mode h/diff-mode diff-mode "hyperdrive-diff"
"Major mode for `hyperdrive-diff' buffers."
:group 'hyperdrive
:interactive nil
@@ -115,12 +117,12 @@ This function is intended to diff files, not directories."
(save-excursion
(goto-char (point-min))
(delete-line)
- (when (hyperdrive-diff-empty-diff-p (current-buffer))
+ (when (h/diff-empty-diff-p (current-buffer))
(insert (format "No difference between entries:
%s
%s"
- (hyperdrive-entry-description (car
hyperdrive-diff-entries))
- (hyperdrive-entry-description (cdr
hyperdrive-diff-entries)))))
+ (h//format-entry (car h/diff-entries))
+ (h//format-entry (cdr h/diff-entries)))))
(goto-char (point-max))
(forward-line -1)
(delete-region (point) (point-max)))))
@@ -128,4 +130,12 @@ This function is intended to diff files, not directories."
;;;; Footer
(provide 'hyperdrive-diff)
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
;;; hyperdrive-diff.el ends here
diff --git a/hyperdrive-dir.el b/hyperdrive-dir.el
index 4074f3a008..51dd426797 100644
--- a/hyperdrive-dir.el
+++ b/hyperdrive-dir.el
@@ -29,12 +29,7 @@
(require 'cl-lib)
(require 'hyperdrive-lib)
-(require 'hyperdrive-ewoc)
-
-;;;; Variables
-
-(defvar imenu-auto-rescan)
-(defvar imenu-space-replacement)
+(require 'h/ewoc)
;;;; Functions
@@ -44,57 +39,58 @@
If THEN, call it in the directory buffer with no arguments."
;; NOTE: ENTRY is not necessarily "filled" yet.
(pcase-let* (((cl-struct hyperdrive-entry hyperdrive path version)
directory-entry)
- (url (hyperdrive-entry-url directory-entry))
+ (url (he/url directory-entry))
((cl-struct plz-response headers body)
;; SOMEDAY: Consider updating plz to optionally not stringify
the body.
- (hyperdrive-api 'get url :as 'response :noquery t))
+ (h/api 'get url :as 'response :noquery t))
(entry-names (json-read-from-string body))
(entries (mapcar (lambda (entry-name)
- (hyperdrive-entry-create
+ (he/create
:hyperdrive hyperdrive
:path (concat path entry-name)
:version version))
entry-names))
- (parent-entry (hyperdrive-parent directory-entry))
+ (parent-entry (h/parent directory-entry))
(header
(progn
;; Fill metadata first to get the current nickname.
;; TODO: Consider filling metadata earlier, outside
;; 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))))
+ (h/fill-metadata hyperdrive)
+ (h/dir-column-headers
+ (h//format-entry directory-entry))))
(num-entries (length entries)) (num-filled 0)
;; (debug-start-time (current-time))
(metadata-queue) (ewoc) (prev-entry) (prev-point))
(cl-labels ((goto-entry (entry ewoc)
- (when-let ((node (hyperdrive-ewoc-find-node ewoc entry
- :predicate #'hyperdrive-entry-equal-p)))
+ (when-let ((node (h/ewoc-find-node ewoc entry
+ :predicate #'he/equal-p)))
(goto-char (ewoc-location node))))
(update-footer (num-filled num-of)
(when (zerop (mod num-filled 5))
(ewoc-set-hf ewoc header
(propertize (format "Loading (%s/%s)..."
num-filled num-of)
'face 'font-lock-comment-face)))))
- (setf directory-entry (hyperdrive--fill directory-entry headers))
+ (setf directory-entry (h//fill directory-entry headers))
(when parent-entry
- (setf (alist-get 'display-name (hyperdrive-entry-etc parent-entry))
"../")
+ (setf (alist-get 'display-name (he/etc parent-entry)) "../")
(push parent-entry entries))
- (with-current-buffer (hyperdrive--get-buffer-create directory-entry)
+ (with-current-buffer (h//get-buffer-create directory-entry)
(with-silent-modifications
- (setf ewoc (or hyperdrive-ewoc ; Bind this for lambdas.
- (setf hyperdrive-ewoc (ewoc-create
#'hyperdrive-dir-pp)))
+ (setf ewoc (or h/ewoc ; Bind this for lambdas.
+ (setf h/ewoc (ewoc-create #'h/dir-pp)))
metadata-queue (make-plz-queue
;; Experimentation seems to show that a
;; queue size of about 20 performs best.
- :limit hyperdrive-queue-limit
+ :limit h/queue-limit
:finally (lambda ()
(with-current-buffer (ewoc-buffer
ewoc)
(with-silent-modifications
;; `with-silent-modifications'
increases performance,
;; but we still need
`set-buffer-modified-p' below.
(ewoc-set-hf ewoc header "")
- (setf entries
(hyperdrive-sort-entries entries))
+ (setf entries (h/sort-entries
entries))
(dolist (entry entries)
(ewoc-enter-last ewoc entry))
(or (when prev-entry
@@ -107,43 +103,43 @@ If THEN, call it in the directory buffer with no
arguments."
;; (float-time
(time-subtract (current-time)
;;
debug-start-time)))
))
- prev-entry (when-let ((node (ewoc-locate hyperdrive-ewoc)))
+ prev-entry (when-let ((node (ewoc-locate h/ewoc)))
(ewoc-data node))
prev-point (point))
- (ewoc-filter hyperdrive-ewoc #'ignore)
+ (ewoc-filter h/ewoc #'ignore)
(update-footer num-filled num-entries)
(dolist (entry entries)
- (hyperdrive-fill entry :queue metadata-queue
+ (h/fill entry :queue metadata-queue
:then (lambda (&rest _)
(update-footer (cl-incf num-filled) num-entries))))
(plz-run metadata-queue)
(when then
(funcall then)))))))
-(defun hyperdrive-dir-column-headers (prefix)
+(defun h/dir-column-headers (prefix)
"Return column headers as a string with PREFIX.
Columns are suffixed with up/down arrows according to
`hyperdrive-sort-entries'."
- (pcase-let* ((`(,sort-column . ,direction) hyperdrive-directory-sort)
+ (pcase-let* ((`(,sort-column . ,direction) h/directory-sort)
;; TODO: Use "↑" and "↓" glyphs, but make sure that the
;; column headers are aligned correctly.
(arrow (propertize (if (eq direction :ascending) "^" "v")
- 'face 'hyperdrive-header-arrow))
+ 'face 'h/header-arrow))
(headers))
- (pcase-dolist (`(,column . ,(map (:desc desc))) hyperdrive-dir-sort-fields)
+ (pcase-dolist (`(,column . ,(map (:desc desc))) h/dir-sort-fields)
(let* ((selected (eq column sort-column))
;; Put the arrow after desc, since the column is left-aligned.
(left-aligned (eq column 'name))
(format-str (pcase column
('size "%6s")
- ('mtime (format "%%%ds" hyperdrive-timestamp-width))
+ ('mtime (format "%%%ds" h/timestamp-width))
('name "%s")))
(desc (concat (and selected (not left-aligned) (concat arrow " "))
(propertize desc 'face (if selected
-
'hyperdrive-selected-column-header
- 'hyperdrive-column-header))
+ 'h/selected-column-header
+ 'h/column-header))
;; This extra space is necessary to prevent
- ;; the `hyperdrive-column-header' face from
+ ;; the `h/column-header' face from
;; extended to the end of the window.
(and selected left-aligned (concat " " arrow)))))
(push (propertize (format format-str desc)
@@ -158,17 +154,17 @@ Columns are suffixed with up/down arrows according to
(apply #'concat prefix "\n" (nreverse headers))))
-(defun hyperdrive-dir-complete-sort ()
+(defun h/dir-complete-sort ()
"Return a value for `hyperdrive-directory-sort' selected with completion."
(pcase-let* ((read-answer-short t)
(choices (mapcar (lambda (field)
(let ((desc (symbol-name (car field))))
(list desc (aref desc 0) (format "sort by
%s" desc))))
- hyperdrive-dir-sort-fields))
+ h/dir-sort-fields))
(column (intern (read-answer "Sort by column: " choices))))
- (hyperdrive-dir-toggle-sort-direction column hyperdrive-directory-sort)))
+ (h/dir-toggle-sort-direction column h/directory-sort)))
-(defun hyperdrive-dir-toggle-sort-direction (column sort)
+(defun h/dir-toggle-sort-direction (column sort)
"Return `hyperdrive-directory-sort' cons cell for COLUMN.
If SORT is already sorted using COLUMN, toggle direction.
Otherwise, set direction to \\+`:descending'."
@@ -179,219 +175,227 @@ Otherwise, set direction to \\+`:descending'."
:ascending)))
(cons column direction)))
-(defun hyperdrive-dir-pp (thing)
+(defun h/dir-pp (thing)
"Pretty-print THING.
To be used as the pretty-printer for `ewoc-create'."
(pcase-exhaustive thing
- ((pred hyperdrive-entry-p)
- (insert (hyperdrive-dir--format-entry thing)))))
+ ((pred he/p)
+ (insert (h/dir--format-entry thing)))))
-(defun hyperdrive-dir--format-entry (entry)
+(defun h/dir--format-entry (entry)
"Return ENTRY formatted as a string."
(pcase-let* (((cl-struct hyperdrive-entry size mtime) entry)
(size (when size
(file-size-human-readable size)))
- (directoryp (hyperdrive--entry-directory-p entry))
- (face (if directoryp 'hyperdrive-directory 'default))
+ (directoryp (h//entry-directory-p entry))
+ (face (if directoryp 'h/directory 'default))
(timestamp (if mtime
- (format-time-string hyperdrive-timestamp-format
mtime)
- (propertize " " 'display '(space :width
hyperdrive-timestamp-width)))))
+ (format-time-string h/timestamp-format mtime)
+ (propertize " " 'display '(space :width
h/timestamp-width)))))
(format "%6s %s %s"
(propertize (or size "")
- 'face 'hyperdrive-size)
+ 'face 'h/size)
(propertize timestamp
- 'face 'hyperdrive-timestamp)
- (propertize (or (alist-get 'display-name (hyperdrive-entry-etc
entry))
- (hyperdrive-entry-name entry))
+ 'face 'h/timestamp)
+ (propertize (or (alist-get 'display-name (he/etc entry))
+ (he/name entry))
'face face
'mouse-face 'highlight
'help-echo (format "Visit this %s in other window"
(if directoryp "directory
""file"))))))
-(defun hyperdrive-dir--entry-at-point ()
+(defun h/dir--entry-at-point ()
"Return entry at point.
With point below last entry, returns nil.
With point on header, returns directory entry."
(let ((current-line (line-number-at-pos))
- (last-entry (ewoc-nth hyperdrive-ewoc -1)))
+ (last-entry (ewoc-nth h/ewoc -1)))
(cond ((or (not last-entry) (= 1 current-line))
;; Hyperdrive is empty or point is on header line
- hyperdrive-current-entry)
+ h/current-entry)
((or (> current-line (line-number-at-pos (ewoc-location last-entry)))
(= 2 current-line))
;; Point is below the last entry or on column headers
nil)
(t
;; Point on a file entry: return its entry.
- (ewoc-data (ewoc-locate hyperdrive-ewoc))))))
+ (ewoc-data (ewoc-locate h/ewoc))))))
;;;; Mode
-(declare-function hyperdrive-up "hyperdrive")
-(declare-function hyperdrive-delete "hyperdrive")
-(declare-function hyperdrive-download "hyperdrive")
-;; `hyperdrive-menu' is defined with `transient-define-prefix', which
+(declare-function h/up "hyperdrive")
+(declare-function h/delete "hyperdrive")
+(declare-function h/download "hyperdrive")
+;; `h/menu' is defined with `transient-define-prefix', which
;; `check-declare' doesn't recognize.
-(declare-function hyperdrive-menu "hyperdrive-menu" nil t)
+(declare-function h/menu "hyperdrive-menu" nil t)
-(defvar-keymap hyperdrive-dir-mode-map
- :parent hyperdrive-ewoc-mode-map
+(defvar-keymap h/dir-mode-map
+ :parent h/ewoc-mode-map
:doc "Local keymap for `hyperdrive-dir-mode' buffers."
- "RET" #'hyperdrive-dir-find-file
- "o" #'hyperdrive-dir-find-file-other-window
- "v" #'hyperdrive-dir-view-file
+ "RET" #'h/dir-find-file
+ "o" #'h/dir-find-file-other-window
+ "v" #'h/dir-view-file
"j" #'imenu
- "w" #'hyperdrive-dir-copy-url
- "d" #'hyperdrive-download
- "^" #'hyperdrive-up
- "D" #'hyperdrive-delete
- "H" #'hyperdrive-dir-history
- "s" #'hyperdrive-dir-sort
- "?" #'hyperdrive-menu
- "+" #'hyperdrive-create-directory-no-op
- "<mouse-2>" #'hyperdrive-dir-follow-link
+ "w" #'h/dir-copy-url
+ "d" #'h/download
+ "^" #'h/up
+ "D" #'h/delete
+ "H" #'h/dir-history
+ "s" #'h/dir-sort
+ "?" #'h/menu
+ "+" #'h/create-directory-no-op
+ "<mouse-2>" #'h/dir-follow-link
"<follow-link>" 'mouse-face)
-(define-derived-mode hyperdrive-dir-mode hyperdrive-ewoc-mode
+(define-derived-mode h/dir-mode h/ewoc-mode
`("Hyperdrive-dir"
;; TODO: Add more to lighter, e.g. URL.
)
"Major mode for Hyperdrive directory buffers."
:group 'hyperdrive
:interactive nil
- (setq-local imenu-create-index-function
#'hyperdrive-dir--imenu-create-index-function
+ (setq-local imenu-create-index-function #'h/dir--imenu-create-index-function
imenu-auto-rescan t
imenu-space-replacement " "))
;;;; Commands
-(defun hyperdrive-dir-follow-link (event)
+(defun h/dir-follow-link (event)
"Follow link at EVENT's position."
(interactive "e")
(if-let ((column (get-char-property (mouse-set-point event)
'hyperdrive-dir-column)))
- (hyperdrive-dir-sort
- (hyperdrive-dir-toggle-sort-direction
- column hyperdrive-directory-sort))
- (call-interactively #'hyperdrive-dir-find-file-other-window)))
+ (h/dir-sort
+ (h/dir-toggle-sort-direction
+ column h/directory-sort))
+ (call-interactively #'h/dir-find-file-other-window)))
-(cl-defun hyperdrive-dir-find-file
- (entry &key (display-buffer-action
hyperdrive-directory-display-buffer-action))
+(cl-defun h/dir-find-file
+ (entry &key (display-buffer-action h/directory-display-buffer-action))
"Visit hyperdrive ENTRY at point.
Interactively, visit file or directory at point in
`hyperdrive-dir' buffer. DISPLAY-BUFFER-ACTION is passed to
`pop-to-buffer'."
- (declare (modes hyperdrive-dir-mode))
- (interactive (list (or (hyperdrive-dir--entry-at-point)
- (hyperdrive-user-error "No file/directory at
point"))))
- (hyperdrive-open entry
+ (interactive (list (or (h/dir--entry-at-point)
+ (h/user-error "No file/directory at point")))
+ h/dir-mode)
+ (h/open entry
:then (lambda ()
(pop-to-buffer (current-buffer) display-buffer-action))))
-(defun hyperdrive-dir-find-file-other-window (entry)
+(defun h/dir-find-file-other-window (entry)
"Visit hyperdrive ENTRY at point in other window.
Interactively, visit file or directory at point in
`hyperdrive-dir' buffer."
- (declare (modes hyperdrive-dir-mode))
- (interactive (list (or (hyperdrive-dir--entry-at-point)
- (hyperdrive-user-error "No file/directory at
point"))))
- (hyperdrive-dir-find-file entry :display-buffer-action t))
+ (interactive (list (or (h/dir--entry-at-point)
+ (h/user-error "No file/directory at point")))
+ h/dir-mode)
+ (h/dir-find-file entry :display-buffer-action t))
-(declare-function hyperdrive-view-file "hyperdrive")
-(defun hyperdrive-dir-view-file (entry)
+(declare-function h/view-file "hyperdrive")
+(defun h/dir-view-file (entry)
"Open hyperdrive ENTRY at point in `view-mode'.
Interactively, opens file or directory at point in
`hyperdrive-dir' buffer."
- (declare (modes hyperdrive-dir-mode))
- (interactive (list (or (hyperdrive-dir--entry-at-point)
- (hyperdrive-user-error "No file/directory at
point"))))
- (hyperdrive-view-file entry))
+ (interactive (list (or (h/dir--entry-at-point)
+ (h/user-error "No file/directory at point")))
+ h/dir-mode)
+ (h/view-file entry))
-(declare-function hyperdrive-copy-url "hyperdrive")
+(declare-function h/copy-url "hyperdrive")
-(defun hyperdrive-dir-copy-url (entry)
+(defun h/dir-copy-url (entry)
"Copy URL of ENTRY into the kill ring."
- (declare (modes hyperdrive-dir-mode))
- (interactive (list (or (hyperdrive-dir--entry-at-point)
- (hyperdrive-user-error "No file/directory at
point"))))
- (hyperdrive-copy-url entry))
+ (interactive (list (or (h/dir--entry-at-point)
+ (h/user-error "No file/directory at point")))
+ h/dir-mode)
+ (h/copy-url entry))
-(declare-function hyperdrive-history "hyperdrive-history")
+(declare-function h/history "hyperdrive-history")
-(defun hyperdrive-dir-history (entry)
+(defun h/dir-history (entry)
"Display version history for ENTRY at point."
- (interactive (list (or (hyperdrive-dir--entry-at-point)
- (hyperdrive-user-error "No file/directory at
point"))))
- (hyperdrive-history entry))
+ (interactive (list (or (h/dir--entry-at-point)
+ (h/user-error "No file/directory at point"))))
+ (h/history entry))
-(defun hyperdrive-create-directory-no-op ()
+(defun h/create-directory-no-op ()
"Signal error that directory creation is not possible in hyperdrive."
(interactive)
- (hyperdrive-user-error
- (substitute-command-keys "Cannot create empty directory; to create a new
file, use `hyperdrive-find-file' or \\[hyperdrive-find-file]")))
+ (h/user-error "Cannot create empty directory; to create a new file, use
`hyperdrive-find-file' or \\[hyperdrive-find-file]"))
-(defun hyperdrive-dir-sort (directory-sort)
+(defun h/dir-sort (directory-sort)
"Sort current `hyperdrive-dir' buffer by DIRECTORY-SORT.
DIRECTORY-SORT should be a valid value of
`hyperdrive-directory-sort'."
(interactive (list (if current-prefix-arg
- (hyperdrive-dir-complete-sort)
- (hyperdrive-dir-toggle-sort-direction
- (car hyperdrive-directory-sort)
hyperdrive-directory-sort))))
- (setq-local hyperdrive-directory-sort directory-sort)
+ (h/dir-complete-sort)
+ (h/dir-toggle-sort-direction
+ (car h/directory-sort) h/directory-sort))))
+ (setq-local h/directory-sort directory-sort)
(with-silent-modifications
- (let ((entries (ewoc-collect hyperdrive-ewoc #'hyperdrive-entry-p)))
- (ewoc-filter hyperdrive-ewoc #'ignore)
- (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))
+ (let ((entries (ewoc-collect h/ewoc #'he/p)))
+ (ewoc-filter h/ewoc #'ignore)
+ (dolist (entry (h/sort-entries entries))
+ (ewoc-enter-last h/ewoc entry))
+ (ewoc-set-hf h/ewoc
+ (h/dir-column-headers
+ (h//format-entry h/current-entry))
""))))
;;;; Imenu support
-(defun hyperdrive-dir--imenu-create-index-function ()
+(defun h/dir--imenu-create-index-function ()
"Return Imenu index for the current `hyperdrive-dir' buffer.
For use as `imenu-create-index-function'."
- (cl-loop for node in (hyperdrive-ewoc-collect-nodes hyperdrive-ewoc
#'identity)
+ (cl-loop for node in (h/ewoc-collect-nodes h/ewoc #'identity)
collect (let* ((location (goto-char (ewoc-location node)))
(entry (ewoc-data node))
- (face (when (hyperdrive--entry-directory-p entry)
- 'hyperdrive-directory)))
- (cons (propertize (hyperdrive-entry-name entry)
+ (face (when (h//entry-directory-p entry)
+ 'h/directory)))
+ (cons (propertize (he/name entry)
'face face)
location))))
;;;; Yank media support
(when (version<= "29.1" emacs-version)
- (defun hyperdrive-dir--yank-media-image-handler (_type image)
+ (defun h/dir--yank-media-image-handler (_type image)
"Upload IMAGE to current buffer's hyperdrive directory.
Prompts for a filename before uploading. For more information,
see Info node `(elisp)Yanking Media'."
;; TODO: Extend this to other media types?
- (cl-assert (and hyperdrive-current-entry
- (hyperdrive--entry-directory-p hyperdrive-current-entry)))
- (pcase-let* (((cl-struct hyperdrive-entry hyperdrive path)
hyperdrive-current-entry)
- (entry (hyperdrive-read-entry :hyperdrive (and
(hyperdrive-writablep hyperdrive)
- hyperdrive)
- :predicate
#'hyperdrive-writablep
- :default-path path
:latest-version t)))
- (hyperdrive-api 'put (hyperdrive-entry-url entry)
+ (cl-assert (and h/current-entry
+ (h//entry-directory-p h/current-entry)))
+ (pcase-let* (((cl-struct hyperdrive-entry hyperdrive path) h/current-entry)
+ (entry (h/read-entry :hyperdrive (and (h/writablep hyperdrive)
+ hyperdrive)
+ :predicate #'h/writablep
+ :default-path path :latest-version t)))
+ (h/api 'put (he/url entry)
:body-type 'binary
;; TODO: Pass MIME type in a header? hyper-gateway detects it for us.
:body image :as 'response
- :then (lambda (_res) (hyperdrive-open entry))
+ :then (lambda (_res) (h/open entry))
:else (lambda (plz-error)
- (hyperdrive-message "Unable to yank media: %S" plz-error)))))
+ (h/message "Unable to yank media: %S" plz-error)))))
- (add-hook 'hyperdrive-dir-mode-hook
+ (add-hook 'h/dir-mode-hook
(lambda ()
;; Silence compiler warning about `yank-media-handler' not being
;; defined in earlier versions of Emacs.
(`with-suppressed-warnings'
;; doesn't allow suppressing this warning.)
(with-no-warnings
(yank-media-handler
- "image/.*" #'hyperdrive-dir--yank-media-image-handler)))))
+ "image/.*" #'h/dir--yank-media-image-handler)))))
(provide 'hyperdrive-dir)
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
;;; hyperdrive-dir.el ends here
diff --git a/hyperdrive-ewoc.el b/hyperdrive-ewoc.el
index 470c7b134c..ca5542ea18 100644
--- a/hyperdrive-ewoc.el
+++ b/hyperdrive-ewoc.el
@@ -33,13 +33,13 @@
;;;; Variables
-(defvar-local hyperdrive-ewoc nil
+(defvar-local h/ewoc nil
"EWOC for current hyperdrive buffer.")
-(put 'hyperdrive-ewoc 'permanent-local t)
+(put 'h/ewoc 'permanent-local t)
;;;; Functions
-(cl-defun hyperdrive-ewoc-find-node (ewoc data &key (predicate #'eq))
+(cl-defun h/ewoc-find-node (ewoc data &key (predicate #'eq))
"Return the last node in EWOC whose DATA matches PREDICATE.
PREDICATE is called with DATA and node's data. Searches backward from
last node."
@@ -53,13 +53,13 @@ last node."
;;;; Mode
-(defvar-keymap hyperdrive-ewoc-mode-map
+(defvar-keymap h/ewoc-mode-map
:parent special-mode-map
:doc "Local keymap for `hyperdrive-ewoc-mode' buffers."
- "n" #'hyperdrive-ewoc-next
- "p" #'hyperdrive-ewoc-previous)
+ "n" #'h/ewoc-next
+ "p" #'h/ewoc-previous)
-(define-derived-mode hyperdrive-ewoc-mode special-mode
+(define-derived-mode h/ewoc-mode special-mode
`("Hyperdrive-ewoc"
;; TODO: Add more to lighter, e.g. URL.
)
@@ -69,47 +69,45 @@ last node."
;;;; Commands
-(cl-defun hyperdrive-ewoc-next (&optional (n 1))
+(cl-defun h/ewoc-next (&optional (n 1))
"Move forward N entries.
When on header line, moves point to first entry, skipping over
column headers."
- (declare (modes hyperdrive-ewoc-mode))
- (interactive "p")
+ (interactive "p" h/ewoc-mode)
;; TODO: Try using the intangible text property on headers to
;; automatically skip over them without conditional code. Setting
;; `cursor-intangible' on the column header causes `hl-line-mode' to
;; highlight the wrong line when crossing over the headers.
(let ((lines-below-header (- (line-number-at-pos) 2)))
(if (cl-plusp lines-below-header)
- (hyperdrive-ewoc-move n)
+ (h/ewoc-move n)
;; Point on first line or column header: jump to first ewoc entry and
then maybe move.
- (goto-char (ewoc-location (ewoc-nth hyperdrive-ewoc 0)))
- (hyperdrive-ewoc-move (1- n)))))
+ (goto-char (ewoc-location (ewoc-nth h/ewoc 0)))
+ (h/ewoc-move (1- n)))))
-(cl-defun hyperdrive-ewoc-previous (&optional (n 1))
+(cl-defun h/ewoc-previous (&optional (n 1))
"Move backward N entries.
When on first entry, moves point to header line, skipping over
column headers."
- (declare (modes hyperdrive-ewoc-mode))
- (interactive "p")
+ (interactive "p" h/ewoc-mode)
(let ((lines-below-header (- (line-number-at-pos) 2)))
(if (and (cl-plusp lines-below-header)
(< n lines-below-header))
- (hyperdrive-ewoc-move (- n))
+ (h/ewoc-move (- n))
;; Point on first line or column header or N > LINE
(goto-char (point-min)))))
-(cl-defun hyperdrive-ewoc-move (&optional (n 1))
+(cl-defun h/ewoc-move (&optional (n 1))
"Move forward N entries."
(let ((next-fn (pcase n
((pred (< 0)) #'ewoc-next)
((pred (> 0)) #'ewoc-prev)))
- (node (ewoc-locate hyperdrive-ewoc))
+ (node (ewoc-locate h/ewoc))
(i 0)
(n (abs n))
target-node)
(while (and (< i n)
- (setf node (funcall next-fn hyperdrive-ewoc node)))
+ (setf node (funcall next-fn h/ewoc node)))
(setf target-node node)
(cl-incf i))
(when target-node
@@ -117,7 +115,7 @@ column headers."
;;;; Functions
-(defun hyperdrive-ewoc-collect-nodes (ewoc predicate)
+(defun h/ewoc-collect-nodes (ewoc predicate)
"Collect all nodes in EWOC matching PREDICATE.
PREDICATE is called with the full node."
;; Intended to be like `ewoc-collect', but working with the full
@@ -128,5 +126,13 @@ PREDICATE is called with the full node."
when (funcall predicate node)
collect node))
-(provide 'hyperdrive-ewoc)
+(provide 'h/ewoc)
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
;;; hyperdrive-ewoc.el ends here
diff --git a/hyperdrive-history.el b/hyperdrive-history.el
index 4ff74e2ee9..f3f9d8ab7d 100644
--- a/hyperdrive-history.el
+++ b/hyperdrive-history.el
@@ -29,23 +29,23 @@
(require 'cl-lib)
(require 'hyperdrive-lib)
-(require 'hyperdrive-ewoc)
+(require 'h/ewoc)
;;;; Functions
-(defun hyperdrive-history-find-at-point (event)
+(defun h/history-find-at-point (event)
"Find entry at EVENT's position."
(interactive "e")
(mouse-set-point event)
- (call-interactively #'hyperdrive-history-find-file-other-window))
+ (call-interactively #'h/history-find-file-other-window))
-(defun hyperdrive-history-pp (thing)
+(defun h/history-pp (thing)
"Pretty-print THING.
To be used as the pretty-printer for `ewoc-create'."
;; FIXME: Perform type-checking? If not, is this function necessary?
- (insert (hyperdrive-history--format-range-entry thing)))
+ (insert (h/history--format-range-entry thing)))
-(defun hyperdrive-history--format-range-entry (range-entry)
+(defun h/history--format-range-entry (range-entry)
"Return RANGE-ENTRY formatted as a string.
RANGE-ENTRY is a cons cell whose car is a range according to
`hyperdrive-version-ranges', except that \\+`:existsp' may have the
@@ -63,18 +63,18 @@ value \\+`unknown', and whose cdr is a hyperdrive entry."
(size (when size
(file-size-human-readable size)))
(timestamp (if mtime
- (format-time-string hyperdrive-timestamp-format
mtime)
- (propertize " " 'display '(space :width
hyperdrive-timestamp-width)))))
+ (format-time-string h/timestamp-format mtime)
+ (propertize " " 'display '(space :width
h/timestamp-width)))))
;; FIXME: Use dynamic width of range column equal to 2N+1, where N
;; is the width of the hyperdrive's latest version
(format "%7s %19s %6s %s"
(propertize exists-marker
'face (pcase-exhaustive existsp
- ('t 'hyperdrive-history-existent)
- ('nil 'hyperdrive-history-nonexistent)
- ('unknown 'hyperdrive-history-unknown)))
+ ('t 'h/history-existent)
+ ('nil 'h/history-nonexistent)
+ ('unknown 'h/history-unknown)))
(propertize formatted-range
- 'face 'hyperdrive-history-range
+ 'face 'h/history-range
'mouse-face 'highlight
'help-echo (format (pcase-exhaustive existsp
('t "Open version %s")
@@ -82,33 +82,33 @@ value \\+`unknown', and whose cdr is a hyperdrive entry."
('unknown "Load history at
version %s"))
range-start))
(propertize (or size "")
- 'face 'hyperdrive-size)
+ 'face 'h/size)
(propertize (or timestamp "")
- 'face 'hyperdrive-timestamp))))
+ 'face 'h/timestamp))))
-(defun hyperdrive-history-range-entry-at-point ()
+(defun h/history-range-entry-at-point ()
"Return range-entry at version at point.
With point below last entry, signals a user-error.
With point on header, returns a rangle-entry whose RANGE-END
and ENTRY's version are nil."
(let ((current-line (line-number-at-pos))
- (last-line (line-number-at-pos (ewoc-location (ewoc-nth
hyperdrive-ewoc -1))))
- (range-entry-at-point (ewoc-data (ewoc-locate hyperdrive-ewoc))))
+ (last-line (line-number-at-pos (ewoc-location (ewoc-nth h/ewoc -1))))
+ (range-entry-at-point (ewoc-data (ewoc-locate h/ewoc))))
(cond ((= 1 current-line)
;; Point on header: set range-end and entry version to nil
(pcase-let ((`(,range . ,entry)
- (hyperdrive-copy-tree range-entry-at-point t)))
+ (h/copy-tree range-entry-at-point t)))
(setf (map-elt (cdr range) :range-end) nil)
- (setf (hyperdrive-entry-version entry) nil)
+ (setf (he/version entry) nil)
(cons range entry)))
((or (> current-line last-line) (= 2 current-line))
;; Point is below the last entry or on column headers: signal error.
- (hyperdrive-user-error "No file on this line"))
+ (h/user-error "No file on this line"))
(t
;; Point on a file entry: return its entry.
range-entry-at-point))))
-(defun hyperdrive-range-entry-exists-p (range-entry)
+(defun h/range-entry-exists-p (range-entry)
"Return status of RANGE-ENTRY's existence at its version.
- t :: ENTRY is known to exist.
@@ -118,39 +118,39 @@ and ENTRY's version are nil."
((map (:existsp existsp)) (cdr range)))
existsp))
-(defun hyperdrive-history-revert-buffer (&optional _ignore-auto _noconfirm)
+(defun h/history-revert-buffer (&optional _ignore-auto _noconfirm)
"Revert `hyperdrive-history-mode' buffer."
;; TODO: Preserve point position in buffer.
- (hyperdrive-history hyperdrive-current-entry))
+ (h/history h/current-entry))
;;;; Mode
-(defvar-keymap hyperdrive-history-mode-map
- :parent hyperdrive-ewoc-mode-map
+(defvar-keymap h/history-mode-map
+ :parent h/ewoc-mode-map
:doc "Local keymap for `hyperdrive-history-mode' buffers."
- "RET" #'hyperdrive-history-find-file
- "o" #'hyperdrive-history-find-file-other-window
- "v" #'hyperdrive-history-view-file
- "=" #'hyperdrive-history-diff
- "+" #'hyperdrive-history-fill-version-ranges
- "w" #'hyperdrive-history-copy-url
- "d" #'hyperdrive-history-download-file
- "<mouse-2>" #'hyperdrive-history-find-at-point
+ "RET" #'h/history-find-file
+ "o" #'h/history-find-file-other-window
+ "v" #'h/history-view-file
+ "=" #'h/history-diff
+ "+" #'h/history-fill-version-ranges
+ "w" #'h/history-copy-url
+ "d" #'h/history-download-file
+ "<mouse-2>" #'h/history-find-at-point
"<follow-link>" 'mouse-face)
-(define-derived-mode hyperdrive-history-mode hyperdrive-ewoc-mode
+(define-derived-mode h/history-mode h/ewoc-mode
`("Hyperdrive-history"
;; TODO: Add more to lighter, e.g. URL.
)
"Major mode for Hyperdrive history buffers."
;; TODO: Add revert buffer function. This will likely require
- ;; binding hyperdrive-current-entry in this mode. Consider keeping
+ ;; binding h/current-entry in this mode. Consider keeping
;; the version around so that we can highlight the line
;; corresponding to version currently open in another buffer.
:group 'hyperdrive
:interactive nil
- (setf hyperdrive-ewoc (ewoc-create #'hyperdrive-history-pp))
- (setq-local revert-buffer-function #'hyperdrive-history-revert-buffer))
+ (setf h/ewoc (ewoc-create #'h/history-pp))
+ (setq-local revert-buffer-function #'h/history-revert-buffer))
;;;; Commands
@@ -161,10 +161,10 @@ and ENTRY's version are nil."
Interactively, open version history for current file ENTRY or
ENTRY at point in a directory. Otherwise, or with universal
prefix argument \\[universal-argument], prompt for ENTRY."
- (interactive (list (hyperdrive--context-entry)))
+ (interactive (list (h//context-entry)))
;; TODO: Highlight range for ENTRY
- (when (hyperdrive--entry-directory-p entry)
- (hyperdrive-user-error "Directory history not implemented"))
+ (when (h//entry-directory-p entry)
+ (h/user-error "Directory history not implemented"))
(pcase-let* (((cl-struct hyperdrive-entry hyperdrive path) entry)
(range-entries
(mapcar (lambda (range)
@@ -172,38 +172,38 @@ prefix argument \\[universal-argument], prompt for ENTRY."
;; as in the version before it was created, see:
;; (info "(hyperdrive)Versioning")
(cons range
- (hyperdrive-entry-create
+ (he/create
:hyperdrive hyperdrive
:path path
;; Set version to range-start
: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))
+ (nreverse (he/version-ranges-no-gaps entry))))
+ (main-header (h//format-entry entry "[%H] %p"))
(header (concat main-header "\n"
(format "%7s %19s %6s %s"
- (propertize "Exists" 'face
'hyperdrive-column-header)
- (propertize "Drive Version Range" 'face
'hyperdrive-column-header)
- (propertize "Size" 'face
'hyperdrive-column-header)
- (format (format "%%%ds"
hyperdrive-timestamp-width)
- (propertize "Last Modified"
'face 'hyperdrive-column-header)))))
+ (propertize "Exists" 'face
'h/column-header)
+ (propertize "Drive Version Range" 'face
'h/column-header)
+ (propertize "Size" 'face
'h/column-header)
+ (format (format "%%%ds"
h/timestamp-width)
+ (propertize "Last Modified"
'face 'h/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*"
+ (h//format-entry entry "[%H] %p")))
(with-silent-modifications
- (hyperdrive-history-mode)
- (setq-local hyperdrive-current-entry entry)
- (setf ewoc hyperdrive-ewoc) ; Bind this for the hyperdrive-fill lambda.
- (ewoc-filter hyperdrive-ewoc #'ignore)
+ (h/history-mode)
+ (setq-local h/current-entry entry)
+ (setf ewoc h/ewoc) ; Bind this for the h/fill lambda.
+ (ewoc-filter h/ewoc #'ignore)
(erase-buffer)
- (ewoc-set-hf hyperdrive-ewoc header "")
+ (ewoc-set-hf h/ewoc header "")
(mapc (lambda (range-entry)
- (ewoc-enter-last hyperdrive-ewoc range-entry))
+ (ewoc-enter-last h/ewoc range-entry))
range-entries))
;; TODO: Display files in pop-up window, like magit-diff buffers appear
when selected from magit-log
- (display-buffer (current-buffer)
hyperdrive-history-display-buffer-action)
- (setf queue (make-plz-queue :limit hyperdrive-queue-limit
+ (display-buffer (current-buffer) h/history-display-buffer-action)
+ (setf queue (make-plz-queue :limit h/queue-limit
:finally (lambda ()
;; NOTE: Ensure that the buffer's
window is selected,
;; if it has one. (Workaround a
possible bug in EWOC.)
@@ -211,10 +211,10 @@ prefix argument \\[universal-argument], prompt for ENTRY."
(with-selected-window
buffer-window
;; TODO: Use
`ewoc-invalidate' on individual entries
;; (maybe later, as
performance comes to matter more).
- (with-silent-modifications
(ewoc-refresh hyperdrive-ewoc))
+ (with-silent-modifications
(ewoc-refresh h/ewoc))
(goto-char (point-min)))
(with-current-buffer
(ewoc-buffer ewoc)
- (with-silent-modifications
(ewoc-refresh hyperdrive-ewoc))
+ (with-silent-modifications
(ewoc-refresh h/ewoc))
(goto-char (point-min))))
;; TODO: Accept then argument?
;; (with-current-buffer
(ewoc-buffer ewoc)
@@ -222,48 +222,47 @@ prefix argument \\[universal-argument], prompt for ENTRY."
;; (funcall then)))
)))
(mapc (lambda (range-entry)
- (when (eq t (hyperdrive-range-entry-exists-p range-entry))
+ (when (eq t (h/range-entry-exists-p range-entry))
;; TODO: Handle failures?
- (hyperdrive-fill (cdr range-entry) :queue queue :then
#'ignore)))
+ (h/fill (cdr range-entry) :queue queue :then #'ignore)))
range-entries)
(set-buffer-modified-p nil)
(goto-char (point-min)))))
;; TODO: Add pcase-defmacro for destructuring range-entry
-(defun hyperdrive-history-fill-version-ranges (range-entry)
+(defun h/history-fill-version-ranges (range-entry)
"Fill version ranges starting from RANGE-ENTRY at point."
- (interactive (list (hyperdrive-history-range-entry-at-point)))
+ (interactive (list (h/history-range-entry-at-point)))
(pcase-let* ((`(,range . ,entry) range-entry)
(`(,_range-start . ,(map (:range-end range-end))) range)
- (range-end-entry (hyperdrive-copy-tree entry))
+ (range-end-entry (h/copy-tree entry))
(ov (make-overlay (pos-bol) (+ (pos-bol) (length "Loading")))))
- (setf (hyperdrive-entry-version range-end-entry) range-end)
+ (setf (he/version range-end-entry) range-end)
(overlay-put ov 'display "Loading")
- (hyperdrive-fill-version-ranges range-end-entry
+ (h/fill-version-ranges range-end-entry
:finally (lambda ()
;; TODO: Should we open the history buffer for entry
;; or range-end-entry or...?
(delete-overlay ov)
- (hyperdrive-history entry)))))
+ (h/history entry)))))
-(declare-function hyperdrive-diff-file-entries "hyperdrive-diff")
-(defun hyperdrive-history-diff (old-entry new-entry)
+(declare-function h/diff-file-entries "hyperdrive-diff")
+(defun h/history-diff (old-entry new-entry)
"Show diff between OLD-ENTRY and NEW-ENTRY.
Interactively, diff range entry at point with previous entry."
- (declare (modes hyperdrive-history-mode))
;; TODO: Set entries based on marked ranges
;; TODO: What to do for unknown range-entries?
- (interactive (let* ((new-entry (cdr
(hyperdrive-history-range-entry-at-point)))
- (old-entry (hyperdrive-entry-previous new-entry)))
+ (interactive (let* ((new-entry (cdr (h/history-range-entry-at-point)))
+ (old-entry (he/previous new-entry)))
(unless old-entry
- (setf old-entry (hyperdrive-copy-tree new-entry t))
- (cl-decf (hyperdrive-entry-version old-entry)))
- (list old-entry new-entry)))
- (hyperdrive-diff-file-entries old-entry new-entry
+ (setf old-entry (h/copy-tree new-entry t))
+ (cl-decf (he/version old-entry)))
+ (list old-entry new-entry)) h/history-mode)
+ (h/diff-file-entries old-entry new-entry
:then (lambda ()
(pop-to-buffer (current-buffer)))))
-(cl-defun hyperdrive-history-find-file
+(cl-defun h/history-find-file
(range-entry &key (then (lambda ()
(pop-to-buffer (current-buffer)
'(display-buffer-same-window)))))
"Visit hyperdrive entry in RANGE-ENTRY at point.
@@ -273,20 +272,19 @@ entry at RANGE-ENTRY's RANGE-END.
Interactively, visit entry at point in `hyperdrive-history'
buffer."
- (declare (modes hyperdrive-history-mode))
- (interactive (list (hyperdrive-history-range-entry-at-point)))
- (pcase-exhaustive (hyperdrive-range-entry-exists-p range-entry)
+ (interactive (list (h/history-range-entry-at-point)) h/history-mode)
+ (pcase-exhaustive (h/range-entry-exists-p range-entry)
('t
;; Known to exist: open it.
- (hyperdrive-open (cdr range-entry) :then then))
+ (h/open (cdr range-entry) :then then))
('nil
;; Known to not exist: warn user.
- (hyperdrive-user-error "File does not exist!"))
+ (h/user-error "File does not exist!"))
('unknown
;; Not known to exist: fill version ranges:
- (hyperdrive-history-fill-version-ranges range-entry))))
+ (h/history-fill-version-ranges range-entry))))
-(defun hyperdrive-history-find-file-other-window (range-entry)
+(defun h/history-find-file-other-window (range-entry)
"Visit hyperdrive entry in RANGE-ENTRY at point in other window.
Then call THEN. When entry does not exist, does nothing and
returns nil. When entry is not known to exist, attempts to load
@@ -294,59 +292,55 @@ entry at RANGE-ENTRY's RANGE-END.
Interactively, visit entry at point in `hyperdrive-history'
buffer."
- (declare (modes hyperdrive-history-mode))
- (interactive (list (hyperdrive-history-range-entry-at-point)))
- (hyperdrive-history-find-file
+ (interactive (list (h/history-range-entry-at-point)) h/history-mode)
+ (h/history-find-file
range-entry :then (lambda ()
(pop-to-buffer (current-buffer) t))))
-(declare-function hyperdrive-view-file "hyperdrive")
-(defun hyperdrive-history-view-file (range-entry)
+(declare-function h/view-file "hyperdrive")
+(defun h/history-view-file (range-entry)
"Open hyperdrive entry in RANGE-ENTRY at point in `view-mode'.
When entry does not exist or is not known to exist, does nothing
and returns nil.
Interactively, visit entry at point in `hyperdrive-history'
buffer."
- (declare (modes hyperdrive-history-mode))
- (interactive (list (hyperdrive-history-range-entry-at-point)))
- (pcase-exhaustive (hyperdrive-range-entry-exists-p range-entry)
+ (interactive (list (h/history-range-entry-at-point)) h/history-mode)
+ (pcase-exhaustive (h/range-entry-exists-p range-entry)
('t
;; Known to exist: open it.
- (hyperdrive-view-file (cdr range-entry)))
+ (h/view-file (cdr range-entry)))
('nil
;; Known to not exist: warn user.
- (hyperdrive-user-error "File does not exist!"))
+ (h/user-error "File does not exist!"))
('unknown
;; Not known to exist: fill version ranges:
- (hyperdrive-history-fill-version-ranges range-entry))))
+ (h/history-fill-version-ranges range-entry))))
-(declare-function hyperdrive-copy-url "hyperdrive")
+(declare-function h/copy-url "hyperdrive")
-(defun hyperdrive-history-copy-url (range-entry)
+(defun h/history-copy-url (range-entry)
"Copy URL of entry in RANGE-ENTRY into the kill ring."
- (declare (modes hyperdrive-history-mode))
- (interactive (list (hyperdrive-history-range-entry-at-point)))
- (pcase-exhaustive (hyperdrive-range-entry-exists-p range-entry)
+ (interactive (list (h/history-range-entry-at-point)) h/history-mode)
+ (pcase-exhaustive (h/range-entry-exists-p range-entry)
('t
;; Known to exist: copy it.
- (hyperdrive-copy-url (cdr range-entry)))
+ (h/copy-url (cdr range-entry)))
('nil
;; Known to not exist: warn user.
- (hyperdrive-user-error "File does not exist!"))
+ (h/user-error "File does not exist!"))
('unknown
;; Not known to exist: warn user.
- (hyperdrive-user-error "File not known to exist!"))))
+ (h/user-error "File not known to exist!"))))
-(declare-function hyperdrive-download "hyperdrive")
+(declare-function h/download "hyperdrive")
-(defun hyperdrive-history-download-file (range-entry filename)
+(defun h/history-download-file (range-entry filename)
"Download entry in RANGE-ENTRY at point to FILENAME on disk."
- (declare (modes hyperdrive-history-mode))
(interactive
- (pcase-let* ((range-entry (hyperdrive-history-range-entry-at-point))
+ (pcase-let* ((range-entry (h/history-range-entry-at-point))
((cl-struct hyperdrive-entry name) (cdr range-entry))
- (read-filename (when (eq t (hyperdrive-range-entry-exists-p
range-entry))
+ (read-filename (when (eq t (h/range-entry-exists-p
range-entry))
;; Only prompt for filename when entry exists
;; FIXME: This function is only intended for
@@ -355,18 +349,26 @@ buffer."
;; in the body? This change would deduplicate
the
;; check for the existence of the entry.
(read-file-name "Filename: "
- (expand-file-name name
hyperdrive-download-directory)))))
- (list range-entry read-filename)))
- (pcase-exhaustive (hyperdrive-range-entry-exists-p range-entry)
+ (expand-file-name name
h/download-directory)))))
+ (list range-entry read-filename)) h/history-mode)
+ (pcase-exhaustive (h/range-entry-exists-p range-entry)
('t
;; Known to exist: download it.
- (hyperdrive-download (cdr range-entry) filename))
+ (h/download (cdr range-entry) filename))
('nil
;; Known to not exist: warn user.
- (hyperdrive-user-error "File does not exist!"))
+ (h/user-error "File does not exist!"))
('unknown
;; Not known to exist: warn user.
- (hyperdrive-user-error "File not known to exist!"))))
+ (h/user-error "File not known to exist!"))))
-(provide 'hyperdrive-history)
+(provide 'h/history)
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
;;; hyperdrive-history.el ends here
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index 78c7f21a4a..8acbec9d57 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -41,25 +41,21 @@
;;;; Declarations
-(declare-function hyperdrive-mode "hyperdrive")
-(declare-function hyperdrive-dir-mode "hyperdrive-dir")
-
-(eval-and-compile
- (when (< emacs-major-version 28)
- (cl-pushnew '(modes ignore) defun-declarations-alist :test #'equal)))
+(declare-function h/mode "hyperdrive")
+(declare-function h/dir-mode "hyperdrive-dir")
;;;; Errors
-(define-error 'hyperdrive-error "hyperdrive error")
+(define-error 'h/error "hyperdrive error")
-(defun hyperdrive-error (&rest args)
+(defun h/error (&rest args)
"Like `error', but signals `hyperdrive-error'.
Passes ARGS to `format-message'."
- (signal 'hyperdrive-error (list (apply #'format-message args))))
+ (signal 'h/error (list (apply #'format-message args))))
;;;; Structs
-(cl-defstruct (hyperdrive-entry (:constructor hyperdrive-entry--create)
+(cl-defstruct (hyperdrive-entry (:constructor he//create)
(:copier nil))
"Represents an entry in a hyperdrive."
(hyperdrive nil :documentation "The entry's hyperdrive.")
@@ -76,7 +72,7 @@ Passes ARGS to `format-message'."
(type nil :documentation "MIME type of the entry.")
(etc nil :documentation "Alist for extra data about the entry."))
-(cl-defstruct (hyperdrive (:constructor hyperdrive-create)
+(cl-defstruct (hyperdrive (:constructor h/create)
(:copier nil))
"Represents a hyperdrive."
(public-key nil :documentation "Hyperdrive's public key.")
@@ -89,7 +85,7 @@ Passes ARGS to `format-message'."
(latest-version nil :documentation "Latest known version of hyperdrive.")
(etc nil :documentation "Alist of extra data."))
-(defun hyperdrive-url (hyperdrive)
+(defun h/url (hyperdrive)
"Return a \"hyper://\"-prefixed URL from a HYPERDRIVE struct.
URL does not have a trailing slash, i.e., \"hyper://PUBLIC-KEY\".
@@ -101,23 +97,23 @@ domains slot."
(host (or public-key (car domains))))
(concat "hyper://" host)))
-(defun hyperdrive--url-hexify-string (string)
+(defun h//url-hexify-string (string)
"Return STRING having been URL-encoded.
Calls `url-hexify-string' with the \"/\" character added to
`url-unreserved-chars'."
(url-hexify-string string (cons ?/ url-unreserved-chars)))
-(defun hyperdrive-entry-url (entry)
+(defun he/url (entry)
"Return ENTRY's canonical URL.
Returns URL with hyperdrive's full public key."
- (hyperdrive--format-entry-url entry :with-protocol t))
+ (h//format-entry-url entry :with-protocol t))
-(cl-defun hyperdrive-entry-create (&key hyperdrive path version etc)
+(cl-defun he/create (&key hyperdrive path version etc)
"Return hyperdrive entry struct from args.
HYPERDRIVE, VERSION, and ETC are used as-is. Entry NAME is
generated from PATH."
- (setf path (hyperdrive--format-path path))
- (hyperdrive-entry--create
+ (setf path (h//format-path path))
+ (he//create
:hyperdrive hyperdrive
:path path
;; TODO: Is it necessary to store the name alongside the path?
@@ -135,12 +131,12 @@ generated from PATH."
:version version
:etc etc))
-(cl-defun hyperdrive-sort-entries (entries &key (direction
hyperdrive-directory-sort))
+(cl-defun h/sort-entries (entries &key (direction h/directory-sort))
"Return ENTRIES sorted by DIRECTION.
See `hyperdrive-directory-sort' for the type of DIRECTION."
(pcase-let* ((`(,column . ,direction) direction)
((map (:accessor accessor) (direction sort-function))
- (alist-get column hyperdrive-dir-sort-fields)))
+ (alist-get column h/dir-sort-fields)))
(cl-sort entries (lambda (a b)
(cond ((and a b) (funcall sort-function a b))
;; When an entry lacks appropriate metadata
@@ -152,7 +148,7 @@ See `hyperdrive-directory-sort' for the type of DIRECTION."
;; These functions take a URL argument, not a hyperdrive-entry struct.
-(cl-defun hyperdrive-api (method url &rest rest)
+(cl-defun h/api (method url &rest rest)
"Make hyperdrive API request by METHOD to URL.
Calls `hyperdrive--httpify-url' to convert HYPER-URL starting
with `hyperdrive--hyper-prefix' to a URL starting with
@@ -164,12 +160,12 @@ REST is passed to `plz', which see.
REST may include the argument `:queue', a `plz-queue' in which to
make the request."
;; TODO: Document that the request/queue is returned.
- ;; TODO: Should we create a wrapper for `hyperdrive-api' which calls
- ;; `hyperdrive--fill-latest-version' for requests to
+ ;; TODO: Should we create a wrapper for `h/api' which calls
+ ;; `h//fill-latest-version' for requests to
;; directories/requests which modify the drive (and therefore
;; always return the latest version number). If we did this, we
;; could remove redundant calls to
- ;; `hyperdrive--fill-latest-version' everywhere else.
+ ;; `h//fill-latest-version' everywhere else.
(declare (indent defun))
(pcase method
((and (or 'get 'head)
@@ -185,7 +181,7 @@ make the request."
(_ (plist-get rest :else))))
;; We wrap the provided ELSE in our own lambda that
;; checks for common errors.
- (else* (apply-partially #'hyperdrive-api-default-else else)))
+ (else* (apply-partially #'h/api-default-else else)))
(plist-put rest :else else*)
(condition-case err
;; The `condition-case' is only intended for synchronous
@@ -195,13 +191,13 @@ make the request."
(setf rest (map-delete rest :queue)))))
(plz-run
(apply #'plz-queue
- queue method (hyperdrive--httpify-url url) rest))
- (apply #'plz method (hyperdrive--httpify-url url) rest))
+ queue method (h//httpify-url url) rest))
+ (apply #'plz method (h//httpify-url url) rest))
(plz-error
;; We pass only the `plz-error' struct to the ELSE* function.
(funcall else* (caddr err))))))
-(defun hyperdrive-api-default-else (else plz-err)
+(defun h/api-default-else (else plz-err)
"Handle common errors, overriding ELSE.
Checks for common errors; if none are found, calls ELSE with
PLZ-ERR, if ELSE is non-nil; otherwise re-signals PLZ-ERR.
@@ -209,11 +205,10 @@ PLZ-ERR should be a `plz-error' struct."
(pcase plz-err
((app plz-error-curl-error `(7 . ,_message))
;; Curl error 7 is "Failed to connect to host."
- (hyperdrive-user-error (substitute-command-keys
- "Gateway not running. Use \\[hyperdrive-start]
to start it")))
+ (h/user-error "Gateway not running. Use \\[hyperdrive-start] to start
it"))
((app plz-error-response (cl-struct plz-response (status (or 403 405))
body))
;; 403 Forbidden or 405 Method Not Allowed: Display message from
hyper-gateway.
- (hyperdrive-error "%s" body))
+ (h/error "%s" body))
((guard else)
(funcall else plz-err))
(_
@@ -224,34 +219,34 @@ PLZ-ERR should be a `plz-error' struct."
"Return non-nil if `hyper-gateway' is running and accessible."
;; FIXME: Ensure a very short timeout for this request.
(condition-case nil
- (plz 'get (concat "http://localhost:"; (number-to-string
hyperdrive-hyper-gateway-port) "/"))
+ (plz 'get (concat "http://localhost:"; (number-to-string
h/hyper-gateway-port) "/"))
(error nil)))
-(defun hyperdrive--httpify-url (url)
+(defun h//httpify-url (url)
"Return localhost HTTP URL for HYPER-URL."
- (concat "http://localhost:"; (number-to-string hyperdrive-hyper-gateway-port)
"/hyper/"
- (substring url (length hyperdrive--hyper-prefix))))
+ (concat "http://localhost:"; (number-to-string h/hyper-gateway-port) "/hyper/"
+ (substring url (length h//hyper-prefix))))
-(cl-defun hyperdrive--write (url &key body then else queue)
+(cl-defun h//write (url &key body then else queue)
"Save BODY (a string) to hyperdrive URL.
THEN and ELSE are passed to `hyperdrive-api', which see."
(declare (indent defun))
- (hyperdrive-api 'put url
+ (h/api 'put url
;; TODO: Investigate whether we should use 'text body type for text
buffers.
:body-type 'binary
- ;; TODO: plz accepts buffer as a body, we should refactor calls to
hyperdrive--write to pass in a buffer instead of a buffer-string.
+ ;; TODO: plz accepts buffer as a body, we should refactor calls to
h//write to pass in a buffer instead of a buffer-string.
:body body :as 'response :then then :else else :queue queue))
-(defun hyperdrive-parent (entry)
+(defun h/parent (entry)
"Return parent entry for ENTRY.
If already at top-level directory, return nil."
(pcase-let (((cl-struct hyperdrive-entry hyperdrive path version) entry))
(when-let ((parent-path (file-name-parent-directory path)))
- (hyperdrive-entry-create :hyperdrive hyperdrive :path parent-path
:version version))))
+ (he/create :hyperdrive hyperdrive :path parent-path :version version))))
;; For Emacsen <29.1.
(declare-function textsec-suspicious-p "ext:textsec-check")
-(defun hyperdrive-url-entry (url)
+(defun h/url-entry (url)
"Return entry for URL.
Set entry's hyperdrive slot to persisted hyperdrive if it exists.
@@ -264,9 +259,9 @@ before making the entry struct."
(setf url (concat "hyper://" url)))
(pcase-let* (((cl-struct url host (filename path) target)
(url-generic-parse-url url))
- ;; TODO: For now, no other function besides
`hyperdrive-url-entry' calls
- ;; `hyperdrive-create', but perhaps it would be good to add a
function which wraps
- ;; `hyperdrive-create' and returns either an existing
hyperdrive or a new one?
+ ;; TODO: For now, no other function besides `h/url-entry' calls
+ ;; `h/create', but perhaps it would be good to add a function
which wraps
+ ;; `h/create' and returns either an existing hyperdrive or a
new one?
(hyperdrive (pcase host
;; FIXME: Duplicate hyperdrive (one has domain
and nothing else)
((rx ".") ; Assume host is a DNSLink domain. See
code for <https://github.com/RangerMauve/hyper-sdk#sdkget>.
@@ -277,10 +272,10 @@ before making the entry struct."
(unless (y-or-n-p
(format "Suspicious domain: %s;
continue anyway?" host))
(user-error "Suspicious domain %s" host)))
- (hyperdrive-create :domains (list host)))
+ (h/create :domains (list host)))
(_ ;; Assume host is a public-key
- (or (gethash host hyperdrive-hyperdrives)
- (hyperdrive-create :public-key host)))))
+ (or (gethash host h/hyperdrives)
+ (h/create :public-key host)))))
(etc (when target
`((target . ,(substring (url-unhex-string target)
(length "::"))))))
(version (pcase path
@@ -289,59 +284,60 @@ before making the entry struct."
(string-to-number v)))))
;; e.g. for hyper://PUBLIC-KEY/path/to/basename, we do:
;; :path "/path/to/basename" :name "basename"
- (hyperdrive-entry-create :hyperdrive hyperdrive :path (url-unhex-string
path)
- :version version :etc etc)))
+ (he/create :hyperdrive hyperdrive :path (url-unhex-string path)
+ :version version :etc etc)))
;;;; Entries
;; These functions take a hyperdrive-entry struct argument, not a URL.
-(defun hyperdrive-entry-latest (entry)
+(defun he/latest (entry)
"Return ENTRY at its hyperdrive's latest version, or nil."
- (hyperdrive-entry-at nil entry))
+ (he/at nil entry))
-(defun hyperdrive--entry-version-range-key (entry)
+(defun h//entry-version-range-key (entry)
"Return URI-encoded URL for ENTRY without protocol, version, target, or face.
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)))
+ (version-less (he/create :hyperdrive hyperdrive :path path)))
+ (substring-no-properties
+ (h//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)
+(defun he/version-ranges (entry)
"Return version ranges for ENTRY."
- (gethash (hyperdrive--entry-version-range-key entry)
hyperdrive-version-ranges))
+ (gethash (h//entry-version-range-key entry) h/version-ranges))
-(gv-define-setter hyperdrive-entry-version-ranges (ranges entry)
+(gv-define-setter he/version-ranges (ranges entry)
`(progn
- (setf (gethash (hyperdrive--entry-version-range-key ,entry)
hyperdrive-version-ranges) ,ranges)
- (persist-save 'hyperdrive-version-ranges)))
+ (setf (gethash (h//entry-version-range-key ,entry) h/version-ranges)
,ranges)
+ (persist-save 'h/version-ranges)))
-(defun hyperdrive-purge-version-ranges (hyperdrive)
+(defun h/purge-version-ranges (hyperdrive)
"Purge all version range data for HYPERDRIVE."
(maphash (lambda (key _val)
;; NOTE: The KEY starts with the key and ends with a path, so we
compare as prefix.
- (when (string-prefix-p (hyperdrive-public-key hyperdrive) key)
- (remhash key hyperdrive-version-ranges)))
- hyperdrive-version-ranges)
- (persist-save 'hyperdrive-version-ranges))
+ (when (string-prefix-p (h/public-key hyperdrive) key)
+ (remhash key h/version-ranges)))
+ h/version-ranges)
+ (persist-save 'h/version-ranges))
-(cl-defun hyperdrive-entry-version-range (entry &key version)
+(cl-defun he/version-range (entry &key version)
"Return the version range containing ENTRY.
Returns nil when ENTRY is not known to exist at its version.
With non-nil VERSION, use it instead of ENTRY's version."
(declare (indent defun))
(pcase-let* (((cl-struct hyperdrive-entry hyperdrive (version
entry-version)) entry)
- (version (or version entry-version (hyperdrive-latest-version
hyperdrive)))
- (ranges (hyperdrive-entry-version-ranges entry)))
+ (version (or version entry-version (h/latest-version
hyperdrive)))
+ (ranges (he/version-ranges entry)))
(when ranges
(cl-find-if (pcase-lambda (`(,range-start . ,(map (:range-end
range-end))))
(<= range-start version range-end))
ranges))))
-(cl-defun hyperdrive-entry-exists-p (entry &key version)
+(cl-defun he/exists-p (entry &key version)
"Return status of ENTRY's existence at its version.
- t :: ENTRY is known to exist.
@@ -351,12 +347,12 @@ With non-nil VERSION, use it instead of ENTRY's version."
Does not make a request to the gateway; checks the cached value
in `hyperdrive-version-ranges'.
With non-nil VERSION, use it instead of ENTRY's version."
- (if-let ((range (hyperdrive-entry-version-range entry :version version)))
+ (if-let ((range (he/version-range entry :version version)))
(pcase-let ((`(,_range-start . ,(map (:existsp existsp))) range))
existsp)
'unknown))
-(defun hyperdrive-entry-version-ranges-no-gaps (entry)
+(defun he/version-ranges-no-gaps (entry)
"Return ranges alist for ENTRY with no gaps in history.
Returned newly-constructed alist where each range-end is always
1- the following range-start. Each gap is filled with a cons cell
@@ -369,8 +365,8 @@ When the final range's range-end is less than ENTRY's
hyperdrive's latest-version slot, the final gap is filled."
(let ((ranges '())
(previous-range-end 0))
- (pcase-dolist (`(,range-start . ,(map (:range-end range-end) (:existsp
existsp))) (hyperdrive-entry-version-ranges entry))
- ;; If hyperdrive-entry-version-ranges returns nil, this whole loop will
be skipped.
+ (pcase-dolist (`(,range-start . ,(map (:range-end range-end) (:existsp
existsp))) (he/version-ranges entry))
+ ;; If he/version-ranges returns nil, this whole loop will be skipped.
(let ((next-range-start (1+ previous-range-end)))
(when (> range-start next-range-start)
;; Insert an "unknown" gap range
@@ -379,7 +375,7 @@ hyperdrive's latest-version slot, the final gap is filled."
(setf previous-range-end range-end)))
(pcase-let* ((final-known-range (car ranges))
(`(,_range-start . ,(map (:range-end final-known-range-end)))
final-known-range)
- (latest-version (hyperdrive-latest-version
(hyperdrive-entry-hyperdrive entry))))
+ (latest-version (h/latest-version (he/hyperdrive entry))))
(unless final-known-range-end
(setf final-known-range-end 0))
(when (< final-known-range-end latest-version)
@@ -387,53 +383,53 @@ hyperdrive's latest-version slot, the final gap is
filled."
(push `(,(1+ final-known-range-end) . (:range-end ,latest-version ,
:existsp unknown)) ranges)))
(nreverse ranges)))
-(cl-defun hyperdrive-entry-previous (entry &key cache-only)
+(cl-defun he/previous (entry &key cache-only)
"Return ENTRY at its hyperdrive's previous version, or nil.
If ENTRY is a directory, return a copy with decremented version.
If CACHE-ONLY, don't send a request to the gateway; only check
`hyperdrive-version-ranges'. In this case, return value may also
be \\+`unknown'."
- (if (hyperdrive--entry-directory-p entry)
+ (if (h//entry-directory-p entry)
(pcase-let* (((cl-struct hyperdrive-entry hyperdrive path version) entry)
- (version (or version (hyperdrive-latest-version
hyperdrive))))
+ (version (or version (h/latest-version hyperdrive))))
(when (> version 1)
- (hyperdrive-entry-create :hyperdrive hyperdrive :path path :version
(1- version))))
- (let ((previous-version (1- (car (hyperdrive-entry-version-range entry)))))
- (pcase-exhaustive (hyperdrive-entry-version-range entry :version
previous-version)
+ (he/create :hyperdrive hyperdrive :path path :version (1- version))))
+ (let ((previous-version (1- (car (he/version-range entry)))))
+ (pcase-exhaustive (he/version-range entry :version previous-version)
(`(,range-start . ,(map (:existsp existsp)))
(if existsp
;; Return entry if it's known existent.
- (hyperdrive-entry-at range-start entry)
+ (he/at range-start entry)
;; Return nil if it's known nonexistent.
nil))
('nil
;; Entry is not known to exist, optionally send a request.
(if cache-only
'unknown
- (when-let ((previous-entry (hyperdrive-entry-at previous-version
entry)))
+ (when-let ((previous-entry (he/at previous-version entry)))
;; Entry version is currently its range end, but it should be its
version range start.
- (setf (hyperdrive-entry-version previous-entry) (car
(hyperdrive-entry-version-range previous-entry)))
+ (setf (he/version previous-entry) (car (he/version-range
previous-entry)))
previous-entry)))))))
-(defun hyperdrive-entry-at (version entry)
+(defun he/at (version entry)
"Return ENTRY at its hyperdrive's VERSION, or nil if not found.
When VERSION is nil, return latest version of ENTRY."
- ;; Use `hyperdrive-copy-tree', because `copy-tree' doesn't work on
+ ;; Use `h/copy-tree', because `copy-tree' doesn't work on
;; records/structs, and `copy-hyperdrive-entry' doesn't copy deeply,
;; and we need to be able to modify the `etc' alist of the copied
;; entry separately.
- (let ((entry (hyperdrive-copy-tree entry t)))
- (setf (hyperdrive-entry-version entry) version)
+ (let ((entry (h/copy-tree entry t)))
+ (setf (he/version entry) version)
(condition-case err
;; FIXME: Requests to out of range version currently hang.
- (hyperdrive-fill entry :then 'sync)
+ (h/fill entry :then 'sync)
(plz-error
(pcase (plz-response-status (plz-error-response (caddr err)))
;; FIXME: If plz-error is a curl-error, this block will fail.
(404 nil)
(_ (signal (car err) (cdr err))))))))
-(cl-defun hyperdrive-entry-next (entry)
+(cl-defun he/next (entry)
"Return unfilled ENTRY at its hyperdrive's next version.
If next version is known nonexistent, return nil.
@@ -441,46 +437,46 @@ If next version's existence is unknown, return
\\+`unknown'.
If ENTRY's version is nil, return value is `eq' to ENTRY.
Sends a request to the gateway for hyperdrive's latest version."
- (unless (hyperdrive-entry-version entry)
+ (unless (he/version entry)
;; ENTRY's version is nil: return ENTRY.
- (cl-return-from hyperdrive-entry-next entry))
+ (cl-return-from he/next entry))
;; ENTRY's version is not nil.
- (let ((next-entry (hyperdrive-copy-tree entry t))
- (latest-version (hyperdrive-fill-latest-version
- (hyperdrive-entry-hyperdrive entry))))
+ (let ((next-entry (h/copy-tree entry t))
+ (latest-version (h/fill-latest-version
+ (he/hyperdrive entry))))
;; ENTRY version is the latest version: return ENTRY with nil version.
- (when (eq latest-version (hyperdrive-entry-version entry))
- (setf (hyperdrive-entry-version next-entry) nil)
- (cl-return-from hyperdrive-entry-next next-entry))
+ (when (eq latest-version (he/version entry))
+ (setf (he/version next-entry) nil)
+ (cl-return-from he/next next-entry))
;; 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))
+ (when (h//entry-directory-p entry)
+ (cl-incf (he/version next-entry))
+ (when (eq latest-version (he/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))
+ (setf (he/version next-entry) nil))
+ (cl-return-from he/next next-entry))
;; ENTRY is a file...
- (pcase-let* ((`(,_range-start . ,(map (:range-end range-end)))
(hyperdrive-entry-version-range entry))
+ (pcase-let* ((`(,_range-start . ,(map (:range-end range-end)))
(he/version-range entry))
(next-range-start (1+ range-end))
((map (:existsp next-range-existsp) (:range-end
next-range-end))
;; TODO: If cl struct copiers are extended like this:
;;
https://lists.gnu.org/archive/html/help-gnu-emacs/2021-10/msg00797.html
;; replace following sexp with
- ;; (hyperdrive-entry-version-range
(hyperdrive-entry-copy :version next-range-start))
- (map-elt (hyperdrive-entry-version-ranges-no-gaps entry)
next-range-start)))
+ ;; (he/version-range (hyperdrive-entry-copy :version
next-range-start))
+ (map-elt (he/version-ranges-no-gaps entry)
next-range-start)))
;; ENTRY is in the last version range: return ENTRY with nil version.
(when (eq latest-version range-end)
- (setf (hyperdrive-entry-version next-entry) nil)
- (cl-return-from hyperdrive-entry-next next-entry))
+ (setf (he/version next-entry) nil)
+ (cl-return-from he/next next-entry))
;; Check existence of ENTRY's next version range...
(pcase-exhaustive next-range-existsp
('t
- (setf (hyperdrive-entry-version next-entry)
+ (setf (he/version next-entry)
(if (eq next-range-end latest-version)
;; This is the latest version: remove version number.
nil
@@ -489,8 +485,8 @@ Sends a request to the gateway for hyperdrive's latest
version."
('nil nil)
('unknown 'unknown)))))
-(declare-function hyperdrive-history "hyperdrive-history")
-(cl-defun hyperdrive-open
+(declare-function h/history "hyperdrive-history")
+(cl-defun h/open
(entry &key recurse (createp t) (messagep t)
(then (lambda ()
(pop-to-buffer (current-buffer)
'((display-buffer-reuse-window display-buffer-same-window))))))
@@ -505,28 +501,28 @@ echo area when the request for the file is made."
;; TODO: Add `find-file'-like interface. See
<https://todo.sr.ht/~ushin/ushin/16>
;; FIXME: Some of the synchronous filling functions we've added now cause
this to be blocking,
;; which is very noticeable when a file can't be loaded from the gateway and
eventually times out.
- (let ((hyperdrive (hyperdrive-entry-hyperdrive entry)))
- (hyperdrive-fill entry
+ (let ((hyperdrive (he/hyperdrive entry)))
+ (h/fill entry
:then (lambda (entry)
(pcase-let* (((cl-struct hyperdrive-entry type) entry)
- (handler (alist-get type hyperdrive-type-handlers
nil nil #'string-match-p)))
- (unless (hyperdrive--entry-directory-p entry)
+ (handler (alist-get type h/type-handlers nil nil
#'string-match-p)))
+ (unless (h//entry-directory-p entry)
;; No need to fill latest version for directories,
- ;; since we do it in `hyperdrive--fill' already.
- (hyperdrive-fill-latest-version hyperdrive))
- (hyperdrive-persist hyperdrive)
- (funcall (or handler #'hyperdrive-handler-default) entry :then
then)))
+ ;; since we do it in `h//fill' already.
+ (h/fill-latest-version hyperdrive))
+ (h/persist hyperdrive)
+ (funcall (or handler #'h/handler-default) entry :then then)))
:else (lambda (err)
(cl-labels ((not-found-action
() (if recurse
- (hyperdrive-open (hyperdrive-parent entry)
:recurse t)
+ (h/open (h/parent entry) :recurse t)
(pcase (prompt)
- ('history (hyperdrive-history entry))
- ('up (hyperdrive-open (hyperdrive-parent
entry)))
- ('recurse (hyperdrive-open
(hyperdrive-parent entry) :recurse t)))))
+ ('history (h/history entry))
+ ('up (h/open (h/parent entry)))
+ ('recurse (h/open (h/parent entry) :recurse
t)))))
(prompt
() (pcase-exhaustive
- (read-answer (format "URL not found:
\"%s\". " (hyperdrive-entry-url entry))
+ (read-answer (format "URL not found:
\"%s\". " (he/url entry))
'(("history" ?h "open version
history")
("up" ?u "open parent
directory")
("recurse" ?r "go up until a
directory is found")
@@ -539,37 +535,40 @@ echo area when the request for the file is made."
;; FIXME: If plz-error is a curl-error, this block will fail.
(404 ;; Path not found.
(cond
- ((equal (hyperdrive-entry-path entry) "/")
+ ((equal (he/path entry) "/")
;; Root directory not found: Drive has not been
;; loaded locally, and no peers are found seeding it.
- (hyperdrive-message "No peers found for %s"
(hyperdrive-entry-url entry)))
+ (h/message "No peers found for %s" (he/url entry)))
((and createp
- (not (hyperdrive--entry-directory-p entry))
- (hyperdrive-writablep hyperdrive)
- (not (hyperdrive-entry-version entry)))
+ (not (h//entry-directory-p entry))
+ (h/writablep hyperdrive)
+ (not (he/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
+ (h//format-entry entry h/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)))
+ (h/message "Entry no longer exists! %s"
+ (h//format-entry entry)))
;; Make and switch to new buffer.
- (switch-to-buffer (hyperdrive--get-buffer-create
entry))))
+ (switch-to-buffer (h//get-buffer-create entry))))
(t
;; Hyperdrive entry is not writable: prompt for action.
(not-found-action))))
(500 ;; Generic error, likely a mistyped URL
- (hyperdrive-message "Generic hyper-gateway status 500
error. Is this URL correct? %s"
- (hyperdrive-entry-url entry)))
- (_ (hyperdrive-message "Unable to load URL \"%s\": %S"
- (hyperdrive-entry-url entry) err))))))
+ (h/message "Generic hyper-gateway status 500 error. Is this
URL correct? %s"
+ (he/url entry)))
+ (_ (h/message "Unable to load URL \"%s\": %S"
+ (he/url entry) err))))))
(when messagep
- (hyperdrive-message "Opening <%s>..." (hyperdrive-entry-url entry)))))
+ (h/message "Opening <%s>..." (he/url entry)))))
-(cl-defun hyperdrive-fill (entry &key queue then else)
+(cl-defun h/fill (entry &key queue then else)
"Fill ENTRY's metadata and call THEN.
If THEN is `sync', return the filled entry and ignore ELSE.
Otherwise, make request asynchronously and call THEN with the
@@ -589,37 +588,37 @@ the given `plz-queue'"
;; (e.g. if the user reverted too quickly).
nil)
(_
- (hyperdrive-message
+ (h/message
(format "hyperdrive-fill: error: %S" plz-error)))))))
(pcase then
('sync (condition-case err
- (hyperdrive--fill entry
- (plz-response-headers
- (hyperdrive-api 'head (hyperdrive-entry-url
entry)
- :as 'response
- :then 'sync
- :noquery t)))
+ (h//fill entry
+ (plz-response-headers
+ (h/api 'head (he/url entry)
+ :as 'response
+ :then 'sync
+ :noquery t)))
(plz-error
(pcase (plz-response-status (plz-error-response (caddr err)))
;; FIXME: If plz-error is a curl-error, this block will fail.
(404 ;; Entry doesn't exist at this version: update range data.
- (hyperdrive-update-nonexistent-version-range entry)))
- ;; Re-signal error for, e.g. `hyperdrive-entry-at'.
+ (h/update-nonexistent-version-range entry)))
+ ;; Re-signal error for, e.g. `he/at'.
(signal (car err) (cdr err)))))
- (_ (hyperdrive-api 'head (hyperdrive-entry-url entry)
+ (_ (h/api 'head (he/url entry)
:queue queue
:as 'response
:then (lambda (response)
- (funcall then (hyperdrive--fill entry (plz-response-headers
response))))
+ (funcall then (h//fill entry (plz-response-headers
response))))
:else (lambda (&rest args)
- (when (hyperdrive-entry-version entry)
+ (when (he/version entry)
;; If request is canceled, the entry may not have a version.
;; FIXME: Only update nonexistent range on 404.
- (hyperdrive-update-nonexistent-version-range entry))
+ (h/update-nonexistent-version-range entry))
(apply else args))
:noquery t))))
-(defun hyperdrive--fill (entry headers)
+(defun h//fill (entry headers)
"Fill ENTRY and its hyperdrive from HEADERS.
The following ENTRY slots are filled:
@@ -639,57 +638,57 @@ Returns filled ENTRY."
((map link content-length content-type etag last-modified
allow) headers)
;; If URL hostname was a DNSLink domain, entry doesn't yet have
a public-key slot.
(public-key (progn
- (string-match hyperdrive--public-key-re link)
+ (string-match h//public-key-re link)
(match-string 1 link)))
- (persisted-hyperdrive (gethash public-key
hyperdrive-hyperdrives))
+ (persisted-hyperdrive (gethash public-key h/hyperdrives))
(domain (car domains)))
(when last-modified
(setf last-modified (encode-time (parse-time-string last-modified))))
(when (and allow (eq 'unknown writablep))
- (setf (hyperdrive-writablep hyperdrive) (string-match-p "PUT" allow)))
- (setf (hyperdrive-entry-size entry) (when content-length
- (ignore-errors
- (cl-parse-integer content-length)))
- (hyperdrive-entry-type entry) content-type
- (hyperdrive-entry-mtime entry) last-modified)
+ (setf (h/writablep hyperdrive) (string-match-p "PUT" allow)))
+ (setf (he/size entry) (when content-length
+ (ignore-errors
+ (cl-parse-integer content-length)))
+ (he/type entry) content-type
+ (he/mtime entry) last-modified)
(if persisted-hyperdrive
(progn
;; Ensure that entry's hyperdrive is the persisted
;; hyperdrive, since it may be used later as part of a
- ;; `hyperdrive-version-ranges' key and compared using `eq'.
- ;; Also, we want the call to `hyperdrive--fill-latest-version'
+ ;; `h/version-ranges' key and compared using `eq'.
+ ;; Also, we want the call to `h//fill-latest-version'
;; below to update the persisted hyperdrive.
- (setf (hyperdrive-entry-hyperdrive entry) persisted-hyperdrive)
+ (setf (he/hyperdrive entry) persisted-hyperdrive)
(when domain
- ;; The previous call to hyperdrive-entry-url may not have retrieved
+ ;; The previous call to he/url may not have retrieved
;; the persisted hyperdrive if we had only a domain but no
public-key.
- (cl-pushnew domain (hyperdrive-domains
(hyperdrive-entry-hyperdrive entry)) :test #'equal)))
- (setf (hyperdrive-public-key hyperdrive) public-key))
- (if (and (hyperdrive--entry-directory-p entry)
- (null (hyperdrive-entry-version entry)))
+ (cl-pushnew domain (h/domains (he/hyperdrive entry)) :test
#'equal)))
+ (setf (h/public-key hyperdrive) public-key))
+ (if (and (h//entry-directory-p entry)
+ (null (he/version entry)))
;; Version-less directory HEAD/GET request ETag header always have the
;; hyperdrive's latest version. We don't currently store
;; version ranges for directories (since they don't
;; technically have versions in hyperdrive).
- (hyperdrive--fill-latest-version hyperdrive headers)
+ (h//fill-latest-version hyperdrive headers)
;; File HEAD/GET request ETag header does not retrieve the
- ;; hyperdrive's latest version, so
`hyperdrive-update-existent-version-range'
+ ;; hyperdrive's latest version, so `h/update-existent-version-range'
;; will not necessarily fill in the entry's last range.
- (hyperdrive-update-existent-version-range entry (string-to-number etag)))
+ (h/update-existent-version-range entry (string-to-number etag)))
entry))
-(defun hyperdrive-fill-latest-version (hyperdrive)
+(defun h/fill-latest-version (hyperdrive)
"Synchronously fill the latest version slot in HYPERDRIVE.
Returns the latest version number."
(pcase-let (((cl-struct plz-response headers)
- (hyperdrive-api
- 'head (hyperdrive-entry-url
- (hyperdrive-entry-create
+ (h/api
+ 'head (he/url
+ (he/create
:hyperdrive hyperdrive :path "/"))
:as 'response)))
- (hyperdrive--fill-latest-version hyperdrive headers)))
+ (h//fill-latest-version hyperdrive headers)))
-(defun hyperdrive--fill-latest-version (hyperdrive headers)
+(defun h//fill-latest-version (hyperdrive headers)
"Fill the latest version slot in HYPERDRIVE from HEADERS.
HEADERS must from a HEAD/GET request to a directory or a
PUT/DELETE request to a file, as only those requests return the
@@ -698,13 +697,13 @@ correct ETag header. Returns the latest version number."
;; updates, at the least describe-hyperdrive buffers.
;; TODO: Consider updating version range here. First check all the
;; places where this function is called. Better yet, update
- ;; `hyperdrive-version-ranges' (and `hyperdrive-hyperdrives'?) in a
- ;; lower-level function, perhaps a wrapper for `hyperdrive-api'?
- (setf (hyperdrive-latest-version hyperdrive) (string-to-number (map-elt
headers 'etag))))
+ ;; `h/version-ranges' (and `h/hyperdrives'?) in a
+ ;; lower-level function, perhaps a wrapper for `h/api'?
+ (setf (h/latest-version hyperdrive) (string-to-number (map-elt headers
'etag))))
;; TODO: Consider using symbol-macrolet to simplify place access.
-(defun hyperdrive-update-existent-version-range (entry range-start)
+(defun h/update-existent-version-range (entry range-start)
"Update the version range for ENTRY which exists at its version.
Sets the range keyed by RANGE-START to a plist whose :range-end
value is ENTRY's version.
@@ -713,21 +712,21 @@ For the format of each version range, see
`hyperdrive-version-ranges'.
Returns the ranges cons cell for ENTRY."
(cl-check-type range-start integer)
- (unless (hyperdrive--entry-directory-p entry)
- (pcase-let* ((ranges (hyperdrive-entry-version-ranges entry))
+ (unless (h//entry-directory-p entry)
+ (pcase-let* ((ranges (he/version-ranges entry))
(range (map-elt ranges range-start))
((map (:range-end old-range-end)) range)
((cl-struct hyperdrive-entry hyperdrive version) entry)
- (range-end (or version (hyperdrive-latest-version
hyperdrive))))
+ (range-end (or version (h/latest-version hyperdrive))))
(unless (and old-range-end (> old-range-end range-end))
;; If there already exists a longer existent range in
- ;; `hyperdrive-version-ranges', there's nothing to do.
+ ;; `h/version-ranges', there's nothing to do.
(setf (plist-get range :existsp) t
(plist-get range :range-end) range-end
(map-elt ranges range-start) range
- (hyperdrive-entry-version-ranges entry) (cl-sort ranges #'< :key
#'car))))))
+ (he/version-ranges entry) (cl-sort ranges #'< :key #'car))))))
-(defun hyperdrive-update-nonexistent-version-range (entry)
+(defun h/update-nonexistent-version-range (entry)
"Update the version range for ENTRY which doesn't exist at its version.
Checks for nonexistent previous or next ranges, to combine them
into one contiguous nonexistent range.
@@ -735,20 +734,20 @@ into one contiguous nonexistent range.
For the format of each version range, see `hyperdrive-version-ranges'.
Returns the ranges cons cell for ENTRY."
- (unless (or (hyperdrive--entry-directory-p entry)
+ (unless (or (h//entry-directory-p entry)
;; If there already exists a nonexistent range in
- ;; `hyperdrive-version-ranges', there's nothing to do.
- (hyperdrive-entry-version-range entry)
+ ;; `h/version-ranges', there's nothing to do.
+ (he/version-range entry)
;; Don't store ranges for entries which have never existed.
- (not (hyperdrive-entry-version-ranges entry)))
- (pcase-let* ((ranges (hyperdrive-entry-version-ranges entry))
+ (not (he/version-ranges entry)))
+ (pcase-let* ((ranges (he/version-ranges entry))
((cl-struct hyperdrive-entry hyperdrive path version) entry)
- (version (or version (hyperdrive-latest-version hyperdrive)))
- (previous-range (hyperdrive-entry-version-range
- (hyperdrive-entry-create :hyperdrive
hyperdrive :path path :version (1- version))))
+ (version (or version (h/latest-version hyperdrive)))
+ (previous-range (he/version-range
+ (he/create :hyperdrive hyperdrive :path
path :version (1- version))))
(`(,previous-range-start . ,(map (:existsp
previous-exists-p))) previous-range)
- (next-range (hyperdrive-entry-version-range
- (hyperdrive-entry-create :hyperdrive hyperdrive
:path path :version (1+ version))))
+ (next-range (he/version-range
+ (he/create :hyperdrive hyperdrive :path path
:version (1+ version))))
(`(,next-range-start . ,(map (:existsp next-exists-p)
(:range-end next-range-end))) next-range)
(range-start (if (and previous-range (null previous-exists-p))
;; Extend previous nonexistent range
@@ -762,59 +761,59 @@ Returns the ranges cons cell for ENTRY."
(when (and next-range (null next-exists-p))
(setf ranges (map-delete ranges next-range-start)))
(setf (map-elt ranges range-start) `(:existsp nil :range-end ,range-end)
- (hyperdrive-entry-version-ranges entry) (cl-sort ranges #'< :key
#'car)))))
+ (he/version-ranges entry) (cl-sort ranges #'< :key #'car)))))
-(cl-defun hyperdrive-fill-version-ranges (entry &key (finally #'ignore))
+(cl-defun h/fill-version-ranges (entry &key (finally #'ignore))
"Asynchronously fill in versions ranges before ENTRY.
Once all requests return, call FINALLY with no arguments."
(declare (indent defun))
(let* ((outstanding-nonexistent-requests-p)
- (total-requests-limit hyperdrive-fill-version-ranges-limit)
- (fill-entry-queue (make-plz-queue :limit hyperdrive-queue-limit
+ (total-requests-limit h/fill-version-ranges-limit)
+ (fill-entry-queue (make-plz-queue :limit h/queue-limit
:finally (lambda ()
(unless
outstanding-nonexistent-requests-p
(funcall finally)))))
;; Flag used in the nonexistent-queue finalizer.
finishedp)
(cl-labels ((fill-existent-at (version)
- (let ((prev-range-end (1- (car
(hyperdrive-entry-version-range entry :version version)))))
+ (let ((prev-range-end (1- (car (he/version-range entry
:version version)))))
(if (and (cl-plusp total-requests-limit)
- (eq 'unknown (hyperdrive-entry-exists-p entry
:version prev-range-end)))
+ (eq 'unknown (he/exists-p entry :version
prev-range-end)))
;; Recurse backward through history.
(fill-entry-at prev-range-end)
(setf finishedp t))))
(fill-nonexistent-at (version)
(let ((nonexistent-queue
(make-plz-queue
- :limit hyperdrive-queue-limit
+ :limit h/queue-limit
:finally (lambda ()
(setf outstanding-nonexistent-requests-p
nil)
(if finishedp
;; If the fill-nonexistent-at loop
stopped
;; prematurely, stop filling and call
`finally'.
(funcall finally)
- (let ((last-requested-version (-
version hyperdrive-queue-limit)))
- (cl-decf total-requests-limit
hyperdrive-queue-limit)
- (pcase-exhaustive
(hyperdrive-entry-exists-p entry :version last-requested-version)
+ (let ((last-requested-version (-
version h/queue-limit)))
+ (cl-decf total-requests-limit
h/queue-limit)
+ (pcase-exhaustive (he/exists-p entry
:version last-requested-version)
('t (fill-existent-at
last-requested-version))
('nil (fill-nonexistent-at
last-requested-version))
('unknown
- (hyperdrive-error "Entry should
have been filled at version: %s" last-requested-version))))))))
+ (h/error "Entry should have been
filled at version: %s" last-requested-version))))))))
;; Make a copy of the version ranges for use in the
HEAD request callback.
- (copy-entry-version-ranges (copy-sequence
(hyperdrive-entry-version-ranges entry))))
+ (copy-entry-version-ranges (copy-sequence
(he/version-ranges entry))))
;; For nonexistent entries, send requests in parallel.
- (cl-dotimes (i hyperdrive-queue-limit)
+ (cl-dotimes (i h/queue-limit)
;; Send the maximum number of simultaneous requests.
- (let ((prev-entry (hyperdrive-copy-tree entry t)))
- (setf (hyperdrive-entry-version prev-entry) (- version
i 1))
- (unless (and (cl-plusp (hyperdrive-entry-version
prev-entry))
- (eq 'unknown (hyperdrive-entry-exists-p
prev-entry))
+ (let ((prev-entry (h/copy-tree entry t)))
+ (setf (he/version prev-entry) (- version i 1))
+ (unless (and (cl-plusp (he/version prev-entry))
+ (eq 'unknown (he/exists-p prev-entry))
(> total-requests-limit i))
;; Stop at the beginning of the history, at a known
;; existent/nonexistent entry, or at the limit.
(setf finishedp t)
(cl-return))
- (hyperdrive-api 'head (hyperdrive-entry-url prev-entry)
+ (h/api 'head (he/url prev-entry)
:queue nonexistent-queue
:as 'response
:then (pcase-lambda ((cl-struct plz-response
(headers (map etag))))
@@ -825,27 +824,27 @@ Once all requests return, call FINALLY with no arguments."
;; range-start that was already known
;; before this batch of parallel
requests.
(setf finishedp t))
- (hyperdrive-update-existent-version-range
prev-entry range-start)))
+ (h/update-existent-version-range
prev-entry range-start)))
:else (lambda (err)
;; TODO: Better error handling.
(pcase (plz-response-status
(plz-error-response err))
;; FIXME: If plz-error is a curl-error,
this block will fail.
- (404
(hyperdrive-update-nonexistent-version-range prev-entry))
+ (404 (h/update-nonexistent-version-range
prev-entry))
(_ (signal (car err) (cdr err)))))
:noquery t)
(setf outstanding-nonexistent-requests-p t)))))
(fill-entry-at (version)
- (let ((copy-entry (hyperdrive-copy-tree entry t)))
- (setf (hyperdrive-entry-version copy-entry) version)
+ (let ((copy-entry (h/copy-tree entry t)))
+ (setf (he/version copy-entry) version)
(cl-decf total-requests-limit)
- (hyperdrive-api 'head (hyperdrive-entry-url copy-entry)
+ (h/api 'head (he/url copy-entry)
:queue fill-entry-queue
:as 'response
:then (pcase-lambda ((cl-struct plz-response (headers
(map etag))))
(pcase-let* ((range-start (string-to-number
etag))
((map (:existsp existsp))
- (map-elt
(hyperdrive-entry-version-ranges copy-entry) range-start)))
- (hyperdrive-update-existent-version-range
copy-entry range-start)
+ (map-elt (he/version-ranges
copy-entry) range-start)))
+ (h/update-existent-version-range copy-entry
range-start)
(if (eq 't existsp)
;; Stop if the requested entry has a
;; range-start that was already known
@@ -856,30 +855,30 @@ Once all requests return, call FINALLY with no arguments."
(pcase (plz-response-status (plz-error-response
err))
;; FIXME: If plz-error is a curl-error, this
block will fail.
(404
- (hyperdrive-update-nonexistent-version-range
copy-entry)
+ (h/update-nonexistent-version-range
copy-entry)
(fill-nonexistent-at version))
(_ (signal (car err) (cdr err)))))
:noquery t))))
- (fill-entry-at (hyperdrive-entry-version entry)))))
+ (fill-entry-at (he/version entry)))))
-(defun hyperdrive-fill-metadata (hyperdrive)
+(defun h/fill-metadata (hyperdrive)
"Fill HYPERDRIVE's public metadata and return it.
Sends a synchronous request to get the latest contents of
HYPERDRIVE's public metadata file."
(declare (indent defun))
- (pcase-let* ((entry (hyperdrive-entry-create
+ (pcase-let* ((entry (he/create
:hyperdrive hyperdrive
:path "/.well-known/host-meta.json"
;; NOTE: Don't attempt to fill hyperdrive struct with
old metadata
:version nil))
(metadata (condition-case err
- (hyperdrive-api 'get (hyperdrive-entry-url entry)
+ (h/api 'get (he/url entry)
:as (lambda ()
(condition-case err
(json-read)
(json-error
- (hyperdrive-message "Error parsing
JSON metadata file: %s"
-
(hyperdrive-entry-url entry)))
+ (h/message "Error parsing JSON
metadata file: %s"
+ (he/url entry)))
(_ (signal (car err) (cdr err)))))
:noquery t)
(plz-error
@@ -887,11 +886,11 @@ HYPERDRIVE's public metadata file."
;; FIXME: If plz-error is a curl-error, this
block will fail.
(404 nil)
(_ (signal (car err) (cdr err))))))))
- (setf (hyperdrive-metadata hyperdrive) metadata)
- (hyperdrive-persist hyperdrive)
+ (setf (h/metadata hyperdrive) metadata)
+ (h/persist hyperdrive)
hyperdrive))
-(cl-defun hyperdrive-purge-no-prompt (hyperdrive &key then else)
+(cl-defun h/purge-no-prompt (hyperdrive &key then else)
"Purge all data corresponding to HYPERDRIVE, then call THEN with response.
- HYPERDRIVE file content and metadata managed by hyper-gateway
@@ -900,56 +899,32 @@ HYPERDRIVE's public metadata file."
Call ELSE if request fails."
(declare (indent defun))
- (hyperdrive-api 'delete (hyperdrive-entry-url (hyperdrive-entry-create
:hyperdrive hyperdrive))
+ (h/api 'delete (he/url (he/create :hyperdrive hyperdrive))
:as 'response
:then (lambda (response)
- (hyperdrive-persist hyperdrive :purge t)
- (hyperdrive-purge-version-ranges hyperdrive)
+ (h/persist hyperdrive :purge t)
+ (h/purge-version-ranges hyperdrive)
(funcall then response))
:else else))
-(cl-defun hyperdrive-write (entry &key body then else queue)
+(cl-defun h/write (entry &key body then else queue)
"Write BODY to hyperdrive ENTRY's URL."
(declare (indent defun))
- (hyperdrive--write (hyperdrive-entry-url entry)
+ (h//write (he/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
+(cl-defun h//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 +942,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)))
+ (h//preferred-format (he/hyperdrive entry)
+ host-format h/raw-formats)))
(version-part (and version (format "/$/version/%s" version)))
((map target) etc)
(target-part (when (and with-target target)
@@ -976,92 +951,124 @@ Path and target fragment are URI-encoded."
(url-hexify-string target))))
(path (when with-path
;; TODO: Consider removing this argument if it's not
needed.
- (hyperdrive--url-hexify-string path)))
+ (h//url-hexify-string path)))
(url (concat protocol host version-part path target-part)))
(if with-help-echo
(propertize url
- 'help-echo (hyperdrive--format-entry-url
+ 'help-echo (h//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 h//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 h/formats)))
+ (cl-labels ((fmt (format value face)
+ (if value
+ (format (alist-get format 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.
+ (h//preferred-format hyperdrive)))
+ (?P . ,(fmt 'petname petname 'h/petname))
+ (?N . ,(fmt 'nickname nickname 'h/nickname))
+ (?k . ,(fmt 'short-key public-key 'h/public-key))
+ (?K . ,(fmt 'public-key public-key 'h/public-key))
+ (?S . ,(fmt 'seed seed 'h/seed))
+ (?D . ,(if (car domains)
+ (format (alist-get 'domains formats)
+ (string-join
+ (mapcar (lambda (domain)
+ (propertize domain
+ 'face
'h/domain))
+ domains)
+ ","))
+ "")))))))
+
+(defun h//preferred-format (hyperdrive &optional format 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."
+`hyperdrive-preferred-formats', which see for choices. If the
+specified FORMAT is not available, return nil.
+
+Each item in FORMAT 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 format h/preferred-formats))
+ when (pcase f
+ ((and 'petname (guard petname))
+ (h//format hyperdrive "%P" formats))
+ ((and 'nickname (guard nickname))
+ (h//format hyperdrive "%N" formats))
+ ((and 'domain (guard (car domains)))
+ (h//format hyperdrive "%D" formats))
+ ((and 'seed (guard seed))
+ (h//format hyperdrive "%S" formats))
+ ((and 'short-key (guard public-key))
+ (h//format hyperdrive "%k" formats))
+ ((and 'public-key (guard public-key))
+ (h//format hyperdrive "%K" formats)))
+ return it)))
;;;; Reading from the user
-(declare-function hyperdrive-dir--entry-at-point "hyperdrive-dir")
-(cl-defun hyperdrive--context-entry (&key latest-version)
+(declare-function h/dir--entry-at-point "hyperdrive-dir")
+(cl-defun h//context-entry (&key latest-version)
"Return the current entry in the current context.
LATEST-VERSION is passed to `hyperdrive-read-entry'.
With universal prefix argument \\[universal-argument], prompt for entry."
(pcase major-mode
((guard current-prefix-arg)
- (hyperdrive-read-entry :read-version t :latest-version latest-version))
- ('hyperdrive-dir-mode (hyperdrive-dir--entry-at-point))
- (_ (or hyperdrive-current-entry (hyperdrive-read-entry :latest-version
latest-version)))))
+ (h/read-entry :read-version t :latest-version latest-version))
+ ('h/dir-mode (h/dir--entry-at-point))
+ (_ (or h/current-entry (h/read-entry :latest-version latest-version)))))
-(cl-defun hyperdrive-complete-hyperdrive (&key predicate force-prompt)
+(cl-defun h/complete-hyperdrive (&key predicate force-prompt)
"Return hyperdrive for current entry when it matches PREDICATE.
With FORCE-PROMPT or when current hyperdrive does not match
PREDICATE, return a hyperdrive selected with completion. In this
case, when PREDICATE, only offer hyperdrives matching it."
- (when (zerop (hash-table-count hyperdrive-hyperdrives))
- (hyperdrive-user-error "No known hyperdrives. Use `hyperdrive-new' to
create a new one"))
+ (when (zerop (hash-table-count h/hyperdrives))
+ (h/user-error "No known hyperdrives. Use `hyperdrive-new' to create a new
one"))
(unless predicate
;; cl-defun default value doesn't work when nil predicate value is passed
in.
(setf predicate #'always))
;; Return current drive when appropriate.
(when-let* (((not force-prompt))
- (hyperdrive-current-entry)
- (current-hyperdrive (hyperdrive-entry-hyperdrive
hyperdrive-current-entry))
+ (h/current-entry)
+ (current-hyperdrive (he/hyperdrive h/current-entry))
((funcall predicate current-hyperdrive)))
- (cl-return-from hyperdrive-complete-hyperdrive current-hyperdrive))
+ (cl-return-from h/complete-hyperdrive current-hyperdrive))
;; Otherwise, prompt for drive.
- (let* ((current-hyperdrive (when hyperdrive-current-entry
- (hyperdrive-entry-hyperdrive
hyperdrive-current-entry)))
- (hyperdrives (cl-remove-if-not predicate (hash-table-values
hyperdrive-hyperdrives)))
- (default (when (and hyperdrive-current-entry (funcall predicate
current-hyperdrive))
- (hyperdrive--format-hyperdrive
(hyperdrive-entry-hyperdrive hyperdrive-current-entry))))
+ (let* ((current-hyperdrive (when h/current-entry
+ (he/hyperdrive h/current-entry)))
+ (hyperdrives (cl-remove-if-not predicate (hash-table-values
h/hyperdrives)))
+ (default (when (and h/current-entry (funcall predicate
current-hyperdrive))
+ (h//format-hyperdrive (he/hyperdrive h/current-entry))))
(prompt (format-prompt "Hyperdrive" default))
(candidates (mapcar (lambda (hyperdrive)
- (cons (hyperdrive--format-hyperdrive
hyperdrive) hyperdrive))
+ (cons (h//format-hyperdrive hyperdrive)
hyperdrive))
hyperdrives))
(completion-styles (cons 'substring completion-styles))
(selected
@@ -1074,20 +1081,19 @@ case, when PREDICATE, only offer hyperdrives matching
it."
action candidates string predicate)))
nil 'require-match nil nil default)))
(or (alist-get selected candidates nil nil #'equal)
- (hyperdrive-user-error "No such hyperdrive. Use `hyperdrive-new' to
create a new one"))))
+ (h/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))
+(cl-defun h//format-hyperdrive
+ (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 (h//preferred-format hyperdrive format)
concat (concat it " "))))
-(cl-defun hyperdrive-read-entry (&key hyperdrive predicate default-path
- (force-prompt-drive t) latest-version
read-version)
+(cl-defun h/read-entry (&key hyperdrive predicate default-path
+ (force-prompt-drive t) latest-version
read-version)
"Return new hyperdrive entry in HYPERDRIVE with path read from user.
With nil HYPERDRIVE, prompt for one by passing PREDICATE and
@@ -1104,105 +1110,105 @@ completion, returned entry has the same version.
Otherwise, prompt for a version number."
;; TODO: Consider removing FORCE-PROMPT-DRIVE argument.
(let* ((hyperdrive (or hyperdrive
- (hyperdrive-complete-hyperdrive :predicate predicate
- :force-prompt
force-prompt-drive)))
+ (h/complete-hyperdrive :predicate predicate
+ :force-prompt
force-prompt-drive)))
(default-version (when (and (not latest-version)
- hyperdrive-current-entry
- (hyperdrive-equal-p
- hyperdrive (hyperdrive-entry-hyperdrive
hyperdrive-current-entry)))
- (hyperdrive-entry-version
hyperdrive-current-entry)))
+ h/current-entry
+ (h/equal-p
+ hyperdrive (he/hyperdrive
h/current-entry)))
+ (he/version h/current-entry)))
(version (unless latest-version
(if read-version
- (hyperdrive-read-version :hyperdrive hyperdrive
:initial-input-number default-version)
+ (h/read-version :hyperdrive hyperdrive
:initial-input-number default-version)
default-version)))
- (default-path (hyperdrive--format-path
+ (default-path (h//format-path
(or default-path
- (and hyperdrive-current-entry
- (hyperdrive-equal-p
- hyperdrive (hyperdrive-entry-hyperdrive
hyperdrive-current-entry))
- (hyperdrive-entry-path
hyperdrive-current-entry)))))
- (path (hyperdrive-read-path :hyperdrive hyperdrive :version version
:default default-path)))
- (hyperdrive-entry-create :hyperdrive hyperdrive :path path :version
version)))
-
-(defvar hyperdrive--version-history nil
+ (and h/current-entry
+ (h/equal-p
+ hyperdrive (he/hyperdrive h/current-entry))
+ (he/path h/current-entry)))))
+ (path (h/read-path :hyperdrive hyperdrive :version version :default
default-path)))
+ (he/create :hyperdrive hyperdrive :path path :version version)))
+
+(defvar h//version-history nil
"Minibuffer history of `hyperdrive-read-version'.")
-(cl-defun hyperdrive-read-version (&key hyperdrive prompt initial-input-number)
+(cl-defun h/read-version (&key hyperdrive prompt initial-input-number)
"Return version number.
Blank input returns nil.
HYPERDRIVE is used to fill in PROMPT format %s sequence.
INITIAL-INPUT-NUMBER is converted to a string and passed to
`read-string', which see."
- (let* ((prompt (or prompt "Version number in «%s» (leave blank for latest
version)"))
+ (let* ((prompt (or prompt "Version number in `%s' (leave blank for latest
version)"))
;; Don't use read-number since it cannot return nil.
(version (read-string
- (format-prompt prompt nil (hyperdrive--format-hyperdrive
hyperdrive))
+ (format-prompt prompt nil (h//format-hyperdrive hyperdrive))
(when initial-input-number (number-to-string
initial-input-number))
- 'hyperdrive--version-history)))
+ 'h//version-history)))
(unless (string-blank-p version)
(string-to-number version))))
-(defvar hyperdrive--path-history nil
+(defvar h//path-history nil
"Minibuffer history of `hyperdrive-read-path'.")
-(cl-defun hyperdrive-read-path (&key hyperdrive version prompt default)
+(cl-defun h/read-path (&key hyperdrive version prompt default)
"Return path read from user.
HYPERDRIVE and VERSION are used to fill in the prompt's format %s
sequence. PROMPT is passed to `format-prompt', which see. DEFAULT
is passed to `read-string' as its DEFAULT-VALUE argument."
(let ((prompt (or prompt
(if version
- "Path in «%s» (version:%s)"
- "Path in «%s»"))))
+ "Path in `%s' (version:%s)"
+ "Path in `%s'"))))
;; TODO: Provide a `find-file'-like auto-completing UI
(read-string (format-prompt prompt default
- (hyperdrive--format-hyperdrive hyperdrive)
version)
- nil 'hyperdrive--path-history default)))
+ (h//format-hyperdrive hyperdrive) version)
+ nil 'h//path-history default)))
-(defvar hyperdrive--url-history nil
+(defvar h//url-history nil
"Minibuffer history of `hyperdrive-read-url'.")
-(cl-defun hyperdrive-read-url (&key (prompt "Hyperdrive URL"))
+(cl-defun h/read-url (&key (prompt "Hyperdrive URL"))
"Return URL trimmed of whitespace.
Prompts with PROMPT. Defaults to current entry if it exists."
- (let ((default (when hyperdrive-current-entry
- (hyperdrive-entry-url hyperdrive-current-entry))))
- (string-trim (read-string (format-prompt prompt default) nil
'hyperdrive--url-history default))))
+ (let ((default (when h/current-entry
+ (he/url h/current-entry))))
+ (string-trim (read-string (format-prompt prompt default) nil
'h//url-history default))))
-(defvar hyperdrive--name-history nil
+(defvar h//name-history nil
"Minibuffer history of `hyperdrive-read-name'.")
-(cl-defun hyperdrive-read-name (&key prompt initial-input default)
+(cl-defun h/read-name (&key prompt initial-input default)
"Wrapper for `read-string' with common history.
Prompts with PROMPT and DEFAULT, according to `format-prompt'.
DEFAULT and INITIAL-INPUT are passed to `read-string' as-is."
- (read-string (format-prompt prompt default) initial-input
'hyperdrive--name-history default))
+ (read-string (format-prompt prompt default) initial-input 'h//name-history
default))
-(cl-defun hyperdrive-put-metadata (hyperdrive &key then)
+(cl-defun h/put-metadata (hyperdrive &key then)
"Put HYPERDRIVE's metadata into the appropriate file, then call THEN."
(declare (indent defun))
- (let ((entry (hyperdrive-entry-create :hyperdrive hyperdrive
- :path "/.well-known/host-meta.json")))
- (hyperdrive-write entry :body (json-encode (hyperdrive-metadata
hyperdrive))
+ (let ((entry (he/create :hyperdrive hyperdrive
+ :path "/.well-known/host-meta.json")))
+ (h/write entry :body (json-encode (h/metadata hyperdrive))
:then then)
hyperdrive))
-(cl-defun hyperdrive-persist (hyperdrive &key purge)
+(cl-defun h/persist (hyperdrive &key purge)
"Persist HYPERDRIVE in `hyperdrive-hyperdrives'.
With PURGE, delete hash table entry for HYPERDRIVE."
;; TODO: Make separate function for purging persisted data.
(if purge
- (remhash (hyperdrive-public-key hyperdrive) hyperdrive-hyperdrives)
- (puthash (hyperdrive-public-key hyperdrive) hyperdrive
hyperdrive-hyperdrives))
- (persist-save 'hyperdrive-hyperdrives))
+ (remhash (h/public-key hyperdrive) h/hyperdrives)
+ (puthash (h/public-key hyperdrive) hyperdrive h/hyperdrives))
+ (persist-save 'h/hyperdrives))
-(defun hyperdrive-seed-url (seed)
+(defun h/seed-url (seed)
"Return URL to hyperdrive known as SEED, or nil if it doesn't exist.
That is, if the SEED has been used to create a local
hyperdrive."
(condition-case err
- (pcase (hyperdrive-api 'get (concat "hyper://localhost/?key="
(url-hexify-string seed))
+ (pcase (h/api 'get (concat "hyper://localhost/?key=" (url-hexify-string
seed))
:as 'response :noquery t)
((and (pred plz-response-p)
response
@@ -1222,99 +1228,99 @@ Otherwise, return nil. SLOT may be one of
- petname
- public-key"
(let ((accessor-function (pcase-exhaustive slot
- ('seed #'hyperdrive-seed)
- ('petname #'hyperdrive-petname)
- ('public-key #'hyperdrive-public-key))))
+ ('seed #'h/seed)
+ ('petname #'h/petname)
+ ('public-key #'h/public-key))))
(catch 'get-first-hash
(maphash (lambda (_key val)
(when (equal (funcall accessor-function val) value)
(throw 'get-first-hash val)))
- hyperdrive-hyperdrives)
+ h/hyperdrives)
nil)))
;;;; Handlers
-(declare-function hyperdrive--org-link-goto "hyperdrive-org")
-(cl-defun hyperdrive-handler-default (entry &key then)
+(declare-function h/org--link-goto "hyperdrive-org")
+(cl-defun h/handler-default (entry &key then)
"Load ENTRY's file into an Emacs buffer.
If then, then call THEN with no arguments. Default handler."
- (hyperdrive-api 'get (hyperdrive-entry-url entry)
+ (h/api 'get (he/url entry)
:noquery t
:as (lambda ()
(pcase-let* (((cl-struct hyperdrive-entry hyperdrive version etc)
entry)
((map target) etc)
(response-buffer (current-buffer)))
- (with-current-buffer (hyperdrive--get-buffer-create entry)
+ (with-current-buffer (h//get-buffer-create entry)
;; TODO: Don't reload if we're jumping to a link on the
;; same page (but ensure that reverting still works).
(if (buffer-modified-p)
- (hyperdrive-message "Buffer modified: %S" (current-buffer))
+ (h/message "Buffer modified: %S" (current-buffer))
(save-excursion
(with-silent-modifications
(erase-buffer)
(insert-buffer-substring response-buffer))
(setf buffer-undo-list nil
- buffer-read-only (or (not (hyperdrive-writablep
hyperdrive)) version))
+ buffer-read-only (or (not (h/writablep hyperdrive))
version))
(set-buffer-modified-p nil)
(set-visited-file-modtime (current-time))))
(when target
(pcase major-mode
('org-mode
(require 'hyperdrive-org)
- (hyperdrive--org-link-goto target))
+ (h/org--link-goto target))
('markdown-mode
;; TODO: Handle markdown link
)))
(when then
(funcall then)))))))
-(cl-defun hyperdrive-handler-streamable (entry &key _then)
+(cl-defun h/handler-streamable (entry &key _then)
;; TODO: Is there any reason to not pass THEN through?
"Stream ENTRY."
- (hyperdrive-message "Streaming %s..." (hyperdrive--format-entry-url entry))
+ (h/message "Streaming %s..." (h//format-entry-url entry))
(pcase-let ((`(,command . ,args)
- (split-string hyperdrive-stream-player-command)))
+ (split-string h/stream-player-command)))
(apply #'start-process "hyperdrive-stream-player"
- nil command (cl-substitute (hyperdrive--httpify-url
- (hyperdrive-entry-url entry))
+ nil command (cl-substitute (h//httpify-url
+ (he/url entry))
"%s" args :test #'equal))))
-(declare-function hyperdrive-dir-handler "hyperdrive-dir")
-(cl-defun hyperdrive-handler-json (entry &key then)
+(declare-function h/dir-handler "hyperdrive-dir")
+(cl-defun h/handler-json (entry &key then)
"Show ENTRY.
THEN is passed to other handlers, which see. If ENTRY is a
directory (if its URL ends in \"/\"), pass to
`hyperdrive-dir-handler'. Otherwise, open with
`hyperdrive-handler-default'."
- (if (hyperdrive--entry-directory-p entry)
- (hyperdrive-dir-handler entry :then then)
- (hyperdrive-handler-default entry :then then)))
+ (if (h//entry-directory-p entry)
+ (h/dir-handler entry :then then)
+ (h/handler-default entry :then then)))
-(cl-defun hyperdrive-handler-html (entry &key then)
+(cl-defun h/handler-html (entry &key then)
"Show ENTRY, where ENTRY is an HTML file.
If `hyperdrive-render-html' is non-nil, render HTML with
`shr-insert-document', then calls THEN if given. Otherwise, open
with `hyperdrive-handler-default'."
- (if hyperdrive-render-html
+ (if h/render-html
(let (buffer)
(save-window-excursion
;; Override EWW's calling `pop-to-buffer-same-window'; we
;; want our callback to display the buffer.
- (eww (hyperdrive-entry-url entry))
- ;; Set `hyperdrive-current-entry' and use `hyperdrive-mode'
- ;; for remapped keybindings for, e.g., `hyperdrive-up'.
- (setq-local hyperdrive-current-entry entry)
- (hyperdrive-mode)
+ (eww (he/url entry))
+ ;; Set `h/current-entry' and use `h/mode'
+ ;; for remapped keybindings for, e.g., `h/up'.
+ (setq-local h/current-entry entry)
+ (h/mode)
(setq buffer (current-buffer)))
(set-buffer buffer)
(when then
(funcall then)))
- (hyperdrive-handler-default entry :then then)))
+ (h/handler-default entry :then then)))
-(cl-defun hyperdrive-handler-image (entry &key then)
+(cl-defun h/handler-image (entry &key then)
"Show ENTRY, where ENTRY is an image file.
Then calls THEN if given."
- (hyperdrive-handler-default
+ (h/handler-default
entry :then (lambda ()
(image-mode)
(when then
@@ -1322,7 +1328,7 @@ Then calls THEN if given."
;;;; Misc.
-(defun hyperdrive--get-buffer-create (entry)
+(defun h//get-buffer-create (entry)
"Return buffer for ENTRY.
In the buffer, `hyperdrive-mode' is activated and
`hyperdrive-current-entry' is set.
@@ -1336,55 +1342,78 @@ 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 (h//format-entry
+ entry h/buffer-name-format))
(buffer
- (or (when (eq 'any-version hyperdrive-reuse-buffers)
+ (or (when (eq 'any-version h/reuse-buffers)
(cl-loop for buffer in (buffer-list)
- when (hyperdrive--buffer-visiting-entry-p buffer
entry)
+ when (h//buffer-visiting-entry-p buffer entry)
return buffer))
(get-buffer-create buffer-name))))
(with-current-buffer buffer
(rename-buffer buffer-name)
;; NOTE: We do not erase the buffer because, e.g. the directory
;; handler needs to record point before it erases the buffer.
- (if (hyperdrive--entry-directory-p entry)
- (hyperdrive-dir-mode)
- (when hyperdrive-honor-auto-mode-alist
+ (if (h//entry-directory-p entry)
+ (h/dir-mode)
+ (when h/honor-auto-mode-alist
;; Inspired by https://emacs.stackexchange.com/a/2555/39549
- (let ((buffer-file-name (hyperdrive-entry-name entry)))
+ (let ((buffer-file-name (he/name entry)))
(set-auto-mode))))
- (hyperdrive-mode)
- (setq-local hyperdrive-current-entry entry)
+ (h/mode)
+ (setq-local h/current-entry entry)
(current-buffer))))
-(defun hyperdrive--buffer-visiting-entry-p (buffer entry)
+(defun h//buffer-visiting-entry-p (buffer entry)
"Return non-nil when BUFFER is visiting ENTRY."
- (and (buffer-local-value 'hyperdrive-current-entry buffer)
- (hyperdrive-entry-equal-p
- entry (buffer-local-value 'hyperdrive-current-entry buffer))))
+ (and (buffer-local-value 'h/current-entry buffer)
+ (he/equal-p
+ entry (buffer-local-value 'h/current-entry buffer))))
-(defun hyperdrive--buffer-for-entry (entry)
+(defun h//buffer-for-entry (entry)
"Return a predicate to match buffer against ENTRY."
;; 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--entry-directory-p (entry)
+ (lambda (buffer) (h//buffer-visiting-entry-p buffer entry)))
+
+(defun h//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 h/formats)))
+ (cl-labels ((fmt (format value)
+ (if value
+ (format (alist-get format formats) value)
+ "")))
+ (propertize
+ (format-spec (or format h/default-entry-format)
+ `((?n . ,(lambda () (fmt 'name name)))
+ (?p . ,(lambda () (fmt 'path path)))
+ (?v . ,(lambda () (fmt 'version version)))
+ (?H . ,(lambda () (h//preferred-format hyperdrive nil
formats)))
+ (?D . ,(lambda () (h//format hyperdrive "%D" formats)))
+ (?k . ,(lambda () (h//format hyperdrive "%k" formats)))
+ (?K . ,(lambda () (h//format hyperdrive "%K" formats)))
+ (?N . ,(lambda () (h//format hyperdrive "%N" formats)))
+ (?P . ,(lambda () (h//format hyperdrive "%P" formats)))
+ (?S . ,(lambda () (h//format hyperdrive "%S" formats)))))
+ 'help-echo (he/url entry)))))
+
+(defun h//entry-directory-p (entry)
"Return non-nil if ENTRY is a directory."
- (string-suffix-p "/" (hyperdrive-entry-path entry)))
+ (string-suffix-p "/" (he/path entry)))
-(defun hyperdrive-message (message &rest args)
+(defun h/message (message &rest args)
"Call `message' with MESSAGE and ARGS, prefixing MESSAGE with
\"Hyperdrive:\"."
- (apply #'message (concat "Hyperdrive: " message) args))
+ (apply #'message
+ (concat "Hyperdrive: " (substitute-command-keys message)) args))
-(defun hyperdrive-user-error (format &rest args)
+(defun h/user-error (format &rest args)
"Call `user-error' with FORMAT and ARGS, prefixing FORMAT with
\"Hyperdrive:\"."
- (apply #'user-error (concat "Hyperdrive: " format) args))
+ (apply #'user-error
+ (concat "Hyperdrive: " (substitute-command-keys format)) args))
-(defun hyperdrive-insert-button (text &rest properties)
+(defun h/insert-button (text &rest properties)
"Insert button labeled TEXT with button PROPERTIES at point.
PROPERTIES are passed to `insert-text-button', for which this
function is a convenience wrapper used by `describe-package-1'."
@@ -1394,7 +1423,7 @@ function is a convenience wrapper used by
`describe-package-1'."
(apply #'insert-text-button button-text 'face button-face 'follow-link t
properties)))
-(defun hyperdrive-copy-tree (tree &optional vecp)
+(defun h/copy-tree (tree &optional vecp)
"Copy TREE like `copy-tree', but with VECP, works for records too."
;; TODO: Now that the new copy-tree behavior has been merged into Emacs,
;; remove this function once compat.el supports the new behavior.
@@ -1403,19 +1432,19 @@ function is a convenience wrapper used by
`describe-package-1'."
(while (consp tree)
(let ((newcar (car tree)))
(if (or (consp (car tree)) (and vecp (or (vectorp (car tree))
(recordp (car tree)))))
- (setq newcar (hyperdrive-copy-tree (car tree) vecp)))
+ (setq newcar (h/copy-tree (car tree) vecp)))
(push newcar result))
(setq tree (cdr tree)))
(nconc (nreverse result)
- (if (and vecp (or (vectorp tree) (recordp tree)))
(hyperdrive-copy-tree tree vecp) tree)))
+ (if (and vecp (or (vectorp tree) (recordp tree))) (h/copy-tree
tree vecp) tree)))
(if (and vecp (or (vectorp tree) (recordp tree)))
(let ((i (length (setq tree (copy-sequence tree)))))
(while (>= (setq i (1- i)) 0)
- (aset tree i (hyperdrive-copy-tree (aref tree i) vecp)))
+ (aset tree i (h/copy-tree (aref tree i) vecp)))
tree)
tree)))
-(cl-defun hyperdrive--format-path (path &key directoryp)
+(cl-defun h//format-path (path &key directoryp)
"Return PATH with a leading slash if it lacks one.
When DIRECTORYP, also add a trailing slash to PATH if it lacks one.
When PATH is nil or blank, return \"/\"."
@@ -1428,12 +1457,12 @@ When PATH is nil or blank, return \"/\"."
;;;; Utilities
-(defun hyperdrive-time-greater-p (a b)
+(defun h/time-greater-p (a b)
"Return non-nil if time value A is greater than B."
(not (or (time-less-p a b)
(time-equal-p a b))))
-(defun hyperdrive--clean-buffer (&optional buffer)
+(defun h//clean-buffer (&optional buffer)
"Remove all local variables, overlays, and text properties in BUFFER.
When BUFFER is nil, act on current buffer."
(with-current-buffer (or buffer (current-buffer))
@@ -1447,7 +1476,7 @@ When BUFFER is nil, act on current buffer."
(delete-all-overlays)
(set-text-properties (point-min) (point-max) nil))))
-(defun hyperdrive-entry-equal-p (a b)
+(defun he/equal-p (a b)
"Return non-nil if hyperdrive entries A and B are equal.
Compares only public key, version, and path."
(pcase-let (((cl-struct hyperdrive-entry (path a-path) (version a-version)
@@ -1460,16 +1489,16 @@ Compares only public key, version, and path."
(equal a-path b-path)
(equal a-key b-key))))
-(defun hyperdrive-equal-p (a b)
+(defun h/equal-p (a b)
"Return non-nil if hyperdrives A and B are equal.
Compares their public keys."
- (equal (hyperdrive-public-key a) (hyperdrive-public-key b)))
+ (equal (h/public-key a) (h/public-key b)))
-(defun hyperdrive-entry-hyperdrive-equal-p (a b)
+(defun he/hyperdrive-equal-p (a b)
"Return non-nil if entries A and B have the same hyperdrive."
- (hyperdrive-equal-p (hyperdrive-entry-hyperdrive a)
(hyperdrive-entry-hyperdrive b)))
+ (h/equal-p (he/hyperdrive a) (he/hyperdrive b)))
-(defun hyperdrive--ensure-dot-slash-prefix-path (path)
+(defun h//ensure-dot-slash-prefix-path (path)
"Return PATH, ensuring it begins with the correct prefix.
Unless PATH starts with \"/\" \"./\" or \"../\", add \"./\"."
(if (string-match-p (rx bos (or "/" "./" "../")) path)
@@ -1477,4 +1506,12 @@ Unless PATH starts with \"/\" \"./\" or \"../\", add
\"./\"."
(concat "./" path)))
(provide 'hyperdrive-lib)
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
;;; hyperdrive-lib.el ends here
diff --git a/hyperdrive-menu.el b/hyperdrive-menu.el
index 2bd437e88f..53c6bc931a 100644
--- a/hyperdrive-menu.el
+++ b/hyperdrive-menu.el
@@ -32,322 +32,417 @@
(require 'transient)
(require 'compat)
+(require 'hyperdrive)
(require 'hyperdrive-vars)
(require 'hyperdrive-lib)
+(require 'h/mirror)
;;;; Declarations
-(declare-function hyperdrive-dir--entry-at-point "hyperdrive-dir")
-(declare-function hyperdrive-delete "hyperdrive")
-(declare-function hyperdrive-set-nickname "hyperdrive")
-(declare-function hyperdrive-set-petname "hyperdrive")
+(declare-function h/dir--entry-at-point "hyperdrive-dir")
+(declare-function h/delete "hyperdrive")
+(declare-function h/set-nickname "hyperdrive")
+(declare-function h/set-petname "hyperdrive")
-;;;;; hyperdrive-menu: Transient for entries
+;;;; 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
+;; (when h/current-entry
;; (pcase-let (((cl-struct hyperdrive-entry hyperdrive)
-;; hyperdrive-current-entry))
+;; h/current-entry))
;; ,@body))))
;;;###autoload (autoload 'hyperdrive-menu "hyperdrive-menu" nil t)
(transient-define-prefix hyperdrive-menu (entry)
"Show the hyperdrive transient menu."
:info-manual "(hyperdrive)"
+ :refresh-suffixes t
[["Hyperdrive"
:description
(lambda ()
- (if-let* ((entry (hyperdrive-menu--entry))
- (hyperdrive (hyperdrive-entry-hyperdrive entry)))
+ (if-let* ((entry (h/menu--scope))
+ (hyperdrive (he/hyperdrive entry)))
(concat (propertize "Hyperdrive: " 'face 'transient-heading)
- (hyperdrive--format-host hyperdrive :with-label t))
+ (h//format hyperdrive))
"Hyperdrive"))
- ("h" "Hyperdrive" hyperdrive-menu-hyperdrive)
- ("N" "New drive" hyperdrive-new)
- ("L" "Open Link" hyperdrive-open-url)]
+ ("h" "Hyperdrive" h/menu-hyperdrive)
+ ("N" "New drive" h/new)
+ ("L" "Open Link" h/open-url)]
["Version"
:if (lambda ()
- (and (hyperdrive-menu--entry)
+ (and (h/menu--scope)
;; TODO: Remove this check and add useful history transient UI.
- (not (eq 'hyperdrive-history-mode major-mode))))
+ (not (eq 'h/history-mode major-mode))))
:description (lambda ()
- (if-let ((entry (hyperdrive-menu--entry)))
+ (if-let ((entry (h/menu--scope)))
(concat (propertize "Version: "
'face 'transient-heading)
(propertize (format "%s"
- (or
(hyperdrive-entry-version entry)
+ (or (he/version entry)
"latest"))
'face 'transient-value))
"Version"))
- ("V p" "Previous" hyperdrive-open-previous-version
+ ("V p" "Previous" h/open-previous-version
:inapt-if-not (lambda ()
- (hyperdrive-entry-previous (hyperdrive-menu--entry)
:cache-only t))
+ (he/previous (h/menu--scope) :cache-only t))
;; :transient t
:description (lambda ()
- (if-let ((entry (hyperdrive-menu--entry)))
+ (if-let ((entry (h/menu--scope)))
(concat "Previous"
- (pcase-exhaustive (hyperdrive-entry-previous
entry :cache-only t)
+ (pcase-exhaustive (he/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-open-next-version
+ ("V n" "Next" h/open-next-version
:inapt-if-not (lambda ()
- (let ((entry (hyperdrive-menu--entry)))
- (and (hyperdrive-entry-version entry)
- (hyperdrive-entry-p (hyperdrive-entry-next
entry)))))
+ (let ((entry (h/menu--scope)))
+ (and (he/version entry)
+ (he/p (he/next entry)))))
:description (lambda ()
(concat "Next"
- (when-let* ((entry (hyperdrive-menu--entry))
- (next-entry (hyperdrive-entry-next
entry))
+ (when-let* ((entry (h/menu--scope))
+ (next-entry (he/next entry))
;; Don't add ": latest" if we're
already at the latest
;; version or if the next version is
`unknown'.
- ((and (hyperdrive-entry-version entry)
- (hyperdrive-entry-p
(hyperdrive-entry-next entry))))
- (display-version (if-let
((next-version (hyperdrive-entry-version next-entry)))
+ ((and (he/version entry)
+ (he/p (he/next entry))))
+ (display-version (if-let
((next-version (he/version next-entry)))
(number-to-string
next-version)
"latest")))
(concat ": " (propertize display-version 'face
'transient-value)))))
)
- ("V a" "At..." hyperdrive-open-at-version)
- ("V h" "History" hyperdrive-history
+ ("V a" "At..." h/open-at-version)
+ ("V h" "History" h/history
:inapt-if (lambda ()
- (hyperdrive--entry-directory-p (hyperdrive-menu--entry))))]]
+ (h//entry-directory-p (h/menu--scope))))]]
[:if (lambda ()
- (and (hyperdrive-menu--entry)
+ (and (h/menu--scope)
;; TODO: Remove this check and add useful history transient UI.
- (not (eq 'hyperdrive-history-mode major-mode))))
- [;; Current
- :description
- (lambda ()
- (let ((entry (hyperdrive-menu--entry)))
- (concat (propertize "Current: " 'face 'transient-heading)
- (propertize (hyperdrive--format-path (hyperdrive-entry-path
entry))
- 'face 'transient-value))))
- ("g" "Refresh" revert-buffer)
- ("^" "Up to parent"
- (lambda ()
- (interactive)
- (hyperdrive-up (hyperdrive-menu--entry)))
- :inapt-if-not (lambda ()
- (hyperdrive-parent (hyperdrive-menu--entry))))
- ("s" "Sort" hyperdrive-dir-sort
- :if-mode hyperdrive-dir-mode
- :transient t)
- ("j" "Jump" imenu)
- ;; 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 (hyperdrive-menu--entry)))
- :if-mode hyperdrive-dir-mode
- :transient t)
- ("n" "Next" (lambda ()
- (interactive)
- (hyperdrive-ewoc-next)
- (hyperdrive-menu (hyperdrive-menu--entry)))
- :if-mode hyperdrive-dir-mode
- :transient t)
- ("w" "Copy URL" hyperdrive-copy-url
- :if-not-mode hyperdrive-dir-mode)
- ("D" "Delete" hyperdrive-delete
- :if-not-mode hyperdrive-dir-mode
- :inapt-if (lambda ()
- (pcase-let (((cl-struct hyperdrive-entry hyperdrive version)
- (hyperdrive-menu--entry)))
- (or version (not (hyperdrive-writablep hyperdrive))))))
- ("d" "Download" hyperdrive-download
- :if-not-mode hyperdrive-dir-mode)]
- ;; TODO: Consider adding a defcustom to hide the "Selected" and
- ;; "Current" groups when in a directory buffer.
- [;; Selected
- :if (lambda ()
- (and (hyperdrive-menu--entry)
- (eq major-mode 'hyperdrive-dir-mode)
- (hyperdrive-dir--entry-at-point)))
- :description
- (lambda ()
- (let ((current-entry (hyperdrive-menu--entry))
- (selected-entry (hyperdrive-dir--entry-at-point)))
- (concat (propertize "Selected: " 'face 'transient-heading)
- (propertize
- (or (and (hyperdrive-entry-equal-p current-entry
selected-entry)
- "./")
- (alist-get 'display-name
- (hyperdrive-entry-etc selected-entry))
- (hyperdrive-entry-name selected-entry))
- 'face 'transient-value))))
- :pad-keys t
- ("d" "Download" hyperdrive-download
- :inapt-if (lambda ()
- (when-let ((entry-at-point (hyperdrive-dir--entry-at-point)))
- (hyperdrive--entry-directory-p entry-at-point))))
- ("D" "Delete" hyperdrive-delete
- :inapt-if (lambda ()
- (let ((current-entry (hyperdrive-menu--entry))
- (selected-entry (hyperdrive-dir--entry-at-point)))
- (or (not (hyperdrive-writablep
- (hyperdrive-entry-hyperdrive current-entry)))
- (eq selected-entry current-entry)
- (string= "../" (alist-get 'display-name
- (hyperdrive-entry-etc
selected-entry)))))))
- ("w" "Copy URL" hyperdrive-dir-copy-url)
- ;; 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
- :inapt-if (lambda ()
- (when-let ((entry-at-point (hyperdrive-dir--entry-at-point)))
- (hyperdrive--entry-directory-p entry-at-point))))]]
+ (not (eq 'h/history-mode major-mode))))
+ [;; Current
+ :description
+ (lambda ()
+ (let ((entry (h/menu--scope)))
+ (concat (propertize "Current: " 'face 'transient-heading)
+ (propertize (h//format-path (he/path entry))
+ 'face 'transient-value))))
+ ("g" "Refresh" revert-buffer)
+ ("^" "Up to parent" h/up
+ :inapt-if-not (lambda ()
+ (h/parent (h/menu--scope))))
+ ("s" "Sort" h/dir-sort
+ :if-mode h/dir-mode
+ :transient t)
+ ;; TODO: Consider running whatever command imenu has been rebound to
in the
+ ;; global map, e.g., consult-imenu.
+ ("j" "Jump" imenu
+ :if-mode h/dir-mode)
+ ;; TODO: Combine previous and next commands on the same line?
+ ("p" "Previous" h/ewoc-previous
+ :if-mode h/dir-mode
+ :transient t)
+ ("n" "Next" h/ewoc-next
+ :if-mode h/dir-mode
+ :transient t)
+ ("w" "Copy URL" h/copy-url
+ :if-not-mode h/dir-mode)
+ ("D" "Delete" h/delete
+ :if-not-mode h/dir-mode
+ :inapt-if (lambda ()
+ (pcase-let (((cl-struct hyperdrive-entry hyperdrive
version)
+ (h/menu--scope)))
+ (or version (not (h/writablep hyperdrive))))))
+ ("d" "Download" h/download
+ :if-not-mode h/dir-mode)]
+ ;; TODO: Consider adding a defcustom to hide the "Selected" and
+ ;; "Current" groups when in a directory buffer.
+ [;; Selected
+ :if (lambda ()
+ (and (h/menu--scope)
+ (eq major-mode 'h/dir-mode)
+ (h/dir--entry-at-point)))
+ :description
+ (lambda ()
+ (let ((current-entry (h/menu--scope))
+ (selected-entry (h/dir--entry-at-point)))
+ (concat (propertize "Selected: " 'face 'transient-heading)
+ (propertize
+ (or (and (he/equal-p current-entry selected-entry)
+ "./")
+ (alist-get 'display-name
+ (he/etc selected-entry))
+ (he/name selected-entry))
+ 'face 'transient-value))))
+ :pad-keys t
+ ("d" "Download" h/download
+ :inapt-if (lambda ()
+ (when-let ((entry-at-point (h/dir--entry-at-point)))
+ (h//entry-directory-p entry-at-point))))
+ ("D" "Delete" h/delete
+ :inapt-if (lambda ()
+ (let ((current-entry (h/menu--scope))
+ (selected-entry (h/dir--entry-at-point)))
+ (or (not (h/writablep
+ (he/hyperdrive current-entry)))
+ (eq selected-entry current-entry)
+ (string= "../" (alist-get 'display-name
+ (he/etc
selected-entry)))))))
+ ("w" "Copy URL" h/dir-copy-url)
+ ;; FIXME: The sequence "? RET" says "Unbound suffix" instead of
showing the help for that command. Might be an issue in Transient.
+ ("RET" "Open" h/dir-find-file)
+ ("v" "View" h/dir-view-file
+ :inapt-if (lambda ()
+ (when-let ((entry-at-point (h/dir--entry-at-point)))
+ (h//entry-directory-p entry-at-point))))]]
[["Gateway"
:description
(lambda ()
(concat (propertize "Gateway: " 'face 'transient-heading)
- (propertize (if (hyperdrive-status) "on" "off")
+ (propertize (if (h/status) "on" "off")
'face 'transient-value)))
- ("G s" "Start" hyperdrive-start
+ ("G s" "Start" h/start
:transient t)
- ("G S" "Stop" hyperdrive-stop
+ ("G S" "Stop" h/stop
:transient t)
- ("G v" "Version" hyperdrive-hyper-gateway-version
+ ("G v" "Version" h/hyper-gateway-version
:transient t)]
["Bookmark"
- ("b j" "Jump" hyperdrive-bookmark-jump)
- ("b l" "List" hyperdrive-bookmark-list)
+ ("b j" "Jump" h/bookmark-jump)
+ ("b l" "List" h/bookmark-list)
("b s" "Set" bookmark-set
- :if hyperdrive-menu--entry)]]
- (interactive (list hyperdrive-current-entry))
- (transient-setup 'hyperdrive-menu nil nil :scope entry))
+ :if h/menu--scope)]]
+ (interactive (list h/current-entry))
+ (transient-setup 'h/menu nil nil :scope entry))
-;;;;; hyperdrive-menu-hyperdrive: Transient for hyperdrives
+;;;; hyperdrive-menu-hyperdrive: Transient for hyperdrives
+(defvar h/mirror-source nil)
+(defvar h/mirror-target nil)
+(defvar h/mirror-filter nil)
+(defvar h/mirror-confirm t)
+
+;;;###autoload (autoload 'hyperdrive-menu-hyperdrive "hyperdrive-menu" nil t)
(transient-define-prefix hyperdrive-menu-hyperdrive (hyperdrive)
"Show menu for HYPERDRIVE."
+ :info-manual "(hyperdrive)"
+ :refresh-suffixes t
["Hyperdrive"
+ ;; TODO(transient): Maybe support shared predicates like
+ ;; so, and then ":if entryp" to avoid duplication below.
+ ;; :predicates ((entryp ,(lambda () (h/seed (h/menu--scope)))))
+ ;; TODO(transient): Support subgroups in a column group,
+ ;; making the below "" "Upload" unnecessary.
+ ;; TODO: After transient supports subgroup in a column group, use :if
writablep
+ ;; on whole "Upload" group instead of :inapt-if-not on individual commands
+ ;; TODO(transient): Implement :inapt-if* for groups.
:pad-keys t
- ("d" "Describe" (lambda ()
- (interactive)
- (hyperdrive-describe-hyperdrive
(hyperdrive-menu--entry))))
- ;; FIXME: Is there a better way to intersperse lines of description and
commands?
- ("" "Public key" ignore
- :description (lambda ()
- (concat "Public key: " (hyperdrive--format-host
(hyperdrive-menu--entry) :format 'public-key))))
- ("" "Seed" ignore
- :description (lambda ()
- (concat "Seed: " (hyperdrive--format-host
(hyperdrive-menu--entry) :format 'seed)))
- :if (lambda ()
- (hyperdrive-seed (hyperdrive-menu--entry))))
- ("p" "Petname" hyperdrive-menu-set-petname
- :transient t
- :description (lambda ()
- (format "Petname: %s"
- (if-let ((petname (hyperdrive-petname
- (hyperdrive-menu--entry))))
- (propertize petname
- 'face 'hyperdrive-petname)
- ""))))
- ("n" "set nickname" hyperdrive-menu-set-nickname
- :transient t
- :inapt-if-not (lambda ()
- (hyperdrive-writablep (hyperdrive-menu--entry)))
- :description (lambda ()
- (format "Nickname: %s"
- ;; TODO: Hyperdrive-metadata accessor (and maybe gv
setter).
- (if-let ((nickname (alist-get 'name
- (hyperdrive-metadata
-
(hyperdrive-menu--entry)))))
- (propertize nickname
- 'face 'hyperdrive-nickname)
- ""))))
- ("" "Domain" ignore
- :description (lambda ()
- (concat "Domain: " (hyperdrive--format-host
(hyperdrive-menu--entry) :format 'domain)))
- :if (lambda ()
- (hyperdrive-domains (hyperdrive-menu--entry))))
- ("" "Latest version" ignore
- :description (lambda ()
- (format "Latest version: %s" (hyperdrive-latest-version
(hyperdrive-menu--entry)))))]
+ ("d" h/menu-describe-hyperdrive)
+ ("w" h/menu-hyperdrive-copy-url)
+ (:info (lambda () (h//format (h/menu--scope) "Public key: %K"
h/raw-formats)))
+ ( :info (lambda () (h//format (h/menu--scope) "Seed: %S" h/raw-formats))
+ :if (lambda () (h/seed (h/menu--scope))))
+ ("p" h/menu-set-petname :transient t)
+ ("n" h/menu-set-nickname :transient t
+ :inapt-if-not (lambda () (h/writablep (h/menu--scope))))
+ ( :info (lambda () (h//format (h/menu--scope) "Domain: %D" h/raw-formats))
+ :if (lambda () (h/domains (h/menu--scope))))
+ (:info (lambda () (format "Latest version: %s" (h/latest-version
(h/menu--scope)))))]
[["Open"
- ("f" "Find file"
- (lambda ()
- (interactive)
- (hyperdrive-open
- (hyperdrive-read-entry
- :hyperdrive (hyperdrive-menu--entry)
- :read-version current-prefix-arg))))
- ("v" "View file" (lambda ()
- (interactive)
- (hyperdrive-view-file
- (hyperdrive-read-entry
- :hyperdrive (hyperdrive-menu--entry)
- :read-version current-prefix-arg))))]
- ["Upload"
- ("u f" "File" hyperdrive-menu-upload-file
- :inapt-if-not (lambda ()
- (hyperdrive-writablep (hyperdrive-menu--entry))))
- ("u F" "Files" hyperdrive-menu-upload-files
- :inapt-if-not (lambda ()
- (hyperdrive-writablep (hyperdrive-menu--entry))))
- ;; TODO: When `hyperdrive-mirror' is rewritten with transient.el, set the
hyperdrive by default to the
- ("u m" "Mirror" hyperdrive-mirror
- :inapt-if-not (lambda ()
- (hyperdrive-writablep (hyperdrive-menu--entry))))]]
- (interactive (list (hyperdrive-complete-hyperdrive :force-prompt
current-prefix-arg)))
- (transient-setup 'hyperdrive-menu-hyperdrive nil nil :scope hyperdrive))
+ ("f" "Find file" h/menu-open-file)
+ ("v" "View file" h/menu-view-file)
+ "" "Upload"
+ ("u f" "File" h/menu-upload-file
+ :inapt-if-not (lambda () (h/writablep (h/menu--scope))))
+ ("u F" "Files" h/menu-upload-files
+ :inapt-if-not (lambda () (h/writablep (h/menu--scope))))]
+ ["Mirror"
+ :if (lambda () (h/writablep (h/menu--scope)))
+ ("m m" "Mirror using settings below" h/mirror-configured)
+ ("m s" "Source" h/mirror-set-source)
+ ("m t" "Target" h/mirror-set-target)
+ ("m f" "Filter" h/mirror-set-filter)
+ ("m c" "Confirm" h/mirror-set-confirm)]]
+ (interactive (list (h/complete-hyperdrive :force-prompt current-prefix-arg)))
+ (transient-setup 'h/menu-hyperdrive nil nil :scope hyperdrive))
+
+(transient-define-suffix h/mirror-configured ()
+ (interactive)
+ (h/mirror (or h/mirror-source default-directory)
+ (h/menu--scope)
+ :target-dir h/mirror-target
+ :filter h/mirror-filter
+ :no-confirm (not h/mirror-confirm)))
+
+;; TODO(transient): Use a suffix class, so these commands can be invoked
+;; directly. See magit-branch.<branch>.description et al.
+(defclass h/mirror-variable (transient-lisp-variable)
+ ((format :initform " %k %d: %v")
+ (format-value :initarg :format-value :initform nil)
+ (value-face :initarg :value-face :initform nil)))
-(transient-define-suffix hyperdrive-menu-upload-file (filename entry)
+(cl-defmethod transient-format-value ((obj h/mirror-variable))
+ (if-let ((fn (oref obj format-value)))
+ (funcall fn obj)
+ (if-let ((value (oref obj value))
+ (value (if (stringp value)
+ value
+ (prin1-to-string value))))
+ (if-let ((face (oref obj value-face)))
+ (propertize value 'face face)
+ value)
+ (propertize "not set" 'face 'h/dimmed))))
+
+(transient-define-infix h/mirror-set-source ()
+ :class 'h/mirror-variable
+ :variable 'h/mirror-source
+ :value-face 'h/file-name
+ :format-value (lambda (obj)
+ (if-let ((value (oref obj value)))
+ (propertize value 'face 'h/file-name)
+ (format (propertize "%s (default)" 'face 'h/dimmed)
+ (propertize default-directory 'face
'h/file-name))))
+ :reader (lambda (_prompt _default _history)
+ (read-directory-name "Mirror directory: " nil nil t)))
+
+(transient-define-infix h/mirror-set-target ()
+ :class 'h/mirror-variable
+ :variable 'h/mirror-target
+ :value-face 'h/file-name
+ :format-value (lambda (obj)
+ (if-let ((value (oref obj value)))
+ (propertize value 'face 'h/file-name)
+ (format (propertize "%s (default)" 'face 'h/dimmed)
+ (propertize "/" 'face 'h/file-name))))
+ :reader (lambda (_prompt _default _history)
+ (h//format-path
+ (h/read-path
+ :hyperdrive (h/menu--scope)
+ :prompt "Target directory in `%s'"
+ :default "/")
+ :directoryp t)))
+
+(transient-define-infix h/mirror-set-filter ()
+ :class 'h/mirror-variable
+ :variable 'h/mirror-filter
+ :always-read nil
+ :format-value (lambda (obj)
+ (pcase-exhaustive (oref obj value)
+ ('nil (propertize "None (mirror all)" 'face 'h/file-name))
+ ((and (pred stringp) it) (propertize it 'face
'font-lock-regexp-face))
+ ((and (pred symbolp) it) (propertize (symbol-name it)
'face 'font-lock-function-name-face))
+ ;; TODO: Fontify the whole lambda.
+ ((and (pred consp) it) (propertize (prin1-to-string it)
'face 'default))))
+ :reader (lambda (_prompt _default _history)
+ (h/mirror-read-filter)))
+
+(transient-define-infix h/mirror-set-confirm ()
+ :class 'h/mirror-variable
+ :variable 'h/mirror-confirm
+ :format-value (lambda (obj)
+ ;; TODO dedicated faces
+ (if (oref obj value)
+ (propertize "yes" 'face 'h/file-name)
+ (propertize "no (dangerous)" 'face
'font-lock-warning-face)))
+ :reader (lambda (_prompt _default _history)
+ (not h/mirror-confirm)))
+
+(transient-define-suffix h/menu-open-file ()
+ (interactive)
+ (h/open (h/read-entry
+ :hyperdrive (h/menu--scope)
+ :read-version current-prefix-arg)))
+
+(transient-define-suffix h/menu-view-file ()
+ (interactive)
+ (h/view-file (h/read-entry
+ :hyperdrive (h/menu--scope)
+ :read-version current-prefix-arg)))
+
+(transient-define-suffix h/menu-upload-file (filename entry)
(interactive
(let* ((filename (read-file-name "Upload file: "))
- (entry (hyperdrive-read-entry :hyperdrive (hyperdrive-menu--entry)
- :default-path (file-name-nondirectory
filename)
- :latest-version t)))
+ (entry (h/read-entry :hyperdrive (h/menu--scope)
+ :default-path (file-name-nondirectory filename)
+ :latest-version t)))
(list filename entry)))
- (hyperdrive-upload-file filename entry))
+ (h/upload-file filename entry))
-(transient-define-suffix hyperdrive-menu-upload-files (files hyperdrive &key
target-directory)
+(transient-define-suffix h/menu-upload-files (files hyperdrive &key
target-directory)
(interactive
- (let ((drive (hyperdrive-menu--entry)))
+ (let ((drive (h/menu--scope)))
(list
- (hyperdrive-read-files)
+ (h/read-files)
drive
- :target-directory (hyperdrive-read-path
+ :target-directory (h/read-path
:hyperdrive drive
- :prompt "Target directory in «%s»"
+ :prompt "Target directory in `%s'"
:default "/"))))
- (hyperdrive-upload-files files hyperdrive
- :target-directory target-directory))
+ (h/upload-files files hyperdrive
+ :target-directory target-directory))
+
+(transient-define-suffix h/menu-describe-hyperdrive ()
+ :description "Describe"
+ (interactive)
+ (h/describe-hyperdrive (h/menu--scope)))
+
+(transient-define-suffix h/menu-hyperdrive-copy-url ()
+ :description "Copy URL"
+ (interactive)
+ (h/copy-url (he/create
+ :hyperdrive (h/menu--scope))))
-(transient-define-suffix hyperdrive-menu-set-petname (petname hyperdrive)
+(transient-define-suffix h/menu-set-petname (petname hyperdrive)
+ :description (lambda ()
+ (format "Petname: %s"
+ (if-let ((petname (h/petname
+ (h/menu--scope))))
+ (propertize petname 'face 'h/petname)
+ "")))
(interactive
- (list (hyperdrive-read-name
+ (list (h/read-name
:prompt "New petname"
- :initial-input (hyperdrive-petname (hyperdrive-menu--entry)))
- (hyperdrive-menu--entry)))
- (hyperdrive-set-petname petname hyperdrive))
+ :initial-input (h/petname (h/menu--scope)))
+ (h/menu--scope)))
+ (h/set-petname petname hyperdrive))
-(transient-define-suffix hyperdrive-menu-set-nickname (nickname hyperdrive)
+(transient-define-suffix h/menu-set-nickname (nickname hyperdrive)
+ :description
+ (lambda ()
+ (format "Nickname: %s"
+ ;; TODO: h/metadata accessor (and maybe gv setter).
+ (if-let ((nickname (alist-get 'name
+ (h/metadata
+ (h/menu--scope)))))
+ (propertize nickname 'face 'h/nickname)
+ "")))
(interactive
- (list (hyperdrive-read-name
+ (list (h/read-name
:prompt "New nickname"
- :initial-input (alist-get 'name (hyperdrive-metadata
(hyperdrive-menu--entry))))
- (hyperdrive-menu--entry)))
- (hyperdrive-set-nickname nickname hyperdrive
- :then (lambda (drive)
- (hyperdrive-menu-hyperdrive drive))))
+ :initial-input (alist-get 'name (h/metadata (h/menu--scope))))
+ (h/menu--scope)))
+ (h/set-nickname nickname hyperdrive))
-;;;;; Common Utilities
+;;;; Menu Utilities
-(defun hyperdrive-menu--entry ()
+(defun h/menu--scope ()
"Return the current entry as understood by `hyperdrive-menu'."
(oref (or transient--prefix transient-current-prefix) scope))
;;;; Footer
-(provide 'hyperdrive-menu)
+(provide 'h/menu)
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
;;; hyperdrive-menu.el ends here
diff --git a/hyperdrive-mirror.el b/hyperdrive-mirror.el
index 286dd225c5..ee735f17e4 100644
--- a/hyperdrive-mirror.el
+++ b/hyperdrive-mirror.el
@@ -27,6 +27,7 @@
;;;; Requirements
(require 'cl-lib)
+(require 'rx)
(require 'hyperdrive-lib)
@@ -45,13 +46,13 @@ file."))
;;;; Variables
;; TODO: Consolidate these two local variables into one?
-(defvar-local hyperdrive-mirror-parent-entry nil
+(defvar-local h/mirror-parent-entry nil
"Parent entry for `hyperdrive-mirror-mode' buffer.")
-(put 'hyperdrive-mirror-parent-entry 'permanent-local t)
+(put 'h/mirror-parent-entry 'permanent-local t)
-(defvar-local hyperdrive-mirror-files-and-urls nil
+(defvar-local h/mirror-files-and-urls nil
"List of lists like (FILE URL STATUS) for `hyperdrive-mirror-mode'.
-FILE is the local filepath of the file to be uploaded.
+FILE is the local file path of the file to be uploaded.
URL is \"hyper://\" URL where the file would be uploaded.
STATUS is one of:
- \\+`new': FILE does not exist in hyperdrive at URL
@@ -59,20 +60,20 @@ STATUS is one of:
- \\+`older': FILE has an earlier modification time than hyperdrive URL
- \\+`same': FILE has the same modification time as hyperdrive URL")
-(defvar-local hyperdrive-mirror-query nil
+(defvar-local h/mirror-query nil
"List of arguments passed to `hyperdrive-mirror', excluding
\\+`no-confirm'.")
-(defvar-local hyperdrive-mirror-visibility-cache nil)
+(defvar-local h/mirror-visibility-cache nil)
;;;; Keys
;; These are the "keys" used to group items with Taxy.
(eval-and-compile
- (taxy-define-key-definer hyperdrive-mirror-define-key
- hyperdrive-mirror-keys "hyperdrive-mirror-key" "Grouping keys."))
+ (taxy-define-key-definer h/mirror-define-key
+ h/mirror-keys "hyperdrive-mirror-key" "Grouping keys."))
-(hyperdrive-mirror-define-key status ()
+(h/mirror-define-key status ()
(pcase-let (((cl-struct hyperdrive-mirror-item (status item-status)) item))
(pcase-exhaustive item-status
(`new "New locally")
@@ -80,7 +81,7 @@ STATUS is one of:
('older "Older locally")
('same "Same"))))
-(defvar hyperdrive-mirror-default-keys
+(defvar h/mirror-default-keys
'(status)
"Default keys.")
@@ -91,24 +92,24 @@ STATUS is one of:
(eval-and-compile
(taxy-magit-section-define-column-definer "hyperdrive-mirror"))
-(hyperdrive-mirror-define-column "Local File" ()
+(h/mirror-define-column "Local File" ()
(pcase-let (((cl-struct hyperdrive-mirror-item file) item))
(abbreviate-file-name file)))
-(hyperdrive-mirror-define-column "Hyperdrive File" ()
+(h/mirror-define-column "Hyperdrive File" ()
(pcase-let* (((cl-struct hyperdrive-mirror-item url) item)
- (entry (hyperdrive-url-entry url))
- (short-url (hyperdrive--format-entry-url entry :host-format
'short-key)))
+ (entry (h/url-entry url))
+ (short-url (h//format-entry-url entry :host-format 'short-key)))
(propertize url 'display short-url)))
-(unless hyperdrive-mirror-columns
- (setq-default hyperdrive-mirror-columns
- (get 'hyperdrive-mirror-columns 'standard-value)))
+(unless h/mirror-columns
+ (setq-default h/mirror-columns
+ (get 'h/mirror-columns 'standard-value)))
;;;; Functions
-(declare-function hyperdrive-upload-file "hyperdrive")
-(defun hyperdrive--mirror (files-and-urls parent-entry)
+(declare-function h/upload-file "hyperdrive")
+(defun h//mirror (files-and-urls parent-entry)
"Upload each file to its corresponding URL in FILES-AND-URLs.
FILES-AND-URLS is structured like `hyperdrive-mirror-files-and-urls'.
After uploading files, open PARENT-ENTRY."
@@ -120,37 +121,35 @@ After uploading files, open PARENT-ENTRY."
(progress-reporter
(make-progress-reporter (format "Uploading %s files: " (length
upload-files-and-urls)) 0 (length upload-files-and-urls)))
(queue (make-plz-queue
- :limit hyperdrive-queue-limit
+ :limit h/queue-limit
:finally (lambda ()
(when (buffer-live-p (get-buffer
"*hyperdrive-mirror*"))
(kill-buffer "*hyperdrive-mirror*"))
- (hyperdrive-open parent-entry)
+ (h/open parent-entry)
(progress-reporter-done progress-reporter)))))
(unless upload-files-and-urls
- (hyperdrive-user-error "No new/newer files to upload"))
+ (h/user-error "No new/newer files to upload"))
(pcase-dolist ((cl-struct hyperdrive-mirror-item file url)
upload-files-and-urls)
- (hyperdrive-upload-file file (hyperdrive-url-entry url)
+ (h/upload-file file (h/url-entry url)
:queue queue
;; TODO: Error handling (e.g. in case one or more files fails to
upload).
:then (lambda (_)
(progress-reporter-update progress-reporter (cl-incf
count)))))))
-(defun hyperdrive-mirror-revert-buffer (&optional _ignore-auto _noconfirm)
+(defun h/mirror-revert-buffer (&optional _ignore-auto _noconfirm)
"Revert `hyperdrive-mirror-mode' buffer.
Runs `hyperdrive-mirror' again with the same query."
- (apply #'hyperdrive-mirror hyperdrive-mirror-query))
+ (apply #'h/mirror h/mirror-query))
;;;; Commands
-;; TODO: Rewrite `hyperdrive-mirror' as a Transient.
-
;;;###autoload
(cl-defun hyperdrive-mirror
- (source hyperdrive &key target-dir (predicate #'always) no-confirm)
+ (source hyperdrive &key target-dir (filter #'always) no-confirm)
"Mirror SOURCE to TARGET-DIR in HYPERDRIVE.
-Only mirror paths within SOURCE for which PREDICATE returns
-non-nil. PREDICATE may be a function, which receives the expanded
+Only mirror paths within SOURCE for which FILTER returns
+non-nil. FILTER may be a function, which receives the expanded
filename path as its argument, or a regular expression, which is
tested against each expanded filename path. SOURCE is a directory
name.
@@ -165,39 +164,39 @@ be uploaded and the URL at which each file will be
published. See
When NO-CONFIRM is non-nil, upload without prompting.
Interactively, with one universal prefix argument
-\\[universal-argument], prompt for predicate, otherwise mirror
+\\[universal-argument], prompt for filter, otherwise mirror
all files. With two universal prefix arguments
\\[universal-argument] \\[universal-argument], prompt for
-predicate and set NO-CONFIRM to t."
+filter and set NO-CONFIRM to t."
(interactive
(let ((source (read-directory-name "Mirror directory: " nil nil t))
- (hyperdrive (hyperdrive-complete-hyperdrive :predicate
#'hyperdrive-writablep
- :force-prompt t)))
+ (hyperdrive (h/complete-hyperdrive :predicate #'h/writablep
+ :force-prompt t)))
(list source hyperdrive
;; TODO: Get path from any visible hyperdrive-dir buffer and
;; auto-fill (or add as "future history") in target-dir prompt.
- :target-dir (hyperdrive-read-path :hyperdrive hyperdrive :prompt
"Target directory in «%s»" :default "/")
+ :target-dir (h/read-path :hyperdrive hyperdrive :prompt "Target
directory in `%s'" :default "/")
:no-confirm (equal '(16) current-prefix-arg)
- :predicate (if current-prefix-arg
- (hyperdrive-mirror-read-predicate)
- #'always))))
+ :filter (if current-prefix-arg
+ (h/mirror-read-filter)
+ #'always))))
(cl-callf expand-file-name source)
- (setf target-dir (hyperdrive--format-path target-dir :directoryp t))
- (when (stringp predicate)
- (let ((regexp predicate))
- (setf predicate (lambda (filename)
- (string-match-p regexp filename)))))
- (let* ((files (cl-remove-if-not predicate (directory-files-recursively
source ".")))
- (parent-entry (hyperdrive-entry-create :hyperdrive hyperdrive :path
target-dir))
+ (setf target-dir (h//format-path target-dir :directoryp t))
+ (when (stringp filter)
+ (let ((regexp filter))
+ (setf filter (lambda (filename)
+ (string-match-p regexp filename)))))
+ (let* ((files (cl-remove-if-not filter (directory-files-recursively source
".")))
+ (parent-entry (he/create :hyperdrive hyperdrive :path target-dir))
(buffer (unless no-confirm
(get-buffer-create "*hyperdrive-mirror*")))
(num-filled 0)
(num-of (length files))
metadata-queue files-and-urls)
(unless files
- (hyperdrive-user-error "No files selected for mirroring (double-check
predicate)"))
+ (h/user-error "No files selected for mirroring (double-check filter)"))
(if no-confirm
- (hyperdrive--mirror files-and-urls parent-entry)
+ (h//mirror files-and-urls parent-entry)
(with-current-buffer buffer
(with-silent-modifications
(cl-labels ((update-progress (num-filled num-of)
@@ -207,34 +206,34 @@ predicate and set NO-CONFIRM to t."
(erase-buffer)
(insert (propertize (format "Comparing files
(%s/%s)..." num-filled num-of)
'face
'font-lock-comment-face)))))))
- (hyperdrive-mirror-mode)
- (setq-local hyperdrive-mirror-query
- `(,source ,hyperdrive :target-dir ,target-dir
:predicate ,predicate)
- hyperdrive-mirror-parent-entry parent-entry)
+ (h/mirror-mode)
+ (setq-local h/mirror-query
+ `(,source ,hyperdrive :target-dir ,target-dir :filter
,filter)
+ h/mirror-parent-entry parent-entry)
;; TODO: Add command to clear plz queue.
(setf metadata-queue
(make-plz-queue
- :limit hyperdrive-queue-limit
+ :limit h/queue-limit
:finally (lambda ()
- (hyperdrive-mirror--metadata-finally
+ (h/mirror--metadata-finally
buffer
(sort files-and-urls
(pcase-lambda ((cl-struct
hyperdrive-mirror-item (file a-file))
(cl-struct
hyperdrive-mirror-item (file b-file)))
(string< a-file b-file)))))))
(dolist (file files)
- (let ((entry (hyperdrive-entry-create
+ (let ((entry (he/create
:hyperdrive hyperdrive
:path (expand-file-name (file-relative-name file
source) target-dir))))
- (hyperdrive-fill entry :queue metadata-queue
+ (h/fill entry :queue metadata-queue
:then (lambda (entry)
- (let* ((drive-mtime (floor (float-time
(hyperdrive-entry-mtime entry))))
+ (let* ((drive-mtime (floor (float-time (he/mtime
entry))))
(local-mtime (floor (float-time
(file-attribute-modification-time (file-attributes file)))))
(status (cond
((time-less-p drive-mtime
local-mtime) 'newer)
((time-equal-p drive-mtime
local-mtime) 'same)
(t 'older)))
- (url (hyperdrive-entry-url entry)))
+ (url (he/url entry)))
(push (make-hyperdrive-mirror-item :file file :url
url :status status)
files-and-urls)
(update-progress (cl-incf num-filled) num-of)))
@@ -242,18 +241,18 @@ predicate and set NO-CONFIRM to t."
(let ((status-code (plz-response-status
(plz-error-response plz-error))))
(pcase status-code
(404 ;; Entry doesn't exist: Set `status' to
`new'".
- ;; TODO: Consider moving
`hyperdrive-update-nonexistent-version-range' call...
- (hyperdrive-update-nonexistent-version-range
entry)
+ ;; TODO: Consider moving
`h/update-nonexistent-version-range' call...
+ (h/update-nonexistent-version-range entry)
(push (make-hyperdrive-mirror-item
- :file file :url (hyperdrive-entry-url
entry) :status 'new)
+ :file file :url (he/url entry) :status
'new)
files-and-urls)
(update-progress (cl-incf num-filled) num-of))
(_
- (hyperdrive-error "Unable to get metadata for
URL \"%s\": %S"
- (hyperdrive-entry-url entry)
plz-error))))))))
+ (h/error "Unable to get metadata for URL
\"%s\": %S"
+ (he/url entry) plz-error))))))))
(pop-to-buffer (current-buffer))))))))
-(defun hyperdrive-mirror--metadata-finally (buffer files-and-urls)
+(defun h/mirror--metadata-finally (buffer files-and-urls)
"Insert FILES-AND-URLS into BUFFER.
Callback for queue finalizer in `hyperdrive-mirror'."
(with-current-buffer buffer
@@ -265,24 +264,24 @@ Callback for queue finalizer in `hyperdrive-mirror'."
(uploadable (cl-remove-if-not (lambda (status)
(member status '(new newer)))
files-and-urls
- :key
#'hyperdrive-mirror-item-status))
+ :key #'h/mirror-item-status))
(non-uploadable (cl-remove-if-not (lambda (status)
(member status '(older same)))
files-and-urls
- :key
#'hyperdrive-mirror-item-status)))
- (setq-local hyperdrive-mirror-files-and-urls files-and-urls)
+ :key #'h/mirror-item-status)))
+ (setq-local h/mirror-files-and-urls files-and-urls)
(when-let ((window (get-buffer-window (current-buffer))))
(setf window-point (window-point window)
window-start (window-start window)))
- (when hyperdrive-mirror-visibility-cache
- (setf magit-section-visibility-cache
hyperdrive-mirror-visibility-cache))
- (add-hook 'kill-buffer-hook #'hyperdrive-mirror--cache-visibility nil
'local)
+ (when h/mirror-visibility-cache
+ (setf magit-section-visibility-cache h/mirror-visibility-cache))
+ (add-hook 'kill-buffer-hook #'h/mirror--cache-visibility nil 'local)
(delete-all-overlays)
(erase-buffer)
(when non-uploadable
- (hyperdrive-mirror--insert-taxy :name "Ignored" :items
non-uploadable))
+ (h/mirror--insert-taxy :name "Ignored" :items non-uploadable))
(when uploadable
- (hyperdrive-mirror--insert-taxy :name "To upload" :items uploadable))
+ (h/mirror--insert-taxy :name "To upload" :items uploadable))
(if-let ((section-ident)
(section (magit-get-section section-ident)))
(goto-char (oref section start))
@@ -292,8 +291,8 @@ Callback for queue finalizer in `hyperdrive-mirror'."
(set-window-point window window-point))))
(set-buffer-modified-p nil)))
-(cl-defun hyperdrive-mirror--insert-taxy
- (&key items name (keys hyperdrive-mirror-default-keys))
+(cl-defun h/mirror--insert-taxy
+ (&key items name (keys h/mirror-default-keys))
"Insert and return a `taxy' for `hyperdrive-mirror', optionally having ITEMS.
NAME is the name of the section. KEYS should be a list of
grouping keys, as in `hyperdrive-mirror-default-keys'."
@@ -310,7 +309,7 @@ grouping keys, as in `hyperdrive-mirror-default-keys'."
(taxy
(thread-last
(make-fn :name name
- :take (taxy-make-take-function keys
hyperdrive-mirror-keys))
+ :take (taxy-make-take-function keys h/mirror-keys))
(taxy-fill items)
(taxy-sort* (lambda (a b)
(pcase a
@@ -328,71 +327,78 @@ grouping keys, as in `hyperdrive-mirror-default-keys'."
#'taxy-name)))
(format-cons
(taxy-magit-section-format-items
- hyperdrive-mirror-columns hyperdrive-mirror-column-formatters
+ h/mirror-columns h/mirror-column-formatters
taxy))
(inhibit-read-only t))
(setf format-table (car format-cons)
column-sizes (cdr format-cons)
header-line-format (taxy-magit-section-format-header
- column-sizes
hyperdrive-mirror-column-formatters))
+ column-sizes h/mirror-column-formatters))
;; Before this point, no changes have been made to the buffer's
contents.
(save-excursion
(taxy-magit-section-insert taxy :items 'first :initial-depth 0))
taxy))))
-(defun hyperdrive-mirror-read-predicate ()
+(defun h/mirror-read-filter ()
"Read a function for filtering source files for mirroring."
(let* ((readers
- '(("Mirror all files" .
- (lambda () #'always))
- ("`rx' form" .
- (lambda () (eval (read--expression "`rx' form: " "(rx )"))))
+ '(("Mirror all files" . nil)
("Regexp string" .
(lambda () (read-regexp "Regular expression: ")))
("Lambda function" .
(lambda () (read--expression "Lambda: " "(lambda (filename) )")))
("Named function" .
- (lambda () (completing-read "Named function: " obarray
#'functionp t)))))
- (reader (completing-read "Predicate type: " readers)))
- (funcall (alist-get reader readers nil nil #'equal))))
-
-(defun hyperdrive-mirror-do-upload ()
+ (lambda () (intern (completing-read "Named function: " obarray
#'functionp t))))))
+ ;; TODO(transient): Implement returning values from prefixes,
+ ;; allowing us to use a sub-prefix here instead of completing-read.
+ (reader (completing-read "Filter type: " readers nil t))
+ (reader (alist-get reader readers nil nil #'equal)))
+ (and reader (funcall reader))))
+
+(defun h/mirror-do-upload ()
"Upload files in current \"*hyperdrive-mirror*\" buffer."
- (declare (modes hyperdrive-mirror-mode))
- (interactive)
+ (interactive nil h/mirror-mode)
;; FIXME: Debounce this (e.g. if the user accidentally calls this
;; command twice in a mirror buffer, it would start another queue to
;; upload the same files, which would unnecessarily increment the
;; hyperdrive version by potentially a lot).
- (if (and hyperdrive-mirror-files-and-urls hyperdrive-mirror-parent-entry)
- (hyperdrive--mirror hyperdrive-mirror-files-and-urls
hyperdrive-mirror-parent-entry)
- (hyperdrive-user-error "Missing information about files to upload. Are
you in a \"*hyperdrive-mirror*\" buffer?")))
+ (if (and h/mirror-files-and-urls h/mirror-parent-entry)
+ (h//mirror h/mirror-files-and-urls h/mirror-parent-entry)
+ (h/user-error "Missing information about files to upload. Are you in a
\"*hyperdrive-mirror*\" buffer?")))
-(defun hyperdrive-mirror--cache-visibility ()
+(defun h/mirror--cache-visibility ()
"Save visibility cache.
Sets `hyperdrive-mirror-visibility-cache' to the value of
`magit-section-visibility-cache'. To be called in
`kill-buffer-hook' in `hyperdrive-mirror' buffers."
(ignore-errors
(when magit-section-visibility-cache
- (setf hyperdrive-mirror-visibility-cache
magit-section-visibility-cache))))
+ (setf h/mirror-visibility-cache magit-section-visibility-cache))))
;;;; Mode
-(defvar-keymap hyperdrive-mirror-mode-map
+(defvar-keymap h/mirror-mode-map
:parent magit-section-mode-map
:doc "Local keymap for `hyperdrive-mirror-mode' buffers."
- "C-c C-c" #'hyperdrive-mirror-do-upload)
+ "C-c C-c" #'h/mirror-do-upload)
-(define-derived-mode hyperdrive-mirror-mode magit-section-mode
+(define-derived-mode h/mirror-mode magit-section-mode
"Hyperdrive-mirror"
"Major mode for buffers for mirror local directories to a hyperdrive."
:group 'hyperdrive
:interactive nil
;; TODO: When possible, use vtable.el (currently only available in Emacs
>=29) (or maybe taxy-magit-section)
- (setq revert-buffer-function #'hyperdrive-mirror-revert-buffer))
+ (setq revert-buffer-function #'h/mirror-revert-buffer))
;;;; Footer
-(provide 'hyperdrive-mirror)
+(provide 'h/mirror)
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
;;; hyperdrive-mirror.el ends here
diff --git a/hyperdrive-org.el b/hyperdrive-org.el
index 235a729b20..5bf48321e4 100644
--- a/hyperdrive-org.el
+++ b/hyperdrive-org.el
@@ -31,12 +31,12 @@
(require 'hyperdrive-lib)
-(defvar hyperdrive-mode)
+(defvar h/mode)
-(declare-function hyperdrive-open-url "hyperdrive")
-(declare-function hyperdrive-dir--entry-at-point "hyperdrive-dir")
+(declare-function h/open-url "hyperdrive")
+(declare-function h/dir--entry-at-point "hyperdrive-dir")
-(defcustom hyperdrive-org-link-full-url nil
+(defcustom h/org-link-full-url nil
"Always insert full \"hyper://\" URLs when linking to hyperdrive files.
Otherwise, when inserting a link to the same hyperdrive Org file,
@@ -56,30 +56,28 @@ hyperdrive, insert a relative or absolute link according to
"Store an Org link to the entry at point in current Org buffer.
To be called by `org-store-link'. Calls `org-link-store-props',
which see."
- (when hyperdrive-current-entry
+ (when h/current-entry
(pcase-let (((map type link description)
(pcase major-mode
- ('org-mode (hyperdrive--org-link))
- ('hyperdrive-dir-mode
- (let ((entry (hyperdrive-dir--entry-at-point)))
+ ('org-mode (h/org--link))
+ ('h/dir-mode
+ (let ((entry (h/dir--entry-at-point)))
`((type . "hyper://")
- (link . ,(hyperdrive-entry-url entry))
- (description . ,(hyperdrive-entry-description
entry)))))
+ (link . ,(he/url entry))
+ (description . ,(h//format-entry entry)))))
(_ `((type . "hyper://")
- (link . ,(hyperdrive-entry-url
hyperdrive-current-entry))
- (description . ,(hyperdrive-entry-description
hyperdrive-current-entry)))))))
+ (link . ,(he/url h/current-entry))
+ (description . ,(h//format-entry h/current-entry)))))))
(org-link-store-props :type type :link link :description description)
t)))
-(defun hyperdrive--org-link (&optional raw-url-p)
+(defun h/org--link (&optional raw-url-p)
"Return Org alist for current Org buffer.
Attempts to link to the entry at point. If RAW-URL-P, return a
raw URL, not an Org link."
- ;; NOTE: We would like to return a plist rather than an alist, but
- ;; the version of `map' included with Emacs 27 doesn't support that,
- ;; and depending on a later version won't force Emacs to actually
- ;; use it when compiling this package, so for now we avoid
- ;; destructuring plists with `pcase-let'.
+ ;; TODO: Since we depend on Emacs 28 now, we can rely on `map'
+ ;; being able to destructure a plist inside `pcase-let', so we
+ ;; should switch to using a plist instead of an alist.
;; NOTE: Ideally we would simply reuse Org's internal functions to
;; store links, like `org-store-link'. However, its API is not
;; designed to be used by external libraries, and requires ugly
@@ -91,14 +89,14 @@ raw URL, not an Org link."
;; The URL's "fragment" (aka "target" in org-link jargon) is the
;; CUSTOM_ID if it exists or headline search string if it exists.
(cl-assert (eq 'org-mode major-mode))
- (when hyperdrive-mode
+ (when h/mode
(let* ((heading (org-entry-get (point) "ITEM"))
(custom-id (org-entry-get (point) "CUSTOM_ID"))
(fragment (cond (custom-id (concat "#" custom-id))
(heading (concat "*" heading))))
- (entry-copy (hyperdrive-copy-tree hyperdrive-current-entry t))
- (_ (setf (alist-get 'target (hyperdrive-entry-etc entry-copy))
fragment))
- (raw-url (hyperdrive-entry-url entry-copy)))
+ (entry-copy (h/copy-tree h/current-entry t))
+ (_ (setf (alist-get 'target (he/etc entry-copy)) fragment))
+ (raw-url (he/url entry-copy)))
(if raw-url-p
raw-url
;; NOTE: Due to annoying issues with older versions of Emacs
@@ -112,30 +110,29 @@ raw URL, not an Org link."
"Follow hyperdrive URL."
;; Add "hyper:" prefix because Org strips the prefix for links that
;; have been configured with `org-link-set-parameters'.
- (hyperdrive-open (hyperdrive-url-entry (concat "hyper:" url))))
+ (h/open (h/url-entry (concat "hyper:" url))))
-(defun hyperdrive--org-link-goto (target)
+(defun h/org--link-goto (target)
"Go to TARGET in current Org buffer.
TARGET may be a CUSTOM_ID or a headline."
(cl-assert (eq 'org-mode major-mode))
(org-link-search target))
-(defun hyperdrive-org-link-complete ()
+(defun h/org-link-complete ()
"Create a hyperdrive org link."
;; TODO: Support other hyper:// links like diffs when implemented.
- (hyperdrive-entry-url (hyperdrive-read-entry :read-version t)))
+ (he/url (h/read-entry :read-version t)))
-;; TODO: hyperdrive--org-* or hyperdrive-org--*?
-
-(defun hyperdrive--org-open-at-point ()
+(defun h/org--open-at-point ()
"Handle relative links in hyperdrive-mode org files.
Added to `org-open-at-point-functions' in order to short-circuit
the logic for handling links of \"file\" type."
- (when hyperdrive-mode
- (hyperdrive-open (hyperdrive--org-link-entry-at-point))))
+ (when-let ((h/mode)
+ (link (h/org--link-entry-at-point)))
+ (h/open link)))
-(defun hyperdrive--org-link-entry-at-point ()
+(defun h/org--link-entry-at-point ()
"Return a hyperdrive entry for the Org link at point."
;; This function is not in the code path for full URLs or links that
;; are only search options.
@@ -148,40 +145,40 @@ the logic for handling links of \"file\" type."
;; Don't treat link as a relative/absolute path in the
;; hyperdrive if "file:" protocol prefix is explicit.
(not (string-prefix-p "file:" raw-link-type)))
- (pcase-let* (((cl-struct hyperdrive-entry hyperdrive path)
hyperdrive-current-entry)
- (entry (hyperdrive-entry-create
+ (pcase-let* (((cl-struct hyperdrive-entry hyperdrive path)
h/current-entry)
+ (entry (he/create
:hyperdrive hyperdrive
:path (expand-file-name (org-element-property :path
context)
(file-name-directory path))
:etc `((target . ,(org-element-property
:search-option context))))))
entry))))
-(defun hyperdrive--org-insert-link-after-advice (&rest _)
+(defun h/org--insert-link-after-advice (&rest _)
"Modify just-inserted link as appropriate for `hyperdrive-mode' buffers."
- (when (and hyperdrive-mode hyperdrive-current-entry)
+ (when (and h/mode h/current-entry)
(let* ((link-element (org-element-context))
(_ (cl-assert (eq 'link (car link-element))))
(url (org-element-property :raw-link link-element))
- (desc (hyperdrive--org-link-description link-element))
- (target-entry (hyperdrive-url-entry url)))
- (when (and (not hyperdrive-org-link-full-url)
- (hyperdrive-entry-hyperdrive-equal-p
- hyperdrive-current-entry target-entry))
+ (desc (h/org--link-description link-element))
+ (target-entry (h/url-entry url)))
+ (when (and (not h/org-link-full-url)
+ (he/hyperdrive-equal-p
+ h/current-entry target-entry))
(delete-region (org-element-property :begin link-element)
(org-element-property :end link-element))
(insert (org-link-make-string
- (hyperdrive--org-shorthand-link target-entry)
+ (h/org--shorthand-link target-entry)
desc))))))
-(cl-defun hyperdrive--org-shorthand-link (entry)
+(cl-defun h/org--shorthand-link (entry)
"Return a non-\"hyper://\"-prefixed link to ENTRY.
Respects `hyperdrive-org-link-full-url' and `org-link-file-path-type'."
- ;; FIXME: Docstring, maybe move details from `hyperdrive-org-link-full-url'.
- (cl-assert hyperdrive-current-entry)
- (let ((search-option (alist-get 'target (hyperdrive-entry-etc entry))))
+ ;; FIXME: Docstring, maybe move details from `h/org-link-full-url'.
+ (cl-assert h/current-entry)
+ (let ((search-option (alist-get 'target (he/etc entry))))
(when (and search-option
- (hyperdrive-entry-equal-p hyperdrive-current-entry entry))
- (cl-return-from hyperdrive--org-shorthand-link search-option))
+ (he/equal-p h/current-entry entry))
+ (cl-return-from h/org--shorthand-link search-option))
;; Search option alone: Remove leading "::"
(when search-option
@@ -191,9 +188,9 @@ Respects `hyperdrive-org-link-full-url' and
`org-link-file-path-type'."
;; See the `adaptive' option in `org-link-file-path-type'.
(string-prefix-p
(file-name-directory
- (hyperdrive-entry-path hyperdrive-current-entry))
- (hyperdrive-entry-path entry))))
- (hyperdrive--ensure-dot-slash-prefix-path
+ (he/path h/current-entry))
+ (he/path entry))))
+ (h//ensure-dot-slash-prefix-path
(concat
(pcase org-link-file-path-type
;; TODO: Handle `org-link-file-path-type' as a function.
@@ -203,20 +200,23 @@ Respects `hyperdrive-org-link-full-url' and
`org-link-file-path-type'."
;; no home directory.
'noabbrev
(and 'adaptive (guard (not adaptive-target-p))))
- (hyperdrive-entry-path entry))
+ (he/path entry))
((or 'relative (and 'adaptive (guard adaptive-target-p)))
(file-relative-name
- (hyperdrive-entry-path entry)
- (file-name-directory (hyperdrive-entry-path
hyperdrive-current-entry)))))
+ (he/path entry)
+ (file-name-directory (he/path h/current-entry)))))
search-option)))))
-(defun hyperdrive--org-link-description (link)
+(defun h/org--link-description (link)
"Return description of Org LINK or nil if it has none."
;; TODO: Is there a built-in solution?
(when-let* ((desc-begin (org-element-property :contents-begin link))
(desc-end (org-element-property :contents-end link)))
(buffer-substring desc-begin desc-end)))
+;; NOTE: Autoloads do not support shorthands (yet?), so we use the full symbol
+;; names below.
+;; TODO: Report Emacs bug about autoloads and symbol shorthands.
;;;###autoload
(with-eval-after-load 'org
(org-link-set-parameters "hyper"
@@ -224,13 +224,20 @@ Respects `hyperdrive-org-link-full-url' and
`org-link-file-path-type'."
:follow #'hyperdrive-org-link-follow
:complete #'hyperdrive-org-link-complete)
(with-eval-after-load 'hyperdrive
- ;; Handle links with no specified type in `hyperdrive-mode'
- ;; buffers as links to files within that hyperdrive. Only add
- ;; this function to the variable after `hyperdrive' is loaded so
- ;; that `hyperdrive-mode' will be defined.
- (cl-pushnew #'hyperdrive--org-open-at-point org-open-at-point-functions)))
+ ;; Handle links with no specified type in `hyperdrive-mode' buffers as
links
+ ;; to files within that hyperdrive. Only add this function to the variable
+ ;; after `hyperdrive' is loaded so that `hyperdrive-mode' will be defined.
+ (cl-pushnew #'hyperdrive-org--open-at-point org-open-at-point-functions)))
;;;; Footer
(provide 'hyperdrive-org)
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
;;; hyperdrive-org.el ends here
diff --git a/hyperdrive-vars.el b/hyperdrive-vars.el
index 62d9d6f7dd..7a72b1ae57 100644
--- a/hyperdrive-vars.el
+++ b/hyperdrive-vars.el
@@ -38,15 +38,15 @@
:group 'external
:prefix "hyperdrive-")
-(defcustom hyperdrive-hyper-gateway-port 4973
+(defcustom h/hyper-gateway-port 4973
"Port on which to run the hyper-gateway server."
:type 'natnum)
-(defcustom hyperdrive-honor-auto-mode-alist t
+(defcustom h/honor-auto-mode-alist t
"If non-nil, use file extension of hyperdrive file to set `major-mode'."
:type 'boolean)
-(defcustom hyperdrive-persist-location nil
+(defcustom h/persist-location nil
;; TODO: Consider using XDG locations for this, as well as storing
;; -hyperdrives separately from -version-ranges. (Note that
;; xdg-state-home is only in Emacs 29+ and is not in compat.)
@@ -57,7 +57,7 @@
:type '(choice (const :tag "Use default persist location" nil)
(file :tag "Custom location")))
-(defcustom hyperdrive-download-directory
+(defcustom h/download-directory
(expand-file-name
(if (bound-and-true-p eww-download-directory)
(if (stringp eww-download-directory)
@@ -68,21 +68,21 @@
Defaults to `eww-download-directory'."
:type '(file :must-match t))
-(defvar hyperdrive-timestamp-width)
-(defcustom hyperdrive-timestamp-format "%x %X"
+(defvar h/timestamp-width)
+(defcustom h/timestamp-format "%x %X"
"Format string used for timestamps.
Passed to `format-time-string', which see."
:type 'string
:set (lambda (option value)
(set-default option value)
- (setf hyperdrive-timestamp-width
+ (setf h/timestamp-width
;; FIXME: This value varies based on current
;; time. (format-time-string "%-I") will
;; be one or two characters long
;; depending on the time of day
(string-width (format-time-string value)))))
-(defcustom hyperdrive-directory-display-buffer-action
+(defcustom h/directory-display-buffer-action
'(display-buffer-same-window)
"Display buffer action for hyperdrive directories.
Passed to `display-buffer', which see."
@@ -91,7 +91,7 @@ Passed to `display-buffer', which see."
(const :tag "Pop up window" (display-buffer-pop-up-window))
(sexp :tag "Other")))
-(defcustom hyperdrive-directory-sort '(name . :ascending)
+(defcustom h/directory-sort '(name . :ascending)
"Column by which directory entries are sorted.
Internally, a cons cell of (COLUMN . DIRECTION), the COLUMN being
one of the directory listing columns (\\+`name', \\+`size', or
@@ -110,7 +110,7 @@ one of the directory listing columns (\\+`name', \\+`size',
or
(const :tag "Ascending" :ascending)
(const :tag "Descending" :descending)))))
-(defcustom hyperdrive-history-display-buffer-action
+(defcustom h/history-display-buffer-action
'(display-buffer-same-window)
"Display buffer action for hyperdrive history buffers.
Passed to `display-buffer', which see."
@@ -118,23 +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
- '(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
-used."
- :type '(repeat
- (choice (const :tag "Petname" petname)
- (const :tag "Nickname"
- :doc "(Nickname specified by hyperdrive author)"
- :format "%t %h"
- nickname)
- (const :tag "DNSLink domain" domain)
- (const :tag "Seed" seed)
- (const :tag "Shortened public key" short-key)
- (const :tag "Full public key" public-key))))
-
-(defcustom hyperdrive-stream-player-command "mpv --force-window=immediate %s"
+(defcustom h/stream-player-command "mpv --force-window=immediate %s"
"Command used to play streamable URLs externally.
In the command, \"%s\" is replaced with the URL (it should not be
quoted, because the arguments are passed directly rather than
@@ -143,21 +127,21 @@ through a shell)."
(const :tag "VLC" "vlc %s")
(string :tag "Other command")))
-(defcustom hyperdrive-queue-limit 20
+(defcustom h/queue-limit 20
"Default size of request queues."
;; TODO: Consider a separate option for metadata queue size (e.g. used in
the dir handler).
;; TODO: Consider a separate option for upload queue size, etc.
:type 'natnum)
-(defcustom hyperdrive-fill-version-ranges-limit 100
+(defcustom h/fill-version-ranges-limit 100
"Default maximum number of requests when filling version history."
:type 'natnum)
-(defcustom hyperdrive-render-html t
+(defcustom h/render-html t
"Render HTML hyperdrive files with EWW."
:type 'boolean)
-(defcustom hyperdrive-reuse-buffers 'any-version
+(defcustom h/reuse-buffers 'any-version
"How to reuse buffers when showing entries.
When \\+`any-version', try to reuse an existing buffer showing the
same entry at any version. When \\+`same-version', try to reuse
@@ -165,75 +149,192 @@ 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 h/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
+used."
+ :type '(repeat
+ (choice (const :tag "Petname" petname)
+ (const :tag "Nickname"
+ :doc "(Nickname specified by hyperdrive author)"
+ :format "%t %h"
+ nickname)
+ (const :tag "DNSLink domain" domain)
+ (const :tag "Seed" seed)
+ (const :tag "Shortened public key" short-key)
+ (const :tag "Full public key" public-key))))
+
+(defcustom h/default-entry-format "[%H] %p%v"
+ "Format string for displaying entries.
+Specifiers:
+
+%H Preferred hyperdrive format (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 h/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 h/buffer-name-format "[%H] %n%v"
+ "Format string for buffer names.
+Specifiers are as in `hyperdrive-default-entry-format', which
+see."
+ :type 'string)
+
+(defvar h/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 h/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
"Faces shown in directory listings."
:group 'hyperdrive)
-(defface hyperdrive-petname '((t :inherit font-lock-type-face))
+(defface h/petname '((t :inherit font-lock-type-face))
"Applied to hyperdrive petnames.")
-(defface hyperdrive-seed '((t :inherit font-lock-doc-face))
+(defface h/seed '((t :inherit font-lock-doc-face))
"Applied to hyperdrive seeds.")
-(defface hyperdrive-domain '((t :inherit font-lock-keyword-face))
+(defface h/domain '((t :inherit font-lock-keyword-face))
"Applied to hyperdrive domains.")
-(defface hyperdrive-nickname '((t :inherit font-lock-warning-face))
+(defface h/nickname '((t :inherit font-lock-warning-face))
"Applied to hyperdrive nicknames.")
-(defface hyperdrive-public-key '((t :inherit font-lock-function-name-face))
+(defface h/public-key '((t :inherit font-lock-function-name-face))
"Applied to hyperdrive public keys.")
-(defface hyperdrive-header '((t (:inherit dired-header)))
+(defface h/file-name '((t :inherit font-lock-keyword-face)) ; TODO theme
+ "Applied to file names.")
+
+(defface h/dimmed '((t :inherit shadow))
+ "Applied to text in transient menus that should be dimmed.")
+
+(defface h/header '((t (:inherit dired-header)))
"Directory path.")
-(defface hyperdrive-column-header '((t (:inherit underline)))
+(defface h/column-header '((t (:inherit underline)))
"Column header.")
-(defface hyperdrive-selected-column-header '((t ( :inherit underline
- :weight bold)))
+(defface h/selected-column-header '((t ( :inherit underline
+ :weight bold)))
"Selected column header.")
-(defface hyperdrive-directory '((t (:inherit dired-directory)))
+(defface h/directory '((t (:inherit dired-directory)))
"Subdirectories.")
-(defface hyperdrive-size '((t (:inherit font-lock-doc-face)))
+(defface h/size '((t (:inherit font-lock-doc-face)))
"Size of entries.")
-(defface hyperdrive-timestamp '((t (:inherit default)))
+(defface h/timestamp '((t (:inherit default)))
"Entry timestamp.")
-(defface hyperdrive-header-arrow '((t (:inherit bold)))
+(defface h/header-arrow '((t (:inherit bold)))
"Header arrows.")
-(defface hyperdrive-history-range '((t (:inherit font-lock-escape-face)))
+(defface h/history-range '((t (:inherit font-lock-escape-face)))
"Version range in `hyperdrive-history' buffers.")
-(defface hyperdrive-history-existent '((t :inherit success))
+(defface h/history-existent '((t :inherit success))
"Marker for known existent entries in `hyperdrive-history'buffers.")
-(defface hyperdrive-history-nonexistent '((t :inherit error))
+(defface h/history-nonexistent '((t :inherit error))
"Marker for known nonexistent entries in `hyperdrive-history'buffers.")
-(defface hyperdrive-history-unknown '((t :inherit warning))
+(defface h/history-unknown '((t :inherit warning))
"Marker for entries with unknown existence in `hyperdrive-history' buffers.")
;;;;; Regular expressions
(eval-and-compile
- (defconst hyperdrive--hyper-prefix "hyper://"
+ (defconst h//hyper-prefix "hyper://"
"Hyperdrive URL prefix."))
-(defconst hyperdrive--public-key-re
- (rx (eval hyperdrive--hyper-prefix) (group (= 52 alphanumeric)))
+(defconst h//public-key-re
+ (rx (eval h//hyper-prefix) (group (= 52 alphanumeric)))
"Regexp to match \"hyper://\" + public key.
Capture group matches public key.")
-(defconst hyperdrive--version-re
- (rx (eval hyperdrive--hyper-prefix)
+(defconst h//version-re
+ (rx (eval h//hyper-prefix)
(one-or-more alnum)
(group "+" (one-or-more num)))
"Regexp to match \"hyper://\" + public key or seed + version number.
@@ -248,20 +349,20 @@ Capture group matches version number.")
;; To work around this, we set the default value to nil and initialize
;; it to a hash table "manually".
;; TODO: See persist.el patch:
<https://debbugs.gnu.org/cgi/bugreport.cgi?bug=63513>
-(persist-defvar hyperdrive-hyperdrives nil
+(persist-defvar h/hyperdrives nil
"List of known hyperdrives."
- hyperdrive-persist-location)
-(unless hyperdrive-hyperdrives
- (setf hyperdrive-hyperdrives (make-hash-table :test #'equal)))
+ h/persist-location)
+(unless h/hyperdrives
+ (setf h/hyperdrives (make-hash-table :test #'equal)))
-(persist-defvar hyperdrive-version-ranges nil
+(persist-defvar h/version-ranges nil
"Hash table of hyperdrive version ranges.
Keys are generated by `hyperdrive--entry-version-range-key', and
values are alists mapping version range starts to plists with
`:existsp' and `:range-end' keys."
- hyperdrive-persist-location)
-(unless hyperdrive-version-ranges
- (setf hyperdrive-version-ranges (make-hash-table :test #'equal)))
+ h/persist-location)
+(unless h/version-ranges
+ (setf h/version-ranges (make-hash-table :test #'equal)))
;; TODO: Flesh out the persist hook.
;; (defvar hyperdrive-persist-hook nil
@@ -269,31 +370,31 @@ values are alists mapping version range starts to plists
with
;;;;; Internals
-(defvar-local hyperdrive-current-entry nil
+(defvar-local h/current-entry nil
"Entry for current buffer.")
-(put 'hyperdrive-current-entry 'permanent-local t)
+(put 'h/current-entry 'permanent-local t)
-(defvar hyperdrive-type-handlers
+(defvar h/type-handlers
`(
;; Directories are sent from the gateway as JSON arrays
- ("application/json" . hyperdrive-handler-json)
- (,(rx bos "audio/") . hyperdrive-handler-streamable)
- (,(rx bos "video/") . hyperdrive-handler-streamable)
- (,(rx bos "image/") . hyperdrive-handler-image)
- (,(rx (or "text/html" "application/xhtml+xml")) . hyperdrive-handler-html))
+ ("application/json" . h/handler-json)
+ (,(rx bos "audio/") . h/handler-streamable)
+ (,(rx bos "video/") . h/handler-streamable)
+ (,(rx bos "image/") . h/handler-image)
+ (,(rx (or "text/html" "application/xhtml+xml")) . h/handler-html))
"Alist mapping MIME types to handler functions.
Keys are regexps matched against MIME types.")
-(defvar hyperdrive-dir-sort-fields
- '((size :accessor hyperdrive-entry-size
+(defvar h/dir-sort-fields
+ '((size :accessor he/size
:ascending <
:descending >
:desc "Size")
- (mtime :accessor hyperdrive-entry-mtime
+ (mtime :accessor he/mtime
:ascending time-less-p
- :descending hyperdrive-time-greater-p
+ :descending h/time-greater-p
:desc "Last Modified")
- (name :accessor hyperdrive-entry-name
+ (name :accessor he/name
:ascending string<
:descending string>
:desc "Name"))
@@ -302,4 +403,12 @@ Keys are regexps matched against MIME types.")
;;;; Footer
(provide 'hyperdrive-vars)
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
;;; hyperdrive-vars.el ends here
diff --git a/hyperdrive.el b/hyperdrive.el
index 1c613df169..c07d4e47d0 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -7,7 +7,7 @@
;; Maintainer: Joseph Turner <~ushin/ushin@lists.sr.ht>
;; Created: 2022
;; Version: 0.3-pre
-;; Package-Requires: ((emacs "27.1") (map "3.0") (compat "29.1.4.0") (plz
"0.7") (persist "0.5") (taxy-magit-section "0.12.1") (transient "0.4.3"))
+;; Package-Requires: ((emacs "28.1") (map "3.0") (compat "29.1.4.0") (plz
"0.7") (persist "0.5") (taxy-magit-section "0.12.1") (transient "0.5.0"))
;; Homepage: https://git.sr.ht/~ushin/hyperdrive.el
;; This program is free software; you can redistribute it and/or
@@ -33,7 +33,7 @@
;;;; Installation:
-;; hyperdrive.el requires Emacs version 27.1 or later.
+;; hyperdrive.el requires Emacs version 28.1 or later.
;; hyperdrive.el is available on MELPA:
;; https://melpa.org/#/getting-started
@@ -49,9 +49,6 @@
;;; Code:
-;; TODO: When requiring Emacs 28+, consider using symbol shorthands to
-;; reduce how many times we have to type "hyperdrive".
-
;;;; Requirements
(require 'cl-lib)
@@ -81,17 +78,16 @@
(defvar browse-url-handlers)
(defvar thing-at-point-uri-schemes)
-(defun hyperdrive-browse-url (url &rest _ignore)
+(defun h/browse-url (url &rest _ignore)
"Browse hyperdrive URL."
- (hyperdrive-open-url url))
+ (h/open-url url))
-(when (version<= "28.1" emacs-version)
- (require 'browse-url)
- (require 'thingatpt)
+(require 'browse-url)
+(require 'thingatpt)
- (cl-pushnew (cons (rx bos "hyper://") #'hyperdrive-browse-url)
- browse-url-handlers :test #'equal)
- (cl-pushnew "hyper://" thing-at-point-uri-schemes :test #'equal))
+(cl-pushnew (cons (rx bos "hyper://") #'h/browse-url)
+ browse-url-handlers :test #'equal)
+(cl-pushnew "hyper://" thing-at-point-uri-schemes :test #'equal)
;;;; Commands
@@ -105,9 +101,9 @@
(let ((buffer (get-buffer-create " *hyperdrive-start*")))
(unwind-protect
(unless (zerop (call-process "systemctl" nil (list buffer t) nil
"--user" "start" "hyper-gateway.service"))
- (hyperdrive-error "Unable to start hyper-gateway: %S"
- (with-current-buffer buffer
- (string-trim-right (buffer-string)))))
+ (h/error "Unable to start hyper-gateway: %S"
+ (with-current-buffer buffer
+ (string-trim-right (buffer-string)))))
(kill-buffer buffer))))
;; TODO: Add user option to start the gateway without systemd (run as
@@ -120,9 +116,9 @@
(let ((buffer (get-buffer-create " *hyperdrive-stop*")))
(unwind-protect
(unless (zerop (call-process "systemctl" nil (list buffer t) nil
"--user" "stop" "hyper-gateway.service"))
- (hyperdrive-error "Unable to stop hyper-gateway: %S"
- (with-current-buffer buffer
- (string-trim-right (buffer-string)))))
+ (h/error "Unable to stop hyper-gateway: %S"
+ (with-current-buffer buffer
+ (string-trim-right (buffer-string)))))
(kill-buffer buffer))))
;;;###autoload
@@ -131,10 +127,10 @@
Gateway must be running."
(interactive)
(condition-case err
- (let ((url (concat "http://localhost:"; (number-to-string
hyperdrive-hyper-gateway-port) "/")))
- (hyperdrive-message "hyper-gateway version %s"
- (alist-get 'version (plz 'get url :as
#'json-read))))
- (plz-error (hyperdrive-api-default-else nil (caddr err)))))
+ (let ((url (concat "http://localhost:"; (number-to-string
h/hyper-gateway-port) "/")))
+ (h/message "hyper-gateway version %s"
+ (alist-get 'version (plz 'get url :as #'json-read))))
+ (plz-error (h/api-default-else nil (caddr err)))))
;;;###autoload
(defun hyperdrive-new (seed)
@@ -142,8 +138,8 @@ Gateway must be running."
If SEED is not currently used as the petname for another
hyperdrive, the new hyperdrive's petname will be set to SEED."
- (interactive (list (hyperdrive-read-name :prompt "New hyperdrive seed")))
- (let* ((response (hyperdrive-api 'post (concat "hyper://localhost/?key="
(url-hexify-string seed))))
+ (interactive (list (h/read-name :prompt "New hyperdrive seed")))
+ (let* ((response (h/api 'post (concat "hyper://localhost/?key="
(url-hexify-string seed))))
(url (progn
;; NOTE: Working around issue in plz whereby the
;; stderr process sentinel sometimes leaves "stderr
@@ -151,25 +147,25 @@ hyperdrive, the new hyperdrive's petname will be set to
SEED."
;; Emacs versions. See:
<https://github.com/alphapapa/plz.el/issues/23>.
(string-match (rx bos (group "hyper://" (1+ nonl))) response)
(match-string 1 response)))
- (hyperdrive (hyperdrive-entry-hyperdrive (hyperdrive-url-entry url))))
- (setf (hyperdrive-seed hyperdrive) seed
- (hyperdrive-writablep hyperdrive) t)
+ (hyperdrive (he/hyperdrive (h/url-entry url))))
+ (setf (h/seed hyperdrive) seed
+ (h/writablep hyperdrive) t)
(unwind-protect
- (hyperdrive-set-petname seed hyperdrive)
- (hyperdrive-persist hyperdrive)
- (hyperdrive-open (hyperdrive-url-entry url)))))
+ (h/set-petname seed hyperdrive)
+ (h/persist hyperdrive)
+ (h/open (h/url-entry url)))))
;;;###autoload
(defun hyperdrive-purge (hyperdrive)
"Purge all data corresponding to HYPERDRIVE."
- (interactive (list (hyperdrive-complete-hyperdrive :force-prompt t)))
- (when (yes-or-no-p (format "Delete local copy of hyperdrive (data will
likely not be recoverable—see manual): «%s»? "
- (hyperdrive--format-hyperdrive hyperdrive)))
- (hyperdrive-purge-no-prompt hyperdrive
+ (interactive (list (h/complete-hyperdrive :force-prompt t)))
+ (when (yes-or-no-p (format-message "Delete local copy of hyperdrive (data
will likely not be recoverable—see manual): `%s'? "
+ (h//format-hyperdrive hyperdrive)))
+ (h/purge-no-prompt hyperdrive
:then (lambda (_response)
- (hyperdrive-message "Purged drive: %s"
(hyperdrive--format-hyperdrive hyperdrive)))
+ (h/message "Purged drive: %s" (h//format-hyperdrive hyperdrive)))
:else (lambda (plz-error)
- (hyperdrive-error "Unable to purge drive: %s %S"
(hyperdrive--format-hyperdrive hyperdrive) plz-error)))))
+ (h/error "Unable to purge drive: %s %S" (h//format-hyperdrive
hyperdrive) plz-error)))))
;;;###autoload
(defun hyperdrive-set-petname (petname hyperdrive)
@@ -180,25 +176,25 @@ Returns HYPERDRIVE.
Universal prefix argument \\[universal-argument] forces
`hyperdrive-complete-hyperdrive' to prompt for a hyperdrive."
(interactive
- (let* ((hyperdrive (hyperdrive-complete-hyperdrive :force-prompt
current-prefix-arg))
- (petname (hyperdrive-read-name
- :prompt (format "Petname for «%s» (leave blank to unset)"
- (hyperdrive--format-hyperdrive hyperdrive))
- :initial-input (hyperdrive-petname hyperdrive))))
+ (let* ((hyperdrive (h/complete-hyperdrive :force-prompt current-prefix-arg))
+ (petname (h/read-name
+ :prompt (format "Petname for `%s' (leave blank to unset)"
+ (h//format-hyperdrive hyperdrive))
+ :initial-input (h/petname hyperdrive))))
(list petname hyperdrive)))
- (while-let (((not (equal petname (hyperdrive-petname hyperdrive))))
- (other-hyperdrive (cl-find petname (hash-table-values
hyperdrive-hyperdrives)
- :key #'hyperdrive-petname :test
#'equal)))
- (setf petname (hyperdrive-read-name
- :prompt (format "%S already assigned as petname to
hyperdrive «%s». Enter new petname"
- petname (hyperdrive--format-hyperdrive
other-hyperdrive))
- :initial-input (hyperdrive-petname hyperdrive))))
+ (while-let (((not (equal petname (h/petname hyperdrive))))
+ (other-hyperdrive (cl-find petname (hash-table-values
h/hyperdrives)
+ :key #'h/petname :test #'equal)))
+ (setf petname (h/read-name
+ :prompt (format "%S already assigned as petname to
hyperdrive `%s'. Enter new petname"
+ petname (h//format-hyperdrive
other-hyperdrive))
+ :initial-input (h/petname hyperdrive))))
(if (string-blank-p petname)
- (when (yes-or-no-p (format "Unset petname for «%s»? "
- (hyperdrive--format-hyperdrive hyperdrive)))
- (setf (hyperdrive-petname hyperdrive) nil))
- (setf (hyperdrive-petname hyperdrive) petname))
- (hyperdrive-persist hyperdrive)
+ (when (yes-or-no-p (format-message "Unset petname for `%s'? "
+ (h//format-hyperdrive hyperdrive)))
+ (setf (h/petname hyperdrive) nil))
+ (setf (h/petname hyperdrive) petname))
+ (h/persist hyperdrive)
;; TODO: Consider refreshing buffer names, directory headers, etc.
hyperdrive)
@@ -213,41 +209,41 @@ its only argument.
Universal prefix argument \\[universal-argument] forces
`hyperdrive-complete-hyperdrive' to prompt for a hyperdrive."
(interactive
- (let* ((hyperdrive (hyperdrive-complete-hyperdrive :predicate
#'hyperdrive-writablep
- :force-prompt
current-prefix-arg))
+ (let* ((hyperdrive (h/complete-hyperdrive :predicate #'h/writablep
+ :force-prompt current-prefix-arg))
(nickname
;; NOTE: Fill metadata first in case the JSON file has been updated
manually
(progn
- (hyperdrive-fill-metadata hyperdrive)
- (hyperdrive-read-name
- :prompt (format "Nickname for «%s»"
- (hyperdrive--format-hyperdrive hyperdrive))
- :initial-input (alist-get 'name (hyperdrive-metadata
hyperdrive))))))
+ (h/fill-metadata hyperdrive)
+ (h/read-name
+ :prompt (format-message "Nickname for `%s'"
+ (h//format-hyperdrive hyperdrive))
+ :initial-input (alist-get 'name (h/metadata hyperdrive))))))
(list nickname hyperdrive)))
- (unless (equal nickname (alist-get 'name (hyperdrive-metadata hyperdrive)))
+ (unless (equal nickname (alist-get 'name (h/metadata hyperdrive)))
(if (string-blank-p nickname)
(progn
- (cl-callf map-delete (hyperdrive-metadata hyperdrive) 'name)
- (hyperdrive-put-metadata hyperdrive
+ (cl-callf map-delete (h/metadata hyperdrive) 'name)
+ (h/put-metadata hyperdrive
:then (pcase-lambda ((cl-struct plz-response headers))
- (hyperdrive--fill-latest-version hyperdrive headers)
- (hyperdrive-persist hyperdrive)
+ (h//fill-latest-version hyperdrive headers)
+ (h/persist hyperdrive)
(funcall then hyperdrive))))
- (setf (alist-get 'name (hyperdrive-metadata hyperdrive)) nickname)
- (hyperdrive-put-metadata hyperdrive
+ (setf (alist-get 'name (h/metadata hyperdrive)) nickname)
+ (h/put-metadata hyperdrive
:then (pcase-lambda ((cl-struct plz-response headers))
- (hyperdrive--fill-latest-version hyperdrive headers)
- (hyperdrive-persist hyperdrive)
+ (h//fill-latest-version hyperdrive headers)
+ (h/persist hyperdrive)
(funcall then hyperdrive))))
;; TODO: Consider refreshing buffer names, directory headers, etc,
especially host-meta.json entry buffer.
)
hyperdrive)
-(defun hyperdrive-revert-buffer (&optional _ignore-auto noconfirm)
+(defun h/revert-buffer (&optional _ignore-auto noconfirm)
"Revert `hyperdrive-mode' buffer by reloading hyperdrive contents.
With NOCONFIRM or when current entry is a directory, revert
without confirmation."
- (when (or (hyperdrive--entry-directory-p hyperdrive-current-entry)
+ (when (or (h//entry-directory-p h/current-entry)
noconfirm
;; TODO: Add option hyperdrive-revert-without-query ?
;; (and (not (buffer-modified-p))
@@ -259,77 +255,76 @@ without confirmation."
(format (if (buffer-modified-p)
"Hyperdrive: Discard edits and reread from %s? "
"Hyperdrive: Revert buffer from %s? ")
- (hyperdrive-entry-url hyperdrive-current-entry))))
+ (he/url h/current-entry))))
;; TODO: Support before-revert-hook, after-revert-hook,
revert-buffer-internal-hook
- ;; Setting the modified flag to nil prevents `hyperdrive-open'
+ ;; Setting the modified flag to nil prevents `h/open'
;; from erroring if it has been modified.
(set-buffer-modified-p nil)
- (hyperdrive-open hyperdrive-current-entry)
+ (h/open h/current-entry)
t))
-(defun hyperdrive-revert-buffer-quick ()
+(defun h/revert-buffer-quick ()
"Like `revert-buffer-quick', but works with `hyperdrive-mode' files."
- (declare (modes hyperdrive-mode))
- (interactive)
- (hyperdrive-revert-buffer nil (not (buffer-modified-p))))
+ (interactive nil h/mode)
+ (h/revert-buffer nil (not (buffer-modified-p))))
-;;;; hyperdrive-mode
+;;;; h/mode
-(defvar-local hyperdrive-mode--state nil
+(defvar-local h/mode--state nil
"Previous state of buffer before `hyperdrive-mode' was activated.
Intended to be passed to `buffer-local-restore-state'.")
;;;###autoload
(define-minor-mode hyperdrive-mode
- ;; TODO: Consider moving hyperdrive-mode definition to
+ ;; TODO: Consider moving h/mode definition to
;; hyperdrive-lib.el. (Since it's used in multiple files.)
"Minor mode for buffers opened from hyperdrives."
:global nil
:interactive nil
:group 'hyperdrive
:lighter " hyperdrive"
- :keymap '(([remap revert-buffer-quick] . hyperdrive-revert-buffer-quick)
- ([remap dired-jump] . hyperdrive-up))
- (if hyperdrive-mode
+ :keymap '(([remap revert-buffer-quick] . h/revert-buffer-quick)
+ ([remap dired-jump] . h/up))
+ (if h/mode
(progn
- (setq-local hyperdrive-mode--state
+ (setq-local h/mode--state
(buffer-local-set-state
- revert-buffer-function #'hyperdrive-revert-buffer
- bookmark-make-record-function
#'hyperdrive-bookmark-make-record
- write-contents-functions (cl-adjoin
#'hyperdrive--write-contents write-contents-functions)
+ revert-buffer-function #'h/revert-buffer
+ bookmark-make-record-function #'h/bookmark-make-record
+ write-contents-functions (cl-adjoin #'h//write-contents
write-contents-functions)
;; TODO: Modify buffer-local value of
`save-some-buffers-action-alist'
;; to allow diffing modified buffer with hyperdrive file
buffer-offer-save t))
(add-hook 'after-change-major-mode-hook
- #'hyperdrive--hack-write-contents-functions nil 'local)
+ #'h//hack-write-contents-functions nil 'local)
;; TODO: Consider checking for existing advice before adding our own.
- (advice-add #'org-insert-link :after
#'hyperdrive--org-insert-link-after-advice))
- (buffer-local-restore-state hyperdrive-mode--state)
+ (advice-add #'org-insert-link :after
#'h/org--insert-link-after-advice))
+ (buffer-local-restore-state h/mode--state)
(remove-hook 'after-change-major-mode-hook
- #'hyperdrive--hack-write-contents-functions 'local)
- ;; FIXME: Only remove advice when all hyperdrive-mode buffers are killed.
- ;; (advice-remove #'org-insert-link #'hyperdrive--org-insert-link)
+ #'h//hack-write-contents-functions 'local)
+ ;; FIXME: Only remove advice when all h/mode buffers are killed.
+ ;; (advice-remove #'org-insert-link #'hyperdrive-org--insert-link)
))
;; Making it permanent-local keeps the minor mode active even if the
;; user changes the major mode, so the buffer can still be saved back
;; to the hyperdrive.
-(put 'hyperdrive-mode 'permanent-local t)
+(put 'h/mode 'permanent-local t)
-(defun hyperdrive--hack-write-contents-functions ()
+(defun h//hack-write-contents-functions ()
"Hack `write-contents-functions' for `hyperdrive-mode' in current buffer.
Ensures that hyperdrive buffers can still be saved after the
major mode changes (which resets `write-contents-functions' by
calling `kill-all-local-variables')."
- (cl-pushnew #'hyperdrive--write-contents write-contents-functions))
-(put 'hyperdrive--hack-write-contents-functions 'permanent-local-hook t)
+ (cl-pushnew #'h//write-contents write-contents-functions))
+(put 'h//hack-write-contents-functions 'permanent-local-hook t)
;;;###autoload
(defun hyperdrive-find-file (entry)
"Find hyperdrive ENTRY.
Interactively, prompt for known hyperdrive and path.
With universal prefix argument \\[universal-argument], prompt for version."
- (interactive (list (hyperdrive-read-entry :read-version current-prefix-arg)))
- (hyperdrive-open entry))
+ (interactive (list (h/read-entry :read-version current-prefix-arg)))
+ (h/open entry))
;;;###autoload
(defun hyperdrive-view-file (entry)
@@ -339,8 +334,8 @@ With universal prefix argument \\[universal-argument],
prompt for version."
;; TODO: Stay in `view-mode' after
;; `hyperdrive-previous-version'/`hyperdrive-next-version'. This may
;; require another minor mode.
- (interactive (list (hyperdrive-read-entry :read-version current-prefix-arg)))
- (hyperdrive-open entry
+ (interactive (list (h/read-entry :read-version current-prefix-arg)))
+ (h/open entry
;; `view-buffer' checks the mode-class symbol property of
;; `major-mode' and avoids putting directory buffers in `view-mode'.
:createp nil :then (lambda () (view-buffer (current-buffer)))))
@@ -348,8 +343,8 @@ With universal prefix argument \\[universal-argument],
prompt for version."
;;;###autoload
(defun hyperdrive-open-url (url)
"Open hyperdrive URL."
- (interactive (list (hyperdrive-read-url :prompt "Open hyperdrive URL")))
- (hyperdrive-open (hyperdrive-url-entry url)))
+ (interactive (list (h/read-url :prompt "Open hyperdrive URL")))
+ (h/open (h/url-entry url)))
;;;###autoload
(cl-defun hyperdrive-delete (entry &key (then #'ignore) (else #'ignore))
@@ -360,43 +355,44 @@ directory. Otherwise, or with universal prefix argument
\\[universal-argument], prompt for ENTRY."
(declare (indent defun))
(interactive
- (let* ((entry (hyperdrive--context-entry :latest-version t))
- (description (hyperdrive-entry-description entry))
+ (let* ((entry (h//context-entry :latest-version t))
+ (description (h//format-entry 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))))
+ (when (and (h//entry-directory-p entry)
+ (or (eq entry h/current-entry)
+ (string= "../" (alist-get 'display-name (he/etc entry)))))
+ (h/user-error "Won't delete from within"))
+ (when (and (yes-or-no-p (format-message "Delete `%s'? " description))
+ (or (not (h//entry-directory-p entry))
+ (yes-or-no-p (format-message "Recursively delete `%s'? "
+ description))))
(list entry
:then (lambda (_)
(when (and (buffer-live-p buffer)
- (eq 'hyperdrive-dir-mode (buffer-local-value
'major-mode buffer)))
+ (eq 'h/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))
+ (h/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)
+ (h/message "Unable to delete `%s': %S" description
plz-error))))))
+ (h/api 'delete (he/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)))
- (unless (hyperdrive--entry-directory-p entry)
+ (nonexistent-entry (h/copy-tree entry t)))
+ (unless (h//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))
- ;; Since there's no way for `hyperdrive--write-contents' to run
when
+ (setf (he/version nonexistent-entry) (string-to-number etag))
+ (h//fill-latest-version (he/hyperdrive entry) headers)
+ (h/update-nonexistent-version-range nonexistent-entry))
+ ;; Since there's no way for `h//write-contents' to run when
;; `buffer-modified-p' returns nil, this is a workaround to
ensure that
;; `save-buffer' re-saves files after they've been deleted.
(dolist (buf (match-buffers (lambda (buf deleted-entry)
- (when-let ((current-entry
(buffer-local-value 'hyperdrive-current-entry buf)))
- (hyperdrive-entry-equal-p
current-entry deleted-entry)))
+ (when-let ((current-entry
(buffer-local-value 'h/current-entry buf)))
+ (he/equal-p current-entry
deleted-entry)))
nil entry))
(with-current-buffer buf
(set-buffer-modified-p t)))
@@ -410,27 +406,27 @@ Interactively, download current hyperdrive file or file
at point
in a directory. Otherwise, or with universal prefix argument
\\[universal-argument], prompt for ENTRY."
(interactive
- (pcase-let* ((entry (hyperdrive--context-entry))
+ (pcase-let* ((entry (h//context-entry))
((cl-struct hyperdrive-entry name) entry)
- (read-filename (read-file-name "Filename: " (expand-file-name
name hyperdrive-download-directory))))
+ (read-filename (read-file-name "Filename: " (expand-file-name
name h/download-directory))))
(list entry read-filename)))
- (hyperdrive-download-url (hyperdrive-entry-url entry) filename))
+ (h/download-url (he/url entry) filename))
;;;###autoload
(defun hyperdrive-download-url (url filename)
"Load contents at URL as a file to store on disk at FILENAME."
;; TODO: Handle directory URLs (recursively download contents?)
(interactive
- (let* ((read-url (hyperdrive-read-url :prompt "Download hyperdrive URL"))
- (name (hyperdrive-entry-name (hyperdrive-url-entry read-url)))
- (read-filename (read-file-name "Filename: " (expand-file-name name
hyperdrive-download-directory))))
+ (let* ((read-url (h/read-url :prompt "Download hyperdrive URL"))
+ (name (he/name (h/url-entry read-url)))
+ (read-filename (read-file-name "Filename: " (expand-file-name name
h/download-directory))))
(list read-url read-filename)))
(when (or (not (file-exists-p filename))
(yes-or-no-p (format "File %s already exists; overwrite anyway? "
(expand-file-name filename))))
(when (file-exists-p filename)
;; plz.el will not overwrite existing files: ensure there's no file
there.
(delete-file filename))
- (hyperdrive-api 'get url :as `(file ,filename))))
+ (h/api 'get url :as `(file ,filename))))
;;;###autoload
(defun hyperdrive-write-buffer (entry &optional overwritep)
@@ -443,19 +439,19 @@ without prompting.
This function is for interactive use only; for non-interactive
use, see `hyperdrive-write'."
- (interactive (list (hyperdrive-read-entry :predicate #'hyperdrive-writablep
- :default-path (when
hyperdrive-current-entry
-
(hyperdrive-entry-path hyperdrive-current-entry))
- :latest-version t)
+ (interactive (list (h/read-entry :predicate #'h/writablep
+ :default-path (when h/current-entry
+ (he/path h/current-entry))
+ :latest-version t)
current-prefix-arg))
- (unless (or overwritep (not (hyperdrive-entry-at nil entry)))
+ (unless (or overwritep (not (he/at nil entry)))
(unless (y-or-n-p
- (format "File %s exists; overwrite?" (hyperdrive-entry-description
entry)))
- (hyperdrive-user-error "Canceled"))
- (when-let ((buffers (match-buffers (hyperdrive--buffer-for-entry entry))))
+ (format "File %s exists; overwrite?" (h//format-entry entry)))
+ (h/user-error "Canceled"))
+ (when-let ((buffers (match-buffers (h//buffer-for-entry entry))))
(unless (y-or-n-p
- (format "A buffer is visiting %s; proceed?"
(hyperdrive-entry-description entry)))
- (hyperdrive-user-error "Aborted"))
+ (format "A buffer is visiting %s; proceed?" (h//format-entry
entry)))
+ (h/user-error "Aborted"))
;; TODO: In BUFFERS, when user attempts to modify the buffer,
;; offer warning like "FILE has been modified in hyperdrive; are
;; you sure you want to edit this buffer?"
@@ -465,36 +461,38 @@ use, see `hyperdrive-write'."
(ignore buffers)
))
(pcase-let (((cl-struct hyperdrive-entry hyperdrive name) entry)
- (url (hyperdrive-entry-url entry))
+ (url (he/url entry))
(buffer (current-buffer)))
- (hyperdrive-write entry
+ (h/write entry
:body (without-restriction
(buffer-substring-no-properties (point-min) (point-max)))
:then (lambda (response)
(when (buffer-live-p buffer)
(with-current-buffer buffer
- (unless hyperdrive-mode
- (hyperdrive--clean-buffer)
- (when hyperdrive-honor-auto-mode-alist
- (let ((buffer-file-name (hyperdrive-entry-name entry)))
+ (unless h/mode
+ (h//clean-buffer)
+ (when h/honor-auto-mode-alist
+ (let ((buffer-file-name (he/name entry)))
(set-auto-mode)))
- (hyperdrive-mode))
- ;; NOTE: `hyperdrive-fill-latest-version' must come before
- ;; `hyperdrive--fill' because the latter calls
- ;; `hyperdrive-update-existent-version-range' internally.
- (hyperdrive-fill-latest-version hyperdrive)
- (hyperdrive--fill entry (plz-response-headers response))
+ (h/mode))
+ ;; NOTE: `h/fill-latest-version' must come before
+ ;; `h//fill' because the latter calls
+ ;; `h/update-existent-version-range' internally.
+ (h/fill-latest-version hyperdrive)
+ (h//fill entry (plz-response-headers response))
;; PUT responses only include ETag and Last-Modified
;; headers, so we need to set other entry metadata manually.
;; FIXME: For large buffers, `buffer-size' returns a
different
;; value than hyper-gateway's Content-Length header.
- (setf (hyperdrive-entry-size entry) (buffer-size))
+ (setf (he/size entry) (buffer-size))
;; FIXME: Will entry type ever be anything besides
text/plain?
;; /.well-known/host-meta.json ?
- (setf (hyperdrive-entry-type entry) "text/plain;
charset=utf-8")
- (setq-local hyperdrive-current-entry entry)
+ (setf (he/type entry) "text/plain; charset=utf-8")
+ (setq-local h/current-entry entry)
(setf buffer-file-name nil)
- (rename-buffer (hyperdrive--entry-buffer-name entry) 'unique)
+ (rename-buffer
+ (h//format-entry entry h/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
@@ -502,117 +500,113 @@ use, see `hyperdrive-write'."
;; and lets us avoid making another request for
;; metadata.
(set-visited-file-modtime (current-time))))
- (hyperdrive-message "Wrote: %S to \"%s\"" name url))
+ (h/message "Wrote: %S to \"%s\"" name url))
:else (lambda (plz-error)
- (hyperdrive-message "Unable to write: %S: %S" name plz-error)))
- (hyperdrive-message "Saving to \"%s\"..." url)
+ (h/message "Unable to write: %S: %S" name plz-error)))
+ (h/message "Saving to \"%s\"..." url)
;; TODO: Reload relevant hyperdrive-dir buffers after writing buffer (if
ewoc buffers display version, then possibly all ewoc buffers for a given
hyperdrive should be reloaded)
))
-(defun hyperdrive--write-contents ()
+(defun h//write-contents ()
"Call `hyperdrive-write-buffer' for the current buffer.
To be used in `write-contents-functions'."
- (cl-assert hyperdrive-mode)
- (hyperdrive-write-buffer hyperdrive-current-entry t))
+ (cl-assert h/mode)
+ (h/write-buffer h/current-entry t))
-(defun hyperdrive-copy-url (entry)
+(defun h/copy-url (entry)
"Save hyperdrive ENTRY's URL to the kill ring.
Interactively, uses `hyperdrive-current-entry', from either a
hyperdrive directory listing or a `hyperdrive-mode' file buffer."
- (declare (modes hyperdrive-mode))
- (interactive (list hyperdrive-current-entry))
- (let ((url (hyperdrive-entry-url entry)))
+ (interactive (list h/current-entry) h/mode)
+ (let ((url (he/url entry)))
(kill-new url)
- (hyperdrive-message "%s" url)))
+ (h/message "%s" url)))
-(cl-defun hyperdrive-up (entry &key (then nil then-set-p))
+(cl-defun h/up (entry &key (then nil then-set-p))
"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 (progn
- (unless (and hyperdrive-mode hyperdrive-current-entry)
+ (unless (and h/mode h/current-entry)
(user-error "Not a hyperdrive buffer"))
- (list hyperdrive-current-entry)))
- (if-let ((parent (hyperdrive-parent entry)))
+ (list h/current-entry))
+ h/mode)
+ (if-let ((parent (h/parent entry)))
;; TODO: Go to entry in parent directory.
(if then-set-p
- (hyperdrive-open parent :then then)
+ (h/open parent :then then)
;; Allow default callback to be used.
- (hyperdrive-open parent))
- (hyperdrive-user-error "At root directory")))
+ (h/open parent))
+ (h/user-error "At root directory")))
-(defvar-keymap hyperdrive-up-map
+(defvar-keymap h/up-map
:doc "Keymap to repeat `hyperdrive-up'. Used in `repeat-mode'."
:repeat t
- "j" #'hyperdrive-up
- "C-j" #'hyperdrive-up)
+ "j" #'h/up
+ "C-j" #'h/up)
-(defun hyperdrive-open-previous-version (entry)
+(defun h/open-previous-version (entry)
"Open previous version of ENTRY."
- (declare (modes hyperdrive-mode))
- (interactive (list hyperdrive-current-entry))
- (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)
- (1- (car (hyperdrive-entry-version-range entry))))))
-
-(defun hyperdrive-open-next-version (entry)
+ (interactive (list h/current-entry) h/mode)
+ (if-let ((previous-entry (he/previous entry)))
+ (h/open previous-entry)
+ (h/message "%s does not exist at version %s. Try \\[hyperdrive-history]"
+ (h//format-entry entry "[%H] %p")
+ (1- (car (he/version-range entry))))))
+
+(defun h/open-next-version (entry)
"Open next version of ENTRY."
- (declare (modes hyperdrive-mode))
- (interactive (list hyperdrive-current-entry))
- (pcase-exhaustive (hyperdrive-entry-next entry)
+ (interactive (list h/current-entry) h/mode)
+ (pcase-exhaustive (he/next entry)
((and (pred (eq entry)) next-entry)
;; ENTRY already at latest version: open and say `revert-buffer'.
- (hyperdrive-open next-entry)
- (hyperdrive-message
+ (h/open next-entry)
+ (h/message
"Already at latest version of entry; consider reverting buffer with %s
to check for newer versions"
(substitute-command-keys
(if (fboundp 'revert-buffer-quick)
"\\[revert-buffer-quick]"
"\\[revert-buffer]"))))
- ('nil ;; Known nonexistent: suggest `hyperdrive-history'.
- (hyperdrive-message (substitute-command-keys
- "Entry deleted after this version. Try
\\[hyperdrive-history]")))
- ('unknown ;; Unknown existence: suggest `hyperdrive-history'.
- (hyperdrive-message (substitute-command-keys
- "Next version unknown. Try \\[hyperdrive-history]")))
- ((and (pred hyperdrive-entry-p) next-entry)
- (hyperdrive-open next-entry))))
-
-(defun hyperdrive-open-at-version (entry version)
+ ('nil ;; Known nonexistent: suggest `h/history'.
+ (h/message "Entry deleted after this version. Try
\\[hyperdrive-history]"))
+ ('unknown ;; Unknown existence: suggest `h/history'.
+ (h/message "Next version unknown. Try \\[hyperdrive-history]"))
+ ((and (pred he/p) next-entry)
+ (h/open next-entry))))
+
+(defun h/open-at-version (entry version)
"Open ENTRY at VERSION.
Nil VERSION means open the entry at its hyperdrive's latest version."
- (declare (modes hyperdrive-mode))
- (interactive (let ((entry hyperdrive-current-entry))
- (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))))))
- (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)
- version)))
+ (interactive (let ((entry h/current-entry))
+ (list entry (h/read-version
+ :hyperdrive (he/hyperdrive entry)
+ :prompt (format-message "Open `%s' at version
(leave blank for latest version)"
+ (h//format-entry
entry)))))
+ h/mode)
+ (if-let ((latest-entry (he/at version entry)))
+ (h/open latest-entry)
+ (h/message "%s does not exist at version %s. Try \\[hyperdrive-history]"
+ (h//format-entry
+ entry h/default-entry-format-without-version)
+ version)))
;;;; Bookmark support
;; TODO: Display entry description instead of full URL in bookmark list view.
(require 'bookmark)
-(defun hyperdrive-bookmark-make-record ()
+(defun h/bookmark-make-record ()
"Return a bookmark record for current hyperdrive buffer.
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)))
+ (setf (alist-get 'handler bookmark) #'h/bookmark-handler
+ (alist-get 'location bookmark) (he/url h/current-entry))
+ (cons (format "hyperdrive: %s" (h//format-entry h/current-entry))
bookmark)))
;;;###autoload
(defun hyperdrive-bookmark-handler (bookmark)
"Handler for Hyperdrive BOOKMARK."
- (hyperdrive-open (hyperdrive-url-entry (alist-get 'location (cdr bookmark)))
+ (h/open (h/url-entry (alist-get 'location (cdr bookmark)))
:then (lambda ()
(bookmark-default-handler
;; We add the buffer property, because we don't want to
@@ -622,9 +616,9 @@ Works in `hyperdrive-mode' and `hyperdrive-dir-mode'
buffers."
;; `bookmark-default-handler' to signal an error.
(append bookmark `((buffer . ,(current-buffer)))))
(pop-to-buffer (current-buffer) '(display-buffer-same-window)))))
-(put 'hyperdrive-bookmark-handler 'bookmark-handler-type "hyperdrive")
+(put 'h/bookmark-handler 'bookmark-handler-type "hyperdrive")
-(defun hyperdrive-bookmark-jump (bookmark)
+(defun h/bookmark-jump (bookmark)
"Jump to a Hyperdrive BOOKMARK."
(interactive
(progn
@@ -632,16 +626,16 @@ Works in `hyperdrive-mode' and `hyperdrive-dir-mode'
buffers."
(list
(completing-read "Open Hyperdrive bookmark: " bookmark-alist
(pcase-lambda (`(,_name . ,(map handler)))
- (equal handler #'hyperdrive-bookmark-handler))
+ (equal handler #'h/bookmark-handler))
t nil 'bookmark-history))))
(bookmark-jump bookmark))
-(defun hyperdrive-bookmark-list ()
+(defun h/bookmark-list ()
"List Hyperdrive bookmarks."
(interactive)
(let ((bookmark-alist
(cl-remove-if-not (pcase-lambda (`(,_name . ,(map handler)))
- (equal handler #'hyperdrive-bookmark-handler))
+ (equal handler #'h/bookmark-handler))
bookmark-alist)))
(call-interactively #'bookmark-bmenu-list)))
@@ -651,47 +645,47 @@ Works in `hyperdrive-mode' and `hyperdrive-dir-mode'
buffers."
(cl-defun hyperdrive-upload-file
(filename entry &key queue
(then (lambda (&rest _ignore)
- (hyperdrive-open (hyperdrive-parent entry))
- (hyperdrive-message "Uploaded: \"%s\"."
(hyperdrive-entry-url entry)))))
+ (h/open (h/parent entry))
+ (h/message "Uploaded: \"%s\"." (he/url entry)))))
"Upload FILENAME to ENTRY.
Interactively, read FILENAME and ENTRY from the user.
After successful upload, call THEN. When QUEUE, use it."
(declare (indent defun))
(interactive (let ((filename (read-file-name "Upload file: ")))
(list filename
- (hyperdrive-read-entry :predicate #'hyperdrive-writablep
- :default-path
(file-name-nondirectory filename)
- :latest-version t))))
- (let ((url (hyperdrive-entry-url entry))
+ (h/read-entry :predicate #'h/writablep
+ :default-path (file-name-nondirectory
filename)
+ :latest-version t))))
+ (let ((url (he/url entry))
(last-modified (let ((system-time-locale "C"))
(format-time-string "%Y-%m-%dT%T.%3NZ"
;; "%a, %-d %b %Y %T %Z"
(file-attribute-modification-time
(file-attributes filename)) t))))
- (hyperdrive-api 'put url :queue queue
+ (h/api 'put url :queue queue
:body `(file ,filename)
:headers `(("Last-Modified" . ,last-modified))
:then then)
(unless queue
- (hyperdrive-message "Uploading to \"%s\"..." url))))
+ (h/message "Uploading to \"%s\"..." url))))
-(defun hyperdrive-read-files ()
+(defun h/read-files ()
"Return list of files read from the user."
(cl-loop for file = (read-file-name "File (blank to stop): ")
while (not (string-blank-p file))
collect file))
-(cl-defun hyperdrive-upload-files (files hyperdrive &key (target-directory
"/"))
+(cl-defun h/upload-files (files hyperdrive &key (target-directory "/"))
"Upload FILES to TARGET-DIRECTORY in HYPERDRIVE.
Universal prefix argument \\[universal-argument] forces
`hyperdrive-complete-hyperdrive' to prompt for a hyperdrive."
(interactive
- (let* ((files (hyperdrive-read-files))
- (hyperdrive (hyperdrive-complete-hyperdrive :predicate
#'hyperdrive-writablep
- :force-prompt
current-prefix-arg))
+ (let* ((files (h/read-files))
+ (hyperdrive (h/complete-hyperdrive :predicate #'h/writablep
+ :force-prompt current-prefix-arg))
;; TODO: Consider offering target dirs in hyperdrive with completion.
- (target-dir (hyperdrive-read-path :hyperdrive hyperdrive :prompt
"Target directory in «%s»" :default "/")))
+ (target-dir (h/read-path :hyperdrive hyperdrive :prompt "Target
directory in `%s'" :default "/")))
(list files hyperdrive :target-directory target-dir)))
(cl-assert (cl-notany #'file-directory-p files))
(cl-assert (cl-every #'file-readable-p files))
@@ -699,20 +693,20 @@ Universal prefix argument \\[universal-argument] forces
(dolist (file files)
(unless (= 1 (cl-count (file-name-nondirectory file) files
:test #'equal :key #'file-name-nondirectory))
- (hyperdrive-user-error "Can't upload multiple files with same name: %S"
(file-name-nondirectory file))))
- (setf target-directory (hyperdrive--format-path target-directory :directoryp
t))
+ (h/user-error "Can't upload multiple files with same name: %S"
(file-name-nondirectory file))))
+ (setf target-directory (h//format-path target-directory :directoryp t))
(let ((queue (make-plz-queue
- :limit hyperdrive-queue-limit
+ :limit h/queue-limit
:finally (lambda ()
;; FIXME: Offer more informative message in case of
errors?
- (hyperdrive-open (hyperdrive-entry-create
:hyperdrive hyperdrive
- :path
target-directory))
- (hyperdrive-message "Uploaded %s files." (length
files))))))
+ (h/open (he/create :hyperdrive hyperdrive
+ :path target-directory))
+ (h/message "Uploaded %s files." (length files))))))
(dolist (file files)
(let* ((path (file-name-concat target-directory (file-name-nondirectory
file)))
- (entry (hyperdrive-entry-create :hyperdrive hyperdrive :path
path)))
+ (entry (he/create :hyperdrive hyperdrive :path path)))
;; TODO: Handle failures? Retry?
- (hyperdrive-upload-file file entry :queue queue :then #'ignore)))
+ (h/upload-file file entry :queue queue :then #'ignore)))
(plz-run queue)))
;;;; Info lookup
@@ -752,7 +746,7 @@ Universal prefix argument \\[universal-argument] forces
(require 'url)
-(defun hyperdrive-url-loader (parsed-url)
+(defun h/url-loader (parsed-url)
"Retrieve URL synchronously.
PARSED-URL must be a URL-struct like the output of
`url-generic-parse-url'.
@@ -761,7 +755,7 @@ The return value of this function is the retrieval buffer."
(cl-check-type parsed-url url "Need a pre-parsed URL.")
(let* ((url (url-recreate-url parsed-url))
;; response-buffer will contain the loaded HTML, and will be deleted
at the end of `eww-render'.
- (response-buffer (hyperdrive-api 'get url :as 'buffer)))
+ (response-buffer (h/api 'get url :as 'buffer)))
(with-current-buffer response-buffer
(widen)
(goto-char (point-min))
@@ -773,45 +767,35 @@ The return value of this function is the retrieval
buffer."
(replace-match ""))
(current-buffer))))
-(puthash "hyper" '(name "hyper" loader hyperdrive-url-loader
+(puthash "hyper" '(name "hyper" loader h/url-loader
;; Expand relative paths against host
expand-file-name url-default-expander)
url-scheme-registry)
-(defvar eww-use-browse-url)
-(when (version<= "28.1" emacs-version)
- (require 'eww)
- (setf eww-use-browse-url
- (if eww-use-browse-url
- (rx-to-string `(or ,eww-use-browse-url (seq bos "hyper://")))
- (rx bos "hyper://"))))
+(require 'eww)
+(setf eww-use-browse-url
+ (if eww-use-browse-url
+ (rx-to-string `(or ,eww-use-browse-url (seq bos "hyper://")))
+ (rx bos "hyper://")))
;;;; `kill-buffer-query-functions' integration
-(defun hyperdrive--kill-buffer-possibly-save (buffer)
+(defun h//kill-buffer-possibly-save (buffer)
"Ask whether to kill modified hyperdrive file BUFFER."
;; Mostly copied from `kill-buffer--possibly-save'.
- (cl-assert (and hyperdrive-mode hyperdrive-current-entry))
+ (cl-assert (and h/mode h/current-entry))
(let ((response
- (cadr
- (if (< emacs-major-version 28)
- (read-multiple-choice
- (format "Hyperdrive file %s modified; kill anyway?"
- (hyperdrive-entry-description 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))
- '((?y "yes" "kill buffer without saving")
- (?n "no" "exit without doing anything")
- (?s "save and then kill" "save the buffer and
then kill it"))
- nil nil (and (not use-short-answers)
- (not (when (fboundp 'use-dialog-box-p)
- (with-no-warnings
- (use-dialog-box-p)))))))))))
+ (cadr (compat-call
+ read-multiple-choice
+ (format "Hyperdrive file %s modified; kill anyway?"
+ (h//format-entry h/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"))
+ nil nil (and (not use-short-answers)
+ (not (when (fboundp 'use-dialog-box-p)
+ (with-no-warnings
+ (use-dialog-box-p)))))))))
(if (equal response "no")
nil
(unless (equal response "yes")
@@ -819,64 +803,64 @@ The return value of this function is the retrieval
buffer."
(save-buffer)))
t)))
-(defun hyperdrive-kill-buffer-query-function ()
+(defun h/kill-buffer-query-function ()
"Ask before killing an unsaved hyperdrive file buffer."
- (if (and hyperdrive-mode
- hyperdrive-current-entry
- (not (hyperdrive--entry-directory-p hyperdrive-current-entry))
+ (if (and h/mode
+ h/current-entry
+ (not (h//entry-directory-p h/current-entry))
(buffer-modified-p))
- (hyperdrive--kill-buffer-possibly-save (current-buffer))
+ (h//kill-buffer-possibly-save (current-buffer))
t))
-(cl-pushnew #'hyperdrive-kill-buffer-query-function
kill-buffer-query-functions)
+(cl-pushnew #'h/kill-buffer-query-function kill-buffer-query-functions)
;;;;; `easy-menu' integration
-(defvar hyperdrive-menu-bar-menu
+(defvar h/menu-bar-menu
'("Hyperdrive"
("Gateway"
:label
- (format "Gateway (%s)" (if (hyperdrive-status) "on" "off"))
- ["Start Gateway" hyperdrive-start
+ (format "Gateway (%s)" (if (h/status) "on" "off"))
+ ["Start Gateway" h/start
:help "Start hyper-gateway"]
- ["Stop Gateway" hyperdrive-stop
+ ["Stop Gateway" h/stop
:help "Stop hyper-gateway"]
- ["Gateway version" hyperdrive-hyper-gateway-version
+ ["Gateway version" h/hyper-gateway-version
:help "Say hyper-gateway version"])
"---"
- ["Open URL" hyperdrive-open-url
+ ["Open URL" h/open-url
:help "Load a hyperdrive URL"]
- ["New Drive" hyperdrive-new
+ ["New Drive" h/new
:help "Create a new hyperdrive"]
("Drives"
- :active (< 0 (hash-table-count hyperdrive-hyperdrives))
- :label (if (zerop (hash-table-count hyperdrive-hyperdrives))
+ :active (< 0 (hash-table-count h/hyperdrives))
+ :label (if (zerop (hash-table-count h/hyperdrives))
"Drives (empty)"
"Drives")
:filter (lambda (_)
(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)
+ for entry = (he/create :hyperdrive drive)
+ collect (list (h//format drive)
(vector "Describe"
`(lambda ()
(interactive)
- (let
((hyperdrive-current-entry ,entry))
-
(call-interactively #'hyperdrive-describe-hyperdrive)))
+ (let
((h/current-entry ,entry))
+
(call-interactively #'h/describe-hyperdrive)))
:help "Display
information about hyperdrive")
(vector "Find File"
`(lambda ()
(interactive)
- (hyperdrive-open
-
(hyperdrive-read-entry
+ (h/open
+ (h/read-entry
:hyperdrive
,drive
:read-version current-prefix-arg)))
:help "Find a file
in hyperdrive")
(vector "View File"
`(lambda ()
(interactive)
-
(hyperdrive-view-file
-
(hyperdrive-read-entry
+ (h/view-file
+ (h/read-entry
:hyperdrive
,drive
:read-version
current-prefix-arg)))
:help "View a file
in hyperdrive")
@@ -885,29 +869,29 @@ The return value of this function is the retrieval
buffer."
`(lambda ()
(interactive)
(let*
((filename (read-file-name "Upload file: "))
- (entry
(hyperdrive-read-entry :hyperdrive ,drive
-
:default-path (file-name-nondirectory filename)
-
:latest-version t)))
-
(hyperdrive-upload-file filename entry)))
- :active
`(hyperdrive-writablep ,drive)
+ (entry
(h/read-entry :hyperdrive ,drive
+
:default-path (file-name-nondirectory filename)
+
:latest-version t)))
+
(h/upload-file filename entry)))
+ :active
`(h/writablep ,drive)
:help "Upload a
file to hyperdrive")
(vector "Upload Files"
`(lambda ()
(interactive)
- (let* ((files
(hyperdrive-read-files))
-
(target-dir (hyperdrive-read-path
+ (let* ((files
(h/read-files))
+
(target-dir (h/read-path
:hyperdrive ,drive
-
:prompt "Target directory in «%s»"
+
:prompt "Target directory in `%s'"
:default "/")))
-
(hyperdrive-upload-files files ,drive
-
:target-directory target-dir)))
- :active
`(hyperdrive-writablep ,drive)
+
(h/upload-files files ,drive
+
:target-directory target-dir)))
+ :active
`(h/writablep ,drive)
:help "Upload
files to hyperdrive")
- (vector "Mirror"
#'hyperdrive-mirror
- ;; TODO:
`hyperdrive-mirror''s interactive form will also prompt
- ;; for a drive.
After changing `hyperdrive-mirror' to use
+ (vector "Mirror" #'h/mirror
+ ;; TODO:
`h/mirror''s interactive form will also prompt
+ ;; for a drive.
After changing `h/mirror' to use
;; Transient.el,
we should pass in the default drive argument.
- :active
`(hyperdrive-writablep ,drive)
+ :active
`(h/writablep ,drive)
:help "Mirror a
directory to hyperdrive")
"---"
(vector "Petname"
@@ -916,72 +900,72 @@ The return value of this function is the retrieval
buffer."
;; TODO: Ask about
this and/or file a bug report.
`(lambda ()
(interactive)
- (let
((hyperdrive-current-entry ,entry))
-
(call-interactively #'hyperdrive-set-petname)))
+ (let
((h/current-entry ,entry))
+
(call-interactively #'h/set-petname)))
:help "Set petname
for hyperdrive"
:label
- (format "Set
petname: «%s»"
- (pcase
(hyperdrive-petname drive)
- (`nil
"none")
- (it
it))))
+ (format-message
"Set petname: `%s'"
+
(pcase (h/petname drive)
+
(`nil "none")
+
(it it))))
(vector "Nickname"
`(lambda ()
(interactive)
- (let
((hyperdrive-current-entry ,entry))
-
(call-interactively #'hyperdrive-set-nickname)))
+ (let
((h/current-entry ,entry))
+
(call-interactively #'h/set-nickname)))
:help "Set
nickname for hyperdrive"
- :active
(hyperdrive-writablep drive)
+ :active
(h/writablep drive)
:label
- (format "Set
nickname: «%s»"
- (pcase
(alist-get 'name (hyperdrive-metadata drive))
- (`nil
"none")
- (it
it))))
+ (format-message
"Set nickname: `%s'"
+
(pcase (alist-get 'name (h/metadata drive))
+
(`nil "none")
+
(it it))))
"---"
(vector "Purge"
`(lambda ()
(interactive)
- (let
((hyperdrive-current-entry ,entry))
-
(call-interactively #'hyperdrive-purge)))
+ (let
((h/current-entry ,entry))
+
(call-interactively #'h/purge)))
:help "Purge all
local data about hyperdrive")))))
(append (list ["Writable" :active nil])
- (or (list-drives (sort (cl-remove-if-not
#'hyperdrive-writablep (hash-table-values hyperdrive-hyperdrives))
+ (or (list-drives (sort (cl-remove-if-not
#'h/writablep (hash-table-values h/hyperdrives))
(lambda (a b)
- (string<
(hyperdrive--format-host a :with-label t)
-
(hyperdrive--format-host b :with-label t)))))
+ (string< (h//format a)
+ (h//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))
+ (or (list-drives (sort (cl-remove-if #'h/writablep
(hash-table-values h/hyperdrives))
(lambda (a b)
- (string<
(hyperdrive--format-host a :with-label t)
-
(hyperdrive--format-host b :with-label t)))))
+ (string< (h//format a)
+ (h//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))
+ :active h/current-entry
+ :label (if-let* ((entry h/current-entry))
+ (format-message "Current: `%s'"
+ (h//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))
+ :active h/current-entry
+ :label (if-let* ((entry h/current-entry)
+ (hyperdrive (he/hyperdrive entry)))
+ (format-message "Current Drive `%s'" (h//format hyperdrive))
"Current Drive")
["Find File"
(lambda ()
(interactive)
- (hyperdrive-open
- (hyperdrive-read-entry
- :hyperdrive (hyperdrive-entry-hyperdrive hyperdrive-current-entry)
+ (h/open
+ (h/read-entry
+ :hyperdrive (he/hyperdrive h/current-entry)
:read-version current-prefix-arg)))
:help "Find a file in hyperdrive"]
["View File"
(lambda ()
(interactive)
- (hyperdrive-view-file
- (hyperdrive-read-entry
- :hyperdrive (hyperdrive-entry-hyperdrive hyperdrive-current-entry)
+ (h/view-file
+ (h/read-entry
+ :hyperdrive (he/hyperdrive h/current-entry)
:read-version current-prefix-arg)))
:help "View a file in hyperdrive"]
"---"
@@ -989,27 +973,27 @@ The return value of this function is the retrieval
buffer."
(lambda ()
(interactive)
(let* ((filename (read-file-name "Upload file: "))
- (entry (hyperdrive-read-entry :hyperdrive
(hyperdrive-entry-hyperdrive hyperdrive-current-entry)
- :default-path
(file-name-nondirectory filename)
- :latest-version t)))
- (hyperdrive-upload-file filename entry)))
- :active (hyperdrive-writablep (hyperdrive-entry-hyperdrive
hyperdrive-current-entry))
+ (entry (h/read-entry :hyperdrive (he/hyperdrive
h/current-entry)
+ :default-path (file-name-nondirectory
filename)
+ :latest-version t)))
+ (h/upload-file filename entry)))
+ :active (h/writablep (he/hyperdrive h/current-entry))
:help "Upload a file to hyperdrive"]
["Upload Files"
(lambda ()
(interactive)
- (let* ((files (hyperdrive-read-files))
- (drive (hyperdrive-entry-hyperdrive hyperdrive-current-entry))
- (target-dir (hyperdrive-read-path
+ (let* ((files (h/read-files))
+ (drive (he/hyperdrive h/current-entry))
+ (target-dir (h/read-path
:hyperdrive drive
- :prompt "Target directory in «%s»"
+ :prompt "Target directory in `%s'"
:default "/")))
- (hyperdrive-upload-files files drive
- :target-directory target-dir)))
- :active (hyperdrive-writablep (hyperdrive-entry-hyperdrive
hyperdrive-current-entry))
+ (h/upload-files files drive
+ :target-directory target-dir)))
+ :active (h/writablep (he/hyperdrive h/current-entry))
:help "Upload files to hyperdrive"]
- ["Mirror" hyperdrive-mirror
- :active (hyperdrive-writablep (hyperdrive-entry-hyperdrive
hyperdrive-current-entry))
+ ["Mirror" h/mirror
+ :active (h/writablep (he/hyperdrive h/current-entry))
:help "Mirror a directory to hyperdrive"]
"---"
["Petname"
@@ -1017,149 +1001,149 @@ The return value of this function is the retrieval
buffer."
;; This workaround prevents keybindings from displaying in the
menu bar.
(lambda ()
(interactive)
- (call-interactively #'hyperdrive-set-petname))
+ (call-interactively #'h/set-petname))
:help "Set petname for hyperdrive"
:label
- (format "Set petname: «%s»"
- (pcase (hyperdrive-petname (hyperdrive-entry-hyperdrive
hyperdrive-current-entry))
- (`nil "none")
- (it it)))]
+ (format-message "Set petname: `%s'"
+ (pcase (h/petname (he/hyperdrive h/current-entry))
+ (`nil "none")
+ (it it)))]
["Nickname" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-set-nickname))
+ (call-interactively #'h/set-nickname))
:help "Set nickname for hyperdrive"
- :active (hyperdrive-writablep (hyperdrive-entry-hyperdrive
hyperdrive-current-entry))
+ :active (h/writablep (he/hyperdrive h/current-entry))
:label
- (format "Set nickname: «%s»"
- (pcase (alist-get 'name
- (hyperdrive-metadata
- (hyperdrive-entry-hyperdrive
- hyperdrive-current-entry)))
- (`nil "none")
- (it it)))]
+ (format-message "Set nickname: `%s'"
+ (pcase (alist-get 'name
+ (h/metadata
+ (he/hyperdrive
+ h/current-entry)))
+ (`nil "none")
+ (it it)))]
"---"
["Describe" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-describe-hyperdrive))
+ (call-interactively #'h/describe-hyperdrive))
:help "Display information about hyperdrive"]
["Purge" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-purge))
+ (call-interactively #'h/purge))
:help "Purge all local data about hyperdrive"])
("Current File/Directory"
- :label (format "Current %s: «%s»"
- (if (hyperdrive--entry-directory-p
hyperdrive-current-entry)
- "Directory"
- "File")
- (hyperdrive--format-path (hyperdrive-entry-path
- hyperdrive-current-entry)))
+ :label (format-message "Current %s: `%s'"
+ (if (h//entry-directory-p h/current-entry)
+ "Directory"
+ "File")
+ (h//format-path (he/path
+ h/current-entry)))
["Refresh" (lambda ()
(interactive)
(call-interactively #'revert-buffer))
:help "Revert current hyperdrive file/directory"]
["Up to Parent" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-up))
- :active (hyperdrive-parent hyperdrive-current-entry)
+ (call-interactively #'h/up))
+ :active (h/parent h/current-entry)
:help "Open parent directory"]
("Sort Directory"
- :active (eq major-mode 'hyperdrive-dir-mode)
+ :active (eq major-mode 'h/dir-mode)
["By Name" (lambda ()
(interactive)
- (hyperdrive-dir-sort
- (hyperdrive-dir-toggle-sort-direction
- 'name hyperdrive-directory-sort)))
- :suffix (pcase-let ((`(,column . ,direction)
hyperdrive-directory-sort))
+ (h/dir-sort
+ (h/dir-toggle-sort-direction
+ 'name h/directory-sort)))
+ :suffix (pcase-let ((`(,column . ,direction) h/directory-sort))
(when (eq 'name column)
(format " (%s)" (if (eq 'ascending direction) "v" "^"))))
:help "Sort directory by name"]
["By Size" (lambda ()
(interactive)
- (hyperdrive-dir-sort
- (hyperdrive-dir-toggle-sort-direction
- 'size hyperdrive-directory-sort)))
- :suffix (pcase-let ((`(,column . ,direction)
hyperdrive-directory-sort))
+ (h/dir-sort
+ (h/dir-toggle-sort-direction
+ 'size h/directory-sort)))
+ :suffix (pcase-let ((`(,column . ,direction) h/directory-sort))
(when (string= 'size column)
(format " (%s)" (if (eq 'ascending direction) "v" "^"))))
:help "Sort directory by size"]
["By Last Modified Time" (lambda ()
(interactive)
- (hyperdrive-dir-sort
- (hyperdrive-dir-toggle-sort-direction
- 'mtime hyperdrive-directory-sort)))
- :suffix (pcase-let ((`(,column . ,direction)
hyperdrive-directory-sort))
+ (h/dir-sort
+ (h/dir-toggle-sort-direction
+ 'mtime h/directory-sort)))
+ :suffix (pcase-let ((`(,column . ,direction) h/directory-sort))
(when (string= 'mtime column)
(format " (%s)" (if (eq 'ascending direction) "v" "^"))))
:help "Sort directory by last modified time"])
["Copy URL" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-copy-url))
+ (call-interactively #'h/copy-url))
:help "Copy URL of current file/directory"]
["Delete" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-delete))
- :active (pcase-let (((cl-struct hyperdrive-entry hyperdrive version)
hyperdrive-current-entry))
- (and (not (eq major-mode 'hyperdrive-dir-mode))
+ (call-interactively #'h/delete))
+ :active (pcase-let (((cl-struct hyperdrive-entry hyperdrive version)
h/current-entry))
+ (and (not (eq major-mode 'h/dir-mode))
(not version)
- (hyperdrive-writablep hyperdrive)))
+ (h/writablep hyperdrive)))
:help "Delete current file/directory"]
;; TODO: Add command to download whole directories
["Download" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-download))
- :active (not (eq major-mode 'hyperdrive-dir-mode))
+ (call-interactively #'h/download))
+ :active (not (eq major-mode 'h/dir-mode))
:help "Download current file"])
("Selected"
- :label (let ((entry-at-point (hyperdrive-dir--entry-at-point)))
- (format "Selected %s: «%s»"
- (if (hyperdrive--entry-directory-p entry-at-point)
- "Directory"
- "File")
- (hyperdrive-entry-name entry-at-point)))
- :visible (and (eq major-mode 'hyperdrive-dir-mode)
- (hyperdrive-dir--entry-at-point))
+ :label (let ((entry-at-point (h/dir--entry-at-point)))
+ (format-message "Selected %s: `%s'"
+ (if (h//entry-directory-p entry-at-point)
+ "Directory"
+ "File")
+ (he/name entry-at-point)))
+ :visible (and (eq major-mode 'h/dir-mode)
+ (h/dir--entry-at-point))
["Download" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-download))
- :active (when-let ((entry-at-point (hyperdrive-dir--entry-at-point)))
- (not (hyperdrive--entry-directory-p entry-at-point)))
+ (call-interactively #'h/download))
+ :active (when-let ((entry-at-point (h/dir--entry-at-point)))
+ (not (h//entry-directory-p entry-at-point)))
;; TODO: Change to "file/directory" when it's possible to download a
whole directory
:help "Download file at point"]
["Delete" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-delete))
- :active (let ((selected-entry (hyperdrive-dir--entry-at-point)))
- (and (hyperdrive-writablep
- (hyperdrive-entry-hyperdrive hyperdrive-current-entry))
- (not (eq selected-entry hyperdrive-current-entry))
+ (call-interactively #'h/delete))
+ :active (let ((selected-entry (h/dir--entry-at-point)))
+ (and (h/writablep
+ (he/hyperdrive h/current-entry))
+ (not (eq selected-entry h/current-entry))
;; TODO: Add `hyperdrive--parent-entry-p'
(not (string= ".." (alist-get 'display-name
- (hyperdrive-entry-etc
selected-entry))))))
+ (he/etc
selected-entry))))))
:help "Delete file/directory at point"]
["Copy URL" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-dir-copy-url))
+ (call-interactively #'h/dir-copy-url))
:help "Copy URL of file/directory at point"]
["Open" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-dir-find-file))
+ (call-interactively #'h/dir-find-file))
:help "Open file/directory at point"]
["View" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-dir-view-file))
- :active (when-let ((entry-at-point (hyperdrive-dir--entry-at-point)))
- (not (hyperdrive--entry-directory-p entry-at-point)))
+ (call-interactively #'h/dir-view-file))
+ :active (when-let ((entry-at-point (h/dir--entry-at-point)))
+ (not (h//entry-directory-p entry-at-point)))
:help "View file at point"])
("Version"
:label (format "Version (%s)"
- (or (hyperdrive-entry-version hyperdrive-current-entry)
+ (or (he/version h/current-entry)
"latest"))
["Previous Version" (lambda ()
(interactive)
- (call-interactively
#'hyperdrive-open-previous-version))
- :active (hyperdrive-entry-previous hyperdrive-current-entry :cache-only
t)
+ (call-interactively #'h/open-previous-version))
+ :active (he/previous h/current-entry :cache-only t)
:label (concat "Previous Version"
- (pcase-exhaustive (hyperdrive-entry-previous
hyperdrive-current-entry :cache-only t)
+ (pcase-exhaustive (he/previous h/current-entry
:cache-only t)
('unknown (format " (?)"))
('nil nil)
((cl-struct hyperdrive-entry version)
@@ -1167,50 +1151,50 @@ The return value of this function is the retrieval
buffer."
:help "Open previous version"]
["Next Version" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-open-next-version))
- :active (and (hyperdrive-entry-version hyperdrive-current-entry)
- (hyperdrive-entry-next hyperdrive-current-entry))
+ (call-interactively #'h/open-next-version))
+ :active (and (he/version h/current-entry)
+ (he/next h/current-entry))
:label (concat "Next Version"
- (when-let* ((entry hyperdrive-current-entry)
- (next-entry (hyperdrive-entry-next entry))
+ (when-let* ((entry h/current-entry)
+ (next-entry (he/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)))
+ (display-version (if-let ((next-version
(he/version next-entry)))
(number-to-string
next-version)
"latest")))
(format " (%s)" display-version)))
:help "Open next version"]
["Open Specific Version" (lambda ()
(interactive)
- (call-interactively
#'hyperdrive-open-at-version))
+ (call-interactively #'h/open-at-version))
:help "Open specific version"]
["Version History" (lambda ()
(interactive)
- (call-interactively #'hyperdrive-history))
+ (call-interactively #'h/history))
:help "Open version history"]))
"---"
("Bookmark"
- ["Bookmark Jump" hyperdrive-bookmark-jump
+ ["Bookmark Jump" h/bookmark-jump
:help "Jump to hyperdrive bookmark"]
- ["Bookmark List" hyperdrive-bookmark-list
+ ["Bookmark List" h/bookmark-list
:help "List hyperdrive bookmarks"]
["Bookmark Set" bookmark-set
- :active hyperdrive-current-entry
+ :active h/current-entry
:help "Create a new hyperdrive bookmark"])
"---"
- ["Customize" hyperdrive-customize
+ ["Customize" h/customize
:help "Customize hyperdrive options"]
- ["User Manual" hyperdrive-info-manual
+ ["User Manual" h/info-manual
:help "Open hyperdrive.el info manual"]))
-(easy-menu-define hyperdrive-easy-menu hyperdrive-mode-map
- "Menu with all Hyperdrive commands." hyperdrive-menu-bar-menu)
+(easy-menu-define h/easy-menu h/mode-map
+ "Menu with all Hyperdrive commands." h/menu-bar-menu)
;;;###autoload
(define-minor-mode hyperdrive-menu-bar-mode "Show hyperdrive in \"Tools\" menu
bar."
:global t :group 'hyperdrive
- (if hyperdrive-menu-bar-mode
- (easy-menu-add-item menu-bar-tools-menu nil hyperdrive-menu-bar-menu
+ (if h/menu-bar-mode
+ (easy-menu-add-item menu-bar-tools-menu nil h/menu-bar-menu
"Read Net News")
(easy-menu-remove-item menu-bar-tools-menu nil "Hyperdrive")))
@@ -1224,31 +1208,31 @@ The return value of this function is the retrieval
buffer."
;;;###autoload
(defun hyperdrive-info-manual ()
- "Open hyperdrive.el info manual."
+ "Open Hyperdrive info manual."
(interactive)
(info "(hyperdrive) Top"))
;;;;; Markdown link support
-(defun hyperdrive--markdown-follow-link (url)
+(defun h//markdown-follow-link (url)
"Follow URL.
For use in `markdown-follow-link-functions'."
(pcase (url-type (url-generic-parse-url url))
- ((and `nil (guard (and hyperdrive-mode hyperdrive-current-entry)))
- (hyperdrive-open (hyperdrive--markdown-url-entry url))
+ ((and `nil (guard (and h/mode h/current-entry)))
+ (h/open (h//markdown-url-entry url))
t)
(_ nil)))
-(defun hyperdrive--markdown-url-entry (url)
+(defun h//markdown-url-entry (url)
"Return hyperdrive entry for URL in `markdown-mode' buffer.
Intended for relative (i.e. non-full) URLs."
(pcase-let (((cl-struct url filename) (url-generic-parse-url url))
((cl-struct hyperdrive-entry hyperdrive path)
- hyperdrive-current-entry))
+ h/current-entry))
;; NOTE: Depending on the resolution of
;; <https://github.com/jrblevin/markdown-mode/issues/805>, we may
;; want to URL-decode paths. For now, we won't.
- (hyperdrive-entry-create
+ (he/create
:hyperdrive hyperdrive
:path (expand-file-name filename (file-name-directory path))
;; FIXME: Target.
@@ -1262,6 +1246,8 @@ Intended for relative (i.e. non-full) URLs."
;;;;; `find-file-at-point' (`ffap') support
+(eval-when-compile (require 'ffap))
+
(with-eval-after-load 'ffap
(setf ffap-url-regexp
(if ffap-url-regexp
@@ -1270,17 +1256,30 @@ Intended for relative (i.e. non-full) URLs."
;;;;; Embark integration
+(defvar embark-general-map)
+(defvar embark-keymap-alist)
+
+(declare-function h/menu-hyperdrive "hyperdrive-menu" nil t)
+
(with-eval-after-load 'embark
- (defvar-keymap hyperdrive-embark-hyperdrive-map
+ (defvar-keymap h/embark-hyperdrive-map
:doc "Keymap for Embark actions on hyperdrives."
:parent embark-general-map
- "h" #'hyperdrive-menu-hyperdrive
- "p" #'hyperdrive-set-petname
- "n" #'hyperdrive-set-nickname)
+ "h" #'h/menu-hyperdrive
+ "p" #'h/set-petname
+ "n" #'h/set-nickname)
- (add-to-list 'embark-keymap-alist '(hyperdrive .
hyperdrive-embark-hyperdrive-map)))
+ (add-to-list 'embark-keymap-alist '(hyperdrive . h/embark-hyperdrive-map)))
;;;; Footer
(provide 'hyperdrive)
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
;;; hyperdrive.el ends here
diff --git a/tests/test-hyperdrive-markdown.el
b/tests/test-hyperdrive-markdown.el
index 58eb08b575..c17db9f3bc 100644
--- a/tests/test-hyperdrive-markdown.el
+++ b/tests/test-hyperdrive-markdown.el
@@ -40,13 +40,13 @@
;;;; Parse relative/absolute link into entry tests
;; Neither full "hyper://"-prefixed URLs, nor links which are only search
-;; options, are handled by `hyperdrive--org-link-entry-at-point'.
+;; options, are handled by `h/org--link-entry-at-point'.
-(defmacro hyperdrive-test-markdown-parse-link-deftest (name current-entry link
parsed-entry)
+(defmacro h/test-markdown-parse-link-deftest (name current-entry link
parsed-entry)
(declare (indent defun))
(let ((test-name (intern (format "hyperdrive-test-markdown-parse-link/%s"
name))))
`(ert-deftest ,test-name ()
- (let ((hyperdrive-current-entry ,current-entry))
+ (let ((h/current-entry ,current-entry))
(with-temp-buffer
;; FIXME: Use persistent buffer for performance.
(markdown-mode)
@@ -54,62 +54,71 @@
(insert ,link)
(goto-char (point-min))
(should
- (hyperdrive-entry-equal-p ,parsed-entry
- (hyperdrive--markdown-url-entry
(markdown-link-url)))))))))
+ (he/equal-p ,parsed-entry
+ (h//markdown-url-entry (markdown-link-url)))))))))
-(hyperdrive-test-markdown-parse-link-deftest absolute/without-search-option
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+(h/test-markdown-parse-link-deftest absolute/without-search-option
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.md")
"[link](</foo/bar quux.md>)"
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.md"))
-(hyperdrive-test-markdown-parse-link-deftest parent/without-search-option
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+(h/test-markdown-parse-link-deftest parent/without-search-option
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.md")
"[link](<../foo/bar quux.md>)"
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.md"))
-(hyperdrive-test-markdown-parse-link-deftest sibling/without-search-option
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+(h/test-markdown-parse-link-deftest sibling/without-search-option
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.md")
"[link](<./bar quux.md>)"
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.md"))
-;; (hyperdrive-test-markdown-parse-link-deftest
sibling/with-heading-text-search-option
-;; (hyperdrive-entry-create
-;; :hyperdrive (hyperdrive-create :public-key "deadbeef")
+;; (h/test-markdown-parse-link-deftest sibling/with-heading-text-search-option
+;; (he/create
+;; :hyperdrive (h/create :public-key "deadbeef")
;; :path "/foo/bar quux.md")
;; "[link](<./bar quux.md::Heading A>)"
-;; (hyperdrive-entry-create
-;; :hyperdrive (hyperdrive-create :public-key "deadbeef")
+;; (he/create
+;; :hyperdrive (h/create :public-key "deadbeef")
;; :path "/foo/bar quux.md"
;; :etc '((target . "Heading A"))))
-;; (hyperdrive-test-markdown-parse-link-deftest
sibling/with-heading-text*-search-option
-;; (hyperdrive-entry-create
-;; :hyperdrive (hyperdrive-create :public-key "deadbeef")
+;; (h/test-markdown-parse-link-deftest sibling/with-heading-text*-search-option
+;; (he/create
+;; :hyperdrive (h/create :public-key "deadbeef")
;; :path "/foo/bar quux.md")
;; "[link](<./bar quux.md::*Heading A>)"
-;; (hyperdrive-entry-create
-;; :hyperdrive (hyperdrive-create :public-key "deadbeef")
+;; (he/create
+;; :hyperdrive (h/create :public-key "deadbeef")
;; :path "/foo/bar quux.md"
;; :etc '((target . "*Heading A"))))
-;; (hyperdrive-test-markdown-parse-link-deftest
sibling/with-custom-id-search-option
-;; (hyperdrive-entry-create
-;; :hyperdrive (hyperdrive-create :public-key "deadbeef")
+;; (h/test-markdown-parse-link-deftest sibling/with-custom-id-search-option
+;; (he/create
+;; :hyperdrive (h/create :public-key "deadbeef")
;; :path "/foo/bar quux.md")
;; "[link](<./bar quux.md::#baz zot>)"
-;; (hyperdrive-entry-create
-;; :hyperdrive (hyperdrive-create :public-key "deadbeef")
+;; (he/create
+;; :hyperdrive (h/create :public-key "deadbeef")
;; :path "/foo/bar quux.md"
;; :etc '((target . "#baz zot"))))
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
+;;; test-hyperdrive-markdown.el ends here
diff --git a/tests/test-hyperdrive-org.el b/tests/test-hyperdrive-org.el
index 1a8fd336bc..46474e05e0 100644
--- a/tests/test-hyperdrive-org.el
+++ b/tests/test-hyperdrive-org.el
@@ -41,7 +41,7 @@
;;;;; Scenarios
-(defvar hyperdrive-test-org-store-link-scenarios
+(defvar h/test-org-store-link-scenarios
'((org-mode-before-heading
:public-key "deadbeef"
:path "/foo/bar quux.org"
@@ -78,83 +78,67 @@ Each value is a plist with the following keys:
;;;;; Store links
-(cl-defun hyperdrive-test-org-store-link (contents &key public-key path)
+(cl-defun h/test-org-store-link (contents &key public-key path)
"Return stored link to entry with PUBLIC-KEY, PATH, and CONTENTS.
Point is indicated by ★."
(declare (indent defun))
- (let ((entry (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key public-key)
+ (let ((entry (he/create
+ :hyperdrive (h/create :public-key public-key)
:path path))
org-id-link-to-org-use-id org-stored-links)
(with-temp-buffer
(insert contents)
;; TODO: Initialize this buffer only once for this file's tests.
(org-mode)
- (hyperdrive-mode)
- (setq-local hyperdrive-current-entry entry)
+ (h/mode)
+ (setq-local h/current-entry entry)
(goto-char (point-min))
(search-forward "★")
- (org-store-link nil 'interactive)
- ;; Disable the mode because on Emacs 27, `with-temp-buffer'
- ;; calls kill-buffer hooks and stuff like that which cause
- ;; prompting to kill the buffer when running the tests.
- (hyperdrive-mode -1))
+ (org-store-link nil 'interactive))
org-stored-links))
-(defmacro hyperdrive-test-org-store-link-deftest (scenario)
+(defmacro h/test-org-store-link-deftest (scenario)
"Test scenario in `hyperdrive-test-org-store-link-scenarios'."
(let ((test-name (intern
(format "hyperdrive-test-org-store-link/%s" scenario))))
`(ert-deftest ,test-name ()
- (pcase-let* (((map (:public-key public-key) (:path path) (:content
content)
+ (pcase-let* (((map :public-key :path :content
(:url expected-url) (:desc expected-desc))
;; TODO: Is there a better syntax that explicit `quote'?
(alist-get (quote ,scenario)
- hyperdrive-test-org-store-link-scenarios))
+ h/test-org-store-link-scenarios))
(`((,got-url ,got-desc))
- (hyperdrive-test-org-store-link content
+ (h/test-org-store-link content
:public-key public-key :path path)))
(should (string= expected-url got-url))
- (should (string= ,(if ;; TODO(deprecate-27): Remove this hack someday.
- (and (version<= org-version "9.4.4")
- (equal scenario 'org-mode-before-heading))
- '(progn
- (ignore expected-desc)
- expected-url)
- 'expected-desc)
- got-desc))))))
-
-;; TODO: Loop through `hyperdrive-test-org-store-link-scenarios'?
-(hyperdrive-test-org-store-link-deftest org-mode-before-heading)
-(hyperdrive-test-org-store-link-deftest org-mode-on-heading-with-custom-id)
-(hyperdrive-test-org-store-link-deftest org-mode-on-heading-no-custom-id)
+ (should (string= expected-desc got-desc))))))
+
+;; TODO: Loop through `h/test-org-store-link-scenarios'?
+(h/test-org-store-link-deftest org-mode-before-heading)
+(h/test-org-store-link-deftest org-mode-on-heading-with-custom-id)
+(h/test-org-store-link-deftest org-mode-on-heading-no-custom-id)
;;;;; Insert links
-(cl-defun hyperdrive-test-org-entry-create (&key public-key path)
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key public-key)
+(cl-defun h/test-org-entry-create (&key public-key path)
+ (he/create
+ :hyperdrive (h/create :public-key public-key)
:path path))
-(cl-defun hyperdrive-test-org-insert-link-string (scenario &key public-key
path)
+(cl-defun h/test-org-insert-link-string (scenario &key public-key path)
"Return link for SCENARIO inserted into entry with PUBLIC-KEY and PATH."
(declare (indent defun))
- (pcase-let (((map (:url url) (:desc desc))
- (alist-get scenario hyperdrive-test-org-store-link-scenarios)))
+ (pcase-let (((map :url :desc) (alist-get scenario
h/test-org-store-link-scenarios)))
(with-temp-buffer
;; TODO: Initialize this buffer only once for this file's tests.
(org-mode)
- (hyperdrive-mode)
- (setq-local hyperdrive-current-entry (hyperdrive-test-org-entry-create
- :public-key public-key :path path))
+ (h/mode)
+ (setq-local h/current-entry (h/test-org-entry-create
+ :public-key public-key :path path))
(org-insert-link nil url desc)
- ;; Disable the mode because on Emacs 27, `with-temp-buffer'
- ;; calls kill-buffer hooks and stuff like that which cause
- ;; prompting to kill the buffer when running the tests.
- (hyperdrive-mode -1)
(buffer-string))))
-(cl-defmacro hyperdrive-test-org-insert-link-deftest (name &key public-key
path results)
+(cl-defmacro h/test-org-insert-link-deftest (name &key public-key path results)
"Test inserted link in entry with PUBLIC-KEY and PATH.
Scenario is the first part of NAME, and RESULTS contain let-bound
variables and the expected link."
@@ -169,14 +153,14 @@ variables and the expected link."
(push `(ert-deftest ,test-name ()
(let (,@vars)
(should (string= ,result
- (hyperdrive-test-org-insert-link-string
',scenario
+ (h/test-org-insert-link-string ',scenario
:public-key ,public-key :path ,path)))))
body-forms)))
`(progn ,@body-forms)))
;;;;;; Insert shorthand links
-(hyperdrive-test-org-insert-link-deftest
org-mode-before-heading/same-drive-same-path
+(h/test-org-insert-link-deftest org-mode-before-heading/same-drive-same-path
:public-key "deadbeef"
:path "/foo/bar quux.org"
:results (( :let ((org-link-file-path-type 'relative))
@@ -188,7 +172,7 @@ variables and the expected link."
( :let ((org-link-file-path-type 'adaptive))
:result "[[./bar quux.org]]")))
-(hyperdrive-test-org-insert-link-deftest
org-mode-on-heading-with-custom-id/same-drive-same-path
+(h/test-org-insert-link-deftest
org-mode-on-heading-with-custom-id/same-drive-same-path
:public-key "deadbeef"
:path "/foo/bar quux.org"
:results (( :let ((org-link-file-path-type 'relative))
@@ -200,7 +184,7 @@ variables and the expected link."
( :let ((org-link-file-path-type 'adaptive))
:result "[[#baz zot][Heading A]]")))
-(hyperdrive-test-org-insert-link-deftest
org-mode-on-heading-no-custom-id/same-drive-same-path
+(h/test-org-insert-link-deftest
org-mode-on-heading-no-custom-id/same-drive-same-path
:public-key "deadbeef"
:path "/foo/bar quux.org"
:results (( :let ((org-link-file-path-type 'relative))
@@ -212,7 +196,7 @@ variables and the expected link."
( :let ((org-link-file-path-type 'adaptive))
:result "[[*Heading A][Heading A]]")))
-(hyperdrive-test-org-insert-link-deftest
org-mode-before-heading/same-drive-different-path
+(h/test-org-insert-link-deftest
org-mode-before-heading/same-drive-different-path
:public-key "deadbeef"
:path "/thud.org"
:results (( :let ((org-link-file-path-type 'relative))
@@ -224,7 +208,7 @@ variables and the expected link."
( :let ((org-link-file-path-type 'adaptive))
:result "[[./foo/bar quux.org]]")))
-(hyperdrive-test-org-insert-link-deftest
org-mode-on-heading-with-custom-id/same-drive-different-path
+(h/test-org-insert-link-deftest
org-mode-on-heading-with-custom-id/same-drive-different-path
:public-key "deadbeef"
:path "/thud.org"
:results (( :let ((org-link-file-path-type 'relative))
@@ -236,7 +220,7 @@ variables and the expected link."
( :let ((org-link-file-path-type 'adaptive))
:result "[[./foo/bar quux.org::#baz zot][Heading A]]")))
-(hyperdrive-test-org-insert-link-deftest
org-mode-on-heading-no-custom-id/same-drive-different-path
+(h/test-org-insert-link-deftest
org-mode-on-heading-no-custom-id/same-drive-different-path
:public-key "deadbeef"
:path "/thud.org"
:results (( :let ((org-link-file-path-type 'relative))
@@ -251,21 +235,21 @@ variables and the expected link."
;;;;;; Insert full "hyper://" links
;; Testing a different drive should stand in for testing
-;; `hyperdrive-org-link-full-url' as well as insertion in
+;; `h/org-link-full-url' as well as insertion in
;; non-hyperdrive buffers, since all of these cases cause
-;; `hyperdrive--org-insert-link-after-advice' to do nothing.
+;; `h/org--insert-link-after-advice' to do nothing.
-(hyperdrive-test-org-insert-link-deftest
org-mode-before-heading/different-drive
+(h/test-org-insert-link-deftest org-mode-before-heading/different-drive
:public-key "fredbeef"
:path "/thud.org"
:results ((:result "[[hyper://deadbeef/foo/bar%20quux.org]]")))
-(hyperdrive-test-org-insert-link-deftest
org-mode-on-heading-with-custom-id/different-drive
+(h/test-org-insert-link-deftest
org-mode-on-heading-with-custom-id/different-drive
:public-key "fredbeef"
:path "/thud.org"
:results ((:result
"[[hyper://deadbeef/foo/bar%20quux.org#%3A%3A%23baz%20zot][Heading A]]")))
-(hyperdrive-test-org-insert-link-deftest
org-mode-on-heading-no-custom-id/different-drive
+(h/test-org-insert-link-deftest
org-mode-on-heading-no-custom-id/different-drive
:public-key "fredbeef"
:path "/thud.org"
:results
@@ -274,13 +258,13 @@ variables and the expected link."
;;;; Parse relative/absolute link into entry tests
;; Neither full "hyper://"-prefixed URLs, nor links which are only search
-;; options, are handled by `hyperdrive--org-link-entry-at-point'.
+;; options, are handled by `h/org--link-entry-at-point'.
-(defmacro hyperdrive-org-test-link-parse-deftest (name current-entry link
parsed-entry)
+(defmacro h/org-test-link-parse-deftest (name current-entry link parsed-entry)
(declare (indent defun))
(let ((test-name (intern (format "hyperdrive-test-org-parse-link/%s" name))))
`(ert-deftest ,test-name ()
- (let ((hyperdrive-current-entry ,current-entry))
+ (let ((h/current-entry ,current-entry))
(with-temp-buffer
;; FIXME: Use persistent buffer for performance.
(org-mode)
@@ -288,61 +272,70 @@ variables and the expected link."
(insert ,link)
(goto-char (point-min))
(should
- (hyperdrive-entry-equal-p ,parsed-entry
(hyperdrive--org-link-entry-at-point))))))))
+ (he/equal-p ,parsed-entry (h/org--link-entry-at-point))))))))
-(hyperdrive-org-test-link-parse-deftest absolute/without-search-option
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+(h/org-test-link-parse-deftest absolute/without-search-option
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.org")
"[[/foo/bar quux.org]]"
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.org"))
-(hyperdrive-org-test-link-parse-deftest parent/without-search-option
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+(h/org-test-link-parse-deftest parent/without-search-option
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.org")
"[[../foo/bar quux.org]]"
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.org"))
-(hyperdrive-org-test-link-parse-deftest sibling/without-search-option
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+(h/org-test-link-parse-deftest sibling/without-search-option
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.org")
"[[./bar quux.org]]"
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.org"))
-(hyperdrive-org-test-link-parse-deftest sibling/with-heading-text-search-option
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+(h/org-test-link-parse-deftest sibling/with-heading-text-search-option
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.org")
"[[./bar quux.org::Heading A]]"
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.org"
:etc '((target . "Heading A"))))
-(hyperdrive-org-test-link-parse-deftest
sibling/with-heading-text*-search-option
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+(h/org-test-link-parse-deftest sibling/with-heading-text*-search-option
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.org")
"[[./bar quux.org::*Heading A]]"
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.org"
:etc '((target . "*Heading A"))))
-(hyperdrive-org-test-link-parse-deftest sibling/with-custom-id-search-option
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+(h/org-test-link-parse-deftest sibling/with-custom-id-search-option
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.org")
"[[./bar quux.org::#baz zot]]"
- (hyperdrive-entry-create
- :hyperdrive (hyperdrive-create :public-key "deadbeef")
+ (he/create
+ :hyperdrive (h/create :public-key "deadbeef")
:path "/foo/bar quux.org"
:etc '((target . "#baz zot"))))
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
+;;; test-hyperdrive-org.el ends here
diff --git a/tests/test-hyperdrive.el b/tests/test-hyperdrive.el
index 1c6882fc7b..64baf43e7b 100644
--- a/tests/test-hyperdrive.el
+++ b/tests/test-hyperdrive.el
@@ -45,7 +45,7 @@
;;;; Utilities
-(defmacro hyperdrive-deftest (name &rest args)
+(defmacro h/deftest (name &rest args)
(declare (indent defun))
(let ((name (intern (concat "hyperdrive-" (symbol-name name)))))
`(cl-macrolet ((make-url
@@ -54,81 +54,90 @@
;;;; Tests
-(hyperdrive-deftest url-entry--names-and-paths ()
+(h/deftest url-entry--names-and-paths ()
(pcase-let (((cl-struct hyperdrive-entry name path)
- (hyperdrive-url-entry (make-url ""))))
+ (h/url-entry (make-url ""))))
(should (equal name "/"))
(should (equal path "/")))
(pcase-let (((cl-struct hyperdrive-entry name path)
- (hyperdrive-url-entry (make-url "/"))))
+ (h/url-entry (make-url "/"))))
(should (equal name "/"))
(should (equal path "/")))
(pcase-let (((cl-struct hyperdrive-entry name path)
- (hyperdrive-url-entry (make-url "/name-without-spaces"))))
+ (h/url-entry (make-url "/name-without-spaces"))))
(should (equal name "name-without-spaces"))
(should (equal path "/name-without-spaces")))
;; TODO: Consider testing unhexified filename in URL.
(pcase-let (((cl-struct hyperdrive-entry name path)
- (hyperdrive-url-entry (make-url (hyperdrive--url-hexify-string
"/name with spaces")))))
+ (h/url-entry (make-url (h//url-hexify-string "/name with
spaces")))))
(should (equal name "name with spaces"))
(should (equal path "/name with spaces")))
(pcase-let (((cl-struct hyperdrive-entry name path)
- (hyperdrive-url-entry (make-url "/subdir/"))))
+ (h/url-entry (make-url "/subdir/"))))
(should (equal name "subdir/"))
(should (equal path "/subdir/")))
(pcase-let (((cl-struct hyperdrive-entry name path)
- (hyperdrive-url-entry (make-url "/subdir/with-file"))))
+ (h/url-entry (make-url "/subdir/with-file"))))
(should (equal name "with-file"))
(should (equal path "/subdir/with-file"))))
-(hyperdrive-deftest url-entry--version ()
+(h/deftest url-entry--version ()
(pcase-let (((cl-struct hyperdrive-entry name path version)
- (hyperdrive-url-entry (make-url "/$/version/42"))))
+ (h/url-entry (make-url "/$/version/42"))))
(should (equal name "/"))
(should (equal path "/"))
(should (equal 42 version)))
(pcase-let (((cl-struct hyperdrive-entry name path version)
- (hyperdrive-url-entry (make-url "/$/version/42/"))))
+ (h/url-entry (make-url "/$/version/42/"))))
(should (equal name "/"))
(should (equal path "/"))
(should (equal 42 version)))
(pcase-let (((cl-struct hyperdrive-entry name path version)
- (hyperdrive-url-entry (make-url
"/$/version/42/name-without-spaces"))))
+ (h/url-entry (make-url "/$/version/42/name-without-spaces"))))
(should (equal name "name-without-spaces"))
(should (equal path "/name-without-spaces"))
(should (equal 42 version)))
(pcase-let (((cl-struct hyperdrive-entry name path version)
- (hyperdrive-url-entry (make-url "/$/version/42/subdir/"))))
+ (h/url-entry (make-url "/$/version/42/subdir/"))))
(should (equal name "subdir/"))
(should (equal path "/subdir/"))
(should (equal 42 version)))
(pcase-let (((cl-struct hyperdrive-entry name path version)
- (hyperdrive-url-entry (make-url
"/$/version/42/subdir/with-file"))))
+ (h/url-entry (make-url "/$/version/42/subdir/with-file"))))
(should (equal name "with-file"))
(should (equal path "/subdir/with-file"))
(should (equal 42 version))))
-(hyperdrive-deftest url-entry--makes-hyperdrive ()
+(h/deftest url-entry--makes-hyperdrive ()
(pcase-let* (((cl-struct hyperdrive-entry hyperdrive)
- (hyperdrive-url-entry (make-url (hyperdrive--url-hexify-string
"/subdir/with-file"))))
+ (h/url-entry (make-url (h//url-hexify-string
"/subdir/with-file"))))
((cl-struct hyperdrive public-key) hyperdrive))
(should (equal public-key test-hyperdrive-public-key))))
-(hyperdrive-deftest entry-url-round-trip ()
+(h/deftest entry-url-round-trip ()
- (let ((url (hyperdrive-entry-url (hyperdrive-url-entry (make-url "")))))
+ (let ((url (he/url (h/url-entry (make-url "")))))
(should (equal url (concat "hyper://" test-hyperdrive-public-key "/"))))
- (let ((url (hyperdrive-entry-url (hyperdrive-url-entry (make-url "/")))))
+ (let ((url (he/url (h/url-entry (make-url "/")))))
(should (equal url (concat "hyper://" test-hyperdrive-public-key "/"))))
- (let ((url (hyperdrive-entry-url (hyperdrive-url-entry (make-url
"/name-without-spaces")))))
+ (let ((url (he/url (h/url-entry (make-url "/name-without-spaces")))))
(should (equal url (concat "hyper://" test-hyperdrive-public-key
"/name-without-spaces"))))
- (let ((url (hyperdrive-entry-url (hyperdrive-url-entry (make-url
"/name%20without%20spaces")))))
+ (let ((url (he/url (h/url-entry (make-url "/name%20without%20spaces")))))
(should (equal url (concat "hyper://" test-hyperdrive-public-key
"/name%20without%20spaces"))))
- (let ((url (hyperdrive-entry-url (hyperdrive-url-entry
- (make-url
"/name%20without%20spaces/subdir")))))
+ (let ((url (he/url (h/url-entry
+ (make-url "/name%20without%20spaces/subdir")))))
(should (equal url (concat "hyper://" test-hyperdrive-public-key
"/name%20without%20spaces/subdir")))))
+
+;; Local Variables:
+;; read-symbol-shorthands: (
+;; ("he//" . "hyperdrive-entry--")
+;; ("he/" . "hyperdrive-entry-")
+;; ("h//" . "hyperdrive--")
+;; ("h/" . "hyperdrive-"))
+;; End:
+;;; test-hyperdrive.el ends here
- [nongnu] elpa/hyperdrive d0d444aab2 040/102: Change: (hyperdrive-mirror) Rename PREDICATE argument to FILTER, (continued)
- [nongnu] elpa/hyperdrive d0d444aab2 040/102: Change: (hyperdrive-mirror) Rename PREDICATE argument to FILTER, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 3a778929b8 041/102: Change: (hyperdrive-menu-hyperdrive) Wording of Mirror command, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive fea9674bd2 047/102: Change: (hyperdrive--format-entry) Add faces, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 30f378df0a 065/102: Fix: Fix indentation, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive e640a14d84 067/102: Change: (hyperdrive-{message, error}) Call substitute-command-keys, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 6f56f99d7d 071/102: Fix: (-org--open-at-point) Only call -open on hyper:// links, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 88948716a3 049/102: Docs: Document entry format defcustoms, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 853068609b 095/102: Tidy: Appease spellcheck linter, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 7c52a96078 092/102: Change: Don't autoload register-definition-prefixes, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 32658e6c5f 089/102: Notes: Update, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 902e52ad58 098/102: Merge: Add hyperdrive-menu transient, shorthands...,
ELPA Syncer <=