Add support for fontification of odt src blocks using htmlfontify

* contrib/lisp/org-lparse.el (org-do-lparse): Bind
hfy-user-sheet-assoc.
* contrib/lisp/org-odt.el
(org-export-odt-default-org-styles-alist): Rename
OrgSourceBlock to OrgSrcBlock for consistency.
(org-odt-format-source-code-or-example): Modified. Call either
org-odt-format-source-code-or-example-plain or
org-odt-format-source-code-or-example-colored.
(org-odt-format-source-code-or-example-plain): New. Identical
to the earlier org-odt-format-source-code-or-example.
(org-odt-format-source-code-or-example-colored): New
defun. Use htmlfontify for emitting coloring of source blocks.
(org-export-odt-use-htmlfontify)
(org-export-odt-create-custom-styles-for-srcblocks): New
customizable variables
(org-src-block-paragraph-format): New variable.
(org-odt-hfy-face-to-css)
(org-odt-insert-custom-styles-for-srcblocks): New defuns.
(org-odt-save-as-outfile): Modified. Use
org-odt-insert-custom-styles-for-srcblocks.
This commit is contained in:
Jambunathan K 2011-08-18 20:26:14 +05:30
parent ad9f393b61
commit 78e59a22d0
2 changed files with 157 additions and 8 deletions

View File

