lisp/ox-org.el

   1 ;;; ox-org.el --- Org Back-End for Org Export Engine
   2
   3 ;; Copyright (C) 2013-2014 Free Software Foundation, Inc.
   4
   5 ;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
   6 ;; Keywords: org, wp
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;;; Code:
  26
  27 (require 'ox)
  28 (declare-function htmlize-buffer "htmlize" (&optional buffer))
  29
  30 (defgroup org-export-org nil
  31   "Options for exporting Org mode files to Org."
  32   :tag "Org Export Org"
  33   :group 'org-export
  34   :version "24.4"
  35   :package-version '(Org . "8.0"))
  36
  37 (define-obsolete-variable-alias
  38   'org-export-htmlized-org-css-url 'org-org-htmlized-css-url "24.4")
  39 (defcustom org-org-htmlized-css-url nil
  40   "URL pointing to the CSS defining colors for htmlized Emacs buffers.
  41 Normally when creating an htmlized version of an Org buffer,
  42 htmlize will create the CSS to define the font colors.  However,
  43 this does not work when converting in batch mode, and it also can
  44 look bad if different people with different fontification setup
  45 work on the same website.  When this variable is non-nil,
  46 creating an htmlized version of an Org buffer using
  47 `org-org-export-as-org' will include a link to this URL if the
  48 setting of `org-html-htmlize-output-type' is 'css."
  49   :group 'org-export-org
  50   :type '(choice
  51           (const :tag "Don't include external stylesheet link" nil)
  52           (string :tag "URL or local href")))
  53
  54 (org-export-define-backend 'org
  55   '((babel-call . org-org-identity)
  56     (bold . org-org-identity)
  57     (center-block . org-org-identity)
  58     (clock . org-org-identity)
  59     (code . org-org-identity)
  60     (comment . (lambda (&rest args) ""))
  61     (comment-block . (lambda (&rest args) ""))
  62     (diary-sexp . org-org-identity)
  63     (drawer . org-org-identity)
  64     (dynamic-block . org-org-identity)
  65     (entity . org-org-identity)
  66     (example-block . org-org-identity)
  67     (fixed-width . org-org-identity)
  68     (footnote-definition . ignore)
  69     (footnote-reference . org-org-identity)
  70     (headline . org-org-headline)
  71     (horizontal-rule . org-org-identity)
  72     (inline-babel-call . org-org-identity)
  73     (inline-src-block . org-org-identity)
  74     (inlinetask . org-org-identity)
  75     (italic . org-org-identity)
  76     (item . org-org-identity)
  77     (keyword . org-org-keyword)
  78     (latex-environment . org-org-identity)
  79     (latex-fragment . org-org-identity)
  80     (line-break . org-org-identity)
  81     (link . org-org-identity)
  82     (node-property . org-org-identity)
  83     (template . org-org-template)
  84     (paragraph . org-org-identity)
  85     (plain-list . org-org-identity)
  86     (planning . org-org-identity)
  87     (property-drawer . org-org-identity)
  88     (quote-block . org-org-identity)
  89     (radio-target . org-org-identity)
  90     (section . org-org-section)
  91     (special-block . org-org-identity)
  92     (src-block . org-org-identity)
  93     (statistics-cookie . org-org-identity)
  94     (strike-through . org-org-identity)
  95     (subscript . org-org-identity)
  96     (superscript . org-org-identity)
  97     (table . org-org-identity)
  98     (table-cell . org-org-identity)
  99     (table-row . org-org-identity)
 100     (target . org-org-identity)
 101     (timestamp . org-org-identity)
 102     (underline . org-org-identity)
 103     (verbatim . org-org-identity)
 104     (verse-block . org-org-identity))
 105   :options-alist '((:org-htmlized-css-url nil nil org-org-htmlized-css-url))
 106   :menu-entry
 107   '(?O "Export to Org"
 108        ((?O "As Org buffer" org-org-export-as-org)
 109         (?o "As Org file" org-org-export-to-org)
 110         (?v "As Org file and open"
 111             (lambda (a s v b)
 112               (if a (org-org-export-to-org t s v b)
 113                 (org-open-file (org-org-export-to-org nil s v b))))))))
 114
 115 (defun org-org-identity (blob contents info)
 116   "Transcode BLOB element or object back into Org syntax.
 117 CONTENTS is its contents, as a string or nil.  INFO is ignored."
 118   (let ((case-fold-search t))
 119     (replace-regexp-in-string
 120      "^[ \t]*#\\+ATTR_[-_A-Za-z0-9]+:\\(?: .*\\)?\n" ""
 121      (org-export-expand blob contents t))))
 122
 123 (defun org-org-headline (headline contents info)
 124   "Transcode HEADLINE element back into Org syntax.
 125 CONTENTS is its contents, as a string or nil.  INFO is ignored."
 126   (unless (org-element-property :footnote-section-p headline)
 127     (unless (plist-get info :with-todo-keywords)
 128       (org-element-put-property headline :todo-keyword nil))
 129     (unless (plist-get info :with-tags)
 130       (org-element-put-property headline :tags nil))
 131     (unless (plist-get info :with-priority)
 132       (org-element-put-property headline :priority nil))
 133     (org-element-put-property headline :level
 134                               (org-export-get-relative-level headline info))
 135     (org-element-headline-interpreter headline contents)))
 136
 137 (defun org-org-keyword (keyword contents info)
 138   "Transcode KEYWORD element back into Org syntax.
 139 CONTENTS is nil.  INFO is ignored.  This function ignores
 140 keywords targeted at other export back-ends."
 141   (let ((key (org-element-property :key keyword)))
 142     (unless (or (member key
 143                         (mapcar
 144                          (lambda (block-cons)
 145                            (and (eq (cdr block-cons)
 146                                     'org-element-export-block-parser)
 147                                 (car block-cons)))
 148                          org-element-block-name-alist))
 149                 (member key
 150                         '("AUTHOR" "CREATOR" "DATE" "DESCRIPTION" "EMAIL"
 151                           "KEYWORDS" "TITLE")))
 152       (org-element-keyword-interpreter keyword nil))))
 153
 154 (defun org-org-template (contents info)
 155   "Return Org document template with document keywords.
 156 CONTENTS is the transcoded contents string.  INFO is a plist used
 157 as a communication channel."
 158   (concat
 159    (and (plist-get info :time-stamp-file)
 160         (format-time-string "# Created %Y-%m-%d %a %H:%M\n"))
 161    (format "#+TITLE: %s\n" (org-export-data (plist-get info :title) info))
 162    (and (plist-get info :with-date)
 163         (let ((date (org-export-data (org-export-get-date info) info)))
 164           (and (org-string-nw-p date)
 165                (format "#+DATE: %s\n" date))))
 166    (and (plist-get info :with-author)
 167         (let ((author (org-export-data (plist-get info :author) info)))
 168           (and (org-string-nw-p author)
 169                (format "#+AUTHOR: %s\n" author))))
 170    (and (plist-get info :with-email)
 171         (let ((email (org-export-data (plist-get info :email) info)))
 172           (and (org-string-nw-p email)
 173                (format "#+EMAIL: %s\n" email))))
 174    (and (eq (plist-get info :with-creator) t)
 175         (org-string-nw-p (plist-get info :creator))
 176         (format "#+CREATOR: %s\n" (plist-get info :creator)))
 177    (and (org-string-nw-p (plist-get info :keywords))
 178         (format "#+KEYWORDS: %s\n" (plist-get info :keywords)))
 179    (and (org-string-nw-p (plist-get info :description))
 180         (format "#+DESCRIPTION: %s\n" (plist-get info :description)))
 181    contents
 182    (and (eq (plist-get info :with-creator) 'comment)
 183         (org-string-nw-p (plist-get info :creator))
 184         (format "\n# %s\n" (plist-get info :creator)))))
 185
 186 (defun org-org-section (section contents info)
 187   "Transcode SECTION element back into Org syntax.
 188 CONTENTS is the contents of the section.  INFO is a plist used as
 189 a communication channel."
 190   (concat
 191    (org-element-normalize-string contents)
 192    ;; Insert footnote definitions appearing for the first time in this
 193    ;; section.  Indeed, some of them may not be available to narrowing
 194    ;; so we make sure all of them are included in the result.
 195    (let ((footnotes-alist
 196           (org-element-map section 'footnote-reference
 197             (lambda (fn)
 198               (and (eq (org-element-property :type fn) 'standard)
 199                    (org-export-footnote-first-reference-p fn info)
 200                    (cons (org-element-property :label fn)
 201                          (org-export-get-footnote-definition fn info))))
 202             info)))
 203      (and footnotes-alist
 204           (concat "\n"
 205                   (mapconcat
 206                    (lambda (d)
 207                      (org-element-normalize-string
 208                       (concat (format "[%s] "(car d))
 209                               (org-export-data (cdr d) info))))
 210                    footnotes-alist "\n"))))
 211    (make-string (or (org-element-property :post-blank section) 0) ?\n)))
 212
 213 ;;;###autoload
 214 (defun org-org-export-as-org
 215   (&optional async subtreep visible-only body-only ext-plist)
 216   "Export current buffer to an Org buffer.
 217
 218 If narrowing is active in the current buffer, only export its
 219 narrowed part.
 220
 221 If a region is active, export that region.
 222
 223 A non-nil optional argument ASYNC means the process should happen
 224 asynchronously.  The resulting buffer should be accessible
 225 through the `org-export-stack' interface.
 226
 227 When optional argument SUBTREEP is non-nil, export the sub-tree
 228 at point, extracting information from the headline properties
 229 first.
 230
 231 When optional argument VISIBLE-ONLY is non-nil, don't export
 232 contents of hidden elements.
 233
 234 When optional argument BODY-ONLY is non-nil, strip document
 235 keywords from output.
 236
 237 EXT-PLIST, when provided, is a property list with external
 238 parameters overriding Org default settings, but still inferior to
 239 file-local settings.
 240
 241 Export is done in a buffer named \"*Org ORG Export*\", which will
 242 be displayed when `org-export-show-temporary-export-buffer' is
 243 non-nil."
 244   (interactive)
 245   (org-export-to-buffer 'org "*Org ORG Export*"
 246     async subtreep visible-only body-only ext-plist (lambda () (org-mode))))
 247
 248 ;;;###autoload
 249 (defun org-org-export-to-org
 250   (&optional async subtreep visible-only body-only ext-plist)
 251   "Export current buffer to an org file.
 252
 253 If narrowing is active in the current buffer, only export its
 254 narrowed part.
 255
 256 If a region is active, export that region.
 257
 258 A non-nil optional argument ASYNC means the process should happen
 259 asynchronously.  The resulting file should be accessible through
 260 the `org-export-stack' interface.
 261
 262 When optional argument SUBTREEP is non-nil, export the sub-tree
 263 at point, extracting information from the headline properties
 264 first.
 265
 266 When optional argument VISIBLE-ONLY is non-nil, don't export
 267 contents of hidden elements.
 268
 269 When optional argument BODY-ONLY is non-nil, strip document
 270 keywords from output.
 271
 272 EXT-PLIST, when provided, is a property list with external
 273 parameters overriding Org default settings, but still inferior to
 274 file-local settings.
 275
 276 Return output file name."
 277   (interactive)
 278   (let ((outfile (org-export-output-file-name ".org" subtreep)))
 279     (org-export-to-file 'org outfile
 280       async subtreep visible-only body-only ext-plist)))
 281
 282 ;;;###autoload
 283 (defun org-org-publish-to-org (plist filename pub-dir)
 284   "Publish an org file to org.
 285
 286 FILENAME is the filename of the Org file to be published.  PLIST
 287 is the property list for the given project.  PUB-DIR is the
 288 publishing directory.
 289
 290 Return output file name."
 291   (org-publish-org-to 'org filename ".org" plist pub-dir)
 292   (when (plist-get plist :htmlized-source)
 293     (require 'htmlize)
 294     (require 'ox-html)
 295     (let* ((org-inhibit-startup t)
 296            (htmlize-output-type 'css)
 297            (html-ext (concat "." (or (plist-get plist :html-extension)
 298                                      org-html-extension "html")))
 299            (visitingp (find-buffer-visiting filename))
 300            (work-buffer (or visitingp (find-file filename)))
 301            newbuf)
 302       (font-lock-ensure)
 303       (show-all)
 304       (org-show-block-all)
 305       (setq newbuf (htmlize-buffer))
 306       (with-current-buffer newbuf
 307         (when org-org-htmlized-css-url
 308           (goto-char (point-min))
 309           (and (re-search-forward
 310                 "<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*" nil t)
 311                (replace-match
 312                 (format
 313                  "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
 314                  org-org-htmlized-css-url) t t)))
 315         (write-file (concat pub-dir (file-name-nondirectory filename) html-ext)))
 316       (kill-buffer newbuf)
 317       (unless visitingp (kill-buffer work-buffer)))
 318     (set-buffer-modified-p nil)))
 319
 320
 321 (provide 'ox-org)
 322
 323 ;; Local variables:
 324 ;; generated-autoload-file: "org-loaddefs.el"
 325 ;; End:
 326
 327 ;;; ox-org.el ends here