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