diff options
Diffstat (limited to 'lisp/org/org-html.el')
| -rw-r--r-- | lisp/org/org-html.el | 210 |
1 files changed, 122 insertions, 88 deletions
diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el index 46126ce2573..82fdd507b03 100644 --- a/lisp/org/org-html.el +++ b/lisp/org/org-html.el @@ -1,11 +1,10 @@ ;;; org-html.el --- HTML export for Org-mode -;; Copyright (C) 2004-2011 Free Software Foundation, Inc. +;; Copyright (C) 2004-2012 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 7.7 ;; ;; This file is part of GNU Emacs. ;; @@ -34,6 +33,8 @@ (declare-function org-id-find-id-file "org-id" (id)) (declare-function htmlize-region "ext:htmlize" (beg end)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) (defgroup org-export-html nil "Options specific for HTML export of Org-mode files." @@ -155,6 +156,12 @@ not be modified." dt { font-weight: bold; } div.figure { padding: 0.5em; } div.figure p { text-align: center; } + div.inlinetask { + padding:10px; + border:2px solid gray; + margin:10px; + background: #ffffcc; + } textarea { overflow-x: auto; } .linenr { font-size:smaller } .code-highlighted {background-color:#ffff00;} @@ -348,6 +355,14 @@ CSS classes, then this prefix can be very useful." :group 'org-export-html :type 'string) +(defcustom org-export-html-headline-anchor-format "<a name=\"%s\" id=\"%s\"></a>" + "Format for anchors in HTML headlines. +It requires to %s: both will be replaced by the anchor referring +to the headline (e.g. \"sec-2\"). When set to `nil', don't insert +HTML anchors in headlines." + :group 'org-export-html + :type 'string) + (defcustom org-export-html-preamble t "Non-nil means insert a preamble in HTML export. @@ -355,8 +370,8 @@ When `t', insert a string as defined by one of the formatting strings in `org-export-html-preamble-format'. When set to a string, this string overrides `org-export-html-preamble-format'. When set to a function, apply this function and insert the -returned string. The function takes the property list of export -options as its only argument. +returned string. The function takes no argument, but you can +use `opt-plist' to access the current export options. Setting :html-preamble in publishing projects will take precedence over this variable." @@ -388,8 +403,8 @@ string overrides `org-export-html-postamble-format'. When set to 'auto, discard `org-export-html-postamble-format' and honor `org-export-author/email/creator-info' variables. When set to a function, apply this function and insert the returned string. -The function takes the property list of export options as its -only argument. +The function takes no argument, but you can use `opt-plist' to +access the current export options. Setting :html-postamble in publishing projects will take precedence over this variable." @@ -619,7 +634,10 @@ This variable is obsolete since Org version 7.7. Please set `org-export-html-divs' instead.") (defcustom org-export-html-divs '("preamble" "content" "postamble") - "The name of the main divs for HTML export." + "The name of the main divs for HTML export. +This is a list of three strings, the first one for the preamble +DIV, the second one for the content DIV and the third one for the +postamble DIV." :group 'org-export-html :type '(list (string :tag " Div for the preamble:") @@ -703,7 +721,7 @@ command to convert it." (interactive "r") (let (reg html buf pop-up-frames) (save-window-excursion - (if (org-mode-p) + (if (eq major-mode 'org-mode) (setq html (org-export-region-as-html beg end t 'string)) (setq reg (buffer-substring beg end) @@ -801,11 +819,11 @@ description. See variables `org-export-html-inline-images' and may-inline-p) "Make an HTML link. OPT-PLIST is an options list. -TYPE is the device-type of the link (THIS://foo.html) -PATH is the path of the link (http://THIS#locationx) -FRAGMENT is the fragment part of the link, if any (foo.html#THIS) +TYPE is the device-type of the link (THIS://foo.html). +PATH is the path of the link (http://THIS#location). +FRAGMENT is the fragment part of the link, if any (foo.html#THIS). DESC is the link description, if any. -ATTR is a string of other attributes of the a element. +ATTR is a string of other attributes of the \"a\" element. MAY-INLINE-P allows inlining it as an image." (declare (special org-par-open)) @@ -896,7 +914,7 @@ OPT-PLIST is the export options list." (string-match "^\\.\\.?/" path))) "file") (t "internal"))) - (setq path (org-extract-attributes (org-link-unescape path))) + (setq path (org-extract-attributes 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) @@ -909,7 +927,7 @@ OPT-PLIST is the export options list." (if (string-match "^file:" desc) (setq desc (substring desc (match-end 0))))) (setq desc (org-add-props - (concat "<img src=\"" desc "\" alt=\"" + (concat "<img src=\"" desc "\" alt=\"" (file-name-nondirectory desc) "\"/>") '(org-protected t)))) (cond @@ -1036,14 +1054,17 @@ OPT-PLIST is the export options list." (t ;; just publish the path, as default - (setq rpl (concat "@<i><" type ":" + (setq rpl (concat "<i><" type ":" (save-match-data (org-link-unescape path)) - ">@</i>")))) + "></i>")))) (setq line (replace-match rpl t t line) start (+ start (length rpl)))) line)) ;;; org-export-as-html + +(defvar org-heading-keyword-regexp-format) ; defined in org.el + ;;;###autoload (defun org-export-as-html (arg &optional hidden ext-plist to-buffer body-only pub-dir) @@ -1137,14 +1158,15 @@ PUB-DIR is set, use this as the publishing directory." (current-dir (if buffer-file-name (file-name-directory buffer-file-name) default-directory)) + (auto-insert nil); Avoid any auto-insert stuff for the new file (buffer (if to-buffer (cond ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*")) (t (get-buffer-create to-buffer))) (find-file-noselect filename))) (org-levels-open (make-vector org-level-max nil)) - (date (plist-get opt-plist :date)) - (author (plist-get opt-plist :author)) + (date (org-html-expand (plist-get opt-plist :date))) + (author (org-html-expand (plist-get opt-plist :author))) (html-validation-link (or org-export-html-validation-link "")) (title (org-html-expand (or (and subtree-p (org-export-get-title-from-subtree)) @@ -1165,15 +1187,16 @@ PUB-DIR is set, use this as the publishing directory." (plist-get opt-plist :link-home))) (dummy (setq opt-plist (plist-put opt-plist :title title))) (html-table-tag (plist-get opt-plist :html-table-tag)) - (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) - (quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)")) + (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)")) + (quote-re (format org-heading-keyword-regexp-format + org-quote-string)) (inquote nil) (infixed nil) (inverse nil) (email (plist-get opt-plist :email)) (language (plist-get opt-plist :language)) - (keywords (plist-get opt-plist :keywords)) - (description (plist-get opt-plist :description)) + (keywords (org-html-expand (plist-get opt-plist :keywords))) + (description (org-html-expand (plist-get opt-plist :description))) (num (plist-get opt-plist :section-numbers)) (lang-words nil) (head-count 0) cnt @@ -1287,11 +1310,11 @@ PUB-DIR is set, use this as the publishing directory." "%s <!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"> -<html xmlns=\"http://www.w3.org/1999/xhtml\" -lang=\"%s\" xml:lang=\"%s\"> +<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\"> <head> <title>%s</title> <meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/> +<meta name=\"title\" content=\"%s\"/> <meta name=\"generator\" content=\"Org-mode\"/> <meta name=\"generated\" content=\"%s\"/> <meta name=\"author\" content=\"%s\"/> @@ -1314,7 +1337,7 @@ lang=\"%s\" xml:lang=\"%s\"> language language title (or charset "iso-8859-1") - date author description keywords + title date author description keywords style mathjax (if (or link-up link-home) @@ -1327,28 +1350,35 @@ lang=\"%s\" xml:lang=\"%s\"> ;; insert html preamble (when (plist-get opt-plist :html-preamble) - (let ((html-pre (plist-get opt-plist :html-preamble))) - (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n") + (let ((html-pre (plist-get opt-plist :html-preamble)) + html-pre-real-contents) (cond ((stringp html-pre) - (insert - (format-spec html-pre `((?t . ,title) (?a . ,author) - (?d . ,date) (?e . ,email))))) + (setq html-pre-real-contents + (format-spec html-pre `((?t . ,title) (?a . ,author) + (?d . ,date) (?e . ,email))))) ((functionp html-pre) - (funcall html-pre)) + (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n") + (if (stringp (funcall html-pre)) (insert (funcall html-pre))) + (insert "\n</div>\n")) (t - (insert + (setq html-pre-real-contents (format-spec (or (cadr (assoc (nth 0 lang-words) org-export-html-preamble-format)) (cadr (assoc "en" org-export-html-preamble-format))) `((?t . ,title) (?a . ,author) (?d . ,date) (?e . ,email)))))) - (insert "\n</div>\n"))) + ;; don't output an empty preamble DIV + (unless (and (functionp html-pre) + (equal html-pre-real-contents "")) + (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n") + (insert html-pre-real-contents) + (insert "\n</div>\n")))) ;; begin wrap around body - (insert (format "\n<div id=\"%s\">" + (insert (format "\n<div id=\"%s\">" ;; FIXME org-export-html-content-div is obsolete since 7.7 - (or org-export-html-content-div + (or org-export-html-content-div (nth 1 org-export-html-divs))) ;; FIXME this should go in the preamble but is here so ;; that org-infojs can still find it @@ -1365,7 +1395,7 @@ lang=\"%s\" xml:lang=\"%s\"> (push "<div id=\"text-table-of-contents\">\n" thetoc) (push "<ul>\n<li>" thetoc) (setq lines - (mapcar + (mapcar #'(lambda (line) (if (and (string-match org-todo-line-regexp line) (not (get-text-property 0 'org-protected line))) @@ -1391,7 +1421,7 @@ lang=\"%s\" xml:lang=\"%s\"> line lines level)))) (if (string-match (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) - (setq txt (replace-match + (setq txt (replace-match " <span class=\"tag\"> \\1</span>" t nil txt))) (if (string-match quote-re0 txt) (setq txt (replace-match "" t t txt))) @@ -1419,7 +1449,7 @@ lang=\"%s\" xml:lang=\"%s\"> ;; Check for targets (while (string-match org-any-target-regexp line) (setq line (replace-match - (concat "@<span class=\"target\">" + (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") t t line))) (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) @@ -1427,8 +1457,8 @@ lang=\"%s\" xml:lang=\"%s\"> (setq href (replace-regexp-in-string "\\." "-" (format "sec-%s" snumber))) - (setq href (org-solidify-link-text - (or (cdr (assoc href + (setq href (org-solidify-link-text + (or (cdr (assoc href org-export-preferred-target-alist)) href))) (push (format @@ -1436,7 +1466,7 @@ lang=\"%s\" xml:lang=\"%s\"> "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>" "</li>\n<li><a href=\"#%s\">%s</a>") href txt) thetoc) - + (setq org-last-level level))))) line) lines)) @@ -1445,15 +1475,15 @@ lang=\"%s\" xml:lang=\"%s\"> (push "</li>\n</ul>\n" thetoc)) (push "</div>\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 org-outline-regexp-bol line)) (insert "</pre>\n") @@ -1588,7 +1618,8 @@ lang=\"%s\" xml:lang=\"%s\"> (setq line (org-html-handle-links line opt-plist)) ;; TODO items - (if (and (string-match org-todo-line-regexp line) + (if (and org-todo-line-regexp + (string-match org-todo-line-regexp line) (match-beginning 2)) (setq line @@ -1597,9 +1628,9 @@ lang=\"%s\" xml:lang=\"%s\"> (if (member (match-string 2 line) org-done-keywords) "done" "todo") - " " (match-string 2 line) - "\"> " (org-export-html-get-todo-kwd-class-name - (match-string 2 line)) + " " (org-export-html-get-todo-kwd-class-name + (match-string 2 line)) + "\"> " (match-string 2 line) "</span>" (substring line (match-end 2))))) ;; Does this contain a reference to a footnote? @@ -1636,7 +1667,7 @@ lang=\"%s\" xml:lang=\"%s\"> t t line)))))) (cond - ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) + ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line) ;; This is a headline (setq level (org-tr-level (- (match-end 1) (match-beginning 1) level-offset)) @@ -1785,7 +1816,7 @@ lang=\"%s\" xml:lang=\"%s\"> (?d . ,date) (?c . ,creator-info) (?v . ,html-validation-link))))) ((functionp html-post) - (funcall html-post)) + (if (stringp (funcall html-post)) (insert (funcall html-post)))) ((eq html-post 'auto) ;; fall back on default postamble (when (plist-get opt-plist :time-stamp-file) @@ -1808,7 +1839,7 @@ lang=\"%s\" xml:lang=\"%s\"> (?d . ,date) (?c . ,creator-info) (?v . ,html-validation-link)))))) (insert "\n</div>")))) - + ;; FIXME `org-export-html-with-timestamp' has been declared ;; obsolete since Org 7.7 -- don't forget to remove this. (if org-export-html-with-timestamp @@ -1941,7 +1972,7 @@ NO-CSS is passed to the exporter." (if (string-match "^[ \t]*|" (car lines)) ;; A normal org table (org-format-org-table-html lines nil no-css) - ;; Table made by table.el + ;; Table made by table.el (or (org-format-table-table-html-using-table-generate-source olines (not org-export-prefer-native-exporter-for-tables)) ;; We are here only when table.el table has NO col or row @@ -1969,8 +2000,8 @@ for formatting. This is required for the DocBook exporter." (let* ((caption (org-find-text-property-in-string 'org-caption (car lines))) (label (org-find-text-property-in-string 'org-label (car lines))) - (forced-aligns (org-find-text-property-in-string 'org-forced-aligns - (car lines))) + (col-cookies (org-find-text-property-in-string 'org-col-cookies + (car lines))) (attributes (org-find-text-property-in-string 'org-attributes (car lines))) (html-table-tag (org-export-splice-attributes @@ -1983,9 +2014,9 @@ for formatting. This is required for the DocBook exporter." tbopen line fields html gr colgropen rowstart rowend ali align aligns n) (setq caption (and caption (org-html-do-expand caption))) - (when (and forced-aligns org-table-clean-did-remove-column) - (setq forced-aligns - (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) forced-aligns))) + (when (and col-cookies org-table-clean-did-remove-column) + (setq col-cookies + (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies))) (if splice (setq head nil)) (unless splice (push (if head "<thead>" "<tbody>") html)) (setq tbopen t) @@ -2046,8 +2077,8 @@ for formatting. This is required for the DocBook exporter." (lambda (x) (setq gr (pop org-table-colgroup-info) i (1+ i) - align (if (assoc i forced-aligns) - (cdr (assoc (cdr (assoc i forced-aligns)) + align (if (nth 1 (assoc i col-cookies)) + (cdr (assoc (nth 1 (assoc i col-cookies)) '(("l" . "left") ("r" . "right") ("c" . "center")))) (if (> (/ (float x) nline) @@ -2203,19 +2234,20 @@ for further information." "Format time stamps in string S, or remove them." (catch 'exit (let (r b) - (while (string-match org-maybe-keyword-time-regexp s) - (or b (setq b (substring s 0 (match-beginning 0)))) - (setq r (concat - r (substring s 0 (match-beginning 0)) - " @<span class=\"timestamp-wrapper\">" - (if (match-end 1) - (format "@<span class=\"timestamp-kwd\">%s @</span>" - (match-string 1 s))) - (format " @<span class=\"timestamp\">%s@</span>" - (substring - (org-translate-time (match-string 3 s)) 1 -1)) - "@</span>") - s (substring s (match-end 0)))) + (when org-maybe-keyword-time-regexp + (while (string-match org-maybe-keyword-time-regexp s) + (or b (setq b (substring s 0 (match-beginning 0)))) + (setq r (concat + r (substring s 0 (match-beginning 0)) + " @<span class=\"timestamp-wrapper\">" + (if (match-end 1) + (format "@<span class=\"timestamp-kwd\">%s @</span>" + (match-string 1 s))) + (format " @<span class=\"timestamp\">%s@</span>" + (substring + (org-translate-time (match-string 3 s)) 1 -1)) + "@</span>") + s (substring s (match-end 0))))) ;; Line break if line started and ended with time stamp stuff (if (not r) s @@ -2263,7 +2295,7 @@ that uses these same face definitions." (when (and (symbolp f) (or (not i) (not (listp i)))) (insert (org-add-props (copy-sequence "1") nil 'face f)))) (htmlize-region (point-min) (point-max)))) - (switch-to-buffer "*html*") + (org-pop-to-buffer-same-window "*html*") (goto-char (point-min)) (if (re-search-forward "<style" nil t) (delete-region (point-min) (match-beginning 0))) @@ -2286,18 +2318,20 @@ Possible conversions are set in `org-export-html-protect-char-alist'." (defun org-html-expand (string) "Prepare STRING for HTML export. Apply all active conversions. -If there are links in the string, don't modify these." - (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) - m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-html-do-expand s) res) +If there are links in the string, don't modify these. If STRING +is nil, return nil." + (when string + (let* ((re (concat org-bracket-link-regexp "\\|" + (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) + m s l res) + (while (setq m (string-match re string)) + (setq s (substring string 0 m) + l (match-string 0 string) + string (substring string (match-end 0))) + (push (org-html-do-expand s) res) (push l res)) - (push (org-html-do-expand string) res) - (apply 'concat (nreverse res)))) + (push (org-html-do-expand string) res) + (apply 'concat (nreverse res))))) (defun org-html-do-expand (s) "Apply all active conversions to translate special ASCII to HTML." @@ -2412,8 +2446,9 @@ When TITLE is nil, just close all open levels." (mapconcat (lambda (x) (setq x (org-solidify-link-text (if (org-uuidgen-p x) (concat "ID-" x) x))) - (format "<a name=\"%s\" id=\"%s\"></a>" - x x)) + (if (stringp org-export-html-headline-anchor-format) + (format org-export-html-headline-anchor-format x x) + "")) extra-targets "")) (while (>= l level) @@ -2604,5 +2639,4 @@ the alist of previous items." (provide 'org-html) - ;;; org-html.el ends here |