[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/hyperdrive 7826c10faa 81/82: Merge branch 'wip/org-heading
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/hyperdrive 7826c10faa 81/82: Merge branch 'wip/org-heading-links' |
|
Date: |
Mon, 25 Sep 2023 19:00:56 -0400 (EDT) |
branch: elpa/hyperdrive
commit 7826c10faa78d860722c82c84e74f725287ff9c2
Merge: d2413785b0 7d06ffd037
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>
Merge branch 'wip/org-heading-links'
---
.gitignore | 5 +
CHANGELOG.org | 2 +
DEV.org | 115 +++++++++++++++
doc/hyperdrive-manual.org | 6 +-
hyperdrive-dir.el | 5 +-
hyperdrive-lib.el | 94 +++++++-----
hyperdrive-mirror.el | 5 +-
hyperdrive-org.el | 155 ++++++++++++++------
hyperdrive.el | 14 +-
tests/org links.org | 36 +++--
tests/test-hyperdrive-org.el | 332 +++++++++++++++++++++++++++++++++++++++++++
tests/test-hyperdrive.el | 28 +++-
12 files changed, 687 insertions(+), 110 deletions(-)
diff --git a/.gitignore b/.gitignore
index 9dbcf25ee1..2289008db4 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,3 +4,8 @@ makem.sh
/.dir-locals-2.el
*.elc
/worktrees/
+/hyperdrive-autoloads.el
+/hyperdrive-pkg.el
+/dir
+/doc/hyperdrive-manual.info
+/hyperdrive.info
diff --git a/CHANGELOG.org b/CHANGELOG.org
index 525f2eed72..f7d97e7374 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -7,6 +7,8 @@ This project adheres to
[[https://semver.org/spec/v2.0.0.html][Semantic Versioni
** Added
+- ~org-insert-link~ automatically inserts relative links to hyperdrive
+ files within the same drive
- ~yank-media~ support (on Emacs 29 or later)
- ~save-some-buffers~ integration
- ~info-look~ integration
diff --git a/DEV.org b/DEV.org
index e3ec6f7b39..0cb92a168d 100644
--- a/DEV.org
+++ b/DEV.org
@@ -277,3 +277,118 @@ even when that peer is not advertising the topic
~not-advertising-this~.
How to tell which extension caused a peer-open or peer-remove event?
+* Org links
+
++ [[file:tests/org links.org][org links.org]]
+
+** Design
+
+1. Basically, we want to always store a full ~hyper://...~ URL when the user
calls ~org-store-link~.
+2. Then, when the user calls ~org-insert-link~, we decide based on context
(and maybe also on user input) what kind of a link to insert.
+
+*** Terminology
+
++ Hyperdrive Org links :: Links to hyperdrive files/directories that are valid
within Org documents.
+
+ - With protocol prefix
+
+ This link type or may not be surrounded by brackets. It may or may
+ not contain a search option. Path and search option must be
+ URL-encoded and separated by a decoded ~#~.
+
+ * No search option :: e.g. ~hyper://deadbeef/foo/bar%20quux.org~, which
decodes to ~hyper://deadbeef/foo/bar quux.org~
+
+ * ~CUSTOM_ID~ :: e.g.
+ ~hyper://deadbeef/foo/bar%20quux.org#%3A%3A%23baz%20zot~, which decodes
to ~hyper://deadbeef/foo/bar quux.org#::#baz zot~
+
+ * Heading text search option :: With or without ~*~ (actually [[elisp:(rx
"*" (0+ space))]]) prefix, e.g.
+
+ - ~hyper://deadbeef/foo/bar%20quux.org#%3A%3A%2AHeading%20A~, which
decodes to ~hyper://deadbeef/foo/bar quux.org#::*Heading A~
+ - ~hyper://deadbeef/foo/bar%20quux.org#%3A%3A%2A%20%20Heading%20A~,
which decodes to ~hyper://deadbeef/foo/bar quux.org#::* Heading A~
+ - ~hyper://deadbeef/foo/bar%20quux.org#%3A%3AHeading%20A~, which decodes
to ~hyper://deadbeef/foo/bar quux.org#::Heading A~
+
+ - Without protocol prefix
+
+ This link type must be surrounded by brackets. It has no
+ URL-encoding in any part. It may or may not contain a path:
+
+ + With path :: A link pointing to a file at a path, starting with ~/~ or
~.~, with or without search option:
+
+ - No search option :: ~[[/foo/bar quux.org]]~
+
+ - ~CUSTOM_ID~ :: e.g. ~[[/foo/bar quux.org::#CUSTOM_ID]]~
+
+ - Heading text search option :: With or without ~*~ (actually
[[elisp:(rx "*" (0+ space))]]) prefix, e.g.
+
+ + ~[[/foo/bar quux.org::*Heading A]]~
+ + ~[[/foo/bar quux.org::* Heading A]]~
+ + ~[[/foo/bar quux.org::Heading A]]~
+
+ + Without path :: A link pointing to a heading in the same file with
search option alone:
+
+ - ~CUSTOM_ID~ :: e.g. ~#CUSTOM_ID~
+
+ - Heading text search option :: With or without ~*~ (actually
[[elisp:(rx "*" (0+ space))]]) prefix, e.g.
+
+ + ~*Heading A~
+ + ~* Heading A~
+ + ~Heading A~
+
+*** Limitations
+
++ Because hyperdrive buffers are not considered file-backed by Emacs, and Org
refuses to follow ~ID~-based links in non-file-backed buffers, in a
hyperdrive-backed Org buffer, ~ID~-based links /will not/ be followable. This
is a limitation of ~org-id.el~, and it seems unlikely that we would be able to
overcome it (unless and until we support hyperdrive using TRAMP's
infrastructure).
+
+*** Use cases
+
++ We want users to be able to take one or more Org files and have links
between them continue working regardless of whether the files are on a
hyperdrive or not.
+
+*** Storing links
+
++ All examples below assume point is on a heading titled ~Heading A~.
+
+**** To a heading with a ~CUSTOM_ID~
+
+Assuming the ~CUSTOM_ID~ is ~heading-a~:
+
++ We'll follow Org's example by storing two links:
+ + ~hyper://public-key/foo.org#heading-a~
+ + ~hyper://public-key/foo.org#::*Heading A~
+
+**** To a heading with only an ~ID~
+
++ Because of the [[*Limitations][Limitations]], if the user stores a link to a
heading that does not have a ~CUSTOM_ID~ but only has an ~ID~, we ignore the
~ID~.
++ We store: [[hyper://public-key/foo.org#::*Heading A]]
+
+**** To a heading with neither ~CUSTOM_ID~ nor ~ID~
+
++ We store: [[hyper://public-key/foo.org#::*Heading A]]
++ Internally, the entry's ~etc~ map's ~target~ key will have the value
~"::*Heading A"~.
+
+*** Inserting links
+
++ *NOTE*: After several attempts at using ~:override~ advice, integrating, and
modifying ~org-insert-link~, we concluded that those approaches are
impractical. Instead, we'll use ~:after~ advice to allow ~org-insert-link~ to
behave normally, and then read the link it inserted and modify it as
appropriate for the hyperdrive-backed buffer.
+
++ We first distinguish between whether the buffer we're inserting the link
into is within the same hyperdrive, or not.
+
+**** Inserting into a buffer that is in the same hyperdrive
+
++ Like Org mode, we'll use a relative link.
+
+**** Inserting into a buffer that is not in the same hyperdrive
+
+**** Inserting full ~hyper://~ -prefixed links
+
++ These links may point only to files, or headings in files which have
~CUSTOM_ID~ properties--not headings which have ~ID~ properties, nor by using
~:search-option~-style heading matches.
++ Like in Org, a link using a ~#~-prefixed "fragment" may point only to a
heading which has a ~CUSTOM_ID~ property; the ~ID~ property is not considered,
nor is heading text.
+
++ This type of link may point to:
+ * A file (i.e. not to a heading within a file)
+ * A heading within a file, by:
+ * ~CUSTOM_ID~ (by placing the ID in the URL fragment, i.e.
~hyper://.../foo.org#CUSTOM_ID~ )
+ * Heading text (by placing the Org search option in the URL fragment,
URL-encoded, i.e. ~hyper://.../foo.org/#%3A%3A%2AHeading%20A~ to encode the
search option ~::*Heading A~).
+ # TODO: Consider also supporting ~ID~ properties.
+
+**** Inserting relative links
+
++
+
diff --git a/doc/hyperdrive-manual.org b/doc/hyperdrive-manual.org
index 36f5ed8423..9a79e161b2 100644
--- a/doc/hyperdrive-manual.org
+++ b/doc/hyperdrive-manual.org
@@ -276,8 +276,10 @@ filesystem, explicitly add the ~file:~ link type prefix:
~file:~/.emacs.d/init.el~.
Org-mode hyperdrive link completion allows you to interactively link
-to a hyperdrive file/folder by running ~M-x org-insert-link~ (or ~C-c
-C-l~ in org-mode), then typing ~hyper:~ and ~RET~.
+to a hyperdrive file/folder by running ~M-x org-insert-link~ (or ~C-c C-l~
+in org-mode), then typing ~hyper:~ and ~RET~. To change how
+~org-insert-link~ inserts links to files within the same hyperdrive,
+adjust ~hyperdrive-org-link-full-url~ and ~org-link-file-path-type~.
** View the hyperdrive version history
#+findex: hyperdrive-previous-version
diff --git a/hyperdrive-dir.el b/hyperdrive-dir.el
index 0d427dc6d2..bfecdce651 100644
--- a/hyperdrive-dir.el
+++ b/hyperdrive-dir.el
@@ -52,8 +52,7 @@ the metadata has been loaded."
(hyperdrive-entry-create
:hyperdrive hyperdrive
:path (concat (url-unhex-string path)
entry-name)
- :version version
- :encode t))
+ :version version))
entry-names))
(parent-entry (hyperdrive-parent directory-entry))
(header (hyperdrive-dir-column-headers
(hyperdrive-entry-description directory-entry)))
@@ -62,7 +61,7 @@ the metadata has been loaded."
(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)))
+ :predicate #'hyperdrive-entry-equal-p)))
(goto-char (ewoc-location node))))
(update-footer (num-filled num-of)
(when (zerop (mod num-filled 5))
diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index 00b1b84feb..0e8218c259 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -64,7 +64,7 @@ Passes ARGS to `format-message'."
;; could theoretically contain a slash, and `file-name-nondirectory'
;; would return the wrong value in that case.
(name nil :documentation "Decoded filename of entry (excluding leading
slash).")
- (path nil :documentation "Encoded path (including leading slash).")
+ (path nil :documentation "Decoded path (including leading slash).")
(headers nil :documentation "HTTP headers from request.")
(mtime nil :documentation "Last modified time.")
(size nil :documentation "Size of file.")
@@ -97,18 +97,22 @@ domains slot."
(host (or public-key (car domains))))
(concat "hyper://" host)))
+(defun hyperdrive--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)
"Return ENTRY's canonical URL.
Returns URL with hyperdrive's full public key."
(hyperdrive--format-entry-url entry :with-protocol t))
-(cl-defun hyperdrive-entry-create (&key hyperdrive path version etc encode)
+(cl-defun hyperdrive-entry-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. When ENCODE is non-nil, encode PATH."
+generated from PATH."
(setf path (hyperdrive--format-path path))
- (when encode
- (cl-callf url-hexify-string path (cons ?/ url-unreserved-chars)))
(hyperdrive-entry--create
:hyperdrive hyperdrive
:path path
@@ -267,31 +271,20 @@ before making the entry struct."
(or (gethash host hyperdrive-hyperdrives)
(hyperdrive-create :public-key host)))))
(etc (when target
- (list (cons 'target target))))
+ `((target . ,(substring (url-unhex-string target)
(length "::"))))))
(version (pcase path
((rx "/$/version/" (let v (1+ num)) (let p (0+
anything)))
(setf path p)
(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 path :version
version :etc etc)))
+ (hyperdrive-entry-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-equal (a b)
- "Return non-nil if hyperdrive entries A and B are equal.
-Compares only public key and path."
- (pcase-let (((cl-struct hyperdrive-entry (path a-path)
- (hyperdrive (cl-struct hyperdrive (public-key
a-key))))
- a)
- ((cl-struct hyperdrive-entry (path b-path)
- (hyperdrive (cl-struct hyperdrive (public-key
b-key))) )
- b))
- (and (equal a-path b-path)
- (equal a-key b-key))))
-
(defun hyperdrive-entry-latest (entry)
"Return ENTRY at its hyperdrive's latest version, or nil."
(hyperdrive-entry-at nil entry))
@@ -300,7 +293,7 @@ Compares only public key and path."
"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 :encode t)))
+ (version-less (hyperdrive-entry-create :hyperdrive hyperdrive
:path path)))
(hyperdrive--format-entry-url version-less :host-format '(public-key)
:with-protocol nil
:with-help-echo nil :with-target nil
:with-faces nil)))
@@ -943,6 +936,7 @@ When WITH-VERSION or ENTRY's version is nil, omit
(version:VERSION)."
(cl-defun hyperdrive--format-entry-url
(entry &key (host-format '(public-key domain))
+ (with-path t)
(with-protocol t) (with-help-echo t) (with-target t) (with-faces t))
"Return ENTRY's URL.
Returns URL formatted like:
@@ -959,7 +953,9 @@ number in URL.
Note that, if HOST-FORMAT includes values other than `public-key'
and `domain', the resulting URL may not be a valid hyperdrive
-URL."
+URL.
+
+Path and target fragment are URI-encoded."
;; NOTE: Entries may have only a domain, not a public key yet, so we
;; include `domain' in HOST-FORMAT's default value. The public key
;; will be filled in later.
@@ -967,18 +963,24 @@ URL."
entry)
(protocol (when with-protocol
"hyper://"))
- (host (hyperdrive--format-host (hyperdrive-entry-hyperdrive
entry)
- :format host-format :with-faces
with-faces))
+ (host (when host-format
+ ;; FIXME: Update docstring to say that host-format can
be nil to omit it.
+ (hyperdrive--format-host (hyperdrive-entry-hyperdrive
entry)
+ :format host-format
:with-faces with-faces)))
(version-part (and version (format "/$/version/%s" version)))
((map target) etc)
(target-part (when (and with-target target)
- (concat "#" target)))
+ (concat "#" (url-hexify-string "::")
+ (url-hexify-string target))))
+ (path (when with-path
+ (hyperdrive--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
entry :with-protocol t :host-format
'(public-key domain)
- :with-help-echo nil :with-target with-target
:with-faces with-faces))
+ :with-path with-path :with-help-echo nil
:with-target with-target
+ :with-faces with-faces))
url)))
(cl-defun hyperdrive--format-host (hyperdrive &key format with-label
(with-faces t))
@@ -1078,7 +1080,7 @@ version number."
(hyperdrive-read-version :hyperdrive hyperdrive
:initial-input-number current-version)
current-version)))
(path (hyperdrive-read-path :hyperdrive hyperdrive :version version
:default default-path)))
- (hyperdrive-entry-create :hyperdrive hyperdrive :path path :version
version :encode t)))
+ (hyperdrive-entry-create :hyperdrive hyperdrive :path path :version
version)))
(defvar hyperdrive--version-history nil
"Minibuffer history of `hyperdrive-read-version'.")
@@ -1320,8 +1322,8 @@ Affected by option `hyperdrive-reuse-buffers', which see."
"Return non-nil when BUFFER is visiting ENTRY."
(and (buffer-local-value 'hyperdrive-mode buffer)
(buffer-local-value 'hyperdrive-current-entry buffer)
- (hyperdrive-entry-equal entry
- (buffer-local-value 'hyperdrive-current-entry
buffer))))
+ (hyperdrive-entry-equal-p
+ entry (buffer-local-value 'hyperdrive-current-entry buffer))))
(defun hyperdrive--buffer-for-entry (entry)
"Return a predicate to match buffer against ENTRY."
@@ -1386,15 +1388,6 @@ When PATH is nil or blank, return \"/\"."
path)
"/")))
-(defun hyperdrive-expand-url (path &optional base)
- "Return a URL string of PATH expanded against current entry.
-When BASE is non-nil, PATH will be expanded against BASE instead."
- (let* ((urlobj (url-generic-parse-url path))
- (defobj (url-generic-parse-url (or base (hyperdrive-entry-url
hyperdrive-current-entry)))))
- ;; Destructively modify the URL object to give it the correct host and
path.
- (url-default-expander urlobj defobj)
- (url-recreate-url urlobj)))
-
;;;; Utilities
(defun hyperdrive-time-greater-p (a b)
@@ -1410,5 +1403,32 @@ 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)
+ "Return non-nil if hyperdrive entries A and B are equal.
+Compares only public key and path."
+ (pcase-let (((cl-struct hyperdrive-entry (path a-path)
+ (hyperdrive (cl-struct hyperdrive (public-key
a-key))))
+ a)
+ ((cl-struct hyperdrive-entry (path b-path)
+ (hyperdrive (cl-struct hyperdrive (public-key
b-key))) )
+ b))
+ (and (equal a-path b-path)
+ (equal a-key b-key))))
+
+(defun hyperdrive-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)))
+
+(defun hyperdrive-entry-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)))
+
+(defun hyperdrive--ensure-dot-slash-prefix-path (path)
+ "Return PATH. Unless PATH starts with \"/\" \"./\" or \"../\", add \"./\"."
+ (if (string-match-p (rx bos (or "/" "./" "../")) path)
+ path
+ (concat "./" path)))
+
(provide 'hyperdrive-lib)
;;; hyperdrive-lib.el ends here
diff --git a/hyperdrive-mirror.el b/hyperdrive-mirror.el
index 8399584ae7..7a6fe52a28 100644
--- a/hyperdrive-mirror.el
+++ b/hyperdrive-mirror.el
@@ -139,7 +139,7 @@ predicate and set NO-CONFIRM to t."
(setf predicate (lambda (filename)
(string-match-p regexp filename)))))
(let* ((files (cl-remove-if-not predicate (directory-files-recursively
source ".")))
- (parent-entry (hyperdrive-entry-create :hyperdrive hyperdrive :path
target-dir :encode t))
+ (parent-entry (hyperdrive-entry-create :hyperdrive hyperdrive :path
target-dir))
(buffer (unless no-confirm
(get-buffer-create "*hyperdrive-mirror*")))
(num-filled 0)
@@ -177,8 +177,7 @@ predicate and set NO-CONFIRM to t."
(dolist (file files)
(let ((entry (hyperdrive-entry-create
:hyperdrive hyperdrive
- :path (expand-file-name (file-relative-name file
source) target-dir)
- :encode t)))
+ :path (expand-file-name (file-relative-name file
source) target-dir))))
(hyperdrive-fill entry :queue metadata-queue
:then (lambda (entry)
(let* ((drive-mtime (hyperdrive-entry-mtime entry))
diff --git a/hyperdrive-org.el b/hyperdrive-org.el
index f7d4efafba..bfe2551bc7 100644
--- a/hyperdrive-org.el
+++ b/hyperdrive-org.el
@@ -36,6 +36,19 @@
(declare-function hyperdrive-open-url "hyperdrive")
(declare-function hyperdrive-dir--entry-at-point "hyperdrive-dir")
+(defcustom hyperdrive-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,
+
+- insert a relative path link when before the first heading, or
+- insert a heading text or CUSTOM_ID link when after the first heading
+
+Otherwise, when inserting a link to a different file in the same
+hyperdrive, insert a relative or absolute link according to
+`org-link-file-path-type'."
+ :type 'boolean
+ :group 'hyperdrive)
+
;; TODO: Determine whether it's really necessary to autoload these two
functions.
;;;###autoload
@@ -75,26 +88,17 @@ raw URL, not an Org link."
;; it generates target fragments like we need. So it's simpler for
;; us to reimplement some of the logic here.
;;
- ;; Also, it appears that Org links to ID properties (not CUSTOM_ID)
- ;; can't have filename parts, i.e. they can only link to the
- ;; generated ID and leave locating the entry's file to Org's cache,
- ;; which isn't suitable for our purposes. So instead, we generate
- ;; our own link type which, in that case, includes both the filename
- ;; and the ID or CUSTOM_ID.
-
- ;; The URL's "fragment" (aka "target" in org-link jargon) is either
- ;; the CUSTOM_ID, ID, or headline search string, whichever is found
- ;; first, and it's up to the follow function to determine which it
- ;; is (which is very simple; see below).
+ ;; 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
- (let* ((url (hyperdrive-entry-url hyperdrive-current-entry))
- (heading (org-entry-get (point) "ITEM"))
+ (let* ((heading (org-entry-get (point) "ITEM"))
(custom-id (org-entry-get (point) "CUSTOM_ID"))
- (generated-id (org-entry-get (point) "ID"))
- (fragment (or custom-id generated-id heading))
- (raw-url (concat url (when fragment
- (concat "#" (url-hexify-string fragment))))))
+ (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)))
(if raw-url-p
raw-url
;; NOTE: Due to annoying issues with older versions of Emacs
@@ -112,47 +116,106 @@ raw URL, not an Org link."
(defun hyperdrive--org-link-goto (target)
"Go to TARGET in current Org buffer.
-TARGET may be a CUSTOM_ID, an ID, or a headline."
+TARGET may be a CUSTOM_ID or a headline."
(cl-assert (eq 'org-mode major-mode))
- ;; We do not ensure that a target only exists once in the file, but
- ;; neither does Org always do so.
- (setf target (url-unhex-string target))
- (goto-char (or (org-find-property "CUSTOM_ID" target)
- (org-find-property "ID" target)
- (org-find-exact-headline-in-buffer target)
- (hyperdrive-error "Unable to find entry in file: %S"
target))))
+ (org-link-search target))
(defun hyperdrive-org-link-complete ()
"Create a hyperdrive org link."
;; TODO: Support other hyper:// links like diffs when implemented.
(hyperdrive-entry-url (hyperdrive-read-entry :force-prompt t)))
+;; TODO: hyperdrive--org-* or hyperdrive-org--*?
+
(defun hyperdrive--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 \"fuzzy\" or \"file\" type.
-
-Uses `url-default-expander' to expand the relative link against
-the current location."
+the logic for handling links of \"file\" type."
(when hyperdrive-mode
- (let* ((context
- ;; TODO: Double-check that this is the correct way to get context.
- (org-element-lineage (org-element-context) '(link) t))
- (type (org-element-type context))
- (link-type (org-element-property :type context))
- (raw-link-type (org-element-property :raw-link context)))
- (when (and (eq type 'link)
- (or
- ;; "fuzzy" is for relative links without ./ prefix.
- (equal "fuzzy" link-type)
- ;; "file is for absolute links and relative links with ./
prefix.
- (equal "file" link-type))
- ;; Allow links to explicitly point to local files by
- ;; prefixing with "file:" (because Org assumes that links
- ;; without a specified protocol are "file:" links).
- (not (string-prefix-p "file:" raw-link-type)))
- (hyperdrive-open-url (hyperdrive-expand-url (org-element-property
:path context)))))))
+ (hyperdrive-open (hyperdrive--org-link-entry-at-point))))
+
+(defun hyperdrive--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.
+ (let* ((context (org-element-lineage (org-element-context) '(link) t))
+ (element-type (org-element-type context))
+ (link-type (org-element-property :type context))
+ (raw-link-type (org-element-property :raw-link context)))
+ (when (and (eq element-type 'link)
+ (equal "file" link-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
+ :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 _)
+ "Modify just-inserted link as appropriate for `hyperdrive-mode' buffers."
+ (when (and hyperdrive-mode hyperdrive-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))
+ (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)
+ desc))))))
+
+(cl-defun hyperdrive--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))))
+ (when (and search-option
+ (hyperdrive-entry-equal-p hyperdrive-current-entry entry))
+ (cl-return-from hyperdrive--org-shorthand-link search-option))
+
+ ;; Search option alone: Remove leading "::"
+ (when search-option
+ (cl-callf2 concat "::" search-option))
+
+ (let ((adaptive-target-p
+ ;; 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
+ (concat
+ (pcase org-link-file-path-type
+ ;; TODO: Handle `org-link-file-path-type' as a function.
+ ((or 'absolute
+ ;; TODO: Consider special-casing `noabbrev' - who knows?
+ ;; `noabbrev' is like `absolute' because hyperdrives have
+ ;; no home directory.
+ 'noabbrev
+ (and 'adaptive (guard (not adaptive-target-p))))
+ (hyperdrive-entry-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)))))
+ search-option)))))
+
+(defun hyperdrive--org-link-description (link)
+ "Return description of Org LINK or nil if it has none."
+ ;; TODO: Is there a built-in solution?
+ (when-let* ((desc-begin (org-element-property :contents-begin link))
+ (desc-end (org-element-property :contents-end link)))
+ (buffer-substring desc-begin desc-end)))
;;;###autoload
(with-eval-after-load 'org
diff --git a/hyperdrive.el b/hyperdrive.el
index 2f7e905945..5ce658be9c 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -303,10 +303,15 @@ Intended to be passed to `buffer-local-restore-state'.")
;; 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))
+ #'hyperdrive--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)
(remove-hook 'after-change-major-mode-hook
- #'hyperdrive--hack-write-contents-functions 'local)))
+ #'hyperdrive--hack-write-contents-functions 'local)
+ ;; FIXME: Only remove advice when all hyperdrive-mode buffers are killed.
+ ;; (advice-remove #'org-insert-link #'hyperdrive--org-insert-link)
+ ))
;; 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.
@@ -635,12 +640,11 @@ Universal prefix argument \\[universal-argument] forces
:finally (lambda ()
;; FIXME: Offer more informative message in case of
errors?
(hyperdrive-open (hyperdrive-entry-create
:hyperdrive hyperdrive
- :path
target-directory
- :encode
t))
+ :path
target-directory))
(hyperdrive-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
:encode t)))
+ (entry (hyperdrive-entry-create :hyperdrive hyperdrive :path
path)))
;; TODO: Handle failures? Retry?
(hyperdrive-upload-file file entry :queue queue :then #'ignore)))
(plz-run queue)))
diff --git a/tests/org links.org b/tests/org links.org
index 5ea1dce71c..cadb1f1741 100644
--- a/tests/org links.org
+++ b/tests/org links.org
@@ -15,15 +15,19 @@
Here are various link types which we want to test.
-*** ~hyper://~-prefixed, with or without brackets
+*** DONE ~hyper://~-prefixed, with or without brackets
+:LOGBOOK:
+- State "DONE" from [2023-09-06 Wed 18:23]
+:END:
+ *Notes:*
+ Spaces and such should be URL-encoded :: We decline to automatically
convert, e.g. spaces to ~%20~ when opening links; they should already be
encoded.
+ [ ] Consider giving an error when unencoded e.g. spaces are detected.
-**** TODO Links without targets
+**** DONE Links without targets
:LOGBOOK:
+- State "DONE" from "TODO" [2023-09-06 Wed 17:44]
- State "TODO" from [2023-08-30 Wed 14:43]
:END:
@@ -34,7 +38,10 @@ Here are various link types which we want to test.
+ There are FOUR SLASHES.
-**** Links with targets
+**** DONE Links with targets
+:LOGBOOK:
+- State "DONE" from [2023-09-06 Wed 17:44]
+:END:
*NOTE:* While in Org mode, these anchored links can only point to headings
with matching ~CUSTOM_ID~ properties, in hyperdrive we first check for matching
~CUSTOM_ID~, then ~ID~, then exact heading title content matches. (The anchor
part is URL-decoded and the leading ~#~ is discarded.)
@@ -61,11 +68,14 @@ Here are various link types which we want to test.
+ [[./links test.org]]
+ [[/links test.org]] :: For non-hyperdrive files, this actually links to a
file in the root directory of the filesystem. For hyperdrives, we want this to
point to a file in the hyperdrive's root.
-****** TODO Fix functionality for links like ~[[links test.org]]~
+****** CANCELED Fix functionality for links like ~[[links test.org]]~
:LOGBOOK:
+- State "CANCELED" from "TODO" [2023-09-06 Wed 18:00]
- State "TODO" from [2023-08-29 Tue 16:40]
:END:
+NOTE: This is technically the same as
[[id:c9711207-4a46-45be-9d67-3dc560249a5b][this link type]].
+
Org doesn't support this for local files (this syntax would point to a heading
by that name), so we should follow Org here. This is actually a bug.
***** Links to local files
@@ -96,7 +106,6 @@ Org doesn't support this for local files (this syntax would
point to a heading b
+ [[*Heading A]]
+ Does not work, includes target part in URL sent to server.
-
****** TODO Specified file
:LOGBOOK:
- State "TODO" from [2023-08-29 Tue 15:58]
@@ -114,6 +123,9 @@ Org doesn't support this for local files (this syntax would
point to a heading b
/Without a ~*~ or ~./~, the link is intended to point to a heading within the
same document./
****** Unspecified file (same file)
+:PROPERTIES:
+:ID: c9711207-4a46-45be-9d67-3dc560249a5b
+:END:
+ [[Heading A]]
@@ -121,6 +133,8 @@ Org doesn't support this for local files (this syntax would
point to a heading b
+ [[./links test.org::Heading A]]
+ [[/links test.org::Heading A]]
+# + [[~/links test.org::Heading A]]
+# + [[file:links test.org::Heading A]]
***** Custom IDs: HTML-style, ~#~-anchor-suffixed links
@@ -137,15 +151,17 @@ Org doesn't support this for local files (this syntax
would point to a heading b
(hyperdrive--org-link-goto "#Heading%20A")
#+end_src
-****** DONE Specified file
+****** TODO Specified file
:LOGBOOK:
+- State "TODO" from "DONE" [2023-09-06 Wed 17:05]
- State "DONE" from "TODO" [2023-08-30 Wed 14:48] \\
Both of these work.
- State "TODO" from [2023-08-29 Tue 15:58]
:END:
-+ [[./links test.org::#Heading%20A]]
-+ [[/links test.org#Heading%20A]]
++ [[./org links.org::#Heading%20A]]
++ [[/org links.org#Heading%20A]]
++ [[#hyperdrive foo][Heading with CUSTOM_ID]]
***** Regexp searches for file content
@@ -161,7 +177,9 @@ See [[file:tests/org links.org][tests/org links.org]]
/Below this line is a series of headings we use to link to for testing
purposes./
-** Heading A
+[[Heading A]]
+
+** Heading AB
/Heading without IDs (link to heading text)./
diff --git a/tests/test-hyperdrive-org.el b/tests/test-hyperdrive-org.el
new file mode 100644
index 0000000000..35ebe3bae5
--- /dev/null
+++ b/tests/test-hyperdrive-org.el
@@ -0,0 +1,332 @@
+;;; test-hyperdrive-org-link.el --- Tests for Hyperdrive.el -*-
lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Joseph Turner <joseph@ushin.org>
+
+;; Author: Joseph Turner
+;; Author: Adam Porter <adam@alphapapa.net>
+;; Maintainer: Joseph Turner <joseph@ushin.org>
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU Affero General Public License
+;; as published by the Free Software Foundation; either version 3 of
+;; the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; Affero General Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public
+;; License along with this program. If not, see
+;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file tests Hyperdrive.el's Org link functionality.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'cl-lib)
+(require 'ert)
+(require 'pcase)
+
+(require 'hyperdrive)
+(require 'hyperdrive-org)
+
+;;;; Tests
+
+;;;;; Scenarios
+
+(defvar hyperdrive-test-org-store-link-scenarios
+ '((org-mode-before-heading
+ :public-key "deadbeef"
+ :path "/foo/bar quux.org"
+ :content "★
+* Heading A"
+ :url "hyper://deadbeef/foo/bar%20quux.org"
+ :desc nil)
+ (org-mode-on-heading-with-custom-id
+ :public-key "deadbeef"
+ :path "/foo/bar quux.org"
+ :content
+ "* Heading A
+:PROPERTIES:
+:CUSTOM_ID: baz zot
+:END:
+★"
+ :url "hyper://deadbeef/foo/bar%20quux.org#%3A%3A%23baz%20zot"
+ :desc "Heading A")
+ (org-mode-on-heading-no-custom-id
+ :public-key "deadbeef"
+ :path "/foo/bar quux.org"
+ :content "* Heading A
+★"
+ :url "hyper://deadbeef/foo/bar%20quux.org#%3A%3A%2AHeading%20A"
+ :desc "Heading A"))
+ "Alist keyed by scenario symbols.
+Each value is a plist with the following keys:
+
+- \\+`:public-key'
+- \\+`:path'
+- \\+`:content'
+- \\+`:url'
+- \\+`:desc'")
+
+;;;;; Store links
+
+(cl-defun hyperdrive-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 ((org-id-link-to-org-use-id nil)
+ ;; (default-directory "/")
+ (entry (hyperdrive-entry-create
+ :hyperdrive (hyperdrive-create :public-key public-key)
+ :path path))
+ 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)
+ (goto-char (point-min))
+ (search-forward "★")
+ (org-store-link nil 'interactive))
+ org-stored-links))
+
+(defmacro hyperdrive-test-org-store-link-deftest (scenario)
+ "Test scenario in `hyperdrive-test-org-store-link-scenarios'."
+ (let ((test-name (intern
+ (format "hyperdrive-test-org-store-link/%s" scenario))))
+ `(ert-deftest ,test-name ()
+ (pcase-let* (((map :public-key :path :content
+ (:url expected-url) (:desc expected-desc))
+ ;; TODO: Is there a better syntax that explicit `quote'?
+ (alist-get (quote ,scenario)
+ hyperdrive-test-org-store-link-scenarios))
+ (`((,got-url ,got-desc))
+ (hyperdrive-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)
+
+;;;;; Insert links
+
+(cl-defun hyperdrive-test-org-entry-create (&key public-key path)
+ (hyperdrive-entry-create
+ :hyperdrive (hyperdrive-create :public-key public-key)
+ :path path))
+
+(cl-defun hyperdrive-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)))
+ (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))
+ (org-insert-link nil url desc)
+ (buffer-string))))
+
+(cl-defmacro hyperdrive-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."
+ (declare (indent defun))
+ (let ((scenario (intern (string-trim-right (symbol-name name)
+ (rx "/" (1+ anything) eos))))
+ body-forms)
+ (pcase-dolist ((map (:let vars) (:result result)) results)
+ (let* ((olfpt (cadadr (assoc 'org-link-file-path-type vars)))
+ (test-name (intern (format "hyperdrive-test-org-insert-link/%s/%s"
+ name olfpt))))
+ (push `(ert-deftest ,test-name ()
+ (let (,@vars)
+ (should (string= ,result
+ (hyperdrive-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
+ :public-key "deadbeef"
+ :path "/foo/bar quux.org"
+ :results (( :let ((org-link-file-path-type 'relative))
+ :result "[[./bar quux.org]]")
+ ( :let ((org-link-file-path-type 'absolute))
+ :result "[[/foo/bar quux.org]]")
+ ( :let ((org-link-file-path-type 'noabbrev))
+ :result "[[/foo/bar quux.org]]")
+ ( :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
+ :public-key "deadbeef"
+ :path "/foo/bar quux.org"
+ :results (( :let ((org-link-file-path-type 'relative))
+ :result "[[#baz zot][Heading A]]")
+ ( :let ((org-link-file-path-type 'absolute))
+ :result "[[#baz zot][Heading A]]")
+ ( :let ((org-link-file-path-type 'noabbrev))
+ :result "[[#baz zot][Heading A]]")
+ ( :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
+ :public-key "deadbeef"
+ :path "/foo/bar quux.org"
+ :results (( :let ((org-link-file-path-type 'relative))
+ :result "[[*Heading A][Heading A]]")
+ ( :let ((org-link-file-path-type 'absolute))
+ :result "[[*Heading A][Heading A]]")
+ ( :let ((org-link-file-path-type 'noabbrev))
+ :result "[[*Heading A][Heading A]]")
+ ( :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
+ :public-key "deadbeef"
+ :path "/thud.org"
+ :results (( :let ((org-link-file-path-type 'relative))
+ :result "[[./foo/bar quux.org]]")
+ ( :let ((org-link-file-path-type 'absolute))
+ :result "[[/foo/bar quux.org]]")
+ ( :let ((org-link-file-path-type 'noabbrev))
+ :result "[[/foo/bar quux.org]]")
+ ( :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
+ :public-key "deadbeef"
+ :path "/thud.org"
+ :results (( :let ((org-link-file-path-type 'relative))
+ :result "[[./foo/bar quux.org::#baz zot][Heading A]]")
+ ( :let ((org-link-file-path-type 'absolute))
+ :result "[[/foo/bar quux.org::#baz zot][Heading A]]")
+ ( :let ((org-link-file-path-type 'noabbrev))
+ :result "[[/foo/bar quux.org::#baz zot][Heading A]]")
+ ( :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
+ :public-key "deadbeef"
+ :path "/thud.org"
+ :results (( :let ((org-link-file-path-type 'relative))
+ :result "[[./foo/bar quux.org::*Heading A][Heading A]]")
+ ( :let ((org-link-file-path-type 'absolute))
+ :result "[[/foo/bar quux.org::*Heading A][Heading A]]")
+ ( :let ((org-link-file-path-type 'noabbrev))
+ :result "[[/foo/bar quux.org::*Heading A][Heading A]]")
+ ( :let ((org-link-file-path-type 'adaptive))
+ :result "[[./foo/bar quux.org::*Heading A][Heading A]]")))
+
+;;;;;; Insert full "hyper://" links
+
+;; Testing a different drive should stand in for testing
+;; `hyperdrive-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.
+
+(hyperdrive-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
+ :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
+ :public-key "fredbeef"
+ :path "/thud.org"
+ :results
+ ((:result
"[[hyper://deadbeef/foo/bar%20quux.org#%3A%3A%2AHeading%20A][Heading A]]")))
+
+;;;; 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'.
+
+(defmacro hyperdrive-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))
+ (with-temp-buffer
+ ;; FIXME: Use persistent buffer for performance.
+ (org-mode)
+ (erase-buffer)
+ (insert ,link)
+ (goto-char (point-min))
+ (should
+ (hyperdrive-entry-equal-p ,parsed-entry
(hyperdrive--org-link-entry-at-point))))))))
+
+(hyperdrive-org-test-link-parse-deftest absolute/without-search-option
+ (hyperdrive-entry-create
+ :hyperdrive (hyperdrive-create :public-key "deadbeef")
+ :path "/foo/bar quux.org")
+ "[[/foo/bar quux.org]]"
+ (hyperdrive-entry-create
+ :hyperdrive (hyperdrive-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")
+ :path "/foo/bar quux.org")
+ "[[../foo/bar quux.org]]"
+ (hyperdrive-entry-create
+ :hyperdrive (hyperdrive-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")
+ :path "/foo/bar quux.org")
+ "[[./bar quux.org]]"
+ (hyperdrive-entry-create
+ :hyperdrive (hyperdrive-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")
+ :path "/foo/bar quux.org")
+ "[[./bar quux.org::Heading A]]"
+ (hyperdrive-entry-create
+ :hyperdrive (hyperdrive-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")
+ :path "/foo/bar quux.org")
+ "[[./bar quux.org::*Heading A]]"
+ (hyperdrive-entry-create
+ :hyperdrive (hyperdrive-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")
+ :path "/foo/bar quux.org")
+ "[[./bar quux.org::#baz zot]]"
+ (hyperdrive-entry-create
+ :hyperdrive (hyperdrive-create :public-key "deadbeef")
+ :path "/foo/bar quux.org"
+ :etc '((target . "#baz zot"))))
diff --git a/tests/test-hyperdrive.el b/tests/test-hyperdrive.el
index 6345d4309f..1c6882fc7b 100644
--- a/tests/test-hyperdrive.el
+++ b/tests/test-hyperdrive.el
@@ -49,8 +49,7 @@
(declare (indent defun))
(let ((name (intern (concat "hyperdrive-" (symbol-name name)))))
`(cl-macrolet ((make-url
- (&rest args) `(concat "hyper://"
test-hyperdrive-public-key ,@args))
- (hexify (string) `(url-hexify-string ,string (cons ?/
url-unreserved-chars))))
+ (&rest args) `(concat "hyper://"
test-hyperdrive-public-key ,@args)))
(ert-deftest ,name () ,@args))))
;;;; Tests
@@ -70,9 +69,9 @@
(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 (hexify "/name with spaces")))))
+ (hyperdrive-url-entry (make-url (hyperdrive--url-hexify-string
"/name with spaces")))))
(should (equal name "name with spaces"))
- (should (equal path "/name%20with%20spaces")))
+ (should (equal path "/name with spaces")))
(pcase-let (((cl-struct hyperdrive-entry name path)
(hyperdrive-url-entry (make-url "/subdir/"))))
(should (equal name "subdir/"))
@@ -111,6 +110,25 @@
(hyperdrive-deftest url-entry--makes-hyperdrive ()
(pcase-let* (((cl-struct hyperdrive-entry hyperdrive)
- (hyperdrive-url-entry (make-url (hexify "/subdir/with-file"))))
+ (hyperdrive-url-entry (make-url (hyperdrive--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 ()
+
+ (let ((url (hyperdrive-entry-url (hyperdrive-url-entry (make-url "")))))
+ (should (equal url (concat "hyper://" test-hyperdrive-public-key "/"))))
+
+ (let ((url (hyperdrive-entry-url (hyperdrive-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")))))
+ (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")))))
+ (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")))))
+ (should (equal url (concat "hyper://" test-hyperdrive-public-key
+ "/name%20without%20spaces/subdir")))))
- [nongnu] elpa/hyperdrive 6293463834 67/82: Comment: Add TODO, (continued)
- [nongnu] elpa/hyperdrive 6293463834 67/82: Comment: Add TODO, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 43f50f2ae7 69/82: Change/Fix: (hyperdrive--org-open-at-point) Don't handle fuzzy links, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 27d352dda2 70/82: Comment: Remove TODO, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 5588fb4e1d 71/82: Change/Fix: (hyperdrive--org-link-goto) Don't URI-decode target, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive dafc7f1b93 72/82: Fix: (hyperdrive--org-link-goto) Use org-link-search, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive c1932fb6fd 74/82: Change: (hyperdrive--org-open-at-point) Include target, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 20dd9efc70 76/82: Tidy, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 0a875bef41 78/82: Fix: Docstring, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive fe3c0c374a 79/82: Tests: Add relative/absolute link parsing tests, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 7d06ffd037 80/82: Meta: Update .gitignore, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 7826c10faa 81/82: Merge branch 'wip/org-heading-links',
ELPA Syncer <=
- [nongnu] elpa/hyperdrive 903847d50e 82/82: Tidy: Docstrings, comments, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 670ae8050f 03/82: WIP: Add link tests, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 9b3b215444 04/82: WIP, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 62c487448f 06/82: WIP, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 28d4b1a6d6 08/82: Add: (hyperdrive-equal-p, -entry-hyperdrive-equal-p), ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive bdf9a94b49 09/82: WIP, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 96d458868b 10/82: WIP, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 8a453f0eb4 14/82: WIP: All tests passing! (so far), ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive 82305e861b 15/82: WIP: Have macro define narrower tests, ELPA Syncer, 2023/09/25
- [nongnu] elpa/hyperdrive a72cf3820d 17/82: WIP: All tests pass, etc., ELPA Syncer, 2023/09/25