diff --git a/modules/lang/org/autoload/org-link.el b/modules/lang/org/autoload/org-link.el index bc4317183..dd887a5a8 100644 --- a/modules/lang/org/autoload/org-link.el +++ b/modules/lang/org/autoload/org-link.el @@ -1,43 +1,59 @@ ;;; 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)) (file-relative-name path) path)) -;;;###autoload -(defun +org-def-link (key dir) - (org-link-set-parameters - 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)))) +(defun +org--read-link-path (key dir &optional fn) + (let ((file (funcall (or fn #'read-file-name) (format "%s: " (capitalize key)) dir))) + (format "%s:%s" key (file-relative-name file dir)))) ;;;###autoload -(defun +org-link-read-file (key dir) - (let ((file (read-file-name (format "%s: " (capitalize key)) dir))) - (format "%s:%s" - key - (file-relative-name file dir)))) +(defun +org-define-basic-link (key dir-var &rest plist) + "Define a link with some basic completion & fontification. + +KEY is the name of the link type. DIR-VAR is the directory variable to resolve +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 -(defun +org-link-read-directory (key dir) - (let ((file (read-directory-name (format "%s: " (capitalize key)) dir))) - (format "%s:%s" - key - (file-relative-name file dir)))) +(defun +org-image-file-data-fn (protocol link _description) + "Intepret LINK as an image file path and return its data." + (when (and (file-exists-p link) + (image-type-from-file-name link)) + (with-temp-buffer + (insert-file-contents-literally link) + (buffer-string)))) ;;;###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." (base64-decode-string link)) ;;;###autoload -(defun +org-image-link (protocol link _description) - "Interpret LINK as base64-encoded image data." +(defun +org-http-image-data-fn (protocol link _description) + "Interpret LINK as an URL to an image file." (when (image-type-from-file-name link) (if-let* ((buf (url-retrieve-synchronously (concat protocol ":" link)))) (with-current-buffer buf diff --git a/modules/lang/org/config.el b/modules/lang/org/config.el index 2a3a2b282..d6e0073e6 100644 --- a/modules/lang/org/config.el +++ b/modules/lang/org/config.el @@ -397,15 +397,15 @@ underlying, modified buffer. This fixes that." '("wolfram" . "https://wolframalpha.com/input/?i=%s") '("doom-repo" . "https://github.com/hlissner/doom-emacs/%s")) - (+org-def-link "org" org-directory) - (+org-def-link "doom" doom-emacs-dir) - (+org-def-link "doom-docs" doom-docs-dir) - (+org-def-link "doom-modules" doom-modules-dir) + (+org-define-basic-link "org" 'org-directory) + (+org-define-basic-link "doom" 'doom-emacs-dir) + (+org-define-basic-link "doom-docs" 'doom-docs-dir) + (+org-define-basic-link "doom-modules" 'doom-modules-dir) ;; 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 "https" :image-data-fun #'+org-image-link) - (org-link-set-parameters "img" :image-data-fun #'+org-inline-data-image) + (org-link-set-parameters "http" :image-data-fun #'+org-http-image-data-fn) + (org-link-set-parameters "https" :image-data-fun #'+org-http-image-data-fn) + (org-link-set-parameters "img" :image-data-fun #'+org-inline-image-data-fn) ;; Add support for youtube links + previews (require 'org-yt nil t)) diff --git a/modules/lang/org/contrib/dragndrop.el b/modules/lang/org/contrib/dragndrop.el index 28f3229dc..bd57a7042 100644 --- a/modules/lang/org/contrib/dragndrop.el +++ b/modules/lang/org/contrib/dragndrop.el @@ -16,12 +16,14 @@ (after! org ;; A shorter link to attachments - (+org-def-link "download" org-attach-id-dir) - (setf (alist-get "download" org-link-abbrev-alist nil nil #'equal) - (abbreviate-file-name org-attach-id-dir))) + (+org-define-basic-link "download" 'org-attach-id-dir + :image-data-fun #'+org-image-file-data-fn + :requires 'org-download)) :config - (setq org-download-image-dir org-attach-id-dir - org-download-link-format "[[download:%s]]\n" + (unless org-download-image-dir + (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-heading-lvl nil org-download-timestamp "_%Y%m%d_%H%M%S"