Commits

Anonymous committed 3768562

Sync htmlize.el with upstream 1.34, add /usr(/local)/share/X11/ to rgb.txt search path.

Comments (0)

Files changed (2)

+2009-01-06  Ville Skyttä  <scop@xemacs.org>
+
+	* htmlize.el: Sync with upstream version 1.34.
+	(htmlize-x-library-search-path): Add /usr(/local)/share/X11/.
+
 2007-06-30  Norbert Koch  <viteno@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 1.95 released.
 ;; 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 <hniksic@xemacs.org>
 ;; Keywords: hypermedia, extensions
 ;; 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
 ;; 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:
 ;;
 ;; 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
     ;; `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.
   :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
   :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
   :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
 
 (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.
 
       (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/"
 (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
      (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)))
     (: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
 	     (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.
 	    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.
 		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)))
 	(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))
 
 (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)
 				   :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)
   ;; 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)))
+
+;;; 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-default-body-tag (face-map)
+  nil					; no doc-string
+  "<body>")
 
 ;;; CSS based output support.
 
-(defun htmlize-css-doctype ()
-  nil					; no doc-string
-  "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\">")
-
 ;; Internal function; not a method.
 (defun htmlize-css-specs (fstruct)
   (let (result)
       (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)
     (ignore fstruct)			; shut up the byte-compiler
     (princ "</span>" buffer)))
 
+;; `inline-css' output support.
+
+(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-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.
-
-  "<!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-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
     ;; 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
 					      (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))))
 	(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\" "
 		  "")
 		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
 
       ;; 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))
 	  ;; 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
     (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.
       (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.