contrib/lisp/org-md.el

   1 ;;; org-md.el --- Markdown Back-End for Org Export Engine
   2
   3 ;; Copyright (C) 2012  Free Software Foundation, Inc.
   4
   5 ;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
   6 ;; Keywords: org, wp, tex
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; This library implements a Markdown back-end (vanilla flavour) for
  24 ;; Org exporter, based on `e-html'.
  25 ;;
  26 ;; It provides two commands for export, depending on the desired
  27 ;; output: `org-md-export-as-markdown' (temporary buffer) and
  28 ;; `org-md-export-to-markdown' ("md" file).
  29
  30 ;;; Code:
  31
  32 (require 'org-e-html)
  33
  34
  35 \f
  36 ;;; User-Configurable Variables
  37
  38 (defgroup org-export-md nil
  39   "Options specific to Markdown export back-end."
  40   :tag "Org Markdown"
  41   :group 'org-export
  42   :version "24.2")
  43
  44 (defcustom org-md-headline-style 'atx
  45   "Style used to format headlines.
  46 This variable can be set to either `atx' or `setext'."
  47   :group 'org-export-md
  48   :type '(choice
  49           (const :tag "Use \"atx\" style" atx)
  50           (const :tag "Use \"Setext\" style" setext)))
  51
  52
  53 \f
  54 ;;; Define Back-End
  55
  56 (org-export-define-derived-backend md e-html
  57   :export-block ("MD" "MARKDOWN")
  58   :filters-alist ((:filter-parse-tree . org-md-separate-elements))
  59   :menu-entry
  60   (?m "Export to Markdown"
  61       ((?M "To temporary buffer"
  62            (lambda (s v b) (org-md-export-as-markdown s v)))
  63        (?m "To file" (lambda (s v b) (org-md-export-to-markdown s v)))
  64        (?o "To file and open"
  65            (lambda (s v b) (org-open-file (org-md-export-to-markdown s v))))))
  66   :translate-alist ((bold . org-md-bold)
  67                     (code . org-md-verbatim)
  68                     (example-block . org-md-example-block)
  69                     (footnote-definition . ignore)
  70                     (footnote-reference . ignore)
  71                     (headline . org-md-headline)
  72                     (horizontal-rule . org-md-horizontal-rule)
  73                     (inline-src-block . org-md-verbatim)
  74                     (italic . org-md-italic)
  75                     (item . org-md-item)
  76                     (line-break . org-md-line-break)
  77                     (link . org-md-link)
  78                     (paragraph . org-md-paragraph)
  79                     (plain-list . org-md-plain-list)
  80                     (plain-text . org-md-plain-text)
  81                     (quote-block . org-md-quote-block)
  82                     (quote-section . org-md-example-block)
  83                     (section . org-md-section)
  84                     (src-block . org-md-example-block)
  85                     (template . org-md-template)
  86                     (verbatim . org-md-verbatim)))
  87
  88
  89 \f
  90 ;;; Filters
  91
  92 (defun org-md-separate-elements (tree backend info)
  93   "Make sure elements are separated by at least one blank line.
  94
  95 TREE is the parse tree being exported.  BACKEND is the export
  96 back-end used.  INFO is a plist used as a communication channel.
  97
  98 Assume BACKEND is `md'."
  99   (org-element-map
 100    tree org-element-all-elements
 101    (lambda (elem)
 102      (unless (eq (org-element-type elem) 'org-data)
 103        (org-element-put-property
 104         elem :post-blank
 105         (let ((post-blank (org-element-property :post-blank elem)))
 106           (if (not post-blank) 1 (max 1 post-blank)))))))
 107   ;; Return updated tree.
 108   tree)
 109
 110
 111 \f
 112 ;;; Transcode Functions
 113
 114 ;;;; Bold
 115
 116 (defun org-md-bold (bold contents info)
 117   "Transcode BOLD object into Markdown format.
 118 CONTENTS is the text within bold markup.  INFO is a plist used as
 119 a communication channel."
 120   (format "**%s**" contents))
 121
 122
 123 ;;;; Code and Verbatim
 124
 125 (defun org-md-verbatim (verbatim contents info)
 126   "Transcode VERBATIM object into Markdown format.
 127 CONTENTS is nil.  INFO is a plist used as a communication
 128 channel."
 129   (let ((value (org-element-property :value verbatim)))
 130     (format (cond ((not (string-match "`" value)) "`%s`")
 131                   ((or (string-match "\\``" value)
 132                        (string-match "`\\'" value))
 133                    "`` %s ``")
 134                   (t "``%s``"))
 135             value)))
 136
 137
 138 ;;;; Example Block and Src Block
 139
 140 (defun org-md-example-block (example-block contents info)
 141   "Transcode EXAMPLE-BLOCK element into Markdown format.
 142 CONTENTS is nil.  INFO is a plist used as a communication
 143 channel."
 144   (replace-regexp-in-string
 145    "^" "    "
 146    (org-remove-indentation
 147     (org-element-property :value example-block))))
 148
 149
 150 ;;;; Headline
 151
 152 (defun org-md-headline (headline contents info)
 153   "Transcode HEADLINE element into Markdown format.
 154 CONTENTS is the headline contents.  INFO is a plist used as
 155 a communication channel."
 156   (unless (org-element-property :footnote-section-p headline)
 157     (let* ((level (org-export-get-relative-level headline info))
 158            (title (org-export-data (org-element-property :title headline) info))
 159            (todo (and (plist-get info :with-todo-keywords)
 160                       (let ((todo (org-element-property :todo-keyword
 161                                                         headline)))
 162                         (and todo (concat (org-export-data todo info) " ")))))
 163            (tags (and (plist-get info :with-tags)
 164                       (let ((tag-list (org-export-get-tags headline info)))
 165                         (and tag-list
 166                              (format "     :%s:"
 167                                      (mapconcat 'identity tag-list ":"))))))
 168            (priority
 169             (and (plist-get info :with-priority)
 170                  (let ((char (org-element-property :priority headline)))
 171                    (and char (format "[#%c] " char)))))
 172            ;; Headline text without tags.
 173            (heading (concat todo priority title)))
 174       (cond
 175        ;; Cannot create an headline.  Fall-back to a list.
 176        ((or (org-export-low-level-p headline info)
 177             (not (memq org-md-headline-style '(atx setext)))
 178             (and (eq org-md-headline-style 'atx) (> level 6))
 179             (and (eq org-md-headline-style 'setext) (> level 2)))
 180         (let ((bullet
 181                (if (not (org-export-numbered-headline-p headline info)) "-"
 182                  (concat (number-to-string
 183                           (car (last (org-export-get-headline-number
 184                                       headline info))))
 185                          "."))))
 186           (concat bullet (make-string (- 4 (length bullet)) ? ) heading tags
 187                   "\n\n"
 188                   (and contents
 189                        (replace-regexp-in-string "^" "    " contents)))))
 190        ;; Use "Setext" style.
 191        ((eq org-md-headline-style 'setext)
 192         (concat heading tags "\n"
 193                 (make-string (length heading) (if (= level 1) ?= ?-))
 194                 "\n\n"
 195                 contents))
 196        ;; Use "atx" style.
 197        (t (concat (make-string level ?#) " " heading tags "\n\n" contents))))))
 198
 199
 200 ;;;; Horizontal Rule
 201
 202 (defun org-md-horizontal-rule (horizontal-rule contents info)
 203   "Transcode HORIZONTAL-RULE element into Markdown format.
 204 CONTENTS is the horizontal rule contents.  INFO is a plist used
 205 as a communication channel."
 206   "---")
 207
 208
 209 ;;;; Italic
 210
 211 (defun org-md-italic (italic contents info)
 212   "Transcode ITALIC object into Markdown format.
 213 CONTENTS is the text within italic markup.  INFO is a plist used
 214 as a communication channel."
 215   (format "*%s*" contents))
 216
 217
 218 ;;;; Item
 219
 220 (defun org-md-item (item contents info)
 221   "Transcode ITEM element into Markdown format.
 222 CONTENTS is the item contents.  INFO is a plist used as
 223 a communication channel."
 224   (let* ((type (org-element-property :type (org-export-get-parent item)))
 225          (struct (org-element-property :structure item))
 226          (bullet (if (not (eq type 'ordered)) "-"
 227                    (concat (number-to-string
 228                             (car (last (org-list-get-item-number
 229                                         (org-element-property :begin item)
 230                                         struct
 231                                         (org-list-prevs-alist struct)
 232                                         (org-list-parents-alist struct)))))
 233                            "."))))
 234     (concat bullet
 235             (make-string (- 4 (length bullet)) ? )
 236             (case (org-element-property :checkbox item)
 237               (on "[X] ")
 238               (trans "[-] ")
 239               (off "[ ] "))
 240             (let ((tag (org-element-property :tag item)))
 241               (and tag (format "**%s:** "(org-export-data tag info))))
 242             (org-trim (replace-regexp-in-string "^" "    " contents)))))
 243
 244
 245 ;;;; Line Break
 246
 247 (defun org-md-line-break (line-break contents info)
 248   "Transcode LINE-BREAK object into Markdown format.
 249 CONTENTS is nil.  INFO is a plist used as a communication
 250 channel."
 251   "  ")
 252
 253
 254 ;;;; Link
 255
 256 (defun org-md-link (link contents info)
 257   "Transcode LINE-BREAK object into Markdown format.
 258 CONTENTS is the link's description.  INFO is a plist used as
 259 a communication channel."
 260   (let ((--link-org-files-as-html-maybe
 261          (function
 262           (lambda (raw-path info)
 263             ;; Treat links to `file.org' as links to `file.html', if
 264             ;; needed.  See `org-e-html-link-org-files-as-html'.
 265             (cond
 266              ((and org-e-html-link-org-files-as-html
 267                    (string= ".org"
 268                             (downcase (file-name-extension raw-path "."))))
 269               (concat (file-name-sans-extension raw-path) "."
 270                       (plist-get info :html-extension)))
 271              (t raw-path)))))
 272         (type (org-element-property :type link)))
 273     (cond ((member type '("custom-id" "id"))
 274            (let ((destination (org-export-resolve-id-link link info)))
 275              (if (stringp destination)  ; External file.
 276                  (let ((path (funcall --link-org-files-as-html-maybe
 277                                       destination info)))
 278                    (if (not contents) (format "<%s>" path)
 279                      (format "[%s](%s)" contents path)))
 280                (concat
 281                 (and contents (concat contents " "))
 282                 (format "(%s)"
 283                         (format (org-export-translate "See section %s" :html info)
 284                                 (mapconcat 'number-to-string
 285                                            (org-export-get-headline-number
 286                                             destination info)
 287                                            ".")))))))
 288           ((org-export-inline-image-p link org-e-html-inline-image-rules)
 289            (format "![%s](%s)"
 290                    (let ((caption (org-export-get-caption
 291                                    (org-export-get-parent-element link))))
 292                      (when caption (org-export-data caption info)))
 293                    path))
 294           ((string= type "coderef")
 295            (let ((ref (org-element-property :path link)))
 296              (format (org-export-get-coderef-format ref contents)
 297                      (org-export-resolve-coderef ref info))))
 298           ((equal type "radio")
 299            (let ((destination (org-export-resolve-radio-link link info)))
 300              (org-export-data (org-element-contents destination) info)))
 301           ((equal type "fuzzy")
 302            (let ((destination (org-export-resolve-fuzzy-link link info)))
 303              ;; Ignore invisible "#+TARGET: path".
 304              (unless (eq (org-element-type destination) 'keyword)
 305                (if (org-string-nw-p contents) contents
 306                  (when destination
 307                    (let ((number (org-export-get-ordinal destination info)))
 308                      (when number
 309                        (if (atom number) (number-to-string number)
 310                          (mapconcat 'number-to-string number ".")))))))))
 311           (t (let* ((raw-path (org-element-property :path link))
 312                     (path (cond
 313                            ((member type '("http" "https" "ftp"))
 314                             (concat type ":" raw-path))
 315                            ((equal type "file")
 316                             ;; Treat links to ".org" files as ".html",
 317                             ;; if needed.
 318                             (setq raw-path
 319                                   (funcall --link-org-files-as-html-maybe
 320                                            raw-path info))
 321                             ;; If file path is absolute, prepend it
 322                             ;; with protocol component - "file://".
 323                             (if (not (file-name-absolute-p raw-path)) raw-path
 324                               (concat "file://" (expand-file-name raw-path))))
 325                            (t raw-path))))
 326                (if (not contents) (format "<%s>" path)
 327                  (format "[%s](%s)" contents path)))))))
 328
 329
 330 ;;;; Paragraph
 331
 332 (defun org-md-paragraph (paragraph contents info)
 333   "Transcode PARAGRAPH element into Markdown format.
 334 CONTENTS is the paragraph contents.  INFO is a plist used as
 335 a communication channel."
 336   (let ((first-object (car (org-element-contents paragraph))))
 337     ;; If paragraph starts with a #, protect it.
 338     (if (and (stringp first-object) (string-match "\\`#" first-object))
 339         (replace-regexp-in-string "\\`#" "\\#" contents nil t)
 340       contents)))
 341
 342
 343 ;;;; Plain List
 344
 345 (defun org-md-plain-list (plain-list contents info)
 346   "Transcode PLAIN-LIST element into Markdown format.
 347 CONTENTS is the plain-list contents.  INFO is a plist used as
 348 a communication channel."
 349   contents)
 350
 351
 352 ;;;; Plain Text
 353
 354 (defun org-md-plain-text (text info)
 355   "Transcode a TEXT string into Markdown format.
 356 TEXT is the string to transcode.  INFO is a plist holding
 357 contextual information."
 358   (when (plist-get info :with-smart-quotes)
 359     (setq text (org-export-activate-smart-quotes text :html info)))
 360   ;; Protect ambiguous #.  This will protect # at the beginning of
 361   ;; a line, but not at the beginning of a paragraph.  See
 362   ;; `org-md-paragraph'.
 363   (setq text (replace-regexp-in-string "\n#" "\n\\\\#" text))
 364   ;; Protect ambiguous !
 365   (setq text (replace-regexp-in-string "\\(!\\)\\[" "\\\\!" text nil nil 1))
 366   ;; Protect `, *, _ and \
 367   (setq text (replace-regexp-in-string "[`*_\\]" "\\\\\\&" text))
 368   ;; Handle special strings, if required.
 369   (when (plist-get info :with-special-strings)
 370     (setq text (org-e-html-convert-special-strings text)))
 371   ;; Handle break preservation, if required.
 372   (when (plist-get info :preserve-breaks)
 373     (setq text (replace-regexp-in-string "[ \t]*\n" "  \n" text)))
 374   ;; Return value.
 375   text)
 376
 377
 378 ;;;; Quote Block
 379
 380 (defun org-md-quote-block (quote-block contents info)
 381   "Transcode QUOTE-BLOCK element into Markdown format.
 382 CONTENTS is the quote-block contents.  INFO is a plist used as
 383 a communication channel."
 384   (replace-regexp-in-string
 385    "^" "> "
 386    (replace-regexp-in-string "\n\\'" "" contents)))
 387
 388
 389 ;;;; Section
 390
 391 (defun org-md-section (section contents info)
 392   "Transcode SECTION element into Markdown format.
 393 CONTENTS is the section contents.  INFO is a plist used as
 394 a communication channel."
 395   contents)
 396
 397
 398 ;;;; Template
 399
 400 (defun org-md-template (contents info)
 401   "Return complete document string after Markdown conversion.
 402 CONTENTS is the transcoded contents string.  INFO is a plist used
 403 as a communication channel."
 404   contents)
 405
 406
 407 \f
 408 ;;; Interactive function
 409
 410 ;;;###autoload
 411 (defun org-md-export-as-markdown (&optional subtreep visible-only)
 412   "Export current buffer to a text buffer.
 413
 414 If narrowing is active in the current buffer, only export its
 415 narrowed part.
 416
 417 If a region is active, export that region.
 418
 419 When optional argument SUBTREEP is non-nil, export the sub-tree
 420 at point, extracting information from the headline properties
 421 first.
 422
 423 When optional argument VISIBLE-ONLY is non-nil, don't export
 424 contents of hidden elements.
 425
 426 Export is done in a buffer named \"*Org MD Export*\", which will
 427 be displayed when `org-export-show-temporary-export-buffer' is
 428 non-nil."
 429   (interactive)
 430   (let ((outbuf (org-export-to-buffer
 431                  'md "*Org MD Export*" subtreep visible-only)))
 432     (with-current-buffer outbuf (text-mode))
 433     (when org-export-show-temporary-export-buffer
 434       (switch-to-buffer-other-window outbuf))))
 435
 436
 437 ;;;###autoload
 438 (defun org-md-export-to-markdown (&optional subtreep visible-only)
 439   "Export current buffer to a Markdown file.
 440
 441 If narrowing is active in the current buffer, only export its
 442 narrowed part.
 443
 444 If a region is active, export that region.
 445
 446 When optional argument SUBTREEP is non-nil, export the sub-tree
 447 at point, extracting information from the headline properties
 448 first.
 449
 450 When optional argument VISIBLE-ONLY is non-nil, don't export
 451 contents of hidden elements.
 452
 453 Return output file's name."
 454   (interactive)
 455   (let ((outfile (org-export-output-file-name ".md" subtreep)))
 456     (org-export-to-file 'md outfile subtreep visible-only)))
 457
 458
 459 (provide 'org-md)
 460 ;;; org-md.el ends here