User: scop
Date: 09/01/06 09:30:27
Modified: packages/xemacs-packages/text-modes ChangeLog htmlize.el
Log:
Sync htmlize.el with upstream 1.34, add /usr(/local)/share/X11/ to rgb.txt search path.
Revision Changes Path
1.170 +5 -0 XEmacs/packages/xemacs-packages/text-modes/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/text-modes/ChangeLog,v
retrieving revision 1.169
retrieving revision 1.170
diff -u -p -r1.169 -r1.170
--- ChangeLog 2007/06/30 12:11:35 1.169
+++ ChangeLog 2009/01/06 08:30:26 1.170
@@ -1,3 +1,8 @@
+2009-01-06 Ville Skyttä <[email protected]>
+
+ * htmlize.el: Sync with upstream version 1.34.
+ (htmlize-x-library-search-path): Add /usr(/local)/share/X11/.
+
2007-06-30 Norbert Koch <[email protected]>
* Makefile (VERSION): XEmacs package 1.95 released.
1.15 +306 -112 XEmacs/packages/xemacs-packages/text-modes/htmlize.el
Index: htmlize.el
===================================================================
RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/text-modes/htmlize.el,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -p -r1.14 -r1.15
--- htmlize.el 2005/11/02 07:02:17 1.14
+++ htmlize.el 2009/01/06 08:30:26 1.15
@@ -1,6 +1,6 @@
;; htmlize.el -- Convert buffer text and decorations to HTML.
-;; Copyright (C) 1997,1998,1999,2000,2001,2002,2003,2005 Hrvoje Niksic
+;; Copyright (C) 1997,1998,1999,2000,2001,2002,2003,2005,2006 Hrvoje Niksic
;; Author: Hrvoje Niksic <[email protected]>
;; Keywords: hypermedia, extensions
@@ -36,14 +36,17 @@
;; the same manner. `M-x htmlize-many-files-dired' does the same for
;; files marked in a dired buffer.
-;; htmlize supports two types of HTML output, selected by setting
-;; `htmlize-output-type': `css' and `font'. In `css' mode, htmlize
-;; uses cascading style sheets to specify colors; it generates classes
-;; that correspond to Emacs faces and uses <span class=FACE>...</span>
-;; to color parts of text. In this mode, the produced HTML is valid
-;; under the 4.01 strict DTD, as confirmed by the W3C validator. In
-;; `font' mode, htmlize uses <font color="...">...</font> to colorize
-;; HTML, which is not standard-compliant, but works better in older
+;; htmlize supports three types of HTML output, selected by setting
+;; `htmlize-output-type': `css', `inline-css', and `font'. In `css'
+;; mode, htmlize uses cascading style sheets to specify colors; it
+;; generates classes that correspond to Emacs faces and uses <span
+;; class=FACE>...</span> to color parts of text. In this mode, the
+;; produced HTML is valid under the 4.01 strict DTD, as confirmed by
+;; the W3C validator. `inline-css' is like `css', except the CSS is
+;; put directly in the STYLE attribute of the SPAN element, making it
+;; possible to paste the generated HTML to other documents. In `font'
+;; mode, htmlize uses <font color="...">...</font> to colorize HTML,
+;; which is not standard-compliant, but works better in older
;; browsers. `css' mode is the default.
;; You can also use htmlize from your Emacs Lisp code. When called
@@ -57,7 +60,7 @@
;; fix it. I relied heavily on the presence of CL extensions,
;; especially for cross-emacs compatibility; please don't try to
;; remove that particular dependency. When byte-compiling under GNU
-;; Emacs, you're likely to get lots of warnings; just ignore them.
+;; Emacs, you're likely to get some warnings; just ignore them.
;; The latest version should be available at:
;;
@@ -71,7 +74,7 @@
;; Thanks go to the multitudes of people who have sent reports and
;; contributed comments, suggestions, and fixes. They include Ron
;; Gut, Bob Weiner, Toni Drabik, Peter Breton, Thomas Vogels, Juri
-;; Linkov, and many others.
+;; Linkov, Maciek Pasternacki, and many others.
;; User quotes: "You sir, are a sick, sick, _sick_ person. :)"
;; -- Bill Perry, author of Emacs/W3
@@ -93,7 +96,7 @@
;; `cl' is loaded.
(load "cl-extra")))
-(defconst htmlize-version "1.28")
+(defconst htmlize-version "1.34")
;; Incantations to make custom stuff work without customize, e.g. on
;; XEmacs 19.14 or GNU Emacs 19.34.
@@ -122,18 +125,24 @@
:group 'htmlize)
(defcustom htmlize-output-type 'css
- "*Output type of generated HTML. Legal values are `css' and `font'.
+ "*Output type of generated HTML, one of `css', `inline-css', or `font'.
When set to `css' (the default), htmlize will generate a style sheet
with description of faces, and use it in the HTML document, specifying
the faces in the actual text with <span class=\"FACE\">.
+When set to `inline-css', the style will be generated as above, but
+placed directly in the STYLE attribute of the span ELEMENT: <span
+style=\"STYLE\">. This makes it easier to paste the resulting HTML to
+other documents.
+
When set to `font', the properties will be set using layout tags
<font>, <b>, <i>, <u>, and <strike>.
`css' output is normally preferred, but `font' is still useful for
-supporting old, pre-CSS browsers, or for easy embedding of colorized
-text in foreign HTML documents (no style sheet to carry around)."
-:type '(choice (const css) (const font))
+supporting old, pre-CSS browsers, and both `inline-css' and `font' for
+easier embedding of colorized text in foreign HTML documents (no style
+sheet to carry around)."
+:type '(choice (const css) (const inline-css) (const font))
:group 'htmlize)
(defcustom htmlize-generate-hyperlinks t
@@ -160,8 +169,16 @@ do your own hyperlinkification from html
:group 'htmlize)
(defcustom htmlize-replace-form-feeds t
- "*Non-nil means replace form feed characters in source code with <hr />.
-If this is a string, it additionally specifies the replacement to use.
+ "*Non-nil means replace form feeds in source code with HTML separators.
+Form feeds are the ^L characters at line beginnings that are sometimes
+used to separate sections of source code. If this variable is set to
+`t', form feed characters are replaced with the <hr> separator. If this
+is a string, it specifies the replacement to use. Note that <pre> is
+temporarily closed before the separator is inserted, so the default
+replacement is effectively \"</pre><hr /><pre>\". If you specify
+another replacement, don't forget to close and reopen the <pre> if you
+want the output to remain valid HTML.
+
If you need more elaborate processing, set this to nil and use
htmlize-after-hook."
:type 'boolean
@@ -227,6 +244,16 @@ default setting; don't change it unless
:type 'sexp
:group 'htmlize)
+(defcustom htmlize-ignore-face-size 'absolute
+ "*Whether face size should be ignored when generating HTML.
+If this is nil, face sizes are used. If set to t, sizes are ignored
+If set to `absolute', only absolute size specifications are ignored.
+Please note that font sizes only work with CSS-based output types."
+:type '(choice (const :tag "Don't ignore" nil)
+ (const :tag "Ignore all" t)
+ (const :tag "Ignore absolute" absolute))
+:group 'htmlize)
+
(defcustom htmlize-css-name-prefix ""
"*The prefix used for CSS names.
The CSS names that htmlize generates from face names are often too
@@ -275,6 +302,8 @@ output.")
(defvar htmlize-file-hook nil
"Hook run by `htmlize-file' after htmlizing a file, but before saving it.")
+
+(defvar htmlize-buffer-places)
;;; Some cross-Emacs compatibility.
@@ -615,11 +644,14 @@ without modifying their meaning."
(when (file-exists-p (expand-file-name file dir))
(return (expand-file-name file dir))))))
+;; XEmacs change: added /usr(/local)/share/X11/
(defvar htmlize-x-library-search-path
- '("/usr/X11R6/lib/X11/"
+ '("/usr/share/X11/"
+ "/usr/X11R6/lib/X11/"
"/usr/X11R5/lib/X11/"
"/usr/lib/X11R6/X11/"
"/usr/lib/X11R5/X11/"
+ "/usr/local/share/X11/"
"/usr/local/X11R6/lib/X11/"
"/usr/local/X11R5/lib/X11/"
"/usr/local/lib/X11R6/X11/"
@@ -797,6 +829,7 @@ If no rgb.txt file is found, return nil.
(defstruct htmlize-fstruct
foreground ; foreground color, #rrggbb
background ; background color, #rrggbb
+ size ; size
boldp ; whether face is bold
italicp ; whether face is italic
underlinep ; whether face is underlined
@@ -812,6 +845,8 @@ If no rgb.txt file is found, return nil.
(setf (htmlize-fstruct-foreground fstruct) (htmlize-color-to-rgb value)))
(:background
(setf (htmlize-fstruct-background fstruct) (htmlize-color-to-rgb value)))
+ (:height
+ (setf (htmlize-fstruct-size fstruct) value))
(:weight
(when (string-match (symbol-name value) "bold")
(setf (htmlize-fstruct-boldp fstruct) t)))
@@ -829,6 +864,17 @@ If no rgb.txt file is found, return nil.
(:strike-through
(setf (htmlize-fstruct-strikep fstruct) value))))
+(defun htmlize-face-size (face)
+ ;; The size (height) of FACE, taking inheritance into account.
+ ;; Only works in Emacs 21 and later.
+ (let ((size-list
+ (loop
+ for f = face then (face-attribute f :inherit)
+ until (eq f 'unspecified)
+ for h = (face-attribute f :height)
+ collect (if (eq h 'unspecified) nil h))))
+ (reduce 'htmlize-merge-size (cons nil size-list))))
+
(defun htmlize-face-to-fstruct (face)
"Convert Emacs face FACE to fstruct."
(let ((fstruct (make-htmlize-fstruct
@@ -858,9 +904,19 @@ If no rgb.txt file is found, return nil.
(let ((value (if (>= emacs-major-version 22)
;; Use the INHERIT arg in GNU Emacs 22.
(face-attribute face attr nil t)
- (face-attribute face attr))))
+ ;; Otherwise, fake it.
+ (let ((face face))
+ (while (and (eq (face-attribute face attr)
+ 'unspecified)
+ (not (eq (face-attribute face :inherit)
+ 'unspecified)))
+ (setq face (face-attribute face :inherit)))
+ (face-attribute face attr)))))
(when (and value (not (eq value 'unspecified)))
- (htmlize-face-emacs21-attr fstruct attr value)))))
+ (htmlize-face-emacs21-attr fstruct attr value))))
+ (let ((size (htmlize-face-size face)))
+ (unless (eql size 1.0) ; ignore non-spec
+ (setf (htmlize-fstruct-size fstruct) size))))
(t
;; Older GNU Emacs. Some of these functions are only
;; available under Emacs 20+, hence the guards.
@@ -897,6 +953,46 @@ If no rgb.txt file is found, return nil.
name))
fstruct))
+(defmacro htmlize-copy-attr-if-set (attr-list dest source)
+ ;; Expand the code of the type
+ ;; (and (htmlize-fstruct-ATTR source)
+ ;; (setf (htmlize-fstruct-ATTR dest) (htmlize-fstruct-ATTR source)))
+ ;; for the given list of boolean attributes.
+ (cons 'progn
+ (loop for attr in attr-list
+ for attr-sym = (intern (format "htmlize-fstruct-%s" attr))
+ collect `(and (,attr-sym ,source)
+ (setf (,attr-sym ,dest) (,attr-sym ,source))))))
+
+(defun htmlize-merge-size (merged next)
+ ;; Calculate the size of the merge of MERGED and NEXT.
+ (cond ((null merged) next)
+ ((integerp next) next)
+ ((null next) merged)
+ ((floatp merged) (* merged next))
+ ((integerp merged) (round (* merged next)))))
+
+(defun htmlize-merge-two-faces (merged next)
+ (htmlize-copy-attr-if-set
+ (foreground background boldp italicp underlinep overlinep strikep)
+ merged next)
+ (setf (htmlize-fstruct-size merged)
+ (htmlize-merge-size (htmlize-fstruct-size merged)
+ (htmlize-fstruct-size next)))
+ merged)
+
+(defun htmlize-merge-faces (fstruct-list)
+ (cond ((null fstruct-list)
+ ;; Nothing to do, return a dummy face.
+ (make-htmlize-fstruct))
+ ((null (cdr fstruct-list))
+ ;; Optimize for the common case of a single face, simply
+ ;; return it.
+ (car fstruct-list))
+ (t
+ (reduce #'htmlize-merge-two-faces
+ (cons (make-htmlize-fstruct) fstruct-list)))))
+
;; GNU Emacs 20+ supports attribute lists in `face' properties. For
;; example, you can use `(:foreground "red" :weight bold)' as an
;; overlay's "face", or you can even use a list of such lists, etc.
@@ -1016,8 +1112,8 @@ property and by buffer overlays that spe
next (or (next-single-property-change pos 'face) (point-max)))
;; FACE-PROP can be a face/attrlist or a list thereof.
(setq faces (if (htmlize-face-list-p face-prop)
- (union (mapcar #'htmlize-unstringify-face face-prop)
- faces :test 'equal)
+ (nunion (mapcar #'htmlize-unstringify-face face-prop)
+ faces :test 'equal)
(adjoin (htmlize-unstringify-face face-prop)
faces :test 'equal)))
(setq pos next)))
@@ -1026,8 +1122,8 @@ property and by buffer overlays that spe
(let ((face-prop (overlay-get overlay 'face)))
;; FACE-PROP can be a face/attrlist or a list thereof.
(setq faces (if (htmlize-face-list-p face-prop)
- (union (mapcar #'htmlize-unstringify-face face-prop)
- faces :test 'equal)
+ (nunion (mapcar #'htmlize-unstringify-face face-prop)
+ faces :test 'equal)
(adjoin (htmlize-unstringify-face face-prop)
faces :test 'equal))))))
faces))
@@ -1042,15 +1138,22 @@ property and by buffer overlays that spe
(cond (htmlize-running-xemacs
(defun htmlize-faces-at-point ()
- (let (extent list face-prop)
+ (let (extent extent-list face-list face-prop)
(while (setq extent (extent-at (point) nil 'face extent))
+ (push extent extent-list))
+ ;; extent-list is in reverse display order, meaning that
+ ;; smallest ones come last. That is the order we want,
+ ;; except it can be overridden by the `priority' property.
+ (setq extent-list (stable-sort extent-list #'<
+ :key #'extent-priority))
+ (dolist (extent extent-list)
(setq face-prop (extent-face extent))
- (setq list (if (listp face-prop)
- (nconc (reverse face-prop) list)
- (cons face-prop list))))
- ;; No need to reverse the list: PUSH has already
- ;; constructed it in the reverse display order.
- list)))
+ ;; extent's face-list is in reverse order from what we
+ ;; want, but the `nreverse' below will take care of it.
+ (setq face-list (if (listp face-prop)
+ (append face-prop face-list)
+ (cons face-prop face-list))))
+ (nreverse face-list))))
(t
(defun htmlize-faces-at-point ()
(let (all-faces)
@@ -1078,6 +1181,16 @@ property and by buffer overlays that spe
:key (lambda (o)
(- (overlay-end o)
(overlay-start o)))))
+ ;; Overlay priorities, if present, override the above
+ ;; established order. Larger overlay priority takes
+ ;; precedence and therefore comes later in the list.
+ (setq overlays (stable-sort
+ overlays
+ ;; Reorder (stably) by acending...
+ #'<
+ ;; ...overlay priority.
+ :key (lambda (o)
+ (or (overlay-get o 'priority) 0))))
(dolist (overlay overlays)
(setq face-prop (overlay-get overlay 'face))
(setq list (if (htmlize-face-list-p face-prop)
@@ -1118,13 +1231,63 @@ property and by buffer overlays that spe
;; Return METHOD's function definition for the current output type.
;; The returned object can be safely funcalled.
(let ((sym (intern (format "htmlize-%s-%s" htmlize-output-type method))))
- (indirect-function (if (fboundp sym) sym 'ignore))))
+ (indirect-function (if (fboundp sym)
+ sym
+ (let ((default (intern (concat "htmlize-default-"
+ (symbol-name method)))))
+ (if (fboundp default)
+ default
+ 'ignore))))))
+
+(defvar htmlize-memoization-table (make-hash-table :test 'equal))
+
+(defmacro htmlize-memoize (key generator)
+ "Return the value of GENERATOR, memoized as KEY.
+That means that GENERATOR will be evaluated and returned the first time
+it's called with the same value of KEY. All other times, the cached
+\(memoized) value will be returned."
+ (let ((value (gensym)))
+ `(let ((,value (gethash ,key htmlize-memoization-table)))
+ (unless ,value
+ (setq ,value ,generator)
+ (setf (gethash ,key htmlize-memoization-table) ,value))
+ ,value)))
-;;; CSS based output support.
+;;; Default methods.
+
+(defun htmlize-default-doctype ()
+ nil ; no doc-string
+ ;; According to DTDs published by the W3C, it is illegal to embed
+ ;; <font> in <pre>. This makes sense in general, but is bad for
+ ;; htmlize's intended usage of <font> to specify the document color.
+
+ ;; To make generated HTML legal, htmlize's `font' mode used to
+ ;; specify the SGML declaration of "HTML Pro" DTD here. HTML Pro
+ ;; aka Silmaril DTD was a project whose goal was to produce a GPL'ed
+ ;; DTD that would encompass all the incompatible HTML extensions
+ ;; procured by Netscape, MSIE, and other players in the field.
+ ;; Apparently the project got abandoned, the last available version
+ ;; being "Draft 0 Revision 11" from January 1997, as documented at
+ ;; <http://imbolc.ucc.ie/~pflynn/articles/htmlpro.html>.
+
+ ;; Since by now HTML Pro is remembered by none but the most die-hard
+ ;; early-web-days nostalgics and used by not even them, there is no
+ ;; use in specifying it. So we return the standard HTML 4.0
+ ;; declaration, which makes generated HTML technically illegal. If
+ ;; you have a problem with that, use the `css' engine designed to
+ ;; create fully conforming HTML.
+
+ "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">"
+
+ ;; Now-abandoned HTML Pro declaration.
+ ;"<!DOCTYPE HTML PUBLIC \"+//Silmaril//DTD HTML Pro v0r11 19970101//EN\">"
+ )
-(defun htmlize-css-doctype ()
+(defun htmlize-default-body-tag (face-map)
nil ; no doc-string
- "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">")
+ "<body>")
+
+;;; CSS based output support.
;; Internal function; not a method.
(defun htmlize-css-specs (fstruct)
@@ -1136,6 +1299,12 @@ property and by buffer overlays that spe
(push (format "background-color: %s;"
(htmlize-fstruct-background fstruct))
result))
+ (let ((size (htmlize-fstruct-size fstruct)))
+ (when (and size (not (eq htmlize-ignore-face-size t)))
+ (cond ((floatp size)
+ (push (format "font-size: %d%%;" (* 100 size)) result))
+ ((not (eq htmlize-ignore-face-size 'absolute))
+ (push (format "font-size: %spt;" (/ size 10.0)) result)))))
(when (htmlize-fstruct-boldp fstruct)
(push "font-weight: bold;" result))
(when (htmlize-fstruct-italicp fstruct)
@@ -1194,77 +1363,59 @@ property and by buffer overlays that spe
(ignore fstruct) ; shut up the byte-compiler
(princ "</span>" buffer)))
-;;; `font' tag based output support.
-
-(defun htmlize-font-doctype ()
- nil ; no doc-string
-
- ;; According to DTDs published by the W3C, it is illegal to embed
- ;; <font> in <pre>. This makes sense in general, but is bad for
- ;; htmlize's intended usage of <font> to specify the document color.
-
- ;; To make generated HTML legal, htmlize.el used to specify the SGML
- ;; declaration of "HTML Pro" DTD here. HTML Pro aka Silmaril DTD
- ;; was a project whose goal was to produce a GPL'ed DTD that would
- ;; encompass all the incompatible HTML extensions procured by
- ;; Netscape, MSIE, and other players in the field. Apparently the
- ;; project got abandoned, the last available version being "Draft 0
- ;; Revision 11" from January 1997, as documented at
- ;; <http://imbolc.ucc.ie/~pflynn/articles/htmlpro.html>.
-
- ;; Since by now (2005) HTML Pro is remembered by none but the most
- ;; die-hard early-web-days nostalgics and used by not even them,
- ;; there is no use in specifying it. So we return the standard HTML
- ;; 4.0 declaration, which makes generated HTML technically illegal.
- ;; If you have a problem with that, use the `css' generation engine
- ;; which I believe creates fully conforming HTML.
+;; `inline-css' output support.
- "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">"
-
- ;; Now-abandoned HTML Pro declaration.
- ;"<!DOCTYPE HTML PUBLIC \"+//Silmaril//DTD HTML Pro v0r11 19970101//EN\">"
- )
+(defun htmlize-inline-css-body-tag (face-map)
+ (format "<body style=\"%s\">"
+ (mapconcat #'identity (htmlize-css-specs (gethash 'default face-map))
+ " ")))
+
+(defun htmlize-inline-css-insert-text (text fstruct-list buffer)
+ (let* ((merged (htmlize-merge-faces fstruct-list))
+ (style (htmlize-memoize
+ merged
+ (let ((specs (htmlize-css-specs merged)))
+ (and specs
+ (mapconcat #'identity (htmlize-css-specs merged) " "))))))
+ (when style
+ (princ "<span style=\"" buffer)
+ (princ style buffer)
+ (princ "\">" buffer))
+ (princ text buffer)
+ (when style
+ (princ "</span>" buffer))))
+
+;;; `font' tag based output support.
(defun htmlize-font-body-tag (face-map)
(let ((fstruct (gethash 'default face-map)))
(format "<body text=\"%s\" bgcolor=\"%s\">"
(htmlize-fstruct-foreground fstruct)
(htmlize-fstruct-background fstruct))))
-
+
(defun htmlize-font-insert-text (text fstruct-list buffer)
;; In `font' mode, we use the traditional HTML means of altering
;; presentation: <font> tag for colors, <b> for bold, <u> for
;; underline, and <strike> for strike-through.
- (let (bold italic underline strike fg)
- ;; Merge the face attributes.
- (dolist (fstruct fstruct-list)
- ;; A non-null boolean attribute in any face sets the attribute.
- (and (htmlize-fstruct-boldp fstruct) (setq bold t))
- (and (htmlize-fstruct-italicp fstruct) (setq italic t))
- (and (htmlize-fstruct-underlinep fstruct) (setq underline t))
- (and (htmlize-fstruct-strikep fstruct) (setq strike t))
- ;; The foreground/background of the last face in the list wins.
- (and (htmlize-fstruct-foreground fstruct)
- (setq fg (htmlize-fstruct-foreground fstruct))))
-
- ;; Generate the markup that reflects the merged attributes.
- (princ (concat
- (and fg (format "<font color=\"%s\">" fg))
- (and bold "<b>")
- (and italic "<i>")
- (and underline "<u>")
- (and strike "<strike>"))
- buffer)
- ;; Print the text.
+ (let* ((merged (htmlize-merge-faces fstruct-list))
+ (markup (htmlize-memoize
+ merged
+ (cons (concat
+ (and (htmlize-fstruct-foreground merged)
+ (format "<font color=\"%s\">" (htmlize-fstruct-foreground merged)))
+ (and (htmlize-fstruct-boldp merged) "<b>")
+ (and (htmlize-fstruct-italicp merged) "<i>")
+ (and (htmlize-fstruct-underlinep merged) "<u>")
+ (and (htmlize-fstruct-strikep merged) "<strike>"))
+ (concat
+ (and (htmlize-fstruct-strikep merged) "</strike>")
+ (and (htmlize-fstruct-underlinep merged) "</u>")
+ (and (htmlize-fstruct-italicp merged) "</i>")
+ (and (htmlize-fstruct-boldp merged) "</b>")
+ (and (htmlize-fstruct-foreground merged) "</font>"))))))
+ (princ (car markup) buffer)
(princ text buffer)
- ;; Close the tags we've opened.
- (princ (concat
- (and strike "</strike>")
- (and underline "</u>")
- (and italic "</i>")
- (and bold "</b>")
- (and fg "</font>"))
- buffer)))
+ (princ (cdr markup) buffer)))
(defun htmlize-buffer-1 ()
;; Internal function; don't call it from outside this file. Htmlize
@@ -1279,6 +1430,7 @@ property and by buffer overlays that spe
;; in advance.
(htmlize-ensure-fontified)
(clrhash htmlize-extended-character-cache)
+ (clrhash htmlize-memoization-table)
(let* ((buffer-faces (htmlize-faces-in-buffer))
(face-map (htmlize-make-face-map (adjoin 'default buffer-faces)))
;; Generate the new buffer. It's important that it inherits
@@ -1288,6 +1440,9 @@ property and by buffer overlays that spe
(file-name-nondirectory
(buffer-file-name)))
"*html*")))
+ ;; Having a dummy value in the plist allows writing simply
+ ;; (plist-put places foo bar).
+ (places '(nil nil))
(title (if (buffer-file-name)
(file-name-nondirectory (buffer-file-name))
(buffer-name))))
@@ -1297,7 +1452,9 @@ property and by buffer overlays that spe
(insert (htmlize-method doctype) ?\n
(format "<!-- Created by htmlize-%s in %s mode. -->\n"
htmlize-version htmlize-output-type)
- "<html>\n <head>\n"
+ "<html>\n ")
+ (plist-put places 'head-start (point-marker))
+ (insert "<head>\n"
" <title>" (htmlize-protect-string title) "</title>\n"
(if htmlize-html-charset
(format (concat " <meta http-equiv=\"Content-Type\" "
@@ -1306,11 +1463,14 @@ property and by buffer overlays that spe
"")
htmlize-head-tags)
(htmlize-method insert-head buffer-faces face-map)
- (insert " </head>"
- "\n "
- (or (htmlize-method body-tag face-map)
- "<body>")
- "\n <pre>\n"))
+ (insert " </head>")
+ (plist-put places 'head-end (point-marker))
+ (insert "\n ")
+ (plist-put places 'body-start (point-marker))
+ (insert (htmlize-method body-tag face-map)
+ "\n ")
+ (plist-put places 'content-start (point-marker))
+ (insert "<pre>\n"))
(let ((insert-text-method
;; Get the inserter method, so we can funcall it inside
;; the loop. Not calling `htmlize-method' in the loop
@@ -1358,20 +1518,24 @@ property and by buffer overlays that spe
;; Insert the epilog and post-process the buffer.
(with-current-buffer htmlbuf
- (insert "</pre>\n </body>\n</html>\n")
+ (insert "</pre>")
+ (plist-put places 'content-end (point-marker))
+ (insert "\n </body>")
+ (plist-put places 'body-end (point-marker))
+ (insert "\n</html>\n")
(when htmlize-generate-hyperlinks
(htmlize-make-hyperlinks))
(htmlize-defang-local-variables)
(when htmlize-replace-form-feeds
- ;; Change each "^L\n" to "\n<hr/>".
+ ;; Change each "\n^L" to "<hr />".
(goto-char (point-min))
(let ((source
;; ^L has already been escaped, so search for that.
- (htmlize-protect-string "\^L\n"))
+ (htmlize-protect-string "\n\^L"))
(replacement
- (concat "\n" (if (stringp htmlize-replace-form-feeds)
- htmlize-replace-form-feeds
- "<hr />"))))
+ (if (stringp htmlize-replace-form-feeds)
+ htmlize-replace-form-feeds
+ "</pre><hr /><pre>")))
(while (search-forward source nil t)
(replace-match replacement t t))))
(goto-char (point-min))
@@ -1379,12 +1543,26 @@ property and by buffer overlays that spe
;; What sucks about this is that the minor modes, most notably
;; font-lock-mode, won't be initialized. Oh well.
(funcall htmlize-html-major-mode))
+ (set (make-local-variable 'htmlize-buffer-places) places)
(run-hooks 'htmlize-after-hook)
(buffer-enable-undo))
htmlbuf)))
;; Utility functions.
+(defmacro htmlize-with-fontify-message (&rest body)
+ ;; When forcing fontification of large buffers in
+ ;; htmlize-ensure-fontified, inform the user that he is waiting for
+ ;; font-lock, not for htmlize to finish.
+ `(progn
+ (if (> (buffer-size) 65536)
+ (message "Forcing fontification of %s..."
+ (buffer-name (current-buffer))))
+ ,@body
+ (if (> (buffer-size) 65536)
+ (message "Forcing fontification of %s...done"
+ (buffer-name (current-buffer))))))
+
(defun htmlize-ensure-fontified ()
;; If font-lock is being used, ensure that the "support" modes
;; actually fontify the buffer. If font-lock is not in use, we
@@ -1396,15 +1574,18 @@ property and by buffer overlays that spe
(cond
((and (boundp 'jit-lock-mode)
(symbol-value 'jit-lock-mode))
- (jit-lock-fontify-now (point-min) (point-max)))
+ (htmlize-with-fontify-message
+ (jit-lock-fontify-now (point-min) (point-max))))
((and (boundp 'lazy-lock-mode)
(symbol-value 'lazy-lock-mode))
- (lazy-lock-fontify-region (point-min) (point-max)))
+ (htmlize-with-fontify-message
+ (lazy-lock-fontify-region (point-min) (point-max))))
((and (boundp 'lazy-shot-mode)
(symbol-value 'lazy-shot-mode))
- ;; lazy-shot is amazing in that it must *refontify* the region,
- ;; even if the whole buffer has already been fontified. <sigh>
- (lazy-shot-fontify-region (point-min) (point-max)))
+ (htmlize-with-fontify-message
+ ;; lazy-shot is amazing in that it must *refontify* the region,
+ ;; even if the whole buffer has already been fontified. <sigh>
+ (lazy-shot-fontify-region (point-min) (point-max))))
;; There's also fast-lock, but we don't need to handle specially,
;; I think. fast-lock doesn't really defer fontification, it
;; just saves it to an external cache so it's not done twice.
@@ -1446,6 +1627,19 @@ See `htmlize-buffer' for details."
(when (interactive-p)
(switch-to-buffer htmlbuf))
htmlbuf))
+
+(defun htmlize-region-for-paste (beg end)
+ "Htmlize the region and return just the HTML as a string.
+This forces the `inline-css' style and only returns the HTML body,
+but without the BODY tag. This should make it useful for inserting
+the text to another HTML buffer."
+ (let* ((htmlize-output-type 'inline-css)
+ (htmlbuf (htmlize-region beg end)))
+ (unwind-protect
+ (with-current-buffer htmlbuf
+ (buffer-substring (plist-get htmlize-buffer-places 'content-start)
+ (plist-get htmlize-buffer-places 'content-end)))
+ (kill-buffer htmlbuf))))
(defun htmlize-make-file-name (file)
"Make an HTML file name from FILE.
_______________________________________________
XEmacs-CVS mailing list
[email protected]
http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-cvs
lmpx.com only provides a reader for public news (NNTP) servers. It is not
affiliated with the servers or forums shown here and is not responsible for
the content of articles, which is written by their respective authors.