@ -717,7 +717,10 @@ version."
(setq-default org-deadline-line-regexp org-deadline-line-regexp)
(setq-default org-done-keywords org-done-keywords)
(setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp)
(let* (org-lparse-encode-pending
(let* (hfy-user-sheet-assoc ; let `htmlfontify' know that
; we are interested in
; collecting styles
org-lparse-encode-pending
org-lparse-par-open
(org-lparse-list-level 0) ; list level starts at 1. A
; value of 0 implies we are

View File

@ -236,7 +236,7 @@ be linked only."
(right . "OrgRight")
(title . "Heading_20_1.title")
(footnote . "Footnote")
(src . "OrgSourceBlock")
(src . "OrgSrcBlock")
(illustration . "Illustration")
(table . "Table")
(definition-term . "Text_20_body_20_bold")
@ -852,8 +852,19 @@ PUB-DIR is set, use this as the publishing directory."
((string= s "\t") (org-odt-format-tabs))
(t (org-odt-format-spaces (length s))))) line))
(defun org-odt-format-source-code-or-example
(defcustom org-export-odt-use-htmlfontify t
"Specify whether or not source blocks need to be fontified.
Turn this option on if you want to colorize the source code
blocks in the exported file. For colorization to work, you need
to make available an enhanced version of `htmlfontify' library."
:type 'boolean
:group 'org-export-odt)
(defun org-odt-format-source-code-or-example-plain
(lines lang caption textareap cols rows num cont rpllbl fmt)
"Format source or example blocks much like fixedwidth blocks.
Use this when `org-export-odt-use-htmlfontify' option is turned
off."
(setq lines (org-export-number-lines (org-xml-encode-plain-text-lines lines)
0 0 num cont rpllbl fmt))
(mapconcat
@ -862,6 +873,134 @@ PUB-DIR is set, use this as the publishing directory."
'fixedwidth (org-odt-fill-tabs-and-spaces line)))
(org-split-string lines "[\r\n]") "\n"))
(defvar org-src-block-paragraph-format
"<style:style style:name=\"OrgSrcBlock\" style:family=\"paragraph\" style:parent-style-name=\"Preformatted_20_Text\">
<style:paragraph-properties fo:background-color=\"%s\" fo:padding=\"0.049cm\" fo:border=\"0.51pt solid #000000\" style:shadow=\"none\">
<style:background-image/>
</style:paragraph-properties>
<style:text-properties fo:color=\"%s\"/>
</style:style>"
"Custom paragraph style for colorized source and example blocks.
This style is much the same as that of \"OrgFixedWidthBlock\"
except that the foreground and background colors are set
according to the default face identified by the `htmlfontify'.")
(defun org-odt-hfy-face-to-css (fn)
"Create custom style for face FN.
When FN is the default face, use it's foreground and background
properties to create \"OrgSrcBlock\" paragraph style. Otherwise
use it's color attribute to create a character style whose name
is obtained from FN. Currently all attributes of FN other than
color are ignored.
The style name for a face FN is derived using the following
operations on the face name in that order - de-dash, CamelCase
and prefix with \"OrgSrc\". For example,
`font-lock-function-name-face' is associated with
\"OrgSrcFontLockFunctionNameFace\"."
(let* ((css-list (hfy-face-to-style fn))
(style-name ((lambda (fn)
(concat "OrgSrc"
(mapconcat
'capitalize (split-string
(hfy-face-or-def-to-name fn) "-")
""))) fn))
(color-val (cdr (assoc "color" css-list)))
(background-color-val (cdr (assoc "background" css-list)))
(style (and org-export-odt-create-custom-styles-for-srcblocks
(cond
((eq fn 'default)
(format org-src-block-paragraph-format
background-color-val color-val))
(t
(format
"
<style:style style:name=\"%s\" style:family=\"text\">
<style:text-properties fo:color=\"%s\"/>
</style:style>" style-name color-val))))))
(cons style-name style)))
(defcustom org-export-odt-create-custom-styles-for-srcblocks t
"Whether custom styles for colorized source blocks be automatically created.
When this option is turned on, the exporter creates custom styles
for source blocks based on the advice of `htmlfontify'. Creation
of custom styles happen as part of `org-odt-hfy-face-to-css'.
When this option is turned off exporter does not create such
styles.
Use the latter option if you do not want the custom styles to be
based on your current display settings. It is necessary that the
styles.xml already contains needed styles for colorizing to work.
This variable is effective only if
`org-export-odt-use-htmlfontify' is turned on."
:group 'org-export-odt
:type 'boolean)
(defun org-odt-insert-custom-styles-for-srcblocks (styles)
"Save STYLES used for colorizing of source blocks.
Update styles.xml with styles that were collected as part of
`org-odt-hfy-face-to-css' callbacks."
(when styles
(with-current-buffer
(find-file-noselect (expand-file-name "styles.xml") t)
(goto-char (point-min))
(when (re-search-forward "</office:styles>" nil t)
(goto-char (match-beginning 0))
(insert "\n<!-- Org Htmlfontify Styles -->\n" styles "\n")))))
(defun org-odt-format-source-code-or-example-colored
(lines lang caption textareap cols rows num cont rpllbl fmt)
"Format source or example blocks using `htmlfontify-string'.
Use this routine when `org-export-odt-use-htmlfontify' option is
turned on."
(let* ((lang-m (and lang (or (cdr (assoc lang org-src-lang-modes)) lang)))
(mode (and lang-m (intern (concat (if (symbolp lang-m)
(symbol-name lang-m)
lang-m) "-mode"))))
(org-inhibit-startup t)
(org-startup-folded nil)
(lines (with-temp-buffer
(insert lines)
(if (functionp mode) (funcall mode) (fundamental-mode))
(font-lock-fontify-buffer)
(buffer-string)))
(hfy-html-quote-regex "\\([<\"&> ]\\)")
(hfy-html-quote-map '(("\"" "&quot;")
("<" "&lt;")
("&" "&amp;")
(">" "&gt;")
(" " "<text:s/>")
(" " "<text:tab/>")))
(hfy-face-to-css 'org-odt-hfy-face-to-css)
(hfy-optimisations-1 (copy-seq hfy-optimisations))
(hfy-optimisations (add-to-list 'hfy-optimisations-1
'body-text-only))
(hfy-begin-span-handler
(lambda (style text-block text-id text-begins-block-p)
(insert (format "<text:span text:style-name=\"%s\">" style))))
(hfy-end-span-handler (lambda nil (insert "</text:span>"))))
(mapconcat
(lambda (line)
(org-odt-format-stylized-paragraph 'src (htmlfontify-string line)))
(org-split-string lines "[\r\n]") "\n")))
(defun org-odt-format-source-code-or-example (lines lang caption textareap
cols rows num cont
rpllbl fmt)
"Format source or example blocks for export.
Use `org-odt-format-source-code-or-example-plain' or
`org-odt-format-source-code-or-example-colored' depending on the
value of `org-export-odt-use-htmlfontify."
(funcall
(if (and org-export-odt-use-htmlfontify
(or (featurep 'htmlfontify) (require 'htmlfontify))
(fboundp 'htmlfontify-string))
'org-odt-format-source-code-or-example-colored
'org-odt-format-source-code-or-example-plain)
lines lang caption textareap cols rows num cont rpllbl fmt))
(defun org-xml-encode-plain-text-lines (rtn)
(mapconcat 'org-xml-encode-plain-text (org-split-string rtn "[\r\n]") "\n"))
@ -1366,6 +1505,13 @@ visually."
(org-odt-configure-outline-numbering
(if org-export-with-section-numbers org-export-headline-levels 0)))
;; Write custom stlyes for source blocks
(org-odt-insert-custom-styles-for-srcblocks
(mapconcat
(lambda (style)
(format " %s\n" (cddr style)))
hfy-user-sheet-assoc ""))
(let ((zipdir default-directory))
(message "Switching to directory %s" (expand-file-name zipdir))