"
(format
(or (and (stringp org-export-html-xml-declaration)
org-export-html-xml-declaration)
(cdr (assoc html-extension org-export-html-xml-declaration))
(cdr (assoc "html" org-export-html-xml-declaration))
(t ""))
(or charset "iso-8859-1"))
language language (org-html-expand title)
(or charset "iso-8859-1")
date author description keywords
style))
(insert (or (plist-get opt-plist :preamble) ""))
(when (plist-get opt-plist :auto-preamble)
(if title (insert (format org-export-html-title-format
(org-html-expand title))))))
(if (and org-export-with-toc (not body-only))
(progn
(push (format "
%s\n"
org-export-html-toplevel-hlevel
(nth 3 lang-words)
org-export-html-toplevel-hlevel)
thetoc)
(push "
\n" thetoc)
(push "
\n- " thetoc)
(setq lines
(mapcar '(lambda (line)
(if (string-match org-todo-line-regexp line)
;; This is a headline
(progn
(setq have-headings t)
(setq level (- (match-end 1) (match-beginning 1)
level-offset)
level (org-tr-level level)
txt (save-match-data
(org-html-expand
(org-export-cleanup-toc-line
(match-string 3 line))))
todo
(or (and org-export-mark-todo-in-toc
(match-beginning 2)
(not (member (match-string 2 line)
org-done-keywords)))
; TODO, not DONE
(and org-export-mark-todo-in-toc
(= level umax-toc)
(org-search-todo-below
line lines level))))
(if (string-match
(org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt)
(setq txt (replace-match " \\1" t nil txt)))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(setq snumber (org-section-number level))
(if org-export-with-section-numbers
(setq txt (concat snumber " " txt)))
(if (<= level (max umax umax-toc))
(setq head-count (+ head-count 1)))
(if (<= level umax-toc)
(progn
(if (> level org-last-level)
(progn
(setq cnt (- level org-last-level))
(while (>= (setq cnt (1- cnt)) 0)
(push "\n
\n- " thetoc))
(push "\n" thetoc)))
(if (< level org-last-level)
(progn
(setq cnt (- org-last-level level))
(while (>= (setq cnt (1- cnt)) 0)
(push "
\n
" thetoc))
(push "\n" thetoc)))
;; Check for targets
(while (string-match org-any-target-regexp line)
(setq line (replace-match
(concat "@" (match-string 1 line) "@ ")
t t line)))
(while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt)
(setq txt (replace-match "" t t txt)))
(setq href (format "sec-%s" snumber))
(setq href (or (cdr (assoc href org-export-preferred-target-alist)) href))
(push
(format
(if todo
" \n- %s"
"
\n- %s")
href txt) thetoc)
(setq org-last-level level))
)))
line)
lines))
(while (> org-last-level (1- org-min-level))
(setq org-last-level (1- org-last-level))
(push "
\n
\n" thetoc))
(push "
\n" thetoc)
(setq thetoc (if have-headings (nreverse thetoc) nil))))
(setq head-count 0)
(org-init-section-numbers)
(org-open-par)
(while (setq line (pop lines) origline line)
(catch 'nextline
;; end of quote section?
(when (and inquote (string-match "^\\*+ " line))
(insert "\n")
(org-open-par)
(setq inquote nil))
;; inside a quote section?
(when inquote
(insert (org-html-protect line) "\n")
(throw 'nextline nil))
;; Fixed-width, verbatim lines (examples)
(when (and org-export-with-fixed-width
(string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line))
(when (not infixed)
(setq infixed t)
(org-close-par-maybe)
(insert "
\n"))
(insert (org-html-protect (match-string 3 line)) "\n")
(when (or (not lines)
(not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)"
(car lines))))
(setq infixed nil)
(insert "
\n")
(org-open-par))
(throw 'nextline nil))
;; Protected HTML
(when (get-text-property 0 'org-protected line)
(let (par)
(when (re-search-backward
"\\(
\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t)
(setq par (match-string 1))
(replace-match "\\2\n"))
(insert line "\n")
(while (and lines
(or (= (length (car lines)) 0)
(get-text-property 0 'org-protected (car lines))))
(insert (pop lines) "\n"))
(and par (insert "
\n")))
(throw 'nextline nil))
;; Horizontal line
(when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line)
(if org-par-open
(insert "\n
\n
\n
\n")
(insert "\n
\n"))
(throw 'nextline nil))
;; Blockquotes, verse, and center
(when (equal "ORG-BLOCKQUOTE-START" line)
(org-close-par-maybe)
(insert "
\n")
(org-open-par)
(throw 'nextline nil))
(when (equal "ORG-BLOCKQUOTE-END" line)
(org-close-par-maybe)
(insert "\n
\n")
(org-open-par)
(throw 'nextline nil))
(when (equal "ORG-VERSE-START" line)
(org-close-par-maybe)
(insert "\n
\n")
(setq inverse t)
(throw 'nextline nil))
(when (equal "ORG-VERSE-END" line)
(insert "
\n")
(org-open-par)
(setq inverse nil)
(throw 'nextline nil))
(when (equal "ORG-CENTER-START" line)
(org-close-par-maybe)
(insert "\n
")
(org-open-par)
(throw 'nextline nil))
(when (equal "ORG-CENTER-END" line)
(org-close-par-maybe)
(insert "\n
")
(org-open-par)
(throw 'nextline nil))
(run-hooks 'org-export-html-after-blockquotes-hook)
(when inverse
(let ((i (org-get-string-indentation line)))
(if (> i 0)
(setq line (concat (mapconcat 'identity
(make-list (* 2 i) "\\nbsp") "")
" " (org-trim line))))
(unless (string-match "\\\\\\\\[ \t]*$" line)
(setq line (concat line "\\\\")))))
;; make targets to anchors
(while (string-match
"<<\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line)
(cond
((match-end 2)
(setq line (replace-match
(format
"@
@"
(org-solidify-link-text (match-string 1 line))
(org-solidify-link-text (match-string 1 line)))
t t line)))
((and org-export-with-toc (equal (string-to-char line) ?*))
;; FIXME: NOT DEPENDENT on TOC?????????????????????
(setq line (replace-match
(concat "@
" (match-string 1 line) "@ ")
; (concat "@
" (match-string 1 line) "@ ")
t t line)))
(t
(setq line (replace-match
(concat "@
" (match-string 1 line) "@ ")
t t line)))))
(setq line (org-html-handle-time-stamps line))
;; replace "&" by "&", "<" and ">" by "<" and ">"
;; handle @<..> HTML tags (replace "@>..<" by "<..>")
;; Also handle sub_superscripts and checkboxes
(or (string-match org-table-hline-regexp line)
(setq line (org-html-expand line)))
;; Format the links
(setq start 0)
(while (string-match org-bracket-link-analytic-regexp++ line start)
(setq start (match-beginning 0))
(setq path (save-match-data (org-link-unescape
(match-string 3 line))))
(setq type (cond
((match-end 2) (match-string 2 line))
((save-match-data
(or (file-name-absolute-p path)
(string-match "^\\.\\.?/" path)))
"file")
(t "internal")))
(setq path (org-extract-attributes (org-link-unescape path)))
(setq attr (get-text-property 0 'org-attributes path))
(setq desc1 (if (match-end 5) (match-string 5 line))
desc2 (if (match-end 2) (concat type ":" path) path)
descp (and desc1 (not (equal desc1 desc2)))
desc (or desc1 desc2))
;; Make an image out of the description if that is so wanted
(when (and descp (org-file-image-p
desc org-export-html-inline-image-extensions))
(save-match-data
(if (string-match "^file:" desc)
(setq desc (substring desc (match-end 0)))))
(setq desc (org-add-props
(concat "
![](\"")
")
'(org-protected t))))
;; FIXME: do we need to unescape here somewhere?
(cond
((equal type "internal")
(setq rpl
(concat
"
"
(org-export-html-format-desc desc)
"")))
((and (equal type "id")
(setq id-file (org-id-find-id-file path)))
;; This is an id: link to another file (if it was the same file,
;; it would have become an internal link...)
(setq id-file (file-relative-name
id-file (file-name-directory org-current-export-file)))
(setq id-file (concat (file-name-sans-extension id-file)
"." html-extension))
(setq rpl (concat "
"
(org-export-html-format-desc desc)
"")))
((member type '("http" "https"))
;; standard URL, just check if we need to inline an image
(if (and (or (eq t org-export-html-inline-images)
(and org-export-html-inline-images (not descp)))
(org-file-image-p
path org-export-html-inline-image-extensions))
(setq rpl (org-export-html-format-image
(concat type ":" path) org-par-open))
(setq link (concat type ":" path))
(setq rpl (concat "
"
(org-export-html-format-desc desc)
""))))
((member type '("ftp" "mailto" "news"))
;; standard URL
(setq link (concat type ":" path))
(setq rpl (concat "
"
(org-export-html-format-desc desc)
"")))
((string= type "coderef")
(setq rpl (format "
%s"
path path path
(format (org-export-get-coderef-format path (and descp desc))
(cdr (assoc path org-export-code-refs))))))
((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
;; The link protocol has a function for format the link
(setq rpl
(save-match-data
(funcall fnc (org-link-unescape path) desc1 'html))))
((string= type "file")
;; FILE link
(let* ((filename path)
(abs-p (file-name-absolute-p filename))
thefile file-is-image-p search)
(save-match-data
(if (string-match "::\\(.*\\)" filename)
(setq search (match-string 1 filename)
filename (replace-match "" t nil filename)))
(setq valid
(if (functionp link-validate)
(funcall link-validate filename current-dir)
t))
(setq file-is-image-p
(org-file-image-p
filename org-export-html-inline-image-extensions))
(setq thefile (if abs-p (expand-file-name filename) filename))
(when (and org-export-html-link-org-files-as-html
(string-match "\\.org$" thefile))
(setq thefile (concat (substring thefile 0
(match-beginning 0))
"." html-extension))
(if (and search
;; make sure this is can be used as target search
(not (string-match "^[0-9]*$" search))
(not (string-match "^\\*" search))
(not (string-match "^/.*/$" search)))
(setq thefile (concat thefile "#"
(org-solidify-link-text
(org-link-unescape search)))))
(when (string-match "^file:" desc)
(setq desc (replace-match "" t t desc))
(if (string-match "\\.org$" desc)
(setq desc (replace-match "" t t desc))))))
(setq rpl (if (and file-is-image-p
(or (eq t org-export-html-inline-images)
(and org-export-html-inline-images
(not descp))))
(progn
(message "image %s %s" thefile org-par-open)
(org-export-html-format-image thefile org-par-open))
(concat "
"
(org-export-html-format-desc desc)
"")))
(if (not valid) (setq rpl desc))))
(t
;; just publish the path, as default
(setq rpl (concat "
<" type ":"
(save-match-data (org-link-unescape path))
">"))))
(setq line (replace-match rpl t t line)
start (+ start (length rpl))))
;; TODO items
(if (and (string-match org-todo-line-regexp line)
(match-beginning 2))
(setq line
(concat (substring line 0 (match-beginning 2))
"
" (org-export-html-get-todo-kwd-class-name
(match-string 2 line))
"" (substring line (match-end 2)))))
;; Does this contain a reference to a footnote?
(when org-export-with-footnotes
(setq start 0)
(while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" line start)
(if (get-text-property (match-beginning 2) 'org-protected line)
(setq start (match-end 2))
(let ((n (match-string 2 line)) extra a)
(if (setq a (assoc n footref-seen))
(progn
(setcdr a (1+ (cdr a)))
(setq extra (format ".%d" (cdr a))))
(setq extra "")
(push (cons n 1) footref-seen))
(setq line
(replace-match
(format
"%s
"
(match-string 1 line) n extra n n)
t t line))))))
(cond
((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line)
;; This is a headline
(setq level (org-tr-level (- (match-end 1) (match-beginning 1)
level-offset))
txt (match-string 2 line))
(if (string-match quote-re0 txt)
(setq txt (replace-match "" t t txt)))
(if (<= level (max umax umax-toc))
(setq head-count (+ head-count 1)))
(when in-local-list
;; Close any local lists before inserting a new header line
(while local-list-type
(org-close-li (car local-list-type))
(insert (format "%sl>\n" (car local-list-type)))
(pop local-list-type))
(setq local-list-indent nil
in-local-list nil))
(setq first-heading-pos (or first-heading-pos (point)))
(org-html-level-start level txt umax
(and org-export-with-toc (<= level umax))
head-count)
;; QUOTES
(when (string-match quote-re line)
(org-close-par-maybe)
(insert "
")
(setq inquote t)))
((string-match "^[ \t]*- __+[ \t]*$" line)
;; Explicit list closure
(when local-list-type
(let ((ind (org-get-indentation line)))
(while (and local-list-indent
(<= ind (car local-list-indent)))
(org-close-li (car local-list-type))
(insert (format "%sl>\n" (car local-list-type)))
(pop local-list-type)
(pop local-list-indent))
(or local-list-indent (setq in-local-list nil))))
(throw 'nextline nil))
((and org-export-with-tables
(string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line))
(when (not table-open)
;; New table starts
(setq table-open t table-buffer nil table-orig-buffer nil))
;; Accumulate lines
(setq table-buffer (cons line table-buffer)
table-orig-buffer (cons origline table-orig-buffer))
(when (or (not lines)
(not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)"
(car lines))))
(setq table-open nil
table-buffer (nreverse table-buffer)
table-orig-buffer (nreverse table-orig-buffer))
(org-close-par-maybe)
(insert (org-format-table-html table-buffer table-orig-buffer))))
(t
;; Normal lines
(when (string-match
(cond
((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)")
(t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))
line)
(setq ind (org-get-string-indentation line)
item-type (if (match-beginning 4) "o" "u")
starter (if (match-beginning 2)
(substring (match-string 2 line) 0 -1))
line (substring line (match-beginning 5))
item-tag nil)
(if (and starter (string-match "\\(.*?\\) ::[ \t]*" line))
(setq item-type "d"
item-tag (match-string 1 line)
line (substring line (match-end 0))))
(when (and (not (equal item-type "d"))
(not (string-match "[^ \t]" line)))
;; empty line. Pretend indentation is large.
(setq ind (if org-empty-line-terminates-plain-lists
0
(1+ (or (car local-list-indent) 1)))))
(setq didclose nil)
(while (and in-local-list
(or (and (= ind (car local-list-indent))
(not starter))
(< ind (car local-list-indent))))
(setq didclose t)
(org-close-li (car local-list-type))
(insert (format "%sl>\n" (car local-list-type)))
(pop local-list-type) (pop local-list-indent)
(setq in-local-list local-list-indent))
(cond
((and starter
(or (not in-local-list)
(> ind (car local-list-indent))))
;; Start new (level of) list
(org-close-par-maybe)
(insert (cond
((equal item-type "u") "
\n- \n")
((equal item-type "o") "
\n- \n")
((equal item-type "d")
(format "
\n- %s
- \n" item-tag))))
(push item-type local-list-type)
(push ind local-list-indent)
(setq in-local-list t))
(starter
;; continue current list
(org-close-li (car local-list-type))
(insert (cond
((equal (car local-list-type) "d")
(format "
- %s
- \n" (or item-tag "???")))
(t "
- \n"))))
(didclose
;; we did close a list, normal text follows: need
(org-open-par)))
(if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line)
(setq line
(replace-match
(if (equal (match-string 1 line) "X")
"[X]"
"[X]")
t t line))))
;; Empty lines start a new paragraph. If hand-formatted lists
;; are not fully interpreted, lines starting with "-", "+", "*"
;; also start a new paragraph.
(if (string-match "^ [-+*]-\\|^[ \t]*$" line) (org-open-par))
;; Is this the start of a footnote?
(when org-export-with-footnotes
(when (and (boundp 'footnote-section-tag-regexp)
(string-match (concat "^" footnote-section-tag-regexp)
line))
;; ignore this line
(throw 'nextline nil))
(when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line)
(org-close-par-maybe)
(let ((n (match-string 1 line)))
(setq org-par-open t
line (replace-match
(format "
so that the footnote matcher
;; does not see this.
(if (not (get-text-property (match-beginning 0)
'org-protected line))
(setq line (replace-match "" t t line)))
(setq start (match-end 0))))
(insert line "\n")))))
;; Properly close all local lists and other lists
(when inquote
(insert "\n")
(org-open-par))
(when in-local-list
;; Close any local lists before inserting a new header line
(while local-list-type
(org-close-li (car local-list-type))
(insert (format "%sl>\n" (car local-list-type)))
(pop local-list-type))
(setq local-list-indent nil
in-local-list nil))
(org-html-level-start 1 nil umax
(and org-export-with-toc (<= level umax))
head-count)
;; the
to close the last text-... div.
(when (and (> umax 0) first-heading-pos) (insert "\n"))
(save-excursion
(goto-char (point-min))
(while (re-search-forward "\\|\\'\\)" nil t)
(push (match-string 0) footnotes)
(replace-match "" t t)))
(when footnotes
(insert (format org-export-html-footnotes-section
(or (nth 4 lang-words) "Footnotes")
(mapconcat 'identity (nreverse footnotes) "\n"))
"\n"))
(let ((bib (org-export-html-get-bibliography)))
(when bib
(insert "\n" bib "\n")))
(unless body-only
(when (plist-get opt-plist :auto-postamble)
(insert "\n")
(when (and org-export-author-info author)
(insert "
"
(nth 1 lang-words) ": " author "\n")
(when email
(if (listp (split-string email ",+ *"))
(mapc (lambda(e)
(insert "<"
e ">\n"))
(split-string email ",+ *"))
(insert "<"
email ">\n")))
(insert "
\n"))
(when (and date org-export-time-stamp-file)
(insert "
"
(nth 2 lang-words) ": "
date "
\n"))
(when org-export-creator-info
(insert (format "
HTML generated by org-mode %s in emacs %s
\n"
org-version emacs-major-version)))
(when org-export-html-validation-link
(insert org-export-html-validation-link "\n"))
(insert "
"))
(if org-export-html-with-timestamp
(insert org-export-html-html-helper-timestamp))
(insert (or (plist-get opt-plist :postamble) ""))
(insert "\n\n\n\n"))
(unless (plist-get opt-plist :buffer-will-be-killed)
(normal-mode)
(if (eq major-mode default-major-mode) (html-mode)))
;; insert the table of contents
(goto-char (point-min))
(when thetoc
(if (or (re-search-forward
"