mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 12:21:25 -08:00
Code Issues Projects Releases Wiki Activity

* htmlfontify.el: Add support for code block fontification

Browse source 
for ODT export.
(hfy-optimisations): Define new option
`body-text-only'
(hfy-fontify-buffer): Honor above setting.
(hfy-begin-span, hfy-end-span): New routines factored out form
`hfy-fontify-buffer'.
(hfy-begin-span-handler, hfy-end-span-handler): New variables
that permit insertion of custom tags.
(hfy-fontify-buffer): Use above handlers.
(hfy-face-to-css-default): Same as the earlier `hfy-face-to-css'.
(hfy-face-to-css): Re-defined to be a variable.
(hfy-compile-stylesheet): Modified.  Allow stylesheet to be built
over multiple runs. This is made possible by having the caller let
bind a special variable `hfy-user-sheet-assoc'.
(htmlfontify-string): New defun.
(hfy-compile-face-map): Make sure that the last char in the
buffer is correctly fontified.
(hfy-face-resolve-face): Whitespace only change.

Fixes: debbugs:9914
This commit is contained in:
Jambunathan K 2012-03-17 22:03:54 +08:00 • committed by Chong Yidong
parent 986bd52a31
commit f02ff80d33
2 changed files with 147 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

22
lisp/ChangeLog
View file

