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