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 "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     (fixed-width . org-org-identity)
  67     (footnote-definition . ignore)
  68     (footnote-reference . org-org-identity)
  69     (headline . org-org-headline)
  70     (horizontal-rule . org-org-identity)
  71     (inline-babel-call . org-org-identity)
  72     (inline-src-block . org-org-identity)
  73     (inlinetask . org-org-identity)
  74     (italic . org-org-identity)
  75     (item . org-org-identity)
  76     (keyword . org-org-keyword)
  77     (latex-environment . org-org-identity)
  78     (latex-fragment . org-org-identity)
  79     (line-break . org-org-identity)
  80     (link . org-org-link)
  81     (node-property . org-org-identity)
  82     (template . org-org-template)
  83     (paragraph . org-org-identity)
  84     (plain-list . org-org-identity)
  85     (planning . org-org-identity)
  86     (property-drawer . org-org-identity)
  87     (quote-block . org-org-identity)
  88     (radio-target . org-org-identity)
  89     (section . org-org-section)
  90     (special-block . org-org-identity)
  91     (src-block . org-org-identity)
  92     (statistics-cookie . org-org-identity)
  93     (strike-through . org-org-identity)
  94     (subscript . org-org-identity)
  95     (superscript . org-org-identity)
  96     (table . org-org-identity)
  97     (table-cell . org-org-identity)
  98     (table-row . org-org-identity)
  99     (target . org-org-identity)
 100     (timestamp . org-org-identity)
 101     (underline . org-org-identity)
 102     (verbatim . org-org-identity)
 103     (verse-block . org-org-identity))
 104   :menu-entry
 105   '(?O "Export to Org"
 106        ((?O "As Org buffer" org-org-export-as-org)
 107         (?o "As Org file" org-org-export-to-org)
 108         (?v "As Org file and open"
 109             (lambda (a s v b)
 110               (if a (org-org-export-to-org t s v b)
 111                 (org-open-file (org-org-export-to-org nil s v b))))))))
 112
 113 (defun org-org-identity (blob contents _info)
 114   "Transcode BLOB element or object back into Org syntax.
 115 CONTENTS is its contents, as a string or nil.  INFO is ignored."
 116   (let ((case-fold-search t))
 117     (replace-regexp-in-string
 118      "^[ \t]*#\\+ATTR_[-_A-Za-z0-9]+:\\(?: .*\\)?\n" ""
 119      (org-export-expand blob contents t))))
 120
 121 (defun org-org-headline (headline contents info)
 122   "Transcode HEADLINE element back into Org syntax.
 123 CONTENTS is its contents, as a string or nil.  INFO is ignored."
 124   (unless (org-element-property :footnote-section-p headline)
 125     (unless (plist-get info :with-todo-keywords)
 126       (org-element-put-property headline :todo-keyword nil))
 127     (unless (plist-get info :with-tags)
 128       (org-element-put-property headline :tags nil))
 129     (unless (plist-get info :with-priority)
 130       (org-element-put-property headline :priority nil))
 131     (org-element-put-property headline :level
 132                               (org-export-get-relative-level headline info))
 133     (org-element-headline-interpreter headline contents)))
 134
 135 (defun org-org-keyword (keyword _contents _info)
 136   "Transcode KEYWORD element back into Org syntax.
 137 CONTENTS is nil.  INFO is ignored."
 138   (let ((key (org-element-property :key keyword)))
 139     (unless (member key
 140                     '("AUTHOR" "CREATOR" "DATE" "EMAIL" "OPTIONS" "TITLE"))
 141       (org-element-keyword-interpreter keyword nil))))
 142
 143 (defun org-org-link (link contents _info)
 144   "Transcode LINK object back into Org syntax.
 145 CONTENTS is the description of the link, as a string, or nil.
 146 INFO is a plist containing current export state."
 147   (or (org-export-custom-protocol-maybe link contents 'org)
 148       (org-element-link-interpreter link contents)))
 149
 150 (defun org-org-template (contents info)
 151   "Return Org document template with document keywords.
 152 CONTENTS is the transcoded contents string.  INFO is a plist used
 153 as a communication channel."
 154   (concat
 155    (and (plist-get info :time-stamp-file)
 156         (format-time-string "# Created %Y-%m-%d %a %H:%M\n"))
 157    (org-element-normalize-string
 158     (mapconcat #'identity
 159                (org-element-map (plist-get info :parse-tree) 'keyword
 160                  (lambda (k)
 161                    (and (string-equal (org-element-property :key k) "OPTIONS")
 162                         (concat "#+OPTIONS: "
 163                                 (org-element-property :value k)))))
 164                "\n"))
 165    (and (plist-get info :with-title)
 166         (format "#+TITLE: %s\n" (org-export-data (plist-get info :title) info)))
 167    (and (plist-get info :with-date)
 168         (let ((date (org-export-data (org-export-get-date info) info)))
 169           (and (org-string-nw-p date)
 170                (format "#+DATE: %s\n" date))))
 171    (and (plist-get info :with-author)
 172         (let ((author (org-export-data (plist-get info :author) info)))
 173           (and (org-string-nw-p author)
 174                (format "#+AUTHOR: %s\n" author))))
 175    (and (plist-get info :with-email)
 176         (let ((email (org-export-data (plist-get info :email) info)))
 177           (and (org-string-nw-p email)
 178                (format "#+EMAIL: %s\n" email))))
 179    (and (plist-get info :with-creator)
 180         (org-string-nw-p (plist-get info :creator))
 181         (format "#+CREATOR: %s\n" (plist-get info :creator)))
 182    contents))
 183
 184 (defun org-org-section (section contents info)
 185   "Transcode SECTION element back into Org syntax.
 186 CONTENTS is the contents of the section.  INFO is a plist used as
 187 a communication channel."
 188   (concat
 189    (org-element-normalize-string contents)
 190    ;; Insert footnote definitions appearing for the first time in this
 191    ;; section.  Indeed, some of them may not be available to narrowing
 192    ;; so we make sure all of them are included in the result.
 193    (let ((footnotes-alist
 194           (org-element-map section 'footnote-reference
 195             (lambda (fn)
 196               (and (eq (org-element-property :type fn) 'standard)
 197                    (org-export-footnote-first-reference-p fn info)
 198                    (cons (org-element-property :label fn)
 199                          (org-export-get-footnote-definition fn info))))
 200             info)))
 201      (and footnotes-alist
 202           (concat "\n"
 203                   (mapconcat
 204                    (lambda (d)
 205                      (org-element-normalize-string
 206                       (concat (format "[%s] "(car d))
 207                               (org-export-data (cdr d) info))))
 208                    footnotes-alist "\n"))))
 209    (make-string (or (org-element-property :post-blank section) 0) ?\n)))
 210
 211 ;;;###autoload
 212 (defun org-org-export-as-org
 213   (&optional async subtreep visible-only body-only ext-plist)
 214   "Export current buffer to an Org buffer.
 215
 216 If narrowing is active in the current buffer, only export its
 217 narrowed part.
 218
 219 If a region is active, export that region.
 220
 221 A non-nil optional argument ASYNC means the process should happen
 222 asynchronously.  The resulting buffer should be accessible
 223 through the `org-export-stack' interface.
 224
 225 When optional argument SUBTREEP is non-nil, export the sub-tree
 226 at point, extracting information from the headline properties
 227 first.
 228
 229 When optional argument VISIBLE-ONLY is non-nil, don't export
 230 contents of hidden elements.
 231
 232 When optional argument BODY-ONLY is non-nil, strip document
 233 keywords from output.
 234
 235 EXT-PLIST, when provided, is a property list with external
 236 parameters overriding Org default settings, but still inferior to
 237 file-local settings.
 238
 239 Export is done in a buffer named \"*Org ORG Export*\", which will
 240 be displayed when `org-export-show-temporary-export-buffer' is
 241 non-nil."
 242   (interactive)
 243   (org-export-to-buffer 'org "*Org ORG Export*"
 244     async subtreep visible-only body-only ext-plist (lambda () (org-mode))))
 245
 246 ;;;###autoload
 247 (defun org-org-export-to-org
 248   (&optional async subtreep visible-only body-only ext-plist)
 249   "Export current buffer to an org file.
 250
 251 If narrowing is active in the current buffer, only export its
 252 narrowed part.
 253
 254 If a region is active, export that region.
 255
 256 A non-nil optional argument ASYNC means the process should happen
 257 asynchronously.  The resulting file should be accessible through
 258 the `org-export-stack' interface.
 259
 260 When optional argument SUBTREEP is non-nil, export the sub-tree
 261 at point, extracting information from the headline properties
 262 first.
 263
 264 When optional argument VISIBLE-ONLY is non-nil, don't export
 265 contents of hidden elements.
 266
 267 When optional argument BODY-ONLY is non-nil, strip document
 268 keywords from output.
 269
 270 EXT-PLIST, when provided, is a property list with external
 271 parameters overriding Org default settings, but still inferior to
 272 file-local settings.
 273
 274 Return output file name."
 275   (interactive)
 276   (let ((outfile (org-export-output-file-name ".org" subtreep)))
 277     (org-export-to-file 'org outfile
 278       async subtreep visible-only body-only ext-plist)))
 279
 280 ;;;###autoload
 281 (defun org-org-publish-to-org (plist filename pub-dir)
 282   "Publish an org file to org.
 283
 284 FILENAME is the filename of the Org file to be published.  PLIST
 285 is the property list for the given project.  PUB-DIR is the
 286 publishing directory.
 287
 288 Return output file name."
 289   (org-publish-org-to 'org filename ".org" plist pub-dir)
 290   (when (plist-get plist :htmlized-source)
 291     (require 'htmlize)
 292     (require 'ox-html)
 293     (let* ((org-inhibit-startup t)
 294            (htmlize-output-type 'css)
 295            (html-ext (concat "." (or (plist-get plist :html-extension)
 296                                      org-html-extension "html")))
 297            (visitingp (find-buffer-visiting filename))
 298            (work-buffer (or visitingp (find-file-noselect filename)))
 299            newbuf)
 300       (with-current-buffer work-buffer
 301         (org-font-lock-ensure)
 302         (outline-show-all)
 303         (org-show-block-all)
 304         (setq newbuf (htmlize-buffer)))
 305       (with-current-buffer newbuf
 306         (when org-org-htmlized-css-url
 307           (goto-char (point-min))
 308           (and (re-search-forward
 309                 "<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*" nil t)
 310                (replace-match
 311                 (format
 312                  "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
 313                  org-org-htmlized-css-url)
 314                 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     ;; FIXME: Why?  Which buffer is this supposed to apply to?
 319     (set-buffer-modified-p nil)))
 320
 321
 322 (provide 'ox-org)
 323
 324 ;; Local variables:
 325 ;; generated-autoload-file: "org-loaddefs.el"
 326 ;; End:
 327
 328 ;;; ox-org.el ends here