lisp/desktop.el (desktop-clear): Be more careful about deleting frames.

[bpt/emacs.git] / lisp / htmlfontify.el

diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el
index 0b02daf..3de2b1a 100644 (file)
--- a/lisp/htmlfontify.el
+++ b/lisp/htmlfontify.el
@@ -1,6 +1,6 @@
-;;; htmlfontify.el --- htmlise a buffer/source tree with optional hyperlinks
+;;; htmlfontify.el --- htmlize a buffer/source tree with optional hyperlinks

 
 

-;; Copyright (C) 2002-2003, 2009-2011  Free Software Foundation, Inc.
+;; Copyright (C) 2002-2003, 2009-2013 Free Software Foundation, Inc.

 
 ;; Emacs Lisp Archive Entry
 ;; Package: htmlfontify
 
 ;; Emacs Lisp Archive Entry
 ;; Package: htmlfontify


@@ -10,7 +10,7 @@
 ;; Author: Vivek Dasmohapatra <vivek@etla.org>
 ;; Maintainer: Vivek Dasmohapatra <vivek@etla.org>
 ;; Created: 2002-01-05
 ;; Author: Vivek Dasmohapatra <vivek@etla.org>
 ;; Maintainer: Vivek Dasmohapatra <vivek@etla.org>
 ;; Created: 2002-01-05

-;; Description: htmlise a buffer/source tree with optional hyperlinks
+;; Description: htmlize a buffer/source tree with optional hyperlinks

 ;; URL: http://rtfm.etla.org/emacs/htmlfontify/
 ;; Compatibility: Emacs23, Emacs22
 ;; Incompatibility: Emacs19, Emacs20, Emacs21
 ;; URL: http://rtfm.etla.org/emacs/htmlfontify/
 ;; Compatibility: Emacs23, Emacs22
 ;; Incompatibility: Emacs19, Emacs20, Emacs21


