]> code.delx.au - gnu-emacs/blob - lisp/org/org-html.el
Restore clobbered changes to Org copyright years.
[gnu-emacs] / lisp / org / org-html.el
1 ;;; org-html.el --- HTML export for Org-mode
2
3 ;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
4
5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
6 ;; Keywords: outlines, hypermedia, calendar, wp
7 ;; Homepage: http://orgmode.org
8 ;; Version: 7.7
9 ;;
10 ;; This file is part of GNU Emacs.
11 ;;
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
16
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
25 ;;
26 ;;; Commentary:
27
28 ;;; Code:
29
30 (require 'org-exp)
31 (require 'format-spec)
32
33 (eval-when-compile (require 'cl))
34
35 (declare-function org-id-find-id-file "org-id" (id))
36 (declare-function htmlize-region "ext:htmlize" (beg end))
37 (declare-function org-pop-to-buffer-same-window
38 "org-compat" (&optional buffer-or-name norecord label))
39
40 (defgroup org-export-html nil
41 "Options specific for HTML export of Org-mode files."
42 :tag "Org Export HTML"
43 :group 'org-export)
44
45 (defcustom org-export-html-footnotes-section "<div id=\"footnotes\">
46 <h2 class=\"footnotes\">%s: </h2>
47 <div id=\"text-footnotes\">
48 %s
49 </div>
50 </div>"
51 "Format for the footnotes section.
52 Should contain a two instances of %s. The first will be replaced with the
53 language-specific word for \"Footnotes\", the second one will be replaced
54 by the footnotes themselves."
55 :group 'org-export-html
56 :type 'string)
57
58 (defcustom org-export-html-footnote-format "<sup>%s</sup>"
59 "The format for the footnote reference.
60 %s will be replaced by the footnote reference itself."
61 :group 'org-export-html
62 :type 'string)
63
64
65 (defcustom org-export-html-footnote-separator "<sup>, </sup>"
66 "Text used to separate footnotes."
67 :group 'org-export-html
68 :type 'string)
69
70 (defcustom org-export-html-coding-system nil
71 "Coding system for HTML export, defaults to `buffer-file-coding-system'."
72 :group 'org-export-html
73 :type 'coding-system)
74
75 (defcustom org-export-html-extension "html"
76 "The extension for exported HTML files."
77 :group 'org-export-html
78 :type 'string)
79
80 (defcustom org-export-html-xml-declaration
81 '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>")
82 ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>"))
83 "The extension for exported HTML files.
84 %s will be replaced with the charset of the exported file.
85 This may be a string, or an alist with export extensions
86 and corresponding declarations."
87 :group 'org-export-html
88 :type '(choice
89 (string :tag "Single declaration")
90 (repeat :tag "Dependent on extension"
91 (cons (string :tag "Extension")
92 (string :tag "Declaration")))))
93
94 (defcustom org-export-html-style-include-scripts t
95 "Non-nil means include the JavaScript snippets in exported HTML files.
96 The actual script is defined in `org-export-html-scripts' and should
97 not be modified."
98 :group 'org-export-html
99 :type 'boolean)
100
101 (defconst org-export-html-scripts
102 "<script type=\"text/javascript\">
103 <!--/*--><![CDATA[/*><!--*/
104 function CodeHighlightOn(elem, id)
105 {
106 var target = document.getElementById(id);
107 if(null != target) {
108 elem.cacheClassElem = elem.className;
109 elem.cacheClassTarget = target.className;
110 target.className = \"code-highlighted\";
111 elem.className = \"code-highlighted\";
112 }
113 }
114 function CodeHighlightOff(elem, id)
115 {
116 var target = document.getElementById(id);
117 if(elem.cacheClassElem)
118 elem.className = elem.cacheClassElem;
119 if(elem.cacheClassTarget)
120 target.className = elem.cacheClassTarget;
121 }
122 /*]]>*///-->
123 </script>"
124 "Basic JavaScript that is needed by HTML files produced by Org-mode.")
125
126 (defconst org-export-html-style-default
127 "<style type=\"text/css\">
128 <!--/*--><![CDATA[/*><!--*/
129 html { font-family: Times, serif; font-size: 12pt; }
130 .title { text-align: center; }
131 .todo { color: red; }
132 .done { color: green; }
133 .tag { background-color: #add8e6; font-weight:normal }
134 .target { }
135 .timestamp { color: #bebebe; }
136 .timestamp-kwd { color: #5f9ea0; }
137 .right {margin-left:auto; margin-right:0px; text-align:right;}
138 .left {margin-left:0px; margin-right:auto; text-align:left;}
139 .center {margin-left:auto; margin-right:auto; text-align:center;}
140 p.verse { margin-left: 3% }
141 pre {
142 border: 1pt solid #AEBDCC;
143 background-color: #F3F5F7;
144 padding: 5pt;
145 font-family: courier, monospace;
146 font-size: 90%;
147 overflow:auto;
148 }
149 table { border-collapse: collapse; }
150 td, th { vertical-align: top; }
151 th.right { text-align:center; }
152 th.left { text-align:center; }
153 th.center { text-align:center; }
154 td.right { text-align:right; }
155 td.left { text-align:left; }
156 td.center { text-align:center; }
157 dt { font-weight: bold; }
158 div.figure { padding: 0.5em; }
159 div.figure p { text-align: center; }
160 textarea { overflow-x: auto; }
161 .linenr { font-size:smaller }
162 .code-highlighted {background-color:#ffff00;}
163 .org-info-js_info-navigation { border-style:none; }
164 #org-info-js_console-label { font-size:10px; font-weight:bold;
165 white-space:nowrap; }
166 .org-info-js_search-highlight {background-color:#ffff00; color:#000000;
167 font-weight:bold; }
168 /*]]>*/-->
169 </style>"
170 "The default style specification for exported HTML files.
171 Please use the variables `org-export-html-style' and
172 `org-export-html-style-extra' to add to this style. If you wish to not
173 have the default style included, customize the variable
174 `org-export-html-style-include-default'.")
175
176 (defcustom org-export-html-style-include-default t
177 "Non-nil means include the default style in exported HTML files.
178 The actual style is defined in `org-export-html-style-default' and should
179 not be modified. Use the variables `org-export-html-style' to add
180 your own style information."
181 :group 'org-export-html
182 :type 'boolean)
183 ;;;###autoload
184 (put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
185
186 (defcustom org-export-html-style ""
187 "Org-wide style definitions for exported HTML files.
188
189 This variable needs to contain the full HTML structure to provide a style,
190 including the surrounding HTML tags. If you set the value of this variable,
191 you should consider to include definitions for the following classes:
192 title, todo, done, timestamp, timestamp-kwd, tag, target.
193
194 For example, a valid value would be:
195
196 <style type=\"text/css\">
197 <![CDATA[
198 p { font-weight: normal; color: gray; }
199 h1 { color: black; }
200 .title { text-align: center; }
201 .todo, .timestamp-kwd { color: red; }
202 .done { color: green; }
203 ]]>
204 </style>
205
206 If you'd like to refer to an external style file, use something like
207
208 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
209
210 As the value of this option simply gets inserted into the HTML <head> header,
211 you can \"misuse\" it to add arbitrary text to the header.
212 See also the variable `org-export-html-style-extra'."
213 :group 'org-export-html
214 :type 'string)
215 ;;;###autoload
216 (put 'org-export-html-style 'safe-local-variable 'stringp)
217
218 (defcustom org-export-html-style-extra ""
219 "Additional style information for HTML export.
220 The value of this variable is inserted into the HTML buffer right after
221 the value of `org-export-html-style'. Use this variable for per-file
222 settings of style information, and do not forget to surround the style
223 settings with <style>...</style> tags."
224 :group 'org-export-html
225 :type 'string)
226 ;;;###autoload
227 (put 'org-export-html-style-extra 'safe-local-variable 'stringp)
228
229 (defcustom org-export-html-mathjax-options
230 '((path "http://orgmode.org/mathjax/MathJax.js")
231 (scale "100")
232 (align "center")
233 (indent "2em")
234 (mathml nil))
235 "Options for MathJax setup.
236
237 path The path where to find MathJax
238 scale Scaling for the HTML-CSS backend, usually between 100 and 133
239 align How to align display math: left, center, or right
240 indent If align is not center, how far from the left/right side?
241 mathml Should a MathML player be used if available?
242 This is faster and reduces bandwidth use, but currently
243 sometimes has lower spacing quality. Therefore, the default is
244 nil. When browsers get better, this switch can be flipped.
245
246 You can also customize this for each buffer, using something like
247
248 #+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\""
249 :group 'org-export-html
250 :type '(list :greedy t
251 (list :tag "path (the path from where to load MathJax.js)"
252 (const :format " " path) (string))
253 (list :tag "scale (scaling for the displayed math)"
254 (const :format " " scale) (string))
255 (list :tag "align (alignment of displayed equations)"
256 (const :format " " align) (string))
257 (list :tag "indent (indentation with left or right alignment)"
258 (const :format " " indent) (string))
259 (list :tag "mathml (should MathML display be used is possible)"
260 (const :format " " mathml) (boolean))))
261
262 (defun org-export-html-mathjax-config (template options in-buffer)
263 "Insert the user setup into the matchjax template."
264 (let (name val (yes " ") (no "// ") x)
265 (mapc
266 (lambda (e)
267 (setq name (car e) val (nth 1 e))
268 (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer)
269 (setq val (car (read-from-string
270 (substring in-buffer (match-end 0))))))
271 (if (not (stringp val)) (setq val (format "%s" val)))
272 (if (string-match (concat "%" (upcase (symbol-name name))) template)
273 (setq template (replace-match val t t template))))
274 options)
275 (setq val (nth 1 (assq 'mathml options)))
276 (if (string-match (concat "\\<mathml:") in-buffer)
277 (setq val (car (read-from-string
278 (substring in-buffer (match-end 0))))))
279 ;; Exchange prefixes depending on mathml setting
280 (if (not val) (setq x yes yes no no x))
281 ;; Replace cookies to turn on or off the config/jax lines
282 (if (string-match ":MMLYES:" template)
283 (setq template (replace-match yes t t template)))
284 (if (string-match ":MMLNO:" template)
285 (setq template (replace-match no t t template)))
286 ;; Return the modified template
287 template))
288
289 (defcustom org-export-html-mathjax-template
290 "<script type=\"text/javascript\" src=\"%PATH\">
291 <!--/*--><![CDATA[/*><!--*/
292 MathJax.Hub.Config({
293 // Only one of the two following lines, depending on user settings
294 // First allows browser-native MathML display, second forces HTML/CSS
295 :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"],
296 :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"],
297 extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\",
298 \"TeX/noUndefined.js\"],
299 tex2jax: {
300 inlineMath: [ [\"\\\\(\",\"\\\\)\"] ],
301 displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"], [\"\\\\begin{displaymath}\",\"\\\\end{displaymath}\"] ],
302 skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"],
303 ignoreClass: \"tex2jax_ignore\",
304 processEscapes: false,
305 processEnvironments: true,
306 preview: \"TeX\"
307 },
308 showProcessingMessages: true,
309 displayAlign: \"%ALIGN\",
310 displayIndent: \"%INDENT\",
311
312 \"HTML-CSS\": {
313 scale: %SCALE,
314 availableFonts: [\"STIX\",\"TeX\"],
315 preferredFont: \"TeX\",
316 webFont: \"TeX\",
317 imageFont: \"TeX\",
318 showMathMenu: true,
319 },
320 MMLorHTML: {
321 prefer: {
322 MSIE: \"MML\",
323 Firefox: \"MML\",
324 Opera: \"HTML\",
325 other: \"HTML\"
326 }
327 }
328 });
329 /*]]>*///-->
330 </script>"
331 "The MathJax setup for XHTML files."
332 :group 'org-export-html
333 :type 'string)
334
335 (defcustom org-export-html-tag-class-prefix ""
336 "Prefix to class names for TODO keywords.
337 Each tag gets a class given by the tag itself, with this prefix.
338 The default prefix is empty because it is nice to just use the keyword
339 as a class name. But if you get into conflicts with other, existing
340 CSS classes, then this prefix can be very useful."
341 :group 'org-export-html
342 :type 'string)
343
344 (defcustom org-export-html-todo-kwd-class-prefix ""
345 "Prefix to class names for TODO keywords.
346 Each TODO keyword gets a class given by the keyword itself, with this prefix.
347 The default prefix is empty because it is nice to just use the keyword
348 as a class name. But if you get into conflicts with other, existing
349 CSS classes, then this prefix can be very useful."
350 :group 'org-export-html
351 :type 'string)
352
353 (defcustom org-export-html-preamble t
354 "Non-nil means insert a preamble in HTML export.
355
356 When `t', insert a string as defined by one of the formatting
357 strings in `org-export-html-preamble-format'. When set to a
358 string, this string overrides `org-export-html-preamble-format'.
359 When set to a function, apply this function and insert the
360 returned string. The function takes the property list of export
361 options as its only argument.
362
363 Setting :html-preamble in publishing projects will take
364 precedence over this variable."
365 :group 'org-export-html
366 :type '(choice (const :tag "No preamble" nil)
367 (const :tag "Default preamble" t)
368 (string :tag "Custom formatting string")
369 (function :tag "Function (must return a string)")))
370
371 (defcustom org-export-html-preamble-format '(("en" ""))
372 "The format for the HTML preamble.
373
374 %t stands for the title.
375 %a stands for the author's name.
376 %e stands for the author's email.
377 %d stands for the date.
378
379 If you need to use a \"%\" character, you need to escape it
380 like that: \"%%\"."
381 :group 'org-export-html
382 :type 'string)
383
384 (defcustom org-export-html-postamble 'auto
385 "Non-nil means insert a postamble in HTML export.
386
387 When `t', insert a string as defined by the formatting string in
388 `org-export-html-postamble-format'. When set to a string, this
389 string overrides `org-export-html-postamble-format'. When set to
390 'auto, discard `org-export-html-postamble-format' and honor
391 `org-export-author/email/creator-info' variables. When set to a
392 function, apply this function and insert the returned string.
393 The function takes the property list of export options as its
394 only argument.
395
396 Setting :html-postamble in publishing projects will take
397 precedence over this variable."
398 :group 'org-export-html
399 :type '(choice (const :tag "No postamble" nil)
400 (const :tag "Auto preamble" 'auto)
401 (const :tag "Default formatting string" t)
402 (string :tag "Custom formatting string")
403 (function :tag "Function (must return a string)")))
404
405 (defcustom org-export-html-postamble-format
406 '(("en" "<p class=\"author\">Author: %a (%e)</p>
407 <p class=\"date\">Date: %d</p>
408 <p class=\"creator\">Generated by %c</p>
409 <p class=\"xhtml-validation\">%v</p>
410 "))
411 "The format for the HTML postamble.
412
413 %a stands for the author's name.
414 %e stands for the author's email.
415 %d stands for the date.
416 %c will be replaced by information about Org/Emacs versions.
417 %v will be replaced by `org-export-html-validation-link'.
418
419 If you need to use a \"%\" character, you need to escape it
420 like that: \"%%\"."
421 :group 'org-export-html
422 :type 'string)
423
424 (defcustom org-export-html-home/up-format
425 "<div id=\"org-div-home-and-up\" style=\"text-align:right;font-size:70%%;white-space:nowrap;\">
426 <a accesskey=\"h\" href=\"%s\"> UP </a>
427 |
428 <a accesskey=\"H\" href=\"%s\"> HOME </a>
429 </div>"
430 "Snippet used to insert the HOME and UP links.
431 This is a format string, the first %s will receive the UP link,
432 the second the HOME link. If both `org-export-html-link-up' and
433 `org-export-html-link-home' are empty, the entire snippet will be
434 ignored."
435 :group 'org-export-html
436 :type 'string)
437
438 (defcustom org-export-html-toplevel-hlevel 2
439 "The <H> level for level 1 headings in HTML export.
440 This is also important for the classes that will be wrapped around headlines
441 and outline structure. If this variable is 1, the top-level headlines will
442 be <h1>, and the corresponding classes will be outline-1, section-number-1,
443 and outline-text-1. If this is 2, all of these will get a 2 instead.
444 The default for this variable is 2, because we use <h1> for formatting the
445 document title."
446 :group 'org-export-html
447 :type 'string)
448
449 (defcustom org-export-html-link-org-files-as-html t
450 "Non-nil means make file links to `file.org' point to `file.html'.
451 When org-mode is exporting an org-mode file to HTML, links to
452 non-html files are directly put into a href tag in HTML.
453 However, links to other Org-mode files (recognized by the
454 extension `.org.) should become links to the corresponding html
455 file, assuming that the linked org-mode file will also be
456 converted to HTML.
457 When nil, the links still point to the plain `.org' file."
458 :group 'org-export-html
459 :type 'boolean)
460
461 (defcustom org-export-html-inline-images 'maybe
462 "Non-nil means inline images into exported HTML pages.
463 This is done using an <img> tag. When nil, an anchor with href is used to
464 link to the image. If this option is `maybe', then images in links with
465 an empty description will be inlined, while images with a description will
466 be linked only."
467 :group 'org-export-html
468 :type '(choice (const :tag "Never" nil)
469 (const :tag "Always" t)
470 (const :tag "When there is no description" maybe)))
471
472 (defcustom org-export-html-inline-image-extensions
473 '("png" "jpeg" "jpg" "gif" "svg")
474 "Extensions of image files that can be inlined into HTML."
475 :group 'org-export-html
476 :type '(repeat (string :tag "Extension")))
477
478 (defcustom org-export-html-table-tag
479 "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">"
480 "The HTML tag that is used to start a table.
481 This must be a <table> tag, but you may change the options like
482 borders and spacing."
483 :group 'org-export-html
484 :type 'string)
485
486 (defcustom org-export-table-header-tags '("<th scope=\"%s\"%s>" . "</th>")
487 "The opening tag for table header fields.
488 This is customizable so that alignment options can be specified.
489 The first %s will be filled with the scope of the field, either row or col.
490 The second %s will be replaced by a style entry to align the field.
491 See also the variable `org-export-html-table-use-header-tags-for-first-column'.
492 See also the variable `org-export-html-table-align-individual-fields'."
493 :group 'org-export-tables
494 :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
495
496 (defcustom org-export-table-data-tags '("<td%s>" . "</td>")
497 "The opening tag for table data fields.
498 This is customizable so that alignment options can be specified.
499 The first %s will be filled with the scope of the field, either row or col.
500 The second %s will be replaced by a style entry to align the field.
501 See also the variable `org-export-html-table-align-individual-fields'."
502 :group 'org-export-tables
503 :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
504
505 (defcustom org-export-table-row-tags '("<tr>" . "</tr>")
506 "The opening tag for table data fields.
507 This is customizable so that alignment options can be specified.
508 Instead of strings, these can be Lisp forms that will be evaluated
509 for each row in order to construct the table row tags. During evaluation,
510 the variable `head' will be true when this is a header line, nil when this
511 is a body line. And the variable `nline' will contain the line number,
512 starting from 1 in the first header line. For example
513
514 (setq org-export-table-row-tags
515 (cons '(if head
516 \"<tr>\"
517 (if (= (mod nline 2) 1)
518 \"<tr class=\\\"tr-odd\\\">\"
519 \"<tr class=\\\"tr-even\\\">\"))
520 \"</tr>\"))
521
522 will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"."
523 :group 'org-export-tables
524 :type '(cons
525 (choice :tag "Opening tag"
526 (string :tag "Specify")
527 (sexp))
528 (choice :tag "Closing tag"
529 (string :tag "Specify")
530 (sexp))))
531
532 (defcustom org-export-html-table-align-individual-fields t
533 "Non-nil means attach style attributes for alignment to each table field.
534 When nil, alignment will only be specified in the column tags, but this
535 is ignored by some browsers (like Firefox, Safari). Opera does it right
536 though."
537 :group 'org-export-tables
538 :type 'boolean)
539
540 (defcustom org-export-html-table-use-header-tags-for-first-column nil
541 "Non-nil means format column one in tables with header tags.
542 When nil, also column one will use data tags."
543 :group 'org-export-tables
544 :type 'boolean)
545
546 (defcustom org-export-html-validation-link
547 "<a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a>"
548 "Link to HTML validation service."
549 :group 'org-export-html
550 :type 'string)
551
552 ;; FIXME Obsolete since Org 7.7
553 ;; Use the :timestamp option or `org-export-time-stamp-file' instead
554 (defvar org-export-html-with-timestamp nil
555 "If non-nil, write container for HTML-helper-mode timestamp.")
556
557 ;; FIXME Obsolete since Org 7.7
558 (defvar org-export-html-html-helper-timestamp
559 "\n<p><br/><br/>\n<!-- hhmts start --> <!-- hhmts end --></p>\n"
560 "The HTML tag used as timestamp delimiter for HTML-helper-mode.")
561
562 (defcustom org-export-html-protect-char-alist
563 '(("&" . "&amp;")
564 ("<" . "&lt;")
565 (">" . "&gt;"))
566 "Alist of characters to be converted by `org-html-protect'."
567 :group 'org-export-html
568 :type '(repeat (cons (string :tag "Character")
569 (string :tag "HTML equivalent"))))
570
571 (defgroup org-export-htmlize nil
572 "Options for processing examples with htmlize.el."
573 :tag "Org Export Htmlize"
574 :group 'org-export-html)
575
576 (defcustom org-export-htmlize-output-type 'inline-css
577 "Output type to be used by htmlize when formatting code snippets.
578 Choices are `css', to export the CSS selectors only, or `inline-css', to
579 export the CSS attribute values inline in the HTML. We use as default
580 `inline-css', in order to make the resulting HTML self-containing.
581
582 However, this will fail when using Emacs in batch mode for export, because
583 then no rich font definitions are in place. It will also not be good if
584 people with different Emacs setup contribute HTML files to a website,
585 because the fonts will represent the individual setups. In these cases,
586 it is much better to let Org/Htmlize assign classes only, and to use
587 a style file to define the look of these classes.
588 To get a start for your css file, start Emacs session and make sure that
589 all the faces you are interested in are defined, for example by loading files
590 in all modes you want. Then, use the command
591 \\[org-export-htmlize-generate-css] to extract class definitions."
592 :group 'org-export-htmlize
593 :type '(choice (const css) (const inline-css)))
594
595 (defcustom org-export-htmlize-css-font-prefix "org-"
596 "The prefix for CSS class names for htmlize font specifications."
597 :group 'org-export-htmlize
598 :type 'string)
599
600 (defcustom org-export-htmlized-org-css-url nil
601 "URL pointing to a CSS file defining text colors for htmlized Emacs buffers.
602 Normally when creating an htmlized version of an Org buffer, htmlize will
603 create CSS to define the font colors. However, this does not work when
604 converting in batch mode, and it also can look bad if different people
605 with different fontification setup work on the same website.
606 When this variable is non-nil, creating an htmlized version of an Org buffer
607 using `org-export-as-org' will remove the internal CSS section and replace it
608 with a link to this URL."
609 :group 'org-export-htmlize
610 :type '(choice
611 (const :tag "Keep internal css" nil)
612 (string :tag "URL or local href")))
613
614 ;; FIXME: The following variable is obsolete since Org 7.7 but is
615 ;; still declared and checked within code for compatibility reasons.
616 ;; Use the custom variables `org-export-html-divs' instead.
617 (defvar org-export-html-content-div "content"
618 "The name of the container DIV that holds all the page contents.
619
620 This variable is obsolete since Org version 7.7.
621 Please set `org-export-html-divs' instead.")
622
623 (defcustom org-export-html-divs '("preamble" "content" "postamble")
624 "The name of the main divs for HTML export."
625 :group 'org-export-html
626 :type '(list
627 (string :tag " Div for the preamble:")
628 (string :tag " Div for the content:")
629 (string :tag "Div for the postamble:")))
630
631 ;;; Hooks
632
633 (defvar org-export-html-after-blockquotes-hook nil
634 "Hook run during HTML export, after blockquote, verse, center are done.")
635
636 (defvar org-export-html-final-hook nil
637 "Hook run at the end of HTML export, in the new buffer.")
638
639 ;;; HTML export
640
641 (defun org-export-html-preprocess (parameters)
642 "Convert LaTeX fragments to images."
643 (when (and org-current-export-file
644 (plist-get parameters :LaTeX-fragments))
645 (org-format-latex
646 (concat "ltxpng/" (file-name-sans-extension
647 (file-name-nondirectory
648 org-current-export-file)))
649 org-current-export-dir nil "Creating LaTeX image %s"
650 nil nil
651 (cond
652 ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim)
653 ((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax)
654 ((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax)
655 ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng)
656 (t nil))))
657 (goto-char (point-min))
658 (let (label l1)
659 (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t)
660 (org-if-unprotected-at (match-beginning 1)
661 (setq label (match-string 1))
662 (save-match-data
663 (if (string-match "\\`[a-z]\\{1,10\\}:\\(.+\\)" label)
664 (setq l1 (substring label (match-beginning 1)))
665 (setq l1 label)))
666 (replace-match (format "[[#%s][%s]]" label l1) t t)))))
667
668 ;;;###autoload
669 (defun org-export-as-html-and-open (arg)
670 "Export the outline as HTML and immediately open it with a browser.
671 If there is an active region, export only the region.
672 The prefix ARG specifies how many levels of the outline should become
673 headlines. The default is 3. Lower levels will become bulleted lists."
674 (interactive "P")
675 (org-export-as-html arg 'hidden)
676 (org-open-file buffer-file-name)
677 (when org-export-kill-product-buffer-when-displayed
678 (kill-buffer (current-buffer))))
679
680 ;;;###autoload
681 (defun org-export-as-html-batch ()
682 "Call the function `org-export-as-html'.
683 This function can be used in batch processing as:
684 emacs --batch
685 --load=$HOME/lib/emacs/org.el
686 --eval \"(setq org-export-headline-levels 2)\"
687 --visit=MyFile --funcall org-export-as-html-batch"
688 (org-export-as-html org-export-headline-levels 'hidden))
689
690 ;;;###autoload
691 (defun org-export-as-html-to-buffer (arg)
692 "Call `org-export-as-html` with output to a temporary buffer.
693 No file is created. The prefix ARG is passed through to `org-export-as-html'."
694 (interactive "P")
695 (org-export-as-html arg nil nil "*Org HTML Export*")
696 (when org-export-show-temporary-export-buffer
697 (switch-to-buffer-other-window "*Org HTML Export*")))
698
699 ;;;###autoload
700 (defun org-replace-region-by-html (beg end)
701 "Assume the current region has org-mode syntax, and convert it to HTML.
702 This can be used in any buffer. For example, you could write an
703 itemized list in org-mode syntax in an HTML buffer and then use this
704 command to convert it."
705 (interactive "r")
706 (let (reg html buf pop-up-frames)
707 (save-window-excursion
708 (if (org-mode-p)
709 (setq html (org-export-region-as-html
710 beg end t 'string))
711 (setq reg (buffer-substring beg end)
712 buf (get-buffer-create "*Org tmp*"))
713 (with-current-buffer buf
714 (erase-buffer)
715 (insert reg)
716 (org-mode)
717 (setq html (org-export-region-as-html
718 (point-min) (point-max) t 'string)))
719 (kill-buffer buf)))
720 (delete-region beg end)
721 (insert html)))
722
723 ;;;###autoload
724 (defun org-export-region-as-html (beg end &optional body-only buffer)
725 "Convert region from BEG to END in org-mode buffer to HTML.
726 If prefix arg BODY-ONLY is set, omit file header, footer, and table of
727 contents, and only produce the region of converted text, useful for
728 cut-and-paste operations.
729 If BUFFER is a buffer or a string, use/create that buffer as a target
730 of the converted HTML. If BUFFER is the symbol `string', return the
731 produced HTML as a string and leave not buffer behind. For example,
732 a Lisp program could call this function in the following way:
733
734 (setq html (org-export-region-as-html beg end t 'string))
735
736 When called interactively, the output buffer is selected, and shown
737 in a window. A non-interactive call will only return the buffer."
738 (interactive "r\nP")
739 (when (org-called-interactively-p 'any)
740 (setq buffer "*Org HTML Export*"))
741 (let ((transient-mark-mode t) (zmacs-regions t)
742 ext-plist rtn)
743 (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
744 (goto-char end)
745 (set-mark (point)) ;; to activate the region
746 (goto-char beg)
747 (setq rtn (org-export-as-html
748 nil nil ext-plist
749 buffer body-only))
750 (if (fboundp 'deactivate-mark) (deactivate-mark))
751 (if (and (org-called-interactively-p 'any) (bufferp rtn))
752 (switch-to-buffer-other-window rtn)
753 rtn)))
754
755 (defvar html-table-tag nil) ; dynamically scoped into this.
756 (defvar org-par-open nil)
757
758 ;;; org-html-cvt-link-fn
759 (defconst org-html-cvt-link-fn
760 nil
761 "Function to convert link URLs to exportable URLs.
762 Takes two arguments, TYPE and PATH.
763 Returns exportable url as (TYPE PATH), or nil to signal that it
764 didn't handle this case.
765 Intended to be locally bound around a call to `org-export-as-html'." )
766
767 (defun org-html-cvt-org-as-html (opt-plist type path)
768 "Convert an org filename to an equivalent html filename.
769 If TYPE is not file, just return `nil'.
770 See variable `org-export-html-link-org-files-as-html'"
771
772 (save-match-data
773 (and
774 org-export-html-link-org-files-as-html
775 (string= type "file")
776 (string-match "\\.org$" path)
777 (progn
778 (list
779 "file"
780 (concat
781 (substring path 0 (match-beginning 0))
782 "."
783 (plist-get opt-plist :html-extension)))))))
784
785
786 ;;; org-html-should-inline-p
787 (defun org-html-should-inline-p (filename descp)
788 "Return non-nil if link FILENAME should be inlined.
789 The decision to inline the FILENAME link is based on the current
790 settings. DESCP is the boolean of whether there was a link
791 description. See variables `org-export-html-inline-images' and
792 `org-export-html-inline-image-extensions'."
793 (declare (special
794 org-export-html-inline-images
795 org-export-html-inline-image-extensions))
796 (and (or (eq t org-export-html-inline-images)
797 (and org-export-html-inline-images (not descp)))
798 (org-file-image-p
799 filename org-export-html-inline-image-extensions)))
800
801 ;;; org-html-make-link
802 (defun org-html-make-link (opt-plist type path fragment desc attr
803 may-inline-p)
804 "Make an HTML link.
805 OPT-PLIST is an options list.
806 TYPE is the device-type of the link (THIS://foo.html)
807 PATH is the path of the link (http://THIS#locationx)
808 FRAGMENT is the fragment part of the link, if any (foo.html#THIS)
809 DESC is the link description, if any.
810 ATTR is a string of other attributes of the a element.
811 MAY-INLINE-P allows inlining it as an image."
812
813 (declare (special org-par-open))
814 (save-match-data
815 (let* ((filename path)
816 ;;First pass. Just sanity stuff.
817 (components-1
818 (cond
819 ((string= type "file")
820 (list
821 type
822 ;;Substitute just if original path was absolute.
823 ;;(Otherwise path must remain relative)
824 (if (file-name-absolute-p path)
825 (concat "file://" (expand-file-name path))
826 path)))
827 ((string= type "")
828 (list nil path))
829 (t (list type path))))
830
831 ;;Second pass. Components converted so they can refer
832 ;;to a remote site.
833 (components-2
834 (or
835 (and org-html-cvt-link-fn
836 (apply org-html-cvt-link-fn
837 opt-plist components-1))
838 (apply #'org-html-cvt-org-as-html
839 opt-plist components-1)
840 components-1))
841 (type (first components-2))
842 (thefile (second components-2)))
843
844
845 ;;Third pass. Build final link except for leading type
846 ;;spec.
847 (cond
848 ((or
849 (not type)
850 (string= type "http")
851 (string= type "https")
852 (string= type "file")
853 (string= type "coderef"))
854 (if fragment
855 (setq thefile (concat thefile "#" fragment))))
856
857 (t))
858
859 ;;Final URL-build, for all types.
860 (setq thefile
861 (let
862 ((str (org-export-html-format-href thefile)))
863 (if (and type (not (or (string= "file" type)
864 (string= "coderef" type))))
865 (concat type ":" str)
866 str)))
867
868 (if (and
869 may-inline-p
870 ;;Can't inline a URL with a fragment.
871 (not fragment))
872 (progn
873 (message "image %s %s" thefile org-par-open)
874 (org-export-html-format-image thefile org-par-open))
875 (concat
876 "<a href=\"" thefile "\"" (if attr (concat " " attr)) ">"
877 (org-export-html-format-desc desc)
878 "</a>")))))
879
880 (defun org-html-handle-links (line opt-plist)
881 "Return LINE with markup of Org mode links.
882 OPT-PLIST is the export options list."
883 (let ((start 0)
884 (current-dir (if buffer-file-name
885 (file-name-directory buffer-file-name)
886 default-directory))
887 (link-validate (plist-get opt-plist :link-validation-function))
888 type id-file fnc
889 rpl path attr desc descp desc1 desc2 link)
890 (while (string-match org-bracket-link-analytic-regexp++ line start)
891 (setq start (match-beginning 0))
892 (setq path (save-match-data (org-link-unescape
893 (match-string 3 line))))
894 (setq type (cond
895 ((match-end 2) (match-string 2 line))
896 ((save-match-data
897 (or (file-name-absolute-p path)
898 (string-match "^\\.\\.?/" path)))
899 "file")
900 (t "internal")))
901 (setq path (org-extract-attributes (org-link-unescape path)))
902 (setq attr (get-text-property 0 'org-attributes path))
903 (setq desc1 (if (match-end 5) (match-string 5 line))
904 desc2 (if (match-end 2) (concat type ":" path) path)
905 descp (and desc1 (not (equal desc1 desc2)))
906 desc (or desc1 desc2))
907 ;; Make an image out of the description if that is so wanted
908 (when (and descp (org-file-image-p
909 desc org-export-html-inline-image-extensions))
910 (save-match-data
911 (if (string-match "^file:" desc)
912 (setq desc (substring desc (match-end 0)))))
913 (setq desc (org-add-props
914 (concat "<img src=\"" desc "\" alt=\""
915 (file-name-nondirectory desc) "\"/>")
916 '(org-protected t))))
917 (cond
918 ((equal type "internal")
919 (let
920 ((frag-0
921 (if (= (string-to-char path) ?#)
922 (substring path 1)
923 path)))
924 (setq rpl
925 (org-html-make-link
926 opt-plist
927 ""
928 ""
929 (org-solidify-link-text
930 (save-match-data (org-link-unescape frag-0))
931 nil)
932 desc attr nil))))
933 ((and (equal type "id")
934 (setq id-file (org-id-find-id-file path)))
935 ;; This is an id: link to another file (if it was the same file,
936 ;; it would have become an internal link...)
937 (save-match-data
938 (setq id-file (file-relative-name
939 id-file
940 (file-name-directory org-current-export-file)))
941 (setq rpl
942 (org-html-make-link opt-plist
943 "file" id-file
944 (concat (if (org-uuidgen-p path) "ID-") path)
945 desc
946 attr
947 nil))))
948 ((member type '("http" "https"))
949 ;; standard URL, can inline as image
950 (setq rpl
951 (org-html-make-link opt-plist
952 type path nil
953 desc
954 attr
955 (org-html-should-inline-p path descp))))
956 ((member type '("ftp" "mailto" "news"))
957 ;; standard URL, can't inline as image
958 (setq rpl
959 (org-html-make-link opt-plist
960 type path nil
961 desc
962 attr
963 nil)))
964
965 ((string= type "coderef")
966 (let*
967 ((coderef-str (format "coderef-%s" path))
968 (attr-1
969 (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\""
970 coderef-str coderef-str)))
971 (setq rpl
972 (org-html-make-link opt-plist
973 type "" coderef-str
974 (format
975 (org-export-get-coderef-format
976 path
977 (and descp desc))
978 (cdr (assoc path org-export-code-refs)))
979 attr-1
980 nil))))
981
982 ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
983 ;; The link protocol has a function for format the link
984 (setq rpl
985 (save-match-data
986 (funcall fnc (org-link-unescape path) desc1 'html))))
987
988 ((string= type "file")
989 ;; FILE link
990 (save-match-data
991 (let*
992 ((components
993 (if
994 (string-match "::\\(.*\\)" path)
995 (list
996 (replace-match "" t nil path)
997 (match-string 1 path))
998 (list path nil)))
999
1000 ;;The proper path, without a fragment
1001 (path-1
1002 (first components))
1003
1004 ;;The raw fragment
1005 (fragment-0
1006 (second components))
1007
1008 ;;Check the fragment. If it can't be used as
1009 ;;target fragment we'll pass nil instead.
1010 (fragment-1
1011 (if
1012 (and fragment-0
1013 (not (string-match "^[0-9]*$" fragment-0))
1014 (not (string-match "^\\*" fragment-0))
1015 (not (string-match "^/.*/$" fragment-0)))
1016 (org-solidify-link-text
1017 (org-link-unescape fragment-0))
1018 nil))
1019 (desc-2
1020 ;;Description minus "file:" and ".org"
1021 (if (string-match "^file:" desc)
1022 (let
1023 ((desc-1 (replace-match "" t t desc)))
1024 (if (string-match "\\.org$" desc-1)
1025 (replace-match "" t t desc-1)
1026 desc-1))
1027 desc)))
1028
1029 (setq rpl
1030 (if
1031 (and
1032 (functionp link-validate)
1033 (not (funcall link-validate path-1 current-dir)))
1034 desc
1035 (org-html-make-link opt-plist
1036 "file" path-1 fragment-1 desc-2 attr
1037 (org-html-should-inline-p path-1 descp)))))))
1038
1039 (t
1040 ;; just publish the path, as default
1041 (setq rpl (concat "@<i>&lt;" type ":"
1042 (save-match-data (org-link-unescape path))
1043 "&gt;@</i>"))))
1044 (setq line (replace-match rpl t t line)
1045 start (+ start (length rpl))))
1046 line))
1047
1048 ;;; org-export-as-html
1049 ;;;###autoload
1050 (defun org-export-as-html (arg &optional hidden ext-plist
1051 to-buffer body-only pub-dir)
1052 "Export the outline as a pretty HTML file.
1053 If there is an active region, export only the region. The prefix
1054 ARG specifies how many levels of the outline should become
1055 headlines. The default is 3. Lower levels will become bulleted
1056 lists. HIDDEN is obsolete and does nothing.
1057 EXT-PLIST is a property list with external parameters overriding
1058 org-mode's default settings, but still inferior to file-local
1059 settings. When TO-BUFFER is non-nil, create a buffer with that
1060 name and export to that buffer. If TO-BUFFER is the symbol
1061 `string', don't leave any buffer behind but just return the
1062 resulting HTML as a string. When BODY-ONLY is set, don't produce
1063 the file header and footer, simply return the content of
1064 <body>...</body>, without even the body tags themselves. When
1065 PUB-DIR is set, use this as the publishing directory."
1066 (interactive "P")
1067 (run-hooks 'org-export-first-hook)
1068
1069 ;; Make sure we have a file name when we need it.
1070 (when (and (not (or to-buffer body-only))
1071 (not buffer-file-name))
1072 (if (buffer-base-buffer)
1073 (org-set-local 'buffer-file-name
1074 (with-current-buffer (buffer-base-buffer)
1075 buffer-file-name))
1076 (error "Need a file name to be able to export")))
1077
1078 (message "Exporting...")
1079 (setq-default org-todo-line-regexp org-todo-line-regexp)
1080 (setq-default org-deadline-line-regexp org-deadline-line-regexp)
1081 (setq-default org-done-keywords org-done-keywords)
1082 (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
1083 (let* ((opt-plist
1084 (org-export-process-option-filters
1085 (org-combine-plists (org-default-export-plist)
1086 ext-plist
1087 (org-infile-export-plist))))
1088 (body-only (or body-only (plist-get opt-plist :body-only)))
1089 (style (concat (if (plist-get opt-plist :style-include-default)
1090 org-export-html-style-default)
1091 (plist-get opt-plist :style)
1092 (plist-get opt-plist :style-extra)
1093 "\n"
1094 (if (plist-get opt-plist :style-include-scripts)
1095 org-export-html-scripts)))
1096 (html-extension (plist-get opt-plist :html-extension))
1097 valid thetoc have-headings first-heading-pos
1098 (odd org-odd-levels-only)
1099 (region-p (org-region-active-p))
1100 (rbeg (and region-p (region-beginning)))
1101 (rend (and region-p (region-end)))
1102 (subtree-p
1103 (if (plist-get opt-plist :ignore-subtree-p)
1104 nil
1105 (when region-p
1106 (save-excursion
1107 (goto-char rbeg)
1108 (and (org-at-heading-p)
1109 (>= (org-end-of-subtree t t) rend))))))
1110 (level-offset (if subtree-p
1111 (save-excursion
1112 (goto-char rbeg)
1113 (+ (funcall outline-level)
1114 (if org-odd-levels-only 1 0)))
1115 0))
1116 (opt-plist (setq org-export-opt-plist
1117 (if subtree-p
1118 (org-export-add-subtree-options opt-plist rbeg)
1119 opt-plist)))
1120 ;; The following two are dynamically scoped into other
1121 ;; routines below.
1122 (org-current-export-dir
1123 (or pub-dir (org-export-directory :html opt-plist)))
1124 (org-current-export-file buffer-file-name)
1125 (level 0) (line "") (origline "") txt todo
1126 (umax nil)
1127 (umax-toc nil)
1128 (filename (if to-buffer nil
1129 (expand-file-name
1130 (concat
1131 (file-name-sans-extension
1132 (or (and subtree-p
1133 (org-entry-get (region-beginning)
1134 "EXPORT_FILE_NAME" t))
1135 (file-name-nondirectory buffer-file-name)))
1136 "." html-extension)
1137 (file-name-as-directory
1138 (or pub-dir (org-export-directory :html opt-plist))))))
1139 (current-dir (if buffer-file-name
1140 (file-name-directory buffer-file-name)
1141 default-directory))
1142 (buffer (if to-buffer
1143 (cond
1144 ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
1145 (t (get-buffer-create to-buffer)))
1146 (find-file-noselect filename)))
1147 (org-levels-open (make-vector org-level-max nil))
1148 (date (plist-get opt-plist :date))
1149 (author (plist-get opt-plist :author))
1150 (html-validation-link (or org-export-html-validation-link ""))
1151 (title (org-html-expand
1152 (or (and subtree-p (org-export-get-title-from-subtree))
1153 (plist-get opt-plist :title)
1154 (and (not body-only)
1155 (not
1156 (plist-get opt-plist :skip-before-1st-heading))
1157 (org-export-grab-title-from-buffer))
1158 (and buffer-file-name
1159 (file-name-sans-extension
1160 (file-name-nondirectory buffer-file-name)))
1161 "UNTITLED")))
1162 (link-up (and (plist-get opt-plist :link-up)
1163 (string-match "\\S-" (plist-get opt-plist :link-up))
1164 (plist-get opt-plist :link-up)))
1165 (link-home (and (plist-get opt-plist :link-home)
1166 (string-match "\\S-" (plist-get opt-plist :link-home))
1167 (plist-get opt-plist :link-home)))
1168 (dummy (setq opt-plist (plist-put opt-plist :title title)))
1169 (html-table-tag (plist-get opt-plist :html-table-tag))
1170 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
1171 (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
1172 (inquote nil)
1173 (infixed nil)
1174 (inverse nil)
1175 (email (plist-get opt-plist :email))
1176 (language (plist-get opt-plist :language))
1177 (keywords (plist-get opt-plist :keywords))
1178 (description (plist-get opt-plist :description))
1179 (num (plist-get opt-plist :section-numbers))
1180 (lang-words nil)
1181 (head-count 0) cnt
1182 (start 0)
1183 (coding-system (and (boundp 'buffer-file-coding-system)
1184 buffer-file-coding-system))
1185 (coding-system-for-write (or org-export-html-coding-system
1186 coding-system))
1187 (save-buffer-coding-system (or org-export-html-coding-system
1188 coding-system))
1189 (charset (and coding-system-for-write
1190 (fboundp 'coding-system-get)
1191 (coding-system-get coding-system-for-write
1192 'mime-charset)))
1193 (region
1194 (buffer-substring
1195 (if region-p (region-beginning) (point-min))
1196 (if region-p (region-end) (point-max))))
1197 (org-export-have-math nil)
1198 (org-export-footnotes-seen nil)
1199 (org-export-footnotes-data (org-footnote-all-labels 'with-defs))
1200 (lines
1201 (org-split-string
1202 (org-export-preprocess-string
1203 region
1204 :emph-multiline t
1205 :for-backend 'html
1206 :skip-before-1st-heading
1207 (plist-get opt-plist :skip-before-1st-heading)
1208 :drawers (plist-get opt-plist :drawers)
1209 :todo-keywords (plist-get opt-plist :todo-keywords)
1210 :tasks (plist-get opt-plist :tasks)
1211 :tags (plist-get opt-plist :tags)
1212 :priority (plist-get opt-plist :priority)
1213 :footnotes (plist-get opt-plist :footnotes)
1214 :timestamps (plist-get opt-plist :timestamps)
1215 :archived-trees
1216 (plist-get opt-plist :archived-trees)
1217 :select-tags (plist-get opt-plist :select-tags)
1218 :exclude-tags (plist-get opt-plist :exclude-tags)
1219 :add-text
1220 (plist-get opt-plist :text)
1221 :LaTeX-fragments
1222 (plist-get opt-plist :LaTeX-fragments))
1223 "[\r\n]"))
1224 (mathjax
1225 (if (or (eq (plist-get opt-plist :LaTeX-fragments) 'mathjax)
1226 (and org-export-have-math
1227 (eq (plist-get opt-plist :LaTeX-fragments) t)))
1228
1229 (org-export-html-mathjax-config
1230 org-export-html-mathjax-template
1231 org-export-html-mathjax-options
1232 (or (plist-get opt-plist :mathjax) ""))
1233 ""))
1234 table-open
1235 table-buffer table-orig-buffer
1236 ind
1237 rpl path attr desc descp desc1 desc2 link
1238 snumber fnc
1239 footnotes footref-seen
1240 href
1241 )
1242
1243 (let ((inhibit-read-only t))
1244 (org-unmodified
1245 (remove-text-properties (point-min) (point-max)
1246 '(:org-license-to-kill t))))
1247
1248 (message "Exporting...")
1249
1250 (setq org-min-level (org-get-min-level lines level-offset))
1251 (setq org-last-level org-min-level)
1252 (org-init-section-numbers)
1253
1254 (cond
1255 ((and date (string-match "%" date))
1256 (setq date (format-time-string date)))
1257 (date)
1258 (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
1259
1260 ;; Get the language-dependent settings
1261 (setq lang-words (or (assoc language org-export-language-setup)
1262 (assoc "en" org-export-language-setup)))
1263
1264 ;; Switch to the output buffer
1265 (set-buffer buffer)
1266 (let ((inhibit-read-only t)) (erase-buffer))
1267 (fundamental-mode)
1268 (org-install-letbind)
1269
1270 (and (fboundp 'set-buffer-file-coding-system)
1271 (set-buffer-file-coding-system coding-system-for-write))
1272
1273 (let ((case-fold-search nil)
1274 (org-odd-levels-only odd))
1275 ;; create local variables for all options, to make sure all called
1276 ;; functions get the correct information
1277 (mapc (lambda (x)
1278 (set (make-local-variable (nth 2 x))
1279 (plist-get opt-plist (car x))))
1280 org-export-plist-vars)
1281 (setq umax (if arg (prefix-numeric-value arg)
1282 org-export-headline-levels))
1283 (setq umax-toc (if (integerp org-export-with-toc)
1284 (min org-export-with-toc umax)
1285 umax))
1286 (unless body-only
1287 ;; File header
1288 (insert (format
1289 "%s
1290 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
1291 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
1292 <html xmlns=\"http://www.w3.org/1999/xhtml\"
1293 lang=\"%s\" xml:lang=\"%s\">
1294 <head>
1295 <title>%s</title>
1296 <meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
1297 <meta name=\"generator\" content=\"Org-mode\"/>
1298 <meta name=\"generated\" content=\"%s\"/>
1299 <meta name=\"author\" content=\"%s\"/>
1300 <meta name=\"description\" content=\"%s\"/>
1301 <meta name=\"keywords\" content=\"%s\"/>
1302 %s
1303 %s
1304 </head>
1305 <body>
1306 %s
1307 "
1308 (format
1309 (or (and (stringp org-export-html-xml-declaration)
1310 org-export-html-xml-declaration)
1311 (cdr (assoc html-extension org-export-html-xml-declaration))
1312 (cdr (assoc "html" org-export-html-xml-declaration))
1313
1314 "")
1315 (or charset "iso-8859-1"))
1316 language language
1317 title
1318 (or charset "iso-8859-1")
1319 date author description keywords
1320 style
1321 mathjax
1322 (if (or link-up link-home)
1323 (concat
1324 (format org-export-html-home/up-format
1325 (or link-up link-home)
1326 (or link-home link-up))
1327 "\n")
1328 "")))
1329
1330 ;; insert html preamble
1331 (when (plist-get opt-plist :html-preamble)
1332 (let ((html-pre (plist-get opt-plist :html-preamble)))
1333 (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n")
1334 (cond ((stringp html-pre)
1335 (insert
1336 (format-spec html-pre `((?t . ,title) (?a . ,author)
1337 (?d . ,date) (?e . ,email)))))
1338 ((functionp html-pre)
1339 (funcall html-pre))
1340 (t
1341 (insert
1342 (format-spec
1343 (or (cadr (assoc (nth 0 lang-words)
1344 org-export-html-preamble-format))
1345 (cadr (assoc "en" org-export-html-preamble-format)))
1346 `((?t . ,title) (?a . ,author)
1347 (?d . ,date) (?e . ,email))))))
1348 (insert "\n</div>\n")))
1349
1350 ;; begin wrap around body
1351 (insert (format "\n<div id=\"%s\">"
1352 ;; FIXME org-export-html-content-div is obsolete since 7.7
1353 (or org-export-html-content-div
1354 (nth 1 org-export-html-divs)))
1355 ;; FIXME this should go in the preamble but is here so
1356 ;; that org-infojs can still find it
1357 "\n<h1 class=\"title\">" title "</h1>\n"))
1358
1359 ;; insert body
1360 (if (and org-export-with-toc (not body-only))
1361 (progn
1362 (push (format "<h%d>%s</h%d>\n"
1363 org-export-html-toplevel-hlevel
1364 (nth 3 lang-words)
1365 org-export-html-toplevel-hlevel)
1366 thetoc)
1367 (push "<div id=\"text-table-of-contents\">\n" thetoc)
1368 (push "<ul>\n<li>" thetoc)
1369 (setq lines
1370 (mapcar
1371 #'(lambda (line)
1372 (if (and (string-match org-todo-line-regexp line)
1373 (not (get-text-property 0 'org-protected line)))
1374 ;; This is a headline
1375 (progn
1376 (setq have-headings t)
1377 (setq level (- (match-end 1) (match-beginning 1)
1378 level-offset)
1379 level (org-tr-level level)
1380 txt (save-match-data
1381 (org-html-expand
1382 (org-export-cleanup-toc-line
1383 (match-string 3 line))))
1384 todo
1385 (or (and org-export-mark-todo-in-toc
1386 (match-beginning 2)
1387 (not (member (match-string 2 line)
1388 org-done-keywords)))
1389 ; TODO, not DONE
1390 (and org-export-mark-todo-in-toc
1391 (= level umax-toc)
1392 (org-search-todo-below
1393 line lines level))))
1394 (if (string-match
1395 (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
1396 (setq txt (replace-match
1397 "&nbsp;&nbsp;&nbsp;<span class=\"tag\"> \\1</span>" t nil txt)))
1398 (if (string-match quote-re0 txt)
1399 (setq txt (replace-match "" t t txt)))
1400 (setq snumber (org-section-number level))
1401 (if (and num (if (integerp num)
1402 (>= num level)
1403 num))
1404 (setq txt (concat snumber " " txt)))
1405 (if (<= level (max umax umax-toc))
1406 (setq head-count (+ head-count 1)))
1407 (if (<= level umax-toc)
1408 (progn
1409 (if (> level org-last-level)
1410 (progn
1411 (setq cnt (- level org-last-level))
1412 (while (>= (setq cnt (1- cnt)) 0)
1413 (push "\n<ul>\n<li>" thetoc))
1414 (push "\n" thetoc)))
1415 (if (< level org-last-level)
1416 (progn
1417 (setq cnt (- org-last-level level))
1418 (while (>= (setq cnt (1- cnt)) 0)
1419 (push "</li>\n</ul>" thetoc))
1420 (push "\n" thetoc)))
1421 ;; Check for targets
1422 (while (string-match org-any-target-regexp line)
1423 (setq line (replace-match
1424 (concat "@<span class=\"target\">"
1425 (match-string 1 line) "@</span> ")
1426 t t line)))
1427 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
1428 (setq txt (replace-match "" t t txt)))
1429 (setq href
1430 (replace-regexp-in-string
1431 "\\." "-" (format "sec-%s" snumber)))
1432 (setq href (org-solidify-link-text
1433 (or (cdr (assoc href
1434 org-export-preferred-target-alist)) href)))
1435 (push
1436 (format
1437 (if todo
1438 "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
1439 "</li>\n<li><a href=\"#%s\">%s</a>")
1440 href txt) thetoc)
1441
1442 (setq org-last-level level)))))
1443 line)
1444 lines))
1445 (while (> org-last-level (1- org-min-level))
1446 (setq org-last-level (1- org-last-level))
1447 (push "</li>\n</ul>\n" thetoc))
1448 (push "</div>\n" thetoc)
1449 (setq thetoc (if have-headings (nreverse thetoc) nil))))
1450
1451 (setq head-count 0)
1452 (org-init-section-numbers)
1453
1454 (org-open-par)
1455
1456 (while (setq line (pop lines) origline line)
1457 (catch 'nextline
1458
1459 ;; end of quote section?
1460 (when (and inquote (string-match org-outline-regexp-bol line))
1461 (insert "</pre>\n")
1462 (org-open-par)
1463 (setq inquote nil))
1464 ;; inside a quote section?
1465 (when inquote
1466 (insert (org-html-protect line) "\n")
1467 (throw 'nextline nil))
1468
1469 ;; Fixed-width, verbatim lines (examples)
1470 (when (and org-export-with-fixed-width
1471 (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
1472 (when (not infixed)
1473 (setq infixed t)
1474 (org-close-par-maybe)
1475
1476 (insert "<pre class=\"example\">\n"))
1477 (insert (org-html-protect (match-string 3 line)) "\n")
1478 (when (or (not lines)
1479 (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
1480 (car lines))))
1481 (setq infixed nil)
1482 (insert "</pre>\n")
1483 (org-open-par))
1484 (throw 'nextline nil))
1485
1486 ;; Protected HTML
1487 (when (and (get-text-property 0 'org-protected line)
1488 ;; Make sure it is the entire line that is protected
1489 (not (< (or (next-single-property-change
1490 0 'org-protected line) 10000)
1491 (length line))))
1492 (let (par (ind (get-text-property 0 'original-indentation line)))
1493 (when (re-search-backward
1494 "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
1495 (setq par (match-string 1))
1496 (replace-match "\\2\n"))
1497 (insert line "\n")
1498 (while (and lines
1499 (or (= (length (car lines)) 0)
1500 (not ind)
1501 (equal ind (get-text-property 0 'original-indentation (car lines))))
1502 (or (= (length (car lines)) 0)
1503 (get-text-property 0 'org-protected (car lines))))
1504 (insert (pop lines) "\n"))
1505 (and par (insert "<p>\n")))
1506 (throw 'nextline nil))
1507
1508 ;; Blockquotes, verse, and center
1509 (when (equal "ORG-BLOCKQUOTE-START" line)
1510 (org-close-par-maybe)
1511 (insert "<blockquote>\n")
1512 (org-open-par)
1513 (throw 'nextline nil))
1514 (when (equal "ORG-BLOCKQUOTE-END" line)
1515 (org-close-par-maybe)
1516 (insert "\n</blockquote>\n")
1517 (org-open-par)
1518 (throw 'nextline nil))
1519 (when (equal "ORG-VERSE-START" line)
1520 (org-close-par-maybe)
1521 (insert "\n<p class=\"verse\">\n")
1522 (setq org-par-open t)
1523 (setq inverse t)
1524 (throw 'nextline nil))
1525 (when (equal "ORG-VERSE-END" line)
1526 (insert "</p>\n")
1527 (setq org-par-open nil)
1528 (org-open-par)
1529 (setq inverse nil)
1530 (throw 'nextline nil))
1531 (when (equal "ORG-CENTER-START" line)
1532 (org-close-par-maybe)
1533 (insert "\n<div style=\"text-align: center\">")
1534 (org-open-par)
1535 (throw 'nextline nil))
1536 (when (equal "ORG-CENTER-END" line)
1537 (org-close-par-maybe)
1538 (insert "\n</div>")
1539 (org-open-par)
1540 (throw 'nextline nil))
1541 (run-hooks 'org-export-html-after-blockquotes-hook)
1542 (when inverse
1543 (let ((i (org-get-string-indentation line)))
1544 (if (> i 0)
1545 (setq line (concat (mapconcat 'identity
1546 (make-list (* 2 i) "\\nbsp") "")
1547 " " (org-trim line))))
1548 (unless (string-match "\\\\\\\\[ \t]*$" line)
1549 (setq line (concat line "\\\\")))))
1550
1551 ;; make targets to anchors
1552 (setq start 0)
1553 (while (string-match
1554 "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
1555 (cond
1556 ((get-text-property (match-beginning 1) 'org-protected line)
1557 (setq start (match-end 1)))
1558 ((match-end 2)
1559 (setq line (replace-match
1560 (format
1561 "@<a name=\"%s\" id=\"%s\">@</a>"
1562 (org-solidify-link-text (match-string 1 line))
1563 (org-solidify-link-text (match-string 1 line)))
1564 t t line)))
1565 ((and org-export-with-toc (equal (string-to-char line) ?*))
1566 ;; FIXME: NOT DEPENDENT on TOC?????????????????????
1567 (setq line (replace-match
1568 (concat "@<span class=\"target\">"
1569 (match-string 1 line) "@</span> ")
1570 ;; (concat "@<i>" (match-string 1 line) "@</i> ")
1571 t t line)))
1572 (t
1573 (setq line (replace-match
1574 (concat "@<a name=\""
1575 (org-solidify-link-text (match-string 1 line))
1576 "\" class=\"target\">" (match-string 1 line)
1577 "@</a> ")
1578 t t line)))))
1579
1580 (setq line (org-html-handle-time-stamps line))
1581
1582 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
1583 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
1584 ;; Also handle sub_superscripts and checkboxes
1585 (or (string-match org-table-hline-regexp line)
1586 (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line)
1587 (setq line (org-html-expand line)))
1588
1589 ;; Format the links
1590 (setq line (org-html-handle-links line opt-plist))
1591
1592 ;; TODO items
1593 (if (and (string-match org-todo-line-regexp line)
1594 (match-beginning 2))
1595
1596 (setq line
1597 (concat (substring line 0 (match-beginning 2))
1598 "<span class=\""
1599 (if (member (match-string 2 line)
1600 org-done-keywords)
1601 "done" "todo")
1602 " " (match-string 2 line)
1603 "\"> " (org-export-html-get-todo-kwd-class-name
1604 (match-string 2 line))
1605 "</span>" (substring line (match-end 2)))))
1606
1607 ;; Does this contain a reference to a footnote?
1608 (when org-export-with-footnotes
1609 (setq start 0)
1610 (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
1611 ;; Discard protected matches not clearly identified as
1612 ;; footnote markers.
1613 (if (or (get-text-property (match-beginning 2) 'org-protected line)
1614 (not (get-text-property (match-beginning 2) 'org-footnote line)))
1615 (setq start (match-end 2))
1616 (let ((n (match-string 2 line)) extra a)
1617 (if (setq a (assoc n footref-seen))
1618 (progn
1619 (setcdr a (1+ (cdr a)))
1620 (setq extra (format ".%d" (cdr a))))
1621 (setq extra "")
1622 (push (cons n 1) footref-seen))
1623 (setq line
1624 (replace-match
1625 (concat
1626 (format
1627 (concat "%s"
1628 (format org-export-html-footnote-format
1629 (concat "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>")))
1630 (or (match-string 1 line) "") n extra n n)
1631 ;; If another footnote is following the
1632 ;; current one, add a separator.
1633 (if (save-match-data
1634 (string-match "\\`\\[[0-9]+\\]"
1635 (substring line (match-end 0))))
1636 org-export-html-footnote-separator
1637 ""))
1638 t t line))))))
1639
1640 (cond
1641 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
1642 ;; This is a headline
1643 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
1644 level-offset))
1645 txt (match-string 2 line))
1646 (if (string-match quote-re0 txt)
1647 (setq txt (replace-match "" t t txt)))
1648 (if (<= level (max umax umax-toc))
1649 (setq head-count (+ head-count 1)))
1650 (setq first-heading-pos (or first-heading-pos (point)))
1651 (org-html-level-start level txt umax
1652 (and org-export-with-toc (<= level umax))
1653 head-count opt-plist)
1654
1655 ;; QUOTES
1656 (when (string-match quote-re line)
1657 (org-close-par-maybe)
1658 (insert "<pre>")
1659 (setq inquote t)))
1660
1661 ((and org-export-with-tables
1662 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
1663 (when (not table-open)
1664 ;; New table starts
1665 (setq table-open t table-buffer nil table-orig-buffer nil))
1666
1667 ;; Accumulate lines
1668 (setq table-buffer (cons line table-buffer)
1669 table-orig-buffer (cons origline table-orig-buffer))
1670 (when (or (not lines)
1671 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
1672 (car lines))))
1673 (setq table-open nil
1674 table-buffer (nreverse table-buffer)
1675 table-orig-buffer (nreverse table-orig-buffer))
1676 (org-close-par-maybe)
1677 (insert (org-format-table-html table-buffer table-orig-buffer))))
1678
1679 ;; Normal lines
1680
1681 (t
1682 ;; This line either is list item or end a list.
1683 (when (get-text-property 0 'list-item line)
1684 (setq line (org-html-export-list-line
1685 line
1686 (get-text-property 0 'list-item line)
1687 (get-text-property 0 'list-struct line)
1688 (get-text-property 0 'list-prevs line))))
1689
1690 ;; Horizontal line
1691 (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
1692 (if org-par-open
1693 (insert "\n</p>\n<hr/>\n<p>\n")
1694 (insert "\n<hr/>\n"))
1695 (throw 'nextline nil))
1696
1697 ;; Empty lines start a new paragraph. If hand-formatted lists
1698 ;; are not fully interpreted, lines starting with "-", "+", "*"
1699 ;; also start a new paragraph.
1700 (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
1701
1702 ;; Is this the start of a footnote?
1703 (when org-export-with-footnotes
1704 (when (and (boundp 'footnote-section-tag-regexp)
1705 (string-match (concat "^" footnote-section-tag-regexp)
1706 line))
1707 ;; ignore this line
1708 (throw 'nextline nil))
1709 (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
1710 (org-close-par-maybe)
1711 (let ((n (match-string 1 line)))
1712 (setq org-par-open t
1713 line (replace-match
1714 (format
1715 (concat "<p class=\"footnote\">"
1716 (format org-export-html-footnote-format
1717 "<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>"))
1718 n n n) t t line)))))
1719 ;; Check if the line break needs to be conserved
1720 (cond
1721 ((string-match "\\\\\\\\[ \t]*$" line)
1722 (setq line (replace-match "<br/>" t t line)))
1723 (org-export-preserve-breaks
1724 (setq line (concat line "<br/>"))))
1725
1726 ;; Check if a paragraph should be started
1727 (let ((start 0))
1728 (while (and org-par-open
1729 (string-match "\\\\par\\>" line start))
1730 ;; Leave a space in the </p> so that the footnote matcher
1731 ;; does not see this.
1732 (if (not (get-text-property (match-beginning 0)
1733 'org-protected line))
1734 (setq line (replace-match "</p ><p >" t t line)))
1735 (setq start (match-end 0))))
1736
1737 (insert line "\n")))))
1738
1739 ;; Properly close all local lists and other lists
1740 (when inquote
1741 (insert "</pre>\n")
1742 (org-open-par))
1743
1744 (org-html-level-start 1 nil umax
1745 (and org-export-with-toc (<= level umax))
1746 head-count opt-plist)
1747 ;; the </div> to close the last text-... div.
1748 (when (and (> umax 0) first-heading-pos) (insert "</div>\n"))
1749
1750 (save-excursion
1751 (goto-char (point-min))
1752 (while (re-search-forward
1753 "\\(\\(<p class=\"footnote\">\\)[^\000]*?\\)\\(\\(\\2\\)\\|\\'\\)"
1754 nil t)
1755 (push (match-string 1) footnotes)
1756 (replace-match "\\4" t nil)
1757 (goto-char (match-beginning 0))))
1758 (when footnotes
1759 (insert (format org-export-html-footnotes-section
1760 (nth 4 lang-words)
1761 (mapconcat 'identity (nreverse footnotes) "\n"))
1762 "\n"))
1763 (let ((bib (org-export-html-get-bibliography)))
1764 (when bib
1765 (insert "\n" bib "\n")))
1766
1767 (unless body-only
1768 ;; end wrap around body
1769 (insert "</div>\n")
1770
1771 ;; export html postamble
1772 (let ((html-post (plist-get opt-plist :html-postamble))
1773 (email
1774 (mapconcat (lambda(e)
1775 (format "<a href=\"mailto:%s\">%s</a>" e e))
1776 (split-string email ",+ *")
1777 ", "))
1778 (creator-info
1779 (concat "Org version " org-version " with Emacs version "
1780 (number-to-string emacs-major-version))))
1781
1782 (when (plist-get opt-plist :html-postamble)
1783 (insert "\n<div id=\"" (nth 2 org-export-html-divs) "\">\n")
1784 (cond ((stringp html-post)
1785 (insert (format-spec html-post
1786 `((?a . ,author) (?e . ,email)
1787 (?d . ,date) (?c . ,creator-info)
1788 (?v . ,html-validation-link)))))
1789 ((functionp html-post)
1790 (funcall html-post))
1791 ((eq html-post 'auto)
1792 ;; fall back on default postamble
1793 (when (plist-get opt-plist :time-stamp-file)
1794 (insert "<p class=\"date\">" (nth 2 lang-words) ": " date "</p>\n"))
1795 (when (and (plist-get opt-plist :author-info) author)
1796 (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n"))
1797 (when (and (plist-get opt-plist :email-info) email)
1798 (insert "<p class=\"email\">" email "</p>\n"))
1799 (when (plist-get opt-plist :creator-info)
1800 (insert "<p class=\"creator\">"
1801 (concat "Org version " org-version " with Emacs version "
1802 (number-to-string emacs-major-version) "</p>\n")))
1803 (insert html-validation-link "\n"))
1804 (t
1805 (insert (format-spec
1806 (or (cadr (assoc (nth 0 lang-words)
1807 org-export-html-postamble-format))
1808 (cadr (assoc "en" org-export-html-postamble-format)))
1809 `((?a . ,author) (?e . ,email)
1810 (?d . ,date) (?c . ,creator-info)
1811 (?v . ,html-validation-link))))))
1812 (insert "\n</div>"))))
1813
1814 ;; FIXME `org-export-html-with-timestamp' has been declared
1815 ;; obsolete since Org 7.7 -- don't forget to remove this.
1816 (if org-export-html-with-timestamp
1817 (insert org-export-html-html-helper-timestamp))
1818
1819 (unless body-only (insert "\n</body>\n</html>\n"))
1820
1821 (unless (plist-get opt-plist :buffer-will-be-killed)
1822 (normal-mode)
1823 (if (eq major-mode (default-value 'major-mode))
1824 (html-mode)))
1825
1826 ;; insert the table of contents
1827 (goto-char (point-min))
1828 (when thetoc
1829 (if (or (re-search-forward
1830 "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t)
1831 (re-search-forward
1832 "\\[TABLE-OF-CONTENTS\\]" nil t))
1833 (progn
1834 (goto-char (match-beginning 0))
1835 (replace-match ""))
1836 (goto-char first-heading-pos)
1837 (when (looking-at "\\s-*</p>")
1838 (goto-char (match-end 0))
1839 (insert "\n")))
1840 (insert "<div id=\"table-of-contents\">\n")
1841 (let ((beg (point)))
1842 (mapc 'insert thetoc)
1843 (insert "</div>\n")
1844 (while (re-search-backward "<li>[ \r\n\t]*</li>\n?" beg t)
1845 (replace-match ""))))
1846 ;; remove empty paragraphs
1847 (goto-char (point-min))
1848 (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
1849 (replace-match ""))
1850 (goto-char (point-min))
1851 ;; Convert whitespace place holders
1852 (goto-char (point-min))
1853 (let (beg end n)
1854 (while (setq beg (next-single-property-change (point) 'org-whitespace))
1855 (setq n (get-text-property beg 'org-whitespace)
1856 end (next-single-property-change beg 'org-whitespace))
1857 (goto-char beg)
1858 (delete-region beg end)
1859 (insert (format "<span style=\"visibility:hidden;\">%s</span>"
1860 (make-string n ?x)))))
1861 ;; Remove empty lines at the beginning of the file.
1862 (goto-char (point-min))
1863 (when (looking-at "\\s-+\n") (replace-match ""))
1864 ;; Remove display properties
1865 (remove-text-properties (point-min) (point-max) '(display t))
1866 ;; Run the hook
1867 (run-hooks 'org-export-html-final-hook)
1868 (or to-buffer (save-buffer))
1869 (goto-char (point-min))
1870 (or (org-export-push-to-kill-ring "HTML")
1871 (message "Exporting... done"))
1872 (if (eq to-buffer 'string)
1873 (prog1 (buffer-substring (point-min) (point-max))
1874 (kill-buffer (current-buffer)))
1875 (current-buffer)))))
1876
1877 (defun org-export-html-format-href (s)
1878 "Make sure the S is valid as a href reference in an XHTML document."
1879 (save-match-data
1880 (let ((start 0))
1881 (while (string-match "&" s start)
1882 (setq start (+ (match-beginning 0) 3)
1883 s (replace-match "&amp;" t t s)))))
1884 s)
1885
1886 (defun org-export-html-format-desc (s)
1887 "Make sure the S is valid as a description in a link."
1888 (if (and s (not (get-text-property 1 'org-protected s)))
1889 (save-match-data
1890 (org-html-do-expand s))
1891 s))
1892
1893 (defun org-export-html-format-image (src par-open)
1894 "Create image tag with source and attributes."
1895 (save-match-data
1896 (if (string-match "^ltxpng/" src)
1897 (format "<img src=\"%s\" alt=\"%s\"/>"
1898 src (org-find-text-property-in-string 'org-latex-src src))
1899 (let* ((caption (org-find-text-property-in-string 'org-caption src))
1900 (attr (org-find-text-property-in-string 'org-attributes src))
1901 (label (org-find-text-property-in-string 'org-label src)))
1902 (setq caption (and caption (org-html-do-expand caption)))
1903 (concat
1904 (if caption
1905 (format "%s<div %sclass=\"figure\">
1906 <p>"
1907 (if org-par-open "</p>\n" "")
1908 (if label (format "id=\"%s\" " (org-solidify-link-text label)) "")))
1909 (format "<img src=\"%s\"%s />"
1910 src
1911 (if (string-match "\\<alt=" (or attr ""))
1912 (concat " " attr )
1913 (concat " " attr " alt=\"" src "\"")))
1914 (if caption
1915 (format "</p>%s
1916 </div>%s"
1917 (concat "\n<p>" caption "</p>")
1918 (if org-par-open "\n<p>" ""))))))))
1919
1920 (defun org-export-html-get-bibliography ()
1921 "Find bibliography, cut it out and return it."
1922 (catch 'exit
1923 (let (beg end (cnt 1) bib)
1924 (save-excursion
1925 (goto-char (point-min))
1926 (when (re-search-forward "^[ \t]*<div \\(id\\|class\\)=\"bibliography\"" nil t)
1927 (setq beg (match-beginning 0))
1928 (while (re-search-forward "</?div\\>" nil t)
1929 (setq cnt (+ cnt (if (string= (match-string 0) "<div") +1 -1)))
1930 (when (= cnt 0)
1931 (and (looking-at ">") (forward-char 1))
1932 (setq bib (buffer-substring beg (point)))
1933 (delete-region beg (point))
1934 (throw 'exit bib))))
1935 nil))))
1936
1937 (defvar org-table-number-regexp) ; defined in org-table.el
1938 (defun org-format-table-html (lines olines &optional no-css)
1939 "Find out which HTML converter to use and return the HTML code.
1940 NO-CSS is passed to the exporter."
1941 (if (stringp lines)
1942 (setq lines (org-split-string lines "\n")))
1943 (if (string-match "^[ \t]*|" (car lines))
1944 ;; A normal org table
1945 (org-format-org-table-html lines nil no-css)
1946 ;; Table made by table.el
1947 (or (org-format-table-table-html-using-table-generate-source
1948 olines (not org-export-prefer-native-exporter-for-tables))
1949 ;; We are here only when table.el table has NO col or row
1950 ;; spanning and the user prefers using org's own converter for
1951 ;; exporting of such simple table.el tables.
1952 (org-format-table-table-html lines))))
1953
1954 (defvar org-table-number-fraction) ; defined in org-table.el
1955 (defun org-format-org-table-html (lines &optional splice no-css)
1956 "Format a table into HTML.
1957 LINES is a list of lines. Optional argument SPLICE means, do not
1958 insert header and surrounding <table> tags, just format the lines.
1959 Optional argument NO-CSS means use XHTML attributes instead of CSS
1960 for formatting. This is required for the DocBook exporter."
1961 (require 'org-table)
1962 ;; Get rid of hlines at beginning and end
1963 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1964 (setq lines (nreverse lines))
1965 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1966 (setq lines (nreverse lines))
1967 (when org-export-table-remove-special-lines
1968 ;; Check if the table has a marking column. If yes remove the
1969 ;; column and the special lines
1970 (setq lines (org-table-clean-before-export lines)))
1971
1972 (let* ((caption (org-find-text-property-in-string 'org-caption (car lines)))
1973 (label (org-find-text-property-in-string 'org-label (car lines)))
1974 (forced-aligns (org-find-text-property-in-string 'org-forced-aligns
1975 (car lines)))
1976 (attributes (org-find-text-property-in-string 'org-attributes
1977 (car lines)))
1978 (html-table-tag (org-export-splice-attributes
1979 html-table-tag attributes))
1980 (head (and org-export-highlight-first-table-line
1981 (delq nil (mapcar
1982 (lambda (x) (string-match "^[ \t]*|-" x))
1983 (cdr lines)))))
1984 (nline 0) fnum nfields i (cnt 0)
1985 tbopen line fields html gr colgropen rowstart rowend
1986 ali align aligns n)
1987 (setq caption (and caption (org-html-do-expand caption)))
1988 (when (and forced-aligns org-table-clean-did-remove-column)
1989 (setq forced-aligns
1990 (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) forced-aligns)))
1991 (if splice (setq head nil))
1992 (unless splice (push (if head "<thead>" "<tbody>") html))
1993 (setq tbopen t)
1994 (while (setq line (pop lines))
1995 (catch 'next-line
1996 (if (string-match "^[ \t]*|-" line)
1997 (progn
1998 (unless splice
1999 (push (if head "</thead>" "</tbody>") html)
2000 (if lines (push "<tbody>" html) (setq tbopen nil)))
2001 (setq head nil) ;; head ends here, first time around
2002 ;; ignore this line
2003 (throw 'next-line t)))
2004 ;; Break the line into fields
2005 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
2006 (unless fnum (setq fnum (make-vector (length fields) 0)
2007 nfields (length fnum)))
2008 (setq nline (1+ nline) i -1
2009 rowstart (eval (car org-export-table-row-tags))
2010 rowend (eval (cdr org-export-table-row-tags)))
2011 (push (concat rowstart
2012 (mapconcat
2013 (lambda (x)
2014 (setq i (1+ i) ali (format "@@class%03d@@" i))
2015 (if (and (< i nfields) ; make sure no rogue line causes an error here
2016 (string-match org-table-number-regexp x))
2017 (incf (aref fnum i)))
2018 (cond
2019 (head
2020 (concat
2021 (format (car org-export-table-header-tags)
2022 "col" ali)
2023 x
2024 (cdr org-export-table-header-tags)))
2025 ((and (= i 0) org-export-html-table-use-header-tags-for-first-column)
2026 (concat
2027 (format (car org-export-table-header-tags)
2028 "row" ali)
2029 x
2030 (cdr org-export-table-header-tags)))
2031 (t
2032 (concat (format (car org-export-table-data-tags) ali)
2033 x
2034 (cdr org-export-table-data-tags)))))
2035 fields "")
2036 rowend)
2037 html)))
2038 (unless splice (if tbopen (push "</tbody>" html)))
2039 (unless splice (push "</table>\n" html))
2040 (setq html (nreverse html))
2041 (unless splice
2042 ;; Put in col tags with the alignment (unfortunately often ignored...)
2043 (unless (car org-table-colgroup-info)
2044 (setq org-table-colgroup-info
2045 (cons :start (cdr org-table-colgroup-info))))
2046 (setq i 0)
2047 (push (mapconcat
2048 (lambda (x)
2049 (setq gr (pop org-table-colgroup-info)
2050 i (1+ i)
2051 align (if (assoc i forced-aligns)
2052 (cdr (assoc (cdr (assoc i forced-aligns))
2053 '(("l" . "left") ("r" . "right")
2054 ("c" . "center"))))
2055 (if (> (/ (float x) nline)
2056 org-table-number-fraction)
2057 "right" "left")))
2058 (push align aligns)
2059 (format (if no-css
2060 "%s<col align=\"%s\" />%s"
2061 "%s<col class=\"%s\" />%s")
2062 (if (memq gr '(:start :startend))
2063 (prog1
2064 (if colgropen
2065 "</colgroup>\n<colgroup>"
2066 "<colgroup>")
2067 (setq colgropen t))
2068 "")
2069 align
2070 (if (memq gr '(:end :startend))
2071 (progn (setq colgropen nil) "</colgroup>")
2072 "")))
2073 fnum "")
2074 html)
2075 (setq aligns (nreverse aligns))
2076 (if colgropen (setq html (cons (car html)
2077 (cons "</colgroup>" (cdr html)))))
2078 ;; Since the output of HTML table formatter can also be used in
2079 ;; DocBook document, we want to always include the caption to make
2080 ;; DocBook XML file valid.
2081 (push (format "<caption>%s</caption>" (or caption "")) html)
2082 (when label
2083 (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label)))))
2084 (push html-table-tag html))
2085 (setq html (mapcar
2086 (lambda (x)
2087 (replace-regexp-in-string
2088 "@@class\\([0-9]+\\)@@"
2089 (lambda (txt)
2090 (if (not org-export-html-table-align-individual-fields)
2091 ""
2092 (setq n (string-to-number (match-string 1 txt)))
2093 (format (if no-css " align=\"%s\"" " class=\"%s\"")
2094 (or (nth n aligns) "left"))))
2095 x))
2096 html))
2097 (concat (mapconcat 'identity html "\n") "\n")))
2098
2099 (defun org-export-splice-attributes (tag attributes)
2100 "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG."
2101 (if (not attributes)
2102 tag
2103 (let (oldatt newatt)
2104 (setq oldatt (org-extract-attributes-from-string tag)
2105 tag (pop oldatt)
2106 newatt (cdr (org-extract-attributes-from-string attributes)))
2107 (while newatt
2108 (setq oldatt (plist-put oldatt (pop newatt) (pop newatt))))
2109 (if (string-match ">" tag)
2110 (setq tag
2111 (replace-match (concat (org-attributes-to-string oldatt) ">")
2112 t t tag)))
2113 tag)))
2114
2115 (defun org-format-table-table-html (lines)
2116 "Format a table generated by table.el into HTML.
2117 This conversion does *not* use `table-generate-source' from table.el.
2118 This has the advantage that Org-mode's HTML conversions can be used.
2119 But it has the disadvantage, that no cell- or row-spanning is allowed."
2120 (let (line field-buffer
2121 (head org-export-highlight-first-table-line)
2122 fields html empty i)
2123 (setq html (concat html-table-tag "\n"))
2124 (while (setq line (pop lines))
2125 (setq empty "&nbsp;")
2126 (catch 'next-line
2127 (if (string-match "^[ \t]*\\+-" line)
2128 (progn
2129 (if field-buffer
2130 (progn
2131 (setq
2132 html
2133 (concat
2134 html
2135 "<tr>"
2136 (mapconcat
2137 (lambda (x)
2138 (if (equal x "") (setq x empty))
2139 (if head
2140 (concat
2141 (format (car org-export-table-header-tags) "col" "")
2142 x
2143 (cdr org-export-table-header-tags))
2144 (concat (format (car org-export-table-data-tags) "") x
2145 (cdr org-export-table-data-tags))))
2146 field-buffer "\n")
2147 "</tr>\n"))
2148 (setq head nil)
2149 (setq field-buffer nil)))
2150 ;; Ignore this line
2151 (throw 'next-line t)))
2152 ;; Break the line into fields and store the fields
2153 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
2154 (if field-buffer
2155 (setq field-buffer (mapcar
2156 (lambda (x)
2157 (concat x "<br/>" (pop fields)))
2158 field-buffer))
2159 (setq field-buffer fields))))
2160 (setq html (concat html "</table>\n"))
2161 html))
2162
2163 (defun org-format-table-table-html-using-table-generate-source (lines
2164 &optional
2165 spanned-only)
2166 "Format a table into html, using `table-generate-source' from table.el.
2167 Use SPANNED-ONLY to suppress exporting of simple table.el tables.
2168
2169 When SPANNED-ONLY is nil, all table.el tables are exported. When
2170 SPANNED-ONLY is non-nil, only tables with either row or column
2171 spans are exported.
2172
2173 This routine returns the generated source or nil as appropriate.
2174
2175 Refer docstring of `org-export-prefer-native-exporter-for-tables'
2176 for further information."
2177 (require 'table)
2178 (with-current-buffer (get-buffer-create " org-tmp1 ")
2179 (erase-buffer)
2180 (insert (mapconcat 'identity lines "\n"))
2181 (goto-char (point-min))
2182 (if (not (re-search-forward "|[^+]" nil t))
2183 (error "Error processing table"))
2184 (table-recognize-table)
2185 (when (or (not spanned-only)
2186 (let* ((dim (table-query-dimension))
2187 (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim)))
2188 (not (= (* c r) cells))))
2189 (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
2190 (table-generate-source 'html " org-tmp2 ")
2191 (set-buffer " org-tmp2 ")
2192 (buffer-substring (point-min) (point-max)))))
2193
2194 (defun org-export-splice-style (style extra)
2195 "Splice EXTRA into STYLE, just before \"</style>\"."
2196 (if (and (stringp extra)
2197 (string-match "\\S-" extra)
2198 (string-match "</style>" style))
2199 (concat (substring style 0 (match-beginning 0))
2200 "\n" extra "\n"
2201 (substring style (match-beginning 0)))
2202 style))
2203
2204 (defun org-html-handle-time-stamps (s)
2205 "Format time stamps in string S, or remove them."
2206 (catch 'exit
2207 (let (r b)
2208 (while (string-match org-maybe-keyword-time-regexp s)
2209 (or b (setq b (substring s 0 (match-beginning 0))))
2210 (setq r (concat
2211 r (substring s 0 (match-beginning 0))
2212 " @<span class=\"timestamp-wrapper\">"
2213 (if (match-end 1)
2214 (format "@<span class=\"timestamp-kwd\">%s @</span>"
2215 (match-string 1 s)))
2216 (format " @<span class=\"timestamp\">%s@</span>"
2217 (substring
2218 (org-translate-time (match-string 3 s)) 1 -1))
2219 "@</span>")
2220 s (substring s (match-end 0))))
2221 ;; Line break if line started and ended with time stamp stuff
2222 (if (not r)
2223 s
2224 (setq r (concat r s))
2225 (unless (string-match "\\S-" (concat b s))
2226 (setq r (concat r "@<br/>")))
2227 r))))
2228
2229 (defvar htmlize-buffer-places) ; from htmlize.el
2230 (defun org-export-htmlize-region-for-paste (beg end)
2231 "Convert the region to HTML, using htmlize.el.
2232 This is much like `htmlize-region-for-paste', only that it uses
2233 the settings define in the org-... variables."
2234 (let* ((htmlize-output-type org-export-htmlize-output-type)
2235 (htmlize-css-name-prefix org-export-htmlize-css-font-prefix)
2236 (htmlbuf (htmlize-region beg end)))
2237 (unwind-protect
2238 (with-current-buffer htmlbuf
2239 (buffer-substring (plist-get htmlize-buffer-places 'content-start)
2240 (plist-get htmlize-buffer-places 'content-end)))
2241 (kill-buffer htmlbuf))))
2242
2243 ;;;###autoload
2244 (defun org-export-htmlize-generate-css ()
2245 "Create the CSS for all font definitions in the current Emacs session.
2246 Use this to create face definitions in your CSS style file that can then
2247 be used by code snippets transformed by htmlize.
2248 This command just produces a buffer that contains class definitions for all
2249 faces used in the current Emacs session. You can copy and paste the ones you
2250 need into your CSS file.
2251
2252 If you then set `org-export-htmlize-output-type' to `css', calls to
2253 the function `org-export-htmlize-region-for-paste' will produce code
2254 that uses these same face definitions."
2255 (interactive)
2256 (require 'htmlize)
2257 (and (get-buffer "*html*") (kill-buffer "*html*"))
2258 (with-temp-buffer
2259 (let ((fl (face-list))
2260 (htmlize-css-name-prefix "org-")
2261 (htmlize-output-type 'css)
2262 f i)
2263 (while (setq f (pop fl)
2264 i (and f (face-attribute f :inherit)))
2265 (when (and (symbolp f) (or (not i) (not (listp i))))
2266 (insert (org-add-props (copy-sequence "1") nil 'face f))))
2267 (htmlize-region (point-min) (point-max))))
2268 (org-pop-to-buffer-same-window "*html*")
2269 (goto-char (point-min))
2270 (if (re-search-forward "<style" nil t)
2271 (delete-region (point-min) (match-beginning 0)))
2272 (if (re-search-forward "</style>" nil t)
2273 (delete-region (1+ (match-end 0)) (point-max)))
2274 (beginning-of-line 1)
2275 (if (looking-at " +") (replace-match ""))
2276 (goto-char (point-min)))
2277
2278 (defun org-html-protect (s)
2279 "Convert characters to HTML equivalent.
2280 Possible conversions are set in `org-export-html-protect-char-alist'."
2281 (let ((cl org-export-html-protect-char-alist) c)
2282 (while (setq c (pop cl))
2283 (let ((start 0))
2284 (while (string-match (car c) s start)
2285 (setq s (replace-match (cdr c) t t s)
2286 start (1+ (match-beginning 0))))))
2287 s))
2288
2289 (defun org-html-expand (string)
2290 "Prepare STRING for HTML export. Apply all active conversions.
2291 If there are links in the string, don't modify these."
2292 (let* ((re (concat org-bracket-link-regexp "\\|"
2293 (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")))
2294 m s l res)
2295 (while (setq m (string-match re string))
2296 (setq s (substring string 0 m)
2297 l (match-string 0 string)
2298 string (substring string (match-end 0)))
2299 (push (org-html-do-expand s) res)
2300 (push l res))
2301 (push (org-html-do-expand string) res)
2302 (apply 'concat (nreverse res))))
2303
2304 (defun org-html-do-expand (s)
2305 "Apply all active conversions to translate special ASCII to HTML."
2306 (setq s (org-html-protect s))
2307 (if org-export-html-expand
2308 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
2309 (setq s (replace-match "<\\1>" t nil s))))
2310 (if org-export-with-emphasize
2311 (setq s (org-export-html-convert-emphasize s)))
2312 (if org-export-with-special-strings
2313 (setq s (org-export-html-convert-special-strings s)))
2314 (if org-export-with-sub-superscripts
2315 (setq s (org-export-html-convert-sub-super s)))
2316 (if org-export-with-TeX-macros
2317 (let ((start 0) wd rep)
2318 (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?"
2319 s start))
2320 (if (get-text-property (match-beginning 0) 'org-protected s)
2321 (setq start (match-end 0))
2322 (setq wd (match-string 1 s))
2323 (if (setq rep (org-entity-get-representation wd 'html))
2324 (setq s (replace-match rep t t s))
2325 (setq start (+ start (length wd))))))))
2326 s)
2327
2328 (defun org-export-html-convert-special-strings (string)
2329 "Convert special characters in STRING to HTML."
2330 (let ((all org-export-html-special-string-regexps)
2331 e a re rpl start)
2332 (while (setq a (pop all))
2333 (setq re (car a) rpl (cdr a) start 0)
2334 (while (string-match re string start)
2335 (if (get-text-property (match-beginning 0) 'org-protected string)
2336 (setq start (match-end 0))
2337 (setq string (replace-match rpl t nil string)))))
2338 string))
2339
2340 (defun org-export-html-convert-sub-super (string)
2341 "Convert sub- and superscripts in STRING to HTML."
2342 (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
2343 (while (string-match org-match-substring-regexp string s)
2344 (cond
2345 ((and requireb (match-end 8)) (setq s (match-end 2)))
2346 ((get-text-property (match-beginning 2) 'org-protected string)
2347 (setq s (match-end 2)))
2348 (t
2349 (setq s (match-end 1)
2350 key (if (string= (match-string 2 string) "_") "sub" "sup")
2351 c (or (match-string 8 string)
2352 (match-string 6 string)
2353 (match-string 5 string))
2354 string (replace-match
2355 (concat (match-string 1 string)
2356 "<" key ">" c "</" key ">")
2357 t t string)))))
2358 (while (string-match "\\\\\\([_^]\\)" string)
2359 (setq string (replace-match (match-string 1 string) t t string)))
2360 string))
2361
2362 (defun org-export-html-convert-emphasize (string)
2363 "Apply emphasis."
2364 (let ((s 0) rpl)
2365 (while (string-match org-emph-re string s)
2366 (if (not (equal
2367 (substring string (match-beginning 3) (1+ (match-beginning 3)))
2368 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
2369 (setq s (match-beginning 0)
2370 rpl
2371 (concat
2372 (match-string 1 string)
2373 (nth 2 (assoc (match-string 3 string) org-emphasis-alist))
2374 (match-string 4 string)
2375 (nth 3 (assoc (match-string 3 string)
2376 org-emphasis-alist))
2377 (match-string 5 string))
2378 string (replace-match rpl t t string)
2379 s (+ s (- (length rpl) 2)))
2380 (setq s (1+ s))))
2381 string))
2382
2383 (defun org-open-par ()
2384 "Insert <p>, but first close previous paragraph if any."
2385 (org-close-par-maybe)
2386 (insert "\n<p>")
2387 (setq org-par-open t))
2388 (defun org-close-par-maybe ()
2389 "Close paragraph if there is one open."
2390 (when org-par-open
2391 (insert "</p>")
2392 (setq org-par-open nil)))
2393 (defun org-close-li (&optional type)
2394 "Close <li> if necessary."
2395 (org-close-par-maybe)
2396 (insert (if (equal type "d") "</dd>\n" "</li>\n")))
2397
2398 (defvar body-only) ; dynamically scoped into this.
2399 (defun org-html-level-start (level title umax with-toc head-count &optional opt-plist)
2400 "Insert a new level in HTML export.
2401 When TITLE is nil, just close all open levels."
2402 (org-close-par-maybe)
2403 (let* ((target (and title (org-get-text-property-any 0 'target title)))
2404 (extra-targets (and target
2405 (assoc target org-export-target-aliases)))
2406 (extra-class (and title (org-get-text-property-any 0 'html-container-class title)))
2407 (preferred (and target
2408 (cdr (assoc target org-export-preferred-target-alist))))
2409 (l org-level-max)
2410 (num (plist-get opt-plist :section-numbers))
2411 snumber snu href suffix)
2412 (setq extra-targets (remove (or preferred target) extra-targets))
2413 (setq extra-targets
2414 (mapconcat (lambda (x)
2415 (setq x (org-solidify-link-text
2416 (if (org-uuidgen-p x) (concat "ID-" x) x)))
2417 (format "<a name=\"%s\" id=\"%s\"></a>"
2418 x x))
2419 extra-targets
2420 ""))
2421 (while (>= l level)
2422 (if (aref org-levels-open (1- l))
2423 (progn
2424 (org-html-level-close l umax)
2425 (aset org-levels-open (1- l) nil)))
2426 (setq l (1- l)))
2427 (when title
2428 ;; If title is nil, this means this function is called to close
2429 ;; all levels, so the rest is done only if title is given
2430 (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title)
2431 (setq title (replace-match
2432 (if org-export-with-tags
2433 (save-match-data
2434 (concat
2435 "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
2436 (mapconcat
2437 (lambda (x)
2438 (format "<span class=\"%s\">%s</span>"
2439 (org-export-html-get-tag-class-name x)
2440 x))
2441 (org-split-string (match-string 1 title) ":")
2442 "&nbsp;")
2443 "</span>"))
2444 "")
2445 t t title)))
2446 (if (> level umax)
2447 (progn
2448 (if (aref org-levels-open (1- level))
2449 (progn
2450 (org-close-li)
2451 (if target
2452 (insert (format "<li id=\"%s\">" (org-solidify-link-text (or preferred target)))
2453 extra-targets title "<br/>\n")
2454 (insert "<li>" title "<br/>\n")))
2455 (aset org-levels-open (1- level) t)
2456 (org-close-par-maybe)
2457 (if target
2458 (insert (format "<ul>\n<li id=\"%s\">" (org-solidify-link-text (or preferred target)))
2459 extra-targets title "<br/>\n")
2460 (insert "<ul>\n<li>" title "<br/>\n"))))
2461 (aset org-levels-open (1- level) t)
2462 (setq snumber (org-section-number level)
2463 snu (replace-regexp-in-string "\\." "-" snumber))
2464 (setq level (+ level org-export-html-toplevel-hlevel -1))
2465 (if (and num (not body-only))
2466 (setq title (concat
2467 (format "<span class=\"section-number-%d\">%s</span>"
2468 level
2469 (if (and num
2470 (if (integerp num)
2471 ;; fix up num to take into
2472 ;; account the top-level
2473 ;; heading value
2474 (>= (+ num org-export-html-toplevel-hlevel -1)
2475 level)
2476 num))
2477 snumber
2478 ""))
2479 " " title)))
2480 (unless (= head-count 1) (insert "\n</div>\n"))
2481 (setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist)))
2482 (setq suffix (org-solidify-link-text (or href snu)))
2483 (setq href (org-solidify-link-text (or href (concat "sec-" snu))))
2484 (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d%s\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n"
2485 suffix level (if extra-class (concat " " extra-class) "")
2486 level href
2487 extra-targets
2488 title level level suffix))
2489 (org-open-par)))))
2490
2491 (defun org-export-html-get-tag-class-name (tag)
2492 "Turn tag into a valid class name.
2493 Replaces invalid characters with \"_\" and then prepends a prefix."
2494 (save-match-data
2495 (while (string-match "[^a-zA-Z0-9_]" tag)
2496 (setq tag (replace-match "_" t t tag))))
2497 (concat org-export-html-tag-class-prefix tag))
2498
2499 (defun org-export-html-get-todo-kwd-class-name (kwd)
2500 "Turn todo keyword into a valid class name.
2501 Replaces invalid characters with \"_\" and then prepends a prefix."
2502 (save-match-data
2503 (while (string-match "[^a-zA-Z0-9_]" kwd)
2504 (setq kwd (replace-match "_" t t kwd))))
2505 (concat org-export-html-todo-kwd-class-prefix kwd))
2506
2507 (defun org-html-level-close (level max-outline-level)
2508 "Terminate one level in HTML export."
2509 (if (<= level max-outline-level)
2510 (insert "</div>\n")
2511 (org-close-li)
2512 (insert "</ul>\n")))
2513
2514 (defun org-html-export-list-line (line pos struct prevs)
2515 "Insert list syntax in export buffer. Return LINE, maybe modified.
2516
2517 POS is the item position or line position the line had before
2518 modifications to buffer. STRUCT is the list structure. PREVS is
2519 the alist of previous items."
2520 (let* ((get-type
2521 (function
2522 ;; Translate type of list containing POS to "d", "o" or
2523 ;; "u".
2524 (lambda (pos struct prevs)
2525 (let ((type (org-list-get-list-type pos struct prevs)))
2526 (cond
2527 ((eq 'ordered type) "o")
2528 ((eq 'descriptive type) "d")
2529 (t "u"))))))
2530 (get-closings
2531 (function
2532 ;; Return list of all items and sublists ending at POS, in
2533 ;; reverse order.
2534 (lambda (pos)
2535 (let (out)
2536 (catch 'exit
2537 (mapc (lambda (e)
2538 (let ((end (nth 6 e))
2539 (item (car e)))
2540 (cond
2541 ((= end pos) (push item out))
2542 ((>= item pos) (throw 'exit nil)))))
2543 struct))
2544 out)))))
2545 ;; First close any previous item, or list, ending at POS.
2546 (mapc (lambda (e)
2547 (let* ((lastp (= (org-list-get-last-item e struct prevs) e))
2548 (first-item (org-list-get-list-begin e struct prevs))
2549 (type (funcall get-type first-item struct prevs)))
2550 (org-close-par-maybe)
2551 ;; Ending for every item
2552 (org-close-li type)
2553 ;; We're ending last item of the list: end list.
2554 (when lastp
2555 (insert (format "</%sl>\n" type))
2556 (org-open-par))))
2557 (funcall get-closings pos))
2558 (cond
2559 ;; At an item: insert appropriate tags in export buffer.
2560 ((assq pos struct)
2561 (string-match
2562 (concat "[ \t]*\\(\\S-+[ \t]*\\)"
2563 "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
2564 "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?"
2565 "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?"
2566 "\\(.*\\)") line)
2567 (let* ((checkbox (match-string 3 line))
2568 (desc-tag (or (match-string 4 line) "???"))
2569 (body (or (match-string 5 line) ""))
2570 (list-beg (org-list-get-list-begin pos struct prevs))
2571 (firstp (= list-beg pos))
2572 ;; Always refer to first item to determine list type, in
2573 ;; case list is ill-formed.
2574 (type (funcall get-type list-beg struct prevs))
2575 (counter (let ((count-tmp (org-list-get-counter pos struct)))
2576 (cond
2577 ((not count-tmp) nil)
2578 ((string-match "[A-Za-z]" count-tmp)
2579 (- (string-to-char (upcase count-tmp)) 64))
2580 ((string-match "[0-9]+" count-tmp)
2581 count-tmp)))))
2582 (when firstp
2583 (org-close-par-maybe)
2584 (insert (format "<%sl>\n" type)))
2585 (insert (cond
2586 ((equal type "d")
2587 (format "<dt>%s</dt><dd>" desc-tag))
2588 ((and (equal type "o") counter)
2589 (format "<li value=\"%s\">" counter))
2590 (t "<li>")))
2591 ;; If line had a checkbox, some additional modification is required.
2592 (when checkbox
2593 (setq body
2594 (concat
2595 (cond
2596 ((string-match "X" checkbox) "<code>[X]</code> ")
2597 ((string-match " " checkbox) "<code>[&nbsp;]</code> ")
2598 (t "<code>[-]</code> "))
2599 body)))
2600 ;; Return modified line
2601 body))
2602 ;; At a list ender: go to next line (side-effects only).
2603 ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil))
2604 ;; Not at an item: return line unchanged (side-effects only).
2605 (t line))))
2606
2607 (provide 'org-html)
2608
2609
2610 ;;; org-html.el ends here