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