lisp/ox-org.el

   1 ;;; ox-org.el --- Org Back-End for Org Export Engine -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2013-2016 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 "ext:htmlize" (&optional buffer))
  29 (defvar htmlize-output-type)
  30
  31 (defgroup org-export-org nil
  32   "Options for exporting Org mode files to Org."
  33   :tag "Org Export Org"
  34   :group 'org-export
  35   :version "24.4"
  36   :package-version '(Org . "8.0"))
  37
  38 (define-obsolete-variable-alias
  39   'org-export-htmlized-org-css-url 'org-org-htmlized-css-url "24.4")
  40 (defcustom org-org-htmlized-css-url nil
  41   "URL pointing to the CSS defining colors for htmlized Emacs buffers.
  42 Normally when creating an htmlized version of an Org buffer,
  43 htmlize will create the CSS to define the font colors.  However,
  44 this does not work when converting in batch mode, and it also can
  45 look bad if different people with different fontification setup
  46 work on the same website.  When this variable is non-nil,
  47 creating an htmlized version of an Org buffer using
  48 `org-org-export-as-org' will include a link to this URL if the
  49 setting of `org-html-htmlize-output-type' is `css'."
  50   :group 'org-export-org
  51   :type '(choice
  52           (const :tag "Don't include external stylesheet link" nil)
  53           (string :tag "URL or local href")))
  54
  55 (org-export-define-backend 'org
  56   '((babel-call . org-org-identity)
  57     (bold . org-org-identity)
  58     (center-block . org-org-identity)
  59     (clock . org-org-identity)
  60     (code . org-org-identity)
  61     (diary-sexp . org-org-identity)
  62     (drawer . org-org-identity)
  63     (dynamic-block . org-org-identity)
  64     (entity . org-org-identity)
  65     (example-block . org-org-identity)
  66     (export-block . org-org-export-block)
  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-link)
  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   :menu-entry
 106   '(?O "Export to Org"
 107        ((?O "As Org buffer" org-org-export-as-org)
 108         (?o "As Org file" org-org-export-to-org)
 109         (?v "As Org file and open"
 110             (lambda (a s v b)
 111               (if a (org-org-export-to-org t s v b)
 112                 (org-open-file (org-org-export-to-org nil s v b))))))))
 113
 114 (defun org-org-export-block (export-block _contents _info)
 115   "Transcode a EXPORT-BLOCK element from Org to LaTeX.
 116 CONTENTS and INFO are ignored."
 117   (and (equal (org-element-property :type export-block) "ORG")
 118        (org-element-property :value export-block)))
 119
 120 (defun org-org-identity (blob contents _info)
 121   "Transcode BLOB element or object back into Org syntax.
 122 CONTENTS is its contents, as a string or nil.  INFO is ignored."
 123   (let ((case-fold-search t))
 124     (replace-regexp-in-string
 125      "^[ \t]*#\\+ATTR_[-_A-Za-z0-9]+:\\(?: .*\\)?\n" ""
 126      (org-export-expand blob contents t))))
 127
 128 (defun org-org-headline (headline contents info)
 129   "Transcode HEADLINE element back into Org syntax.
 130 CONTENTS is its contents, as a string or nil.  INFO is ignored."
 131   (unless (org-element-property :footnote-section-p headline)
 132     (unless (plist-get info :with-todo-keywords)
 133       (org-element-put-property headline :todo-keyword nil))
 134     (unless (plist-get info :with-tags)
 135       (org-element-put-property headline :tags nil))
 136     (unless (plist-get info :with-priority)
 137       (org-element-put-property headline :priority nil))
 138     (org-element-put-property headline :level
 139                               (org-export-get-relative-level headline info))
 140     (org-element-headline-interpreter headline contents)))
 141
 142 (defun org-org-keyword (keyword _contents _info)
 143   "Transcode KEYWORD element back into Org syntax.
 144 CONTENTS is nil.  INFO is ignored."
 145   (let ((key (org-element-property :key keyword)))
 146     (unless (member key
 147                     '("AUTHOR" "CREATOR" "DATE" "EMAIL" "OPTIONS" "TITLE"))
 148       (org-element-keyword-interpreter keyword nil))))
 149
 150 (defun org-org-link (link contents _info)
 151   "Transcode LINK object back into Org syntax.
 152 CONTENTS is the description of the link, as a string, or nil.
 153 INFO is a plist containing current export state."
 154   (or (org-export-custom-protocol-maybe link contents 'org)
 155       (org-element-link-interpreter link contents)))
 156
 157 (defun org-org-template (contents info)
 158   "Return Org document template with document keywords.
 159 CONTENTS is the transcoded contents string.  INFO is a plist used
 160 as a communication channel."
 161   (concat
 162    (and (plist-get info :time-stamp-file)
 163         (format-time-string "# Created %Y-%m-%d %a %H:%M\n"))
 164    (org-element-normalize-string
 165     (mapconcat #'identity
 166                (org-element-map (plist-get info :parse-tree) 'keyword
 167                  (lambda (k)
 168                    (and (string-equal (org-element-property :key k) "OPTIONS")
 169                         (concat "#+OPTIONS: "
 170                                 (org-element-property :value k)))))
 171                "\n"))
 172    (and (plist-get info :with-title)
 173         (format "#+TITLE: %s\n" (org-export-data (plist-get info :title) info)))
 174    (and (plist-get info :with-date)
 175         (let ((date (org-export-data (org-export-get-date info) info)))
 176           (and (org-string-nw-p date)
 177                (format "#+DATE: %s\n" date))))
 178    (and (plist-get info :with-author)
 179         (let ((author (org-export-data (plist-get info :author) info)))
 180           (and (org-string-nw-p author)
 181                (format "#+AUTHOR: %s\n" author))))
 182    (and (plist-get info :with-email)
 183         (let ((email (org-export-data (plist-get info :email) info)))
 184           (and (org-string-nw-p email)
 185                (format "#+EMAIL: %s\n" email))))
 186    (and (plist-get info :with-creator)
 187         (org-string-nw-p (plist-get info :creator))
 188         (format "#+CREATOR: %s\n" (plist-get info :creator)))
 189    contents))
 190
 191 (defun org-org-section (section contents info)
 192   "Transcode SECTION element back into Org syntax.
 193 CONTENTS is the contents of the section.  INFO is a plist used as
 194 a communication channel."
 195   (concat
 196    (org-element-normalize-string contents)
 197    ;; Insert footnote definitions appearing for the first time in this
 198    ;; section.  Indeed, some of them may not be available to narrowing
 199    ;; so we make sure all of them are included in the result.
 200    (let ((footnotes-alist
 201           (org-element-map section 'footnote-reference
 202             (lambda (fn)
 203               (and (eq (org-element-property :type fn) 'standard)
 204                    (org-export-footnote-first-reference-p fn info)
 205                    (cons (org-element-property :label fn)
 206                          (org-export-get-footnote-definition fn info))))
 207             info)))
 208      (and footnotes-alist
 209           (concat "\n"
 210                   (mapconcat
 211                    (lambda (d)
 212                      (org-element-normalize-string
 213                       (concat (format "[fn:%s] "(car d))
 214                               (org-export-data (cdr d) info))))
 215                    footnotes-alist "\n"))))
 216    (make-string (or (org-element-property :post-blank section) 0) ?\n)))
 217
 218 ;;;###autoload
 219 (defun org-org-export-as-org
 220   (&optional async subtreep visible-only body-only ext-plist)
 221   "Export current buffer to an Org buffer.
 222
 223 If narrowing is active in the current buffer, only export its
 224 narrowed part.
 225
 226 If a region is active, export that region.
 227
 228 A non-nil optional argument ASYNC means the process should happen
 229 asynchronously.  The resulting buffer should be accessible
 230 through the `org-export-stack' interface.
 231
 232 When optional argument SUBTREEP is non-nil, export the sub-tree
 233 at point, extracting information from the headline properties
 234 first.
 235
 236 When optional argument VISIBLE-ONLY is non-nil, don't export
 237 contents of hidden elements.
 238
 239 When optional argument BODY-ONLY is non-nil, strip document
 240 keywords from output.
 241
 242 EXT-PLIST, when provided, is a property list with external
 243 parameters overriding Org default settings, but still inferior to
 244 file-local settings.
 245
 246 Export is done in a buffer named \"*Org ORG Export*\", which will
 247 be displayed when `org-export-show-temporary-export-buffer' is
 248 non-nil."
 249   (interactive)
 250   (org-export-to-buffer 'org "*Org ORG Export*"
 251     async subtreep visible-only body-only ext-plist (lambda () (org-mode))))
 252
 253 ;;;###autoload
 254 (defun org-org-export-to-org
 255   (&optional async subtreep visible-only body-only ext-plist)
 256   "Export current buffer to an org file.
 257
 258 If narrowing is active in the current buffer, only export its
 259 narrowed part.
 260
 261 If a region is active, export that region.
 262
 263 A non-nil optional argument ASYNC means the process should happen
 264 asynchronously.  The resulting file should be accessible through
 265 the `org-export-stack' interface.
 266
 267 When optional argument SUBTREEP is non-nil, export the sub-tree
 268 at point, extracting information from the headline properties
 269 first.
 270
 271 When optional argument VISIBLE-ONLY is non-nil, don't export
 272 contents of hidden elements.
 273
 274 When optional argument BODY-ONLY is non-nil, strip document
 275 keywords from output.
 276
 277 EXT-PLIST, when provided, is a property list with external
 278 parameters overriding Org default settings, but still inferior to
 279 file-local settings.
 280
 281 Return output file name."
 282   (interactive)
 283   (let ((outfile (org-export-output-file-name ".org" subtreep)))
 284     (org-export-to-file 'org outfile
 285       async subtreep visible-only body-only ext-plist)))
 286
 287 ;;;###autoload
 288 (defun org-org-publish-to-org (plist filename pub-dir)
 289   "Publish an org file to org.
 290
 291 FILENAME is the filename of the Org file to be published.  PLIST
 292 is the property list for the given project.  PUB-DIR is the
 293 publishing directory.
 294
 295 Return output file name."
 296   (org-publish-org-to 'org filename ".org" plist pub-dir)
 297   (when (plist-get plist :htmlized-source)
 298     (require 'htmlize)
 299     (require 'ox-html)
 300     (let* ((org-inhibit-startup t)
 301            (htmlize-output-type 'css)
 302            (html-ext (concat "." (or (plist-get plist :html-extension)
 303                                      org-html-extension "html")))
 304            (visitingp (find-buffer-visiting filename))
 305            (work-buffer (or visitingp (find-file-noselect filename)))
 306            newbuf)
 307       (with-current-buffer work-buffer
 308         (org-font-lock-ensure)
 309         (outline-show-all)
 310         (org-show-block-all)
 311         (setq newbuf (htmlize-buffer)))
 312       (with-current-buffer newbuf
 313         (when org-org-htmlized-css-url
 314           (goto-char (point-min))
 315           (and (re-search-forward
 316                 "<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*" nil t)
 317                (replace-match
 318                 (format
 319                  "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
 320                  org-org-htmlized-css-url)
 321                 t t)))
 322         (write-file (concat pub-dir (file-name-nondirectory filename) html-ext)))
 323       (kill-buffer newbuf)
 324       (unless visitingp (kill-buffer work-buffer)))
 325     ;; FIXME: Why?  Which buffer is this supposed to apply to?
 326     (set-buffer-modified-p nil)))
 327
 328
 329 (provide 'ox-org)
 330
 331 ;; Local variables:
 332 ;; generated-autoload-file: "org-loaddefs.el"
 333 ;; End:
 334
 335 ;;; ox-org.el ends here