Fix html link transcoder

This commit is contained in:
louie 2018-05-22 21:09:36 +08:00
parent fbf45e6df8
commit 4ac43c52d0

View file

@ -64,6 +64,7 @@
(require 'json) (require 'json)
(require 'org-element) (require 'org-element)
(require 'ox) (require 'ox)
(require 'ox-html)
(require 'request) (require 'request)
(defconst anki-editor-prop-note-type "ANKI_NOTE_TYPE") (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 () (defun anki-editor-setup-minor-mode ()
"Set up this minor mode." "Set up this minor mode."
(add-hook 'org-property-allowed-value-functions #'anki-editor--get-allowed-values-for-property) (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 () (defun anki-editor-teardown-minor-mode ()
"Tear down this minor mode." "Tear down this minor mode."
(remove-hook 'org-property-allowed-value-functions #'anki-editor--get-allowed-values-for-property) (remove-hook 'org-property-allowed-value-functions #'anki-editor--get-allowed-values-for-property)
(advice-remove 'org-set-tags #'anki-editor--before-set-tags) (advice-remove 'org-set-tags #'anki-editor--before-set-tags)
(when (advice-member-p 'anki-editor--get-buffer-tags #'org-get-buffer-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 ;;; Commands
@ -527,8 +530,7 @@ Do nothing when JUST-ALIGN is non-nil."
(org-export-create-backend (org-export-create-backend
:parent 'html :parent 'html
:transcoders '((latex-fragment . anki-editor--ox-latex) :transcoders '((latex-fragment . anki-editor--ox-latex)
(latex-environment . anki-editor--ox-latex) (latex-environment . anki-editor--ox-latex))))
(link . anki-editor--ox-link))))
(defconst anki-editor--anki-latex-syntax-map (defconst anki-editor--anki-latex-syntax-map
`((,(format "^%s" (regexp-quote "$$")) . "[$$]") `((,(format "^%s" (regexp-quote "$$")) . "[$$]")
@ -564,38 +566,29 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(replace-regexp-in-string "}}" "} } " code) (replace-regexp-in-string "}}" "} } " code)
code))) code)))
;; FIXME: since some functions get added and some get removed in (defun anki-editor--ox-html-link (oldfun link desc info)
;; differenct versions of Org, this is going to break "When LINK is a link to local file, transcodes it to html and stores the target file to Anki, otherwise calls OLDFUN for help.
(defun anki-editor--ox-link (link desc info) The implementation is borrowed and simplified from ox-html."
"Transcode a LINK object from Org to HTML. (or (catch 'giveup
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)) (let* ((type (org-element-property :type link))
(raw-path (org-element-property :path link)) (raw-path (org-element-property :path link))
;; Ensure DESC really exists, or set it to nil.
(desc (org-string-nw-p desc)) (desc (org-string-nw-p desc))
(path (path
(cond (cond
((member type '("http" "https" "ftp" "mailto" "news"))
(url-encode-url (org-link-unescape (concat type ":" raw-path))))
((string= type "file") ((string= type "file")
;; Possibly append `:html-link-home' to relative file ;; Possibly append `:html-link-home' to relative file
;; name. ;; name.
(let ((home (and (plist-get info :html-link-home) (let ((inhibit-message nil)
(home (and (plist-get info :html-link-home)
(org-trim (plist-get info :html-link-home))))) (org-trim (plist-get info :html-link-home)))))
(when (and home (when (and home
(plist-get info :html-link-use-abs-url) (plist-get info :html-link-use-abs-url)
(file-name-absolute-p raw-path)) (file-name-absolute-p raw-path))
(setq raw-path (concat (file-name-as-directory home) raw-path))) (setq raw-path (concat (file-name-as-directory home) raw-path)))
(message "Storing media file to Anki for %s..." 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))))) (anki-editor--anki-connect-store-media-file (expand-file-name (url-unhex-string raw-path)))))
(t raw-path))) (t (throw 'giveup nil))))
;; 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 (attributes-plist
(let* ((parent (org-export-get-parent-element link)) (let* ((parent (org-export-get-parent-element link))
(link (let ((container (org-export-get-parent link))) (link (let ((container (org-export-get-parent link)))
@ -614,95 +607,22 @@ ox-html.el :)"
(org-export-inline-image-p (org-export-inline-image-p
link (plist-get info :html-inline-image-rules))) link (plist-get info :html-inline-image-rules)))
(org-html--format-image path attributes-plist info)) (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 "<a href=\"#%s\"%s>%s</a>"
(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 "<a href=\"%s#%s\"%s>%s</a>"
destination fragment attributes (or desc destination))))
;; Fuzzy link points nowhere.
(`nil
(format "<i>%s</i>"
(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 "<a href=\"#%s\"%s>%s</a>" 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 "<a href=\"#%s\"%s>%s</a>" 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 "<a href=\"#%s\" %s%s>%s</a>"
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. ;; External link with a description part.
((and path desc) (format "<a href=\"%s\"%s>%s</a>" ((and path desc) (format "<a href=\"%s\"%s>%s</a>"
(org-html-encode-plain-text path) (org-html-encode-plain-text path)
attributes attributes
desc)) desc))
;; External link without a description part. ;; External link without a description part.
(path (let ((path (org-html-encode-plain-text path))) (path (let ((path (org-html-encode-plain-text path)))
(format "<a href=\"%s\"%s>%s</a>" (format "<a href=\"%s\"%s>%s</a>"
path path
attributes attributes
(org-link-unescape path)))) (org-link-unescape path))))
;; No path, only description. Try to do something useful.
(t (format "<i>%s</i>" desc))))) (t (throw 'giveup nil)))))
(funcall oldfun link desc info)))
;;; Utilities ;;; Utilities