1;;; ox-org.el --- Org Back-End for Org Export Engine -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2013-2021 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 <https://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.
40Normally when creating an htmlized version of an Org buffer,
41htmlize will create the CSS to define the font colors.  However,
42this does not work when converting in batch mode, and it also can
43look bad if different people with different fontification setup
44work on the same website.  When this variable is non-nil,
45creating an htmlized version of an Org buffer using
46`org-org-export-as-org' will include a link to this URL if the
47setting 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-timestamp)
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  :filters-alist '((:filter-parse-tree . org-org--add-missing-sections)))
112
113(defun org-org--add-missing-sections (tree _backend _info)
114  "Ensure each headline has an associated section.
115
116TREE is the parse tree being exported.
117
118Footnotes relative to the headline are inserted in the section,
119using `org-org-section'.  However, this function is not called if
120the headline doesn't contain any section in the first place, so
121we make sure it is always called."
122  (org-element-map tree 'headline
123    (lambda (h)
124      (let ((first-child (car (org-element-contents h)))
125	    (new-section (org-element-create 'section)))
126	(pcase (org-element-type first-child)
127	  (`section nil)
128	  (`nil (org-element-adopt-elements h new-section))
129	  (_ (org-element-insert-before new-section first-child))))))
130  tree)
131
132(defun org-org-export-block (export-block _contents _info)
133  "Transcode a EXPORT-BLOCK element from Org to LaTeX.
134CONTENTS and INFO are ignored."
135  (and (equal (org-element-property :type export-block) "ORG")
136       (org-element-property :value export-block)))
137
138(defun org-org-identity (blob contents _info)
139  "Transcode BLOB element or object back into Org syntax.
140CONTENTS is its contents, as a string or nil.  INFO is ignored."
141  (let ((case-fold-search t))
142    (replace-regexp-in-string
143     "^[ \t]*#\\+ATTR_[-_A-Za-z0-9]+:\\(?: .*\\)?\n" ""
144     (org-export-expand blob contents t))))
145
146(defun org-org-headline (headline contents info)
147  "Transcode HEADLINE element back into Org syntax.
148CONTENTS is its contents, as a string or nil.  INFO is ignored."
149  (unless (org-element-property :footnote-section-p headline)
150    (unless (plist-get info :with-todo-keywords)
151      (org-element-put-property headline :todo-keyword nil))
152    (unless (plist-get info :with-tags)
153      (org-element-put-property headline :tags nil))
154    (unless (plist-get info :with-priority)
155      (org-element-put-property headline :priority nil))
156    (org-element-put-property headline :level
157			      (org-export-get-relative-level headline info))
158    (org-element-headline-interpreter headline contents)))
159
160(defun org-org-keyword (keyword _contents _info)
161  "Transcode KEYWORD element back into Org syntax.
162CONTENTS is nil.  INFO is ignored."
163  (let ((key (org-element-property :key keyword)))
164    (unless (member key
165		    '("AUTHOR" "CREATOR" "DATE" "EMAIL" "OPTIONS" "TITLE"))
166      (org-element-keyword-interpreter keyword nil))))
167
168(defun org-org-link (link contents info)
169  "Transcode LINK object back into Org syntax.
170CONTENTS is the description of the link, as a string, or nil.
171INFO is a plist containing current export state."
172  (or (org-export-custom-protocol-maybe link contents 'org info)
173      (org-element-link-interpreter link contents)))
174
175(defun org-org-template (contents info)
176  "Return Org document template with document keywords.
177CONTENTS is the transcoded contents string.  INFO is a plist used
178as a communication channel."
179  (concat
180   (and (plist-get info :time-stamp-file)
181	(format-time-string "# Created %Y-%m-%d %a %H:%M\n"))
182   (org-element-normalize-string
183    (mapconcat #'identity
184	       (org-element-map (plist-get info :parse-tree) 'keyword
185		 (lambda (k)
186		   (and (string-equal (org-element-property :key k) "OPTIONS")
187			(concat "#+OPTIONS: "
188				(org-element-property :value k)))))
189	       "\n"))
190   (and (plist-get info :with-title)
191	(format "#+TITLE: %s\n" (org-export-data (plist-get info :title) info)))
192   (and (plist-get info :with-date)
193	(let ((date (org-export-data (org-export-get-date info) info)))
194	  (and (org-string-nw-p date)
195	       (format "#+DATE: %s\n" date))))
196   (and (plist-get info :with-author)
197	(let ((author (org-export-data (plist-get info :author) info)))
198	  (and (org-string-nw-p author)
199	       (format "#+AUTHOR: %s\n" author))))
200   (and (plist-get info :with-email)
201	(let ((email (org-export-data (plist-get info :email) info)))
202	  (and (org-string-nw-p email)
203	       (format "#+EMAIL: %s\n" email))))
204   (and (plist-get info :with-creator)
205	(org-string-nw-p (plist-get info :creator))
206	(format "#+CREATOR: %s\n" (plist-get info :creator)))
207   contents))
208
209(defun org-org-timestamp (timestamp _contents _info)
210  "Transcode a TIMESTAMP object to custom format or back into Org syntax."
211  (org-timestamp-translate timestamp))
212
213(defun org-org-section (section contents info)
214  "Transcode SECTION element back into Org syntax.
215CONTENTS is the contents of the section.  INFO is a plist used as
216a communication channel."
217  (concat
218   (org-element-normalize-string contents)
219   ;; Insert footnote definitions appearing for the first time in this
220   ;; section, or in the relative headline title.  Indeed, some of
221   ;; them may not be available to narrowing so we make sure all of
222   ;; them are included in the result.
223   (let ((footnotes
224	  (org-element-map
225	      (list (org-export-get-parent-headline section) section)
226	      'footnote-reference
227	    (lambda (fn)
228	      (and (eq (org-element-property :type fn) 'standard)
229		   (org-export-footnote-first-reference-p fn info)
230		   (org-element-normalize-string
231		    (format "[fn:%s] %s"
232			    (org-element-property :label fn)
233			    (org-export-data
234			     (org-export-get-footnote-definition fn info)
235			     info)))))
236	    info nil 'headline t)))
237     (and footnotes (concat "\n" (mapconcat #'identity footnotes "\n"))))))
238
239;;;###autoload
240(defun org-org-export-as-org
241  (&optional async subtreep visible-only body-only ext-plist)
242  "Export current buffer to an Org buffer.
243
244If narrowing is active in the current buffer, only export its
245narrowed part.
246
247If a region is active, export that region.
248
249A non-nil optional argument ASYNC means the process should happen
250asynchronously.  The resulting buffer should be accessible
251through the `org-export-stack' interface.
252
253When optional argument SUBTREEP is non-nil, export the sub-tree
254at point, extracting information from the headline properties
255first.
256
257When optional argument VISIBLE-ONLY is non-nil, don't export
258contents of hidden elements.
259
260When optional argument BODY-ONLY is non-nil, strip document
261keywords from output.
262
263EXT-PLIST, when provided, is a property list with external
264parameters overriding Org default settings, but still inferior to
265file-local settings.
266
267Export is done in a buffer named \"*Org ORG Export*\", which will
268be displayed when `org-export-show-temporary-export-buffer' is
269non-nil."
270  (interactive)
271  (org-export-to-buffer 'org "*Org ORG Export*"
272    async subtreep visible-only body-only ext-plist (lambda () (org-mode))))
273
274;;;###autoload
275(defun org-org-export-to-org
276  (&optional async subtreep visible-only body-only ext-plist)
277  "Export current buffer to an Org file.
278
279If narrowing is active in the current buffer, only export its
280narrowed part.
281
282If a region is active, export that region.
283
284A non-nil optional argument ASYNC means the process should happen
285asynchronously.  The resulting file should be accessible through
286the `org-export-stack' interface.
287
288When optional argument SUBTREEP is non-nil, export the sub-tree
289at point, extracting information from the headline properties
290first.
291
292When optional argument VISIBLE-ONLY is non-nil, don't export
293contents of hidden elements.
294
295When optional argument BODY-ONLY is non-nil, strip document
296keywords from output.
297
298EXT-PLIST, when provided, is a property list with external
299parameters overriding Org default settings, but still inferior to
300file-local settings.
301
302Return output file name."
303  (interactive)
304  (let ((outfile (org-export-output-file-name ".org" subtreep)))
305    (org-export-to-file 'org outfile
306      async subtreep visible-only body-only ext-plist)))
307
308;;;###autoload
309(defun org-org-publish-to-org (plist filename pub-dir)
310  "Publish an Org file to Org.
311
312FILENAME is the filename of the Org file to be published.  PLIST
313is the property list for the given project.  PUB-DIR is the
314publishing directory.
315
316Return output file name."
317  (org-publish-org-to 'org filename ".org" plist pub-dir)
318  (when (plist-get plist :htmlized-source)
319    (or (require 'htmlize nil t)
320	(error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
321    (require 'ox-html)
322    (let* ((org-inhibit-startup t)
323	   (htmlize-output-type 'css)
324	   (html-ext (concat "." (or (plist-get plist :html-extension)
325				     org-html-extension "html")))
326	   (visitingp (find-buffer-visiting filename))
327	   (work-buffer (or visitingp (find-file-noselect filename)))
328	   newbuf)
329      (with-current-buffer work-buffer
330        (org-font-lock-ensure)
331        (org-show-all)
332        (setq newbuf (htmlize-buffer)))
333      (with-current-buffer newbuf
334	(when org-org-htmlized-css-url
335	  (goto-char (point-min))
336	  (and (re-search-forward
337		"<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*" nil t)
338	       (replace-match
339		(format
340		 "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">"
341		 org-org-htmlized-css-url)
342                t t)))
343	(write-file (concat pub-dir (file-name-nondirectory filename) html-ext)))
344      (kill-buffer newbuf)
345      (unless visitingp (kill-buffer work-buffer)))
346    ;; FIXME: Why?  Which buffer is this supposed to apply to?
347    (set-buffer-modified-p nil)))
348
349
350(provide 'ox-org)
351
352;; Local variables:
353;; generated-autoload-file: "org-loaddefs.el"
354;; End:
355
356;;; ox-org.el ends here
357