From 27a7b659c7b1b17a165e896ead70853b67c435de Mon Sep 17 00:00:00 2001 From: Samuel Morris Date: Mon, 28 Apr 2025 11:16:37 -0400 Subject: [PATCH 1/2] links: add support for internal links MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Internal links allow users to link directly to sections within a document. These types of links are supported by most markdown parsers, and are part of the standard url format: https://en.wikipedia.org/wiki/URL#Syntax The URL standard refers to them as "fragments", but Emacs’ url library refers to them as "targets" so that’s the nomenclature used here. Notice also that link I referenced itself contains a fragment. Markdown links may be "full" or "partial". "full" links are defined to contain the "type" in the URL standard. "Partial" links contain only the "fragment" component. Partial links are very useful for portability, but may not link between documents. Link fragments are generated through a standard normalization process, where a heading is downcased, stripped of punctuation, then kebab-cased. This means links are case and punctuation insensitive. Links also do not contain nesting information according to the standard. A later, alternate style of link could pretty easily resolve these shortcomings, but at the moment is not portable. This changeset allows users to copy links to the kill ring, and navigate them. --- markdown-mode.el | 73 +++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 69 insertions(+), 4 deletions(-) diff --git a/markdown-mode.el b/markdown-mode.el index fc1796b3..58e7ad89 100644 --- a/markdown-mode.el +++ b/markdown-mode.el @@ -8211,22 +8211,87 @@ returns nil." (or url (and ref (car (markdown-reference-definition (downcase (if (string= ref "") text ref)))))))) +(defun markdown--normalize-target (target) + (if-let* ((heading target) + (normalized (downcase heading)) + (normalized (string-replace "-" " " normalized)) + (normalized (replace-regexp-in-string "[[:punct:]]" "" + normalized)) + (normalized (string-replace " " "-" normalized)) + (url (format "%s" normalized))) + url + (warn "Failed to normalize url"))) + +(defun markdown--partial-heading-url-at-point () + "Return the heading link at point." + (if (markdown-heading-at-point) + (concat "#" (markdown--normalize-target (match-string 5))) + (warn "No heading found at point"))) + +(defun markdown--full-heading-url-at-point () + "Return the full file url at point, including the internal heading if +it exists." + (concat "file://" (buffer-file-name) + (markdown--partial-heading-url-at-point))) + +(defun markdown-copy-partial-heading-link-at-point-as-kill () + "Copy internal heading link at point to the `kill-ring'." + (interactive) + (if-let ((url (markdown--partial-heading-url-at-point))) + (progn + (message "Copied: %s" url) + (kill-new url)))) + +(defun markdown-copy-full-heading-link-at-point-as-kill () + "Copy the full url to heading at point to the `kill-ring'." + (interactive) + (if-let ((url (markdown--full-heading-url-at-point))) + (progn + (message "Copied: %s" url) + (kill-new url)))) + +(defun markdown--collect-targets (&optional buffer) + "Return all headings within BUFFER in a list as targets." + (with-current-buffer (current-buffer) + (let (targets) + (save-mark-and-excursion + (goto-char (point-min)) + (while (re-search-forward markdown-regex-header (buffer-end 1) t) + (setq targets + (append targets + (list (cons (markdown--normalize-target (match-string 5)) + (match-beginning 5))))))) + targets))) + +(defun markdown--jump-to-target (target) + "Push mark to current location and jump to TARGET." + (let* ((targets (markdown--collect-targets)) + (pos (cdr (assoc target targets)))) + (push-mark) + (goto-char pos))) + (defun markdown--browse-url (url) (let* ((struct (url-generic-parse-url url)) (full (url-fullness struct)) - (file url)) + (file url) + (target (url-target struct))) ;; Parse URL, determine fullness, strip query string (setq file (car (url-path-and-query struct))) ;; Open full URLs in browser, files in Emacs (if full - (browse-url url) + (let ((type (url-type struct))) + (browse-url url) + (when (and (equal type "file") target) + (markdown--jump-to-target target))) (when (and file (> (length file) 0)) (let ((link-file (funcall markdown-translate-filename-function file))) (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file)) (if (functionp markdown-open-image-command) (funcall markdown-open-image-command link-file) - (process-file markdown-open-image-command nil nil nil link-file)) - (find-file link-file))))))) + (process-file markdown-open-image-command nil nil nil link-file))) + (find-file link-file))) + (when target + (markdown--jump-to-target target))))) (defun markdown-follow-link-at-point (&optional event) "Open the non-wiki link at point or EVENT. From 2e8d3d22bc66d7f2ec2434fad649d2b4b8fee83e Mon Sep 17 00:00:00 2001 From: Samuel Morris Date: Mon, 28 Apr 2025 18:17:54 -0400 Subject: [PATCH 2/2] add command to jump to heading by name --- markdown-mode.el | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/markdown-mode.el b/markdown-mode.el index 58e7ad89..21b5caf2 100644 --- a/markdown-mode.el +++ b/markdown-mode.el @@ -8250,9 +8250,30 @@ it exists." (message "Copied: %s" url) (kill-new url)))) +(defun markdown--collect-headings (&optional buffer) + "Return all headings within BUFFER in a list as targets." + (with-current-buffer (or buffer (current-buffer)) + (let (targets) + (save-mark-and-excursion + (goto-char (point-min)) + (while (re-search-forward markdown-regex-header (buffer-end 1) t) + (setq targets + (append targets + (list (cons (match-string 5) + (match-beginning 5))))))) + targets))) + +(defun markdown-jump-to-heading (target) + "Push mark to current location and jump to TARGET." + (interactive (list (let ((targets (markdown--collect-headings))) + (assoc (completing-read "Jump to target heading: " targets) targets)))) + (let* ((pos (cdr target))) + (push-mark) + (goto-char pos))) + (defun markdown--collect-targets (&optional buffer) "Return all headings within BUFFER in a list as targets." - (with-current-buffer (current-buffer) + (with-current-buffer (or buffer (current-buffer)) (let (targets) (save-mark-and-excursion (goto-char (point-min))