diff options
Diffstat (limited to 'lisp/org/ox-md.el')
| -rw-r--r-- | lisp/org/ox-md.el | 345 |
1 files changed, 180 insertions, 165 deletions
diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el index 91d5c0ba089..1d20c04f44d 100644 --- a/lisp/org/ox-md.el +++ b/lisp/org/ox-md.el @@ -85,13 +85,17 @@ The %s will be replaced by the footnote reference itself." (if a (org-md-export-to-markdown t s v) (org-open-file (org-md-export-to-markdown nil s v))))))) :translate-alist '((bold . org-md-bold) + (center-block . org-md--convert-to-html) (code . org-md-verbatim) + (drawer . org-md--identity) + (dynamic-block . org-md--identity) (example-block . org-md-example-block) (export-block . org-md-export-block) (fixed-width . org-md-example-block) (headline . org-md-headline) (horizontal-rule . org-md-horizontal-rule) (inline-src-block . org-md-verbatim) + (inlinetask . org-md--convert-to-html) (inner-template . org-md-inner-template) (italic . org-md-italic) (item . org-md-item) @@ -105,7 +109,9 @@ The %s will be replaced by the footnote reference itself." (property-drawer . org-md-property-drawer) (quote-block . org-md-quote-block) (section . org-md-section) + (special-block . org-md--convert-to-html) (src-block . org-md-example-block) + (table . org-md--convert-to-html) (template . org-md-template) (verbatim . org-md-verbatim)) :options-alist @@ -147,6 +153,145 @@ Assume BACKEND is `md'." ;; Return updated tree. tree) + +;;; Internal functions + +(defun org-md--headline-referred-p (headline info) + "Non-nil when HEADLINE is being referred to. +INFO is a plist used as a communication channel. Links and table +of contents can refer to headlines." + (unless (org-element-property :footnote-section-p headline) + (or + ;; Global table of contents includes HEADLINE. + (and (plist-get info :with-toc) + (memq headline + (org-export-collect-headlines info (plist-get info :with-toc)))) + ;; A local table of contents includes HEADLINE. + (cl-some + (lambda (h) + (let ((section (car (org-element-contents h)))) + (and + (eq 'section (org-element-type section)) + (org-element-map section 'keyword + (lambda (keyword) + (when (equal "TOC" (org-element-property :key keyword)) + (let ((case-fold-search t) + (value (org-element-property :value keyword))) + (and (string-match-p "\\<headlines\\>" value) + (let ((n (and + (string-match "\\<[0-9]+\\>" value) + (string-to-number (match-string 0 value)))) + (local? (string-match-p "\\<local\\>" value))) + (memq headline + (org-export-collect-headlines + info n (and local? keyword)))))))) + info t)))) + (org-element-lineage headline)) + ;; A link refers internally to HEADLINE. + (org-element-map (plist-get info :parse-tree) 'link + (lambda (link) + (eq headline + (pcase (org-element-property :type link) + ((or "custom-id" "id") (org-export-resolve-id-link link info)) + ("fuzzy" (org-export-resolve-fuzzy-link link info)) + (_ nil)))) + info t)))) + +(defun org-md--headline-title (style level title &optional anchor tags) + "Generate a headline title in the preferred Markdown headline style. +STYLE is the preferred style (`atx' or `setext'). LEVEL is the +header level. TITLE is the headline title. ANCHOR is the HTML +anchor tag for the section as a string. TAGS are the tags set on +the section." + (let ((anchor-lines (and anchor (concat anchor "\n\n")))) + ;; Use "Setext" style + (if (and (eq style 'setext) (< level 3)) + (let* ((underline-char (if (= level 1) ?= ?-)) + (underline (concat (make-string (length title) underline-char) + "\n"))) + (concat "\n" anchor-lines title tags "\n" underline "\n")) + ;; Use "Atx" style + (let ((level-mark (make-string level ?#))) + (concat "\n" anchor-lines level-mark " " title tags "\n\n"))))) + +(defun org-md--build-toc (info &optional n _keyword scope) + "Return a table of contents. + +INFO is a plist used as a communication channel. + +Optional argument N, when non-nil, is an integer specifying the +depth of the table. + +When optional argument SCOPE is non-nil, build a table of +contents according to the specified element." + (concat + (unless scope + (let ((style (plist-get info :md-headline-style)) + (title (org-html--translate "Table of Contents" info))) + (org-md--headline-title style 1 title nil))) + (mapconcat + (lambda (headline) + (let* ((indentation + (make-string + (* 4 (1- (org-export-get-relative-level headline info))) + ?\s)) + (bullet + (if (not (org-export-numbered-headline-p headline info)) "- " + (let ((prefix + (format "%d." (org-last (org-export-get-headline-number + headline info))))) + (concat prefix (make-string (max 1 (- 4 (length prefix))) + ?\s))))) + (title + (format "[%s](#%s)" + (org-export-data-with-backend + (org-export-get-alt-title headline info) + (org-export-toc-entry-backend 'md) + info) + (or (org-element-property :CUSTOM_ID headline) + (org-export-get-reference headline info)))) + (tags (and (plist-get info :with-tags) + (not (eq 'not-in-toc (plist-get info :with-tags))) + (org-make-tag-string + (org-export-get-tags headline info))))) + (concat indentation bullet title tags))) + (org-export-collect-headlines info n scope) "\n") + "\n")) + +(defun org-md--footnote-formatted (footnote info) + "Formats a single footnote entry FOOTNOTE. +FOOTNOTE is a cons cell of the form (number . definition). +INFO is a plist with contextual information." + (let* ((fn-num (car footnote)) + (fn-text (cdr footnote)) + (fn-format (plist-get info :md-footnote-format)) + (fn-anchor (format "fn.%d" fn-num)) + (fn-href (format " href=\"#fnr.%d\"" fn-num)) + (fn-link-to-ref (org-html--anchor fn-anchor fn-num fn-href info))) + (concat (format fn-format fn-link-to-ref) " " fn-text "\n"))) + +(defun org-md--footnote-section (info) + "Format the footnote section. +INFO is a plist used as a communication channel." + (let* ((fn-alist (org-export-collect-footnote-definitions info)) + (fn-alist (cl-loop for (n _type raw) in fn-alist collect + (cons n (org-trim (org-export-data raw info))))) + (headline-style (plist-get info :md-headline-style)) + (section-title (org-html--translate "Footnotes" info))) + (when fn-alist + (format (plist-get info :md-footnotes-section) + (org-md--headline-title headline-style 1 section-title) + (mapconcat (lambda (fn) (org-md--footnote-formatted fn info)) + fn-alist + "\n"))))) + +(defun org-md--convert-to-html (datum _contents info) + "Convert DATUM into raw HTML, including contents." + (org-export-data-with-backend datum 'html info)) + +(defun org-md--identity (_datum contents _info) + "Return CONTENTS only." + contents) ;;; Transcode Functions @@ -242,65 +387,6 @@ a communication channel." (concat (org-md--headline-title style level heading anchor tags) contents))))))) - -(defun org-md--headline-referred-p (headline info) - "Non-nil when HEADLINE is being referred to. -INFO is a plist used as a communication channel. Links and table -of contents can refer to headlines." - (unless (org-element-property :footnote-section-p headline) - (or - ;; Global table of contents includes HEADLINE. - (and (plist-get info :with-toc) - (memq headline - (org-export-collect-headlines info (plist-get info :with-toc)))) - ;; A local table of contents includes HEADLINE. - (cl-some - (lambda (h) - (let ((section (car (org-element-contents h)))) - (and - (eq 'section (org-element-type section)) - (org-element-map section 'keyword - (lambda (keyword) - (when (equal "TOC" (org-element-property :key keyword)) - (let ((case-fold-search t) - (value (org-element-property :value keyword))) - (and (string-match-p "\\<headlines\\>" value) - (let ((n (and - (string-match "\\<[0-9]+\\>" value) - (string-to-number (match-string 0 value)))) - (local? (string-match-p "\\<local\\>" value))) - (memq headline - (org-export-collect-headlines - info n (and local? keyword)))))))) - info t)))) - (org-element-lineage headline)) - ;; A link refers internally to HEADLINE. - (org-element-map (plist-get info :parse-tree) 'link - (lambda (link) - (eq headline - (pcase (org-element-property :type link) - ((or "custom-id" "id") (org-export-resolve-id-link link info)) - ("fuzzy" (org-export-resolve-fuzzy-link link info)) - (_ nil)))) - info t)))) - -(defun org-md--headline-title (style level title &optional anchor tags) - "Generate a headline title in the preferred Markdown headline style. -STYLE is the preferred style (`atx' or `setext'). LEVEL is the -header level. TITLE is the headline title. ANCHOR is the HTML -anchor tag for the section as a string. TAGS are the tags set on -the section." - (let ((anchor-lines (and anchor (concat anchor "\n\n")))) - ;; Use "Setext" style - (if (and (eq style 'setext) (< level 3)) - (let* ((underline-char (if (= level 1) ?= ?-)) - (underline (concat (make-string (length title) underline-char) - "\n"))) - (concat "\n" anchor-lines title tags "\n" underline "\n")) - ;; Use "Atx" style - (let ((level-mark (make-string level ?#))) - (concat "\n" anchor-lines level-mark " " title tags "\n\n"))))) - ;;;; Horizontal Rule (defun org-md-horizontal-rule (_horizontal-rule _contents _info) @@ -385,20 +471,28 @@ channel." ;;;; Link -(defun org-md-link (link contents info) - "Transcode LINE-BREAK object into Markdown format. -CONTENTS is the link's description. INFO is a plist used as -a communication channel." - (let ((link-org-files-as-md - (lambda (raw-path) - ;; Treat links to `file.org' as links to `file.md'. - (if (string= ".org" (downcase (file-name-extension raw-path "."))) - (concat (file-name-sans-extension raw-path) ".md") - raw-path))) - (type (org-element-property :type link))) +(defun org-md-link (link desc info) + "Transcode LINK object into Markdown format. +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((link-org-files-as-md + (lambda (raw-path) + ;; Treat links to `file.org' as links to `file.md'. + (if (string= ".org" (downcase (file-name-extension raw-path "."))) + (concat (file-name-sans-extension raw-path) ".md") + raw-path))) + (type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + (path (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((string-equal type "file") + (org-export-file-uri (funcall link-org-files-as-md raw-path))) + (t raw-path)))) (cond ;; Link type is handled by a special function. - ((org-export-custom-protocol-maybe link contents 'md)) + ((org-export-custom-protocol-maybe link desc 'md info)) ((member type '("custom-id" "id" "fuzzy")) (let ((destination (if (string= type "fuzzy") (org-export-resolve-fuzzy-link link info) @@ -406,13 +500,13 @@ a communication channel." (pcase (org-element-type destination) (`plain-text ; External file. (let ((path (funcall link-org-files-as-md destination))) - (if (not contents) (format "<%s>" path) - (format "[%s](%s)" contents path)))) + (if (not desc) (format "<%s>" path) + (format "[%s](%s)" desc path)))) (`headline (format "[%s](#%s)" ;; Description. - (cond ((org-string-nw-p contents)) + (cond ((org-string-nw-p desc)) ((org-export-numbered-headline-p destination info) (mapconcat #'number-to-string (org-export-get-headline-number destination info) @@ -424,7 +518,7 @@ a communication channel." (org-export-get-reference destination info)))) (_ (let ((description - (or (org-string-nw-p contents) + (or (org-string-nw-p desc) (let ((number (org-export-get-ordinal destination info))) (cond ((not number) nil) @@ -435,31 +529,23 @@ a communication channel." description (org-export-get-reference destination info)))))))) ((org-export-inline-image-p link org-html-inline-image-rules) - (let ((path (let ((raw-path (org-element-property :path link))) - (cond ((not (equal "file" type)) (concat type ":" raw-path)) - ((not (file-name-absolute-p raw-path)) raw-path) - (t (expand-file-name raw-path))))) + (let ((path (cond ((not (string-equal type "file")) + (concat type ":" raw-path)) + ((not (file-name-absolute-p raw-path)) raw-path) + (t (expand-file-name raw-path)))) (caption (org-export-data (org-export-get-caption - (org-export-get-parent-element link)) info))) + (org-export-get-parent-element link)) + info))) (format "" (if (not (org-string-nw-p caption)) path (format "%s \"%s\"" path caption))))) ((string= type "coderef") - (let ((ref (org-element-property :path link))) - (format (org-export-get-coderef-format ref contents) - (org-export-resolve-coderef ref info)))) - ((equal type "radio") contents) - (t (let* ((raw-path (org-element-property :path link)) - (path - (cond - ((member type '("http" "https" "ftp" "mailto")) - (concat type ":" raw-path)) - ((string= type "file") - (org-export-file-uri (funcall link-org-files-as-md raw-path))) - (t raw-path)))) - (if (not contents) (format "<%s>" path) - (format "[%s](%s)" contents path))))))) + (format (org-export-get-coderef-format path desc) + (org-export-resolve-coderef path info))) + ((equal type "radio") desc) + (t (if (not desc) (format "<%s>" path) + (format "[%s](%s)" desc path)))))) ;;;; Node Property @@ -555,77 +641,6 @@ a communication channel." ;;;; Template -(defun org-md--build-toc (info &optional n _keyword scope) - "Return a table of contents. - -INFO is a plist used as a communication channel. - -Optional argument N, when non-nil, is an integer specifying the -depth of the table. - -When optional argument SCOPE is non-nil, build a table of -contents according to the specified element." - (concat - (unless scope - (let ((style (plist-get info :md-headline-style)) - (title (org-html--translate "Table of Contents" info))) - (org-md--headline-title style 1 title nil))) - (mapconcat - (lambda (headline) - (let* ((indentation - (make-string - (* 4 (1- (org-export-get-relative-level headline info))) - ?\s)) - (bullet - (if (not (org-export-numbered-headline-p headline info)) "- " - (let ((prefix - (format "%d." (org-last (org-export-get-headline-number - headline info))))) - (concat prefix (make-string (max 1 (- 4 (length prefix))) - ?\s))))) - (title - (format "[%s](#%s)" - (org-export-data-with-backend - (org-export-get-alt-title headline info) - (org-export-toc-entry-backend 'md) - info) - (or (org-element-property :CUSTOM_ID headline) - (org-export-get-reference headline info)))) - (tags (and (plist-get info :with-tags) - (not (eq 'not-in-toc (plist-get info :with-tags))) - (org-make-tag-string - (org-export-get-tags headline info))))) - (concat indentation bullet title tags))) - (org-export-collect-headlines info n scope) "\n") - "\n")) - -(defun org-md--footnote-formatted (footnote info) - "Formats a single footnote entry FOOTNOTE. -FOOTNOTE is a cons cell of the form (number . definition). -INFO is a plist with contextual information." - (let* ((fn-num (car footnote)) - (fn-text (cdr footnote)) - (fn-format (plist-get info :md-footnote-format)) - (fn-anchor (format "fn.%d" fn-num)) - (fn-href (format " href=\"#fnr.%d\"" fn-num)) - (fn-link-to-ref (org-html--anchor fn-anchor fn-num fn-href info))) - (concat (format fn-format fn-link-to-ref) " " fn-text "\n"))) - -(defun org-md--footnote-section (info) - "Format the footnote section. -INFO is a plist used as a communication channel." - (let* ((fn-alist (org-export-collect-footnote-definitions info)) - (fn-alist (cl-loop for (n _type raw) in fn-alist collect - (cons n (org-trim (org-export-data raw info))))) - (headline-style (plist-get info :md-headline-style)) - (section-title (org-html--translate "Footnotes" info))) - (when fn-alist - (format (plist-get info :md-footnotes-section) - (org-md--headline-title headline-style 1 section-title) - (mapconcat (lambda (fn) (org-md--footnote-formatted fn info)) - fn-alist - "\n"))))) - (defun org-md-inner-template (contents info) "Return body of document after converting it to Markdown syntax. CONTENTS is the transcoded contents string. INFO is a plist |