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