branch: elpa/hyperdrive
commit ae08015be95d50c518369eeac6af236fd2914b4c
Author: Adam Porter <[email protected]>
Commit: Adam Porter <[email protected]>
Add: Markdown link support
---
hyperdrive.el | 32 +++++++++++
tests/test-hyperdrive-markdown.el | 115 ++++++++++++++++++++++++++++++++++++++
2 files changed, 147 insertions(+)
diff --git a/hyperdrive.el b/hyperdrive.el
index 9c10baacf8..d8da2b4d6c 100644
--- a/hyperdrive.el
+++ b/hyperdrive.el
@@ -1223,6 +1223,38 @@ The return value of this function is the retrieval
buffer."
(interactive)
(info "(hyperdrive) Top"))
+;;;;; Markdown link support
+
+(defun hyperdrive--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))
+ t)
+ (_ nil)))
+
+(defun hyperdrive--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))
+ ;; 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
+ :hyperdrive hyperdrive
+ :path (expand-file-name filename (file-name-directory path))
+ ;; FIXME: Target.
+ ;; :etc `((target . ,FOO))
+ )))
+
+;;;###autoload
+(with-eval-after-load 'markdown-mode
+ (when (boundp 'markdown-follow-link-functions)
+ (cl-pushnew #'hyperdrive--markdown-follow-link
markdown-follow-link-functions)))
+
;;;; Footer
(provide 'hyperdrive)
diff --git a/tests/test-hyperdrive-markdown.el
b/tests/test-hyperdrive-markdown.el
new file mode 100644
index 0000000000..58eb08b575
--- /dev/null
+++ b/tests/test-hyperdrive-markdown.el
@@ -0,0 +1,115 @@
+;;; test-hyperdrive-markdown.el --- Test Hyperdrive.el's integration with
markdown-mode -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023 Joseph Turner <[email protected]>
+
+;; Author: Joseph Turner
+;; Author: Adam Porter <[email protected]>
+;; Maintainer: Joseph Turner <[email protected]>
+
+;; 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 `markdown-mode' link functionality.
+
+;;; Code:
+
+;;;; Requirements
+
+(require 'cl-lib)
+(require 'ert)
+(require 'pcase)
+
+(require 'hyperdrive)
+(require 'markdown-mode)
+
+;;;; Tests
+
+;;;; 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-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))
+ (with-temp-buffer
+ ;; FIXME: Use persistent buffer for performance.
+ (markdown-mode)
+ (erase-buffer)
+ (insert ,link)
+ (goto-char (point-min))
+ (should
+ (hyperdrive-entry-equal-p ,parsed-entry
+ (hyperdrive--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")
+ :path "/foo/bar quux.md")
+ "[link](</foo/bar quux.md>)"
+ (hyperdrive-entry-create
+ :hyperdrive (hyperdrive-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")
+ :path "/foo/bar quux.md")
+ "[link](<../foo/bar quux.md>)"
+ (hyperdrive-entry-create
+ :hyperdrive (hyperdrive-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")
+ :path "/foo/bar quux.md")
+ "[link](<./bar quux.md>)"
+ (hyperdrive-entry-create
+ :hyperdrive (hyperdrive-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")
+;; :path "/foo/bar quux.md")
+;; "[link](<./bar quux.md::Heading A>)"
+;; (hyperdrive-entry-create
+;; :hyperdrive (hyperdrive-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")
+;; :path "/foo/bar quux.md")
+;; "[link](<./bar quux.md::*Heading A>)"
+;; (hyperdrive-entry-create
+;; :hyperdrive (hyperdrive-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")
+;; :path "/foo/bar quux.md")
+;; "[link](<./bar quux.md::#baz zot>)"
+;; (hyperdrive-entry-create
+;; :hyperdrive (hyperdrive-create :public-key "deadbeef")
+;; :path "/foo/bar quux.md"
+;; :etc '((target . "#baz zot"))))
