[nongnu] elpa/hyperdrive a72cf3820d 17/82: WIP: All tests pass, etc.

[ELPA Syncer]

branch: elpa/hyperdrive
commit a72cf3820d140f4507ce98ce5f9cddc3ae7fd881
Author: Adam Porter <adam@alphapapa.net>
Commit: Adam Porter <adam@alphapapa.net>

    WIP: All tests pass, etc.
---
 hyperdrive-lib.el                 |  1 +
 hyperdrive-org.el                 | 72 +++++++++++++++++--------------------
 tests/test-hyperdrive-org-link.el | 76 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 109 insertions(+), 40 deletions(-)

diff --git a/hyperdrive-lib.el b/hyperdrive-lib.el
index 8edcced9b2..7294606306 100644
--- a/hyperdrive-lib.el
+++ b/hyperdrive-lib.el
@@ -955,6 +955,7 @@ 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."
+  ;; FIXME: Update docstring to explain that the URL parts are URL-encoded 
when appropriate.
   ;; 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.
diff --git a/hyperdrive-org.el b/hyperdrive-org.el
index dcc38307e4..ac64f974a0 100644
--- a/hyperdrive-org.el
+++ b/hyperdrive-org.el
@@ -36,6 +36,12 @@
 (declare-function hyperdrive-open-url "hyperdrive")
 (declare-function hyperdrive-dir--entry-at-point "hyperdrive-dir")
 
