# HG changeset patch # User Stefan Monnier # Date 1258662061 0 # Node ID 10d66efa4c618e0f6480bebba6a73dc6252d0f9e # Parent 805f90cb413e8801b26624648225260174c614a2 New files. diff -r 805f90cb413e -r 10d66efa4c61 lisp/ChangeLog --- a/lisp/ChangeLog Thu Nov 19 17:40:14 2009 +0000 +++ b/lisp/ChangeLog Thu Nov 19 20:21:01 2009 +0000 @@ -1,3 +1,7 @@ +2009-11-19 Vivek Dasmohapatra + + * htmlfontify.el, hfy-cmap.el: New files. + 2009-11-19 Juri Linkov * minibuffer.el (completions-format): New defcustom. @@ -25,8 +29,8 @@ 2009-11-19 Michael Albinus - * net/tramp.el (tramp-do-copy-or-rename-file-out-of-band): Set - variables for computing the prompt for reading password. + * net/tramp.el (tramp-do-copy-or-rename-file-out-of-band): + Set variables for computing the prompt for reading password. 2009-11-19 Glenn Morris diff -r 805f90cb413e -r 10d66efa4c61 lisp/hfy-cmap.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/hfy-cmap.el Thu Nov 19 20:21:01 2009 +0000 @@ -0,0 +1,854 @@ +;;; hfy-cmap.el --- Fallback colour name -> rgb mapping for `htmlfontify' + +;; Copyright (C) 2002, 2003, 2009 Free Software Foundation, Inc. + +;; Emacs Lisp Archive Entry +;; Package: htmlfontify +;; Filename: hfy-cmap.el +;; Version: 0.20 +;; Keywords: colour, rgb +;; Author: Vivek Dasmohapatra +;; Maintainer: Vivek Dasmohapatra +;; 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 file is part of GNU Emacs. + +;; GNU Emacs 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 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;;; Code: + +(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 is not specified. +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) +;;; hfy-cmap.el ends here + diff -r 805f90cb413e -r 10d66efa4c61 lisp/htmlfontify.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/htmlfontify.el Thu Nov 19 20:21:01 2009 +0000 @@ -0,0 +1,2374 @@ +;;; htmlfontify.el --- htmlise a buffer/source tree with optional hyperlinks + +;; Copyright (C) 2002, 2003, 2009 Free Software Foundation, Inc. + +;; Emacs Lisp Archive Entry +;; Package: htmlfontify +;; Filename: htmlfontify.el +;; Version: 0.21 +;; Keywords: html, hypermedia, markup, etags +;; Author: Vivek Dasmohapatra +;; Maintainer: Vivek Dasmohapatra +;; Created: 2002-01-05 +;; Description: htmlise a buffer/source tree with optional hyperlinks +;; URL: http://rtfm.etla.org/emacs/htmlfontify/ +;; Compatibility: Emacs23, Emacs22 +;; Incompatibility: Emacs19, Emacs20, Emacs21 +;; Last Updated: Thu 2009-11-19 01:31:21 +0000 + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; I have made some changes to make it work for Emacs 22. A lot of +;; small bug fixes related to the format of text and overlay +;; properties (which might have changed since the beginning of 2003 +;; when this file was originally written). +;; +;; The function `hfy-face-at' currently carries much of the burden of +;; my lacking understanding of the formats mentioned above and should +;; need some knowledgeable help. +;; +;; Another thing that maybe could be fixed is that overlay background +;; colors which are now only seen where there is text (in the XHTML +;; output). A bit of CSS tweaking is necessary there. +;; +;; The face 'default has a value :background "SystemWindow" for the +;; background color. There is no explicit notion that this should be +;; considered transparent, but I have assumed that it could be handled +;; like if it was here. (I am unsure that background and foreground +;; priorities are handled ok, but it looks ok in my tests now.) +;; +;; 2007-12-27 Lennart Borgman +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; 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) + +;;; History: +;; Changes: moved to changelog (CHANGES) file. + +;;; Code: +(eval-when-compile (require 'cl)) +(require 'faces) +;; (`facep' `face-attr-construct' `x-color-values' `color-values' `face-name') +(require 'custom) +;; (`defgroup' `defcustom') +(require 'font-lock) +;; (`font-lock-fontify-region') +(require 'cus-edit) + +(eval-and-compile + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; 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.21) + +(defconst hfy-meta-tags + (format "" + emacs-version htmlfontify-version) + "The 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. +\nInteractive 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 \\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 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 \'\n")) + (funcall hfy-page-header file stylesheet))) + +(defconst hfy-javascript " + \n") + +;; 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 CHAR-STRING 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))) )) )) + +;; Borrowed from font-lock.el +(defmacro hfy-save-buffer-state (varlist &rest body) + "Bind variables according to VARLIST and eval BODY restoring buffer state. +Do not record undo information during evaluation of BODY." + (declare (indent 1) (debug let)) + (let ((modified (make-symbol "modified"))) + `(let* ,(append varlist + `((,modified (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t) + (inhibit-point-motion-hooks t) + (inhibit-modification-hooks t) + deactivate-mark + buffer-file-name + buffer-file-truename)) + (progn + ,@body) + (unless ,modified + (restore-buffer-modified-p nil))))) + +(defun hfy-mark-trailing-whitespace () + "Tag trailing whitespace with a hfy property if it is currently highlighted." + (when show-trailing-whitespace + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (hfy-save-buffer-state nil + (while (re-search-forward "[ \t]+$" nil t) + (put-text-property (match-beginning 0) (match-end 0) + 'hfy-show-trailing-whitespace t))))))) + +(defun hfy-unmark-trailing-whitespace () + "Undo the effect of `hfy-mark-trailing-whitespace'." + (when show-trailing-whitespace + (hfy-save-buffer-state nil + (remove-text-properties (point-min) (point-max) + '(hfy-show-trailing-whitespace))))) + +(defun hfy-fontify-buffer (&optional srcdir file) + "Implement the guts of `htmlfontify-buffer'. +SRCDIR, if set, is the directory being htmlfontified. +FILE, if set, is the file name." + (if srcdir (setq srcdir (directory-file-name srcdir))) + (let* ( (in-style nil) + (invis-buttons nil) + (orig-buffer (current-buffer)) + (html-buffer (hfy-buffer)) + (css-sheet nil) + (css-map nil) + (invis-ranges nil) + (rovl nil) + (orig-ovls (overlays-in (point-min) (point-max))) + (rmin (when mark-active (region-beginning))) + (rmax (when mark-active (region-end ))) ) + (when (and mark-active + transient-mark-mode) + (unless (and (= rmin (point-min)) + (= rmax (point-max))) + (setq rovl (make-overlay rmin rmax)) + (overlay-put rovl 'priority 1000) + (overlay-put rovl 'face 'region))) + ;; copy the buffer, including fontification, and switch to it: + (hfy-mark-trailing-whitespace) + (setq css-sheet (hfy-compile-stylesheet ) + css-map (hfy-compile-face-map ) + invis-ranges (hfy-find-invisible-ranges)) + (hfy-unmark-trailing-whitespace) + (when rovl + (delete-overlay rovl)) + (copy-to-buffer html-buffer (point-min) (point-max)) + (set-buffer html-buffer) + ;; Apply overlay invisible spec + (setq orig-ovls + (sort orig-ovls + (lambda (A B) + (> (or (cadr (memq 'priority (overlay-properties A))) 0) + (or (cadr (memq 'priority (overlay-properties B))) 0))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; at this point, html-buffer retains the fontification of the parent: + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; we don't really need or want text in the html buffer to be invisible, as + ;; that can make it look like we've rendered invalid xhtml when all that's + ;; happened is some tags are in the invisible portions of the buffer: + (setq buffer-invisibility-spec nil) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; ##################################################################### + ;; 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 + ;; + ;; texta... + ;; + ;; instead of: + ;; + ;; texta... + ;; + ;; 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") + (message "invis-ranges:\n%S" invis-ranges) + (mapc + (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) + (insert "") + (if (not (and srcdir file)) + nil + (when move-link + (remove-text-properties (point) (1+ (point)) '(hfy-endl nil)) + (put-text-property pt (1+ pt) 'hfy-endl t) )) + ;; if we have invisible blocks, we need to do some extra magic: + (if invis-ranges + (let ((iname (hfy-invisible-name pt invis-ranges)) + (fname (hfy-lookup fn css-sheet ))) + (when (assq pt invis-ranges) + (insert + (format "" iname)) + (insert "…")) + (insert + (format "" fname iname pt))) + (insert (format "" (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) + ;; ##################################################################### + ;; Invisibility + ;; Maybe just make the text invisible in XHTML? + ;; DONE -- big block of obsolete invisibility code elided here -- v + ;; ##################################################################### + ;; (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 ""))))) + ;; 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 "" rr))) + (insert (format "" pr)) + (setq lp 'hfy-endl)) + ((eq lp 'hfy-endl) + (insert "") (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)) + (insert hfy-javascript) + (if (hfy-opt 'div-wrapper) (insert "
")) + (insert "\n
")
+    (goto-char (point-max))
+    (insert "
\n") + (if (hfy-opt 'div-wrapper) (insert "
")) + ;;(message "inserting footer") + (insert (funcall hfy-page-footer file)) + ;; call any post html-generation hooks: + (run-hooks 'hfy-post-html-hooks) + ;; return the html buffer + (set-buffer-modified-p nil) + html-buffer)) + +(defun hfy-force-fontification () + "Try to force font-locking even when it is optimised away." + (mapc (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) + (when (and font-lock-defaults + font-lock-mode) + (font-lock-fontify-region (point-min) (point-max) nil))) + (message "hfy batch mode (%s:%S)" + (or (buffer-file-name) (buffer-name)) major-mode) + (when font-lock-defaults + (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. + +Dangerous characters in the existing buffer are turned into html +entities, so you should even be able to do html-within-html +fontified display. + +You should, however, note that random control or eight-bit +characters such as ^L (\x0c) or ¤ (\xa4) won't get mapped yet. + +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) + ;; 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)))) ) + + (if (not (hfy-opt 'skip-refontification)) + (save-excursion ;; Keep region + (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 FILE, +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)) )) + +;; 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 \(a filename\)\). +START is the offset at which to start looking for the / character in FILE." + ;;(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 i THIS-FILE: +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." + (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\"). +SRCDIR is the directory being \"published\". +FILE is the specific file we are rendering." + ;;(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 (line-number-at-pos) + 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 () + "Return `shell-file-name', or \"/bin/sh\" if it is a non-bourne shell." + (if (string-match "\\\\|\\\\|\\" 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 (round (string-to-number (match-string 2)))) + (setq tag-point (round (string-to-number (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'. +FILENAME is the name of the file being indexed. +DSTDIR is the output directory, where files will be written." + ;;(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 "")) + (insert "\n") + + (mapc + (lambda (TAG) + (let ((tag-started nil)) + (mapc + (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 + " \n" + " \n" + " \n" + " \n" + " \n") + (if (string= TAG tag-started) " " + (format "%s" 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 "
%s%s%d
\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'. +SRCDIR and DSTDIR are the source and output directories respectively." + (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 +SRCDIR and DSTDIR are the source and output directories respectively. +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. +SRCDIR is the directory being \"published\". +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. +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)) + (mapc (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 () + "Return the expected location of the htmlfontify specific init/custom file." + (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 () + "Save the htmlfontify settings to the htmlfontify init file." + (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") + (mapc '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 () + "Load the htmlfontify specific init/custom file." + (interactive) + (let ((file (hfy-initfile))) + (load file 'NOERROR nil nil) )) + +(provide 'htmlfontify) +;;; htmlfontify.el ends here +