Release 6.34b
[org-mode/org-tableheadings.git] / lisp / org-html.el
blob81513a6e882f2efeaa10672aafe32a2daf734985
1 ;;; org-html.el --- HTML export for Org-mode
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
4 ;; Free Software Foundation, Inc.
6 ;; Author: Carsten Dominik <carsten at orgmode dot org>
7 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;; Homepage: http://orgmode.org
9 ;; Version: 6.34b
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 ;;; Commentary:
29 (require 'org-exp)
30 (eval-when-compile (require 'cl))
32 (declare-function org-id-find-id-file "org-id" (id))
33 (declare-function htmlize-region "ext:htmlize" (beg end))
35 (defgroup org-export-html nil
36 "Options specific for HTML export of Org-mode files."
37 :tag "Org Export HTML"
38 :group 'org-export)
40 (defcustom org-export-html-footnotes-section "<div id=\"footnotes\">
41 <h2 class=\"footnotes\">%s: </h2>
42 <div id=\"text-footnotes\">
44 </div>
45 </div>"
46 "Format for the footnotes section.
47 Should contain a two instances of %s. The first will be replaced with the
48 language-specific word for \"Footnotes\", the second one will be replaced
49 by the footnotes themselves."
50 :group 'org-export-html
51 :type 'string)
53 (defcustom org-export-html-footnote-format "<sup>%s</sup>"
54 "The format for the footnote reference.
55 %s will be replaced by the footnote reference itself."
56 :group 'org-export-html
57 :type 'string)
59 (defcustom org-export-html-coding-system nil
60 "Coding system for HTML export, defaults to buffer-file-coding-system."
61 :group 'org-export-html
62 :type 'coding-system)
64 (defcustom org-export-html-extension "html"
65 "The extension for exported HTML files."
66 :group 'org-export-html
67 :type 'string)
69 (defcustom org-export-html-xml-declaration
70 '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>")
71 ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>"))
72 "The extension for exported HTML files.
73 %s will be replaced with the charset of the exported file.
74 This may be a string, or an alist with export extensions
75 and corresponding declarations."
76 :group 'org-export-html
77 :type '(choice
78 (string :tag "Single declaration")
79 (repeat :tag "Dependent on extension"
80 (cons (string :tag "Extension")
81 (string :tag "Declaration")))))
83 (defcustom org-export-html-style-include-scripts t
84 "Non-nil means, include the javascript snippets in exported HTML files.
85 The actual script is defined in `org-export-html-scripts' and should
86 not be modified."
87 :group 'org-export-html
88 :type 'boolean)
90 (defconst org-export-html-scripts
91 "<script type=\"text/javascript\">
92 <!--/*--><![CDATA[/*><!--*/
93 function CodeHighlightOn(elem, id)
95 var target = document.getElementById(id);
96 if(null != target) {
97 elem.cacheClassElem = elem.className;
98 elem.cacheClassTarget = target.className;
99 target.className = \"code-highlighted\";
100 elem.className = \"code-highlighted\";
103 function CodeHighlightOff(elem, id)
105 var target = document.getElementById(id);
106 if(elem.cacheClassElem)
107 elem.className = elem.cacheClassElem;
108 if(elem.cacheClassTarget)
109 target.className = elem.cacheClassTarget;
111 /*]]>*///-->
112 </script>"
113 "Basic javascript that is needed by HTML files produced by Org-mode.")
115 (defconst org-export-html-style-default
116 "<style type=\"text/css\">
117 <!--/*--><![CDATA[/*><!--*/
118 html { font-family: Times, serif; font-size: 12pt; }
119 .title { text-align: center; }
120 .todo { color: red; }
121 .done { color: green; }
122 .tag { background-color: #add8e6; font-weight:normal }
123 .target { }
124 .timestamp { color: #bebebe; }
125 .timestamp-kwd { color: #5f9ea0; }
126 p.verse { margin-left: 3% }
127 pre {
128 border: 1pt solid #AEBDCC;
129 background-color: #F3F5F7;
130 padding: 5pt;
131 font-family: courier, monospace;
132 font-size: 90%;
133 overflow:auto;
135 table { border-collapse: collapse; }
136 td, th { vertical-align: top; }
137 dt { font-weight: bold; }
138 div.figure { padding: 0.5em; }
139 div.figure p { text-align: center; }
140 .linenr { font-size:smaller }
141 .code-highlighted {background-color:#ffff00;}
142 .org-info-js_info-navigation { border-style:none; }
143 #org-info-js_console-label { font-size:10px; font-weight:bold;
144 white-space:nowrap; }
145 .org-info-js_search-highlight {background-color:#ffff00; color:#000000;
146 font-weight:bold; }
147 /*]]>*/-->
148 </style>"
149 "The default style specification for exported HTML files.
150 Please use the variables `org-export-html-style' and
151 `org-export-html-style-extra' to add to this style. If you wish to not
152 have the default style included, customize the variable
153 `org-export-html-style-include-default'.")
155 (defcustom org-export-html-style-include-default t
156 "Non-nil means, include the default style in exported HTML files.
157 The actual style is defined in `org-export-html-style-default' and should
158 not be modified. Use the variables `org-export-html-style' to add
159 your own style information."
160 :group 'org-export-html
161 :type 'boolean)
162 ;;;###autoload
163 (put 'org-export-html-style-include-default 'safe-local-variable 'booleanp)
165 (defcustom org-export-html-style ""
166 "Org-wide style definitions for exported HTML files.
168 This variable needs to contain the full HTML structure to provide a style,
169 including the surrounding HTML tags. If you set the value of this variable,
170 you should consider to include definitions for the following classes:
171 title, todo, done, timestamp, timestamp-kwd, tag, target.
173 For example, a valid value would be:
175 <style type=\"text/css\">
176 <![CDATA[
177 p { font-weight: normal; color: gray; }
178 h1 { color: black; }
179 .title { text-align: center; }
180 .todo, .timestamp-kwd { color: red; }
181 .done { color: green; }
183 </style>
185 If you'd like to refer to en external style file, use something like
187 <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
189 As the value of this option simply gets inserted into the HTML <head> header,
190 you can \"misuse\" it to add arbitrary text to the header.
191 See also the variable `org-export-html-style-extra'."
192 :group 'org-export-html
193 :type 'string)
194 ;;;###autoload
195 (put 'org-export-html-style 'safe-local-variable 'stringp)
197 (defcustom org-export-html-style-extra ""
198 "Additional style information for HTML export.
199 The value of this variable is inserted into the HTML buffer right after
200 the value of `org-export-html-style'. Use this variable for per-file
201 settings of style information, and do not forget to surround the style
202 settings with <style>...</style> tags."
203 :group 'org-export-html
204 :type 'string)
205 ;;;###autoload
206 (put 'org-export-html-style-extra 'safe-local-variable 'stringp)
208 (defcustom org-export-html-tag-class-prefix ""
209 "Prefix to clas names for TODO keywords.
210 Each tag gets a class given by the tag itself, with this prefix.
211 The default prefix is empty because it is nice to just use the keyword
212 as a class name. But if you get into conflicts with other, existing
213 CSS classes, then this prefic can be very useful."
214 :group 'org-export-html
215 :type 'string)
217 (defcustom org-export-html-todo-kwd-class-prefix ""
218 "Prefix to clas names for TODO keywords.
219 Each TODO keyword gets a class given by the keyword itself, with this prefix.
220 The default prefix is empty because it is nice to just use the keyword
221 as a class name. But if you get into conflicts with other, existing
222 CSS classes, then this prefic can be very useful."
223 :group 'org-export-html
224 :type 'string)
226 (defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n"
227 "Format for typesetting the document title in HTML export."
228 :group 'org-export-html
229 :type 'string)
231 (defcustom org-export-html-home/up-format
232 "<div id=\"org-div-home-and-up\" style=\"text-align:right;font-size:70%%;white-space:nowrap;\">
233 <a accesskey=\"h\" href=\"%s\"> UP </a>
235 <a accesskey=\"H\" href=\"%s\"> HOME </a>
236 </div>"
237 "Snippet used to insert the HOME and UP links. This is a format,
238 the first %s will receive the UP link, the second the HOME link.
239 If both `org-export-html-link-up' and `org-export-html-link-home' are
240 empty, the entire snippet will be ignored."
241 :group 'org-export-html
242 :type 'string)
244 (defcustom org-export-html-toplevel-hlevel 2
245 "The <H> level for level 1 headings in HTML export.
246 This is also important for the classes that will be wrapped around headlines
247 and outline structure. If this variable is 1, the top-level headlines will
248 be <h1>, and the corresponding classes will be outline-1, section-number-1,
249 and outline-text-1. If this is 2, all of these will get a 2 instead.
250 The default for this variable is 2, because we use <h1> for formatting the
251 document title."
252 :group 'org-export-html
253 :type 'string)
255 (defcustom org-export-html-link-org-files-as-html t
256 "Non-nil means, make file links to `file.org' point to `file.html'.
257 When org-mode is exporting an org-mode file to HTML, links to
258 non-html files are directly put into a href tag in HTML.
259 However, links to other Org-mode files (recognized by the
260 extension `.org.) should become links to the corresponding html
261 file, assuming that the linked org-mode file will also be
262 converted to HTML.
263 When nil, the links still point to the plain `.org' file."
264 :group 'org-export-html
265 :type 'boolean)
267 (defcustom org-export-html-inline-images 'maybe
268 "Non-nil means, inline images into exported HTML pages.
269 This is done using an <img> tag. When nil, an anchor with href is used to
270 link to the image. If this option is `maybe', then images in links with
271 an empty description will be inlined, while images with a description will
272 be linked only."
273 :group 'org-export-html
274 :type '(choice (const :tag "Never" nil)
275 (const :tag "Always" t)
276 (const :tag "When there is no description" maybe)))
278 (defcustom org-export-html-inline-image-extensions
279 '("png" "jpeg" "jpg" "gif")
280 "Extensions of image files that can be inlined into HTML."
281 :group 'org-export-html
282 :type '(repeat (string :tag "Extension")))
284 (defcustom org-export-html-table-tag
285 "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">"
286 "The HTML tag that is used to start a table.
287 This must be a <table> tag, but you may change the options like
288 borders and spacing."
289 :group 'org-export-html
290 :type 'string)
292 (defcustom org-export-table-header-tags '("<th scope=\"%s\">" . "</th>")
293 "The opening tag for table header fields.
294 This is customizable so that alignment options can be specified.
295 %s will be filled with the scope of the field, either row or col.
296 See also the variable `org-export-html-table-use-header-tags-for-first-column'."
297 :group 'org-export-tables
298 :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
300 (defcustom org-export-table-data-tags '("<td>" . "</td>")
301 "The opening tag for table data fields.
302 This is customizable so that alignment options can be specified."
303 :group 'org-export-tables
304 :type '(cons (string :tag "Opening tag") (string :tag "Closing tag")))
306 (defcustom org-export-table-row-tags '("<tr>" . "</tr>")
307 "The opening tag for table data fields.
308 This is customizable so that alignment options can be specified.
309 Instead of strings, these can be Lisp forms that will be evaluated
310 for each row in order to construct the table row tags. During evaluation,
311 the variable `head' will be true when this is a header line, nil when this
312 is a body line. And the variable `nline' will contain the line number,
313 starting from 1 in the first header line. For example
315 (setq org-export-table-row-tags
316 (cons '(if head
317 \"<tr>\"
318 (if (= (mod nline 2) 1)
319 \"<tr class=\\\"tr-odd\\\">\"
320 \"<tr class=\\\"tr-even\\\">\"))
321 \"</tr>\"))
323 will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"."
324 :group 'org-export-tables
325 :type '(cons
326 (choice :tag "Opening tag"
327 (string :tag "Specify")
328 (sexp))
329 (choice :tag "Closing tag"
330 (string :tag "Specify")
331 (sexp))))
335 (defcustom org-export-html-table-use-header-tags-for-first-column nil
336 "Non-nil means, format column one in tables with header tags.
337 When nil, also column one will use data tags."
338 :group 'org-export-tables
339 :type 'boolean)
341 (defcustom org-export-html-validation-link nil
342 "Non-nil means, add validationlink to postamble of HTML exported files."
343 :group 'org-export-html
344 :type '(choice
345 (const :tag "Nothing" nil)
346 (const :tag "XHTML 1.0" "<p class=\"xhtml-validation\"><a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a></p>")
347 (string :tag "Specify full HTML")))
350 (defcustom org-export-html-with-timestamp nil
351 "If non-nil, write `org-export-html-html-helper-timestamp'
352 into the exported HTML text. Otherwise, the buffer will just be saved
353 to a file."
354 :group 'org-export-html
355 :type 'boolean)
357 (defcustom org-export-html-html-helper-timestamp
358 "<br/><br/><hr><p><!-- hhmts start --> <!-- hhmts end --></p>\n"
359 "The HTML tag used as timestamp delimiter for HTML-helper-mode."
360 :group 'org-export-html
361 :type 'string)
363 (defgroup org-export-htmlize nil
364 "Options for processing examples with htmlize.el."
365 :tag "Org Export Htmlize"
366 :group 'org-export-html)
368 (defcustom org-export-htmlize-output-type 'inline-css
369 "Output type to be used by htmlize when formatting code snippets.
370 We use as default `inline-css', in order to make the resulting
371 HTML self-containing.
372 However, this will fail when using Emacs in batch mode for export, because
373 then no rich font definitions are in place. It will also not be good if
374 people with different Emacs setup contribute HTML files to a website,
375 because the fonts will represent the individual setups. In these cases,
376 it is much better to let Org/Htmlize assign classes only, and to use
377 a style file to define the look of these classes.
378 To get a start for your css file, start Emacs session and make sure that
379 all the faces you are interested in are defined, for example by loading files
380 in all modes you want. Then, use the command
381 \\[org-export-htmlize-generate-css] to extract class definitions."
382 :group 'org-export-htmlize
383 :type '(choice (const css) (const inline-css)))
385 (defcustom org-export-htmlize-css-font-prefix "org-"
386 "The prefix for CSS class names for htmlize font specifications."
387 :group 'org-export-htmlize
388 :type 'string)
390 (defcustom org-export-htmlized-org-css-url nil
391 "URL pointing to a CSS file defining text colors for htmlized Emacs buffers.
392 Normally when creating an htmlized version of an Org buffer, htmlize will
393 create CSS to define the font colors. However, this does not work when
394 converting in batch mode, and it also can look bad if different people
395 with different fontification setup work on the same website.
396 When this variable is non-nil, creating an htmlized version of an Org buffer
397 using `org-export-as-org' will remove the internal CSS section and replace it
398 with a link to this URL."
399 :group 'org-export-htmlize
400 :type '(choice
401 (const :tag "Keep internal css" nil)
402 (string :tag "URL or local href")))
404 ;;; Variables, constants, and parameter plists
406 (defvar org-export-html-preamble nil
407 "Preamble, to be inserted just before <body>. Set by publishing functions.
408 This may also be a function, building and inserting the preamble.")
409 (defvar org-export-html-postamble nil
410 "Preamble, to be inserted just after </body>. Set by publishing functions.
411 This may also be a function, building and inserting the postamble.")
412 (defvar org-export-html-auto-preamble t
413 "Should default preamble be inserted? Set by publishing functions.")
414 (defvar org-export-html-auto-postamble t
415 "Should default postamble be inserted? Set by publishing functions.")
417 ;;; Hooks
419 (defvar org-export-html-after-blockquotes-hook nil
420 "Hook run during HTML export, after blockquote, verse, center are done.")
422 (defvar org-export-html-final-hook nil
423 "Hook run at the end of HTML export, in the new buffer.")
425 ;;; HTML export
427 (defun org-export-html-preprocess (parameters)
428 ;; Convert LaTeX fragments to images
429 (when (and org-current-export-file
430 (plist-get parameters :LaTeX-fragments))
431 (org-format-latex
432 (concat "ltxpng/" (file-name-sans-extension
433 (file-name-nondirectory
434 org-current-export-file)))
435 org-current-export-dir nil "Creating LaTeX image %s"))
436 (message "Exporting..."))
438 ;;;###autoload
439 (defun org-export-as-html-and-open (arg)
440 "Export the outline as HTML and immediately open it with a browser.
441 If there is an active region, export only the region.
442 The prefix ARG specifies how many levels of the outline should become
443 headlines. The default is 3. Lower levels will become bulleted lists."
444 (interactive "P")
445 (org-export-as-html arg 'hidden)
446 (org-open-file buffer-file-name))
448 ;;;###autoload
449 (defun org-export-as-html-batch ()
450 "Call `org-export-as-html', may be used in batch processing as
451 emacs --batch
452 --load=$HOME/lib/emacs/org.el
453 --eval \"(setq org-export-headline-levels 2)\"
454 --visit=MyFile --funcall org-export-as-html-batch"
455 (org-export-as-html org-export-headline-levels 'hidden))
457 ;;;###autoload
458 (defun org-export-as-html-to-buffer (arg)
459 "Call `org-export-as-html` with output to a temporary buffer.
460 No file is created. The prefix ARG is passed through to `org-export-as-html'."
461 (interactive "P")
462 (org-export-as-html arg nil nil "*Org HTML Export*")
463 (when org-export-show-temporary-export-buffer
464 (switch-to-buffer-other-window "*Org HTML Export*")))
466 ;;;###autoload
467 (defun org-replace-region-by-html (beg end)
468 "Assume the current region has org-mode syntax, and convert it to HTML.
469 This can be used in any buffer. For example, you could write an
470 itemized list in org-mode syntax in an HTML buffer and then use this
471 command to convert it."
472 (interactive "r")
473 (let (reg html buf pop-up-frames)
474 (save-window-excursion
475 (if (org-mode-p)
476 (setq html (org-export-region-as-html
477 beg end t 'string))
478 (setq reg (buffer-substring beg end)
479 buf (get-buffer-create "*Org tmp*"))
480 (with-current-buffer buf
481 (erase-buffer)
482 (insert reg)
483 (org-mode)
484 (setq html (org-export-region-as-html
485 (point-min) (point-max) t 'string)))
486 (kill-buffer buf)))
487 (delete-region beg end)
488 (insert html)))
490 ;;;###autoload
491 (defun org-export-region-as-html (beg end &optional body-only buffer)
492 "Convert region from BEG to END in org-mode buffer to HTML.
493 If prefix arg BODY-ONLY is set, omit file header, footer, and table of
494 contents, and only produce the region of converted text, useful for
495 cut-and-paste operations.
496 If BUFFER is a buffer or a string, use/create that buffer as a target
497 of the converted HTML. If BUFFER is the symbol `string', return the
498 produced HTML as a string and leave not buffer behind. For example,
499 a Lisp program could call this function in the following way:
501 (setq html (org-export-region-as-html beg end t 'string))
503 When called interactively, the output buffer is selected, and shown
504 in a window. A non-interactive call will only return the buffer."
505 (interactive "r\nP")
506 (when (interactive-p)
507 (setq buffer "*Org HTML Export*"))
508 (let ((transient-mark-mode t) (zmacs-regions t)
509 ext-plist rtn)
510 (setq ext-plist (plist-put ext-plist :ignore-subtree-p t))
511 (goto-char end)
512 (set-mark (point)) ;; to activate the region
513 (goto-char beg)
514 (setq rtn (org-export-as-html
515 nil nil ext-plist
516 buffer body-only))
517 (if (fboundp 'deactivate-mark) (deactivate-mark))
518 (if (and (interactive-p) (bufferp rtn))
519 (switch-to-buffer-other-window rtn)
520 rtn)))
522 (defvar html-table-tag nil) ; dynamically scoped into this.
523 (defvar org-par-open nil)
524 ;;;###autoload
525 (defun org-export-as-html (arg &optional hidden ext-plist
526 to-buffer body-only pub-dir)
527 "Export the outline as a pretty HTML file.
528 If there is an active region, export only the region. The prefix
529 ARG specifies how many levels of the outline should become
530 headlines. The default is 3. Lower levels will become bulleted
531 lists. HIDDEN is obsolete and does nothing.
532 EXT-PLIST is a property list with external parameters overriding
533 org-mode's default settings, but still inferior to file-local
534 settings. When TO-BUFFER is non-nil, create a buffer with that
535 name and export to that buffer. If TO-BUFFER is the symbol
536 `string', don't leave any buffer behind but just return the
537 resulting HTML as a string. When BODY-ONLY is set, don't produce
538 the file header and footer, simply return the content of
539 <body>...</body>, without even the body tags themselves. When
540 PUB-DIR is set, use this as the publishing directory."
541 (interactive "P")
542 (run-hooks 'org-export-first-hook)
544 ;; Make sure we have a file name when we need it.
545 (when (and (not (or to-buffer body-only))
546 (not buffer-file-name))
547 (if (buffer-base-buffer)
548 (org-set-local 'buffer-file-name
549 (with-current-buffer (buffer-base-buffer)
550 buffer-file-name))
551 (error "Need a file name to be able to export")))
553 (message "Exporting...")
554 (setq-default org-todo-line-regexp org-todo-line-regexp)
555 (setq-default org-deadline-line-regexp org-deadline-line-regexp)
556 (setq-default org-done-keywords org-done-keywords)
557 (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
558 (let* ((opt-plist
559 (org-export-process-option-filters
560 (org-combine-plists (org-default-export-plist)
561 ext-plist
562 (org-infile-export-plist))))
563 (body-only (or body-only (plist-get opt-plist :body-only)))
564 (style (concat (if (plist-get opt-plist :style-include-default)
565 org-export-html-style-default)
566 (plist-get opt-plist :style)
567 (plist-get opt-plist :style-extra)
568 "\n"
569 (if (plist-get opt-plist :style-include-scripts)
570 org-export-html-scripts)))
571 (html-extension (plist-get opt-plist :html-extension))
572 (link-validate (plist-get opt-plist :link-validation-function))
573 valid thetoc have-headings first-heading-pos
574 (odd org-odd-levels-only)
575 (region-p (org-region-active-p))
576 (rbeg (and region-p (region-beginning)))
577 (rend (and region-p (region-end)))
578 (subtree-p
579 (if (plist-get opt-plist :ignore-subtree-p)
581 (when region-p
582 (save-excursion
583 (goto-char rbeg)
584 (and (org-at-heading-p)
585 (>= (org-end-of-subtree t t) rend))))))
586 (level-offset (if subtree-p
587 (save-excursion
588 (goto-char rbeg)
589 (+ (funcall outline-level)
590 (if org-odd-levels-only 1 0)))
592 (opt-plist (setq org-export-opt-plist
593 (if subtree-p
594 (org-export-add-subtree-options opt-plist rbeg)
595 opt-plist)))
596 ;; The following two are dynamically scoped into other
597 ;; routines below.
598 (org-current-export-dir
599 (or pub-dir (org-export-directory :html opt-plist)))
600 (org-current-export-file buffer-file-name)
601 (level 0) (line "") (origline "") txt todo
602 (umax nil)
603 (umax-toc nil)
604 (filename (if to-buffer nil
605 (expand-file-name
606 (concat
607 (file-name-sans-extension
608 (or (and subtree-p
609 (org-entry-get (region-beginning)
610 "EXPORT_FILE_NAME" t))
611 (file-name-nondirectory buffer-file-name)))
612 "." html-extension)
613 (file-name-as-directory
614 (or pub-dir (org-export-directory :html opt-plist))))))
615 (current-dir (if buffer-file-name
616 (file-name-directory buffer-file-name)
617 default-directory))
618 (buffer (if to-buffer
619 (cond
620 ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*"))
621 (t (get-buffer-create to-buffer)))
622 (find-file-noselect filename)))
623 (org-levels-open (make-vector org-level-max nil))
624 (date (plist-get opt-plist :date))
625 (author (plist-get opt-plist :author))
626 (title (or (and subtree-p (org-export-get-title-from-subtree))
627 (plist-get opt-plist :title)
628 (and (not body-only)
629 (not
630 (plist-get opt-plist :skip-before-1st-heading))
631 (org-export-grab-title-from-buffer))
632 (and buffer-file-name
633 (file-name-sans-extension
634 (file-name-nondirectory buffer-file-name)))
635 "UNTITLED"))
636 (link-up (and (plist-get opt-plist :link-up)
637 (string-match "\\S-" (plist-get opt-plist :link-up))
638 (plist-get opt-plist :link-up)))
639 (link-home (and (plist-get opt-plist :link-home)
640 (string-match "\\S-" (plist-get opt-plist :link-home))
641 (plist-get opt-plist :link-home)))
642 (dummy (setq opt-plist (plist-put opt-plist :title title)))
643 (html-table-tag (plist-get opt-plist :html-table-tag))
644 (quote-re0 (concat "^[ \t]*" org-quote-string "\\>"))
645 (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
646 (inquote nil)
647 (infixed nil)
648 (inverse nil)
649 (in-local-list nil)
650 (local-list-type nil)
651 (local-list-indent nil)
652 (llt org-plain-list-ordered-item-terminator)
653 (email (plist-get opt-plist :email))
654 (language (plist-get opt-plist :language))
655 (keywords (plist-get opt-plist :keywords))
656 (description (plist-get opt-plist :description))
657 (lang-words nil)
658 (head-count 0) cnt
659 (start 0)
660 (coding-system (and (boundp 'buffer-file-coding-system)
661 buffer-file-coding-system))
662 (coding-system-for-write (or org-export-html-coding-system
663 coding-system))
664 (save-buffer-coding-system (or org-export-html-coding-system
665 coding-system))
666 (charset (and coding-system-for-write
667 (fboundp 'coding-system-get)
668 (coding-system-get coding-system-for-write
669 'mime-charset)))
670 (region
671 (buffer-substring
672 (if region-p (region-beginning) (point-min))
673 (if region-p (region-end) (point-max))))
674 (lines
675 (org-split-string
676 (org-export-preprocess-string
677 region
678 :emph-multiline t
679 :for-html t
680 :skip-before-1st-heading
681 (plist-get opt-plist :skip-before-1st-heading)
682 :drawers (plist-get opt-plist :drawers)
683 :todo-keywords (plist-get opt-plist :todo-keywords)
684 :tags (plist-get opt-plist :tags)
685 :priority (plist-get opt-plist :priority)
686 :footnotes (plist-get opt-plist :footnotes)
687 :timestamps (plist-get opt-plist :timestamps)
688 :archived-trees
689 (plist-get opt-plist :archived-trees)
690 :select-tags (plist-get opt-plist :select-tags)
691 :exclude-tags (plist-get opt-plist :exclude-tags)
692 :add-text
693 (plist-get opt-plist :text)
694 :LaTeX-fragments
695 (plist-get opt-plist :LaTeX-fragments))
696 "[\r\n]"))
697 table-open type
698 table-buffer table-orig-buffer
699 ind item-type starter didclose
700 rpl path attr desc descp desc1 desc2 link
701 snumber fnc item-tag
702 footnotes footref-seen
703 id-file href
706 (let ((inhibit-read-only t))
707 (org-unmodified
708 (remove-text-properties (point-min) (point-max)
709 '(:org-license-to-kill t))))
711 (message "Exporting...")
713 (setq org-min-level (org-get-min-level lines level-offset))
714 (setq org-last-level org-min-level)
715 (org-init-section-numbers)
717 (cond
718 ((and date (string-match "%" date))
719 (setq date (format-time-string date)))
720 (date)
721 (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
723 ;; Get the language-dependent settings
724 (setq lang-words (or (assoc language org-export-language-setup)
725 (assoc "en" org-export-language-setup)))
727 ;; Switch to the output buffer
728 (set-buffer buffer)
729 (let ((inhibit-read-only t)) (erase-buffer))
730 (fundamental-mode)
731 (org-install-letbind)
733 (and (fboundp 'set-buffer-file-coding-system)
734 (set-buffer-file-coding-system coding-system-for-write))
736 (let ((case-fold-search nil)
737 (org-odd-levels-only odd))
738 ;; create local variables for all options, to make sure all called
739 ;; functions get the correct information
740 (mapc (lambda (x)
741 (set (make-local-variable (nth 2 x))
742 (plist-get opt-plist (car x))))
743 org-export-plist-vars)
744 (setq umax (if arg (prefix-numeric-value arg)
745 org-export-headline-levels))
746 (setq umax-toc (if (integerp org-export-with-toc)
747 (min org-export-with-toc umax)
748 umax))
749 (unless body-only
750 ;; File header
751 (insert (format
753 <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
754 \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">
755 <html xmlns=\"http://www.w3.org/1999/xhtml\"
756 lang=\"%s\" xml:lang=\"%s\">
757 <head>
758 <title>%s</title>
759 <meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>
760 <meta name=\"generator\" content=\"Org-mode\"/>
761 <meta name=\"generated\" content=\"%s\"/>
762 <meta name=\"author\" content=\"%s\"/>
763 <meta name=\"description\" content=\"%s\"/>
764 <meta name=\"keywords\" content=\"%s\"/>
766 </head>
767 <body>
768 <div id=\"content\">
771 (format
772 (or (and (stringp org-export-html-xml-declaration)
773 org-export-html-xml-declaration)
774 (cdr (assoc html-extension org-export-html-xml-declaration))
775 (cdr (assoc "html" org-export-html-xml-declaration))
778 (or charset "iso-8859-1"))
779 language language
780 (org-html-expand title)
781 (or charset "iso-8859-1")
782 date author description keywords
783 style
784 (if (or link-up link-home)
785 (concat
786 (format org-export-html-home/up-format
787 (or link-up link-home)
788 (or link-home link-up))
789 "\n")
790 "")))
792 (org-export-html-insert-plist-item opt-plist :preamble opt-plist)
794 (when (plist-get opt-plist :auto-preamble)
795 (if title (insert (format org-export-html-title-format
796 (org-html-expand title))))))
798 (if (and org-export-with-toc (not body-only))
799 (progn
800 (push (format "<h%d>%s</h%d>\n"
801 org-export-html-toplevel-hlevel
802 (nth 3 lang-words)
803 org-export-html-toplevel-hlevel)
804 thetoc)
805 (push "<div id=\"text-table-of-contents\">\n" thetoc)
806 (push "<ul>\n<li>" thetoc)
807 (setq lines
808 (mapcar '(lambda (line)
809 (if (string-match org-todo-line-regexp line)
810 ;; This is a headline
811 (progn
812 (setq have-headings t)
813 (setq level (- (match-end 1) (match-beginning 1)
814 level-offset)
815 level (org-tr-level level)
816 txt (save-match-data
817 (org-html-expand
818 (org-export-cleanup-toc-line
819 (match-string 3 line))))
820 todo
821 (or (and org-export-mark-todo-in-toc
822 (match-beginning 2)
823 (not (member (match-string 2 line)
824 org-done-keywords)))
825 ; TODO, not DONE
826 (and org-export-mark-todo-in-toc
827 (= level umax-toc)
828 (org-search-todo-below
829 line lines level))))
830 (if (string-match
831 (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
832 (setq txt (replace-match "&nbsp;&nbsp;&nbsp;<span class=\"tag\"> \\1</span>" t nil txt)))
833 (if (string-match quote-re0 txt)
834 (setq txt (replace-match "" t t txt)))
835 (setq snumber (org-section-number level))
836 (if org-export-with-section-numbers
837 (setq txt (concat snumber " " txt)))
838 (if (<= level (max umax umax-toc))
839 (setq head-count (+ head-count 1)))
840 (if (<= level umax-toc)
841 (progn
842 (if (> level org-last-level)
843 (progn
844 (setq cnt (- level org-last-level))
845 (while (>= (setq cnt (1- cnt)) 0)
846 (push "\n<ul>\n<li>" thetoc))
847 (push "\n" thetoc)))
848 (if (< level org-last-level)
849 (progn
850 (setq cnt (- org-last-level level))
851 (while (>= (setq cnt (1- cnt)) 0)
852 (push "</li>\n</ul>" thetoc))
853 (push "\n" thetoc)))
854 ;; Check for targets
855 (while (string-match org-any-target-regexp line)
856 (setq line (replace-match
857 (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ")
858 t t line)))
859 (while (string-match "&lt;\\(&lt;\\)+\\|&gt;\\(&gt;\\)+" txt)
860 (setq txt (replace-match "" t t txt)))
861 (setq href (format "sec-%s" snumber))
862 (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href))
863 (push
864 (format
865 (if todo
866 "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>"
867 "</li>\n<li><a href=\"#%s\">%s</a>")
868 href txt) thetoc)
870 (setq org-last-level level))
872 line)
873 lines))
874 (while (> org-last-level (1- org-min-level))
875 (setq org-last-level (1- org-last-level))
876 (push "</li>\n</ul>\n" thetoc))
877 (push "</div>\n" thetoc)
878 (setq thetoc (if have-headings (nreverse thetoc) nil))))
880 (setq head-count 0)
881 (org-init-section-numbers)
883 (org-open-par)
885 (while (setq line (pop lines) origline line)
886 (catch 'nextline
888 ;; end of quote section?
889 (when (and inquote (string-match "^\\*+ " line))
890 (insert "</pre>\n")
891 (org-open-par)
892 (setq inquote nil))
893 ;; inside a quote section?
894 (when inquote
895 (insert (org-html-protect line) "\n")
896 (throw 'nextline nil))
898 ;; Fixed-width, verbatim lines (examples)
899 (when (and org-export-with-fixed-width
900 (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
901 (when (not infixed)
902 (setq infixed t)
903 (org-close-par-maybe)
905 (insert "<pre class=\"example\">\n"))
906 (insert (org-html-protect (match-string 3 line)) "\n")
907 (when (or (not lines)
908 (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
909 (car lines))))
910 (setq infixed nil)
911 (insert "</pre>\n")
912 (org-open-par))
913 (throw 'nextline nil))
915 (org-export-html-close-lists-maybe line)
917 ;; Protected HTML
918 (when (get-text-property 0 'org-protected line)
919 (let (par (ind (get-text-property 0 'original-indentation line)))
920 (when (re-search-backward
921 "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
922 (setq par (match-string 1))
923 (replace-match "\\2\n"))
924 (insert line "\n")
925 (while (and lines
926 (or (= (length (car lines)) 0)
927 (not ind)
928 (equal ind (get-text-property 0 'original-indentation (car lines))))
929 (or (= (length (car lines)) 0)
930 (get-text-property 0 'org-protected (car lines))))
931 (insert (pop lines) "\n"))
932 (and par (insert "<p>\n")))
933 (throw 'nextline nil))
935 ;; Blockquotes, verse, and center
936 (when (equal "ORG-BLOCKQUOTE-START" line)
937 (org-close-par-maybe)
938 (insert "<blockquote>\n")
939 (org-open-par)
940 (throw 'nextline nil))
941 (when (equal "ORG-BLOCKQUOTE-END" line)
942 (org-close-par-maybe)
943 (insert "\n</blockquote>\n")
944 (org-open-par)
945 (throw 'nextline nil))
946 (when (equal "ORG-VERSE-START" line)
947 (org-close-par-maybe)
948 (insert "\n<p class=\"verse\">\n")
949 (setq inverse t)
950 (throw 'nextline nil))
951 (when (equal "ORG-VERSE-END" line)
952 (insert "</p>\n")
953 (org-open-par)
954 (setq inverse nil)
955 (throw 'nextline nil))
956 (when (equal "ORG-CENTER-START" line)
957 (org-close-par-maybe)
958 (insert "\n<div style=\"text-align: center\">")
959 (org-open-par)
960 (throw 'nextline nil))
961 (when (equal "ORG-CENTER-END" line)
962 (org-close-par-maybe)
963 (insert "\n</div>")
964 (org-open-par)
965 (throw 'nextline nil))
966 (run-hooks 'org-export-html-after-blockquotes-hook)
967 (when inverse
968 (let ((i (org-get-string-indentation line)))
969 (if (> i 0)
970 (setq line (concat (mapconcat 'identity
971 (make-list (* 2 i) "\\nbsp") "")
972 " " (org-trim line))))
973 (unless (string-match "\\\\\\\\[ \t]*$" line)
974 (setq line (concat line "\\\\")))))
976 ;; make targets to anchors
977 (setq start 0)
978 (while (string-match
979 "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start)
980 (cond
981 ((get-text-property (match-beginning 1) 'org-protected line)
982 (setq start (match-end 1)))
983 ((match-end 2)
984 (setq line (replace-match
985 (format
986 "@<a name=\"%s\" id=\"%s\">@</a>"
987 (org-solidify-link-text (match-string 1 line))
988 (org-solidify-link-text (match-string 1 line)))
989 t t line)))
990 ((and org-export-with-toc (equal (string-to-char line) ?*))
991 ;; FIXME: NOT DEPENDENT on TOC?????????????????????
992 (setq line (replace-match
993 (concat "@<span class=\"target\">"
994 (match-string 1 line) "@</span> ")
995 ;; (concat "@<i>" (match-string 1 line) "@</i> ")
996 t t line)))
998 (setq line (replace-match
999 (concat "@<a name=\""
1000 (org-solidify-link-text (match-string 1 line))
1001 "\" class=\"target\">" (match-string 1 line)
1002 "@</a> ")
1003 t t line)))))
1005 (setq line (org-html-handle-time-stamps line))
1007 ;; replace "&" by "&amp;", "<" and ">" by "&lt;" and "&gt;"
1008 ;; handle @<..> HTML tags (replace "@&gt;..&lt;" by "<..>")
1009 ;; Also handle sub_superscripts and checkboxes
1010 (or (string-match org-table-hline-regexp line)
1011 (setq line (org-html-expand line)))
1013 ;; Format the links
1014 (setq start 0)
1015 (while (string-match org-bracket-link-analytic-regexp++ line start)
1016 (setq start (match-beginning 0))
1017 (setq path (save-match-data (org-link-unescape
1018 (match-string 3 line))))
1019 (setq type (cond
1020 ((match-end 2) (match-string 2 line))
1021 ((save-match-data
1022 (or (file-name-absolute-p path)
1023 (string-match "^\\.\\.?/" path)))
1024 "file")
1025 (t "internal")))
1026 (setq path (org-extract-attributes (org-link-unescape path)))
1027 (setq attr (get-text-property 0 'org-attributes path))
1028 (setq desc1 (if (match-end 5) (match-string 5 line))
1029 desc2 (if (match-end 2) (concat type ":" path) path)
1030 descp (and desc1 (not (equal desc1 desc2)))
1031 desc (or desc1 desc2))
1032 ;; Make an image out of the description if that is so wanted
1033 (when (and descp (org-file-image-p
1034 desc org-export-html-inline-image-extensions))
1035 (save-match-data
1036 (if (string-match "^file:" desc)
1037 (setq desc (substring desc (match-end 0)))))
1038 (setq desc (org-add-props
1039 (concat "<img src=\"" desc "\"/>")
1040 '(org-protected t))))
1041 ;; FIXME: do we need to unescape here somewhere?
1042 (cond
1043 ((equal type "internal")
1044 (setq rpl
1045 (concat
1046 "<a href=\""
1047 (if (= (string-to-char path) ?#) "" "#")
1048 (org-solidify-link-text
1049 (save-match-data (org-link-unescape path)) nil)
1050 "\"" attr ">"
1051 (org-export-html-format-desc desc)
1052 "</a>")))
1053 ((and (equal type "id")
1054 (setq id-file (org-id-find-id-file path)))
1055 ;; This is an id: link to another file (if it was the same file,
1056 ;; it would have become an internal link...)
1057 (save-match-data
1058 (setq id-file (file-relative-name
1059 id-file (file-name-directory org-current-export-file)))
1060 (setq id-file (concat (file-name-sans-extension id-file)
1061 "." html-extension))
1062 (setq rpl (concat "<a href=\"" id-file "#"
1063 (if (org-uuidgen-p path) "ID-")
1064 path "\""
1065 attr ">"
1066 (org-export-html-format-desc desc)
1067 "</a>"))))
1068 ((member type '("http" "https"))
1069 ;; standard URL, just check if we need to inline an image
1070 (if (and (or (eq t org-export-html-inline-images)
1071 (and org-export-html-inline-images (not descp)))
1072 (org-file-image-p
1073 path org-export-html-inline-image-extensions))
1074 (setq rpl (org-export-html-format-image
1075 (concat type ":" path) org-par-open))
1076 (setq link (concat type ":" path))
1077 (setq rpl (concat "<a href=\""
1078 (org-export-html-format-href link)
1079 "\"" attr ">"
1080 (org-export-html-format-desc desc)
1081 "</a>"))))
1082 ((member type '("ftp" "mailto" "news"))
1083 ;; standard URL
1084 (setq link (concat type ":" path))
1085 (setq rpl (concat "<a href=\""
1086 (org-export-html-format-href link)
1087 "\"" attr ">"
1088 (org-export-html-format-desc desc)
1089 "</a>")))
1091 ((string= type "coderef")
1092 (setq rpl (format "<a href=\"#coderef-%s\" class=\"coderef\" onmouseover=\"CodeHighlightOn(this, 'coderef-%s');\" onmouseout=\"CodeHighlightOff(this, 'coderef-%s');\">%s</a>"
1093 path path path
1094 (format (org-export-get-coderef-format path (and descp desc))
1095 (cdr (assoc path org-export-code-refs))))))
1097 ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
1098 ;; The link protocol has a function for format the link
1099 (setq rpl
1100 (save-match-data
1101 (funcall fnc (org-link-unescape path) desc1 'html))))
1103 ((string= type "file")
1104 ;; FILE link
1105 (let* ((filename path)
1106 (abs-p (file-name-absolute-p filename))
1107 thefile file-is-image-p search)
1108 (save-match-data
1109 (if (string-match "::\\(.*\\)" filename)
1110 (setq search (match-string 1 filename)
1111 filename (replace-match "" t nil filename)))
1112 (setq valid
1113 (if (functionp link-validate)
1114 (funcall link-validate filename current-dir)
1116 (setq file-is-image-p
1117 (org-file-image-p
1118 filename org-export-html-inline-image-extensions))
1119 (setq thefile (if abs-p (expand-file-name filename) filename))
1120 (when (and org-export-html-link-org-files-as-html
1121 (string-match "\\.org$" thefile))
1122 (setq thefile (concat (substring thefile 0
1123 (match-beginning 0))
1124 "." html-extension))
1125 (if (and search
1126 ;; make sure this is can be used as target search
1127 (not (string-match "^[0-9]*$" search))
1128 (not (string-match "^\\*" search))
1129 (not (string-match "^/.*/$" search)))
1130 (setq thefile (concat thefile "#"
1131 (org-solidify-link-text
1132 (org-link-unescape search)))))
1133 (when (string-match "^file:" desc)
1134 (setq desc (replace-match "" t t desc))
1135 (if (string-match "\\.org$" desc)
1136 (setq desc (replace-match "" t t desc))))))
1137 (setq rpl (if (and file-is-image-p
1138 (or (eq t org-export-html-inline-images)
1139 (and org-export-html-inline-images
1140 (not descp))))
1141 (progn
1142 (message "image %s %s" thefile org-par-open)
1143 (org-export-html-format-image thefile org-par-open))
1144 (concat "<a href=\"" thefile "\"" attr ">"
1145 (org-export-html-format-desc desc)
1146 "</a>")))
1147 (if (not valid) (setq rpl desc))))
1150 ;; just publish the path, as default
1151 (setq rpl (concat "<i>&lt;" type ":"
1152 (save-match-data (org-link-unescape path))
1153 "&gt;</i>"))))
1154 (setq line (replace-match rpl t t line)
1155 start (+ start (length rpl))))
1157 ;; TODO items
1158 (if (and (string-match org-todo-line-regexp line)
1159 (match-beginning 2))
1161 (setq line
1162 (concat (substring line 0 (match-beginning 2))
1163 "<span class=\""
1164 (if (member (match-string 2 line)
1165 org-done-keywords)
1166 "done" "todo")
1167 " " (match-string 2 line)
1168 "\"> " (org-export-html-get-todo-kwd-class-name
1169 (match-string 2 line))
1170 "</span>" (substring line (match-end 2)))))
1172 ;; Does this contain a reference to a footnote?
1173 (when org-export-with-footnotes
1174 (setq start 0)
1175 (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
1176 (if (get-text-property (match-beginning 2) 'org-protected line)
1177 (setq start (match-end 2))
1178 (let ((n (match-string 2 line)) extra a)
1179 (if (setq a (assoc n footref-seen))
1180 (progn
1181 (setcdr a (1+ (cdr a)))
1182 (setq extra (format ".%d" (cdr a))))
1183 (setq extra "")
1184 (push (cons n 1) footref-seen))
1185 (setq line
1186 (replace-match
1187 (format
1188 (concat "%s"
1189 (format org-export-html-footnote-format
1190 "<a class=\"footref\" name=\"fnr.%s%s\" href=\"#fn.%s\">%s</a>"))
1191 (or (match-string 1 line) "") n extra n n)
1192 t t line))))))
1194 (cond
1195 ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
1196 ;; This is a headline
1197 (setq level (org-tr-level (- (match-end 1) (match-beginning 1)
1198 level-offset))
1199 txt (match-string 2 line))
1200 (if (string-match quote-re0 txt)
1201 (setq txt (replace-match "" t t txt)))
1202 (if (<= level (max umax umax-toc))
1203 (setq head-count (+ head-count 1)))
1204 (when in-local-list
1205 ;; Close any local lists before inserting a new header line
1206 (while local-list-type
1207 (org-close-li (car local-list-type))
1208 (insert (format "</%sl>\n" (car local-list-type)))
1209 (pop local-list-type))
1210 (setq local-list-indent nil
1211 in-local-list nil))
1212 (setq first-heading-pos (or first-heading-pos (point)))
1213 (org-html-level-start level txt umax
1214 (and org-export-with-toc (<= level umax))
1215 head-count)
1217 ;; QUOTES
1218 (when (string-match quote-re line)
1219 (org-close-par-maybe)
1220 (insert "<pre>")
1221 (setq inquote t)))
1223 ((string-match "^[ \t]*- __+[ \t]*$" line)
1224 ;; Explicit list closure
1225 (when local-list-type
1226 (let ((ind (org-get-indentation line)))
1227 (while (and local-list-indent
1228 (<= ind (car local-list-indent)))
1229 (org-close-li (car local-list-type))
1230 (insert (format "</%sl>\n" (car local-list-type)))
1231 (pop local-list-type)
1232 (pop local-list-indent))
1233 (or local-list-indent (setq in-local-list nil))))
1234 (throw 'nextline nil))
1236 ((and org-export-with-tables
1237 (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
1238 (when (not table-open)
1239 ;; New table starts
1240 (setq table-open t table-buffer nil table-orig-buffer nil))
1242 ;; Accumulate lines
1243 (setq table-buffer (cons line table-buffer)
1244 table-orig-buffer (cons origline table-orig-buffer))
1245 (when (or (not lines)
1246 (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
1247 (car lines))))
1248 (setq table-open nil
1249 table-buffer (nreverse table-buffer)
1250 table-orig-buffer (nreverse table-orig-buffer))
1251 (org-close-par-maybe)
1252 (insert (org-format-table-html table-buffer table-orig-buffer))))
1254 ;; Normal lines
1255 (when (string-match
1256 (cond
1257 ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
1258 ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
1259 ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
1260 (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
1261 line)
1262 (setq ind (or (get-text-property 0 'original-indentation line)
1263 (org-get-string-indentation line))
1264 item-type (if (match-beginning 4) "o" "u")
1265 starter (if (match-beginning 2)
1266 (substring (match-string 2 line) 0 -1))
1267 line (substring line (match-beginning 5))
1268 item-tag nil)
1269 (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line))
1270 (setq item-type "d"
1271 item-tag (match-string 1 line)
1272 line (substring line (match-end 0))))
1273 (when (and (not (equal item-type "d"))
1274 (not (string-match "[^ \t]" line)))
1275 ;; empty line. Pretend indentation is large.
1276 (setq ind (if org-empty-line-terminates-plain-lists
1278 (1+ (or (car local-list-indent) 1)))))
1279 (setq didclose nil)
1280 (while (and in-local-list
1281 (or (and (= ind (car local-list-indent))
1282 (not starter))
1283 (< ind (car local-list-indent))))
1284 (setq didclose t)
1285 (org-close-li (car local-list-type))
1286 (insert (format "</%sl>\n" (car local-list-type)))
1287 (pop local-list-type) (pop local-list-indent)
1288 (setq in-local-list local-list-indent))
1289 (cond
1290 ((and starter
1291 (or (not in-local-list)
1292 (> ind (car local-list-indent))))
1293 ;; Start new (level of) list
1294 (org-close-par-maybe)
1295 (insert (cond
1296 ((equal item-type "u") "<ul>\n<li>\n")
1297 ((equal item-type "o") "<ol>\n<li>\n")
1298 ((equal item-type "d")
1299 (format "<dl>\n<dt>%s</dt><dd>\n" item-tag))))
1300 (push item-type local-list-type)
1301 (push ind local-list-indent)
1302 (setq in-local-list t))
1303 (starter
1304 ;; continue current list
1305 (org-close-li (car local-list-type))
1306 (insert (cond
1307 ((equal (car local-list-type) "d")
1308 (format "<dt>%s</dt><dd>\n" (or item-tag "???")))
1309 (t "<li>\n"))))
1310 (didclose
1311 ;; we did close a list, normal text follows: need <p>
1312 (org-open-par)))
1313 (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line)
1314 (setq line
1315 (replace-match
1316 (if (equal (match-string 1 line) "X")
1317 "<b>[X]</b>"
1318 "<b>[<span style=\"visibility:hidden;\">X</span>]</b>")
1319 t t line))))
1321 ;; Horizontal line
1322 (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
1323 (if org-par-open
1324 (insert "\n</p>\n<hr/>\n<p>\n")
1325 (insert "\n<hr/>\n"))
1326 (throw 'nextline nil))
1328 ;; Empty lines start a new paragraph. If hand-formatted lists
1329 ;; are not fully interpreted, lines starting with "-", "+", "*"
1330 ;; also start a new paragraph.
1331 (if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
1333 ;; Is this the start of a footnote?
1334 (when org-export-with-footnotes
1335 (when (and (boundp 'footnote-section-tag-regexp)
1336 (string-match (concat "^" footnote-section-tag-regexp)
1337 line))
1338 ;; ignore this line
1339 (throw 'nextline nil))
1340 (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
1341 (org-close-par-maybe)
1342 (let ((n (match-string 1 line)))
1343 (setq org-par-open t
1344 line (replace-match
1345 (format
1346 (concat "<p class=\"footnote\">"
1347 (format org-export-html-footnote-format
1348 "<a class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a>"))
1349 n n n) t t line)))))
1350 ;; Check if the line break needs to be conserved
1351 (cond
1352 ((string-match "\\\\\\\\[ \t]*$" line)
1353 (setq line (replace-match "<br/>" t t line)))
1354 (org-export-preserve-breaks
1355 (setq line (concat line "<br/>"))))
1357 ;; Check if a paragraph should be started
1358 (let ((start 0))
1359 (while (and org-par-open
1360 (string-match "\\\\par\\>" line start))
1361 ;; Leave a space in the </p> so that the footnote matcher
1362 ;; does not see this.
1363 (if (not (get-text-property (match-beginning 0)
1364 'org-protected line))
1365 (setq line (replace-match "</p ><p >" t t line)))
1366 (setq start (match-end 0))))
1368 (insert line "\n")))))
1370 ;; Properly close all local lists and other lists
1371 (when inquote
1372 (insert "</pre>\n")
1373 (org-open-par))
1374 (when in-local-list
1375 ;; Close any local lists before inserting a new header line
1376 (while local-list-type
1377 (org-close-li (car local-list-type))
1378 (insert (format "</%sl>\n" (car local-list-type)))
1379 (pop local-list-type))
1380 (setq local-list-indent nil
1381 in-local-list nil))
1382 (org-html-level-start 1 nil umax
1383 (and org-export-with-toc (<= level umax))
1384 head-count)
1385 ;; the </div> to close the last text-... div.
1386 (when (and (> umax 0) first-heading-pos) (insert "</div>\n"))
1388 (save-excursion
1389 (goto-char (point-min))
1390 (while (re-search-forward "<p class=\"footnote\">[^\000]*?\\(</p>\\|\\'\\)" nil t)
1391 (push (match-string 0) footnotes)
1392 (replace-match "" t t)))
1393 (when footnotes
1394 (insert (format org-export-html-footnotes-section
1395 (nth 4 lang-words)
1396 (mapconcat 'identity (nreverse footnotes) "\n"))
1397 "\n"))
1398 (let ((bib (org-export-html-get-bibliography)))
1399 (when bib
1400 (insert "\n" bib "\n")))
1401 (unless body-only
1402 (when (plist-get opt-plist :auto-postamble)
1403 (insert "<div id=\"postamble\">\n")
1404 (when (and org-export-author-info author)
1405 (insert "<p class=\"author\"> "
1406 (nth 1 lang-words) ": " author "\n")
1407 (when email
1408 (if (listp (split-string email ",+ *"))
1409 (mapc (lambda(e)
1410 (insert "<a href=\"mailto:" e "\">&lt;"
1411 e "&gt;</a>\n"))
1412 (split-string email ",+ *"))
1413 (insert "<a href=\"mailto:" email "\">&lt;"
1414 email "&gt;</a>\n")))
1415 (insert "</p>\n"))
1416 (when (and date org-export-time-stamp-file)
1417 (insert "<p class=\"date\"> "
1418 (nth 2 lang-words) ": "
1419 date "</p>\n"))
1420 (when org-export-creator-info
1421 (insert (format "<p class=\"creator\">HTML generated by org-mode %s in emacs %s</p>\n"
1422 org-version emacs-major-version)))
1423 (when org-export-html-validation-link
1424 (insert org-export-html-validation-link "\n"))
1425 (insert "</div>"))
1427 (if org-export-html-with-timestamp
1428 (insert org-export-html-html-helper-timestamp))
1429 (org-export-html-insert-plist-item opt-plist :postamble opt-plist)
1430 (insert "\n</div>\n</body>\n</html>\n"))
1432 (unless (plist-get opt-plist :buffer-will-be-killed)
1433 (normal-mode)
1434 (if (eq major-mode (default-value 'major-mode))
1435 (html-mode)))
1437 ;; insert the table of contents
1438 (goto-char (point-min))
1439 (when thetoc
1440 (if (or (re-search-forward
1441 "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t)
1442 (re-search-forward
1443 "\\[TABLE-OF-CONTENTS\\]" nil t))
1444 (progn
1445 (goto-char (match-beginning 0))
1446 (replace-match ""))
1447 (goto-char first-heading-pos)
1448 (when (looking-at "\\s-*</p>")
1449 (goto-char (match-end 0))
1450 (insert "\n")))
1451 (insert "<div id=\"table-of-contents\">\n")
1452 (mapc 'insert thetoc)
1453 (insert "</div>\n"))
1454 ;; remove empty paragraphs and lists
1455 (goto-char (point-min))
1456 (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t)
1457 (replace-match ""))
1458 (goto-char (point-min))
1459 (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t)
1460 (replace-match ""))
1461 (goto-char (point-min))
1462 (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t)
1463 (replace-match ""))
1464 ;; Convert whitespace place holders
1465 (goto-char (point-min))
1466 (let (beg end n)
1467 (while (setq beg (next-single-property-change (point) 'org-whitespace))
1468 (setq n (get-text-property beg 'org-whitespace)
1469 end (next-single-property-change beg 'org-whitespace))
1470 (goto-char beg)
1471 (delete-region beg end)
1472 (insert (format "<span style=\"visibility:hidden;\">%s</span>"
1473 (make-string n ?x)))))
1474 ;; Remove empty lines at the beginning of the file.
1475 (goto-char (point-min))
1476 (when (looking-at "\\s-+\n") (replace-match ""))
1477 ;; Remove display properties
1478 (remove-text-properties (point-min) (point-max) '(display t))
1479 ;; Run the hook
1480 (run-hooks 'org-export-html-final-hook)
1481 (or to-buffer (save-buffer))
1482 (goto-char (point-min))
1483 (or (org-export-push-to-kill-ring "HTML")
1484 (message "Exporting... done"))
1485 (if (eq to-buffer 'string)
1486 (prog1 (buffer-substring (point-min) (point-max))
1487 (kill-buffer (current-buffer)))
1488 (current-buffer)))))
1490 (defun org-export-html-insert-plist-item (plist key &rest args)
1491 (let ((item (plist-get plist key)))
1492 (cond ((functionp item)
1493 (apply item args))
1494 (item
1495 (insert item)))))
1497 (defun org-export-html-format-href (s)
1498 "Make sure the S is valid as a href reference in an XHTML document."
1499 (save-match-data
1500 (let ((start 0))
1501 (while (string-match "&" s start)
1502 (setq start (+ (match-beginning 0) 3)
1503 s (replace-match "&amp;" t t s)))))
1506 (defun org-export-html-format-desc (s)
1507 "Make sure the S is valid as a description in a link."
1508 (if (and s (not (get-text-property 1 'org-protected s)))
1509 (save-match-data
1510 (org-html-do-expand s))
1513 (defun org-export-html-format-image (src par-open)
1514 "Create image tag with source and attributes."
1515 (save-match-data
1516 (if (string-match "^ltxpng/" src)
1517 (format "<img src=\"%s\"/>" src)
1518 (let* ((caption (org-find-text-property-in-string 'org-caption src))
1519 (attr (org-find-text-property-in-string 'org-attributes src))
1520 (label (org-find-text-property-in-string 'org-label src)))
1521 (concat
1522 (if caption
1523 (format "%s<div %sclass=\"figure\">
1524 <p>"
1525 (if org-par-open "</p>\n" "")
1526 (if label (format "id=\"%s\" " label) "")))
1527 (format "<img src=\"%s\"%s />"
1529 (if (string-match "\\<alt=" (or attr ""))
1530 (concat " " attr )
1531 (concat " " attr " alt=\"" src "\"")))
1532 (if caption
1533 (format "</p>%s
1534 </div>%s"
1535 (concat "\n<p>" caption "</p>")
1536 (if org-par-open "\n<p>" ""))))))))
1538 (defun org-export-html-get-bibliography ()
1539 "Find bibliography, cut it out and return it."
1540 (catch 'exit
1541 (let (beg end (cnt 1) bib)
1542 (save-excursion
1543 (goto-char (point-min))
1544 (when (re-search-forward "^[ \t]*<div \\(id\\|class\\)=\"bibliography\"" nil t)
1545 (setq beg (match-beginning 0))
1546 (while (re-search-forward "</?div\\>" nil t)
1547 (setq cnt (+ cnt (if (string= (match-string 0) "<div") +1 -1)))
1548 (when (= cnt 0)
1549 (and (looking-at ">") (forward-char 1))
1550 (setq bib (buffer-substring beg (point)))
1551 (delete-region beg (point))
1552 (throw 'exit bib))))
1553 nil))))
1555 (defvar org-table-number-regexp) ; defined in org-table.el
1556 (defun org-format-table-html (lines olines)
1557 "Find out which HTML converter to use and return the HTML code."
1558 (if (stringp lines)
1559 (setq lines (org-split-string lines "\n")))
1560 (if (string-match "^[ \t]*|" (car lines))
1561 ;; A normal org table
1562 (org-format-org-table-html lines)
1563 ;; Table made by table.el - test for spanning
1564 (let* ((hlines (delq nil (mapcar
1565 (lambda (x)
1566 (if (string-match "^[ \t]*\\+-" x) x
1567 nil))
1568 lines)))
1569 (first (car hlines))
1570 (ll (and (string-match "\\S-+" first)
1571 (match-string 0 first)))
1572 (re (concat "^[ \t]*" (regexp-quote ll)))
1573 (spanning (delq nil (mapcar (lambda (x) (not (string-match re x)))
1574 hlines))))
1575 (if (and (not spanning)
1576 (not org-export-prefer-native-exporter-for-tables))
1577 ;; We can use my own converter with HTML conversions
1578 (org-format-table-table-html lines)
1579 ;; Need to use the code generator in table.el, with the original text.
1580 (org-format-table-table-html-using-table-generate-source olines)))))
1582 (defvar org-table-number-fraction) ; defined in org-table.el
1583 (defun org-format-org-table-html (lines &optional splice)
1584 "Format a table into HTML."
1585 (require 'org-table)
1586 ;; Get rid of hlines at beginning and end
1587 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1588 (setq lines (nreverse lines))
1589 (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines)))
1590 (setq lines (nreverse lines))
1591 (when org-export-table-remove-special-lines
1592 ;; Check if the table has a marking column. If yes remove the
1593 ;; column and the special lines
1594 (setq lines (org-table-clean-before-export lines)))
1596 (let* ((caption (or (get-text-property 0 'org-caption (car lines))
1597 (get-text-property (or (next-single-property-change
1598 0 'org-caption (car lines))
1600 'org-caption (car lines))))
1601 (attributes (or (get-text-property 0 'org-attributes (car lines))
1602 (get-text-property (or (next-single-property-change
1603 0 'org-attributes (car lines))
1605 'org-attributes (car lines))))
1606 (html-table-tag (org-export-splice-attributes
1607 html-table-tag attributes))
1608 (head (and org-export-highlight-first-table-line
1609 (delq nil (mapcar
1610 (lambda (x) (string-match "^[ \t]*|-" x))
1611 (cdr lines)))))
1613 (nline 0) fnum i
1614 tbopen line fields html gr colgropen rowstart rowend)
1615 (if splice (setq head nil))
1616 (unless splice (push (if head "<thead>" "<tbody>") html))
1617 (setq tbopen t)
1618 (while (setq line (pop lines))
1619 (catch 'next-line
1620 (if (string-match "^[ \t]*|-" line)
1621 (progn
1622 (unless splice
1623 (push (if head "</thead>" "</tbody>") html)
1624 (if lines (push "<tbody>" html) (setq tbopen nil)))
1625 (setq head nil) ;; head ends here, first time around
1626 ;; ignore this line
1627 (throw 'next-line t)))
1628 ;; Break the line into fields
1629 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
1630 (unless fnum (setq fnum (make-vector (length fields) 0)))
1631 (setq nline (1+ nline) i -1
1632 rowstart (eval (car org-export-table-row-tags))
1633 rowend (eval (cdr org-export-table-row-tags)))
1634 (push (concat rowstart
1635 (mapconcat
1636 (lambda (x)
1637 (setq i (1+ i))
1638 (if (and (< i nline)
1639 (string-match org-table-number-regexp x))
1640 (incf (aref fnum i)))
1641 (cond
1642 (head
1643 (concat
1644 (format (car org-export-table-header-tags) "col")
1646 (cdr org-export-table-header-tags)))
1647 ((and (= i 0) org-export-html-table-use-header-tags-for-first-column)
1648 (concat
1649 (format (car org-export-table-header-tags) "row")
1651 (cdr org-export-table-header-tags)))
1653 (concat (car org-export-table-data-tags) x
1654 (cdr org-export-table-data-tags)))))
1655 fields "")
1656 rowend)
1657 html)))
1658 (unless splice (if tbopen (push "</tbody>" html)))
1659 (unless splice (push "</table>\n" html))
1660 (setq html (nreverse html))
1661 (unless splice
1662 ;; Put in col tags with the alignment (unfortunately often ignored...)
1663 (unless (car org-table-colgroup-info)
1664 (setq org-table-colgroup-info
1665 (cons :start (cdr org-table-colgroup-info))))
1666 (push (mapconcat
1667 (lambda (x)
1668 (setq gr (pop org-table-colgroup-info))
1669 (format "%s<col align=\"%s\" />%s"
1670 (if (memq gr '(:start :startend))
1671 (prog1
1672 (if colgropen "</colgroup>\n<colgroup>" "<colgroup>")
1673 (setq colgropen t))
1675 (if (> (/ (float x) nline) org-table-number-fraction)
1676 "right" "left")
1677 (if (memq gr '(:end :startend))
1678 (progn (setq colgropen nil) "</colgroup>")
1679 "")))
1680 fnum "")
1681 html)
1682 (if colgropen (setq html (cons (car html) (cons "</colgroup>" (cdr html)))))
1683 ;; Since the output of HTML table formatter can also be used in
1684 ;; DocBook document, we want to always include the caption to make
1685 ;; DocBook XML file valid.
1686 (push (format "<caption>%s</caption>" (or caption "")) html)
1687 (push html-table-tag html))
1688 (concat (mapconcat 'identity html "\n") "\n")))
1690 (defun org-export-splice-attributes (tag attributes)
1691 "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG."
1692 (if (not attributes)
1694 (let (oldatt newatt)
1695 (setq oldatt (org-extract-attributes-from-string tag)
1696 tag (pop oldatt)
1697 newatt (cdr (org-extract-attributes-from-string attributes)))
1698 (while newatt
1699 (setq oldatt (plist-put oldatt (pop newatt) (pop newatt))))
1700 (if (string-match ">" tag)
1701 (setq tag
1702 (replace-match (concat (org-attributes-to-string oldatt) ">")
1703 t t tag)))
1704 tag)))
1706 (defun org-format-table-table-html (lines)
1707 "Format a table generated by table.el into HTML.
1708 This conversion does *not* use `table-generate-source' from table.el.
1709 This has the advantage that Org-mode's HTML conversions can be used.
1710 But it has the disadvantage, that no cell- or row-spanning is allowed."
1711 (let (line field-buffer
1712 (head org-export-highlight-first-table-line)
1713 fields html empty i)
1714 (setq html (concat html-table-tag "\n"))
1715 (while (setq line (pop lines))
1716 (setq empty "&nbsp;")
1717 (catch 'next-line
1718 (if (string-match "^[ \t]*\\+-" line)
1719 (progn
1720 (if field-buffer
1721 (progn
1722 (setq
1723 html
1724 (concat
1725 html
1726 "<tr>"
1727 (mapconcat
1728 (lambda (x)
1729 (if (equal x "") (setq x empty))
1730 (if head
1731 (concat
1732 (format (car org-export-table-header-tags) "col")
1734 (cdr org-export-table-header-tags))
1735 (concat (car org-export-table-data-tags) x
1736 (cdr org-export-table-data-tags))))
1737 field-buffer "\n")
1738 "</tr>\n"))
1739 (setq head nil)
1740 (setq field-buffer nil)))
1741 ;; Ignore this line
1742 (throw 'next-line t)))
1743 ;; Break the line into fields and store the fields
1744 (setq fields (org-split-string line "[ \t]*|[ \t]*"))
1745 (if field-buffer
1746 (setq field-buffer (mapcar
1747 (lambda (x)
1748 (concat x "<br/>" (pop fields)))
1749 field-buffer))
1750 (setq field-buffer fields))))
1751 (setq html (concat html "</table>\n"))
1752 html))
1754 (defun org-format-table-table-html-using-table-generate-source (lines)
1755 "Format a table into html, using `table-generate-source' from table.el.
1756 This has the advantage that cell- or row-spanning is allowed.
1757 But it has the disadvantage, that Org-mode's HTML conversions cannot be used."
1758 (require 'table)
1759 (with-current-buffer (get-buffer-create " org-tmp1 ")
1760 (erase-buffer)
1761 (insert (mapconcat 'identity lines "\n"))
1762 (goto-char (point-min))
1763 (if (not (re-search-forward "|[^+]" nil t))
1764 (error "Error processing table"))
1765 (table-recognize-table)
1766 (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer))
1767 (table-generate-source 'html " org-tmp2 ")
1768 (set-buffer " org-tmp2 ")
1769 (buffer-substring (point-min) (point-max))))
1771 (defun org-export-splice-style (style extra)
1772 "Splice EXTRA into STYLE, just before \"</style>\"."
1773 (if (and (stringp extra)
1774 (string-match "\\S-" extra)
1775 (string-match "</style>" style))
1776 (concat (substring style 0 (match-beginning 0))
1777 "\n" extra "\n"
1778 (substring style (match-beginning 0)))
1779 style))
1781 (defun org-html-handle-time-stamps (s)
1782 "Format time stamps in string S, or remove them."
1783 (catch 'exit
1784 (let (r b)
1785 (while (string-match org-maybe-keyword-time-regexp s)
1786 (or b (setq b (substring s 0 (match-beginning 0))))
1787 (setq r (concat
1788 r (substring s 0 (match-beginning 0))
1789 " @<span class=\"timestamp-wrapper\">"
1790 (if (match-end 1)
1791 (format "@<span class=\"timestamp-kwd\">%s @</span>"
1792 (match-string 1 s)))
1793 (format " @<span class=\"timestamp\">%s@</span>"
1794 (substring
1795 (org-translate-time (match-string 3 s)) 1 -1))
1796 "@</span>")
1797 s (substring s (match-end 0))))
1798 ;; Line break if line started and ended with time stamp stuff
1799 (if (not r)
1801 (setq r (concat r s))
1802 (unless (string-match "\\S-" (concat b s))
1803 (setq r (concat r "@<br/>")))
1804 r))))
1806 (defvar htmlize-buffer-places) ; from htmlize.el
1807 (defun org-export-htmlize-region-for-paste (beg end)
1808 "Convert the region to HTML, using htmlize.el.
1809 This is much like `htmlize-region-for-paste', only that it uses
1810 the settings define in the org-... variables."
1811 (let* ((htmlize-output-type org-export-htmlize-output-type)
1812 (htmlize-css-name-prefix org-export-htmlize-css-font-prefix)
1813 (htmlbuf (htmlize-region beg end)))
1814 (unwind-protect
1815 (with-current-buffer htmlbuf
1816 (buffer-substring (plist-get htmlize-buffer-places 'content-start)
1817 (plist-get htmlize-buffer-places 'content-end)))
1818 (kill-buffer htmlbuf))))
1820 ;;;###autoload
1821 (defun org-export-htmlize-generate-css ()
1822 "Create the CSS for all font definitions in the current Emacs session.
1823 Use this to create face definitions in your CSS style file that can then
1824 be used by code snippets transformed by htmlize.
1825 This command just produces a buffer that contains class definitions for all
1826 faces used in the current Emacs session. You can copy and paste the ones you
1827 need into your CSS file.
1829 If you then set `org-export-htmlize-output-type' to `css', calls to
1830 the function `org-export-htmlize-region-for-paste' will produce code
1831 that uses these same face definitions."
1832 (interactive)
1833 (require 'htmlize)
1834 (and (get-buffer "*html*") (kill-buffer "*html*"))
1835 (with-temp-buffer
1836 (let ((fl (face-list))
1837 (htmlize-css-name-prefix "org-")
1838 (htmlize-output-type 'css)
1839 f i)
1840 (while (setq f (pop fl)
1841 i (and f (face-attribute f :inherit)))
1842 (when (and (symbolp f) (or (not i) (not (listp i))))
1843 (insert (org-add-props (copy-sequence "1") nil 'face f))))
1844 (htmlize-region (point-min) (point-max))))
1845 (switch-to-buffer "*html*")
1846 (goto-char (point-min))
1847 (if (re-search-forward "<style" nil t)
1848 (delete-region (point-min) (match-beginning 0)))
1849 (if (re-search-forward "</style>" nil t)
1850 (delete-region (1+ (match-end 0)) (point-max)))
1851 (beginning-of-line 1)
1852 (if (looking-at " +") (replace-match ""))
1853 (goto-char (point-min)))
1855 (defun org-html-protect (s)
1856 ;; convert & to &amp;, < to &lt; and > to &gt;
1857 (let ((start 0))
1858 (while (string-match "&" s start)
1859 (setq s (replace-match "&amp;" t t s)
1860 start (1+ (match-beginning 0))))
1861 (while (string-match "<" s)
1862 (setq s (replace-match "&lt;" t t s)))
1863 (while (string-match ">" s)
1864 (setq s (replace-match "&gt;" t t s)))
1865 ; (while (string-match "\"" s)
1866 ; (setq s (replace-match "&quot;" t t s)))
1870 (defun org-html-expand (string)
1871 "Prepare STRING for HTML export. Applies all active conversions.
1872 If there are links in the string, don't modify these."
1873 (let* ((re (concat org-bracket-link-regexp "\\|"
1874 (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$")))
1875 m s l res)
1876 (while (setq m (string-match re string))
1877 (setq s (substring string 0 m)
1878 l (match-string 0 string)
1879 string (substring string (match-end 0)))
1880 (push (org-html-do-expand s) res)
1881 (push l res))
1882 (push (org-html-do-expand string) res)
1883 (apply 'concat (nreverse res))))
1885 (defun org-html-do-expand (s)
1886 "Apply all active conversions to translate special ASCII to HTML."
1887 (setq s (org-html-protect s))
1888 (if org-export-html-expand
1889 (while (string-match "@&lt;\\([^&]*\\)&gt;" s)
1890 (setq s (replace-match "<\\1>" t nil s))))
1891 (if org-export-with-emphasize
1892 (setq s (org-export-html-convert-emphasize s)))
1893 (if org-export-with-special-strings
1894 (setq s (org-export-html-convert-special-strings s)))
1895 (if org-export-with-sub-superscripts
1896 (setq s (org-export-html-convert-sub-super s)))
1897 (if org-export-with-TeX-macros
1898 (let ((start 0) wd ass)
1899 (while (setq start (string-match "\\\\\\([a-zA-Z]+\\)\\({}\\)?"
1900 s start))
1901 (if (get-text-property (match-beginning 0) 'org-protected s)
1902 (setq start (match-end 0))
1903 (setq wd (match-string 1 s))
1904 (if (setq ass (assoc wd org-html-entities))
1905 (setq s (replace-match (or (cdr ass)
1906 (concat "&" (car ass) ";"))
1907 t t s))
1908 (setq start (+ start (length wd))))))))
1911 (defun org-export-html-convert-special-strings (string)
1912 "Convert special characters in STRING to HTML."
1913 (let ((all org-export-html-special-string-regexps)
1914 e a re rpl start)
1915 (while (setq a (pop all))
1916 (setq re (car a) rpl (cdr a) start 0)
1917 (while (string-match re string start)
1918 (if (get-text-property (match-beginning 0) 'org-protected string)
1919 (setq start (match-end 0))
1920 (setq string (replace-match rpl t nil string)))))
1921 string))
1923 (defun org-export-html-convert-sub-super (string)
1924 "Convert sub- and superscripts in STRING to HTML."
1925 (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{})))
1926 (while (string-match org-match-substring-regexp string s)
1927 (cond
1928 ((and requireb (match-end 8)) (setq s (match-end 2)))
1929 ((get-text-property (match-beginning 2) 'org-protected string)
1930 (setq s (match-end 2)))
1932 (setq s (match-end 1)
1933 key (if (string= (match-string 2 string) "_") "sub" "sup")
1934 c (or (match-string 8 string)
1935 (match-string 6 string)
1936 (match-string 5 string))
1937 string (replace-match
1938 (concat (match-string 1 string)
1939 "<" key ">" c "</" key ">")
1940 t t string)))))
1941 (while (string-match "\\\\\\([_^]\\)" string)
1942 (setq string (replace-match (match-string 1 string) t t string)))
1943 string))
1945 (defun org-export-html-convert-emphasize (string)
1946 "Apply emphasis."
1947 (let ((s 0) rpl)
1948 (while (string-match org-emph-re string s)
1949 (if (not (equal
1950 (substring string (match-beginning 3) (1+ (match-beginning 3)))
1951 (substring string (match-beginning 4) (1+ (match-beginning 4)))))
1952 (setq s (match-beginning 0)
1954 (concat
1955 (match-string 1 string)
1956 (nth 2 (assoc (match-string 3 string) org-emphasis-alist))
1957 (match-string 4 string)
1958 (nth 3 (assoc (match-string 3 string)
1959 org-emphasis-alist))
1960 (match-string 5 string))
1961 string (replace-match rpl t t string)
1962 s (+ s (- (length rpl) 2)))
1963 (setq s (1+ s))))
1964 string))
1966 (defun org-open-par ()
1967 "Insert <p>, but first close previous paragraph if any."
1968 (org-close-par-maybe)
1969 (insert "\n<p>")
1970 (setq org-par-open t))
1971 (defun org-close-par-maybe ()
1972 "Close paragraph if there is one open."
1973 (when org-par-open
1974 (insert "</p>")
1975 (setq org-par-open nil)))
1976 (defun org-close-li (&optional type)
1977 "Close <li> if necessary."
1978 (org-close-par-maybe)
1979 (insert (if (equal type "d") "</dd>\n" "</li>\n")))
1981 (defvar in-local-list)
1982 (defvar local-list-indent)
1983 (defvar local-list-type)
1984 (defun org-export-html-close-lists-maybe (line)
1985 (let ((ind (or (get-text-property 0 'original-indentation line)))
1986 ; (and (string-match "\\S-" line)
1987 ; (org-get-indentation line))))
1988 didclose)
1989 (when ind
1990 (while (and in-local-list
1991 (<= ind (car local-list-indent)))
1992 (setq didclose t)
1993 (org-close-li (car local-list-type))
1994 (insert (format "</%sl>\n" (car local-list-type)))
1995 (pop local-list-type) (pop local-list-indent)
1996 (setq in-local-list local-list-indent))
1997 (and didclose (org-open-par)))))
1999 (defvar body-only) ; dynamically scoped into this.
2000 (defun org-html-level-start (level title umax with-toc head-count)
2001 "Insert a new level in HTML export.
2002 When TITLE is nil, just close all open levels."
2003 (org-close-par-maybe)
2004 (let* ((target (and title (org-get-text-property-any 0 'target title)))
2005 (extra-targets (assoc target org-export-target-aliases))
2006 (preferred (cdr (assoc target org-export-preferred-target-alist)))
2007 (remove (or preferred target))
2008 (l org-level-max)
2009 snumber href suffix)
2010 (setq extra-targets (remove remove extra-targets))
2011 (setq extra-targets
2012 (mapconcat (lambda (x)
2013 (if (org-uuidgen-p x) (setq x (concat "ID-" x)))
2014 (format "<a name=\"%s\" id=\"%s\"></a>"
2015 x x))
2016 extra-targets
2017 ""))
2018 (while (>= l level)
2019 (if (aref org-levels-open (1- l))
2020 (progn
2021 (org-html-level-close l umax)
2022 (aset org-levels-open (1- l) nil)))
2023 (setq l (1- l)))
2024 (when title
2025 ;; If title is nil, this means this function is called to close
2026 ;; all levels, so the rest is done only if title is given
2027 (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title)
2028 (setq title (replace-match
2029 (if org-export-with-tags
2030 (save-match-data
2031 (concat
2032 "&nbsp;&nbsp;&nbsp;<span class=\"tag\">"
2033 (mapconcat
2034 (lambda (x)
2035 (format "<span class=\"%s\">%s</span>"
2036 (org-export-html-get-tag-class-name x)
2038 (org-split-string (match-string 1 title) ":")
2039 "&nbsp;")
2040 "</span>"))
2042 t t title)))
2043 (if (> level umax)
2044 (progn
2045 (if (aref org-levels-open (1- level))
2046 (progn
2047 (org-close-li)
2048 (if target
2049 (insert (format "<li id=\"%s\">" target) extra-targets title "<br/>\n")
2050 (insert "<li>" title "<br/>\n")))
2051 (aset org-levels-open (1- level) t)
2052 (org-close-par-maybe)
2053 (if target
2054 (insert (format "<ul>\n<li id=\"%s\">" target)
2055 extra-targets title "<br/>\n")
2056 (insert "<ul>\n<li>" title "<br/>\n"))))
2057 (aset org-levels-open (1- level) t)
2058 (setq snumber (org-section-number level))
2059 (setq level (+ level org-export-html-toplevel-hlevel -1))
2060 (if (and org-export-with-section-numbers (not body-only))
2061 (setq title (concat
2062 (format "<span class=\"section-number-%d\">%s</span>"
2063 level snumber)
2064 " " title)))
2065 (unless (= head-count 1) (insert "\n</div>\n"))
2066 (setq href (cdr (assoc (concat "sec-" snumber) org-export-preferred-target-alist)))
2067 (setq suffix (or href snumber))
2068 (setq href (or href (concat "sec-" snumber)))
2069 (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n"
2070 suffix level level href
2071 extra-targets
2072 title level level suffix))
2073 (org-open-par)))))
2075 (defun org-export-html-get-tag-class-name (tag)
2076 "Turn tag into a valid class name.
2077 Replaces invalid characters with \"_\" and then prepends a prefix."
2078 (save-match-data
2079 (while (string-match "[^a-zA-Z0-9_]" tag)
2080 (setq tag (replace-match "_" t t tag))))
2081 (concat org-export-html-tag-class-prefix tag))
2083 (defun org-export-html-get-todo-kwd-class-name (kwd)
2084 "Turn todo keyword into a valid class name.
2085 Replaces invalid characters with \"_\" and then prepends a prefix."
2086 (save-match-data
2087 (while (string-match "[^a-zA-Z0-9_]" kwd)
2088 (setq kwd (replace-match "_" t t kwd))))
2089 (concat org-export-html-todo-kwd-class-prefix kwd))
2091 (defun org-html-level-close (level max-outline-level)
2092 "Terminate one level in HTML export."
2093 (if (<= level max-outline-level)
2094 (insert "</div>\n")
2095 (org-close-li)
2096 (insert "</ul>\n")))
2098 (provide 'org-html)
2100 ;; arch-tag: 8109d84d-eb8f-460b-b1a8-f45f3a6c7ea1
2101 ;;; org-html.el ends here