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