+(defcustom hyperdrive-org-link-full-url nil
+  "Use full \"hyper://\" URLs when storing and inserting links in Org files.
+Otherwise, follow setting in `org-link-file-path-type'."
+  :type 'boolean
+  :group 'hyperdrive)
+
 ;; TODO: Determine whether it's really necessary to autoload these two 
functions.
 
 ;;;###autoload
@@ -156,11 +162,6 @@ the current location."
         ;; FIXME: For fuzzy links, passing to hyperdrive-expand-url is a no-no.
         (hyperdrive-open-url (hyperdrive-expand-url (org-element-property 
:path context)))))))
 
-(defcustom hyperdrive-org-link-full-url nil
-  "Use full \"hyper://\" URLs when storing and inserting links in Org files.
-Otherwise, follow setting in `org-link-file-path-type'."
-  :type 'boolean)
-
 (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)
@@ -173,8 +174,7 @@ Otherwise, follow setting in `org-link-file-path-type'."
       (cond (hyperdrive-org-link-full-url
              ;; User wants only full "hyper://" URLs.
              (when (alist-get 'target (hyperdrive-entry-etc target-entry))
-               (setf fragment-prefix (concat "#" (url-hexify-string "::")))
-               (cl-callf url-hexify-string (alist-get 'target 
(hyperdrive-entry-etc target-entry))))
+               (setf fragment-prefix (concat "#" (url-hexify-string "::"))))
              (setf destination (hyperdrive--format-entry-url
                                 target-entry :fragment-prefix fragment-prefix
                                 :with-path with-path
@@ -182,42 +182,34 @@ Otherwise, follow setting in `org-link-file-path-type'."
             ((hyperdrive-entry-equal-p hyperdrive-current-entry target-entry)
              ;; Link points to same file on same hyperdrive: make link
              ;; relative.
-             (setf with-protocol nil
-                   host-format nil
-                   with-path (if (alist-get 'target (hyperdrive-entry-etc 
target-entry))
-                                 nil t)
-                   destination (concat "./"
-                                       (file-relative-name
-                                        (hyperdrive-entry-path target-entry)
-                                        (file-name-directory 
(hyperdrive-entry-path target-entry)))))
-             (pcase org-link-file-path-type
-               ((or 'absolute 'noabbrev)
-                ;; These two options are the same for our purposes,
-                ;; because hyperdrives have no home directory.
-                (setf destination (hyperdrive-entry-path target-entry)))
-               ('adaptive
-                (setf destination
-                      (if (string-prefix-p (file-name-parent-directory
-                                            (hyperdrive-entry-path 
hyperdrive-current-entry))
-                                           (hyperdrive-entry-path 
target-entry))
-                          ;; Link points to file in same directory tree: use 
relative link.
-                          (concat "./"
-                                  (file-relative-name
-                                   (hyperdrive-entry-path target-entry)
-                                   (file-name-directory (hyperdrive-entry-path 
target-entry))))
-                        (hyperdrive-entry-path target-entry))))
-               ('relative
-                (setf destination
-                      (concat "./"
-                              (file-relative-name
-                               (hyperdrive-entry-path target-entry)
-                               (file-name-directory (hyperdrive-entry-path 
target-entry))))))))
+             (setf destination
+                   (or (alist-get 'target (hyperdrive-entry-etc target-entry))
+                       (pcase org-link-file-path-type
+                         ((or 'absolute 'noabbrev)
+                          ;; These two options are the same for our purposes,
+                          ;; because hyperdrives have no home directory.
+                          (setf destination (hyperdrive-entry-path 
target-entry)))
+                         ('adaptive
+                          (setf destination
+                                (if (string-prefix-p 
(file-name-parent-directory
+                                                      (hyperdrive-entry-path 
hyperdrive-current-entry))
+                                                     (hyperdrive-entry-path 
target-entry))
+                                    ;; Link points to file in same directory 
tree: use relative link.
+                                    (concat "./"
+                                            (file-relative-name
+                                             (hyperdrive-entry-path 
target-entry)
+                                             (file-name-directory 
(hyperdrive-entry-path target-entry))))
+                                  (hyperdrive-entry-path target-entry))))
+                         ('relative
+                          (setf destination
+                                (concat "./"
+                                        (file-relative-name
+                                         (hyperdrive-entry-path target-entry)
+                                         (file-name-directory 
(hyperdrive-entry-path target-entry))))))))))
             ((hyperdrive-entry-hyperdrive-equal-p hyperdrive-current-entry 
target-entry)
              ;; Link points to same hyperdrive as the file the link is in:
              ;; make link relative.
-             (setf with-protocol nil
-                   host-format nil
-                   destination (concat "./"
+             (setf destination (concat "./"
                                        (file-relative-name
                                         (hyperdrive-entry-path target-entry)
                                         (file-name-directory 
(hyperdrive-entry-path target-entry))))))
diff --git a/tests/test-hyperdrive-org-link.el 
b/tests/test-hyperdrive-org-link.el
index 2353e69a12..80dc7dd49c 100644
--- a/tests/test-hyperdrive-org-link.el
+++ b/tests/test-hyperdrive-org-link.el
@@ -114,6 +114,9 @@
               body-forms)))
     `(progn ,@(nreverse body-forms))))
 
+;; TODO: We'll need at least one test for inserting a link into an Org
+;; file that is /not/ in a hyperdrive.
+
 (hyperdrive-test-org-link-deftest same-drive-same-file-before-heading
   :store-body "<|>
 * Heading A
@@ -151,6 +154,79 @@
                     (hyperdrive-org-link-full-url t))
               :result "[[hyper://deadbeef/foo/bar%20quux.org]]")))
 
+(hyperdrive-test-org-link-deftest 
same-drive-same-file-on-heading-with-custom-id
+  :store-body "
+* Heading A
+:PROPERTIES:
+:CUSTOM_ID: baz zot
+:END:
+<|>
+* Heading B"
+  :store-from '("deadbeef" . "/foo/bar quux.org")
+  :insert-into '("deadbeef" . "/foo/bar quux.org")
+  :results (( :let ((org-link-file-path-type 'relative)
+                    (hyperdrive-org-link-full-url nil))
+              :result "[[#baz zot]]")
+            ( :let ((org-link-file-path-type 'relative)
+                    (hyperdrive-org-link-full-url t))
+              :result 
"[[hyper://deadbeef/foo/bar%20quux.org#%3A%3A%23baz%20zot]]")
+
+            ( :let ((org-link-file-path-type 'absolute)
+                    (hyperdrive-org-link-full-url nil))
+              :result "[[#baz zot]]")
+            ( :let ((org-link-file-path-type 'absolute)
+                    (hyperdrive-org-link-full-url t))
+              :result 
"[[hyper://deadbeef/foo/bar%20quux.org#%3A%3A%23baz%20zot]]")
+
+            ( :let ((org-link-file-path-type 'noabbrev)
+                    (hyperdrive-org-link-full-url nil))
+              :result "[[#baz zot]]")
+            ( :let ((org-link-file-path-type 'noabbrev)
+                    (hyperdrive-org-link-full-url t))
+              :result 
"[[hyper://deadbeef/foo/bar%20quux.org#%3A%3A%23baz%20zot]]")
+
+            ( :let ((org-link-file-path-type 'adaptive)
+                    (hyperdrive-org-link-full-url nil))
+              :result "[[#baz zot]]")
+            ( :let ((org-link-file-path-type 'adaptive)
+                    (hyperdrive-org-link-full-url t))
+              :result 
"[[hyper://deadbeef/foo/bar%20quux.org#%3A%3A%23baz%20zot]]")))
+
+(hyperdrive-test-org-link-deftest same-drive-same-file-on-heading-no-custom-id
+  :store-body "
+* Heading A
+<|>
+* Heading B"
+  :store-from '("deadbeef" . "/foo/bar quux.org")
+  :insert-into '("deadbeef" . "/foo/bar quux.org")
+  :results (( :let ((org-link-file-path-type 'relative)
+                    (hyperdrive-org-link-full-url nil))
+              :result "[[*Heading A]]")
+            ( :let ((org-link-file-path-type 'relative)
+                    (hyperdrive-org-link-full-url t))
+              :result 
"[[hyper://deadbeef/foo/bar%20quux.org#%3A%3A%2AHeading%20A]]")
+
+            ( :let ((org-link-file-path-type 'absolute)
+                    (hyperdrive-org-link-full-url nil))
+              :result "[[*Heading A]]")
+            ( :let ((org-link-file-path-type 'absolute)
+                    (hyperdrive-org-link-full-url t))
+              :result 
"[[hyper://deadbeef/foo/bar%20quux.org#%3A%3A%2AHeading%20A]]")
+
+            ( :let ((org-link-file-path-type 'noabbrev)
+                    (hyperdrive-org-link-full-url nil))
+              :result "[[*Heading A]]")
+            ( :let ((org-link-file-path-type 'noabbrev)
+                    (hyperdrive-org-link-full-url t))
+              :result 
"[[hyper://deadbeef/foo/bar%20quux.org#%3A%3A%2AHeading%20A]]")
+
+            ( :let ((org-link-file-path-type 'adaptive)
+                    (hyperdrive-org-link-full-url nil))
+              :result "[[*Heading A]]")
+            ( :let ((org-link-file-path-type 'adaptive)
+                    (hyperdrive-org-link-full-url t))
+              :result 
"[[hyper://deadbeef/foo/bar%20quux.org#%3A%3A%2AHeading%20A]]")))
+
 ;;     * ~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~