diff options
Diffstat (limited to 'lisp/org/ox-md.el')
| -rw-r--r-- | lisp/org/ox-md.el | 364 |
1 files changed, 248 insertions, 116 deletions
diff --git a/lisp/org/ox-md.el b/lisp/org/ox-md.el index ab73f29dfa9..c8ea1fa045e 100644 --- a/lisp/org/ox-md.el +++ b/lisp/org/ox-md.el @@ -1,4 +1,4 @@ -;;; ox-md.el --- Markdown Back-End for Org Export Engine +;;; ox-md.el --- Markdown Back-End for Org Export Engine -*- lexical-binding: t; -*- ;; Copyright (C) 2012-2017 Free Software Foundation, Inc. @@ -28,9 +28,9 @@ ;;; Code: -(eval-when-compile (require 'cl)) +(require 'cl-lib) (require 'ox-html) - +(require 'ox-publish) ;;; User-Configurable Variables @@ -51,11 +51,29 @@ This variable can be set to either `atx' or `setext'." (const :tag "Use \"Setext\" style" setext))) +;;;; Footnotes + +(defcustom org-md-footnotes-section "%s%s" + "Format string for the footnotes section. +The first %s placeholder will be replaced with the localized Footnotes section +heading, the second with the contents of the Footnotes section." + :group 'org-export-md + :type 'string + :version "26.1" + :package-version '(Org . "9.0")) + +(defcustom org-md-footnote-format "<sup>%s</sup>" + "Format string for the footnote reference. +The %s will be replaced by the footnote reference itself." + :group 'org-export-md + :type 'string + :version "26.1" + :package-version '(Org . "9.0")) + ;;; Define Back-End (org-export-define-derived-backend 'md 'html - :export-block '("MD" "MARKDOWN") :filters-alist '((:filter-parse-tree . org-md-separate-elements)) :menu-entry '(?m "Export to Markdown" @@ -68,62 +86,64 @@ This variable can be set to either `atx' or `setext'." (org-open-file (org-md-export-to-markdown nil s v))))))) :translate-alist '((bold . org-md-bold) (code . org-md-verbatim) - (comment . (lambda (&rest args) "")) - (comment-block . (lambda (&rest args) "")) (example-block . org-md-example-block) + (export-block . org-md-export-block) (fixed-width . org-md-example-block) - (footnote-definition . ignore) - (footnote-reference . ignore) (headline . org-md-headline) (horizontal-rule . org-md-horizontal-rule) (inline-src-block . org-md-verbatim) (inner-template . org-md-inner-template) (italic . org-md-italic) (item . org-md-item) + (keyword . org-md-keyword) (line-break . org-md-line-break) (link . org-md-link) + (node-property . org-md-node-property) (paragraph . org-md-paragraph) (plain-list . org-md-plain-list) (plain-text . org-md-plain-text) + (property-drawer . org-md-property-drawer) (quote-block . org-md-quote-block) - (quote-section . org-md-example-block) (section . org-md-section) (src-block . org-md-example-block) (template . org-md-template) - (verbatim . org-md-verbatim))) - + (verbatim . org-md-verbatim)) + :options-alist + '((:md-footnote-format nil nil org-md-footnote-format) + (:md-footnotes-section nil nil org-md-footnotes-section) + (:md-headline-style nil nil org-md-headline-style))) ;;; Filters -(defun org-md-separate-elements (tree backend info) +(defun org-md-separate-elements (tree _backend info) "Fix blank lines between elements. TREE is the parse tree being exported. BACKEND is the export back-end used. INFO is a plist used as a communication channel. -Enforce a blank line between elements. There are three -exceptions to this rule: +Enforce a blank line between elements. There are two exceptions +to this rule: 1. Preserve blank lines between sibling items in a plain list, - 2. Outside of plain lists, preserve blank lines between - a paragraph and a plain list, - - 3. In an item, remove any blank line before the very first - paragraph and the next sub-list. + 2. In an item, remove any blank line before the very first + paragraph and the next sub-list when the latter ends the + current item. Assume BACKEND is `md'." (org-element-map tree (remq 'item org-element-all-elements) (lambda (e) - (cond - ((not (and (eq (org-element-type e) 'paragraph) - (eq (org-element-type (org-export-get-next-element e info)) - 'plain-list))) - (org-element-put-property e :post-blank 1)) - ((not (eq (org-element-type (org-element-property :parent e)) 'item))) - (t (org-element-put-property - e :post-blank (if (org-export-get-previous-element e info) 1 0)))))) + (org-element-put-property + e :post-blank + (if (and (eq (org-element-type e) 'paragraph) + (eq (org-element-type (org-element-property :parent e)) 'item) + (org-export-first-sibling-p e info) + (let ((next (org-export-get-next-element e info))) + (and (eq (org-element-type next) 'plain-list) + (not (org-export-get-next-element next info))))) + 0 + 1)))) ;; Return updated tree. tree) @@ -133,7 +153,7 @@ Assume BACKEND is `md'." ;;;; Bold -(defun org-md-bold (bold contents info) +(defun org-md-bold (_bold contents _info) "Transcode BOLD object into Markdown format. CONTENTS is the text within bold markup. INFO is a plist used as a communication channel." @@ -142,22 +162,22 @@ a communication channel." ;;;; Code and Verbatim -(defun org-md-verbatim (verbatim contents info) +(defun org-md-verbatim (verbatim _contents _info) "Transcode VERBATIM object into Markdown format. CONTENTS is nil. INFO is a plist used as a communication channel." (let ((value (org-element-property :value verbatim))) (format (cond ((not (string-match "`" value)) "`%s`") - ((or (string-match "\\``" value) - (string-match "`\\'" value)) + ((or (string-prefix-p "`" value) + (string-suffix-p "`" value)) "`` %s ``") (t "``%s``")) value))) -;;;; Example Block and Src Block +;;;; Example Block, Src Block and export Block -(defun org-md-example-block (example-block contents info) +(defun org-md-example-block (example-block _contents info) "Transcode EXAMPLE-BLOCK element into Markdown format. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -166,6 +186,14 @@ channel." (org-remove-indentation (org-export-format-code-default example-block info)))) +(defun org-md-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to Markdown. +CONTENTS is nil. INFO is a plist holding contextual information." + (if (member (org-element-property :type export-block) '("MARKDOWN" "MD")) + (org-remove-indentation (org-element-property :value export-block)) + ;; Also include HTML export blocks. + (org-export-with-backend 'html export-block contents info))) + ;;;; Headline @@ -189,45 +217,67 @@ a communication channel." (and (plist-get info :with-priority) (let ((char (org-element-property :priority headline))) (and char (format "[#%c] " char))))) - (anchor - (when (plist-get info :with-toc) - (org-html--anchor - (or (org-element-property :CUSTOM_ID headline) - (concat "sec-" - (mapconcat 'number-to-string - (org-export-get-headline-number - headline info) "-")))))) ;; Headline text without tags. - (heading (concat todo priority title))) + (heading (concat todo priority title)) + (style (plist-get info :md-headline-style))) (cond ;; Cannot create a headline. Fall-back to a list. ((or (org-export-low-level-p headline info) - (not (memq org-md-headline-style '(atx setext))) - (and (eq org-md-headline-style 'atx) (> level 6)) - (and (eq org-md-headline-style 'setext) (> level 2))) + (not (memq style '(atx setext))) + (and (eq style 'atx) (> level 6)) + (and (eq style 'setext) (> level 2))) (let ((bullet (if (not (org-export-numbered-headline-p headline info)) "-" (concat (number-to-string (car (last (org-export-get-headline-number headline info)))) ".")))) - (concat bullet (make-string (- 4 (length bullet)) ? ) heading tags - "\n\n" - (and contents - (replace-regexp-in-string "^" " " contents))))) - ;; Use "Setext" style. - ((eq org-md-headline-style 'setext) - (concat heading tags anchor "\n" - (make-string (length heading) (if (= level 1) ?= ?-)) - "\n\n" - contents)) - ;; Use "atx" style. - (t (concat (make-string level ?#) " " heading tags anchor "\n\n" contents)))))) - + (concat bullet (make-string (- 4 (length bullet)) ?\s) heading tags "\n\n" + (and contents (replace-regexp-in-string "^" " " contents))))) + (t + (let ((anchor + (and (org-md--headline-referred-p headline info) + (format "<a id=\"%s\"></a>" + (or (org-element-property :CUSTOM_ID headline) + (org-export-get-reference headline info)))))) + (concat (org-md--headline-title style level title 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." + (or (plist-get info :with-toc) + (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) +(defun org-md-horizontal-rule (_horizontal-rule _contents _info) "Transcode HORIZONTAL-RULE element into Markdown format. CONTENTS is the horizontal rule contents. INFO is a plist used as a communication channel." @@ -236,7 +286,7 @@ as a communication channel." ;;;; Italic -(defun org-md-italic (italic contents info) +(defun org-md-italic (_italic contents _info) "Transcode ITALIC object into Markdown format. CONTENTS is the text within italic markup. INFO is a plist used as a communication channel." @@ -261,19 +311,31 @@ a communication channel." ".")))) (concat bullet (make-string (- 4 (length bullet)) ? ) - (case (org-element-property :checkbox item) - (on "[X] ") - (trans "[-] ") - (off "[ ] ")) + (pcase (org-element-property :checkbox item) + (`on "[X] ") + (`trans "[-] ") + (`off "[ ] ")) (let ((tag (org-element-property :tag item))) (and tag (format "**%s:** "(org-export-data tag info)))) (and contents (org-trim (replace-regexp-in-string "^" " " contents)))))) + +;;;; Keyword + +(defun org-md-keyword (keyword contents info) + "Transcode a KEYWORD element into Markdown format. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (if (member (org-element-property :key keyword) '("MARKDOWN" "MD")) + (org-element-property :value keyword) + (org-export-with-backend 'html keyword contents info))) + + ;;;; Line Break -(defun org-md-line-break (line-break contents info) +(defun org-md-line-break (_line-break _contents _info) "Transcode LINE-BREAK object into Markdown format. CONTENTS is nil. INFO is a plist used as a communication channel." @@ -287,28 +349,50 @@ channel." CONTENTS is the link's description. INFO is a plist used as a communication channel." (let ((link-org-files-as-md - (function - (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)))) + (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))) (cond - ((member type '("custom-id" "id")) - (let ((destination (org-export-resolve-id-link link info))) - (if (stringp destination) ; External file. - (let ((path (funcall link-org-files-as-md destination))) - (if (not contents) (format "<%s>" path) - (format "[%s](%s)" contents path))) - (concat - (and contents (concat contents " ")) - (format "(%s)" - (format (org-export-translate "See section %s" :html info) - (mapconcat 'number-to-string - (org-export-get-headline-number - destination info) - "."))))))) + ;; Link type is handled by a special function. + ((org-export-custom-protocol-maybe link contents 'md)) + ((member type '("custom-id" "id" "fuzzy")) + (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) + (`plain-text ; External file. + (let ((path (funcall link-org-files-as-md destination))) + (if (not contents) (format "<%s>" path) + (format "[%s](%s)" contents path)))) + (`headline + (format + "[%s](#%s)" + ;; Description. + (cond ((org-string-nw-p contents)) + ((org-export-numbered-headline-p destination info) + (mapconcat #'number-to-string + (org-export-get-headline-number destination info) + ".")) + (t (org-export-data (org-element-property :title destination) + info))) + ;; Reference. + (or (org-element-property :CUSTOM_ID destination) + (org-export-get-reference destination info)))) + (_ + (let ((description + (or (org-string-nw-p contents) + (let ((number (org-export-get-ordinal destination info))) + (cond + ((not number) nil) + ((atom number) (number-to-string number)) + (t (mapconcat #'number-to-string number "."))))))) + (when description + (format "[%s](#%s)" + 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))) (if (not (file-name-absolute-p raw-path)) raw-path @@ -324,53 +408,46 @@ a communication channel." (format (org-export-get-coderef-format ref contents) (org-export-resolve-coderef ref info)))) ((equal type "radio") contents) - ((equal type "fuzzy") - (let ((destination (org-export-resolve-fuzzy-link link info))) - (if (org-string-nw-p contents) contents - (when destination - (let ((number (org-export-get-ordinal destination info))) - (when number - (if (atom number) (number-to-string number) - (mapconcat 'number-to-string number ".")))))))) - ;; Link type is handled by a special function. - ((let ((protocol (nth 2 (assoc type org-link-protocols)))) - (and (functionp protocol) - (funcall protocol - (org-link-unescape (org-element-property :path link)) - contents - 'md)))) (t (let* ((raw-path (org-element-property :path link)) (path (cond ((member type '("http" "https" "ftp")) (concat type ":" raw-path)) ((string= type "file") - (let ((path (funcall link-org-files-as-md raw-path))) - (if (not (file-name-absolute-p path)) path - ;; If file path is absolute, prepend it - ;; with "file:" component. - (concat "file:" path)))) + (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))))))) +;;;; Node Property + +(defun org-md-node-property (node-property _contents _info) + "Transcode a NODE-PROPERTY element into Markdown syntax. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "%s:%s" + (org-element-property :key node-property) + (let ((value (org-element-property :value node-property))) + (if value (concat " " value) "")))) + + ;;;; Paragraph -(defun org-md-paragraph (paragraph contents info) +(defun org-md-paragraph (paragraph contents _info) "Transcode PARAGRAPH element into Markdown format. CONTENTS is the paragraph contents. INFO is a plist used as a communication channel." (let ((first-object (car (org-element-contents paragraph)))) ;; If paragraph starts with a #, protect it. - (if (and (stringp first-object) (string-match "\\`#" first-object)) - (replace-regexp-in-string "\\`#" "\\#" contents nil t) + (if (and (stringp first-object) (string-prefix-p "#" first-object)) + (concat "\\" contents) contents))) ;;;; Plain List -(defun org-md-plain-list (plain-list contents info) +(defun org-md-plain-list (_plain-list contents _info) "Transcode PLAIN-LIST element into Markdown format. CONTENTS is the plain-list contents. INFO is a plist used as a communication channel." @@ -403,9 +480,19 @@ contextual information." text) +;;;; Property Drawer + +(defun org-md-property-drawer (_property-drawer contents _info) + "Transcode a PROPERTY-DRAWER element into Markdown format. +CONTENTS holds the contents of the drawer. INFO is a plist +holding contextual information." + (and (org-string-nw-p contents) + (replace-regexp-in-string "^" " " contents))) + + ;;;; Quote Block -(defun org-md-quote-block (quote-block contents info) +(defun org-md-quote-block (_quote-block contents _info) "Transcode QUOTE-BLOCK element into Markdown format. CONTENTS is the quote-block contents. INFO is a plist used as a communication channel." @@ -416,7 +503,7 @@ a communication channel." ;;;; Section -(defun org-md-section (section contents info) +(defun org-md-section (_section contents _info) "Transcode SECTION element into Markdown format. CONTENTS is the section contents. INFO is a plist used as a communication channel." @@ -425,15 +512,50 @@ a communication channel." ;;;; Template +(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 holding export options." ;; Make sure CONTENTS is separated from table of contents and ;; footnotes with at least a blank line. - (org-trim (org-html-inner-template (concat "\n" contents "\n") info))) - -(defun org-md-template (contents info) + (concat + ;; Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth (org-html-toc depth info))) + ;; Document contents. + contents + "\n" + ;; Footnotes section. + (org-md--footnote-section info))) + +(defun org-md-template (contents _info) "Return complete document string after Markdown conversion. CONTENTS is the transcoded contents string. INFO is a plist used as a communication channel." @@ -472,9 +594,9 @@ non-nil." ;;;###autoload (defun org-md-convert-region-to-md () - "Assume the current region has org-mode syntax, and convert it to Markdown. + "Assume the current region has Org syntax, and convert it to Markdown. This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in a Markdown buffer and use +itemized list in Org syntax in a Markdown buffer and use this command to convert it." (interactive) (org-export-replace-region-by 'md)) @@ -505,6 +627,16 @@ Return output file's name." (let ((outfile (org-export-output-file-name ".md" subtreep))) (org-export-to-file 'md outfile async subtreep visible-only))) +;;;###autoload +(defun org-md-publish-to-md (plist filename pub-dir) + "Publish an org file to Markdown. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'md filename ".md" plist pub-dir)) (provide 'ox-md) |