From 4ac43c52d01a018b258b02e049e24458173e24c5 Mon Sep 17 00:00:00 2001 From: louie Date: Tue, 22 May 2018 21:09:36 +0800 Subject: [PATCH] Fix html link transcoder --- anki-editor.el | 204 +++++++++++++++---------------------------------- 1 file changed, 62 insertions(+), 142 deletions(-) diff --git a/anki-editor.el b/anki-editor.el index 608d2ba..97837c4 100644 --- a/anki-editor.el +++ b/anki-editor.el @@ -64,6 +64,7 @@ (require 'json) (require 'org-element) (require 'ox) +(require 'ox-html) (require 'request) (defconst anki-editor-prop-note-type "ANKI_NOTE_TYPE") @@ -196,14 +197,16 @@ The result is the path to the newly stored media file." (defun anki-editor-setup-minor-mode () "Set up this minor mode." (add-hook 'org-property-allowed-value-functions #'anki-editor--get-allowed-values-for-property) - (advice-add 'org-set-tags :before #'anki-editor--before-set-tags)) + (advice-add 'org-set-tags :before #'anki-editor--before-set-tags) + (advice-add 'org-html-link :around #'anki-editor--ox-html-link)) (defun anki-editor-teardown-minor-mode () "Tear down this minor mode." (remove-hook 'org-property-allowed-value-functions #'anki-editor--get-allowed-values-for-property) (advice-remove 'org-set-tags #'anki-editor--before-set-tags) (when (advice-member-p 'anki-editor--get-buffer-tags #'org-get-buffer-tags) - (advice-remove 'org-get-buffer-tags #'anki-editor--get-buffer-tags))) + (advice-remove 'org-get-buffer-tags #'anki-editor--get-buffer-tags)) + (advice-remove 'org-html-link #'anki-editor--ox-html-link)) ;;; Commands @@ -527,8 +530,7 @@ Do nothing when JUST-ALIGN is non-nil." (org-export-create-backend :parent 'html :transcoders '((latex-fragment . anki-editor--ox-latex) - (latex-environment . anki-editor--ox-latex) - (link . anki-editor--ox-link)))) + (latex-environment . anki-editor--ox-latex)))) (defconst anki-editor--anki-latex-syntax-map `((,(format "^%s" (regexp-quote "$$")) . "[$$]") @@ -564,145 +566,63 @@ CONTENTS is nil. INFO is a plist holding contextual information." (replace-regexp-in-string "}}" "} } " code) code))) -;; FIXME: since some functions get added and some get removed in -;; differenct versions of Org, this is going to break -(defun anki-editor--ox-link (link desc info) - "Transcode a LINK object from Org to HTML. -DESC is the description part of the link, or the empty string. -INFO is a plist holding contextual information. THE -IMPLEMENTATION IS BASICALLY COPIED AND SIMPLIFIED FROM -ox-html.el :)" - (let* ((type (org-element-property :type link)) - (raw-path (org-element-property :path link)) - ;; Ensure DESC really exists, or set it to nil. - (desc (org-string-nw-p desc)) - (path +(defun anki-editor--ox-html-link (oldfun link desc info) + "When LINK is a link to local file, transcodes it to html and stores the target file to Anki, otherwise calls OLDFUN for help. +The implementation is borrowed and simplified from ox-html." + (or (catch 'giveup + (let* ((type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + (desc (org-string-nw-p desc)) + (path + (cond + ((string= type "file") + ;; Possibly append `:html-link-home' to relative file + ;; name. + (let ((inhibit-message nil) + (home (and (plist-get info :html-link-home) + (org-trim (plist-get info :html-link-home))))) + (when (and home + (plist-get info :html-link-use-abs-url) + (file-name-absolute-p raw-path)) + (setq raw-path (concat (file-name-as-directory home) raw-path))) + (message "Storing media file to Anki for %s..." raw-path) + ;; storing file to Anki and return the modified path + (anki-editor--anki-connect-store-media-file (expand-file-name (url-unhex-string raw-path))))) + (t (throw 'giveup nil)))) + (attributes-plist + (let* ((parent (org-export-get-parent-element link)) + (link (let ((container (org-export-get-parent link))) + (if (and (eq (org-element-type container) 'link) + (org-html-inline-image-p link info)) + container + link)))) + (and (eq (org-element-map parent 'link 'identity info t) link) + (org-export-read-attribute :attr_html parent)))) + (attributes + (let ((attr (org-html--make-attribute-string attributes-plist))) + (if (org-string-nw-p attr) (concat " " attr) "")))) (cond - ((member type '("http" "https" "ftp" "mailto" "news")) - (url-encode-url (org-link-unescape (concat type ":" raw-path)))) - ((string= type "file") - ;; Possibly append `:html-link-home' to relative file - ;; name. - (let ((home (and (plist-get info :html-link-home) - (org-trim (plist-get info :html-link-home))))) - (when (and home - (plist-get info :html-link-use-abs-url) - (file-name-absolute-p raw-path)) - (setq raw-path (concat (file-name-as-directory home) raw-path))) - (message "Storing media file to Anki for %s..." raw-path) - (anki-editor--anki-connect-store-media-file (expand-file-name (url-unhex-string raw-path))))) - (t raw-path))) - ;; Extract attributes from parent's paragraph. HACK: Only do - ;; this for the first link in parent (inner image link for - ;; inline images). This is needed as long as attributes - ;; cannot be set on a per link basis. - (attributes-plist - (let* ((parent (org-export-get-parent-element link)) - (link (let ((container (org-export-get-parent link))) - (if (and (eq (org-element-type container) 'link) - (org-html-inline-image-p link info)) - container - link)))) - (and (eq (org-element-map parent 'link 'identity info t) link) - (org-export-read-attribute :attr_html parent)))) - (attributes - (let ((attr (org-html--make-attribute-string attributes-plist))) - (if (org-string-nw-p attr) (concat " " attr) "")))) - (cond - ;; Image file. - ((and (plist-get info :html-inline-images) - (org-export-inline-image-p - link (plist-get info :html-inline-image-rules))) - (org-html--format-image path attributes-plist info)) - ;; Radio target: Transcode target's contents and use them as - ;; link's description. - ((string= type "radio") - (let ((destination (org-export-resolve-radio-link link info))) - (if (not destination) desc - (format "%s" - (org-export-get-reference destination info) - attributes - desc)))) - ;; Links pointing to a headline: Find destination and build - ;; appropriate referencing command. - ((member type '("custom-id" "fuzzy" "id")) - (let ((destination (if (string= type "fuzzy") - (org-export-resolve-fuzzy-link link info) - (org-export-resolve-id-link link info)))) - (pcase (org-element-type destination) - ;; ID link points to an external file. - (`plain-text - (let ((fragment (concat "ID-" path))) - (format "%s" - destination fragment attributes (or desc destination)))) - ;; Fuzzy link points nowhere. - (`nil - (format "%s" - (or desc - (org-export-data - (org-element-property :raw-link link) info)))) - ;; Link points to a headline. - (`headline - (let ((href (or (org-element-property :CUSTOM_ID destination) - (org-export-get-reference destination info))) - ;; What description to use? - (desc - ;; Case 1: Headline is numbered and LINK has no - ;; description. Display section number. - (if (and (org-export-numbered-headline-p destination info) - (not desc)) - (mapconcat #'number-to-string - (org-export-get-headline-number - destination info) ".") - ;; Case 2: Either the headline is un-numbered or - ;; LINK has a custom description. Display LINK's - ;; description or headline's title. - (or desc - (org-export-data - (org-element-property :title destination) info))))) - (format "%s" href attributes desc))) - ;; Fuzzy link points to a target or an element. - (_ - (let* ((ref (org-export-get-reference destination info)) - (number (cond - (desc nil) - ((org-html-standalone-image-p destination info) - (org-export-get-ordinal - (org-element-map destination 'link - #'identity info t) - info 'link 'org-html-standalone-image-p)) - (t (org-export-get-ordinal - destination info nil 'org-html--has-caption-p)))) - (desc (cond (desc) - ((not number) "No description for this link") - ((numberp number) (number-to-string number)) - (t (mapconcat #'number-to-string number "."))))) - (format "%s" ref attributes desc)))))) - ;; Coderef: replace link with the reference name or the - ;; equivalent line number. - ((string= type "coderef") - (let ((fragment (concat "coderef-" (org-html-encode-plain-text path)))) - (format "%s" - fragment - (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, \ -'%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" - fragment fragment) - attributes - (format (org-export-get-coderef-format path desc) - (org-export-resolve-coderef path info))))) - ;; External link with a description part. - ((and path desc) (format "%s" - (org-html-encode-plain-text path) - attributes - desc)) - ;; External link without a description part. - (path (let ((path (org-html-encode-plain-text path))) - (format "%s" - path - attributes - (org-link-unescape path)))) - ;; No path, only description. Try to do something useful. - (t (format "%s" desc))))) + ;; Image file. + ((and (plist-get info :html-inline-images) + (org-export-inline-image-p + link (plist-get info :html-inline-image-rules))) + (org-html--format-image path attributes-plist info)) + + ;; External link with a description part. + ((and path desc) (format "%s" + (org-html-encode-plain-text path) + attributes + desc)) + + ;; External link without a description part. + (path (let ((path (org-html-encode-plain-text path))) + (format "%s" + path + attributes + (org-link-unescape path)))) + + (t (throw 'giveup nil))))) + (funcall oldfun link desc info))) ;;; Utilities