@ -1,3 +1,25 @@
2012-03-13 Jambunathan K <kjambunathan@gmail.com>
* htmlfontify.el: Add support for code block fontification for ODT
export (Bug #9914).
(hfy-optimisations): Define new option
`body-text-only'
(hfy-fontify-buffer): Honor above setting.
(hfy-begin-span, hfy-end-span): New routines factored out form
`hfy-fontify-buffer'.
(hfy-begin-span-handler, hfy-end-span-handler): New variables
that permit insertion of custom tags.
(hfy-fontify-buffer): Use above handlers.
(hfy-face-to-css-default): Same as the earlier `hfy-face-to-css'.
(hfy-face-to-css): Re-defined to be a variable.
(hfy-compile-stylesheet): Modified. Allow stylesheet to be built
over multiple runs. This is made possible by having the caller let
bind a special variable `hfy-user-sheet-assoc'.
(htmlfontify-string): New defun.
(hfy-compile-face-map): Make sure that the last char in the
buffer is correctly fontified.
(hfy-face-resolve-face): Whitespace only change.
2012-03-17 Eli Zaretskii <eliz@gnu.org>
* textmodes/ispell.el (ispell-get-decoded-string): Make the error

159
lisp/htmlfontify.el
View file

@ -450,6 +450,12 @@ and so on."
keep-overlays : More of a bell (or possibly whistle) than an
optimization - If on, preserve overlay highlighting
(cf ediff or goo-font-lock) as well as basic faces.\n
body-text-only : Emit only body-text. In concrete terms,
1. Suppress calls to `hfy-page-header'and
`hfy-page-footer'
2. Pretend that `div-wrapper' option above is
turned off
3. Don't enclose output in <pre> </pre> tags
And the following are planned but not yet available:\n
kill-context-leak : Suppress hyperlinking between files highlighted by
different modes.\n
@ -463,7 +469,8 @@ which can never slow you down, but may result in incomplete fontification."
(const :tag "skip-refontification" skip-refontification)
(const :tag "kill-context-leak" kill-context-leak )
(const :tag "div-wrapper" div-wrapper )
(const :tag "keep-overlays" keep-overlays ))
(const :tag "keep-overlays" keep-overlays )
(const :tag "body-text-only" body-text-only ))
:group 'htmlfontify
:tag "optimizations")
@ -1044,7 +1051,7 @@ haven't encountered them yet. Returns a `hfy-style-assoc'."
((facep fn)
(hfy-face-attr-for-class fn hfy-display-class))
((and (symbolp fn)
(facep (symbol-value fn)))
(facep (symbol-value fn)))
;; Obsolete faces like `font-lock-reference-face' are defined as
;; aliases for another face.
(hfy-face-attr-for-class (symbol-value fn) hfy-display-class))
@ -1108,10 +1115,9 @@ See also `hfy-face-to-style-i', `hfy-flatten-style'."
;; construct an assoc of (stripped-name . "{ css-stuff-here }") pairs
;; from a face:
(defun hfy-face-to-css (fn)
"Take FN, a font or `defface' specification (cf `face-attr-construct')
and return a CSS style specification.\n
See also `hfy-face-to-style'."
(defun hfy-face-to-css-default (fn)
"Default handler for mapping faces to styles.
See also `hfy-face-to-css'."
;;(message "hfy-face-to-css");;DBUG
(let* ((css-list (hfy-face-to-style fn))
(seen nil)
@ -1125,6 +1131,17 @@ See also `hfy-face-to-style'."
css-list)))
(cons (hfy-css-name fn) (format "{%s}" (apply 'concat css-text)))) )
(defvar hfy-face-to-css 'hfy-face-to-css-default
"Handler for mapping faces to styles.
The signature of the handler is of the form \(lambda (FN) ...\).
FN is a font or `defface' specification (cf
`face-attr-construct'). The handler should return a cons cell of
the form (STYLE-NAME . STYLE-SPEC).
The default handler is `hfy-face-to-css-default'.
See also `hfy-face-to-style'.")
(defalias 'hfy-prop-invisible-p
(if (fboundp 'invisible-p) #'invisible-p
(lambda (prop)
@ -1311,20 +1328,27 @@ The plists are returned in descending priority order."
;; construct an assoc of (face-name . (css-name . "{ css-style }")) elements:
(defun hfy-compile-stylesheet ()
"Trawl the current buffer, construct and return a `hfy-sheet-assoc'."
"Trawl the current buffer, construct and return a `hfy-sheet-assoc'.
If `hfy-user-sheet-assoc' is currently bound then use it to
collect new styles discovered during this run. Otherwise create
a new assoc."
;;(message "hfy-compile-stylesheet");;DBUG
(let ((pt (point-min))
;; Make the font stack stay:
;;(hfy-tmpfont-stack nil)
(fn nil)
(style nil))
(style (and (boundp 'hfy-user-sheet-assoc) hfy-user-sheet-assoc)))
(save-excursion
(goto-char pt)
(while (< pt (point-max))
(if (and (setq fn (hfy-face-at pt)) (not (assoc fn style)))
(push (cons fn (hfy-face-to-css fn)) style))
(setq pt (next-char-property-change pt))) )
(push (cons 'default (hfy-face-to-css 'default)) style)))
(push (cons fn (funcall hfy-face-to-css fn)) style))
(setq pt (next-char-property-change pt))))
(unless (assoc 'default style)
(push (cons 'default (funcall hfy-face-to-css 'default)) style))
(when (boundp 'hfy-user-sheet-assoc)
(setq hfy-user-sheet-assoc style))
style))
(defun hfy-fontified-p ()
"`font-lock' doesn't like to say it's been fontified when in batch
@ -1425,7 +1449,7 @@ Returns a modified copy of FACE-MAP."
(setq pt (next-char-property-change pt))
(setq pt-narrow (+ offset pt)))
(if (and map (not (eq 'end (cdar map))))
(push (cons (- (point-max) (point-min)) 'end) map)))
(push (cons (1+ (- (point-max) (point-min))) 'end) map)))
(if (hfy-opt 'merge-adjacent-tags) (hfy-merge-adjacent-spans map) map)))
(defun hfy-buffer ()
@ -1547,6 +1571,61 @@ Do not record undo information during evaluation of BODY."
(remove-text-properties (point-min) (point-max)
'(hfy-show-trailing-whitespace)))))
(defun hfy-begin-span (style text-block text-id text-begins-block-p)
"Default handler to begin a span of text.
Insert \"<span class=\"STYLE\" ...>\". See
`hfy-begin-span-handler' for more information."
(when text-begins-block-p
(insert
(format "<span onclick=\"toggle_invis('%s');\">…</span>" text-block)))
(insert
(if text-block
(format "<span class=\"%s\" id=\"%s-%d\">" style text-block text-id)
(format "<span class=\"%s\">" style))))
(defun hfy-end-span ()
"Default handler to end a span of text.
Insert \"</span>\". See `hfy-end-span-handler' for more
information."
(insert "</span>"))
(defvar hfy-begin-span-handler 'hfy-begin-span
"Handler to begin a span of text.
The signature of the handler is \(lambda (STYLE TEXT-BLOCK
TEXT-ID TEXT-BEGINS-BLOCK-P) ...\). The handler must insert
appropriate tags to begin a span of text.
STYLE is the name of the style that begins at point. It is
derived from the face attributes as part of `hfy-face-to-css'
callback. The other arguments TEXT-BLOCK, TEXT-ID,
TEXT-BEGINS-BLOCK-P are non-nil only if the buffer contains
invisible text.
TEXT-BLOCK is a string that identifies a single chunk of visible
or invisible text of which the current position is a part. For
visible portions, it's value is \"nil\". For invisible portions,
it's value is computed as part of `hfy-invisible-name'.
TEXT-ID marks a unique position within a block. It is set to
value of `point' at the current buffer position.
TEXT-BEGINS-BLOCK-P is a boolean and is non-nil if the current
span also begins a invisible portion of text.
An implementation can use TEXT-BLOCK, TEXT-ID,
TEXT-BEGINS-BLOCK-P to implement fold/unfold-on-mouse-click like
behaviour.
The default handler is `hfy-begin-span'.")
(defvar hfy-end-span-handler 'hfy-end-span
"Handler to end a span of text.
The signature of the handler is \(lambda () ...\). The handler
must insert appropriate tags to end a span of text.
The default handler is `hfy-end-span'.")
(defun hfy-fontify-buffer (&optional srcdir file)
"Implement the guts of `htmlfontify-buffer'.
SRCDIR, if set, is the directory being htmlfontified.
@ -1634,23 +1713,19 @@ FILE, if set, is the file name."
(or (get-text-property pt 'hfy-linkp)
(get-text-property pt 'hfy-endl )))
(if (eq 'end fn)
(insert "</span>")
(funcall hfy-end-span-handler)
(if (not (and srcdir file))
nil
(when move-link
(remove-text-properties (point) (1+ (point)) '(hfy-endl nil))
(put-text-property pt (1+ pt) 'hfy-endl t) ))
;; if we have invisible blocks, we need to do some extra magic:
(if invis-ranges
(let ((iname (hfy-invisible-name pt invis-ranges))
(fname (hfy-lookup fn css-sheet )))
(when (assq pt invis-ranges)
(insert
(format "<span onclick=\"toggle_invis('%s');\">" iname))
(insert "…</span>"))
(insert
(format "<span class=\"%s\" id=\"%s-%d\">" fname iname pt)))
(insert (format "<span class=\"%s\">" (hfy-lookup fn css-sheet))))
(funcall hfy-begin-span-handler
(hfy-lookup fn css-sheet)
(and invis-ranges
(format "%s" (hfy-invisible-name pt invis-ranges)))
(and invis-ranges pt)
(and invis-ranges (assq pt invis-ranges)))
(if (not move-link) nil
;;(message "removing prop2 @ %d" (point))
(if (remove-text-properties (point) (1+ (point)) '(hfy-endl nil))
@ -1698,23 +1773,39 @@ FILE, if set, is the file name."
;; so we have to do this after we use said properties:
;; (message "munging dangerous characters")
(hfy-html-dekludge-buffer)
;; insert the stylesheet at the top:
(goto-char (point-min))
;;(message "inserting stylesheet")
(insert (hfy-sprintf-stylesheet css-sheet file))
(if (hfy-opt 'div-wrapper) (insert "<div class=\"default\">"))
(insert "\n<pre>")
(goto-char (point-max))
(insert "</pre>\n")
(if (hfy-opt 'div-wrapper) (insert "</div>"))
;;(message "inserting footer")
(insert (funcall hfy-page-footer file))
(unless (hfy-opt 'body-text-only)
;; insert the stylesheet at the top:
(goto-char (point-min))
;;(message "inserting stylesheet")
(insert (hfy-sprintf-stylesheet css-sheet file))
(if (hfy-opt 'div-wrapper) (insert "<div class=\"default\">"))
(insert "\n<pre>")
(goto-char (point-max))
(insert "</pre>\n")
(if (hfy-opt 'div-wrapper) (insert "</div>"))
;;(message "inserting footer")
(insert (funcall hfy-page-footer file)))
;; call any post html-generation hooks:
(run-hooks 'hfy-post-html-hooks)
;; return the html buffer
(set-buffer-modified-p nil)
html-buffer))
(defun htmlfontify-string (string)
"Take a STRING and return a fontified version of it.
It is assumed that STRING has text properties that allow it to be
fontified. This is a simple convenience wrapper around
`htmlfontify-buffer'."
(let* ((hfy-optimisations-1 (copy-sequence hfy-optimisations))
(hfy-optimisations (add-to-list 'hfy-optimisations-1
'skip-refontification)))
(with-temp-buffer
(insert string)
(htmlfontify-buffer)
(buffer-string))))
(defun hfy-force-fontification ()
"Try to force font-locking even when it is optimized away."
(run-hooks 'hfy-init-kludge-hook)