diff options
Diffstat (limited to 'contrib/lisp/org-md.el')
| -rw-r--r-- | contrib/lisp/org-md.el | 461 |
1 files changed, 0 insertions, 461 deletions
diff --git a/contrib/lisp/org-md.el b/contrib/lisp/org-md.el deleted file mode 100644 index 4579ca3..0000000 --- a/contrib/lisp/org-md.el +++ /dev/null @@ -1,461 +0,0 @@ -;;; org-md.el --- Markdown Back-End for Org Export Engine - -;; Copyright (C) 2012 Free Software Foundation, Inc. - -;; Author: Nicolas Goaziou <n.goaziou@gmail.com> -;; Keywords: org, wp, tex - -;; This program 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. - -;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements a Markdown back-end (vanilla flavour) for -;; Org exporter, based on `e-html'. -;; -;; 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: - -(require 'org-e-html) - - - -;;; User-Configurable Variables - -(defgroup org-export-md nil - "Options specific to Markdown export back-end." - :tag "Org Markdown" - :group 'org-export - :version "24.2") - -(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 e-html - :export-block ("MD" "MARKDOWN") - :filters-alist ((:filter-parse-tree . org-md-separate-elements)) - :translate-alist ((bold . org-md-bold) - (code . org-md-verbatim) - (example-block . 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 an 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." - " ") - - -;;;; 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-e-html-link-org-files-as-html'. - (cond - ((and org-e-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-e-html-inline-image-rules) - (format "" - (let ((caption - (org-element-property - :caption (org-export-get-parent-element link)))) - (when caption (org-export-data (car 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))) - ;; Ignore invisible "#+TARGET: path". - (unless (eq (org-element-type destination) 'keyword) - (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") - ;; Extract just the file path and strip - ;; all other components. - (when (string-match "\\(.+\\)::.+" raw-path) - (setq raw-path (match-string 1 raw-path))) - ;; 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." - ;; 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 - "[`*_\\]" (lambda (rep) (concat "\\\\" (match-string 1 rep))) text)) - ;; Handle special strings, if required. - (when (plist-get info :with-special-strings) - (setq text (org-e-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 subtreep visible-only) - "Export current buffer to a text buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -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) - (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-export-to-markdown (&optional subtreep visible-only pub-dir) - "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. - -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. - -When optional argument PUB-DIR is set, use it as the publishing -directory. - -Return output file's name." - (interactive) - (let ((outfile (org-export-output-file-name ".md" subtreep pub-dir))) - (org-export-to-file 'md outfile subtreep visible-only))) - - -(provide 'org-md) -;;; org-md.el ends here |