summaryrefslogtreecommitdiff
path: root/lisp/ox-md.el
diff options
context:
space:
mode:
authorSebastien Delafond <seb@debian.org>2013-08-11 16:27:56 +0200
committerS├ębastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:27 +0200
commit53b246b7d66bfa03ab9bcf47d4647913b401e3d6 (patch)
treeb5ea4e732c2219456d13048feb05b37b22a76391 /lisp/ox-md.el
parent8606e2621fc00fd8b334a06924aeef3aab7a2e4d (diff)
parente32a45ed36d6000db4b39171149072d11b77af72 (diff)
Imported Debian patch 8.0.7-1
Diffstat (limited to 'lisp/ox-md.el')
-rw-r--r--lisp/ox-md.el504
1 files changed, 504 insertions, 0 deletions
diff --git a/lisp/ox-md.el b/lisp/ox-md.el
new file mode 100644
index 0000000..52ed42b
--- /dev/null
+++ b/lisp/ox-md.el
@@ -0,0 +1,504 @@
+;;; ox-md.el --- Markdown Back-End for Org Export Engine
+
+;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+
+;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
+;; Keywords: org, wp, markdown
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library implements a Markdown back-end (vanilla flavour) for
+;; Org exporter, based on `html' back-end.
+;;
+;; It provides two commands for export, depending on the desired
+;; output: `org-md-export-as-markdown' (temporary buffer) and
+;; `org-md-export-to-markdown' ("md" file).
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+(require 'ox-html)
+
+
+
+;;; User-Configurable Variables
+
+(defgroup org-export-md nil
+ "Options specific to Markdown export back-end."
+ :tag "Org Markdown"
+ :group 'org-export
+ :version "24.4"
+ :package-version '(Org . "8.0"))
+
+(defcustom org-md-headline-style 'atx
+ "Style used to format headlines.
+This variable can be set to either `atx' or `setext'."
+ :group 'org-export-md
+ :type '(choice
+ (const :tag "Use \"atx\" style" atx)
+ (const :tag "Use \"Setext\" style" setext)))
+
+
+
+;;; 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"
+ ((?M "To temporary buffer"
+ (lambda (a s v b) (org-md-export-as-markdown a s v)))
+ (?m "To file" (lambda (a s v b) (org-md-export-to-markdown a s v)))
+ (?o "To file and open"
+ (lambda (a s v b)
+ (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)
+ (code . org-md-verbatim)
+ (comment . (lambda (&rest args) ""))
+ (comment-block . (lambda (&rest args) ""))
+ (example-block . org-md-example-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)
+ (italic . org-md-italic)
+ (item . org-md-item)
+ (line-break . org-md-line-break)
+ (link . org-md-link)
+ (paragraph . org-md-paragraph)
+ (plain-list . org-md-plain-list)
+ (plain-text . org-md-plain-text)
+ (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)))
+
+
+
+;;; Filters
+
+(defun org-md-separate-elements (tree backend info)
+ "Make sure elements are separated by at least one blank line.
+
+TREE is the parse tree being exported. BACKEND is the export
+back-end used. INFO is a plist used as a communication channel.
+
+Assume BACKEND is `md'."
+ (org-element-map tree org-element-all-elements
+ (lambda (elem)
+ (unless (eq (org-element-type elem) 'org-data)
+ (org-element-put-property
+ elem :post-blank
+ (let ((post-blank (org-element-property :post-blank elem)))
+ (if (not post-blank) 1 (max 1 post-blank)))))))
+ ;; Return updated tree.
+ tree)
+
+
+
+;;; Transcode Functions
+
+;;;; Bold
+
+(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."
+ (format "**%s**" contents))
+
+
+;;;; Code and Verbatim
+
+(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))
+ "`` %s ``")
+ (t "``%s``"))
+ value)))
+
+
+;;;; Example Block and Src Block
+
+(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."
+ (replace-regexp-in-string
+ "^" " "
+ (org-remove-indentation
+ (org-element-property :value example-block))))
+
+
+;;;; Headline
+
+(defun org-md-headline (headline contents info)
+ "Transcode HEADLINE element into Markdown format.
+CONTENTS is the headline contents. INFO is a plist used as
+a communication channel."
+ (unless (org-element-property :footnote-section-p headline)
+ (let* ((level (org-export-get-relative-level headline info))
+ (title (org-export-data (org-element-property :title headline) info))
+ (todo (and (plist-get info :with-todo-keywords)
+ (let ((todo (org-element-property :todo-keyword
+ headline)))
+ (and todo (concat (org-export-data todo info) " ")))))
+ (tags (and (plist-get info :with-tags)
+ (let ((tag-list (org-export-get-tags headline info)))
+ (and tag-list
+ (format " :%s:"
+ (mapconcat 'identity tag-list ":"))))))
+ (priority
+ (and (plist-get info :with-priority)
+ (let ((char (org-element-property :priority headline)))
+ (and char (format "[#%c] " char)))))
+ ;; Headline text without tags.
+ (heading (concat todo priority title)))
+ (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)))
+ (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 "\n"
+ (make-string (length heading) (if (= level 1) ?= ?-))
+ "\n\n"
+ contents))
+ ;; Use "atx" style.
+ (t (concat (make-string level ?#) " " heading tags "\n\n" contents))))))
+
+
+;;;; Horizontal Rule
+
+(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."
+ "---")
+
+
+;;;; Italic
+
+(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."
+ (format "*%s*" contents))
+
+
+;;;; Item
+
+(defun org-md-item (item contents info)
+ "Transcode ITEM element into Markdown format.
+CONTENTS is the item contents. INFO is a plist used as
+a communication channel."
+ (let* ((type (org-element-property :type (org-export-get-parent item)))
+ (struct (org-element-property :structure item))
+ (bullet (if (not (eq type 'ordered)) "-"
+ (concat (number-to-string
+ (car (last (org-list-get-item-number
+ (org-element-property :begin item)
+ struct
+ (org-list-prevs-alist struct)
+ (org-list-parents-alist struct)))))
+ "."))))
+ (concat bullet
+ (make-string (- 4 (length bullet)) ? )
+ (case (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))))
+ (org-trim (replace-regexp-in-string "^" " " contents)))))
+
+
+;;;; Line Break
+
+(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."
+ " \n")
+
+
+;;;; 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-html-maybe
+ (function
+ (lambda (raw-path info)
+ ;; Treat links to `file.org' as links to `file.html', if
+ ;; needed. See `org-html-link-org-files-as-html'.
+ (cond
+ ((and org-html-link-org-files-as-html
+ (string= ".org"
+ (downcase (file-name-extension raw-path "."))))
+ (concat (file-name-sans-extension raw-path) "."
+ (plist-get info :html-extension)))
+ (t 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-html-maybe
+ destination info)))
+ (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)
+ ".")))))))
+ ((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
+ (expand-file-name raw-path)))))
+ (format "![%s](%s)"
+ (let ((caption (org-export-get-caption
+ (org-export-get-parent-element link))))
+ (when caption (org-export-data caption info)))
+ path)))
+ ((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")
+ (let ((destination (org-export-resolve-radio-link link info)))
+ (org-export-data (org-element-contents destination) info)))
+ ((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 "."))))))))
+ (t (let* ((raw-path (org-element-property :path link))
+ (path (cond
+ ((member type '("http" "https" "ftp"))
+ (concat type ":" raw-path))
+ ((equal type "file")
+ ;; Treat links to ".org" files as ".html",
+ ;; if needed.
+ (setq raw-path
+ (funcall --link-org-files-as-html-maybe
+ raw-path info))
+ ;; If file path is absolute, prepend it
+ ;; with protocol component - "file://".
+ (if (not (file-name-absolute-p raw-path)) raw-path
+ (concat "file://" (expand-file-name raw-path))))
+ (t raw-path))))
+ (if (not contents) (format "<%s>" path)
+ (format "[%s](%s)" contents path)))))))
+
+
+;;;; Paragraph
+
+(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)
+ contents)))
+
+
+;;;; Plain List
+
+(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."
+ contents)
+
+
+;;;; Plain Text
+
+(defun org-md-plain-text (text info)
+ "Transcode a TEXT string into Markdown format.
+TEXT is the string to transcode. INFO is a plist holding
+contextual information."
+ (when (plist-get info :with-smart-quotes)
+ (setq text (org-export-activate-smart-quotes text :html info)))
+ ;; Protect ambiguous #. This will protect # at the beginning of
+ ;; a line, but not at the beginning of a paragraph. See
+ ;; `org-md-paragraph'.
+ (setq text (replace-regexp-in-string "\n#" "\n\\\\#" text))
+ ;; Protect ambiguous !
+ (setq text (replace-regexp-in-string "\\(!\\)\\[" "\\\\!" text nil nil 1))
+ ;; Protect `, *, _ and \
+ (setq text (replace-regexp-in-string "[`*_\\]" "\\\\\\&" text))
+ ;; Handle special strings, if required.
+ (when (plist-get info :with-special-strings)
+ (setq text (org-html-convert-special-strings text)))
+ ;; Handle break preservation, if required.
+ (when (plist-get info :preserve-breaks)
+ (setq text (replace-regexp-in-string "[ \t]*\n" " \n" text)))
+ ;; Return value.
+ text)
+
+
+;;;; Quote Block
+
+(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."
+ (replace-regexp-in-string
+ "^" "> "
+ (replace-regexp-in-string "\n\\'" "" contents)))
+
+
+;;;; Section
+
+(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."
+ contents)
+
+
+;;;; Template
+
+(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."
+ contents)
+
+
+
+;;; Interactive function
+
+;;;###autoload
+(defun org-md-export-as-markdown (&optional async subtreep visible-only)
+ "Export current buffer to a Markdown buffer.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should be accessible
+through the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Export is done in a buffer named \"*Org MD Export*\", which will
+be displayed when `org-export-show-temporary-export-buffer' is
+non-nil."
+ (interactive)
+ (if async
+ (org-export-async-start
+ (lambda (output)
+ (with-current-buffer (get-buffer-create "*Org MD Export*")
+ (erase-buffer)
+ (insert output)
+ (goto-char (point-min))
+ (text-mode)
+ (org-export-add-to-stack (current-buffer) 'md)))
+ `(org-export-as 'md ,subtreep ,visible-only))
+ (let ((outbuf (org-export-to-buffer
+ 'md "*Org MD Export*" subtreep visible-only)))
+ (with-current-buffer outbuf (text-mode))
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window outbuf)))))
+
+;;;###autoload
+(defun org-md-convert-region-to-md ()
+ "Assume the current region has org-mode 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
+this command to convert it."
+ (interactive)
+ (org-export-replace-region-by 'md))
+
+
+;;;###autoload
+(defun org-md-export-to-markdown (&optional async subtreep visible-only)
+ "Export current buffer to a Markdown file.
+
+If narrowing is active in the current buffer, only export its
+narrowed part.
+
+If a region is active, export that region.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting file should be accessible through
+the `org-export-stack' interface.
+
+When optional argument SUBTREEP is non-nil, export the sub-tree
+at point, extracting information from the headline properties
+first.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Return output file's name."
+ (interactive)
+ (let ((outfile (org-export-output-file-name ".md" subtreep)))
+ (if async
+ (org-export-async-start
+ (lambda (f) (org-export-add-to-stack f 'md))
+ `(expand-file-name
+ (org-export-to-file 'md ,outfile ,subtreep ,visible-only)))
+ (org-export-to-file 'md outfile subtreep visible-only))))
+
+
+(provide 'ox-md)
+
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
+;;; ox-md.el ends here