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 . org-org-identity)
  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     (quote-section . org-org-identity)
  90     (radio-target . org-org-identity)
  91     (section . org-org-identity)
  92     (special-block . org-org-identity)
  93     (src-block . org-org-identity)
  94     (statistics-cookie . org-org-identity)
  95     (strike-through . org-org-identity)
  96     (subscript . org-org-identity)
  97     (superscript . org-org-identity)
  98     (table . org-org-identity)
  99     (table-cell . org-org-identity)
 100     (table-row . org-org-identity)
 101     (target . org-org-identity)
 102     (timestamp . org-org-identity)
 103     (underline . org-org-identity)
 104     (verbatim . org-org-identity)
 105     (verse-block . org-org-identity))
 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 (plist-get info :with-todo-keywords)
 127     (org-element-put-property headline :todo-keyword nil))
 128   (unless (plist-get info :with-tags)
 129     (org-element-put-property headline :tags nil))
 130   (unless (plist-get info :with-priority)
 131     (org-element-put-property headline :priority nil))
 132   (org-element-put-property headline :level
 133                             (org-export-get-relative-level headline info))
 134   (org-element-headline-interpreter headline contents))
 135
 136 (defun org-org-keyword (keyword contents info)
 137   "Transcode KEYWORD element back into Org syntax.
 138 CONTENTS is nil.  INFO is ignored.  This function ignores
 139 keywords targeted at other export back-ends."
 140   (let ((key (org-element-property :key keyword)))
 141     (unless (or (member key
 142                         (mapcar
 143                          (lambda (block-cons)
 144                            (and (eq (cdr block-cons)
 145                                     'org-element-export-block-parser)
 146                                 (car block-cons)))
 147                          org-element-block-name-alist))
 148                 (member key
 149                         '("AUTHOR" "CREATOR" "DATE" "DESCRIPTION" "EMAIL"
 150                           "KEYWORDS" "TITLE")))
 151       (org-element-keyword-interpreter keyword nil))))
 152
 153 (defun org-org-template (contents info)
 154   "Return Org document template with document keywords.
 155 CONTENTS is the transcoded contents string.  INFO is a plist used
 156 as a communication channel."
 157   (concat
 158    (and (plist-get info :time-stamp-file)
 159         (format-time-string "# Created %Y-%m-%d %a %H:%M\n"))
 160    (format "#+TITLE: %s\n" (org-export-data (plist-get info :title) info))
 161    (and (plist-get info :with-date)
 162         (let ((date (org-export-data (org-export-get-date info) info)))
 163           (and (org-string-nw-p date)
 164                (format "#+DATE: %s\n" date))))
 165    (and (plist-get info :with-author)
 166         (let ((author (org-export-data (plist-get info :author) info)))
 167           (and (org-string-nw-p author)
 168                (format "#+AUTHOR: %s\n" author))))
 169    (and (plist-get info :with-email)
 170         (let ((email (org-export-data (plist-get info :email) info)))
 171           (and (org-string-nw-p email)
 172                (format "#+EMAIL: %s\n" email))))
 173    (and (eq (plist-get info :with-creator) t)
 174         (org-string-nw-p (plist-get info :creator))
 175         (format "#+CREATOR: %s\n" (plist-get info :creator)))
 176    (and (org-string-nw-p (plist-get info :keywords))
 177         (format "#+KEYWORDS: %s\n" (plist-get info :keywords)))
 178    (and (org-string-nw-p (plist-get info :description))
 179         (format "#+DESCRIPTION: %s\n" (plist-get info :description)))
 180    contents
 181    (and (eq (plist-get info :with-creator) 'comment)
 182         (org-string-nw-p (plist-get info :creator))
 183         (format "\n# %s\n" (plist-get info :creator)))))
 184
 185 ;;;###autoload
 186 (defun org-org-export-as-org
 187   (&optional async subtreep visible-only body-only ext-plist)
 188   "Export current buffer to an Org buffer.
 189
 190 If narrowing is active in the current buffer, only export its
 191 narrowed part.
 192
 193 If a region is active, export that region.
 194
 195 A non-nil optional argument ASYNC means the process should happen
 196 asynchronously.  The resulting buffer should be accessible
 197 through the `org-export-stack' interface.
 198
 199 When optional argument SUBTREEP is non-nil, export the sub-tree
 200 at point, extracting information from the headline properties
 201 first.
 202
 203 When optional argument VISIBLE-ONLY is non-nil, don't export
 204 contents of hidden elements.
 205
 206 When optional argument BODY-ONLY is non-nil, strip document
 207 keywords from output.
 208
 209 EXT-PLIST, when provided, is a property list with external
 210 parameters overriding Org default settings, but still inferior to
 211 file-local settings.
 212
 213 Export is done in a buffer named \"*Org ORG Export*\", which will
 214 be displayed when `org-export-show-temporary-export-buffer' is
 215 non-nil."
 216   (interactive)
 217   (org-export-to-buffer 'org "*Org ORG Export*"
 218     async subtreep visible-only body-only ext-plist (lambda () (org-mode))))
 219
 220 ;;;###autoload
 221 (defun org-org-export-to-org
 222   (&optional async subtreep visible-only body-only ext-plist)
 223   "Export current buffer to an org file.
 224
 225 If narrowing is active in the current buffer, only export its
 226 narrowed part.
 227
 228 If a region is active, export that region.
 229
 230 A non-nil optional argument ASYNC means the process should happen
 231 asynchronously.  The resulting file should be accessible through
 232 the `org-export-stack' interface.
 233
 234 When optional argument SUBTREEP is non-nil, export the sub-tree
 235 at point, extracting information from the headline properties
 236 first.
 237
 238 When optional argument VISIBLE-ONLY is non-nil, don't export
 239 contents of hidden elements.
 240
 241 When optional argument BODY-ONLY is non-nil, strip document
 242 keywords from output.
 243
 244 EXT-PLIST, when provided, is a property list with external
 245 parameters overriding Org default settings, but still inferior to
 246 file-local settings.
 247
 248 Return output file name."
 249   (interactive)
 250   (let ((outfile (org-export-output-file-name ".org" subtreep)))
 251     (org-export-to-file 'org outfile
 252       async subtreep visible-only body-only ext-plist)))
 253
 254 ;;;###autoload
 255 (defun org-org-publish-to-org (plist filename pub-dir)
 256   "Publish an org file to org.
 257
 258 FILENAME is the filename of the Org file to be published.  PLIST
 259 is the property list for the given project.  PUB-DIR is the
 260 publishing directory.
 261
 262 Return output file name."
 263   (org-publish-org-to 'org filename ".org" plist pub-dir)
 264   (when (plist-get plist :htmlized-source)
 265     (require 'htmlize)
 266     (require 'ox-html)
 267     (let* ((org-inhibit-startup t)
 268            (htmlize-output-type 'css)
 269            (html-ext (concat "." (or (plist-get plist :html-extension)
 270                                      org-html-extension "html")))
 271            (visitingp (find-buffer-visiting filename))
 272            (work-buffer (or visitingp (find-file filename)))
 273            newbuf)
 274       (font-lock-fontify-buffer)
 275       (show-all)
 276       (org-show-block-all)
 277       (setq newbuf (htmlize-buffer))
 278       (with-current-buffer newbuf
 279         (when org-org-htmlized-css-url
 280           (goto-char (point-min))
 281           (and (re-search-forward
 282                 "<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*" nil t)
 283                (replace-match
 284                 (format
 285                  "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
 286                  org-org-htmlized-css-url) t t)))
 287         (write-file (concat pub-dir (file-name-nondirectory filename) html-ext)))
 288       (kill-buffer newbuf)
 289       (unless visitingp (kill-buffer work-buffer)))
 290     (set-buffer-modified-p nil)))
 291
 292
 293 (provide 'ox-org)
 294
 295 ;; Local variables:
 296 ;; generated-autoload-file: "org-loaddefs.el"
 297 ;; End:
 298
 299 ;;; ox-org.el ends here