Rewrite custom org link types
This should fix a few issues with links (like org-download links) resolving to the incorrect org-directory or org-id-attach-dir (because it's resolved too early). I've also simplified and refactored the API to make it easier to grok.
This commit is contained in:
parent
2c0935cb62
commit
6159068b4d
3 changed files with 54 additions and 36 deletions
|
@ -1,43 +1,59 @@
|
||||||
;;; lang/org/autoload/org-link.el -*- lexical-binding: t; -*-
|
;;; lang/org/autoload/org-link.el -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
(defun +org--relpath (path root)
|
(defun +org--relative-path (path root)
|
||||||
(if (and buffer-file-name (file-in-directory-p buffer-file-name root))
|
(if (and buffer-file-name (file-in-directory-p buffer-file-name root))
|
||||||
(file-relative-name path)
|
(file-relative-name path)
|
||||||
path))
|
path))
|
||||||
|
|
||||||
;;;###autoload
|
(defun +org--read-link-path (key dir &optional fn)
|
||||||
(defun +org-def-link (key dir)
|
(let ((file (funcall (or fn #'read-file-name) (format "%s: " (capitalize key)) dir)))
|
||||||
(org-link-set-parameters
|
(format "%s:%s" key (file-relative-name file dir))))
|
||||||
key
|
|
||||||
:complete (lambda () (+org--relpath (+org-link-read-file key dir) dir))
|
|
||||||
:follow (lambda (link) (find-file (expand-file-name link dir)))
|
|
||||||
:face (lambda (link)
|
|
||||||
(if (file-exists-p (expand-file-name link dir))
|
|
||||||
'org-link
|
|
||||||
'error))))
|
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun +org-link-read-file (key dir)
|
(defun +org-define-basic-link (key dir-var &rest plist)
|
||||||
(let ((file (read-file-name (format "%s: " (capitalize key)) dir)))
|
"Define a link with some basic completion & fontification.
|
||||||
(format "%s:%s"
|
|
||||||
key
|
KEY is the name of the link type. DIR-VAR is the directory variable to resolve
|
||||||
(file-relative-name file dir))))
|
links relative to. PLIST is passed to `org-link-set-parameters' verbatim.
|
||||||
|
|
||||||
|
Links defined with this will be rendered in the `error' face if the file doesn't
|
||||||
|
exist, and `org-link' otherwise."
|
||||||
|
(declare (indent 2))
|
||||||
|
(let ((requires (plist-get plist :requires)))
|
||||||
|
(apply #'org-link-set-parameters
|
||||||
|
key
|
||||||
|
:complete (lambda ()
|
||||||
|
(if requires (mapc #'require (doom-enlist requires)))
|
||||||
|
(+org--relative-path (+org--read-link-path key (symbol-value dir-var))
|
||||||
|
(symbol-value dir-var)))
|
||||||
|
:follow (lambda (link) (find-file (expand-file-name link (symbol-value dir-var))))
|
||||||
|
:face (lambda (link)
|
||||||
|
(if (file-exists-p (expand-file-name link (symbol-value dir-var)))
|
||||||
|
'org-link
|
||||||
|
'error))
|
||||||
|
(doom-plist-delete plist :requires))))
|
||||||
|
|
||||||
|
|
||||||
|
;;
|
||||||
|
;;; Image data functions (for custom inline images)
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun +org-link-read-directory (key dir)
|
(defun +org-image-file-data-fn (protocol link _description)
|
||||||
(let ((file (read-directory-name (format "%s: " (capitalize key)) dir)))
|
"Intepret LINK as an image file path and return its data."
|
||||||
(format "%s:%s"
|
(when (and (file-exists-p link)
|
||||||
key
|
(image-type-from-file-name link))
|
||||||
(file-relative-name file dir))))
|
(with-temp-buffer
|
||||||
|
(insert-file-contents-literally link)
|
||||||
|
(buffer-string))))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun +org-inline-data-image (_protocol link _description)
|
(defun +org-inline-image-data-fn (_protocol link _description)
|
||||||
"Interpret LINK as base64-encoded image data."
|
"Interpret LINK as base64-encoded image data."
|
||||||
(base64-decode-string link))
|
(base64-decode-string link))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun +org-image-link (protocol link _description)
|
(defun +org-http-image-data-fn (protocol link _description)
|
||||||
"Interpret LINK as base64-encoded image data."
|
"Interpret LINK as an URL to an image file."
|
||||||
(when (image-type-from-file-name link)
|
(when (image-type-from-file-name link)
|
||||||
(if-let* ((buf (url-retrieve-synchronously (concat protocol ":" link))))
|
(if-let* ((buf (url-retrieve-synchronously (concat protocol ":" link))))
|
||||||
(with-current-buffer buf
|
(with-current-buffer buf
|
||||||
|
|
|
@ -397,15 +397,15 @@ underlying, modified buffer. This fixes that."
|
||||||
'("wolfram" . "https://wolframalpha.com/input/?i=%s")
|
'("wolfram" . "https://wolframalpha.com/input/?i=%s")
|
||||||
'("doom-repo" . "https://github.com/hlissner/doom-emacs/%s"))
|
'("doom-repo" . "https://github.com/hlissner/doom-emacs/%s"))
|
||||||
|
|
||||||
(+org-def-link "org" org-directory)
|
(+org-define-basic-link "org" 'org-directory)
|
||||||
(+org-def-link "doom" doom-emacs-dir)
|
(+org-define-basic-link "doom" 'doom-emacs-dir)
|
||||||
(+org-def-link "doom-docs" doom-docs-dir)
|
(+org-define-basic-link "doom-docs" 'doom-docs-dir)
|
||||||
(+org-def-link "doom-modules" doom-modules-dir)
|
(+org-define-basic-link "doom-modules" 'doom-modules-dir)
|
||||||
|
|
||||||
;; Allow inline image previews of http(s)? urls or data uris
|
;; Allow inline image previews of http(s)? urls or data uris
|
||||||
(org-link-set-parameters "http" :image-data-fun #'+org-image-link)
|
(org-link-set-parameters "http" :image-data-fun #'+org-http-image-data-fn)
|
||||||
(org-link-set-parameters "https" :image-data-fun #'+org-image-link)
|
(org-link-set-parameters "https" :image-data-fun #'+org-http-image-data-fn)
|
||||||
(org-link-set-parameters "img" :image-data-fun #'+org-inline-data-image)
|
(org-link-set-parameters "img" :image-data-fun #'+org-inline-image-data-fn)
|
||||||
|
|
||||||
;; Add support for youtube links + previews
|
;; Add support for youtube links + previews
|
||||||
(require 'org-yt nil t))
|
(require 'org-yt nil t))
|
||||||
|
|
|
@ -16,12 +16,14 @@
|
||||||
|
|
||||||
(after! org
|
(after! org
|
||||||
;; A shorter link to attachments
|
;; A shorter link to attachments
|
||||||
(+org-def-link "download" org-attach-id-dir)
|
(+org-define-basic-link "download" 'org-attach-id-dir
|
||||||
(setf (alist-get "download" org-link-abbrev-alist nil nil #'equal)
|
:image-data-fun #'+org-image-file-data-fn
|
||||||
(abbreviate-file-name org-attach-id-dir)))
|
:requires 'org-download))
|
||||||
:config
|
:config
|
||||||
(setq org-download-image-dir org-attach-id-dir
|
(unless org-download-image-dir
|
||||||
org-download-link-format "[[download:%s]]\n"
|
(setq org-download-image-dir (expand-file-name (or org-attach-id-dir "")
|
||||||
|
org-directory)))
|
||||||
|
(setq org-download-link-format "[[download:%s]]\n"
|
||||||
org-download-method 'attach
|
org-download-method 'attach
|
||||||
org-download-heading-lvl nil
|
org-download-heading-lvl nil
|
||||||
org-download-timestamp "_%Y%m%d_%H%M%S"
|
org-download-timestamp "_%Y%m%d_%H%M%S"
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue