[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/hyperdrive 514d771d5b 070/102: Use shorthands he//, he/, h
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/hyperdrive 514d771d5b 070/102: Use shorthands he//, he/, h// and h/ |
|
Date: |
Wed, 29 Nov 2023 04:00:54 -0500 (EST) |
branch: elpa/hyperdrive
commit 514d771d5ba36b317e1a2fc49552b32cb54bf543
Author: Jonas Bernoulli <jonas@bernoul.li>
Commit: Adam Porter <adam@alphapapa.net>
Use shorthands he//, he/, h// and h/
But not inside or following autoload cookies, to work around the fact
that autoload extraction is not aware of shorthands yet.
---
hyperdrive-describe.el | 45 ++-
hyperdrive-diff.el | 43 +-
hyperdrive-dir.el | 277 ++++++-------
hyperdrive-ewoc.el | 49 ++-
hyperdrive-history.el | 237 +++++------
hyperdrive-lib.el | 801 ++++++++++++++++++-------------------
hyperdrive-menu.el | 398 ++++++++++---------
hyperdrive-mirror.el | 155 ++++----
hyperdrive-org.el | 117 +++---
hyperdrive-vars.el | 181 +++++----
hyperdrive.el | 807 +++++++++++++++++++-------------------
tests/test-hyperdrive-markdown.el | 79 ++--
tests/test-hyperdrive-org.el | 145 +++----
tests/test-hyperdrive.el | 55 +--
14 files changed, 1757 insertions(+), 1632 deletions(-)
diff --git a/hyperdrive-describe.el b/hyperdrive-describe.el
index 0de5c7f5b6..85a291c2f8 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,24 +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
hyperdrive "%k")))
+ (format "*Hyperdrive: %s*" (h//format hyperdrive
"%k")))
(with-silent-modifications
- (hyperdrive-describe-mode)
- (setq-local hyperdrive-describe-current-hyperdrive 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)
- (hyperdrive--format hyperdrive "Public key %K:\n"
hyperdrive-raw-formats)
- (hyperdrive--format hyperdrive "Seed: %S\n" hyperdrive-raw-formats)
- (hyperdrive--format hyperdrive "Petname: %P\n" hyperdrive-raw-formats)
- (hyperdrive--format hyperdrive "Nickname: %N\n"
hyperdrive-raw-formats)
- (hyperdrive--format hyperdrive "Domains: %D\n" hyperdrive-raw-formats)
- (format "Latest version: %s\n" (hyperdrive-latest-version hyperdrive))
+ (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
@@ -83,22 +83,31 @@ 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)
+
+;;;###autoload(register-definition-prefixes "hyperdrive-describe"
'("hyperdrive-"))
+;; 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 05c2440ba8..6fd0bc5649 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,16 +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--format-entry
- old-entry
hyperdrive-buffer-name-format)))
+ (h//format-entry
+ old-entry
h/buffer-name-format)))
(new-buffer (generate-new-buffer
- (hyperdrive--format-entry
- new-entry
hyperdrive-buffer-name-format)))
+ (h//format-entry
+ new-entry
h/buffer-name-format)))
;; TODO: Improve diff buffer name.
(diff-buffer (get-buffer-create
"*hyperdrive-diff*")))
(when old-response
@@ -89,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
@@ -117,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--format-entry (car
hyperdrive-diff-entries))
- (hyperdrive--format-entry (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)))))
@@ -130,4 +130,13 @@ This function is intended to diff files, not directories."
;;;; Footer
(provide 'hyperdrive-diff)
+
+;;;###autoload(register-definition-prefixes "hyperdrive-diff" '("hyperdrive-"))
+;; 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 a2e0a24981..339cb31b6c 100644
--- a/hyperdrive-dir.el
+++ b/hyperdrive-dir.el
@@ -29,7 +29,7 @@
(require 'cl-lib)
(require 'hyperdrive-lib)
-(require 'hyperdrive-ewoc)
+(require 'h/ewoc)
;;;; Variables
@@ -44,58 +44,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--format-entry 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
@@ -108,43 +108,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)
@@ -159,17 +159,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'."
@@ -180,219 +180,228 @@ 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
+ (declare (modes h/dir-mode))
+ (interactive (list (or (h/dir--entry-at-point)
+ (h/user-error "No file/directory at point"))))
+ (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))
+ (declare (modes h/dir-mode))
+ (interactive (list (or (h/dir--entry-at-point)
+ (h/user-error "No file/directory at point"))))
+ (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))
+ (declare (modes h/dir-mode))
+ (interactive (list (or (h/dir--entry-at-point)
+ (h/user-error "No file/directory at point"))))
+ (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))
+ (declare (modes h/dir-mode))
+ (interactive (list (or (h/dir--entry-at-point)
+ (h/user-error "No file/directory at point"))))
+ (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 "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--format-entry 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)
+
+;;;###autoload(register-definition-prefixes "hyperdrive-dir" '("hyperdrive-"))
+;; 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..8d0c3de027 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,11 +69,11 @@ 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))
+ (declare (modes h/ewoc-mode))
(interactive "p")
;; TODO: Try using the intangible text property on headers to
;; automatically skip over them without conditional code. Setting
@@ -81,35 +81,35 @@ column headers."
;; 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))
+ (declare (modes h/ewoc-mode))
(interactive "p")
(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 +117,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 +128,14 @@ PREDICATE is called with the full node."
when (funcall predicate node)
collect node))
-(provide 'hyperdrive-ewoc)
+(provide 'h/ewoc)
+
+;;;###autoload(register-definition-prefixes "hyperdrive-ewoc" '("hyperdrive-"))
+;; 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 44f098e8cc..b91f58233d 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--format-entry entry "[%H] %p"))
+ (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*"
- (hyperdrive--format-entry entry "[%H] %p")))
+ (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,48 @@ 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))
+ (declare (modes h/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)))
+ (setf old-entry (h/copy-tree new-entry t))
+ (cl-decf (he/version old-entry)))
(list old-entry new-entry)))
- (hyperdrive-diff-file-entries old-entry new-entry
+ (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 +273,20 @@ 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)
+ (declare (modes h/history-mode))
+ (interactive (list (h/history-range-entry-at-point)))
+ (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 +294,59 @@ 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
+ (declare (modes h/history-mode))
+ (interactive (list (h/history-range-entry-at-point)))
+ (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)
+ (declare (modes h/history-mode))
+ (interactive (list (h/history-range-entry-at-point)))
+ (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)
+ (declare (modes h/history-mode))
+ (interactive (list (h/history-range-entry-at-point)))
+ (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))
+ (declare (modes h/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 +355,27 @@ 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)))))
+ (expand-file-name name
h/download-directory)))))
(list range-entry read-filename)))
- (pcase-exhaustive (hyperdrive-range-entry-exists-p range-entry)
+ (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!"))))
-
-(provide 'hyperdrive-history)
+ (h/user-error "File not known to exist!"))))
+
+(provide 'h/history)
+
+;;;###autoload(register-definition-prefixes "hyperdrive-history"
'("hyperdrive-"))
+;; 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 47d545fa45..f2be6f9d4b 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -41,21 +41,21 @@
;;;; Declarations
-(declare-function hyperdrive-mode "hyperdrive")
-(declare-function hyperdrive-dir-mode "hyperdrive-dir")
+(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.")
@@ -72,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.")
@@ -85,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\".
@@ -97,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?
@@ -131,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
@@ -148,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
@@ -160,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)
@@ -181,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
@@ -191,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.
@@ -205,10 +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 "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))
(_
@@ -219,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.
@@ -259,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>.
@@ -272,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
@@ -284,60 +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)))
+ (version-less (he/create :hyperdrive hyperdrive :path path)))
(substring-no-properties
- (hyperdrive--format-entry-url version-less :host-format '(public-key)
- :with-protocol nil :with-target nil))))
+ (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.
@@ -347,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
@@ -365,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
@@ -375,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)
@@ -383,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.
@@ -437,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
@@ -485,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))))))
@@ -501,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")
@@ -535,40 +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--format-entry entry
hyperdrive-buffer-name-format))))
+ (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--format-entry
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
@@ -588,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:
@@ -638,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
@@ -697,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.
@@ -712,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.
@@ -734,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
@@ -761,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))))
@@ -824,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
@@ -855,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
@@ -886,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
@@ -899,21 +899,21 @@ 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)
- :body body :then then :else else :queue queue))
+ (h//write (he/url entry)
+ :body body :then then :else else :queue queue))
-(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))
"Return ENTRY's URL.
@@ -942,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--preferred-format
(hyperdrive-entry-hyperdrive entry)
- host-format
hyperdrive-raw-formats)))
+ (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)
@@ -951,16 +951,16 @@ 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))
url)))
-(defun hyperdrive--format (hyperdrive &optional format formats)
+(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."
@@ -968,31 +968,31 @@ according to FORMATS, by default `hyperdrive-formats',
which see."
(metadata (map ('name nickname))))
hyperdrive)
(format (or format "%H"))
- (formats (or formats hyperdrive-formats)))
+ (formats (or formats h/formats)))
(cl-labels ((fmt (naming value face)
(if value
(format (alist-get naming formats)
(propertize value 'face face))
"")))
(format-spec format
- `((?H . ,(lambda () (hyperdrive--preferred-format
hyperdrive)))
- (?P . ,(lambda () (fmt 'petname petname
'hyperdrive-petname)))
- (?N . ,(lambda () (fmt 'nickname nickname
'hyperdrive-nickname)))
- (?k . ,(lambda () (fmt 'short-key public-key
'hyperdrive-public-key)))
- (?K . ,(lambda () (fmt 'public-key public-key
'hyperdrive-public-key)))
- (?S . ,(lambda () (fmt 'seed seed 'hyperdrive-seed)))
+ `((?H . ,(lambda () (h//preferred-format hyperdrive)))
+ (?P . ,(lambda () (fmt 'petname petname 'h/petname)))
+ (?N . ,(lambda () (fmt 'nickname nickname 'h/nickname)))
+ (?k . ,(lambda () (fmt 'short-key public-key
'h/public-key)))
+ (?K . ,(lambda () (fmt 'public-key public-key
'h/public-key)))
+ (?S . ,(lambda () (fmt 'seed seed 'h/seed)))
(?D . ,(lambda ()
(if (car domains)
(format (alist-get 'domains formats)
(string-join
(mapcar (lambda (domain)
(propertize domain
- 'face
'hyperdrive-domain))
+ 'face
'h/domain))
domains)
","))
""))))))))
-(defun hyperdrive--preferred-format (hyperdrive &optional naming formats)
+(defun h//preferred-format (hyperdrive &optional naming formats)
"Return HYPERDRIVE's formatted hostname, or nil.
NAMING should be one or a list of symbols, by default
`hyperdrive-preferred-formats', which see for choices. If the
@@ -1003,63 +1003,63 @@ default to `hyperdrive-formats', which see."
(pcase-let* (((cl-struct hyperdrive petname public-key domains seed
(metadata (map ('name nickname))))
hyperdrive))
- (cl-loop for f in (ensure-list (or naming hyperdrive-preferred-formats))
+ (cl-loop for f in (ensure-list (or naming h/preferred-formats))
when (pcase f
((and 'petname (guard petname))
- (hyperdrive--format hyperdrive "%P" formats))
+ (h//format hyperdrive "%P" formats))
((and 'nickname (guard nickname))
- (hyperdrive--format hyperdrive "%N" formats))
+ (h//format hyperdrive "%N" formats))
((and 'domain (guard (car domains)))
- (hyperdrive--format hyperdrive "%D" formats))
+ (h//format hyperdrive "%D" formats))
((and 'seed (guard seed))
- (hyperdrive--format hyperdrive "%S" formats))
+ (h//format hyperdrive "%S" formats))
((and 'short-key (guard public-key))
- (hyperdrive--format hyperdrive "%k" formats))
+ (h//format hyperdrive "%k" formats))
((and 'public-key (guard public-key))
- (hyperdrive--format hyperdrive "%K" formats)))
+ (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
@@ -1072,19 +1072,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
+(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."
(string-trim
(cl-loop for format in formats
- when (hyperdrive--preferred-format hyperdrive format)
+ 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
@@ -1101,30 +1101,30 @@ 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.
@@ -1134,16 +1134,16 @@ INITIAL-INPUT-NUMBER is converted to a string and
passed to
(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
@@ -1154,52 +1154,52 @@ is passed to `read-string' as its DEFAULT-VALUE
argument."
"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
@@ -1219,99 +1219,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
@@ -1319,7 +1319,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.
@@ -1333,78 +1333,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--format-entry
- entry hyperdrive-buffer-name-format))
+ (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)))
+ (lambda (buffer) (h//buffer-visiting-entry-p buffer entry)))
-(defun hyperdrive--format-entry (entry &optional format formats)
+(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 hyperdrive-formats)))
+ (formats (or formats h/formats)))
(cl-labels ((fmt (naming value)
(if value
(format (alist-get naming formats) value)
"")))
(propertize
- (format-spec (or format hyperdrive-default-entry-format)
+ (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 () (hyperdrive--preferred-format
hyperdrive nil formats)))
- (?D . ,(lambda () (hyperdrive--format hyperdrive "%D"
formats)))
- (?k . ,(lambda () (hyperdrive--format hyperdrive "%k"
formats)))
- (?K . ,(lambda () (hyperdrive--format hyperdrive "%K"
formats)))
- (?N . ,(lambda () (hyperdrive--format hyperdrive "%N"
formats)))
- (?P . ,(lambda () (hyperdrive--format hyperdrive "%P"
formats)))
- (?S . ,(lambda () (hyperdrive--format hyperdrive "%S"
formats)))))
- 'help-echo (hyperdrive-entry-url entry)))))
-
-(defun hyperdrive--entry-directory-p (entry)
+ (?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: " (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: " (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'."
@@ -1414,7 +1414,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.
@@ -1423,19 +1423,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 \"/\"."
@@ -1448,12 +1448,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))
@@ -1467,7 +1467,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)
@@ -1480,16 +1480,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)
@@ -1497,4 +1497,13 @@ Unless PATH starts with \"/\" \"./\" or \"../\", add
\"./\"."
(concat "./" path)))
(provide 'hyperdrive-lib)
+
+;;;###autoload(register-definition-prefixes "hyperdrive-lib" '("hyperdrive-"))
+;; 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 55084e9bd5..0c6c26e43a 100644
--- a/hyperdrive-menu.el
+++ b/hyperdrive-menu.el
@@ -35,14 +35,14 @@
(require 'hyperdrive)
(require 'hyperdrive-vars)
(require 'hyperdrive-lib)
-(require 'hyperdrive-mirror)
+(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
@@ -50,9 +50,9 @@
;; (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)
@@ -63,169 +63,169 @@
[["Hyperdrive"
:description
(lambda ()
- (if-let* ((entry (hyperdrive-menu--scope))
- (hyperdrive (hyperdrive-entry-hyperdrive entry)))
+ (if-let* ((entry (h/menu--scope))
+ (hyperdrive (he/hyperdrive entry)))
(concat (propertize "Hyperdrive: " 'face 'transient-heading)
- (hyperdrive--format hyperdrive))
+ (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--scope)
+ (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--scope)))
+ (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--scope)
:cache-only t))
+ (he/previous (h/menu--scope) :cache-only t))
;; :transient t
:description (lambda ()
- (if-let ((entry (hyperdrive-menu--scope)))
+ (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--scope)))
- (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--scope))
- (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--scope))))]]
+ (h//entry-directory-p (h/menu--scope))))]]
[:if (lambda ()
- (and (hyperdrive-menu--scope)
+ (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))))
[;; Current
:description
(lambda ()
- (let ((entry (hyperdrive-menu--scope)))
+ (let ((entry (h/menu--scope)))
(concat (propertize "Current: " 'face 'transient-heading)
- (propertize (hyperdrive--format-path (hyperdrive-entry-path
entry))
+ (propertize (h//format-path (he/path entry))
'face 'transient-value))))
("g" "Refresh" revert-buffer)
- ("^" "Up to parent" hyperdrive-up
+ ("^" "Up to parent" h/up
:inapt-if-not (lambda ()
- (hyperdrive-parent (hyperdrive-menu--scope))))
- ("s" "Sort" hyperdrive-dir-sort
- :if-mode hyperdrive-dir-mode
+ (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 hyperdrive-dir-mode)
+ :if-mode h/dir-mode)
;; TODO: Combine previous and next commands on the same line?
- ("p" "Previous" hyperdrive-ewoc-previous
- :if-mode hyperdrive-dir-mode
+ ("p" "Previous" h/ewoc-previous
+ :if-mode h/dir-mode
:transient t)
- ("n" "Next" hyperdrive-ewoc-next
- :if-mode hyperdrive-dir-mode
+ ("n" "Next" h/ewoc-next
+ :if-mode h/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
+ ("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)
- (hyperdrive-menu--scope)))
- (or version (not (hyperdrive-writablep hyperdrive))))))
- ("d" "Download" hyperdrive-download
- :if-not-mode hyperdrive-dir-mode)]
+ (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 (hyperdrive-menu--scope)
- (eq major-mode 'hyperdrive-dir-mode)
- (hyperdrive-dir--entry-at-point)))
+ (and (h/menu--scope)
+ (eq major-mode 'h/dir-mode)
+ (h/dir--entry-at-point)))
:description
(lambda ()
- (let ((current-entry (hyperdrive-menu--scope))
- (selected-entry (hyperdrive-dir--entry-at-point)))
+ (let ((current-entry (h/menu--scope))
+ (selected-entry (h/dir--entry-at-point)))
(concat (propertize "Selected: " 'face 'transient-heading)
(propertize
- (or (and (hyperdrive-entry-equal-p current-entry
selected-entry)
+ (or (and (he/equal-p current-entry selected-entry)
"./")
(alist-get 'display-name
- (hyperdrive-entry-etc selected-entry))
- (hyperdrive-entry-name selected-entry))
+ (he/etc selected-entry))
+ (he/name selected-entry))
'face 'transient-value))))
:pad-keys t
- ("d" "Download" hyperdrive-download
+ ("d" "Download" h/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
+ (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 (hyperdrive-menu--scope))
- (selected-entry (hyperdrive-dir--entry-at-point)))
- (or (not (hyperdrive-writablep
- (hyperdrive-entry-hyperdrive current-entry)))
+ (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
- (hyperdrive-entry-etc
selected-entry)))))))
- ("w" "Copy URL" hyperdrive-dir-copy-url)
+ (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" hyperdrive-dir-find-file)
- ("v" "View" hyperdrive-dir-view-file
+ ("RET" "Open" h/dir-find-file)
+ ("v" "View" h/dir-view-file
:inapt-if (lambda ()
- (when-let ((entry-at-point (hyperdrive-dir--entry-at-point)))
- (hyperdrive--entry-directory-p entry-at-point))))]]
+ (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--scope)]]
- (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
-(defvar hyperdrive-mirror-source nil)
-(defvar hyperdrive-mirror-target nil)
-(defvar hyperdrive-mirror-filter nil)
-(defvar hyperdrive-mirror-confirm t)
+(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)
@@ -235,58 +235,58 @@
["Hyperdrive"
;; TODO(transient): Maybe support shared predicates like
;; so, and then ":if entryp" to avoid duplication below.
- ;; :predicates ((entryp ,(lambda () (hyperdrive-seed
(hyperdrive-menu--scope)))))
+ ;; :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" hyperdrive-menu-describe-hyperdrive)
- ("w" hyperdrive-menu-hyperdrive-copy-url)
- (:info (lambda () (hyperdrive--format (hyperdrive-menu--scope) "Public key:
%K" hyperdrive-raw-formats)))
- ( :info (lambda () (hyperdrive--format (hyperdrive-menu--scope) "Seed: %S"
hyperdrive-raw-formats))
- :if (lambda () (hyperdrive-seed (hyperdrive-menu--scope))))
- ("p" hyperdrive-menu-set-petname :transient t)
- ("n" hyperdrive-menu-set-nickname :transient t
- :inapt-if-not (lambda () (hyperdrive-writablep (hyperdrive-menu--scope))))
- ( :info (lambda () (hyperdrive--format (hyperdrive-menu--scope) "Domain:
%D" hyperdrive-raw-formats))
- :if (lambda () (hyperdrive-domains (hyperdrive-menu--scope))))
- (:info (lambda () (format "Latest version: %s" (hyperdrive-latest-version
(hyperdrive-menu--scope)))))]
+ ("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" hyperdrive-menu-open-file)
- ("v" "View file" hyperdrive-menu-view-file)
+ ("f" "Find file" h/menu-open-file)
+ ("v" "View file" h/menu-view-file)
"" "Upload"
- ("u f" "File" hyperdrive-menu-upload-file
- :inapt-if-not (lambda () (hyperdrive-writablep (hyperdrive-menu--scope))))
- ("u F" "Files" hyperdrive-menu-upload-files
- :inapt-if-not (lambda () (hyperdrive-writablep
(hyperdrive-menu--scope))))]
+ ("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 () (hyperdrive-writablep (hyperdrive-menu--scope)))
- ("m m" "Mirror using settings below" hyperdrive-mirror-configured)
- ("m s" "Source" hyperdrive-mirror-set-source)
- ("m t" "Target" hyperdrive-mirror-set-target)
- ("m f" "Filter" hyperdrive-mirror-set-filter)
- ("m c" "Confirm" hyperdrive-mirror-set-confirm)]]
- (interactive (list (hyperdrive-complete-hyperdrive :force-prompt
current-prefix-arg)))
- (transient-setup 'hyperdrive-menu-hyperdrive nil nil :scope hyperdrive))
-
-(transient-define-suffix hyperdrive-mirror-configured ()
+ :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)
- (hyperdrive-mirror (or hyperdrive-mirror-source default-directory)
- (hyperdrive-menu--scope)
- :target-dir hyperdrive-mirror-target
- :filter hyperdrive-mirror-filter
- :no-confirm (not hyperdrive-mirror-confirm)))
+ (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 hyperdrive-mirror-variable (transient-lisp-variable)
+(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)))
-(cl-defmethod transient-format-value ((obj hyperdrive-mirror-variable))
+(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))
@@ -296,146 +296,154 @@
(if-let ((face (oref obj value-face)))
(propertize value 'face face)
value)
- (propertize "not set" 'face 'hyperdrive-dimmed))))
+ (propertize "not set" 'face 'h/dimmed))))
-(transient-define-infix hyperdrive-mirror-set-source ()
- :class 'hyperdrive-mirror-variable
- :variable 'hyperdrive-mirror-source
- :value-face 'hyperdrive-file-name
+(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 'hyperdrive-file-name)
- (format (propertize "%s (default)" 'face
'hyperdrive-dimmed)
- (propertize default-directory 'face
'hyperdrive-file-name))))
+ (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 hyperdrive-mirror-set-target ()
- :class 'hyperdrive-mirror-variable
- :variable 'hyperdrive-mirror-target
- :value-face 'hyperdrive-file-name
+(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 'hyperdrive-file-name)
- (format (propertize "%s (default)" 'face
'hyperdrive-dimmed)
- (propertize "/" 'face 'hyperdrive-file-name))))
+ (propertize value 'face 'h/file-name)
+ (format (propertize "%s (default)" 'face 'h/dimmed)
+ (propertize "/" 'face 'h/file-name))))
:reader (lambda (_prompt _default _history)
- (hyperdrive--format-path
- (hyperdrive-read-path
- :hyperdrive (hyperdrive-menu--scope)
+ (h//format-path
+ (h/read-path
+ :hyperdrive (h/menu--scope)
:prompt "Target directory in `%s'"
:default "/")
:directoryp t)))
-(transient-define-infix hyperdrive-mirror-set-filter ()
- :class 'hyperdrive-mirror-variable
- :variable 'hyperdrive-mirror-filter
+(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
'hyperdrive-file-name))
+ ('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)
- (hyperdrive-mirror-read-filter)))
+ (h/mirror-read-filter)))
-(transient-define-infix hyperdrive-mirror-set-confirm ()
- :class 'hyperdrive-mirror-variable
- :variable 'hyperdrive-mirror-confirm
+(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 'hyperdrive-file-name)
+ (propertize "yes" 'face 'h/file-name)
(propertize "no (dangerous)" 'face
'font-lock-warning-face)))
:reader (lambda (_prompt _default _history)
- (not hyperdrive-mirror-confirm)))
+ (not h/mirror-confirm)))
-(transient-define-suffix hyperdrive-menu-open-file ()
+(transient-define-suffix h/menu-open-file ()
(interactive)
- (hyperdrive-open (hyperdrive-read-entry
- :hyperdrive (hyperdrive-menu--scope)
- :read-version current-prefix-arg)))
+ (h/open (h/read-entry
+ :hyperdrive (h/menu--scope)
+ :read-version current-prefix-arg)))
-(transient-define-suffix hyperdrive-menu-view-file ()
+(transient-define-suffix h/menu-view-file ()
(interactive)
- (hyperdrive-view-file (hyperdrive-read-entry
- :hyperdrive (hyperdrive-menu--scope)
- :read-version current-prefix-arg)))
+ (h/view-file (h/read-entry
+ :hyperdrive (h/menu--scope)
+ :read-version current-prefix-arg)))
-(transient-define-suffix hyperdrive-menu-upload-file (filename entry)
+(transient-define-suffix h/menu-upload-file (filename entry)
(interactive
(let* ((filename (read-file-name "Upload file: "))
- (entry (hyperdrive-read-entry :hyperdrive (hyperdrive-menu--scope)
- :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--scope)))
+ (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'"
:default "/"))))
- (hyperdrive-upload-files files hyperdrive
- :target-directory target-directory))
+ (h/upload-files files hyperdrive
+ :target-directory target-directory))
-(transient-define-suffix hyperdrive-menu-describe-hyperdrive ()
+(transient-define-suffix h/menu-describe-hyperdrive ()
:description "Describe"
(interactive)
- (hyperdrive-describe-hyperdrive (hyperdrive-menu--scope)))
+ (h/describe-hyperdrive (h/menu--scope)))
-(transient-define-suffix hyperdrive-menu-hyperdrive-copy-url ()
+(transient-define-suffix h/menu-hyperdrive-copy-url ()
:description "Copy URL"
(interactive)
- (hyperdrive-copy-url (hyperdrive-entry-create
- :hyperdrive (hyperdrive-menu--scope))))
+ (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 (hyperdrive-petname
- (hyperdrive-menu--scope))))
- (propertize petname 'face 'hyperdrive-petname)
+ (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--scope)))
- (hyperdrive-menu--scope)))
- (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: Hyperdrive-metadata accessor (and maybe gv setter).
+ ;; TODO: h/metadata accessor (and maybe gv setter).
(if-let ((nickname (alist-get 'name
- (hyperdrive-metadata
- (hyperdrive-menu--scope)))))
- (propertize nickname 'face 'hyperdrive-nickname)
+ (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--scope))))
- (hyperdrive-menu--scope)))
- (hyperdrive-set-nickname nickname hyperdrive))
+ :initial-input (alist-get 'name (h/metadata (h/menu--scope))))
+ (h/menu--scope)))
+ (h/set-nickname nickname hyperdrive))
;;;; Menu Utilities
-(defun hyperdrive-menu--scope ()
+(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)
+;;;###autoload(register-definition-prefixes "hyperdrive-menu" '("hyperdrive-"))
+;; 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 4404ac1e38..e5491dc86a 100644
--- a/hyperdrive-mirror.el
+++ b/hyperdrive-mirror.el
@@ -46,11 +46,11 @@ 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.
URL is \"hyper://\" URL where the file would be uploaded.
@@ -60,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")
@@ -81,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.")
@@ -92,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."
@@ -121,25 +121,25 @@ 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
@@ -170,33 +170,33 @@ all files. With two universal prefix arguments
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)
:filter (if current-prefix-arg
- (hyperdrive-mirror-read-filter)
+ (h/mirror-read-filter)
#'always))))
(cl-callf expand-file-name source)
- (setf target-dir (hyperdrive--format-path target-dir :directoryp t))
+ (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 (hyperdrive-entry-create :hyperdrive hyperdrive :path
target-dir))
+ (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
filter)"))
+ (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)
@@ -206,34 +206,34 @@ filter 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
+ (h/mirror-mode)
+ (setq-local h/mirror-query
`(,source ,hyperdrive :target-dir ,target-dir :filter
,filter)
- hyperdrive-mirror-parent-entry parent-entry)
+ 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)))
@@ -241,18 +241,18 @@ filter 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
@@ -264,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))
@@ -291,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'."
@@ -309,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
@@ -327,19 +327,19 @@ 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-filter ()
+(defun h/mirror-read-filter ()
"Read a function for filtering source files for mirroring."
(let* ((readers
'(("Mirror all files" . nil)
@@ -355,43 +355,52 @@ grouping keys, as in `hyperdrive-mirror-default-keys'."
(reader (alist-get reader readers nil nil #'equal)))
(and reader (funcall reader))))
-(defun hyperdrive-mirror-do-upload ()
+(defun h/mirror-do-upload ()
"Upload files in current \"*hyperdrive-mirror*\" buffer."
- (declare (modes hyperdrive-mirror-mode))
+ (declare (modes h/mirror-mode))
(interactive)
;; 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)
+
+;;;###autoload(register-definition-prefixes "hyperdrive-mirror"
'("hyperdrive-"))
+;; 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 f0f2e877d1..6ce7c79933 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,22 +56,22 @@ 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--format-entry entry)))))
+ (link . ,(he/url entry))
+ (description . ,(h//format-entry entry)))))
(_ `((type . "hyper://")
- (link . ,(hyperdrive-entry-url
hyperdrive-current-entry))
- (description . ,(hyperdrive--format-entry
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."
@@ -89,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
@@ -110,28 +110,28 @@ 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)))
-(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 h/mode
+ (h/open (h/org--link-entry-at-point))))
-(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.
@@ -144,40 +144,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
@@ -187,9 +187,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.
@@ -199,14 +199,14 @@ 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))
@@ -216,17 +216,26 @@ Respects `hyperdrive-org-link-full-url' and
`org-link-file-path-type'."
;;;###autoload
(with-eval-after-load 'org
(org-link-set-parameters "hyper"
- :store #'hyperdrive-org-link-store
- :follow #'hyperdrive-org-link-follow
- :complete #'hyperdrive-org-link-complete)
+ :store #'h/org-link-store
+ :follow #'h/org-link-follow
+ :complete #'h/org-link-complete)
(with-eval-after-load 'hyperdrive
- ;; Handle links with no specified type in `hyperdrive-mode'
+ ;; Handle links with no specified type in `h/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)))
+ ;; that `h/mode' will be defined.
+ (cl-pushnew #'h/org--open-at-point org-open-at-point-functions)))
;;;; Footer
(provide 'hyperdrive-org)
+
+;;;###autoload(register-definition-prefixes "hyperdrive-org" '("hyperdrive-"))
+;; 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 0a2622262e..2130b67d28 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,7 +118,7 @@ Passed to `display-buffer', which see."
(const :tag "Pop up window" (display-buffer-pop-up-window))
(sexp :tag "Other")))
-(defcustom hyperdrive-preferred-formats
+(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
@@ -134,7 +134,7 @@ used."
(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 +143,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
@@ -171,7 +171,7 @@ an existing buffer at the same version, or make a new
buffer."
"Formatting of entries for buffer names, etc."
:group 'hyperdrive)
-(defcustom hyperdrive-default-entry-format "[%H] %p%v"
+(defcustom h/default-entry-format "[%H] %p%v"
"Format string for displaying entries.
Specifiers:
@@ -190,41 +190,41 @@ To configure the format of the following specifiers, see
`hyperdrive-formats':
%D Hyperdrive domains"
:type 'string)
-(defvar hyperdrive-default-entry-format-without-version "[%H] %p"
+(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 hyperdrive-buffer-name-format "[%H] %n%v"
+(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 hyperdrive-raw-formats '(;; Entry metadata
- (name . "%s")
- (path . "%s")
- (version . "%s")
- ;; Hyperdrive metadata
- (petname . "%s")
- (nickname . "%s")
- (public-key . "%s")
- (short-key . "%s")
- (seed . "%s")
- (domains . "%s"))
+(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 hyperdrive-formats '(;; Entry metadata
- (name . "%s")
- (version . " (version:%s)")
- (path . "%s")
- ;; Hyperdrive metadata
- (petname . "petname:%s")
- (nickname . "nickname:%s")
- (public-key . "public-key:%s")
- (short-key . "public-key:%.8s…")
- (seed . "seed:%s")
- (domains . "domains:%s"))
+(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:
@@ -266,75 +266,75 @@ value (and should only be present once in the string).
Used in
"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-file-name '((t :inherit font-lock-keyword-face)) ; TODO
theme
+(defface h/file-name '((t :inherit font-lock-keyword-face)) ; TODO theme
"Applied to file names.")
-(defface hyperdrive-dimmed '((t :inherit shadow))
+(defface h/dimmed '((t :inherit shadow))
"Applied to text in transient menus that should be dimmed.")
-(defface hyperdrive-header '((t (:inherit dired-header)))
+(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.
@@ -349,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
@@ -370,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"))
@@ -403,4 +403,13 @@ Keys are regexps matched against MIME types.")
;;;; Footer
(provide 'hyperdrive-vars)
+
+;;;###autoload(register-definition-prefixes "hyperdrive-vars" '("hyperdrive-"))
+;; 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 8cfea50fbb..763cc424be 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -81,14 +81,14 @@
(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))
(require 'browse-url)
(require 'thingatpt)
-(cl-pushnew (cons (rx bos "hyper://") #'hyperdrive-browse-url)
+(cl-pushnew (cons (rx bos "hyper://") #'h/browse-url)
browse-url-handlers :test #'equal)
(cl-pushnew "hyper://" thing-at-point-uri-schemes :test #'equal)
@@ -104,9 +104,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
@@ -119,9 +119,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
@@ -130,10 +130,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)
@@ -141,8 +141,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
@@ -150,25 +150,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)))
+ (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'? "
- (hyperdrive--format-hyperdrive
hyperdrive)))
- (hyperdrive-purge-no-prompt hyperdrive
+ (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)
@@ -179,25 +179,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
+ (let* ((hyperdrive (h/complete-hyperdrive :force-prompt current-prefix-arg))
+ (petname (h/read-name
:prompt (format "Petname for `%s' (leave blank to unset)"
- (hyperdrive--format-hyperdrive hyperdrive))
- :initial-input (hyperdrive-petname hyperdrive))))
+ (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
+ (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 (hyperdrive--format-hyperdrive
other-hyperdrive))
- :initial-input (hyperdrive-petname hyperdrive))))
+ petname (h//format-hyperdrive
other-hyperdrive))
+ :initial-input (h/petname hyperdrive))))
(if (string-blank-p petname)
(when (yes-or-no-p (format-message "Unset petname for `%s'? "
- (hyperdrive--format-hyperdrive
hyperdrive)))
- (setf (hyperdrive-petname hyperdrive) nil))
- (setf (hyperdrive-petname hyperdrive) petname))
- (hyperdrive-persist hyperdrive)
+ (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)
@@ -212,41 +212,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
+ (h/fill-metadata hyperdrive)
+ (h/read-name
:prompt (format-message "Nickname for `%s'"
- (hyperdrive--format-hyperdrive
hyperdrive))
- :initial-input (alist-get 'name (hyperdrive-metadata
hyperdrive))))))
+ (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))
@@ -258,77 +258,77 @@ 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))
+ (declare (modes h/mode))
(interactive)
- (hyperdrive-revert-buffer nil (not (buffer-modified-p))))
+ (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.
+ #'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)
@@ -338,8 +338,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)))))
@@ -347,8 +347,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))
@@ -359,44 +359,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--format-entry 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 (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 (hyperdrive--entry-directory-p entry))
+ (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 +410,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 +443,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--format-entry
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--format-entry 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,37 +465,37 @@ 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--format-entry entry
hyperdrive-buffer-name-format)
+ (h//format-entry entry h/buffer-name-format)
'unique)
(set-buffer-modified-p nil)
;; Update the visited file modtime so undo commands
@@ -504,116 +504,116 @@ 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)))
+ (declare (modes h/mode))
+ (interactive (list h/current-entry))
+ (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))
+ (declare (modes h/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)))
+ (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 "%s does not exist at version %s. Try
\\[hyperdrive-history]"
- (hyperdrive--format-entry entry "[%H] %p")
- (1- (car (hyperdrive-entry-version-range entry))))))
-
-(defun hyperdrive-open-next-version (entry)
+ (declare (modes h/mode))
+ (interactive (list h/current-entry))
+ (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)
+ (declare (modes h/mode))
+ (interactive (list h/current-entry))
+ (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 "Entry deleted after this version. Try
\\[hyperdrive-history]"))
- ('unknown ;; Unknown existence: suggest `hyperdrive-history'.
- (hyperdrive-message "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)
+ (declare (modes h/mode))
+ (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)"
-
(hyperdrive--format-entry entry))))))
- (if-let ((latest-entry (hyperdrive-entry-at version entry)))
- (hyperdrive-open latest-entry)
- (hyperdrive-message "%s does not exist at version %s. Try
\\[hyperdrive-history]"
- (hyperdrive--format-entry
- entry hyperdrive-default-entry-format-without-version)
- version)))
+ (h//format-entry
entry))))))
+ (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--format-entry
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
@@ -623,9 +623,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
@@ -633,16 +633,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)))
@@ -652,47 +652,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))
@@ -700,20 +700,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
@@ -753,7 +753,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'.
@@ -762,7 +762,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))
@@ -774,7 +774,7 @@ 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)
@@ -787,15 +787,15 @@ The return value of this function is the retrieval
buffer."
;;;; `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 (compat-call
read-multiple-choice
(format "Hyperdrive file %s modified; kill anyway?"
- (hyperdrive--format-entry hyperdrive-current-entry))
+ (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"))
@@ -810,64 +810,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 drive)
+ 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")
@@ -876,29 +876,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'"
: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"
@@ -907,72 +907,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-message
"Set petname: `%s'"
-
(pcase (hyperdrive-petname drive)
+
(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-message
"Set nickname: `%s'"
-
(pcase (alist-get 'name (hyperdrive-metadata drive))
+
(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
a)
- (hyperdrive--format
b)))))
+ (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
a)
- (hyperdrive--format
b)))))
+ (string< (h//format a)
+ (h//format b)))))
(list ["none" :active nil]))))))
("Current"
- :active hyperdrive-current-entry
- :label (if-let* ((entry hyperdrive-current-entry))
+ :active h/current-entry
+ :label (if-let* ((entry h/current-entry))
(format-message "Current: `%s'"
- (hyperdrive--format-entry entry))
+ (h//format-entry entry))
"Current")
("Current Drive"
- :active hyperdrive-current-entry
- :label (if-let* ((entry hyperdrive-current-entry)
- (hyperdrive (hyperdrive-entry-hyperdrive entry)))
- (format-message "Current Drive `%s'" (hyperdrive--format
hyperdrive))
+ :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"]
"---"
@@ -980,27 +980,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'"
: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"
@@ -1008,149 +1008,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-message "Set petname: `%s'"
- (pcase (hyperdrive-petname (hyperdrive-entry-hyperdrive
hyperdrive-current-entry))
+ (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-message "Set nickname: `%s'"
(pcase (alist-get 'name
- (hyperdrive-metadata
- (hyperdrive-entry-hyperdrive
- hyperdrive-current-entry)))
+ (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-message "Current %s: `%s'"
- (if (hyperdrive--entry-directory-p
hyperdrive-current-entry)
+ (if (h//entry-directory-p h/current-entry)
"Directory"
"File")
- (hyperdrive--format-path (hyperdrive-entry-path
-
hyperdrive-current-entry)))
+ (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)))
+ :label (let ((entry-at-point (h/dir--entry-at-point)))
(format-message "Selected %s: `%s'"
- (if (hyperdrive--entry-directory-p
entry-at-point)
+ (if (h//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))
+ (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)
@@ -1158,50 +1158,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")))
@@ -1221,25 +1221,25 @@ The return value of this function is the retrieval
buffer."
;;;;; 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.
@@ -1249,7 +1249,7 @@ Intended for relative (i.e. non-full) URLs."
;;;###autoload
(with-eval-after-load 'markdown-mode
(when (boundp 'markdown-follow-link-functions)
- (cl-pushnew #'hyperdrive--markdown-follow-link
markdown-follow-link-functions)))
+ (cl-pushnew #'h//markdown-follow-link markdown-follow-link-functions)))
;;;;; `find-file-at-point' (`ffap') support
@@ -1266,19 +1266,28 @@ Intended for relative (i.e. non-full) URLs."
(defvar embark-general-map)
(defvar embark-keymap-alist)
-(declare-function hyperdrive-menu "hyperdrive-menu-hyperdrive" nil t)
+(declare-function h/menu "hyperdrive-menu-hyperdrive" 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)
+
+;;;###autoload(register-definition-prefixes "hyperdrive" '("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 49e6a075b6..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 a18e3ab570..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,26 +78,26 @@ 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))
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))))
@@ -106,39 +106,39 @@ Point is indicated by ★."
(: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= 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)
+;; 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 :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)
(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."
@@ -153,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))
@@ -172,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))
@@ -184,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))
@@ -196,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))
@@ -208,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))
@@ -220,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))
@@ -235,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
@@ -258,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)
@@ -272,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 0b5102ac9c 036/102: Meta: Update CHANGELOG, (continued)
- [nongnu] elpa/hyperdrive 0b5102ac9c 036/102: Meta: Update CHANGELOG, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive d1b68b1a66 048/102: Add: (hyperdrive-entry-format-alist) Consolidate entry formats, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive cc0e3cdfdf 059/102: Tidy: Indentation, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive fa48b80132 060/102: Improve defcustom, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 98761ce57f 007/102: Change: (-menu-hyperdrive) Move definitions of suffix descriptions, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 807b1fd0df 051/102: Change: (hyperdrive--format-host) Remove :with-faces keyword argument, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive d19558893e 035/102: Fix: Require 'rx, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 22c95b82a4 068/102: Fix: Complete rename of org link functions, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 5883d33fca 099/102: Meta: Update changelog, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive e944a86276 077/102: Docs: Say "file" not "entry", ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 514d771d5b 070/102: Use shorthands he//, he/, h// and h/,
ELPA Syncer <=
- [nongnu] elpa/hyperdrive ace50018fa 084/102: Tidy: Remove Imenu compiler warning workaround, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive c433a8ea07 085/102: Tidy: Indentation, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 4144f5530d 090/102: Meta: Update changelog, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 1b17526619 076/102: Docs: Improve wording of acknowledgment, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 281d686f15 083/102: Chore: Remove 27.2 build script, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 456257e607 020/102: Change: (hyperdrive-mirror-set-target) Propertize values, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive e7a01e7f5a 043/102: Fix: Silence byte-compiler, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive 70362a6a7e 061/102: Tidy: Simplify labeled function and custom value, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive ab0e45fee3 034/102: Change: (hyperdrive-mirror-read-predicate) Remove rx form option, ELPA Syncer, 2023/11/29
- [nongnu] elpa/hyperdrive d76de4842b 072/102: Change: (-preferred-formats) Move into hyperdrive-entry-format group, ELPA Syncer, 2023/11/29