@@ -150,11 +150,11 @@ main-content <=MAIN_CONTENT;\\n\" rtfm-section file style rtfm-section file))
   :prefix "hfy-")
 
 (defcustom hfy-page-header 'hfy-default-header
   :prefix "hfy-")
 
 (defcustom hfy-page-header 'hfy-default-header

-  "Function called to build the header of the html source.
+  "Function called to build the header of the HTML source.

 This is called with two arguments (the filename relative to the top
 level source directory being etag'd and fontified), and a string containing
 the <style>...</style> text to embed in the document.
 This is called with two arguments (the filename relative to the top
 level source directory being etag'd and fontified), and a string containing
 the <style>...</style> text to embed in the document.

-It should return the string returned will be used as the header for the
+It should return a string that will be used as the header for the

 htmlfontified version of the source file.\n
 See also `hfy-page-footer'."
   :group 'htmlfontify
 htmlfontified version of the source file.\n
 See also `hfy-page-footer'."
   :group 'htmlfontify


@@ -166,8 +166,8 @@ See also `hfy-page-footer'."
 (defcustom hfy-split-index nil
   "Whether or not to split the index `hfy-index-file' alphabetically.
 If non-nil, the index is split on the first letter of each tag.
 (defcustom hfy-split-index nil
   "Whether or not to split the index `hfy-index-file' alphabetically.
 If non-nil, the index is split on the first letter of each tag.

-Useful when the index would otherwise
-be large and take a long time to render or be difficult to navigate."
+Useful when the index would otherwise be large and take
+a long time to render or be difficult to navigate."

   :group 'htmlfontify
   :tag   "split-index"
   :type  '(boolean))
   :group 'htmlfontify
   :tag   "split-index"
   :type  '(boolean))


@@ -179,7 +179,7 @@ It takes only one argument, the filename."
   :tag   "page-footer"
   :type  '(function))
 
   :tag   "page-footer"
   :type  '(function))
 

-(defcustom hfy-extn        ".html"
+(defcustom hfy-extn ".html"

   "File extension used for output files."
   :group 'htmlfontify
   :tag   "extension"
   "File extension used for output files."
   :group 'htmlfontify
   :tag   "extension"


@@ -249,9 +249,10 @@ when not running under a window system."
   :tag   "init-kludge-hooks"
   :type  '(hook))
 
   :tag   "init-kludge-hooks"
   :type  '(hook))
 

-(defcustom hfy-post-html-hooks nil
+(define-obsolete-variable-alias 'hfy-post-html-hooks 'hfy-post-html-hook "24.3")
+(defcustom hfy-post-html-hook nil

   "List of functions to call after creating and filling the HTML buffer.
   "List of functions to call after creating and filling the HTML buffer.

-These functions will be called with the html buffer as the current buffer."
+These functions will be called with the HTML buffer as the current buffer."

   :group   'htmlfontify
   :tag     "post-html-hooks"
   :options '(set-auto-mode)
   :group   'htmlfontify
   :tag     "post-html-hooks"
   :options '(set-auto-mode)


@@ -290,8 +291,7 @@ in order, to:\n
   :group 'htmlfontify
   :tag   "html-quote-map"
   :type  '(alist :key-type (string)))
   :group 'htmlfontify
   :tag   "html-quote-map"
   :type  '(alist :key-type (string)))

-(eval-and-compile
-  (defconst hfy-e2x-etags-cmd "for src in `find . -type f`;
+(defconst hfy-e2x-etags-cmd "for src in `find . -type f`;

 do
   ETAGS=%s;
   case ${src} in
 do
   ETAGS=%s;
   case ${src} in


@@ -322,17 +322,17 @@ do
   esac;
 done;")
 
   esac;
 done;")
 

-  (defconst hfy-etags-cmd-alist-default
-    `(("emacs etags"     . ,hfy-e2x-etags-cmd)
-      ("exuberant ctags" . "%s -R -f -"   )))
+(defconst hfy-etags-cmd-alist-default
+  `(("emacs etags"     . ,hfy-e2x-etags-cmd)
+    ("exuberant ctags" . "%s -R -f -"   )))

 
 

-  (defcustom hfy-etags-cmd-alist
-    hfy-etags-cmd-alist-default
-    "Alist of possible shell commands that will generate etags output that
+(defcustom hfy-etags-cmd-alist
+  hfy-etags-cmd-alist-default
+  "Alist of possible shell commands that will generate etags output that

 `htmlfontify' can use.  '%s' will be replaced by `hfy-etags-bin'."
 `htmlfontify' can use.  '%s' will be replaced by `hfy-etags-bin'."

-    :group 'htmlfontify
-    :tag   "etags-cmd-alist"
-    :type  '(alist :key-type (string) :value-type (string)) ))
+  :group 'htmlfontify
+  :tag   "etags-cmd-alist"
+  :type  '(alist :key-type (string) :value-type (string)))

 
 (defcustom hfy-etags-bin "etags"
   "Location of etags binary (we begin by assuming it's in your path).\n
 
 (defcustom hfy-etags-bin "etags"
   "Location of etags binary (we begin by assuming it's in your path).\n


@@ -343,7 +343,7 @@ commands in `hfy-etags-cmd-alist'."
   :type  '(file))
 
 (defcustom hfy-shell-file-name "/bin/sh"
   :type  '(file))
 
 (defcustom hfy-shell-file-name "/bin/sh"

-  "Shell (bourne or compatible) to invoke for complex shell operations."
+  "Shell (Bourne or compatible) to invoke for complex shell operations."

   :group 'htmlfontify
   :tag   "shell-file-name"
   :type  '(file))
   :group 'htmlfontify
   :tag   "shell-file-name"
   :type  '(file))


@@ -361,25 +361,30 @@ commands in `hfy-etags-cmd-alist'."
   :type '(repeat symbol))
 
 (defun hfy-which-etags ()
   :type '(repeat symbol))
 
 (defun hfy-which-etags ()

-  "Return a string indicating which flavour of etags we are using."
+  "Return a string indicating which flavor of etags we are using."

   (let ((v (shell-command-to-string (concat hfy-etags-bin " --version"))))
     (cond ((string-match "exube" v) "exuberant ctags")
           ((string-match "GNU E" v) "emacs etags"    )) ))
 
 (defcustom hfy-etags-cmd
   (let ((v (shell-command-to-string (concat hfy-etags-bin " --version"))))
     (cond ((string-match "exube" v) "exuberant ctags")
           ((string-match "GNU E" v) "emacs etags"    )) ))
 
 (defcustom hfy-etags-cmd

-  (eval-and-compile (cdr (assoc (hfy-which-etags) hfy-etags-cmd-alist)))
+  ;; We used to wrap this in a `eval-and-compile', but:
+  ;; - it had no effect because this expression was not seen by the
+  ;;   byte-compiler (defcustom used to quote this argument).
+  ;; - it signals an error (`hfy-which-etags' is not defined at compile-time).
+  ;; - we want this auto-detection to reflect the system on which Emacs is run
+  ;;   rather than the one on which it's compiled.
+  (cdr (assoc (hfy-which-etags) hfy-etags-cmd-alist))

   "The etags equivalent command to run in a source directory to generate a tags
 file for the whole source tree from there on down.  The command should emit
 the etags output on stdout.\n
   "The etags equivalent command to run in a source directory to generate a tags
 file for the whole source tree from there on down.  The command should emit
 the etags output on stdout.\n

-Two canned commands are provided - they drive Emacs' etags and
+Two canned commands are provided - they drive Emacs's etags and

 exuberant-ctags' etags respectively."
   :group 'htmlfontify
   :tag   "etags-command"
 exuberant-ctags' etags respectively."
   :group 'htmlfontify
   :tag   "etags-command"

-  :type (eval-and-compile
-          (let ((clist (list '(string))))
-            (dolist (C hfy-etags-cmd-alist)
-              (push (list 'const :tag (car C) (cdr C)) clist))
-            (cons 'choice clist)) ))
+  :type (let ((clist (list '(string))))
+          (dolist (C hfy-etags-cmd-alist)
+            (push (list 'const :tag (car C) (cdr C)) clist))
+          (cons 'choice clist)))

 
 (defcustom hfy-istext-command "file %s | sed -e 's@^[^:]*:[ \t]*@@'"
   "Command to run with the name of a file, to see whether it is a text file
 
 (defcustom hfy-istext-command "file %s | sed -e 's@^[^:]*:[ \t]*@@'"
   "Command to run with the name of a file, to see whether it is a text file


@@ -428,8 +433,8 @@ and so on."
                                  (const :tag "Lucid Toolkit" lucid    )
                                  (const :tag "Motif Toolkit" motif    )))
 
                                  (const :tag "Lucid Toolkit" lucid    )
                                  (const :tag "Motif Toolkit" motif    )))
 

-             (class      (choice (const :tag "Colour"        color    )
-                                 (const :tag "Greyscale"     grayscale)))
+             (class      (choice (const :tag "Color"         color    )
+                                 (const :tag "Grayscale"     grayscale)))

 
              (background (choice (const :tag "Dark"          dark     )
                                  (const :tag "Bright"        light    ))) ))
 
              (background (choice (const :tag "Dark"          dark     )
                                  (const :tag "Bright"        light    ))) ))


@@ -446,6 +451,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
   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
   And the following are planned but not yet available:\n
   kill-context-leak  : Suppress hyperlinking between files highlighted by
                        different modes.\n


@@ -459,7 +470,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 "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")
 
   :group 'htmlfontify
   :tag   "optimizations")
 


@@ -576,13 +588,13 @@ If a window system is unavailable, calls `hfy-fallback-colour-values'."
             (color-values colour)
           ;;(message "[%S]" window-system)
           (x-color-values colour))
             (color-values colour)
           ;;(message "[%S]" window-system)
           (x-color-values colour))

-      ;; blarg - tty colours are no good - go fetch some X colours:
+      ;; blarg - tty colors are no good - go fetch some X colors:

       (hfy-fallback-colour-values colour))))
 
 (defvar hfy-cperl-mode-kludged-p nil)
 
 (defun hfy-kludge-cperl-mode ()
       (hfy-fallback-colour-values colour))))
 
 (defvar hfy-cperl-mode-kludged-p nil)
 
 (defun hfy-kludge-cperl-mode ()

-  "CPerl mode does its damndest not to do some of its fontification when not
+  "CPerl mode does its damnedest not to do some of its fontification when not

 in a windowing system - try to trick it..."
   (if (not hfy-cperl-mode-kludged-p)
       (progn (if (not window-system)
 in a windowing system - try to trick it..."
   (if (not hfy-cperl-mode-kludged-p)
       (progn (if (not window-system)


@@ -591,7 +603,8 @@ in a windowing system - try to trick it..."
                    (setq cperl-syntaxify-by-font-lock t)))
              (setq hfy-cperl-mode-kludged-p t))) )
 
                    (setq cperl-syntaxify-by-font-lock t)))
              (setq hfy-cperl-mode-kludged-p t))) )
 

-(defun hfy-opt (symbol) "Is option SYMBOL set."
+(defun hfy-opt (symbol)
+  "Is option SYMBOL set."

   (memq symbol hfy-optimisations))
 
 (defun hfy-default-header (file style)
   (memq symbol hfy-optimisations))
 
 (defun hfy-default-header (file style)


@@ -704,9 +717,9 @@ STYLE is the inline CSS stylesheet (or tag referring to an external sheet)."
 --> </script>
   </head>
   <body onload=\"stripe('index'); return true;\">\n"
 --> </script>
   </head>
   <body onload=\"stripe('index'); return true;\">\n"

-          file style))
+          (mapconcat 'hfy-html-quote (mapcar 'char-to-string file) "") style))

 
 

-(defun hfy-default-footer (file)
+(defun hfy-default-footer (_file)

   "Default value for `hfy-page-footer'.
 FILE is the name of the file being rendered, in case it is needed."
   "\n </body>\n</html>\n")
   "Default value for `hfy-page-footer'.
 FILE is the name of the file being rendered, in case it is needed."
   "\n </body>\n</html>\n")


@@ -735,6 +748,10 @@ if you've redefined white, (esp. if you've redefined it to have a triplet
 member lower than that of the color you are processing) strange things
 may happen."
   ;;(message "hfy-colour-vals");;DBUG
 member lower than that of the color you are processing) strange things
 may happen."
   ;;(message "hfy-colour-vals");;DBUG

+  ;; TODO?  Can we do somehow do better than this?
+  (cond
+   ((equal colour "unspecified-fg") (setq colour "black"))
+   ((equal colour "unspecified-bg") (setq colour "white")))

   (let ((white (mapcar (lambda (I) (float (1+ I))) (hfy-colour-vals "white")))
         (rgb16 (mapcar (lambda (I) (float (1+ I))) (hfy-colour-vals  colour))))
     (if rgb16
   (let ((white (mapcar (lambda (I) (float (1+ I))) (hfy-colour-vals "white")))
         (rgb16 (mapcar (lambda (I) (float (1+ I))) (hfy-colour-vals  colour))))
     (if rgb16


@@ -760,6 +777,8 @@ may happen."
   "Derive a CSS font-size specifier from an Emacs font :height attribute HEIGHT.
 Does not cope with the case where height is a function to be applied to
 the height of the underlying font."
   "Derive a CSS font-size specifier from an Emacs font :height attribute HEIGHT.
 Does not cope with the case where height is a function to be applied to
 the height of the underlying font."

+  ;; In ttys, the default face has :height == 1.
+  (and (not (display-graphic-p)) (equal 1 height) (setq height 100))

   (list
    (cond
     ;;(t                 (cons "font-size" ": 1em"))
   (list
    (cond
     ;;(t                 (cons "font-size" ": 1em"))


@@ -821,7 +840,7 @@ regular specifiers."
        ((stringp  box) (list (cons "border" (format "solid %s 1px" box))))
        ((listp    box) (hfy-box-to-style box)                            ))) )
 
        ((stringp  box) (list (cons "border" (format "solid %s 1px" box))))
        ((listp    box) (hfy-box-to-style box)                            ))) )
 

-(defun hfy-decor (tag val)
+(defun hfy-decor (tag _val)

   "Derive CSS text-decoration specifiers from various Emacs font attributes.
 TAG is an Emacs font attribute key (eg :underline).
 VAL is ignored."
   "Derive CSS text-decoration specifiers from various Emacs font attributes.
 TAG is an Emacs font attribute key (eg :underline).
 VAL is ignored."


@@ -832,7 +851,7 @@ VAL is ignored."
      (:overline       (cons "text-decoration" "overline"    ))
      (:strike-through (cons "text-decoration" "line-through")))))
 
      (:overline       (cons "text-decoration" "overline"    ))
      (:strike-through (cons "text-decoration" "line-through")))))
 

-(defun hfy-invisible (&optional val)
+(defun hfy-invisible (&optional _val)

   "This text should be invisible.
 Do something in CSS to make that happen.
 VAL is ignored here."
   "This text should be invisible.
 Do something in CSS to make that happen.
 VAL is ignored here."


@@ -854,13 +873,13 @@ If CLASS is set, it must be a `defface' alist key [see below],
 in which case the first face specification returned by `hfy-combined-face-spec'
 which *doesn't* clash with CLASS is returned.\n
 \(A specification with a class of t is considered to match any class you
 in which case the first face specification returned by `hfy-combined-face-spec'
 which *doesn't* clash with CLASS is returned.\n
 \(A specification with a class of t is considered to match any class you

-specify - this matches Emacs' behavior when deciding on which face attributes
+specify - this matches Emacs's behavior when deciding on which face attributes

 to use, to the best of my understanding).\n
 to use, to the best of my understanding).\n

-If CLASS is nil, then you just get get whatever `face-attr-construct' returns,
+If CLASS is nil, then you just get whatever `face-attr-construct' returns,

 ie the current specification in effect for FACE.\n
 *NOTE*: This function forces any face that is not 'default and which has
 no :inherit property to inherit from 'default (this is because 'default
 ie the current specification in effect for FACE.\n
 *NOTE*: This function forces any face that is not 'default and which has
 no :inherit property to inherit from 'default (this is because 'default

-is magical in that Emacs' fonts behave as if they inherit implicitly from
+is magical in that Emacs's fonts behave as if they inherit implicitly from

 'default, but no such behavior exists in HTML/CSS).\n
 See also `hfy-display-class' for details of valid values for CLASS."
   (let ((face-spec
 'default, but no such behavior exists in HTML/CSS).\n
 See also `hfy-display-class' for details of valid values for CLASS."
   (let ((face-spec


@@ -1039,9 +1058,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 fn)
     (hfy-face-attr-for-class fn hfy-display-class))
    ((and (symbolp fn)

-        (facep (symbol-value fn)))
-    ;; Obsolete faces like `font-lock-reference-face' are defined as
-    ;; aliases for another face.
+         (facep (symbol-value fn)))

     (hfy-face-attr-for-class (symbol-value fn) hfy-display-class))
    (t nil)))
 
     (hfy-face-attr-for-class (symbol-value fn) hfy-display-class))
    (t nil)))
 


@@ -1062,7 +1079,7 @@ See also `hfy-face-to-style-i', `hfy-flatten-style'."
                      ;; text-decoration is not inherited.
                      ;; but it's not wrong and if this ever changes it will
                      ;; be needed, so I think it's better to leave it in? -- v
                      ;; text-decoration is not inherited.
                      ;; but it's not wrong and if this ever changes it will
                      ;; be needed, so I think it's better to leave it in? -- v

-                     (nconc final-style '(("text-decoration"."none"))))))
+                     (nconc final-style '(("text-decoration" . "none"))))))

     final-style))
 
 ;; strip redundant bits from a name. Technically, this could result in
     final-style))
 
 ;; strip redundant bits from a name. Technically, this could result in


@@ -1103,10 +1120,9 @@ See also `hfy-face-to-style-i', `hfy-flatten-style'."
 
 ;; construct an assoc of (stripped-name . "{ css-stuff-here }") pairs
 ;; from a face:
 
 ;; 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)
   ;;(message "hfy-face-to-css");;DBUG
   (let* ((css-list (hfy-face-to-style fn))
          (seen     nil)


@@ -1120,6 +1136,17 @@ See also `hfy-face-to-style'."
            css-list)))
     (cons (hfy-css-name fn) (format "{%s}" (apply 'concat css-text)))) )
 
            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)
 (defalias 'hfy-prop-invisible-p
   (if (fboundp 'invisible-p) #'invisible-p
     (lambda (prop)


@@ -1145,7 +1172,7 @@ See also `hfy-face-to-style'."
         (setq p (next-char-property-change p)))
       ;; still invisible at buffer end?
       (when i
         (setq p (next-char-property-change p)))
       ;; still invisible at buffer end?
       (when i

-        (setq invisible (cons (cons s (point-max)) invisible))) 
+        (setq invisible (cons (cons s (point-max)) invisible)))

       invisible)))
 
 (defun hfy-invisible-name (point map)
       invisible)))
 
 (defun hfy-invisible-name (point map)


@@ -1306,20 +1333,27 @@ The plists are returned in descending priority order."
 
 ;; construct an assoc of (face-name . (css-name . "{ css-style }")) elements:
 (defun hfy-compile-stylesheet ()
 
 ;; 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)
   ;;(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)))
     (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
 
 (defun hfy-fontified-p ()
   "`font-lock' doesn't like to say it's been fontified when in batch


@@ -1420,7 +1454,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))))
         (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 ()
     (if (hfy-opt 'merge-adjacent-tags) (hfy-merge-adjacent-spans map) map)))
 
 (defun hfy-buffer ()


@@ -1542,6 +1576,61 @@ Do not record undo information during evaluation of BODY."
       (remove-text-properties (point-min) (point-max)
                               '(hfy-show-trailing-whitespace)))))
 
       (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.
 (defun hfy-fontify-buffer (&optional srcdir file)
   "Implement the guts of `htmlfontify-buffer'.
 SRCDIR, if set, is the directory being htmlfontified.


@@ -1572,7 +1661,7 @@ FILE, if set, is the file name."
       (delete-overlay rovl))
     (copy-to-buffer html-buffer (point-min) (point-max))
     (set-buffer     html-buffer)
       (delete-overlay rovl))
     (copy-to-buffer html-buffer (point-min) (point-max))
     (set-buffer     html-buffer)

-    ;; rip out props that could interfere with our htmlisation of the buffer:
+    ;; rip out props that could interfere with our htmlization of the buffer:

     (remove-text-properties (point-min) (point-max) hfy-ignored-properties)
     ;; Apply overlay invisible spec
     (setq orig-ovls
     (remove-text-properties (point-min) (point-max) hfy-ignored-properties)
     ;; Apply overlay invisible spec
     (setq orig-ovls


@@ -1629,23 +1718,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)
               (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 (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))
           (if (not move-link) nil
             ;;(message "removing prop2 @ %d" (point))
             (if (remove-text-properties (point) (1+ (point)) '(hfy-endl nil))


@@ -1693,23 +1778,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)
     ;; 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:
     ;; call any post html-generation hooks:

-    (run-hooks 'hfy-post-html-hooks)
+    (run-hooks 'hfy-post-html-hook)

     ;; return the html buffer
     (set-buffer-modified-p nil)
     html-buffer))
 
     ;; 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)
 (defun hfy-force-fontification ()
   "Try to force font-locking even when it is optimized away."
   (run-hooks 'hfy-init-kludge-hook)


@@ -1755,7 +1856,7 @@ hyperlinks as appropriate."
   (if (not (hfy-opt 'skip-refontification))
       (save-excursion ;; Keep region
         (hfy-force-fontification)))
   (if (not (hfy-opt 'skip-refontification))
       (save-excursion ;; Keep region
         (hfy-force-fontification)))

-  (if (interactive-p) ;; display the buffer in interactive mode:
+  (if (called-interactively-p 'any) ;; display the buffer in interactive mode:

       (switch-to-buffer (hfy-fontify-buffer srcdir file))
     (hfy-fontify-buffer srcdir file)))
 
       (switch-to-buffer (hfy-fontify-buffer srcdir file))
     (hfy-fontify-buffer srcdir file)))
 


@@ -1764,13 +1865,13 @@ hyperlinks as appropriate."
   "Return a list of files under DIRECTORY.
 Strips any leading \"./\" from each filename."
   ;;(message "hfy-list-files");;DBUG
   "Return a list of files under DIRECTORY.
 Strips any leading \"./\" from each filename."
   ;;(message "hfy-list-files");;DBUG

-  ;; FIXME: this changes the dir of the currrent buffer.  Is that right??
+  ;; FIXME: this changes the dir of the current buffer.  Is that right??

   (cd directory)
   (mapcar (lambda (F) (if (string-match "^./\\(.*\\)" F) (match-string 1 F) F))
           (split-string (shell-command-to-string hfy-find-cmd))) )
 
   (cd directory)
   (mapcar (lambda (F) (if (string-match "^./\\(.*\\)" F) (match-string 1 F) F))
           (split-string (shell-command-to-string hfy-find-cmd))) )
 

-;; strip the filename off, return a directiry name
-;; not a particularly thorough implementaion, but it will be
+;; strip the filename off, return a directory name
+;; not a particularly thorough implementation, but it will be

 ;; fed pretty carefully, so it should be Ok:
 (defun hfy-dirname (file)
   "Return everything preceding the last \"/\" from a relative filename FILE,
 ;; fed pretty carefully, so it should be Ok:
 (defun hfy-dirname (file)
   "Return everything preceding the last \"/\" from a relative filename FILE,


@@ -1988,7 +2089,7 @@ FILE is the specific file we are rendering."
          tags-list) )))
 
 (defun hfy-shell ()
          tags-list) )))
 
 (defun hfy-shell ()

-  "Return `shell-file-name', or \"/bin/sh\" if it is a non-bourne shell."
+  "Return `shell-file-name', or \"/bin/sh\" if it is a non-Bourne shell."

   (if (string-match "\\<bash\\>\\|\\<sh\\>\\|\\<dash\\>" shell-file-name)
       shell-file-name
     (or hfy-shell-file-name "/bin/sh")))
   (if (string-match "\\<bash\\>\\|\\<sh\\>\\|\\<dash\\>" shell-file-name)
       shell-file-name
     (or hfy-shell-file-name "/bin/sh")))


@@ -2022,13 +2123,13 @@ FILE is the specific file we are rendering."
         (hash-entry nil) (tag-string nil) (tag-line   nil)
         (tag-point  nil) (new-entry  nil) (etags-file nil))
 
         (hash-entry nil) (tag-string nil) (tag-line   nil)
         (tag-point  nil) (new-entry  nil) (etags-file nil))
 

-    ;; (re)initialise the tag reverse map:
+    ;; (re)initialize the tag reverse map:

     (if trmap-cache (setq trmap-hash (cadr trmap-cache))
       (setq trmap-hash (make-hash-table :test 'equal))
       (setq hfy-tags-rmap (list (list srcdir trmap-hash) hfy-tags-rmap)))
     (clrhash trmap-hash)
 
     (if trmap-cache (setq trmap-hash (cadr trmap-cache))
       (setq trmap-hash (make-hash-table :test 'equal))
       (setq hfy-tags-rmap (list (list srcdir trmap-hash) hfy-tags-rmap)))
     (clrhash trmap-hash)
 

-    ;; (re)initialise the tag cache:
+    ;; (re)initialize the tag cache:

     (if cache-entry (setq cache-hash (cadr cache-entry))
       (setq cache-hash (make-hash-table :test 'equal))
       (setq hfy-tags-cache (list (list srcdir cache-hash) hfy-tags-cache)))
     (if cache-entry (setq cache-hash (cadr cache-entry))
       (setq cache-hash (make-hash-table :test 'equal))
       (setq hfy-tags-cache (list (list srcdir cache-hash) hfy-tags-cache)))


@@ -2057,7 +2158,7 @@ FILE is the specific file we are rendering."
                   (puthash tag-string hash-entry cache-hash)))) )))
 
     ;; cache a list of tags in descending length order:
                   (puthash tag-string hash-entry cache-hash)))) )))
 
     ;; cache a list of tags in descending length order:

-    (maphash (lambda (K V) (push K tags-list)) cache-hash)
+    (maphash (lambda (K _V) (push K tags-list)) cache-hash)

     (setq tags-list (sort tags-list (lambda (A B) (< (length B) (length A)))))
 
     ;; put the tag list into the cache:
     (setq tags-list (sort tags-list (lambda (A B) (< (length B) (length A)))))
 
     ;; put the tag list into the cache:


@@ -2088,7 +2189,7 @@ DSTDIR is the output directory, where files will be written."
                   (setq cache-hash (cadr cache-entry))
                   (setq index-buf  (get-buffer-create index-file))))
         nil ;; noop
                   (setq cache-hash (cadr cache-entry))
                   (setq index-buf  (get-buffer-create index-file))))
         nil ;; noop

-      (maphash (lambda (K V) (push K tag-list)) cache-hash)
+      (maphash (lambda (K _V) (push K tag-list)) cache-hash)

       (setq tag-list (sort tag-list 'string<))
       (set-buffer index-buf)
       (erase-buffer)
       (setq tag-list (sort tag-list 'string<))
       (set-buffer index-buf)
       (erase-buffer)


@@ -2132,7 +2233,7 @@ SRCDIR and DSTDIR are the source and output directories respectively."
           (cache-entry  (assoc srcdir hfy-tags-cache)))
       (if (and cache-entry (setq cache-hash (cadr cache-entry)))
           (maphash
           (cache-entry  (assoc srcdir hfy-tags-cache)))
       (if (and cache-entry (setq cache-hash (cadr cache-entry)))
           (maphash

-           (lambda (K V)
+           (lambda (K _V)

              (let ((stub (upcase (substring K 0 1))))
                (if (member stub stub-list)
                    nil ;; seen this already: NOOP
              (let ((stub (upcase (substring K 0 1))))
                (if (member stub stub-list)
                    nil ;; seen this already: NOOP


@@ -2165,7 +2266,7 @@ See also `hfy-prepare-index', `hfy-split-index'."
 
       (if (and cache-entry (setq cache-hash (cadr cache-entry)))
           (maphash
 
       (if (and cache-entry (setq cache-hash (cadr cache-entry)))
           (maphash

-           (lambda (K V)
+           (lambda (K _V)

              (let ((stub (upcase (substring K 0 1))))
                (if (member stub stub-list)
                    nil ;; seen this already: NOOP
              (let ((stub (upcase (substring K 0 1))))
                (if (member stub stub-list)
                    nil ;; seen this already: NOOP


@@ -2311,7 +2412,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'."
 
 \f
 ;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file)
 
 \f
 ;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file)

-;;;;;;  "hfy-cmap" "hfy-cmap.el" "8dce008297f15826cc6ab82203c46fa6")
+;;;;;;  "hfy-cmap" "hfy-cmap.el" "3f97eeabe72027099da579f6ef9ae0bd")

 ;;; Generated autoloads from hfy-cmap.el
 
 (autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\
 ;;; Generated autoloads from hfy-cmap.el
 
 (autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\