[nongnu] elpa/hyperdrive c536bc9a2c 11/82: WIP

[ELPA Syncer]

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

    WIP
---
 hyperdrive-org.el        | 41 +++++++++++++++++------------------------
 tests/test-hyperdrive.el | 18 ++++++++++++++++++
 2 files changed, 35 insertions(+), 24 deletions(-)

diff --git a/hyperdrive-org.el b/hyperdrive-org.el
index 8ff6648a8d..4cca5bfc1b 100644
--- a/hyperdrive-org.el
+++ b/hyperdrive-org.el
@@ -162,36 +162,29 @@ the current location."
     (let* ((link-element (org-element-context))
            (_ (cl-assert (eq 'link (car link-element))))
            (target-entry (hyperdrive-url-entry (org-element-property :raw-link 
link-element)))
-           (host-format '(public-key))
-           (with-path t)
-           (fragment-prefix "#"))
-      (when (equal (hyperdrive-public-key (hyperdrive-entry-hyperdrive 
hyperdrive-current-entry))
-                   (hyperdrive-public-key (hyperdrive-entry-hyperdrive 
target-entry)))
-        ;; Link points to same hyperdrive as the file the link is in:
-        ;; make link relative.
-        (setf host-format nil))
-      (when (equal (hyperdrive-entry-path hyperdrive-current-entry)
-                   (hyperdrive-entry-path target-entry))
-        ;; Link points to same file: make link relative.
-        (setf with-path nil)
-        (when (alist-get 'target (hyperdrive-entry-etc target-entry))
-          ;; HACK: Adjust target to give us the result we want.
-          (setf fragment-prefix "")
-          ))
-      
+           (host-format '(public-key)) (with-path t) (with-protocol t)
+           fragment-prefix)
+      (cond ((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 nil))
+            ((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))
+            (t
+             (setf fragment-prefix (concat "#" (url-hexify-string "::")))
+             (cl-callf url-hexify-string (alist-get 'target 
(hyperdrive-entry-etc target-entry)))))
       (delete-region (org-element-property :begin link-element)
                      (org-element-property :end link-element))
       (insert (org-link-make-string
                (hyperdrive--format-entry-url
                 target-entry :fragment-prefix fragment-prefix
                 :with-path with-path
-                :with-protocol nil :host-format host-format)))
-      
-      
-      )
-    ))
-
-
+                :with-protocol with-protocol :host-format host-format))))))
 
 ;;;###autoload
 (with-eval-after-load 'org
diff --git a/tests/test-hyperdrive.el b/tests/test-hyperdrive.el
index 53e3ed2d8b..6a38fa1993 100644
--- a/tests/test-hyperdrive.el
+++ b/tests/test-hyperdrive.el
@@ -259,6 +259,24 @@ LINK is an Org link as a string."
 (ert-deftest hyperdrive-link-heading-within-drive ()
   "Linking to a heading within the same drive but different file.")
 
+;;;;;;; With protocol
+
+;; These links will look the same regardless of hyperdrive or path.
+
+(ert-deftest hyperdrive-link-different-drive-with-custom-id ()
+  (should
+   (equal "[[hyper://deadbeef/foo/bar.org#%3A%3A%23example%20ID]]"
+          (hyperdrive-test-org-link-roundtrip
+           "
+* Heading A
+:PROPERTIES:
+:CUSTOM_ID: example ID
+:END:
+<|>
+* Heading B"
+           :store-from '("deadbeef" . "/foo/bar.org")
+           :insert-into '("fredbeef" . "/foo/bar.org")))))
+
 ;; (hyperdrive-test-org-link-roundtrip
 ;;  "<|>
 ;; * Heading A