#!/bin/sh

if test $# -ne 3; then
  echo "Usage:"
  echo "htmlfontify -mode <modename> file"
  exit 1
fi

if test $1 = "-mode"; then
  LANGUAGE=$2
  INFILE=$3
elif test $2 = "-mode"; then
  INFILE=$1
  LANGUAGE=$3
else
  echo "Usage:"
  echo "htmlfontify -mode <modename> file"
  exit 1
fi

TMPDIR=
trap 'rm -rf $TMPDIR; exit' 0 1 2 3 15
TMPDIR=$(mktemp -d)
cat > $TMPDIR/hfy-cmap.el << "EOF"
;; hfy-cmap.el  - fallback colour name -> rgb mapping for `htmlfontify'

;; Emacs Lisp Archive Entry
;; Package: htmlfontify
;; Filename: hfy-cmap.el
;; Version: 0.20
;; Keywords: colour, rgb
;; Author: Vivek Dasmohapatra <vivek@etla.org>
;; Maintainer: Vivek Dasmohapatra <vivek@etla.org>
;; Created: 2002-01-20
;; Description: fallback code for colour name -> rgb mapping 
;; URL: http://rtfm.etla.org/emacs/htmlfontify/
;; Last-Updated: Sat 2003-02-15 03:49:32 +0000

;;  This program is distributed in the hope that it will be useful,
;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;  GNU General Public License for more details.

;;  You should have received a copy of the GNU General Public License
;;  along with this program; if not, write to the Free Software
;;  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

;;  Copyright (C) 2002,2003 Vivek Dasmohapatra <vivek@etla.org>

;;  This program is free software; you can redistribute it and/or modify
;;  it under the terms of the GNU General Public License as published by
;;  the Free Software Foundation; either version 2 of the License, or
;;  (at your option) any later version.

(defconst hfy-fallback-colour-map
  '(("snow"                    65535 64250 64250)
    ("ghost white"             63736 63736 65535)
    ("GhostWhite"              63736 63736 65535)
    ("white smoke"             62965 62965 62965)
    ("WhiteSmoke"              62965 62965 62965)
    ("gainsboro"               56540 56540 56540)
    ("floral white"            65535 64250 61680)
    ("FloralWhite"             65535 64250 61680)
    ("old lace"                65021 62965 59110)
    ("OldLace"                 65021 62965 59110)
    ("linen"                   64250 61680 59110)
    ("antique white"           64250 60395 55255)
    ("AntiqueWhite"            64250 60395 55255)
    ("papaya whip"             65535 61423 54741)
    ("PapayaWhip"              65535 61423 54741)
    ("blanched almond"         65535 60395 52685)
    ("BlanchedAlmond"          65535 60395 52685)
    ("bisque"                  65535 58596 50372)
    ("peach puff"              65535 56026 47545)
    ("PeachPuff"               65535 56026 47545)
    ("navajo white"            65535 57054 44461)
    ("NavajoWhite"             65535 57054 44461)
    ("moccasin"                65535 58596 46517)
    ("cornsilk"                65535 63736 56540)
    ("ivory"                   65535 65535 61680)
    ("lemon chiffon"           65535 64250 52685)
    ("LemonChiffon"            65535 64250 52685)
    ("seashell"                65535 62965 61166)
    ("honeydew"                61680 65535 61680)
    ("mint cream"              62965 65535 64250)
    ("MintCream"               62965 65535 64250)
    ("azure"                   61680 65535 65535)
    ("alice blue"              61680 63736 65535)
    ("AliceBlue"               61680 63736 65535)
    ("lavender"                59110 59110 64250)
    ("lavender blush"          65535 61680 62965)
    ("LavenderBlush"           65535 61680 62965)
    ("misty rose"              65535 58596 57825)
    ("MistyRose"               65535 58596 57825)
    ("white"                   65535 65535 65535)
    ("black"                       0     0     0)
    ("dark slate gray"         12079 20303 20303)
    ("DarkSlateGray"           12079 20303 20303)
    ("dark slate grey"         12079 20303 20303)
    ("DarkSlateGrey"           12079 20303 20303)
    ("dim gray"                26985 26985 26985)
    ("DimGray"                 26985 26985 26985)
    ("dim grey"                26985 26985 26985)
    ("DimGrey"                 26985 26985 26985)
    ("slate gray"              28784 32896 37008)
    ("SlateGray"               28784 32896 37008)
    ("slate grey"              28784 32896 37008)
    ("SlateGrey"               28784 32896 37008)
    ("light slate gray"        30583 34952 39321)
    ("LightSlateGray"          30583 34952 39321)
    ("light slate grey"        30583 34952 39321)
    ("LightSlateGrey"          30583 34952 39321)
    ("gray"                    48830 48830 48830)
    ("grey"                    48830 48830 48830)
    ("light grey"              54227 54227 54227)
    ("LightGrey"               54227 54227 54227)
    ("light gray"              54227 54227 54227)
    ("LightGray"               54227 54227 54227)
    ("midnight blue"            6425  6425 28784)
    ("MidnightBlue"             6425  6425 28784)
    ("navy"                        0     0 32896)
    ("navy blue"                   0     0 32896)
    ("NavyBlue"                    0     0 32896)
    ("cornflower blue"         25700 38293 60909)
    ("CornflowerBlue"          25700 38293 60909)
    ("dark slate blue"         18504 15677 35723)
    ("DarkSlateBlue"           18504 15677 35723)
    ("slate blue"              27242 23130 52685)
    ("SlateBlue"               27242 23130 52685)
    ("medium slate blue"       31611 26728 61166)
    ("MediumSlateBlue"         31611 26728 61166)
    ("light slate blue"        33924 28784 65535)
    ("LightSlateBlue"          33924 28784 65535)
    ("medium blue"                 0     0 52685)
    ("MediumBlue"                  0     0 52685)
    ("royal blue"              16705 26985 57825)
    ("RoyalBlue"               16705 26985 57825)
    ("blue"                        0     0 65535)
    ("dodger blue"              7710 37008 65535)
    ("DodgerBlue"               7710 37008 65535)
    ("deep sky blue"               0 49087 65535)
    ("DeepSkyBlue"                 0 49087 65535)
    ("sky blue"                34695 52942 60395)
    ("SkyBlue"                 34695 52942 60395)
    ("light sky blue"          34695 52942 64250)
    ("LightSkyBlue"            34695 52942 64250)
    ("steel blue"              17990 33410 46260)
    ("SteelBlue"               17990 33410 46260)
    ("light steel blue"        45232 50372 57054)
    ("LightSteelBlue"          45232 50372 57054)
    ("light blue"              44461 55512 59110)
    ("LightBlue"               44461 55512 59110)
    ("powder blue"             45232 57568 59110)
    ("PowderBlue"              45232 57568 59110)
    ("pale turquoise"          44975 61166 61166)
    ("PaleTurquoise"           44975 61166 61166)
    ("dark turquoise"              0 52942 53713)
    ("DarkTurquoise"               0 52942 53713)
    ("medium turquoise"        18504 53713 52428)
    ("MediumTurquoise"         18504 53713 52428)
    ("turquoise"               16448 57568 53456)
    ("cyan"                        0 65535 65535)
    ("light cyan"              57568 65535 65535)
    ("LightCyan"               57568 65535 65535)
    ("cadet blue"              24415 40606 41120)
    ("CadetBlue"               24415 40606 41120)
    ("medium aquamarine"       26214 52685 43690)
    ("MediumAquamarine"        26214 52685 43690)
    ("aquamarine"              32639 65535 54484)
    ("dark green"                  0 25700     0)
    ("DarkGreen"                   0 25700     0)
    ("dark olive green"        21845 27499 12079)
    ("DarkOliveGreen"          21845 27499 12079)
    ("dark sea green"          36751 48316 36751)
    ("DarkSeaGreen"            36751 48316 36751)
    ("sea green"               11822 35723 22359)
    ("SeaGreen"                11822 35723 22359)
    ("medium sea green"        15420 46003 29041)
    ("MediumSeaGreen"          15420 46003 29041)
    ("light sea green"          8224 45746 43690)
    ("LightSeaGreen"            8224 45746 43690)
    ("pale green"              39064 64507 39064)
    ("PaleGreen"               39064 64507 39064)
    ("spring green"                0 65535 32639)
    ("SpringGreen"                 0 65535 32639)
    ("lawn green"              31868 64764     0)
    ("LawnGreen"               31868 64764     0)
    ("green"                       0 65535     0)
    ("chartreuse"              32639 65535     0)
    ("medium spring green"         0 64250 39578)
    ("MediumSpringGreen"           0 64250 39578)
    ("green yellow"            44461 65535 12079)
    ("GreenYellow"             44461 65535 12079)
    ("lime green"              12850 52685 12850)
    ("LimeGreen"               12850 52685 12850)
    ("yellow green"            39578 52685 12850)
    ("YellowGreen"             39578 52685 12850)
    ("forest green"             8738 35723  8738)
    ("ForestGreen"              8738 35723  8738)
    ("olive drab"              27499 36494  8995)
    ("OliveDrab"               27499 36494  8995)
    ("dark khaki"              48573 47031 27499)
    ("DarkKhaki"               48573 47031 27499)
    ("khaki"                   61680 59110 35980)
    ("pale goldenrod"          61166 59624 43690)
    ("PaleGoldenrod"           61166 59624 43690)
    ("light goldenrod yellow"  64250 64250 53970)
    ("LightGoldenrodYellow"    64250 64250 53970)
    ("light yellow"            65535 65535 57568)
    ("LightYellow"             65535 65535 57568)
    ("yellow"                  65535 65535     0)
    ("gold"                    65535 55255     0)
    ("light goldenrod"         61166 56797 33410)
    ("LightGoldenrod"          61166 56797 33410)
    ("goldenrod"               56026 42405  8224)
    ("dark goldenrod"          47288 34438  2827)
    ("DarkGoldenrod"           47288 34438  2827)
    ("rosy brown"              48316 36751 36751)
    ("RosyBrown"               48316 36751 36751)
    ("indian red"              52685 23644 23644)
    ("IndianRed"               52685 23644 23644)
    ("saddle brown"            35723 17733  4883)
    ("SaddleBrown"             35723 17733  4883)
    ("sienna"                  41120 21074 11565)
    ("peru"                    52685 34181 16191)
    ("burlywood"               57054 47288 34695)
    ("beige"                   62965 62965 56540)
    ("wheat"                   62965 57054 46003)
    ("sandy brown"             62708 42148 24672)
    ("SandyBrown"              62708 42148 24672)
    ("tan"                     53970 46260 35980)
    ("chocolate"               53970 26985  7710)
    ("firebrick"               45746  8738  8738)
    ("brown"                   42405 10794 10794)
    ("dark salmon"             59881 38550 31354)
    ("DarkSalmon"              59881 38550 31354)
    ("salmon"                  64250 32896 29298)
    ("light salmon"            65535 41120 31354)
    ("LightSalmon"             65535 41120 31354)
    ("orange"                  65535 42405     0)
    ("dark orange"             65535 35980     0)
    ("DarkOrange"              65535 35980     0)
    ("coral"                   65535 32639 20560)
    ("light coral"             61680 32896 32896)
    ("LightCoral"              61680 32896 32896)
    ("tomato"                  65535 25443 18247)
    ("orange red"              65535 17733     0)
    ("OrangeRed"               65535 17733     0)
    ("red"                     65535     0     0)
    ("hot pink"                65535 26985 46260)
    ("HotPink"                 65535 26985 46260)
    ("deep pink"               65535  5140 37779)
    ("DeepPink"                65535  5140 37779)
    ("pink"                    65535 49344 52171)
    ("light pink"              65535 46774 49601)
    ("LightPink"               65535 46774 49601)
    ("pale violet red"         56283 28784 37779)
    ("PaleVioletRed"           56283 28784 37779)
    ("maroon"                  45232 12336 24672)
    ("medium violet red"       51143  5397 34181)
    ("MediumVioletRed"         51143  5397 34181)
    ("violet red"              53456  8224 37008)
    ("VioletRed"               53456  8224 37008)
    ("magenta"                 65535     0 65535)
    ("violet"                  61166 33410 61166)
    ("plum"                    56797 41120 56797)
    ("orchid"                  56026 28784 54998)
    ("medium orchid"           47802 21845 54227)
    ("MediumOrchid"            47802 21845 54227)
    ("dark orchid"             39321 12850 52428)
    ("DarkOrchid"              39321 12850 52428)
    ("dark violet"             38036     0 54227)
    ("DarkViolet"              38036     0 54227)
    ("blue violet"             35466 11051 58082)
    ("BlueViolet"              35466 11051 58082)
    ("purple"                  41120  8224 61680)
    ("medium purple"           37779 28784 56283)
    ("MediumPurple"            37779 28784 56283)
    ("thistle"                 55512 49087 55512)
    ("snow1"                   65535 64250 64250)
    ("snow2"                   61166 59881 59881)
    ("snow3"                   52685 51657 51657)
    ("snow4"                   35723 35209 35209)
    ("seashell1"               65535 62965 61166)
    ("seashell2"               61166 58853 57054)
    ("seashell3"               52685 50629 49087)
    ("seashell4"               35723 34438 33410)
    ("AntiqueWhite1"           65535 61423 56283)
    ("AntiqueWhite2"           61166 57311 52428)
    ("AntiqueWhite3"           52685 49344 45232)
    ("AntiqueWhite4"           35723 33667 30840)
    ("bisque1"                 65535 58596 50372)
    ("bisque2"                 61166 54741 47031)
    ("bisque3"                 52685 47031 40606)
    ("bisque4"                 35723 32125 27499)
    ("PeachPuff1"              65535 56026 47545)
    ("PeachPuff2"              61166 52171 44461)
    ("PeachPuff3"              52685 44975 38293)
    ("PeachPuff4"              35723 30583 25957)
    ("NavajoWhite1"            65535 57054 44461)
    ("NavajoWhite2"            61166 53199 41377)
    ("NavajoWhite3"            52685 46003 35723)
    ("NavajoWhite4"            35723 31097 24158)
    ("LemonChiffon1"           65535 64250 52685)
    ("LemonChiffon2"           61166 59881 49087)
    ("LemonChiffon3"           52685 51657 42405)
    ("LemonChiffon4"           35723 35209 28784)
    ("cornsilk1"               65535 63736 56540)
    ("cornsilk2"               61166 59624 52685)
    ("cornsilk3"               52685 51400 45489)
    ("cornsilk4"               35723 34952 30840)
    ("ivory1"                  65535 65535 61680)
    ("ivory2"                  61166 61166 57568)
    ("ivory3"                  52685 52685 49601)
    ("ivory4"                  35723 35723 33667)
    ("honeydew1"               61680 65535 61680)
    ("honeydew2"               57568 61166 57568)
    ("honeydew3"               49601 52685 49601)
    ("honeydew4"               33667 35723 33667)
    ("LavenderBlush1"          65535 61680 62965)
    ("LavenderBlush2"          61166 57568 58853)
    ("LavenderBlush3"          52685 49601 50629)
    ("LavenderBlush4"          35723 33667 34438)
    ("MistyRose1"              65535 58596 57825)
    ("MistyRose2"              61166 54741 53970)
    ("MistyRose3"              52685 47031 46517)
    ("MistyRose4"              35723 32125 31611)
    ("azure1"                  61680 65535 65535)
    ("azure2"                  57568 61166 61166)
    ("azure3"                  49601 52685 52685)
    ("azure4"                  33667 35723 35723)
    ("SlateBlue1"              33667 28527 65535)
    ("SlateBlue2"              31354 26471 61166)
    ("SlateBlue3"              26985 22873 52685)
    ("SlateBlue4"              18247 15420 35723)
    ("RoyalBlue1"              18504 30326 65535)
    ("RoyalBlue2"              17219 28270 61166)
    ("RoyalBlue3"              14906 24415 52685)
    ("RoyalBlue4"              10023 16448 35723)
    ("blue1"                       0     0 65535)
    ("blue2"                       0     0 61166)
    ("blue3"                       0     0 52685)
    ("blue4"                       0     0 35723)
    ("DodgerBlue1"              7710 37008 65535)
    ("DodgerBlue2"              7196 34438 61166)
    ("DodgerBlue3"              6168 29812 52685)
    ("DodgerBlue4"              4112 20046 35723)
    ("SteelBlue1"              25443 47288 65535)
    ("SteelBlue2"              23644 44204 61166)
    ("SteelBlue3"              20303 38036 52685)
    ("SteelBlue4"              13878 25700 35723)
    ("DeepSkyBlue1"                0 49087 65535)
    ("DeepSkyBlue2"                0 45746 61166)
    ("DeepSkyBlue3"                0 39578 52685)
    ("DeepSkyBlue4"                0 26728 35723)
    ("SkyBlue1"                34695 52942 65535)
    ("SkyBlue2"                32382 49344 61166)
    ("SkyBlue3"                27756 42662 52685)
    ("SkyBlue4"                19018 28784 35723)
    ("LightSkyBlue1"           45232 58082 65535)
    ("LightSkyBlue2"           42148 54227 61166)
    ("LightSkyBlue3"           36237 46774 52685)
    ("LightSkyBlue4"           24672 31611 35723)
    ("SlateGray1"              50886 58082 65535)
    ("SlateGray2"              47545 54227 61166)
    ("SlateGray3"              40863 46774 52685)
    ("SlateGray4"              27756 31611 35723)
    ("LightSteelBlue1"         51914 57825 65535)
    ("LightSteelBlue2"         48316 53970 61166)
    ("LightSteelBlue3"         41634 46517 52685)
    ("LightSteelBlue4"         28270 31611 35723)
    ("LightBlue1"              49087 61423 65535)
    ("LightBlue2"              45746 57311 61166)
    ("LightBlue3"              39578 49344 52685)
    ("LightBlue4"              26728 33667 35723)
    ("LightCyan1"              57568 65535 65535)
    ("LightCyan2"              53713 61166 61166)
    ("LightCyan3"              46260 52685 52685)
    ("LightCyan4"              31354 35723 35723)
    ("PaleTurquoise1"          48059 65535 65535)
    ("PaleTurquoise2"          44718 61166 61166)
    ("PaleTurquoise3"          38550 52685 52685)
    ("PaleTurquoise4"          26214 35723 35723)
    ("CadetBlue1"              39064 62965 65535)
    ("CadetBlue2"              36494 58853 61166)
    ("CadetBlue3"              31354 50629 52685)
    ("CadetBlue4"              21331 34438 35723)
    ("turquoise1"                  0 62965 65535)
    ("turquoise2"                  0 58853 61166)
    ("turquoise3"                  0 50629 52685)
    ("turquoise4"                  0 34438 35723)
    ("cyan1"                       0 65535 65535)
    ("cyan2"                       0 61166 61166)
    ("cyan3"                       0 52685 52685)
    ("cyan4"                       0 35723 35723)
    ("DarkSlateGray1"          38807 65535 65535)
    ("DarkSlateGray2"          36237 61166 61166)
    ("DarkSlateGray3"          31097 52685 52685)
    ("DarkSlateGray4"          21074 35723 35723)
    ("aquamarine1"             32639 65535 54484)
    ("aquamarine2"             30326 61166 50886)
    ("aquamarine3"             26214 52685 43690)
    ("aquamarine4"             17733 35723 29812)
    ("DarkSeaGreen1"           49601 65535 49601)
    ("DarkSeaGreen2"           46260 61166 46260)
    ("DarkSeaGreen3"           39835 52685 39835)
    ("DarkSeaGreen4"           26985 35723 26985)
    ("SeaGreen1"               21588 65535 40863)
    ("SeaGreen2"               20046 61166 38036)
    ("SeaGreen3"               17219 52685 32896)
    ("SeaGreen4"               11822 35723 22359)
    ("PaleGreen1"              39578 65535 39578)
    ("PaleGreen2"              37008 61166 37008)
    ("PaleGreen3"              31868 52685 31868)
    ("PaleGreen4"              21588 35723 21588)
    ("SpringGreen1"                0 65535 32639)
    ("SpringGreen2"                0 61166 30326)
    ("SpringGreen3"                0 52685 26214)
    ("SpringGreen4"                0 35723 17733)
    ("green1"                      0 65535     0)
    ("green2"                      0 61166     0)
    ("green3"                      0 52685     0)
    ("green4"                      0 35723     0)
    ("chartreuse1"             32639 65535     0)
    ("chartreuse2"             30326 61166     0)
    ("chartreuse3"             26214 52685     0)
    ("chartreuse4"             17733 35723     0)
    ("OliveDrab1"              49344 65535 15934)
    ("OliveDrab2"              46003 61166 14906)
    ("OliveDrab3"              39578 52685 12850)
    ("OliveDrab4"              26985 35723  8738)
    ("DarkOliveGreen1"         51914 65535 28784)
    ("DarkOliveGreen2"         48316 61166 26728)
    ("DarkOliveGreen3"         41634 52685 23130)
    ("DarkOliveGreen4"         28270 35723 15677)
    ("khaki1"                  65535 63222 36751)
    ("khaki2"                  61166 59110 34181)
    ("khaki3"                  52685 50886 29555)
    ("khaki4"                  35723 34438 20046)
    ("LightGoldenrod1"         65535 60652 35723)
    ("LightGoldenrod2"         61166 56540 33410)
    ("LightGoldenrod3"         52685 48830 28784)
    ("LightGoldenrod4"         35723 33153 19532)
    ("LightYellow1"            65535 65535 57568)
    ("LightYellow2"            61166 61166 53713)
    ("LightYellow3"            52685 52685 46260)
    ("LightYellow4"            35723 35723 31354)
    ("yellow1"                 65535 65535     0)
    ("yellow2"                 61166 61166     0)
    ("yellow3"                 52685 52685     0)
    ("yellow4"                 35723 35723     0)
    ("gold1"                   65535 55255     0)
    ("gold2"                   61166 51657     0)
    ("gold3"                   52685 44461     0)
    ("gold4"                   35723 30069     0)
    ("goldenrod1"              65535 49601  9509)
    ("goldenrod2"              61166 46260  8738)
    ("goldenrod3"              52685 39835  7453)
    ("goldenrod4"              35723 26985  5140)
    ("DarkGoldenrod1"          65535 47545  3855)
    ("DarkGoldenrod2"          61166 44461  3598)
    ("DarkGoldenrod3"          52685 38293  3084)
    ("DarkGoldenrod4"          35723 25957  2056)
    ("RosyBrown1"              65535 49601 49601)
    ("RosyBrown2"              61166 46260 46260)
    ("RosyBrown3"              52685 39835 39835)
    ("RosyBrown4"              35723 26985 26985)
    ("IndianRed1"              65535 27242 27242)
    ("IndianRed2"              61166 25443 25443)
    ("IndianRed3"              52685 21845 21845)
    ("IndianRed4"              35723 14906 14906)
    ("sienna1"                 65535 33410 18247)
    ("sienna2"                 61166 31097 16962)
    ("sienna3"                 52685 26728 14649)
    ("sienna4"                 35723 18247  9766)
    ("burlywood1"              65535 54227 39835)
    ("burlywood2"              61166 50629 37265)
    ("burlywood3"              52685 43690 32125)
    ("burlywood4"              35723 29555 21845)
    ("wheat1"                  65535 59367 47802)
    ("wheat2"                  61166 55512 44718)
    ("wheat3"                  52685 47802 38550)
    ("wheat4"                  35723 32382 26214)
    ("tan1"                    65535 42405 20303)
    ("tan2"                    61166 39578 18761)
    ("tan3"                    52685 34181 16191)
    ("tan4"                    35723 23130 11051)
    ("chocolate1"              65535 32639  9252)
    ("chocolate2"              61166 30326  8481)
    ("chocolate3"              52685 26214  7453)
    ("chocolate4"              35723 17733  4883)
    ("firebrick1"              65535 12336 12336)
    ("firebrick2"              61166 11308 11308)
    ("firebrick3"              52685  9766  9766)
    ("firebrick4"              35723  6682  6682)
    ("brown1"                  65535 16448 16448)
    ("brown2"                  61166 15163 15163)
    ("brown3"                  52685 13107 13107)
    ("brown4"                  35723  8995  8995)
    ("salmon1"                 65535 35980 26985)
    ("salmon2"                 61166 33410 25186)
    ("salmon3"                 52685 28784 21588)
    ("salmon4"                 35723 19532 14649)
    ("LightSalmon1"            65535 41120 31354)
    ("LightSalmon2"            61166 38293 29298)
    ("LightSalmon3"            52685 33153 25186)
    ("LightSalmon4"            35723 22359 16962)
    ("orange1"                 65535 42405     0)
    ("orange2"                 61166 39578     0)
    ("orange3"                 52685 34181     0)
    ("orange4"                 35723 23130     0)
    ("DarkOrange1"             65535 32639     0)
    ("DarkOrange2"             61166 30326     0)
    ("DarkOrange3"             52685 26214     0)
    ("DarkOrange4"             35723 17733     0)
    ("coral1"                  65535 29298 22102)
    ("coral2"                  61166 27242 20560)
    ("coral3"                  52685 23387 17733)
    ("coral4"                  35723 15934 12079)
    ("tomato1"                 65535 25443 18247)
    ("tomato2"                 61166 23644 16962)
    ("tomato3"                 52685 20303 14649)
    ("tomato4"                 35723 13878  9766)
    ("OrangeRed1"              65535 17733     0)
    ("OrangeRed2"              61166 16448     0)
    ("OrangeRed3"              52685 14135     0)
    ("OrangeRed4"              35723  9509     0)
    ("red1"                    65535     0     0)
    ("red2"                    61166     0     0)
    ("red3"                    52685     0     0)
    ("red4"                    35723     0     0)
    ("DeepPink1"               65535  5140 37779)
    ("DeepPink2"               61166  4626 35209)
    ("DeepPink3"               52685  4112 30326)
    ("DeepPink4"               35723  2570 20560)
    ("HotPink1"                65535 28270 46260)
    ("HotPink2"                61166 27242 42919)
    ("HotPink3"                52685 24672 37008)
    ("HotPink4"                35723 14906 25186)
    ("pink1"                   65535 46517 50629)
    ("pink2"                   61166 43433 47288)
    ("pink3"                   52685 37265 40606)
    ("pink4"                   35723 25443 27756)
    ("LightPink1"              65535 44718 47545)
    ("LightPink2"              61166 41634 44461)
    ("LightPink3"              52685 35980 38293)
    ("LightPink4"              35723 24415 25957)
    ("PaleVioletRed1"          65535 33410 43947)
    ("PaleVioletRed2"          61166 31097 40863)
    ("PaleVioletRed3"          52685 26728 35209)
    ("PaleVioletRed4"          35723 18247 23901)
    ("maroon1"                 65535 13364 46003)
    ("maroon2"                 61166 12336 42919)
    ("maroon3"                 52685 10537 37008)
    ("maroon4"                 35723  7196 25186)
    ("VioletRed1"              65535 15934 38550)
    ("VioletRed2"              61166 14906 35980)
    ("VioletRed3"              52685 12850 30840)
    ("VioletRed4"              35723  8738 21074)
    ("magenta1"                65535     0 65535)
    ("magenta2"                61166     0 61166)
    ("magenta3"                52685     0 52685)
    ("magenta4"                35723     0 35723)
    ("orchid1"                 65535 33667 64250)
    ("orchid2"                 61166 31354 59881)
    ("orchid3"                 52685 26985 51657)
    ("orchid4"                 35723 18247 35209)
    ("plum1"                   65535 48059 65535)
    ("plum2"                   61166 44718 61166)
    ("plum3"                   52685 38550 52685)
    ("plum4"                   35723 26214 35723)
    ("MediumOrchid1"           57568 26214 65535)
    ("MediumOrchid2"           53713 24415 61166)
    ("MediumOrchid3"           46260 21074 52685)
    ("MediumOrchid4"           31354 14135 35723)
    ("DarkOrchid1"             49087 15934 65535)
    ("DarkOrchid2"             45746 14906 61166)
    ("DarkOrchid3"             39578 12850 52685)
    ("DarkOrchid4"             26728  8738 35723)
    ("purple1"                 39835 12336 65535)
    ("purple2"                 37265 11308 61166)
    ("purple3"                 32125  9766 52685)
    ("purple4"                 21845  6682 35723)
    ("MediumPurple1"           43947 33410 65535)
    ("MediumPurple2"           40863 31097 61166)
    ("MediumPurple3"           35209 26728 52685)
    ("MediumPurple4"           23901 18247 35723)
    ("thistle1"                65535 57825 65535)
    ("thistle2"                61166 53970 61166)
    ("thistle3"                52685 46517 52685)
    ("thistle4"                35723 31611 35723)
    ("gray0"                       0     0     0)
    ("grey0"                       0     0     0)
    ("gray1"                     771   771   771)
    ("grey1"                     771   771   771)
    ("gray2"                    1285  1285  1285)
    ("grey2"                    1285  1285  1285)
    ("gray3"                    2056  2056  2056)
    ("grey3"                    2056  2056  2056)
    ("gray4"                    2570  2570  2570)
    ("grey4"                    2570  2570  2570)
    ("gray5"                    3341  3341  3341)
    ("grey5"                    3341  3341  3341)
    ("gray6"                    3855  3855  3855)
    ("grey6"                    3855  3855  3855)
    ("gray7"                    4626  4626  4626)
    ("grey7"                    4626  4626  4626)
    ("gray8"                    5140  5140  5140)
    ("grey8"                    5140  5140  5140)
    ("gray9"                    5911  5911  5911)
    ("grey9"                    5911  5911  5911)
    ("gray10"                   6682  6682  6682)
    ("grey10"                   6682  6682  6682)
    ("gray11"                   7196  7196  7196)
    ("grey11"                   7196  7196  7196)
    ("gray12"                   7967  7967  7967)
    ("grey12"                   7967  7967  7967)
    ("gray13"                   8481  8481  8481)
    ("grey13"                   8481  8481  8481)
    ("gray14"                   9252  9252  9252)
    ("grey14"                   9252  9252  9252)
    ("gray15"                   9766  9766  9766)
    ("grey15"                   9766  9766  9766)
    ("gray16"                  10537 10537 10537)
    ("grey16"                  10537 10537 10537)
    ("gray17"                  11051 11051 11051)
    ("grey17"                  11051 11051 11051)
    ("gray18"                  11822 11822 11822)
    ("grey18"                  11822 11822 11822)
    ("gray19"                  12336 12336 12336)
    ("grey19"                  12336 12336 12336)
    ("gray20"                  13107 13107 13107)
    ("grey20"                  13107 13107 13107)
    ("gray21"                  13878 13878 13878)
    ("grey21"                  13878 13878 13878)
    ("gray22"                  14392 14392 14392)
    ("grey22"                  14392 14392 14392)
    ("gray23"                  15163 15163 15163)
    ("grey23"                  15163 15163 15163)
    ("gray24"                  15677 15677 15677)
    ("grey24"                  15677 15677 15677)
    ("gray25"                  16448 16448 16448)
    ("grey25"                  16448 16448 16448)
    ("gray26"                  16962 16962 16962)
    ("grey26"                  16962 16962 16962)
    ("gray27"                  17733 17733 17733)
    ("grey27"                  17733 17733 17733)
    ("gray28"                  18247 18247 18247)
    ("grey28"                  18247 18247 18247)
    ("gray29"                  19018 19018 19018)
    ("grey29"                  19018 19018 19018)
    ("gray30"                  19789 19789 19789)
    ("grey30"                  19789 19789 19789)
    ("gray31"                  20303 20303 20303)
    ("grey31"                  20303 20303 20303)
    ("gray32"                  21074 21074 21074)
    ("grey32"                  21074 21074 21074)
    ("gray33"                  21588 21588 21588)
    ("grey33"                  21588 21588 21588)
    ("gray34"                  22359 22359 22359)
    ("grey34"                  22359 22359 22359)
    ("gray35"                  22873 22873 22873)
    ("grey35"                  22873 22873 22873)
    ("gray36"                  23644 23644 23644)
    ("grey36"                  23644 23644 23644)
    ("gray37"                  24158 24158 24158)
    ("grey37"                  24158 24158 24158)
    ("gray38"                  24929 24929 24929)
    ("grey38"                  24929 24929 24929)
    ("gray39"                  25443 25443 25443)
    ("grey39"                  25443 25443 25443)
    ("gray40"                  26214 26214 26214)
    ("grey40"                  26214 26214 26214)
    ("gray41"                  26985 26985 26985)
    ("grey41"                  26985 26985 26985)
    ("gray42"                  27499 27499 27499)
    ("grey42"                  27499 27499 27499)
    ("gray43"                  28270 28270 28270)
    ("grey43"                  28270 28270 28270)
    ("gray44"                  28784 28784 28784)
    ("grey44"                  28784 28784 28784)
    ("gray45"                  29555 29555 29555)
    ("grey45"                  29555 29555 29555)
    ("gray46"                  30069 30069 30069)
    ("grey46"                  30069 30069 30069)
    ("gray47"                  30840 30840 30840)
    ("grey47"                  30840 30840 30840)
    ("gray48"                  31354 31354 31354)
    ("grey48"                  31354 31354 31354)
    ("gray49"                  32125 32125 32125)
    ("grey49"                  32125 32125 32125)
    ("gray50"                  32639 32639 32639)
    ("grey50"                  32639 32639 32639)
    ("gray51"                  33410 33410 33410)
    ("grey51"                  33410 33410 33410)
    ("gray52"                  34181 34181 34181)
    ("grey52"                  34181 34181 34181)
    ("gray53"                  34695 34695 34695)
    ("grey53"                  34695 34695 34695)
    ("gray54"                  35466 35466 35466)
    ("grey54"                  35466 35466 35466)
    ("gray55"                  35980 35980 35980)
    ("grey55"                  35980 35980 35980)
    ("gray56"                  36751 36751 36751)
    ("grey56"                  36751 36751 36751)
    ("gray57"                  37265 37265 37265)
    ("grey57"                  37265 37265 37265)
    ("gray58"                  38036 38036 38036)
    ("grey58"                  38036 38036 38036)
    ("gray59"                  38550 38550 38550)
    ("grey59"                  38550 38550 38550)
    ("gray60"                  39321 39321 39321)
    ("grey60"                  39321 39321 39321)
    ("gray61"                  40092 40092 40092)
    ("grey61"                  40092 40092 40092)
    ("gray62"                  40606 40606 40606)
    ("grey62"                  40606 40606 40606)
    ("gray63"                  41377 41377 41377)
    ("grey63"                  41377 41377 41377)
    ("gray64"                  41891 41891 41891)
    ("grey64"                  41891 41891 41891)
    ("gray65"                  42662 42662 42662)
    ("grey65"                  42662 42662 42662)
    ("gray66"                  43176 43176 43176)
    ("grey66"                  43176 43176 43176)
    ("gray67"                  43947 43947 43947)
    ("grey67"                  43947 43947 43947)
    ("gray68"                  44461 44461 44461)
    ("grey68"                  44461 44461 44461)
    ("gray69"                  45232 45232 45232)
    ("grey69"                  45232 45232 45232)
    ("gray70"                  46003 46003 46003)
    ("grey70"                  46003 46003 46003)
    ("gray71"                  46517 46517 46517)
    ("grey71"                  46517 46517 46517)
    ("gray72"                  47288 47288 47288)
    ("grey72"                  47288 47288 47288)
    ("gray73"                  47802 47802 47802)
    ("grey73"                  47802 47802 47802)
    ("gray74"                  48573 48573 48573)
    ("grey74"                  48573 48573 48573)
    ("gray75"                  49087 49087 49087)
    ("grey75"                  49087 49087 49087)
    ("gray76"                  49858 49858 49858)
    ("grey76"                  49858 49858 49858)
    ("gray77"                  50372 50372 50372)
    ("grey77"                  50372 50372 50372)
    ("gray78"                  51143 51143 51143)
    ("grey78"                  51143 51143 51143)
    ("gray79"                  51657 51657 51657)
    ("grey79"                  51657 51657 51657)
    ("gray80"                  52428 52428 52428)
    ("grey80"                  52428 52428 52428)
    ("gray81"                  53199 53199 53199)
    ("grey81"                  53199 53199 53199)
    ("gray82"                  53713 53713 53713)
    ("grey82"                  53713 53713 53713)
    ("gray83"                  54484 54484 54484)
    ("grey83"                  54484 54484 54484)
    ("gray84"                  54998 54998 54998)
    ("grey84"                  54998 54998 54998)
    ("gray85"                  55769 55769 55769)
    ("grey85"                  55769 55769 55769)
    ("gray86"                  56283 56283 56283)
    ("grey86"                  56283 56283 56283)
    ("gray87"                  57054 57054 57054)
    ("grey87"                  57054 57054 57054)
    ("gray88"                  57568 57568 57568)
    ("grey88"                  57568 57568 57568)
    ("gray89"                  58339 58339 58339)
    ("grey89"                  58339 58339 58339)
    ("gray90"                  58853 58853 58853)
    ("grey90"                  58853 58853 58853)
    ("gray91"                  59624 59624 59624)
    ("grey91"                  59624 59624 59624)
    ("gray92"                  60395 60395 60395)
    ("grey92"                  60395 60395 60395)
    ("gray93"                  60909 60909 60909)
    ("grey93"                  60909 60909 60909)
    ("gray94"                  61680 61680 61680)
    ("grey94"                  61680 61680 61680)
    ("gray95"                  62194 62194 62194)
    ("grey95"                  62194 62194 62194)
    ("gray96"                  62965 62965 62965)
    ("grey96"                  62965 62965 62965)
    ("gray97"                  63479 63479 63479)
    ("grey97"                  63479 63479 63479)
    ("gray98"                  64250 64250 64250)
    ("grey98"                  64250 64250 64250)
    ("gray99"                  64764 64764 64764)
    ("grey99"                  64764 64764 64764)
    ("gray100"                 65535 65535 65535)
    ("grey100"                 65535 65535 65535)
    ("dark grey"               43433 43433 43433)
    ("DarkGrey"                43433 43433 43433)
    ("dark gray"               43433 43433 43433)
    ("DarkGray"                43433 43433 43433)
    ("dark blue"                   0     0 35723)
    ("DarkBlue"                    0     0 35723)
    ("dark cyan"                   0 35723 35723)
    ("DarkCyan"                    0 35723 35723)
    ("dark magenta"            35723     0 35723)
    ("DarkMagenta"             35723     0 35723)
    ("dark red"                35723     0     0)
    ("DarkRed"                 35723     0     0)
    ("light green"             37008 61166 37008)
    ("LightGreen"              37008 61166 37008)) )

(defvar hfy-rgb-txt-colour-map nil)

(defvar hfy-rgb-load-path
  (list "/etc/X11"
	(format "/usr/share/emacs/%d.%d/etc"
		emacs-major-version
		emacs-minor-version)
	"/usr/X11R6/lib/X11"))

(defun hfy-rgb-file ()
  "Return a fully qualified path to the X11 style rgb.txt file"
  (catch 'rgb-file
    (mapcar
     (lambda (DIR)
       (let ((rgb-file (concat DIR "/rgb.txt")))
	 (if (file-readable-p rgb-file)
	     (throw 'rgb-file rgb-file) nil)) ) hfy-rgb-load-path) nil))

(defconst hfy-rgb-regex
  "^\\s-*\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+\\(.+\\)\\s-*$")

(defun htmlfontify-load-rgb-file (&optional file)
  "Load an X11 style rgb.txt file \(search `hfy-rgb-load-path' if file\n\
is not specified\).\n
Loads the variable `hfy-rgb-txt-colour-map', which is used by
`hfy-fallback-colour-values'."
  (interactive
   (list
    (read-file-name "rgb.txt \(equivalent\) file: " "" nil t (hfy-rgb-file))))
  (let ((rgb-buffer   nil)
	(end-of-rgb     0)
	(rgb-txt      nil)
	(ff         255.0))
    (if (and (setq rgb-txt (or file (hfy-rgb-file)))
	     (file-readable-p rgb-txt))
	(save-excursion
	  (setq rgb-buffer (find-file-noselect rgb-txt 'nowarn))
	  (set-buffer rgb-buffer)
	  (goto-char (point-min))
	  (htmlfontify-unload-rgb-file)
	  (while (/= end-of-rgb 1)
	    (if (looking-at hfy-rgb-regex)
		(setq hfy-rgb-txt-colour-map
		      (cons (list (match-string 4)
				  (string-to-int (match-string 1))
				  (string-to-int (match-string 2))
				  (string-to-int (match-string 3)))
			    hfy-rgb-txt-colour-map)) )
	    (setq end-of-rgb (forward-line)))
	  (kill-buffer rgb-buffer))
      )
    )
  )

(defun htmlfontify-unload-rgb-file ()
  (interactive)
  (setq hfy-rgb-txt-colour-map nil))

(defun hfy-fallback-colour-values (colour-string)
  (cdr (assoc-ignore-case colour-string (or hfy-rgb-txt-colour-map
					    hfy-fallback-colour-map))) )

(provide 'hfy-cmap)
EOF
cat > $TMPDIR/htmlfontify.el << "EOF"
;; htmlfontify.el  - htmlise a buffer/source tree with optional hyperlinks

;; Emacs Lisp Archive Entry
;; Package: htmlfontify
;; Filename: htmlfontify.el
;; Version: 0.20
;; Keywords: html, hypermedia, markup, etags
;; 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
;; URL: http://rtfm.etla.org/emacs/htmlfontify/
;; Compatibility: Emacs20, Emacs21
;; Incompatibility: Emacs19
;; Last Updated: Sun 2003-03-09 01:27:57 +0000


;;  This program is distributed in the hope that it will be useful,
;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;  GNU General Public License for more details.

;;  You should have received a copy of the GNU General Public License
;;  along with this program; if not, write to the Free Software
;;  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

;; Copyright (C) 2002,2003 Vivek Dasmohapatra <vivek@etla.org>

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.

;; Here's some elisp code to html-pretty-print an emacs buffer, preserving
;; the emacs syntax/whatever highlighting. It also knows how to drive etags
;; (exuberant-ctags or emacs etags) and hyperlink the code according
;; to its (etags') output.

;; NOTE: Currently the hyperlinking code only knows how to drive GNU find
;; and the exuberant and GNU variants of etags : I do not know of any other
;; etags variants, but mechanisms have been provided to allow htmlfontify
;; to be taught how to drive them. As long as your version of find has
;; the -path test and is reasonably sane, you should be fine.

;; A sample of the htmlfontified / hyperlinked output of this module can be
;; found at http://rtfm.etla.org/sql/dbishell/src/ - it's not perfect, but
;; it's a hell of a lot faster and more thorough than I could hope to be
;; doing this by hand.

;; some user / horrified onlooker comments:
;; What? No! There's something deeply wrong here...   (R. Shufflebotham)
;; You're a freak.                                    (D. Silverstone)
;; Aren't we giving you enough to do?                 (J. Busuttil)
;; You're almost as messed up as Lexx is!             (N. Graves-Morris)

;; Changes: moved to changelog (CHANGES) file.

;; elisp-dep-block >>
(require 'faces)
;;  (`facep' `face-attr-construct' `x-color-values' `color-values' `face-name')
;; (require 'fast-lock)
;;  (`fast-lock-mode')
(require 'custom)
;;  (`defgroup' `defcustom')
(require 'font-lock)
;;  (`font-lock-fontify-region')
;; elisp-dep-block <<

(eval-and-compile

  ;; emacs 20 compatibility:
  (if (<= 21 emacs-major-version) nil ;; already post emacs21, NOOP
    (require 'hfy-emacs20))

  ;; non-x-windows emacs20 duct tape...
  ;; admittedly, we get no significant fontification here anyway
  ;; because emacs20 can't fontify on a tty
  (if window-system nil ;; NOOP
    (defun x-color-defined-p (colour &optional frame)
      (let ((window-system nil)) (if (hfy-colour-vals colour) t nil))))

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; I want these - can't be bothered requiring all of cl though.
  (if (not (fboundp 'caddr))      
      (defun caddr (list)
	"Return the `car' of the `cddr' of LIST."
	(car (cddr list))))

  (if (not (fboundp 'cadddr))      
      (defun cadddr (list)
	"Return the `cadr' of the `cddr' of LIST."
	(cadr (cddr list))))
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (autoload
    'htmlfontify-load-rgb-file
    "hfy-cmap"
    "Load an rgb.txt file for colour name -> rgb translation purposes."
    'interactive)

  (autoload
    'htmlfontify-unload-rgb-file
    "hfy-cmap"
    "Unload the current colour name -> rgb translation map."
    'interactive)

  (autoload
    'hfy-fallback-colour-values
    "hfy-cmap"
    "Use a fallback method for obtaining the rgb values for a colour."
    'interactive)
  )

(defconst htmlfontify-version 0.20)

(defconst hfy-meta-tags
  (format "<meta name=\"generator\" content=\"emacs %s; htmlfontify %0.2f\">"
	  emacs-version htmlfontify-version)
  "generator meta tag for this version of htmlfontify")

(defconst htmlfontify-manual "Htmlfontify Manual"
  "Copy and convert buffers and files to html, adding hyperlinks between
files \(driven by etags\) if requested.\n
Interactive functions:
  `htmlfontify-buffer'
  `htmlfontify-run-etags'
  `htmlfontify-copy-and-link-dir'
  `htmlfontify-load-rgb-file'
  `htmlfontify-unload-rgb-file'\n
In order to:\n
fontify a file you have open:           M-x htmlfontify-buffer
prepare the etags map for a directory:  M-x htmlfontify-run-etags
copy a directory, fontifying as you go: M-x htmlfontify-copy-and-link-dir\n
The following might be useful when running non-windowed or in batch mode:
\(note that they shouldn't be necessary - we have a built in map\)\n
load an X11 style rgb.txt file:         M-x htmlfontify-load-rgb-file
unload the current rgb.txt file:        M-x htmlfontify-unload-rgb-file\n
And here's a programmatic example:\n
\(defun rtfm-build-page-header \(file style\)
  \(format \"#define  TEMPLATE red+black.html
#define  DEBUG    1
#include <build/menu-dirlist|>\\n
html-css-url := /css/red+black.css
title        := rtfm.etla.org \( %s / src/%s \)
bodytag      := 
head         <=STYLESHEET;\\n
%s
STYLESHEET
main-title   := rtfm / %s / src/%s\\n
main-content <=MAIN_CONTENT;\\n\" rtfm-section file style rtfm-section file\)\)

\(defun rtfm-build-page-footer \(file\) \"\\nMAIN_CONTENT\\n\"\)

\(defun rtfm-build-source-docs \(section srcdir destdir\)
  \(interactive
   \"s section[eg- emacs / p4-blame]:\\nD source-dir: \\nD output-dir: \"\)
  \(require 'htmlfontify\)
  \(hfy-load-tags-cache srcdir\)
  \(let \(\(hfy-page-header  'rtfm-build-page-header\)
	\(hfy-page-footer  'rtfm-build-page-footer\)
	\(rtfm-section                     section\)
	\(hfy-index-file                   \"index\"\)\)
    \(htmlfontify-run-etags srcdir\)
    \(htmlfontify-copy-and-link-dir srcdir destdir \".src\" \".html\"\)\)\)")

(defgroup htmlfontify nil
  "Copy and convert buffers and files to html, adding hyperlinks between
files \(driven by etags\) if requested.\n
See: `htmlfontify-manual'"
  :group  'applications
  :prefix "hfy-")

(defcustom hfy-page-header 'hfy-default-header
  "*Function 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- the string returned will
be used as the header for the htmlfontified version of the source file.\n
See also: `hfy-page-footer'"
  :group 'htmlfontify
  :tag   "page-header"
  :type  '(function))

(defcustom hfy-split-index nil
  "*Whether or not to split the index `hfy-index-file' alphabetically
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."
  :group 'htmlfontify
  :tag   "split-index"
  :type  '(boolean))

(defcustom hfy-page-footer 'hfy-default-footer
  "*As `hfy-page-header', but generates the output footer
\(and takes only 1 argument, the filename\)."
  :group 'htmlfontify
  :tag   "page-footer"
  :type  '(function))

(defcustom hfy-extn        ".html"
  "*File extension used for output files"
  :group 'htmlfontify
  :tag   "extension"
  :type  '(string))

(defcustom hfy-src-doc-link-style "text-decoration: underline;"
  "*String to add to the \'<style> a\' variant of an htmlfontify css class."
  :group 'htmlfontify
  :tag   "src-doc-link-style"
  :type  '(string))

(defcustom hfy-src-doc-link-unstyle " text-decoration: none;"
  "*Regex to remove from the <style> a variant of an htmlfontify css class."
  :group 'htmlfontify
  :tag   "src-doc-link-unstyle"
  :type  '(string))

(defcustom hfy-link-extn nil
  "*File extension used for href links - Useful where the htmlfontify
output files are going to be processed again, with a resulting change
in file extension. If `nil', then any code using this should fall back
to `hfy-extn'."
  :group 'htmlfontify
  :tag   "link-extension"
  :type  '(choice string (const nil)))

(defcustom hfy-link-style-fun 'hfy-link-style-string
  "*Set this to a function, which will be called with one argument
\(a \"{ foo: bar; ...}\" css style-string\) - it should return a copy of
its argument, altered so as to make any changes you want made for text which
is a hyperlink, in addition to being in the class to which that style would
normally be applied."
  :group 'htmlfontify
  :tag   "link-style-function"
  :type  '(function))

(defcustom hfy-index-file  "hfy-index"
  "*Name \(sans extension\) of the tag definition index file produced during
fontification-and-hyperlinking."
  :group 'htmlfontify
  :tag   "index-file"
  :type  '(string))

(defcustom hfy-instance-file  "hfy-instance"
  "*Name \(sans extension\) of the tag usage index file produced during
fontification-and-hyperlinking."
  :group 'htmlfontify
  :tag   "instance-file"
  :type  '(string))

(defcustom hfy-html-quote-regex "\\(<\\|\"\\|&\\|>\\)"
  "*Regex to match \(with a single back-reference per match\) strings in HTML
which should be quoted with `hfy-html-quote' \(and `hfy-html-quote-map'\)
to make them safe."
  :group 'htmlfontify
  :tag   "html-quote-regex"
  :type  '(regexp))

(defcustom hfy-init-kludge-hooks '(hfy-kludge-cperl-mode)
  "*List of functions to call when starting htmlfontify-buffer to do any
kludging necessary to get highlighting modes to bahave as you want, even
when not running under a window system."
  :group 'htmlfontify
  :tag   "init-kludge-hooks"
  :type  '(hook))

(defcustom hfy-post-html-hooks nil
  "*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"
  :group   'htmlfontify
  :tag     "post-html-hooks"
  :options '(set-auto-mode)
  :type    '(hook))

(defcustom hfy-default-face-def nil
  "*Fallback `defface' specification for the face \'default, used when
`hfy-display-class' has been set \(the normal htmlfontify way of extracting
potentially non-current face information doesn\'t necessarily work for
\'default\).\n
Example: I customise this to:\n
\(\(t :background \"black\" :foreground \"white\" :family \"misc-fixed\"\)\)"
  :group   'htmlfontify
  :tag     "default-face-definition"
  :type    '(alist))

(defcustom hfy-etag-regex (concat ".*"
				  "\x7f" "\\([^\x01\n]+\\)"
				  "\x01" "\\([0-9]+\\)"
				  ","    "\\([0-9]+\\)$"
				  "\\|"  ".*\x7f[0-9]+,[0-9]+$")
  "*Regex used to parse an etags entry: must have 3 subexps, corresponding,
in order, to:\n
   1 - The tag
   2 - The line
   3 - The char \(point\) at which the tag occurs."
  :group 'htmlfontify
  :tag   "etag-regex"
  :type  '(regexp))

(defcustom hfy-html-quote-map '(("\"" "&quot;")
				("<"  "&lt;"  )
				("&"  "&amp;" )
				(">"  "&gt;"  ))
  "*Alist of char -> entity mappings used to make the text html-safe."
  :group 'htmlfontify
  :tag   "html-quote-map"
  :type  '(alist :key-type (string)))

(defconst hfy-e2x-etags-cmd "for src in `find . -type f`;
do
  ETAGS=%s;
  case ${src} in
    *.ad[absm]|*.[CFHMSacfhlmpsty]|*.def|*.in[cs]|*.s[as]|*.src|*.cc|\\
    *.hh|*.[chy]++|*.[ch]pp|*.[chy]xx|*.pdb|*.[ch]s|*.[Cc][Oo][Bb]|\\
    *.[eh]rl|*.f90|*.for|*.java|*.[cem]l|*.clisp|*.lisp|*.[Ll][Ss][Pp]|\\
    [Mm]akefile*|*.pas|*.[Pp][LlMm]|*.psw|*.lm|*.pc|*.prolog|*.oak|\\
    *.p[sy]|*.sch|*.scheme|*.[Ss][Cc][Mm]|*.[Ss][Mm]|*.bib|*.cl[os]|\\
    *.ltx|*.sty|*.TeX|*.tex|*.texi|*.texinfo|*.txi|*.x[bp]m|*.yy|\\
    *.[Ss][Qq][Ll])
          ${ETAGS} -o- ${src};
          ;;
      *)
          FTYPE=`file ${src}`;
          case ${FTYPE} in
              *script*text*)
                  ${ETAGS} -o- ${src};
                  ;;
              *text*)
                  SHEBANG=`head -n1 ${src} | grep '#!' -c`;
                  if [ ${SHEBANG} -eq 1 ];
                  then
                      ${ETAGS} -o- ${src};
                  fi;
                  ;;
          esac;
          ;;
  esac;
done;")

(defcustom hfy-etags-cmd-alist
  `(("emacs etags"     . ,hfy-e2x-etags-cmd)
    ("exuberant ctags" . "%s -R -f -"   ))
  "*alist of possible shell commands that will generate etags output that
`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)) )

(defcustom hfy-etags-bin "etags"
  "*location of etags binary (we begin by assuming it\'s in your path).\n
Note that if etags is not in your path, you will need to alter the shell
commands in `hfy-etags-cmd-alist'."
  :group 'htmlfontify
  :tag   "etags-bin"
  :type  '(file))

(defcustom hfy-shell-file-name "/bin/sh"
  "*shell (bourne or compatible) to invoke for complex shell operations."
  :group 'htmlfontify
  :tag   "shell-file-name"
  :type  '(file))

(defun hfy-which-etags ()
  (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)))
  "*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
exuberant-ctags\' etags respectively."
  :group 'htmlfontify
  :tag   "etags-command"
  :type (eval-and-compile
	  (let ((clist (list '(string))))
	    (mapc
	     (lambda (C)
	       (setq clist
		     (cons (list 'const :tag (car C) (cdr C)) clist)))
	     hfy-etags-cmd-alist)
	    (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
or not. The command should emit a string containing the word \'text\' if
the file is a text file, and a string not containing \'text\' otherwise."
  :group 'htmlfontify
  :tag   "istext-command"
  :type  '(string))

(defcustom hfy-find-cmd
  "find . -type f \\! -name \\*~ \\! -name \\*.flc \\! -path \\*/CVS/\\*"
  "*find command used to harvest a list of files to attempt to fontify."
  :group 'htmlfontify
  :tag   "find-command"
  :type  '(string))

(defcustom hfy-display-class nil
  "*Display class to use to determine which display class to use when
calculating a face\'s attributes. This is useful when, for example, you
are running emacs on a tty or in batch mode, and want htmlfontify to have
access to the face spec you would use if you were connected to an X display.\n
Some valid class specification elements are:\n
  \'\(class      color\)
  \'\(class      grayscale\)
  \'\(background dark\)
  \'\(background light\)
  \'\(type       x-toolkit\)
  \'\(type       tty\)
  \'\(type       motif\)
  \'\(type       lucid\)
Multiple values for a tag may be combined, to indicate that any one or more
of these values in the specification key constitutes a match, eg:\n
\'\(\(class color grayscale\) \(type tty\)\) would match any of:\n
  \'\(\(class color\)\)
  \'\(\(class grayscale\)\)
  \'\(\(class color grayscale\)\)\)
  \'\(\(class color foo\)\)
  \'\(\(type  tty\)\)
  \'\(\(type  tty\) \(class color\)\)\n
and so on."
  :type    '(alist :key-type (symbol) :value-type (symbol))
  :group   'htmlfontify
  :tag     "display-class"
  :options '((type       (choice (const :tag "X11"           x-toolkit)
				 (const :tag "Terminal"      tty      )
				 (const :tag "Lucid Toolkit" lucid    )
				 (const :tag "Motif Toolkit" motif    )))
	     
	     (class      (choice (const :tag "Colour"        color    )
				 (const :tag "Greyscale"     grayscale)))
	     
	     (background (choice (const :tag "Dark"          dark     )
				 (const :tag "Bright"        light    ))) ))

(defcustom hfy-optimisations (list)
  "*Optimisations to turn on: So far, the following have been implemented:\n
  merge-adjacent-tags: If two (or more) span tags are adjacent, identical and
                       separated by nothing more than whitespace, they will
                       be merged into one span.
  zap-comment-links  : Suppress hyperlinking of tags found in comments.
  zap-string-links   : Suppress hyperlinking of tags found in strings.
  div-wrapper        : Add <div class=\"default\"> </div> tags around the
                       output.
  keep-overlays      : More of a bell \(or possibly whistle\) than an
                       optimisation - If on, preserve overlay highlighting
                       \(cf ediff or goo-font-lock\) as well as basic faces\n
  And the following are planned but not yet available:\n
  kill-context-leak  : Suppress hyperlinking between files highlighted by
                       different modes.\n
Note: like compiler optimisations, these optimise the _output_ of the code,
not the processing of the source itself, and are therefore likely to slow
htmlfontify down, at least a little. Except for skip-refontification,
which can never slow you down, but may result in incomplete fontification."
  :type  '(set (const :tag "merge-adjacent-tags"  merge-adjacent-tags )
	       (const :tag "zap-comment-links"    zap-comment-links   )
	       (const :tag "zap-string-links"     zap-string-links    )
	       (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       )
	       )
  :group 'htmlfontify
  :tag   "optimisations")

 (defcustom hfy-fast-lock-save nil
   "*Minimum size of a buffer for cached fontification.
 This value is temporarily assigned to `fast-lock-minimum-size' during
 html-fontification.\n
Only buffers more than this can have associated Font Lock cache files saved.\n
If nil, means cache files are never created.\n
If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
where MAJOR-MODE is a symbol or t (meaning the default).  For example:\n
 ((c-mode     . 25600  )\n  (c++-mode   . 25600  )\n  (rmail-mode . 1048576))\n
means that the minimum size is 25K for buffers in C or C++ modes, one megabyte
for buffers in Rmail mode, and size is irrelevant \(ie no saves\) otherwise.\n"
  :type '(choice
	  (const   :tag "none" nil)
	  (integer :tag "size")
	  (repeat  :menu-tag "mode specific"
		   :tag      "mode specific"
		   :value ((t . nil))
		   (cons :tag "Instance"
			 (radio :tag "Mode"
				(const  :tag "all" t)
				(symbol :tag "name"))
			 (radio :tag "Size"
				(const   :tag "none" nil)
				(integer :tag "size")))))
  :group 'htmlfontify
  :tag   "fast-lock-minimum-size")

(defvar hfy-tags-cache  nil
  "Alist of the form\n
\(\(\"/src/dir/0\" . tag-hash0\) \(\"/src/dir/1\" tag-hash1\) ...\)\n
Each  tag hash entry then contains entries of the form:\n
\"tag_string\" => ((\"file/name.ext\" line char) ... )\n
ie an alist mapping \(relative\) file paths to line and character offsets.\n
See `hfy-load-tags-cache'.")

(defvar hfy-tags-sortl  nil
  "Alist of the form \(\(\"/src/dir\" . (tag0 tag1 tag2)\) ... \)\n
Where the tags are stored in descending order of length.\n
See `hfy-load-tags-cache'.")

(defvar hfy-tags-rmap   nil
  "Alist of the form \(\(\"/src/dir\" . tag-rmap-hash\)\)\n
Where tag-rmap-hash has entries of the form:
\"tag_string\" => ( \"file/name.ext\" line char )
Unlike `hfy-tags-cache' these are the locations of occurrences of
tagged items, not the locations of their definitions.")

(defvar hfy-style-assoc 'please-ignore-this-line
  "An assoc representing/describing an emacs face. Properties may be repeated,
In which case later properties should be treated as if they were inherited
from a \'parent\' font. \(For some properties, only the first encountered value
is of any importance, for others the values might be cumulative, and for
others they might be cumulative in a complex way).\n
Some examples:\n
\(hfy-face-to-style 'default\) =>
  \(\(\"background\"      . \"rgb\(0, 0, 0\)\"\)
   \(\"color\"           . \"rgb\(255, 255, 255\)\"\)
   \(\"font-style\"      . \"normal\"\)
   \(\"font-weight\"     . \"500\"\)
   \(\"font-stretch\"    . \"normal\"\)
   \(\"font-family\"     . \"misc-fixed\"\)
   \(\"font-size\"       . \"13pt\"\)
   \(\"text-decoration\" . \"none\"\)\)\n
\(hfy-face-to-style 'Info-title-3-face\) =>
  \(\(\"font-weight\"     . \"700\"\)
   \(\"font-family\"     . \"helv\"\)
   \(\"font-size\"       . \"120%\"\)
   \(\"text-decoration\" . \"none\"\)\)\n")

(defvar hfy-sheet-assoc 'please-ignore-this-line
  "An assoc with elements of the form (face-name style-name . stlye-string):\n
'\(\(default               \"default\" . \"{background: black;color: white}\"\)
  \(font-lock-string-face \"string\"  . \"{color: rgb\(64,224,208\)}\"\)\)" )

(defvar hfy-facemap-assoc 'please-ignore-this-line
  "An assoc of \(point . FACE-SYMBOL\) or \(point . DEFFACE-LIST\)
and (point . 'end) elements, in descending order of point value
\(ie from the file's end to its beginning\).\n
The map is in reverse order because inserting a <style> tag \(or any other
string) at POINT invalidates the map for all entries with a greater value of
point. By traversing the map from greatest to least POINT, we still invalidate
the map as we go, but only those points we have already dealt with \( and
therefore no longer care about \) will be invalid at any time.\n
'\(\(64820 . end\)
  \(64744 . font-lock-comment-face\)
  \(64736 . end\)
  \(64722 . font-lock-string-face\)
  \(64630 . end\)
  \(64623 . font-lock-string-face\)
  \(64449 . end\)
  \(64446 . font-lock-keyword-face\)
  \(64406 . end\)
  \(64395 . font-lock-constant-face\)
  \(64393 . end\)
  \(64386 . font-lock-keyword-face\)
  \(64379 . end\)
  ;; big similar section elided. You get the idea.
  \(4285 . font-lock-constant-face\)
  \(4285 . end\)
  \(4221 . font-lock-comment-face\)
  \(4221 . end\)
  \(4197 . font-lock-constant-face\)
  \(4197 . end\)
  \(1 . font-lock-comment-face\)\)")

(defvar hfy-tmpfont-stack nil
  "An alist of derived fonts resulting from overlays")

(defconst hfy-hex-regex "[0-9A-Fa-f]")

(defconst hfy-triplet-regex
  (concat 
   "\\(" hfy-hex-regex hfy-hex-regex "\\)"
   "\\(" hfy-hex-regex hfy-hex-regex "\\)"
   "\\(" hfy-hex-regex hfy-hex-regex "\\)"))

(defun hfy-interq (set-a set-b)
  "Return the intersection \(using `eq'\) of 2 lists."
  (let ((sa set-a) (interq nil) (elt nil))
    (while sa
      (setq elt (car sa)
	    sa  (cdr sa))
      (if (memq elt set-b) (setq interq (cons elt interq)))) interq))

(defun hfy-colour-vals (colour)
  "Where COLOUR is a colour name or #XXXXXX style triplet, return a
list of 3 (16 bit) rgb values for said colour.\n
If a window system is unavailable, calls `hfy-fallback-colour-values'."
  (if (string-match hfy-triplet-regex colour)
      (mapcar
       (lambda (x)
	 (* (string-to-int (match-string x colour) 16) 257)) '(1 2 3))
    ;;(message ">> %s" colour)
    (if window-system
	(if (fboundp 'color-values)
	    (color-values colour)
	  ;;(message "[%S]" window-system)
	  (x-color-values colour))
      ;; blarg - tty colours are no good - go fetch some X colours:
      (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
in a windowing system - try to trick it..."
  (if (not hfy-cperl-mode-kludged-p)
      (progn (if (not window-system)
		 (let ((window-system 'htmlfontify))
		   (eval-and-compile (require 'cperl-mode))
		   (setq cperl-syntaxify-by-font-lock t)))
	     (setq hfy-cperl-mode-kludged-p t))) )

(defun hfy-opt (symbol) (memq symbol hfy-optimisations))

(defun hfy-default-header (file style)
  "Default value for `hfy-page-header'"
  (format "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\">
<html>\n <head>\n  <title>%s</title>\n %s\n </head>\n  <body>\n" file style))

(defun hfy-default-footer (file)
  "Default value for `hfy-page-footer'"
  "\n </body>\n</html>\n")

(defun hfy-link-style-string (style-string)
  "Replace the end of a css style declaration STYLE-STRING with the contents
of the variable `hfy-src-doc-link-style', removing text matching the regex
`hfy-src-doc-link-unstyle' first, if necessary."
  ;;(message "hfy-colour-vals");;DBUG
  (if (string-match hfy-src-doc-link-unstyle style-string)
      (setq style-string (replace-match "" 'fixed-case 'literal style-string)))
  (if (and (not (string-match hfy-src-doc-link-style style-string))
           (string-match "} *$" style-string))
      (concat (replace-match hfy-src-doc-link-style
			     'fixed-case
			     'literal
			     style-string) " }") style-string))

;; utility functions - cast emacs style specification values into their
;; css2 equivalents:
(defun hfy-triplet (colour)
  "Takes a colour name \(string\) and return a css rgb(R, G, B) triplet string.
Uses the definition of \"white\" to map the numbers to the 0-255 range, so
if you\'ve redefined white, \(esp if you've redefined it to have a triplet
member lower than that of the colour you are processing, strange things
may happen\)."
  ;;(message "hfy-colour-vals");;DBUG
  (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
	(apply 'format "rgb(%d, %d, %d)"
	       (mapcar (lambda (X)
			 (* (/ (nth X rgb16)
			       (nth X white)) 255)) '(0 1 2))))) )

(defun hfy-family (family) (list (cons "font-family"  family)))
(defun hfy-bgcol  (colour) (list (cons "background"   (hfy-triplet colour))))
(defun hfy-colour (colour) (list (cons "color"        (hfy-triplet colour))))
(defun hfy-width  (width)  (list (cons "font-stretch" (symbol-name  width))))

(defun hfy-size   (height)
  "Derive a css font-size specifier from an emacs font :height attribute.
Does not cope with the case where height is a function to be applied to
the height of the underlying font."
  (list 
   (cond
    ((floatp   height) (cons "font-size" (format "%d%%" (* height 100))))
    ((integerp height) (cons "font-size" (format "%dpt" (/ height 10 )))) )) )

(defun hfy-slant  (slant)
  "Derive a font-style css specifier from the emacs :slant attribute -
CSS does not define the reverse-* styles, so just maps those to the
regular specifiers."
  (list (cons "font-style" (cond ((eq 'italic          slant) "italic" )
				 ((eq 'reverse-italic  slant) "italic" )
				 ((eq 'oblique         slant) "oblique")
				 ((eq 'reverse-oblique slant) "oblique")
				 (t                           "normal" )))) )

(defun hfy-weight (weight)
  "Derive a font-weight css specifier from an emacs weight spec symbol."
  (list (cons "font-weight" (cond ((eq 'ultra-bold  weight) "900")
				  ((eq 'extra-bold  weight) "800")
				  ((eq 'bold        weight) "700")
				  ((eq 'semi-bold   weight) "600")
				  ((eq 'normal      weight) "500")
				  ((eq 'semi-light  weight) "400")
				  ((eq 'light       weight) "300")
				  ((eq 'extra-light weight) "200")
				  ((eq 'ultra-light weight) "100")))) )

(defun hfy-box-to-border-assoc (spec)
  (if spec
      (let ((tag (car  spec))
	    (val (cadr spec)))
	(cons (cond ((eq tag :color) (cons "colour" val))
		    ((eq tag :width) (cons "width"  val))
		    ((eq tag :style) (cons "style"  val)))
	      (hfy-box-to-border-assoc (cddr spec))))) )

(defun hfy-box-to-style (spec)
  (let* ((css (hfy-box-to-border-assoc  spec))
	 (col (cdr      (assoc "colour" css)))
	 (s   (cdr      (assoc "style"  css))))
    (list
     (if col (cons "border-color" (cdr (assoc "colour" css))))
     (cons "border-width" (format "%dpx" (or (cdr (assoc "width" css)) 1)))
     (cons "border-style" (cond ((eq s 'released-button) "outset")
				((eq s 'pressed-button ) "inset" )
				(t                       "solid" ))))) )

(defun hfy-box (box)
  "Derive CSS border-* attributes from the emacs :box attribute."
  (if box
      (cond
       ((integerp box) (list (cons "border-width" (format "%dpx"   box))))
       ((stringp  box) (list (cons "border" (format "solid %s 1px" box))))
       ((listp    box) (hfy-box-to-style box)                            ))) )

(defun hfy-decor (tag val)
  "Derive CSS text-decoration specifiers from various emacs font attributes."
  (list
   (cond ((eq tag :underline     ) (cons "text-decoration" "underline"   ))
	 ((eq tag :overline      ) (cons "text-decoration" "overline"    ))
	 ((eq tag :strike-through) (cons "text-decoration" "line-through")))))

(defun hfy-combined-face-spec (face)
  "Return a `defface' style alist of possible specifications for FACE,
with any entries resulting from user customisation \(`custom-set-faces'\)
taking precedence."
  (let ((spec  nil))
    (setq spec (append (or (get face 'saved-face)        (list))
		       (or (get face 'face-defface-spec) (list))))
    (if (and hfy-display-class hfy-default-face-def (eq face 'default))
	(setq spec (append hfy-default-face-def spec))) spec))
  
(defun hfy-face-attr-for-class (face &optional class)
  "Return the face attributes for FACE. 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
specify - this matches emacs\' behaviour when deciding on which face attributes
to use, to the best of my understanding\).\n
If CLASS is nil, then you just get 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
is magical in that emacs fonts behave as if they inherit implicitly from
\'default, but no such behaviour exists in HTML/CSS \).\n
See `hfy-display-class' for details of valid values for CLASS."
  (let ((face-spec nil))
    (setq
     face-spec
     (if class 
	 (let ((face-props (hfy-combined-face-spec face))
	       (face-specn nil)
	       (face-class nil)
	       (face-attrs nil)
	       (face-score  -1)
	       (face-match nil))                   
	   (while face-props
	     (setq face-specn (car face-props)
		   face-class (car face-specn)
		   face-attrs (cdr face-specn)
		   face-props (cdr face-props))
	     ;; if the current element CEL of CLASS is t we match
	     ;; if the current face-class is t, we match
	     ;; if the cdr of CEL has a non-nil
	     ;;   intersection with the cdr of the first member of
	     ;;   the current face-class with the same car as CEL, we match
	     ;; if we actually clash, then we can't match
	     (let ((cbuf class)
		   (cel    nil)
		   (key    nil)
		   (val    nil)
		   (x      nil)
		   (next   nil)
                   (score    0))
	       (while (and cbuf (not next))
		 (setq cel  (car cbuf)
		       cbuf (cdr cbuf)
		       key  (car  cel)
		       val  (cdr  cel)
		       val  (if (listp val) val (list val)))
		 (cond
		  ((or (eq t cel) (eq t face-class)) ;; default match
		   (setq score 0) (ignore "t match"))
		  ((not (cdr (assq key face-class))) ;; neither good nor bad
		   nil (ignore "non match, non collision"))
		  ((setq x (hfy-interq val (cdr (assq key face-class)))) 
		   (setq score (+ score (length x)))
		   (ignore "intersection"))
		  (t                                 ;; nope.
		   (setq next t score -10) (ignore "collision")) ))
	       (if (> score face-score)
		   (progn
		     (setq face-match face-attrs
			   face-score score     )
		     (ignore "%d << %S/%S" score face-class class))
		 (ignore "--- %d ---- (insufficient)" score)) )) 
	   ;; matched ? last attrs : nil
	   (if face-match  
	       (if (listp (car face-match)) (car face-match) face-match) nil))
       (face-attr-construct face)) )
    (if (or (memq :inherit face-spec) (eq 'default face))
	face-spec
      (nconc face-spec (list :inherit 'default)))
    )
  )

;; construct an assoc of (css-tag-name . css-tag-value) pairs
;; from a face or assoc of face attributes:
(defun hfy-face-to-style-i (fn)
  "The guts of `hfy-face-to-style': FN should be a `defface' font spec,
as returned by `face-attr-construct' or `hfy-face-attr-for-class'. Note
that this function does not get font-sizes right if they are based on
inherited modifiers \(via the :inherit\) attribute, and any other
modifiers that are cumulative if they appear multiple times need to be
merged by the user - `hfy-flatten-style' should do this."
  ;;(message "hfy-face-to-style-i");;DBUG
  (if fn
      (let ((key  (car  fn))
	    (val  (cadr fn))
	    (next (cddr fn))
	    (that       nil)
	    (this       nil)
	    (parent     nil))
	(setq this
	      (if val (cond
		       ((eq key :family        ) (hfy-family    val))
		       ((eq key :width         ) (hfy-width     val))
		       ((eq key :weight        ) (hfy-weight    val))
		       ((eq key :slant         ) (hfy-slant     val))
		       ((eq key :foreground    ) (hfy-colour    val))
		       ((eq key :background    ) (hfy-bgcol     val))
		       ((eq key :box           ) (hfy-box       val))
		       ((eq key :height        ) (hfy-size      val))
		       ((eq key :underline     ) (hfy-decor key val))
		       ((eq key :overline      ) (hfy-decor key val))
		       ((eq key :strike-through) (hfy-decor key val))
		       ((eq key :bold          ) (hfy-weight  'bold))
		       ((eq key :italic        ) (hfy-slant 'italic)))))
	(setq that (hfy-face-to-style-i next))
	(if (eq key :inherit)
	    (setq parent (hfy-face-to-style-i
			  (hfy-face-attr-for-class val hfy-display-class))))
	(nconc this that parent))) )

(defun hfy-size-to-int (spec)
  "Convert SPEC, a css font-size specifier, back to an emacs :height attribute
value. Used while merging multiple font-size attributes."
  ;;(message "hfy-size-to-int");;DBUG
  (list
   (if (string-match "\\([0-9]+\\)\\(%\\|pt\\)" spec)
       (cond ((string= "%"  (match-string 2 spec))
	      (/ (string-to-int (match-string 1 spec)) 100.0))
	     ((string= "pt" (match-string 2 spec))
	      (* (string-to-int (match-string 1 spec))    10)))
     (string-to-number spec))) )

;; size is different, in that in order to get it right at all,
;; we have to trawl the inheritance path, accumulating modifiers,
;; _until_ we get to an absolute (pt) specifier, then combine the lot
(defun hfy-flatten-style (style)
  "Take STYLE (see `hfy-face-to-style-i', `hfy-face-to-style') and merge
any multiple attributes appropriately. Currently only font-size is merged
down to a single occurrence - others may need special handling, but I
haven\'t encountered them yet. Returns a `hfy-style-assoc'."
  ;;(message "hfy-flatten-style");;DBUG
  (let ((n        0)
	(m (list 1))
	(x      nil)
	(r      nil))
    (mapcar
     (lambda (css)
       (if (string= (car css) "font-size")
	   (progn
	     (if (not x) (setq m (nconc m (hfy-size-to-int (cdr css)))))
	     (if (string-match "pt" (cdr css)) (setq x t)))
	 (setq r (nconc r (list css))))) style)
    (setq  n (apply '* m))
    (nconc r (hfy-size (if x (round n) (* n 1.0)))) r))

(defun hfy-face-to-style (fn)
  "Take FN, a font or `defface' style font specification,
\(as returned by `face-attr-construct' or `hfy-face-attr-for-class'\)
and return a `hfy-style-assoc'.\n
See also: `hfy-face-to-style-i', `hfy-flatten-style'."
  ;;(message "hfy-face-to-style");;DBUG
  (let ((face-def (if (facep fn)
		      (hfy-face-attr-for-class fn hfy-display-class) fn))
	(final-style nil))
    
    (setq final-style (hfy-flatten-style (hfy-face-to-style-i face-def)))
    ;;(message "%S" final-style)
    (if (not (assoc "text-decoration" final-style))
	(progn (setq final-style
		     (nconc final-style '(("text-decoration"."none"))))))
    final-style))

;; strip redundant bits from a name. Technically, this could result in
;; a collision, but it is pretty unlikely - will fix later...
;; also handle ephemeral fonts created by overlays, which don't actually
;; have names:
(defun hfy-face-or-def-to-name (fn)
  "Render a font symbol or `defface' font spec into a name \(string\)"
  (if (not (listp fn))
      (format "%s" fn)
    (let* ((key   (format       "%s"        fn))
           (entry (assoc key hfy-tmpfont-stack))
           (base  (cadr   (memq  :inherit  fn)))
           (tag   (cdr                   entry)))
      (if entry nil ;; noop
        (setq tag               (format "%04d" (length hfy-tmpfont-stack))
              entry             (cons key tag)
              hfy-tmpfont-stack (cons entry hfy-tmpfont-stack)))
      (message "%S <- %S" base fn)
      (format "%s-%s" (or base 'default) tag)) ))

(defun hfy-css-name (fn)
  "Strip some of the boring bits from a font-name and return a css style name."
  ;;(message "hfy-css-name");;DBUG
  (let ((face-name (hfy-face-or-def-to-name fn)))
    (if (or (string-match "font-lock-\\(.*\\)" face-name)
	    (string-match "cperl-\\(.*\\)"     face-name)
	    (string-match "[Ii]nfo-\\(.*\\)"   face-name))
	(progn
	  (setq face-name (match-string 1 face-name))
	  (if (string-match "\\(.*\\)-face$" face-name)
	      (setq face-name (match-string 1 face-name))) face-name)
      face-name)) )

;; 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.

See also: `hfy-face-to-style'"
  ;;(message "hfy-face-to-css");;DBUG
  (let ((css-list nil)
	(css-text nil)
	(style    nil)
	(seen     nil))
    (setq css-list (hfy-face-to-style fn))
    (setq css-text
	  (nconc
	   (mapcar
	    (lambda (E)
	      (if (car E)
		    (if (not (member (car E) seen))
			(progn
			  (setq seen (cons (car E) seen))
			  (format " %s: %s; " (car E) (cdr E)))))) css-list)))
    (cons (hfy-css-name fn) (format "{%s}" (apply 'concat css-text)))) )

;; extract a face from a list of char properties, if there is one:
(defun hfy-p-to-face (props)
  "Given PROPS, a list of text-properties, return the value of the face
property, or nil."
  ;;(message "hfy-p-to-face");;DBUG
  (if props
      (if (string= (car props) "face")
	  (if (listp (cadr props)) (car (cadr props)) (cadr props))
	(hfy-p-to-face (cddr props))) nil))

(defun hfy-face-at (p)
  "Find face in effect at point P. If overlays are to be considered
\(see `hfy-optimisations'\) then this may return a defface style
list of face properties instead of a face symbol"
  ;;(message "hfy-face-at");;DBUG
  (let ((face-name   (hfy-p-to-face (text-properties-at p)))
        (overlay-data nil)
        (prop-seen    nil)
	(found-face   nil)
        (extra-props  nil))
    (if (or (not (hfy-opt                      'keep-overlays))
            (not (setq overlay-data (hfy-overlay-props-at p))))
        face-name ;; overlays not wanted, or none to consider
      (mapcar
       (lambda (P)
         (let ((fprops (cadr (memq 'face P))))
	   (if (not (listp fprops))
	       (if (not found-face)
		   (setq face-name (if (stringp fprops) (intern fprops) fprops)
			 found-face t))
	     (while fprops
	       (let ((p (car fprops)) (v (cadr fprops)))
		 (if (memq p prop-seen) nil ;; noop
		   (setq prop-seen   (cons p prop-seen)
			 found-face  t
			 extra-props (cons p (cons v extra-props))) )
		 (setq fprops (cddr fprops)) )) ) )) overlay-data)
      (if found-face
	  (cons :inherit (cons (or face-name 'default) extra-props))
	face-name)
      )
    )
  )

(defun hfy-overlay-props-at (p)
  "Grab overlay properties at point P, plists are returned in
descending priority order"
  (sort (mapcar (lambda (O) (overlay-properties O)) (overlays-at p))
        (lambda (A B) (> (or (cadr (memq 'priority A)) 0)
                         (or (cadr (memq 'priority B)) 0)) ) ) )

;; 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'."
  ;;(message "hfy-compile-stylesheet");;DBUG
  (let ((pt (point-min))
        (hfy-tmpfont-stack nil)
	(fn         nil)
	(css        nil)
	(style      nil))
    (save-excursion
      (goto-char pt)
      (while (< pt (point-max))
	(if (and (setq fn (hfy-face-at pt)) (not (assoc fn style)))
	    (setq style (cons (cons fn (hfy-face-to-css fn)) style)))
	(setq pt (next-char-property-change pt))) )
    (setq style (cons (cons 'default (hfy-face-to-css 'default)) style))) )

(defun hfy-fontified-p ()
  "`font-lock' doesn't like to say it\'s been fontified when in batch
mode, but we want to know if we should fontify or raw copy, so in batch
mode we check for non-default face properties. Otherwise we test
`font-lock-mode' and `font-lock-fontified' for truth."
  ;;(message "font-lock-fontified: %S" font-lock-fontified)
  ;;(message "noninteractive     : %S" noninteractive)
  ;;(message "font-lock-mode     : %S" font-lock-mode)
  (and font-lock-fontified
       (if noninteractive
	   (let ((pt  (point-min))
		 (face-name   nil))
	     (save-excursion
	       (goto-char pt)
	       (while (and (< pt (point-max)) (not face-name))
		 (setq face-name (hfy-face-at pt))
		 (setq pt (next-char-property-change pt)))) face-name)
	 font-lock-mode)))

;; remember, the map is in reverse point order:
;; I wrote this while suffering the effects of a cold, and maybe a
;; mild fever - I think it's correct, but it might be a little warped
;; as my minfd keeps ... where was I? Oh yes, the bunnies...
(defun hfy-merge-adjacent-spans (face-map)
  "Where FACE-MAP is a `hfy-facemap-assoc' for the current buffer, 
this function merges adjacent style blocks which are of the same value
and are separated by nothing more interesting than whitespace.\n
  <span class=\"foo\">narf</span> <span class=\"foo\">brain</span>\n
\(as interpreted from FACE-MAP\) would become:\n
  <span class=\"foo\">narf brain</span>\n
Returns a modified copy of FACE-MAP."
  (let ((tmp-map face-map)
	(map-buf      nil)
	(first-start  nil)
	(first-stop   nil)
	(last-start   nil)
	(last-stop    nil)
	(span-stop    nil)
	(span-start   nil)
	(reduced-map  nil))
    ;;(setq reduced-map (cons (car  tmp-map) reduced-map))
    ;;(setq reduced-map (cons (cadr tmp-map) reduced-map))
    (while tmp-map
      (setq first-start (cadddr tmp-map)
	    first-stop  (caddr  tmp-map)
	    last-start  (cadr   tmp-map)
	    last-stop   (car    tmp-map)
	    map-buf      tmp-map
	    span-start   last-start
	    span-stop    last-stop      )
      (while (and (equal (cdr first-start)
			 (cdr  last-start))
		  (save-excursion
		    (goto-char (car first-stop))
		    (not (re-search-forward "[^ \t\n\r]" (car last-start) t))))
	(setq map-buf     (cddr map-buf)
	      span-start  first-start
	      first-start (cadddr map-buf)
	      first-stop  (caddr  map-buf)
	      last-start  (cadr   map-buf)
	      last-stop   (car    map-buf)))
      (setq reduced-map (cons span-stop  reduced-map))
      (setq reduced-map (cons span-start reduced-map))
      (setq tmp-map (memq last-start tmp-map))
      (setq tmp-map (cdr tmp-map)))
    (setq reduced-map (nreverse reduced-map))))

;; remember to generate 'synthetic' </span> entries -
;; emacs copes by just having a stack of styles in effect
;; and only using the top one: html has a more simplistic approach -
;; we have to explicitly end a style, there's no way of temporarily
;; overriding it w. another one... (afaik)
(defun hfy-compile-face-map ()
  "Compile and return a `hfy-facemap-assoc' for the current buffer."
  ;;(message "hfy-compile-face-map");;DBUG
  (let ((pt (point-min))
	(fn         nil)
	(map        nil)
	(prev-tag   nil)) ;; t   if the last tag-point was a span-start
                          ;; nil if it was a span-stop
    (save-excursion
      (goto-char pt)
      (while (< pt (point-max))
	(if (setq fn (hfy-face-at pt))
	    (progn (if prev-tag (setq map (cons (cons pt 'end) map)))
	           (setq map (cons (cons pt fn) map))
		   (setq prev-tag t))
	  (if prev-tag (setq map (cons (cons pt 'end) map)))
	  (setq prev-tag nil))
	(setq pt (next-char-property-change pt)))
      (if (and map (not (eq 'end (cdar map))))
	  (setq map (cons (cons (point-max) 'end) map))))
    (if (hfy-opt 'merge-adjacent-tags) (hfy-merge-adjacent-spans map) map)))

(defun hfy-buffer ()
  "Generate a buffer to hold the html output. The filename of this buffer is
derived from the source \(current\) buffer\'s `buffer-file-name', if it is
set, plus `hfy-extn'. Otherwise a plausible filename is constructed from
`default-directory', `buffer-name' and `hfy-extn'."
  (let* ((name (concat (buffer-name) hfy-extn))
         (src               (buffer-file-name))
         (buf  (get-buffer-create        name)))
    (save-excursion
      (set-buffer buf)
      (if src (setq buffer-file-name (concat src hfy-extn))
        (if (string-match "^.*/\\([^/]*\\)$" name)
            (setq buffer-file-name
                  (concat default-directory "/" (match-string 1 name)))
          (setq buffer-file-name (concat default-directory "/" name) )))
      buf)))

;; get a css style name for a face from the style:
(defun hfy-lookup (face style) (cadr (assoc face style)))

(defun hfy-link-style (style-string)
  ;;(message "hfy-link-style");;DBUG
  (if (functionp hfy-link-style-fun)
      (funcall hfy-link-style-fun style-string)
    style-string))

;; barf up the inline css stylesheet
(defun hfy-sprintf-stylesheet (css file)
  ;;(message "hfy-sprintf-stylesheet");;DBUG
  (let ((stylesheet nil))
    (setq stylesheet
	  (concat
	   hfy-meta-tags
	   "\n<style type=\"text/css\"><!-- \n"
	   (format "body %s\n" (cddr (assq 'default css)))
	   (apply 'concat
		  (mapcar
		   (lambda (style)
		     (format
		      "span.%s   %s\nspan.%s a %s\n"
		      (cadr style) (cddr style)
		      (cadr style) (hfy-link-style (cddr style)))) css))
	   " --></style>\n"))
    (funcall hfy-page-header file stylesheet)))

;; tag all the dangerous characters we want to escape
;; (ie any "<> chars we _didn't_ put there explicitly for css markup)
(defun hfy-html-enkludge-buffer ()
  "Mark dangerous [\"\<\>] characters with the \'hfy-quoteme property.\n
See also `hfy-html-dekludge-buffer'."
  ;;(message "hfy-html-enkludge-buffer");;DBUG
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward hfy-html-quote-regex nil t)
      (put-text-property (match-beginning 0) (point) 'hfy-quoteme t))) )

;; dangerous char -> &entity;
(defun hfy-html-quote (char-string)
  "Map a string (usu. 1 char long) to an html safe string (entity) if need be."
  ;;(message "hfy-html-quote");;DBUG
  (or (cadr (assoc char-string hfy-html-quote-map)) char-string) )

;; actually entity-ise dangerous chars.
;; note that we can't do this until _after_ we have inserted the css
;; markup, since we use a position-based map to insert this, and if we
;; enter any other text before we do this, we'd have to track another
;; map of offsets, which would be tedious...
(defun hfy-html-dekludge-buffer ()
  "Transform all dangerous characters marked with the \'hfy-quoteme property
using `hfy-html-quote'\n
See also `hfy-html-enkludge-buffer'."
  ;;(message "hfy-html-dekludge-buffer");;DBUG
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward hfy-html-quote-regex nil t)
      (if (get-text-property (match-beginning 0) 'hfy-quoteme)
	  (replace-match (hfy-html-quote (match-string 1)))
	)
      )
    )
  )

(defun hfy-fontify-buffer (&optional srcdir file)
  "Implement the guts of `htmlfontify-buffer'"
  (if srcdir (setq srcdir (directory-file-name srcdir)))
  (let ((in-style                                   nil)
        (fast-lock-minimum-size      hfy-fast-lock-save)
	(html-buffer           (hfy-buffer            ))
	(css-sheet             (hfy-compile-stylesheet))
	(css-map               (hfy-compile-face-map  )))
    ;; copy the buffer, including fontification, and switch to it:
    (copy-to-buffer html-buffer (point-min) (point-max))
    (set-buffer     html-buffer)
    ;;(message "in new html-buffer")
    ;; at this point, html-buffer retains the fontification of the parent:
    ;; #####################################################################
    ;; if we are in etags mode, add properties to mark the anchors and links
    (if (and srcdir file)
	(progn
	  (hfy-mark-tag-names srcdir file) ;; mark anchors
	  (hfy-mark-tag-hrefs srcdir file))) ;; mark links
    ;; #####################################################################
    ;; mark the 'dangerous' characters
    ;;(message "marking dangerous characters")
    (hfy-html-enkludge-buffer)
    ;; trawl the position-based face-map, inserting span tags as we go
    ;; note that we cannot change any character positions before this point
    ;; or we will invalidate the map:
    ;; NB: This also means we have to trawl the map in descending file-offset
    ;; order, obviously.
    ;; ---------------------------------------------------------------------
    ;; Remember, inserting pushes properties to the right, which we don't
    ;; actually want to happen for link properties, so we have to flag
    ;; them and move them by hand - if you don't, you end up with
    ;;
    ;; <span class="foo"><a href="bar">texta</span><span class="bletch"></a>...
    ;;
    ;; instead of:
    ;;
    ;; <span class="foo"><a href="bar">texta</a></span><span class="bletch">...
    ;;
    ;; If my analysis of the problem is correct, we can detect link-ness by
    ;; either hfy-linkp or hfy-endl properties at the insertion point, but I
    ;; think we only need to relocate the hfy-endl property, as the hfy-linkp
    ;; property has already served its main purpose by this point.
    ;;(message "mapcar over the CSS-MAP")
    (mapcar
     (lambda (point-face)
       (let ((pt (car point-face))
	     (fn (cdr point-face))
	     (move-link       nil))
	 (goto-char pt)
	 (setq move-link
	       (or (get-text-property pt 'hfy-linkp)
		   (get-text-property pt 'hfy-endl )))
	 (if (eq 'end fn)
	     (if (not (and srcdir file)) (insert "</span>")
	       (insert "</span>")
	       ;; (message "move-link: %S, pt: %d, point: %d, PROPS: %S"
	       ;; 	   move-link pt (point) PROPS )
	       (if (not move-link) nil
		 ;;(message "removing props @ %d" (point))
		 (remove-text-properties (point) (1+ (point)) '(hfy-endl nil))
		 (put-text-property pt (1+ pt) 'hfy-endl t)
		 )
	       )	   
	   (insert (format "<span class=\"htmlfontify-%s\">"
			   (hfy-lookup fn css-sheet)))
	   (if (not move-link) nil
	     ;;(message "removing prop2 @ %d" (point))
	     (if (remove-text-properties (point) (1+ (point)) '(hfy-endl nil))
		 (put-text-property pt (1+ pt) 'hfy-endl t))) ))) css-map)
    ;; #####################################################################
    ;; (message "checking to see whether we should link...")
    (if (and srcdir file)
	(let ((lp 'hfy-link)
	      (pt  nil)
	      (pr  nil)
	      (rr  nil))
	  ;; (message "  yes we should.")
	    ;; translate 'hfy-anchor properties to anchors
	    (setq pt (point-min))
	    (while (setq pt (next-single-property-change pt 'hfy-anchor))
	      (if (setq pr (get-text-property pt 'hfy-anchor))
		  (progn (goto-char pt)
			 (remove-text-properties pt (1+ pt) '(hfy-anchor nil))
			 (insert (concat "<a name=\"" pr "\"></a>")))))
	    ;; translate alternate 'hfy-link and 'hfy-endl props to opening
	    ;; and closing links. (this should avoid those spurious closes
	    ;; we sometimes get by generating only paired tags)
	    (setq pt (point-min))
	    (while (setq pt (next-single-property-change pt lp))
	      (if (not (setq pr (get-text-property pt lp))) nil
		(goto-char pt)
		(remove-text-properties pt (1+ pt) (list lp nil))
		(cond
		 ((eq lp 'hfy-link)
		  (if (setq rr (get-text-property pt 'hfy-inst))
		      (insert (format "<a name=\"%s\"></a>" rr)))
		  (insert (format "<a href=\"%s\">" pr))
		  (setq lp 'hfy-endl))
		 ((eq lp 'hfy-endl) 
		  (insert "</a>") (setq lp 'hfy-link)) ))) ))
    
    ;; #####################################################################
    ;; transform the dangerous chars. This changes character positions
    ;; since entities have > char length.
    ;; note that this deletes the dangerous characters, and therefore
    ;; destroys any properties they may contain (such as 'hfy-endl),
    ;; 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>\n")
    (goto-char (point-max))
    (insert "\n</pre>\n")
    (if (hfy-opt 'div-wrapper) (insert "</div>"))
    ;;(message "inserting footer")
    (insert (funcall hfy-page-footer file))
    ;; call any post html-generation hooks:
    (run-hooks 'hfy-post-html-hooks)
    ;; return the html buffer
    html-buffer))

(defun hfy-force-fontification ()
  (mapcar (lambda (fun) (funcall fun)) hfy-init-kludge-hooks)
  (eval-and-compile (require 'font-lock))
  (if (boundp 'font-lock-cache-position)
      (or font-lock-cache-position
	  (set 'font-lock-cache-position (make-marker))))
  (if (not noninteractive)
      (progn
	(message "hfy interactive mode (%S %S)" window-system major-mode)
	(font-lock-fontify-region (point-min) (point-max) nil))
    (message "hfy batch mode (%s:%S)"
	     (or (buffer-file-name) (buffer-name)) major-mode)
    (font-lock-fontify-buffer)
    )                           
  )

(defun htmlfontify-buffer (&optional srcdir file)
  "Create a new buffer, named for the current buffer + a .html extension,
containing an inline css-stylesheet and formatted css-markup html that
reproduces the look of the current emacs buffer as closely as possible.\n
Dangerous characters in the existing buffer are turned into html entities,
so you should even be able to do html-within-html fontified display.\n
You should, however, note that random control or eight-bit characters
such as ^L (\x0c) or ¤ (\xa4) won't get mapped yet.\n
If the SRCDIR and FILE arguments are set, lookup etags derived entries
in the `hfy-tags-cache' and add html anchors and hyperlinks as appropriate."
  (interactive)
  ;;(message "htmlfontify-buffer")
  ;; pick up the file name in case we didn't receive it
  (if (not file)
      (progn (setq file (or (buffer-file-name) (buffer-name)))
	     (if (string-match "/\\([^/]*\\)$" file)
		 (setq file (match-string 1 file)))) )
  
  (let ((fast-lock-minimum-size hfy-fast-lock-save))
	;(font-lock-support-mode    'fast-lock-mode))
    (if (not (hfy-opt 'skip-refontification)) (hfy-force-fontification))
    (if (interactive-p) ;; display the buffer in interactive mode:
	(switch-to-buffer (hfy-fontify-buffer srcdir file))
      (hfy-fontify-buffer srcdir file))) )

;; recursive file listing
(defun hfy-list-files (directory)
  "Return a list of files under DIRECTORY.
Strips any leading \"./\" from each filename."
  ;;(message "hfy-list-files");;DBUG
  (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
;; fed pretty carefully, so it should be Ok:
(defun hfy-dirname (file)
  "Return everything preceding the last \"/\" from a relative filename,
on the assumption that this will produce a relative directory name. Hardly
bombproof, but good enough in the context in which it is being used."
  ;;(message "hfy-dirname");;DBUG
  (let ((f (directory-file-name file)))
    (and (string-match "^\\(.*\\)/" f) (match-string 1 f))))

;; create a directory, cf mkdir -p 
(defun hfy-make-directory (dir)
  "Approx equivalent of mkdir -p DIR"
  ;;(message "hfy-make-directory");;DBUG
  (if (file-exists-p dir)
      (if (file-directory-p dir) t)
    (make-directory dir t)))

(defun hfy-text-p (srcdir file)
  "Is SRCDIR/FILE text? Uses `hfy-istext-command' to determine this."
  (let (cmd rsp)
    (setq cmd (format hfy-istext-command (concat srcdir "/" file))
	  rsp (shell-command-to-string    cmd))
    (if (string-match "text" rsp) t nil)))

;; open a file, check fontification, if fontified, write a fontified copy
;; to the destination directory, otherwise just copy the file:
(defun hfy-copy-and-fontify-file (srcdir dstdir file)
  "open FILE in SRCDIR - if fontified, write a fontified copy to DSTDIR
adding an extension of `hfy-extn'. Fontification is actually done by
`htmlfontify-buffer'. If the buffer is not fontified, just copy it."
  ;;(message "hfy-copy-and-fontify-file");;DBUG
  (let ((fast-lock-minimum-size      hfy-fast-lock-save)
        ;(font-lock-support-mode         'fast-lock-mode)
	;;(window-system  (or window-system 'htmlfontify))
	(target nil)
	(source nil)
	(html   nil))
    (cd srcdir)
    (save-excursion
      (setq source (find-file-noselect file))
      (set-buffer   source)
      (setq target (concat dstdir "/" file))
      (hfy-make-directory (hfy-dirname target))
      (if (not (hfy-opt 'skip-refontification)) (hfy-force-fontification))
      (if (or (hfy-fontified-p) (hfy-text-p srcdir file))
	  (progn (setq html  (hfy-fontify-buffer srcdir file))
		 (set-buffer  html)
		 (write-file (concat target hfy-extn))
		 (kill-buffer html))
	;; #o0200 == 128, but emacs20 doesn't know that
	(if (and (file-exists-p target) (not (file-writable-p target)))
	    (set-file-modes target (logior (file-modes target) 128)))
	(copy-file (buffer-file-name source) target 'overwrite))
      (kill-buffer source))
    )
  )

;; what line are we on?
(defun hfy-line-number ()
  ;;(message "hfy-line-number");;DBUG
  (let ((opoint (point)) start)
    (save-excursion
      (goto-char (point-min))
      (forward-line     0)
      (setq start (point))
      (goto-char   opoint)
      (forward-line 0)
      (1+ (count-lines 1 (point))))))

;; list of tags in file in srcdir
(defun hfy-tags-for-file (srcdir file)
  "List of etags tags that have definitions in this FILE. Looks up
the tags cache in `hfy-tags-cache' using SRCDIR as the key."
  ;;(message "hfy-tags-for-file");;DBUG
  (let ((cache-entry (assoc srcdir hfy-tags-cache))
	(cache-hash   nil)
	(tag-list     nil))
    (if (setq cache-hash (cadr cache-entry))
	(maphash
	 (lambda (K V)
	   (if (assoc file V)
	       (setq tag-list (cons K tag-list)))) cache-hash))
    tag-list))

;; mark the tags native to this file for anchors
(defun hfy-mark-tag-names (srcdir file)
  "Mark tags in FILE (lookup SRCDIR in `hfy-tags-cache') with the \'hfy-anchor
property, with a value of \"tag.line-number\"."
  ;;(message "(hfy-mark-tag-names %s %s)" srcdir file);;DBUG
  (let ((cache-entry (assoc srcdir hfy-tags-cache))
	(cache-hash   nil))
    (if (setq cache-hash (cadr cache-entry))
	(mapcar
	 (lambda (TAG)
	   (mapcar
	    (lambda (TLIST)
	      (if (string= file (car TLIST))
		  (let* ((line              (cadr TLIST) )
			 (chr              (caddr TLIST) )
			 (link (format "%s.%d" TAG line) ))
		    (put-text-property (+ 1 chr)
				       (+ 2 chr)
				       'hfy-anchor link))))
	    (gethash TAG cache-hash)))
	 (hfy-tags-for-file srcdir file)))))

(defun hfy-relstub (file &optional start)
  "Return a \"../\" stub of the appropriate length for the current source
tree depth \(as determined from FILE\). iyswim."
  ;;(message "hfy-relstub");;DBUG
  (let ((c ""))
    (while (setq start (string-match "/" file start))
      (setq start (1+ start)) (setq c (concat c "../"))) c))

(defun hfy-href-stub (this-file def-files tag)
  "Return an href stub for a tag href: if DEF-FILES \(list of files containing
definitions for the tag in question\) contains only one entry, the href should
link straight to that file. Otherwise, the link should be to the index file.\n
We are not yet concerned with the file extensions/tag line number and so on at
this point.\n
If `hfy-split-index' is set, and the href wil be to an index file rather than
a source file, append a .X to `hfy-index-file', where X is the uppercased
first character of TAG.\n
See also: `hfy-relstub', `hfy-index-file'`'."
  ;;(message "hfy-href-stub");;DBUG
  (concat
   (hfy-relstub this-file)
   (if (= 1 (length def-files)) (car def-files)
     (if (not hfy-split-index) hfy-index-file
       (concat hfy-index-file "." (upcase (substring tag 0 1)))))) )

(defun hfy-href (this-file def-files tag tag-map)
  "Return a relative href to the tag in question, based on\n
THIS-FILE `hfy-link-extn' `hfy-extn' DEF-FILES TAG and TAG-MAP\n
THIS-FILE is the current source file
DEF-FILES is a list of file containing possible link endpoints for TAG
TAG is the TAG in question
TAG-MAP is the entry in `hfy-tags-cache'."
  ;;(message "hfy-href");;DBUG
  (concat
   (hfy-href-stub this-file def-files tag)
   (or hfy-link-extn hfy-extn) "#" tag ;;(.src -> .html)
   (if (= 1 (length def-files))
       (concat "." (format "%d" (cadr (assoc (car def-files) tag-map)))))) )

(defun hfy-word-regex (string)
  "Return a regex that matches STRING as the first `match-string', with non
word characters on either side \(vaguely emulating the perl \\b regex atom\)."
  (concat "[^$A-Za-z_0-9]\\(" (regexp-quote string) "\\)[^A-Za-z_0-9]"))

;; mark all tags for hyperlinking, except the tags at
;; their own points of definition, iyswim:
(defun hfy-mark-tag-hrefs (srcdir file)
  "Mark href start points with the \'hfy-link prop \(value: href string\)\n
Mark href end points with the \'hfy-endl prop \(value t\)\n
Avoid overlapping links, and mark links in descending length of
tag name in order to prevent subtags from usurping supertags,
\(eg \"term\" for \"terminal\"). "
  ;;(message "hfy-mark-tag-hrefs");;DBUG
  (let ((cache-entry (assoc srcdir hfy-tags-cache))
	(list-cache  (assoc srcdir hfy-tags-sortl))
	(rmap-cache  (assoc srcdir hfy-tags-rmap ))
	(no-comment  (hfy-opt  'zap-comment-links))
	(no-strings  (hfy-opt  'zap-string-links ))
	(cache-hash                            nil)
	(tags-list                             nil)
	(tags-rmap                             nil)
	(case-fold-search                      nil))
    ;; extract the tag mapping hashes (fwd and rev) and the tag list: 
    (if (and (setq cache-hash (cadr cache-entry))
	     (setq tags-rmap  (cadr rmap-cache ))
	     (setq tags-list  (cadr list-cache )))
	(mapcar
	 (lambda (TAG)
	   (let* ((start            nil)		  
		  (stop             nil)
		  (href             nil)
		  (name             nil)
		  (case-fold-search nil)
		  (tmp-point        nil)
		  (maybe-start      nil)
		  (face-at          nil)
		  (rmap-entry       nil)
		  (rnew-elt         nil)
		  (rmap-line        nil)
		  (tag-regex       (hfy-word-regex TAG))
		  (tag-map         (gethash TAG cache-hash))
		  (tag-files       (mapcar (lambda (X) (car X))  tag-map)))
	     ;; find instances of TAG and do what needs to be done:
	     (goto-char (point-min))
	     (while (search-forward TAG nil 'NOERROR)
	       (setq tmp-point   (point)
		     maybe-start (- (match-beginning 0) 1))
	       (goto-char maybe-start)
	       (if (not (looking-at tag-regex))
		   nil
		 (setq start   (match-beginning 1))
		 (setq stop    (match-end 1))
		 (setq face-at
		       (and (or no-comment no-strings) (hfy-face-at start)))
                 (if (listp face-at)
                     (setq face-at (cadr (memq :inherit face-at))))
		 (if (or (text-property-any   start  (1+ stop)  'hfy-linkp  t)
			 (and no-comment (eq 'font-lock-comment-face face-at))
			 (and no-strings (eq 'font-lock-string-face  face-at)))
		     nil ;; already a link, NOOP

		   ;; set a reverse map entry:
		   (setq rmap-line  (hfy-line-number) 
			 rmap-entry (gethash    TAG     tags-rmap) 
		         rnew-elt   (list  file  rmap-line  start) 
		         rmap-entry (cons   rnew-elt   rmap-entry) 
		         name       (format "%s.%d" TAG rmap-line))
		   (put-text-property start (1+ start) 'hfy-inst name)
		   (puthash TAG rmap-entry tags-rmap)
		   
		   ;; mark the link. link to index if the tag has > 1 def
		   ;; add the line number to the #name if it does not:
		   (setq href (hfy-href file tag-files TAG tag-map))
		   (put-text-property start (1+ start) 'hfy-link  href)
		   (put-text-property stop  (1+ stop ) 'hfy-endl  t   )
		   (put-text-property start (1+ stop ) 'hfy-linkp t   )))
	       (goto-char tmp-point)) ))
	 tags-list) )))

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

;; cache the #(tag => file line point) entries for files under srcdir
;; and cache the descending sorted list of tags in the relevant alist,
;; also keyed by srcdir:
(defun hfy-load-tags-cache (srcdir)
  "Run `hfy-etags-cmd' on SRCDIR, then call `hfy-parse-tags-buffer'."
  ;;(message "hfy-load-tags-cache");;DBUG
  (let ((etags-buffer  (get-buffer-create     "*hfy-tags*"))
        (etags-command (format hfy-etags-cmd hfy-etags-bin))
	(shell-file-name                        (hfy-shell)))
    (cd srcdir)
    (shell-command  etags-command etags-buffer)
    (hfy-parse-tags-buffer srcdir etags-buffer)) )

;; break this out from `hfy-load-tags-cache' to make the tar file
;; functionality easier to implement.
;; ( tar file functionality not merged here because it requires a
;;   hacked copy of etags capable of tagging stdin: if Francesco
;;   Potorti accepts a patch, or otherwise implements stdin tagging,
;;   then I will provide a `htmlfontify-tar-file' defun )
(defun hfy-parse-tags-buffer (srcdir buffer)
  "Parse a BUFFER containing etags formatted output, loading the
`hfy-tags-cache'  and `hfy-tags-sortl' entries for SRCDIR."
  (let ((cache-entry     (assoc srcdir    hfy-tags-cache))
	(tlist-cache     (assoc srcdir    hfy-tags-sortl))
	(trmap-cache     (assoc srcdir    hfy-tags-rmap ))
	(cache-hash nil) (trmap-hash nil) (tags-list  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: 
    (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:
    (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)))
    (clrhash cache-hash)
    
    ;; cache the TAG => ((file line point) (file line point) ... ) entries:
    (save-excursion
      (set-buffer buffer)
      (goto-char (point-min))
      
      (while (and (looking-at "^\x0c") (= 0 (forward-line 1)))
	;;(message "^L boundary")
	(if (and (looking-at "^\\(.+\\),\\([0-9]+\\)$")
		 (= 0 (forward-line 1)))
	    (progn
	      (setq etags-file (match-string 1))
	      ;;(message "TAGS for file: %s" etags-file)
	      (while (and (looking-at hfy-etag-regex) (= 0 (forward-line 1)))
		(setq tag-string (match-string 1))
		(if (= 0 (length tag-string)) nil ; noop
		  (setq tag-line   (string-to-int (match-string 2)))
		  (setq tag-point  (string-to-int (match-string 3)))
		  (setq hash-entry (gethash tag-string  cache-hash))
		  (setq new-entry  (list etags-file tag-line tag-point))
		  (setq hash-entry (cons new-entry hash-entry))
		  ;;(message "HASH-ENTRY %s %S" tag-string new-entry)
		  (puthash tag-string hash-entry cache-hash)
		  )
		)
	      )
	  )
	)
      )

    ;; cache a list of tags in descending length order: 
    (maphash (lambda (K V) (setq tags-list (cons 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: 
    (if tlist-cache (setcar (cdr tlist-cache) tags-list)
      (setq hfy-tags-sortl (cons (list srcdir tags-list) hfy-tags-sortl)))

    ;; return the number of tags found:
    (length tags-list)
    )
  )

(defun hfy-prepare-index-i (srcdir dstdir filename &optional stub map)
  "Prepare a tags index buffer for SRCDIR.
`hfy-tags-cache' must already have an entry for SRCDIR for this to work.
`hfy-page-header', `hfy-page-footer', `hfy-link-extn' and `hfy-extn'
all play a part here.\n
If STUB is set, prepare an \(appropriately named\) index buffer
specifically for entries beginning with STUB.\n
If MAP is set, use that instead of `hfy-tags-cache'."
  ;;(message "hfy-write-index");;DBUG
  (let ((cache-entry  (assoc srcdir (or map hfy-tags-cache)))
	(cache-hash    nil)
	(tag-list      nil)
	(index-file
	 (concat filename (if stub (concat "." stub) "") hfy-extn))
	(index-buf     nil))
    (if (not (and cache-entry
		  (setq cache-hash (cadr cache-entry))
		  (setq index-buf  (get-buffer-create index-file))))
	nil ;; noop
      (maphash (lambda (K V) (setq tag-list (cons K tag-list))) cache-hash)
      (setq tag-list (sort tag-list 'string<))
      (set-buffer index-buf)
      (erase-buffer)
      (insert (funcall hfy-page-header filename "<!-- CSS -->"))
      (insert "<table>\n")

      (mapcar
       (lambda (TAG)
	 (let ((tag-started nil))
	   (mapcar
	    (lambda (DEF)
	      (if (and stub (not (string-match (concat "^" stub) TAG)))
		  nil ;; we have a stub and it didn't match: NOOP
		(let ((file (car  DEF))
		      (line (cadr DEF)))
		  (insert
		   (format
		    (concat
		     "  <tr>                                   \n"
		     "   <td>%s</td>                           \n"
		     "   <td><a href=\"%s%s\">%s</a></td>      \n"
		     "   <td><a href=\"%s%s#%s.%d\">%d</a></td>\n"
		     "  </tr>                                  \n")
			(if (string= TAG tag-started) "&nbsp;"
			  (format "<a name=\"%s\">%s</a>" TAG TAG))
			file (or hfy-link-extn hfy-extn) file
			file (or hfy-link-extn hfy-extn) TAG line line))
		  (setq tag-started TAG))))
	    (gethash TAG cache-hash)))) tag-list) 
      (insert "</table>\n")
      (insert (funcall hfy-page-footer filename))
      (and dstdir (cd dstdir))
      (set-visited-file-name index-file)
      index-buf)
    )
  )

(defun hfy-prepare-index (srcdir dstdir)
  "Return a list of index buffer\(s\), as determined by `hfy-split-index'."
  (if (not hfy-split-index)
      (list (hfy-prepare-index-i srcdir dstdir hfy-index-file nil))
    (let ((stub-list     nil)
	  (cache-hash    nil)
	  (index-list    nil)
	  (cache-entry  (assoc srcdir hfy-tags-cache))
	  )
      (if (and cache-entry (setq cache-hash (cadr cache-entry)))
	  (maphash
	   (lambda (K V)
	     (let ((stub (upcase (substring K 0 1))))
	       (if (member stub stub-list)
		   nil ;; seen this already: NOOP
		 (setq
		  stub-list  (cons stub stub-list)
		  index-list (cons (hfy-prepare-index-i srcdir
							dstdir
							hfy-index-file
							stub)
				   index-list)) ))) cache-hash) ) index-list)))

(defun hfy-prepare-tag-map (srcdir dstdir)
  "Prepare the counterpart\(s\) to the index buffer\(s\) - a list of buffers
with the same structure, but listing \( and linking to \) instances of tags
\( as opposed to their definitions \).\n
See: `hfy-prepare-index'
     `hfy-split-index'."
  (if (not hfy-split-index)
      (list (hfy-prepare-index-i srcdir
				 dstdir
				 hfy-instance-file
				 nil
				 hfy-tags-rmap))
    (let ((stub-list     nil)
	  (cache-hash    nil)
	  (index-list    nil)
	  (cache-entry  (assoc srcdir hfy-tags-rmap))
	  )
      (if (and cache-entry (setq cache-hash (cadr cache-entry)))
	  (maphash
	   (lambda (K V)
	     (let ((stub (upcase (substring K 0 1))))
	       (if (member stub stub-list)
		   nil ;; seen this already: NOOP
		 (setq
		  stub-list  (cons stub stub-list)
		  index-list (cons (hfy-prepare-index-i srcdir
							dstdir
							hfy-instance-file
							stub
							hfy-tags-rmap)
				   index-list)) ))) cache-hash) ) index-list)))

(defun hfy-subtract-maps (srcdir)
  "Internal function - strips definitions of tags from the instance map.
See: `hfy-tags-cache' and `hfy-tags-rmap'"
  (let ((new-list nil)
	(old-list nil)
	(def-list nil)
	(exc-list nil)
	(fwd-map (cadr (assoc srcdir hfy-tags-cache)))
	(rev-map (cadr (assoc srcdir hfy-tags-rmap )))
	(taglist (cadr (assoc srcdir hfy-tags-sortl))))
    (mapc
     (lambda (TAG)
       (setq def-list (gethash TAG fwd-map)
	     old-list (gethash TAG rev-map)
	     new-list  nil
	     exc-list  nil)
       (mapc
	(lambda (P)
	  (setq exc-list (cons (list (car P) (cadr P)) exc-list))) def-list)
       (mapc
	(lambda (P)
	  (or (member (list (car P) (cadr P)) exc-list)
	      (setq new-list (cons P new-list)))) old-list)
       (puthash TAG new-list rev-map)) taglist)
    )
  )

(defun htmlfontify-run-etags (srcdir)
  "Load the etags cache for SRCDIR. See `hfy-load-tags-cache'."
  (interactive "D source directory: ")
  (setq srcdir (directory-file-name srcdir))
  (hfy-load-tags-cache srcdir))

;;(defun hfy-test-read-args (foo bar)
;;  (interactive "D source directory: \nD target directory: ")
;;  (message "foo: %S\nbar: %S" foo bar))

(defun hfy-save-kill-buffers (buffer-list &optional dstdir)
  (mapc (lambda (B)
	  (set-buffer B)
	  (and dstdir (file-directory-p dstdir) (cd dstdir))
	  (save-buffer)
	  (kill-buffer B)) buffer-list) )

(defun htmlfontify-copy-and-link-dir (srcdir dstdir &optional f-ext l-ext)
  "Trawl SRCDIR and write fontified-and-hyperlinked output in DSTDIR.\n
F-EXT and L-EXT specify values for `hfy-extn' and `hfy-link-extn'.\n
You may also want to set `hfy-page-header' and `hfy-page-footer'."
  (interactive "D source directory: \nD output directory: ")
  ;;(message "htmlfontify-copy-and-link-dir")
  (setq srcdir (directory-file-name srcdir))
  (setq dstdir (directory-file-name dstdir))
  (let ((source-files "SETME: list of source files, relative to srcdir")
	(tr-cache  (assoc srcdir hfy-tags-rmap))
	(hfy-extn            (or f-ext ".html"))
	(hfy-link-extn       (or l-ext ".html")))
    ;; oops, forgot to load etags for srcdir:
    (if tr-cache nil
      (message "autoload of tags cache")
      (hfy-load-tags-cache srcdir)
      (setq tr-cache (assoc srcdir hfy-tags-rmap)))
    ;; clear out the old cache:
    (clrhash   (cadr tr-cache))
    (hfy-make-directory dstdir)
    (setq source-files (hfy-list-files srcdir))
    (mapcar (lambda (file)
	      (hfy-copy-and-fontify-file srcdir dstdir file)) source-files)
    (hfy-subtract-maps srcdir)
    (hfy-save-kill-buffers (hfy-prepare-index   srcdir dstdir) dstdir)
    (hfy-save-kill-buffers (hfy-prepare-tag-map srcdir dstdir) dstdir)
    )
  )

;; name of the init file we want:
(defun hfy-initfile ()
  (let* ((file (or (getenv "HFY_INITFILE") ".hfy.el")))
    (expand-file-name file "~") ))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; incomplete as yet : transfer hook settings to hfy init file:
;; (defalias 'hfy-set-hooks 'custom-set-variables)

;; (defun hfy-pp-hook (H)
;;   (and (string-match "-hook$" (symbol-name H))
;;        (boundp H)
;;        (symbol-value H)
;;        (insert (format "\n '(%S %S)" H (symbol-value H)))
;;        )
;;   )

;; (defun hfy-save-hooks ()
;;   (let ((custom-file (hfy-initfile)))
;;     (custom-save-delete 'hfy-set-hooks)
;;     (let ((standard-output (current-buffer)))
;;       (princ "(hfy-set-hooks\n;;auto-generated, only one copy allowed\n")
;;       (mapatoms 'hfy-pp-hook)
;;       (insert "\n)")
;;       )
;;     )
;;   )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defalias 'hfy-init-progn 'progn)

(defun hfy-save-initvar (sym)
  (princ (format "(setq %s\n '" sym))
  (pp    (symbol-value sym))
  (princ ")\n")
  )

(defun htmlfontify-save-initfile ()
  (interactive)
  (let* ((start-pos       nil)
	 (custom-file     (hfy-initfile))
	 (standard-output (find-file-noselect custom-file 'nowarn)))
    (save-excursion
      (custom-save-delete 'hfy-init-progn)
      (setq start-pos (point))
      (princ "(hfy-init-progn\n;;auto-generated, only one copy allowed\n")
      (mapcar 'hfy-save-initvar
	      (list 'auto-mode-alist 'interpreter-mode-alist))
      (princ ")\n")
      (indent-region start-pos (point) nil)
      )
    (custom-save-all)
    )
  )

(defun htmlfontify-load-initfile ()
  (interactive)
  (let ((file (hfy-initfile)))
    (load file 'NOERROR nil nil)
    ) 
  )

(provide 'htmlfontify)

;; TLF
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this is for part of the build system for rtfm.etla.org: 
;; it's not really part of htmlfontify-buffer - but it's an example
;; of how to use it:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if t nil
  (defun rtfm-build-page-header (file style)
    (format "#define  TEMPLATE red+black.html
#define  DEBUG    1
#include <build/menu-dirlist|>\n
html-css-url := /css/red+black.css
title        := rtfm.etla.org ( %s / src/%s )
bodytag      := 
head         <=STYLESHEET;\n
%s
STYLESHEET
main-title   := rtfm / %s / src/%s\n
main-content <=MAIN_CONTENT;\n" rtfm-section file style rtfm-section file))
  
  (defun rtfm-build-page-footer (file) "\nMAIN_CONTENT\n")

  (defun rtfm-build-source-docs (section srcdir destdir)
    (interactive
     "s section[eg- emacs / p4-blame]:\nD source-dir: \nD output-dir: ")
    (require 'htmlfontify)
    (hfy-load-tags-cache srcdir)
    (let ((hfy-page-header  'rtfm-build-page-header)
	  (hfy-page-footer  'rtfm-build-page-footer)
	  (rtfm-section                     section)
	  (hfy-index-file                   "index"))
      (htmlfontify-run-etags srcdir)
      (htmlfontify-copy-and-link-dir srcdir destdir ".src" ".html")))
  )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
EOF

if test $INFILE = "-"; then
  INFILE=$TMPDIR/in
  cat /dev/fd/0 > $INFILE
fi

emacs -batch -l $TMPDIR/hfy-cmap.el -l $TMPDIR/htmlfontify.el --eval "(let ((hfy-page-header (lambda(a b) \"\")) (hfy-page-footer (lambda(a) \"\"))) (find-file \"$INFILE\") ($LANGUAGE-mode) (set-buffer (htmlfontify-buffer)) (set-visited-file-name \"$TMPDIR/out\") (save-buffer))" > /dev/null 2>&1
cat $TMPDIR/out
rm -rf $TMPDIR