Browse Source

* Added chm components from andrew haines

git-svn-id: trunk@8061 -
michael 18 years ago
parent
commit
6ce1a04ab7

+ 18 - 0
.gitattributes

@@ -1953,6 +1953,24 @@ packages/extra/cdrom/scsidefs.pp svneol=native#text/plain
 packages/extra/cdrom/showcds.pp svneol=native#text/plain
 packages/extra/cdrom/wincd.pp svneol=native#text/plain
 packages/extra/cdrom/wnaspi32.pp svneol=native#text/plain
+packages/extra/chm/Makefile svneol=native#text/plain
+packages/extra/chm/Makefile.fpc svneol=native#text/plain
+packages/extra/chm/chmbase.pas svneol=native#text/plain
+packages/extra/chm/chmcmd.lpi svneol=native#text/plain
+packages/extra/chm/chmcmd.lpr svneol=native#text/plain
+packages/extra/chm/chmfilewriter.pas svneol=native#text/plain
+packages/extra/chm/chmls.lpi svneol=native#text/plain
+packages/extra/chm/chmls.lpr svneol=native#text/plain
+packages/extra/chm/chmreader.pas svneol=native#text/plain
+packages/extra/chm/chmsitemap.pas svneol=native#text/plain
+packages/extra/chm/chmspecialfiles.pas svneol=native#text/plain
+packages/extra/chm/chmtypes.pas svneol=native#text/plain
+packages/extra/chm/chmwriter.pas svneol=native#text/plain
+packages/extra/chm/fasthtmlparser.pas svneol=native#text/plain
+packages/extra/chm/htmlutil.pas svneol=native#text/plain
+packages/extra/chm/paslznonslide.pas svneol=native#text/plain
+packages/extra/chm/paslzx.pas svneol=native#text/plain
+packages/extra/chm/paslzxcomp.pas svneol=native#text/plain
 packages/extra/dts/Makefile svneol=native#text/plain
 packages/extra/dts/Makefile.fpc svneol=native#text/plain
 packages/extra/dts/dts.pas svneol=native#text/plain

+ 223 - 36
packages/extra/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/05/31]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/04/28]
 #
 default: all
 MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded
@@ -231,106 +231,160 @@ UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
 endif
 PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
 ifeq ($(FULL_TARGET),i386-linux)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil lua
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil lua
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
-override TARGET_DIRS+=unzip
+override TARGET_DIRS+=chm  unzip
 endif
 ifeq ($(FULL_TARGET),i386-win32)
-override TARGET_DIRS+=unzip opengl gtk gtk2 zlib tcl cdrom fpgtk fftw mad openal oggvorbis a52 libpng openssl pcap sdl lua lua
+override TARGET_DIRS+=chm  unzip opengl gtk gtk2 zlib tcl cdrom fpgtk fftw mad openal oggvorbis a52 libpng openssl pcap sdl lua lua
 endif
 ifeq ($(FULL_TARGET),i386-os2)
-override TARGET_DIRS+=os2units rexx unzip zlib x11 gtk libpng tcl imlib fpgtk
+override TARGET_DIRS+=chm  os2units rexx unzip zlib x11 gtk libpng tcl imlib fpgtk
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+endif
+ifeq ($(FULL_TARGET),i386-beos)
+override TARGET_DIRS+=chm
 endif
 ifeq ($(FULL_TARGET),i386-netbsd)
-override TARGET_DIRS+=unzip zlib x11 opengl gtk syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+override TARGET_DIRS+=chm  unzip zlib x11 opengl gtk syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+endif
+ifeq ($(FULL_TARGET),i386-qnx)
+override TARGET_DIRS+=chm
 endif
 ifeq ($(FULL_TARGET),i386-netware)
-override TARGET_DIRS+=unzip zlib
+override TARGET_DIRS+=chm  unzip zlib
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
-override TARGET_DIRS+=unzip zlib x11 opengl gtk syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+override TARGET_DIRS+=chm  unzip zlib x11 opengl gtk syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+override TARGET_DIRS+=chm
 endif
 ifeq ($(FULL_TARGET),i386-darwin)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl libcurl cairo univint sdl
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl libcurl cairo univint sdl
 endif
 ifeq ($(FULL_TARGET),i386-emx)
-override TARGET_DIRS+=os2units rexx unzip zlib x11 gtk libpng tcl imlib fpgtk
+override TARGET_DIRS+=chm  os2units rexx unzip zlib x11 gtk libpng tcl imlib fpgtk
+endif
+ifeq ($(FULL_TARGET),i386-watcom)
+override TARGET_DIRS+=chm
 endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
-override TARGET_DIRS+=unzip zlib
+override TARGET_DIRS+=chm  unzip zlib
 endif
 ifeq ($(FULL_TARGET),i386-wince)
-override TARGET_DIRS+=unzip zlib tcl fftw
+override TARGET_DIRS+=chm  unzip zlib tcl fftw
+endif
+ifeq ($(FULL_TARGET),i386-embedded)
+override TARGET_DIRS+=chm
+endif
+ifeq ($(FULL_TARGET),i386-symbian)
+override TARGET_DIRS+=chm
 endif
 ifeq ($(FULL_TARGET),m68k-linux)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
-override TARGET_DIRS+=unzip zlib x11 opengl gtk syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+override TARGET_DIRS+=chm  unzip zlib x11 opengl gtk syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
-override TARGET_DIRS+=amunits
+override TARGET_DIRS+=chm  amunits
+endif
+ifeq ($(FULL_TARGET),m68k-atari)
+override TARGET_DIRS+=chm
 endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
-override TARGET_DIRS+=unzip zlib x11 opengl gtk syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+override TARGET_DIRS+=chm  unzip zlib x11 opengl gtk syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
-override TARGET_DIRS+=palmunits
+override TARGET_DIRS+=chm  palmunits
+endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+override TARGET_DIRS+=chm
 endif
 ifeq ($(FULL_TARGET),powerpc-linux)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
-override TARGET_DIRS+=unzip zlib x11 opengl gtk syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+override TARGET_DIRS+=chm  unzip zlib x11 opengl gtk syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
-override TARGET_DIRS+=amunits
+override TARGET_DIRS+=chm  amunits
+endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+override TARGET_DIRS+=chm
 endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl libcurl cairo univint sdl
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl libcurl cairo univint sdl
+endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+override TARGET_DIRS+=chm
+endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+override TARGET_DIRS+=chm
 endif
 ifeq ($(FULL_TARGET),sparc-linux)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
-override TARGET_DIRS+=unzip zlib x11 opengl gtk syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+override TARGET_DIRS+=chm  unzip zlib x11 opengl gtk syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+override TARGET_DIRS+=chm
 endif
 ifeq ($(FULL_TARGET),x86_64-linux)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl pcap libcurl cairo sdl
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
-override TARGET_DIRS+=unzip opengl gtk gtk2 zlib tcl cdrom fpgtk fftw openssl sdl
+override TARGET_DIRS+=chm  unzip opengl gtk gtk2 zlib tcl cdrom fpgtk fftw openssl sdl
+endif
+ifeq ($(FULL_TARGET),x86_64-embedded)
+override TARGET_DIRS+=chm
 endif
 ifeq ($(FULL_TARGET),arm-linux)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
-override TARGET_DIRS+=palmunits
+override TARGET_DIRS+=chm  palmunits
 endif
 ifeq ($(FULL_TARGET),arm-wince)
-override TARGET_DIRS+=unzip zlib tcl fftw
+override TARGET_DIRS+=chm  unzip zlib tcl fftw
+endif
+ifeq ($(FULL_TARGET),arm-gba)
+override TARGET_DIRS+=chm
+endif
+ifeq ($(FULL_TARGET),arm-nds)
+override TARGET_DIRS+=chm
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+override TARGET_DIRS+=chm
+endif
+ifeq ($(FULL_TARGET),arm-symbian)
+override TARGET_DIRS+=chm
 endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms svgalib ggi libpng libgd utmp bfd gdbm ncurses tcl cdrom imlib gnome1 fpgtk newt uuid ldap openal mad oggvorbis a52 modplug dts openssl pcap libcurl cairo sdl unixutil
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
-override TARGET_DIRS+=unzip zlib fftw x11 opengl gtk gtk2 syslog forms libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl libcurl cairo
+override TARGET_DIRS+=chm  unzip zlib fftw x11 opengl gtk gtk2 syslog forms libpng libgd utmp bfd gdbm ncurses fpgtk tcl imlib gnome1 openssl libcurl cairo
+endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+override TARGET_DIRS+=chm
 endif
 override INSTALL_FPCPACKAGE=y
 override INSTALL_FPCSUBDIR=packages/extra
@@ -1095,7 +1149,7 @@ override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
 endif
 ifndef CROSSBOOTSTRAP
 ifneq ($(BINUTILSPREFIX),)
-override FPCOPT+=-XP$(BINUTILSPREFIX) 
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
 endif
 ifneq ($(BINUTILSPREFIX),)
 override FPCOPT+=-Xr$(RLINKPATH)
@@ -1408,6 +1462,7 @@ fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIR
 fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
 fpc_makefiles: fpc_makefile fpc_makefile_dirs
 ifeq ($(FULL_TARGET),i386-linux)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -1448,9 +1503,11 @@ TARGET_DIRS_UNIXUTIL=1
 TARGET_DIRS_LUA=1
 endif
 ifeq ($(FULL_TARGET),i386-go32v2)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 endif
 ifeq ($(FULL_TARGET),i386-win32)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_OPENGL=1
 TARGET_DIRS_GTK=1
@@ -1472,6 +1529,7 @@ TARGET_DIRS_LUA=1
 TARGET_DIRS_LUA=1
 endif
 ifeq ($(FULL_TARGET),i386-os2)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_OS2UNITS=1
 TARGET_DIRS_REXX=1
 TARGET_DIRS_UNZIP=1
@@ -1484,6 +1542,7 @@ TARGET_DIRS_IMLIB=1
 TARGET_DIRS_FPGTK=1
 endif
 ifeq ($(FULL_TARGET),i386-freebsd)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -1511,7 +1570,11 @@ TARGET_DIRS_LIBCURL=1
 TARGET_DIRS_CAIRO=1
 TARGET_DIRS_SDL=1
 endif
+ifeq ($(FULL_TARGET),i386-beos)
+TARGET_DIRS_CHM=1
+endif
 ifeq ($(FULL_TARGET),i386-netbsd)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_X11=1
@@ -1538,6 +1601,7 @@ TARGET_DIRS_CAIRO=1
 TARGET_DIRS_SDL=1
 endif
 ifeq ($(FULL_TARGET),i386-solaris)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -1565,11 +1629,16 @@ TARGET_DIRS_LIBCURL=1
 TARGET_DIRS_CAIRO=1
 TARGET_DIRS_SDL=1
 endif
+ifeq ($(FULL_TARGET),i386-qnx)
+TARGET_DIRS_CHM=1
+endif
 ifeq ($(FULL_TARGET),i386-netware)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 endif
 ifeq ($(FULL_TARGET),i386-openbsd)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_X11=1
@@ -1595,7 +1664,11 @@ TARGET_DIRS_LIBCURL=1
 TARGET_DIRS_CAIRO=1
 TARGET_DIRS_SDL=1
 endif
+ifeq ($(FULL_TARGET),i386-wdosx)
+TARGET_DIRS_CHM=1
+endif
 ifeq ($(FULL_TARGET),i386-darwin)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -1622,6 +1695,7 @@ TARGET_DIRS_UNIVINT=1
 TARGET_DIRS_SDL=1
 endif
 ifeq ($(FULL_TARGET),i386-emx)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_OS2UNITS=1
 TARGET_DIRS_REXX=1
 TARGET_DIRS_UNZIP=1
@@ -1633,17 +1707,29 @@ TARGET_DIRS_TCL=1
 TARGET_DIRS_IMLIB=1
 TARGET_DIRS_FPGTK=1
 endif
+ifeq ($(FULL_TARGET),i386-watcom)
+TARGET_DIRS_CHM=1
+endif
 ifeq ($(FULL_TARGET),i386-netwlibc)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 endif
 ifeq ($(FULL_TARGET),i386-wince)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_TCL=1
 TARGET_DIRS_FFTW=1
 endif
+ifeq ($(FULL_TARGET),i386-embedded)
+TARGET_DIRS_CHM=1
+endif
+ifeq ($(FULL_TARGET),i386-symbian)
+TARGET_DIRS_CHM=1
+endif
 ifeq ($(FULL_TARGET),m68k-linux)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -1683,6 +1769,7 @@ TARGET_DIRS_SDL=1
 TARGET_DIRS_UNIXUTIL=1
 endif
 ifeq ($(FULL_TARGET),m68k-freebsd)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -1711,6 +1798,7 @@ TARGET_DIRS_CAIRO=1
 TARGET_DIRS_SDL=1
 endif
 ifeq ($(FULL_TARGET),m68k-netbsd)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_X11=1
@@ -1737,9 +1825,14 @@ TARGET_DIRS_CAIRO=1
 TARGET_DIRS_SDL=1
 endif
 ifeq ($(FULL_TARGET),m68k-amiga)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_AMUNITS=1
 endif
+ifeq ($(FULL_TARGET),m68k-atari)
+TARGET_DIRS_CHM=1
+endif
 ifeq ($(FULL_TARGET),m68k-openbsd)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_X11=1
@@ -1766,9 +1859,14 @@ TARGET_DIRS_CAIRO=1
 TARGET_DIRS_SDL=1
 endif
 ifeq ($(FULL_TARGET),m68k-palmos)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_PALMUNITS=1
 endif
+ifeq ($(FULL_TARGET),m68k-embedded)
+TARGET_DIRS_CHM=1
+endif
 ifeq ($(FULL_TARGET),powerpc-linux)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -1808,6 +1906,7 @@ TARGET_DIRS_SDL=1
 TARGET_DIRS_UNIXUTIL=1
 endif
 ifeq ($(FULL_TARGET),powerpc-netbsd)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_X11=1
@@ -1834,9 +1933,14 @@ TARGET_DIRS_CAIRO=1
 TARGET_DIRS_SDL=1
 endif
 ifeq ($(FULL_TARGET),powerpc-amiga)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_AMUNITS=1
 endif
+ifeq ($(FULL_TARGET),powerpc-macos)
+TARGET_DIRS_CHM=1
+endif
 ifeq ($(FULL_TARGET),powerpc-darwin)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -1862,7 +1966,14 @@ TARGET_DIRS_CAIRO=1
 TARGET_DIRS_UNIVINT=1
 TARGET_DIRS_SDL=1
 endif
+ifeq ($(FULL_TARGET),powerpc-morphos)
+TARGET_DIRS_CHM=1
+endif
+ifeq ($(FULL_TARGET),powerpc-embedded)
+TARGET_DIRS_CHM=1
+endif
 ifeq ($(FULL_TARGET),sparc-linux)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -1902,6 +2013,7 @@ TARGET_DIRS_SDL=1
 TARGET_DIRS_UNIXUTIL=1
 endif
 ifeq ($(FULL_TARGET),sparc-netbsd)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_X11=1
@@ -1928,6 +2040,7 @@ TARGET_DIRS_CAIRO=1
 TARGET_DIRS_SDL=1
 endif
 ifeq ($(FULL_TARGET),sparc-solaris)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -1955,7 +2068,11 @@ TARGET_DIRS_LIBCURL=1
 TARGET_DIRS_CAIRO=1
 TARGET_DIRS_SDL=1
 endif
+ifeq ($(FULL_TARGET),sparc-embedded)
+TARGET_DIRS_CHM=1
+endif
 ifeq ($(FULL_TARGET),x86_64-linux)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -1995,6 +2112,7 @@ TARGET_DIRS_SDL=1
 TARGET_DIRS_UNIXUTIL=1
 endif
 ifeq ($(FULL_TARGET),x86_64-freebsd)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -2023,6 +2141,7 @@ TARGET_DIRS_CAIRO=1
 TARGET_DIRS_SDL=1
 endif
 ifeq ($(FULL_TARGET),x86_64-win64)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_OPENGL=1
 TARGET_DIRS_GTK=1
@@ -2035,7 +2154,11 @@ TARGET_DIRS_FFTW=1
 TARGET_DIRS_OPENSSL=1
 TARGET_DIRS_SDL=1
 endif
+ifeq ($(FULL_TARGET),x86_64-embedded)
+TARGET_DIRS_CHM=1
+endif
 ifeq ($(FULL_TARGET),arm-linux)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -2075,15 +2198,30 @@ TARGET_DIRS_SDL=1
 TARGET_DIRS_UNIXUTIL=1
 endif
 ifeq ($(FULL_TARGET),arm-palmos)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_PALMUNITS=1
 endif
 ifeq ($(FULL_TARGET),arm-wince)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_TCL=1
 TARGET_DIRS_FFTW=1
 endif
+ifeq ($(FULL_TARGET),arm-gba)
+TARGET_DIRS_CHM=1
+endif
+ifeq ($(FULL_TARGET),arm-nds)
+TARGET_DIRS_CHM=1
+endif
+ifeq ($(FULL_TARGET),arm-embedded)
+TARGET_DIRS_CHM=1
+endif
+ifeq ($(FULL_TARGET),arm-symbian)
+TARGET_DIRS_CHM=1
+endif
 ifeq ($(FULL_TARGET),powerpc64-linux)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -2123,6 +2261,7 @@ TARGET_DIRS_SDL=1
 TARGET_DIRS_UNIXUTIL=1
 endif
 ifeq ($(FULL_TARGET),powerpc64-darwin)
+TARGET_DIRS_CHM=1
 TARGET_DIRS_UNZIP=1
 TARGET_DIRS_ZLIB=1
 TARGET_DIRS_FFTW=1
@@ -2146,6 +2285,54 @@ TARGET_DIRS_OPENSSL=1
 TARGET_DIRS_LIBCURL=1
 TARGET_DIRS_CAIRO=1
 endif
+ifeq ($(FULL_TARGET),powerpc64-embedded)
+TARGET_DIRS_CHM=1
+endif
+ifdef TARGET_DIRS_CHM
+chm_all:
+	$(MAKE) -C chm all
+chm_debug:
+	$(MAKE) -C chm debug
+chm_smart:
+	$(MAKE) -C chm smart
+chm_release:
+	$(MAKE) -C chm release
+chm_units:
+	$(MAKE) -C chm units
+chm_examples:
+	$(MAKE) -C chm examples
+chm_shared:
+	$(MAKE) -C chm shared
+chm_install:
+	$(MAKE) -C chm install
+chm_sourceinstall:
+	$(MAKE) -C chm sourceinstall
+chm_exampleinstall:
+	$(MAKE) -C chm exampleinstall
+chm_distinstall:
+	$(MAKE) -C chm distinstall
+chm_zipinstall:
+	$(MAKE) -C chm zipinstall
+chm_zipsourceinstall:
+	$(MAKE) -C chm zipsourceinstall
+chm_zipexampleinstall:
+	$(MAKE) -C chm zipexampleinstall
+chm_zipdistinstall:
+	$(MAKE) -C chm zipdistinstall
+chm_clean:
+	$(MAKE) -C chm clean
+chm_distclean:
+	$(MAKE) -C chm distclean
+chm_cleanall:
+	$(MAKE) -C chm cleanall
+chm_info:
+	$(MAKE) -C chm info
+chm_makefiles:
+	$(MAKE) -C chm makefiles
+chm:
+	$(MAKE) -C chm all
+.PHONY: chm_all chm_debug chm_smart chm_release chm_units chm_examples chm_shared chm_install chm_sourceinstall chm_exampleinstall chm_distinstall chm_zipinstall chm_zipsourceinstall chm_zipexampleinstall chm_zipdistinstall chm_clean chm_distclean chm_cleanall chm_info chm_makefiles chm
+endif
 ifdef TARGET_DIRS_UNZIP
 unzip_all:
 	$(MAKE) -C unzip all

+ 1 - 0
packages/extra/Makefile.fpc

@@ -2,6 +2,7 @@
 #   Makefile.fpc for Free Pascal Packages
 #
 [target]
+dirs=chm
 dirs_linux=unzip zlib fftw \
            x11 opengl gtk gtk2 syslog \
            forms svgalib ggi libpng libgd \

+ 1621 - 0
packages/extra/chm/Makefile

@@ -0,0 +1,1621 @@
+#
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/04/28]
+#
+default: all
+MAKEFILETARGETS=x86_64-linux
+BSDs = freebsd netbsd openbsd darwin
+UNIXs = linux $(BSDs) solaris qnx
+LIMIT83fs = go32v2 os2 emx watcom
+FORCE:
+.PHONY: FORCE
+override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH)))
+ifneq ($(findstring darwin,$(OSTYPE)),)
+inUnix=1 #darwin
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+ifeq ($(findstring ;,$(PATH)),)
+inUnix=1
+SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
+else
+SEARCHPATH:=$(subst ;, ,$(PATH))
+endif
+endif
+SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
+PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
+ifeq ($(PWD),)
+PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
+ifeq ($(PWD),)
+$(error You need the GNU utils package to use this Makefile)
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=
+endif
+else
+PWD:=$(firstword $(PWD))
+SRCEXEEXT=.exe
+endif
+ifndef inUnix
+ifeq ($(OS),Windows_NT)
+inWinNT=1
+else
+ifdef OS2_SHELL
+inOS2=1
+endif
+endif
+else
+ifneq ($(findstring cygdrive,$(PATH)),)
+inCygWin=1
+endif
+endif
+ifdef inUnix
+SRCBATCHEXT=.sh
+else
+ifdef inOS2
+SRCBATCHEXT=.cmd
+else
+SRCBATCHEXT=.bat
+endif
+endif
+ifdef inUnix
+PATHSEP=/
+else
+PATHSEP:=$(subst /,\,/)
+ifdef inCygWin
+PATHSEP=/
+endif
+endif
+ifdef PWD
+BASEDIR:=$(subst \,/,$(shell $(PWD)))
+ifdef inCygWin
+ifneq ($(findstring /cygdrive/,$(BASEDIR)),)
+BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR))
+BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR)))
+BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR))
+endif
+endif
+else
+BASEDIR=.
+endif
+ifdef inOS2
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO=echo
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+endif
+override DEFAULT_FPCDIR=../../..
+ifndef FPC
+ifdef PP
+FPC=$(PP)
+endif
+endif
+ifndef FPC
+FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH))))
+ifneq ($(FPCPROG),)
+FPCPROG:=$(firstword $(FPCPROG))
+FPC:=$(shell $(FPCPROG) -PB)
+ifneq ($(findstring Error,$(FPC)),)
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+else
+override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH)))))
+endif
+endif
+override FPC:=$(subst $(SRCEXEEXT),,$(FPC))
+override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT)
+FOUNDFPC:=$(strip $(wildcard $(FPC)))
+ifeq ($(FOUNDFPC),)
+FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))
+ifeq ($(FOUNDFPC),)
+$(error Compiler $(FPC) not found)
+endif
+endif
+ifndef FPC_COMPILERINFO
+FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO)
+endif
+ifndef FPC_VERSION
+FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO))
+endif
+export FPC FPC_VERSION FPC_COMPILERINFO
+unexport CHECKDEPEND ALLDEPENDENCIES
+ifndef CPU_TARGET
+ifdef CPU_TARGET_DEFAULT
+CPU_TARGET=$(CPU_TARGET_DEFAULT)
+endif
+endif
+ifndef OS_TARGET
+ifdef OS_TARGET_DEFAULT
+OS_TARGET=$(OS_TARGET_DEFAULT)
+endif
+endif
+ifneq ($(words $(FPC_COMPILERINFO)),5)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTP)
+FPC_COMPILERINFO+=$(shell $(FPC) -iSO)
+FPC_COMPILERINFO+=$(shell $(FPC) -iTO)
+endif
+ifndef CPU_SOURCE
+CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO))
+endif
+ifndef CPU_TARGET
+CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO))
+endif
+ifndef OS_SOURCE
+OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO))
+endif
+ifndef OS_TARGET
+OS_TARGET:=$(word 5,$(FPC_COMPILERINFO))
+endif
+FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+TARGETSUFFIX=$(OS_TARGET)
+SOURCESUFFIX=$(OS_SOURCE)
+else
+TARGETSUFFIX=$(FULL_TARGET)
+SOURCESUFFIX=$(FULL_SOURCE)
+endif
+ifneq ($(FULL_TARGET),$(FULL_SOURCE))
+CROSSCOMPILE=1
+endif
+ifeq ($(findstring makefile,$(MAKECMDGOALS)),)
+ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),)
+$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first)
+endif
+endif
+ifneq ($(findstring $(OS_TARGET),$(BSDs)),)
+BSDhier=1
+endif
+ifeq ($(OS_TARGET),linux)
+linuxHier=1
+endif
+export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE
+ifdef FPCDIR
+override FPCDIR:=$(subst \,/,$(FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+else
+override FPCDIR=wrong
+endif
+ifdef DEFAULT_FPCDIR
+ifeq ($(FPCDIR),wrong)
+override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR))
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=wrong
+endif
+endif
+endif
+ifeq ($(FPCDIR),wrong)
+ifdef inUnix
+override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION)
+ifeq ($(wildcard $(FPCDIR)/units),)
+override FPCDIR=/usr/lib/fpc/$(FPC_VERSION)
+endif
+else
+override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH))))))
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(FPCDIR)/..
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR:=$(BASEDIR)
+ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),)
+override FPCDIR=c:/pp
+endif
+endif
+endif
+endif
+endif
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX))
+endif
+ifndef BINUTILSPREFIX
+ifndef CROSSBINDIR
+ifdef CROSSCOMPILE
+BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)-
+endif
+endif
+endif
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX))
+ifeq ($(UNITSDIR),)
+UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET))
+endif
+PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra)
+override PACKAGE_NAME=chm
+override PACKAGE_VERSION=2.0.0
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_PROGRAMS+=chmcmd chmls
+endif
+ifeq ($(FULL_TARGET),x86_64-linux)
+override TARGET_UNITS+=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader
+endif
+override INSTALL_FPCPACKAGE=y
+ifdef REQUIRE_UNITSDIR
+override UNITSDIR+=$(REQUIRE_UNITSDIR)
+endif
+ifdef REQUIRE_PACKAGESDIR
+override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR)
+endif
+ifdef ZIPINSTALL
+ifneq ($(findstring $(OS_TARGET),$(UNIXs)),)
+UNIXHier=1
+endif
+else
+ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),)
+UNIXHier=1
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef PREFIX
+INSTALL_PREFIX=$(PREFIX)
+endif
+endif
+ifndef INSTALL_PREFIX
+ifdef UNIXHier
+INSTALL_PREFIX=/usr/local
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=/pp
+else
+INSTALL_BASEDIR:=/$(PACKAGE_NAME)
+endif
+endif
+endif
+export INSTALL_PREFIX
+ifdef INSTALL_FPCSUBDIR
+export INSTALL_FPCSUBDIR
+endif
+ifndef DIST_DESTDIR
+DIST_DESTDIR:=$(BASEDIR)
+endif
+export DIST_DESTDIR
+ifndef COMPILER_UNITTARGETDIR
+ifdef PACKAGEDIR_MAIN
+COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX)
+else
+COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX)
+endif
+endif
+ifndef COMPILER_TARGETDIR
+COMPILER_TARGETDIR=.
+endif
+ifndef INSTALL_BASEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION)
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME)
+endif
+else
+INSTALL_BASEDIR:=$(INSTALL_PREFIX)
+endif
+endif
+ifndef INSTALL_BINDIR
+ifdef UNIXHier
+INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
+else
+INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
+ifdef INSTALL_FPCPACKAGE
+ifdef CROSSCOMPILE
+ifdef CROSSINSTALL
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX)
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+else
+INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX)
+endif
+endif
+endif
+endif
+ifndef INSTALL_UNITDIR
+INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX)
+ifdef INSTALL_FPCPACKAGE
+ifdef PACKAGE_NAME
+INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME)
+endif
+endif
+endif
+ifndef INSTALL_LIBDIR
+ifdef UNIXHier
+INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib
+else
+INSTALL_LIBDIR:=$(INSTALL_UNITDIR)
+endif
+endif
+ifndef INSTALL_SOURCEDIR
+ifdef UNIXHier
+ifdef BSDhier
+SRCPREFIXDIR=share/src
+else
+ifdef linuxHier
+SRCPREFIXDIR=share/src
+else
+SRCPREFIXDIR=src
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+ifdef INSTALL_FPCSUBDIR
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME)
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME)
+endif
+else
+INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source
+endif
+endif
+endif
+ifndef INSTALL_DOCDIR
+ifdef UNIXHier
+ifdef BSDhier
+DOCPREFIXDIR=share/doc
+else
+ifdef linuxHier
+DOCPREFIXDIR=share/doc
+else
+DOCPREFIXDIR=doc
+endif
+endif
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME)
+else
+INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc
+endif
+endif
+endif
+ifndef INSTALL_EXAMPLEDIR
+ifdef UNIXHier
+ifdef INSTALL_FPCPACKAGE
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME)
+endif
+endif
+else
+ifdef BSDhier
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+ifdef linuxHier
+INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION)
+endif
+endif
+endif
+else
+ifdef INSTALL_FPCPACKAGE
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME)
+else
+INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples
+endif
+endif
+endif
+ifndef INSTALL_DATADIR
+INSTALL_DATADIR=$(INSTALL_BASEDIR)
+endif
+ifndef INSTALL_SHAREDDIR
+INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib
+endif
+ifdef CROSSCOMPILE
+ifndef CROSSBINDIR
+CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX))
+ifeq ($(CROSSBINDIR),)
+CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE))
+endif
+endif
+else
+CROSSBINDIR=
+endif
+BATCHEXT=.bat
+LOADEREXT=.as
+EXEEXT=.exe
+PPLEXT=.ppl
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.so
+SHAREDLIBPREFIX=libfp
+STATICLIBPREFIX=libp
+IMPORTLIBPREFIX=libimp
+RSTEXT=.rst
+ifeq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),go32v1)
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+OEXT=.obj
+ASMEXT=.asm
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),emx)
+BATCHEXT=.cmd
+AOUTEXT=.out
+STATICLIBPREFIX=
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=emx
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),morphos)
+EXEEXT=
+SHAREDLIBEXT=.library
+SHORTSUFFIX=mos
+endif
+ifeq ($(OS_TARGET),atari)
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+EXEEXT=.nlm
+STATICLIBPREFIX=
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+ifeq ($(OS_TARGET),darwin)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=dwn
+endif
+ifeq ($(OS_TARGET),gba)
+EXEEXT=.gba
+SHAREDLIBEXT=.so
+SHORTSUFFIX=gba
+endif
+ifeq ($(OS_TARGET),symbian)
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=symbian
+endif
+else
+ifeq ($(OS_TARGET),go32v1)
+PPUEXT=.pp1
+OEXT=.o1
+ASMEXT=.s1
+SMARTEXT=.sl1
+STATICLIBEXT=.a1
+SHAREDLIBEXT=.so1
+STATICLIBPREFIX=
+SHORTSUFFIX=v1
+endif
+ifeq ($(OS_TARGET),go32v2)
+STATICLIBPREFIX=
+SHORTSUFFIX=dos
+endif
+ifeq ($(OS_TARGET),watcom)
+STATICLIBPREFIX=
+SHORTSUFFIX=wat
+endif
+ifeq ($(OS_TARGET),linux)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=lnx
+endif
+ifeq ($(OS_TARGET),freebsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=fbs
+endif
+ifeq ($(OS_TARGET),netbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=nbs
+endif
+ifeq ($(OS_TARGET),openbsd)
+BATCHEXT=.sh
+EXEEXT=
+HASSHAREDLIB=1
+SHORTSUFFIX=obs
+endif
+ifeq ($(OS_TARGET),win32)
+PPUEXT=.ppw
+OEXT=.ow
+ASMEXT=.sw
+SMARTEXT=.slw
+STATICLIBEXT=.aw
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=w32
+endif
+ifeq ($(OS_TARGET),os2)
+BATCHEXT=.cmd
+PPUEXT=.ppo
+ASMEXT=.so2
+OEXT=.oo2
+AOUTEXT=.out
+SMARTEXT=.sl2
+STATICLIBPREFIX=
+STATICLIBEXT=.ao2
+SHAREDLIBEXT=.dll
+SHORTSUFFIX=os2
+ECHO=echo
+endif
+ifeq ($(OS_TARGET),amiga)
+EXEEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.library
+SHORTSUFFIX=amg
+endif
+ifeq ($(OS_TARGET),atari)
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=.ttp
+SHORTSUFFIX=ata
+endif
+ifeq ($(OS_TARGET),beos)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=be
+endif
+ifeq ($(OS_TARGET),solaris)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=sun
+endif
+ifeq ($(OS_TARGET),qnx)
+BATCHEXT=.sh
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+SHORTSUFFIX=qnx
+endif
+ifeq ($(OS_TARGET),netware)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nw
+endif
+ifeq ($(OS_TARGET),netwlibc)
+STATICLIBPREFIX=
+PPUEXT=.ppu
+OEXT=.o
+ASMEXT=.s
+SMARTEXT=.sl
+STATICLIBEXT=.a
+SHAREDLIBEXT=.nlm
+EXEEXT=.nlm
+SHORTSUFFIX=nwl
+endif
+ifeq ($(OS_TARGET),macos)
+BATCHEXT=
+PPUEXT=.ppu
+ASMEXT=.s
+OEXT=.o
+SMARTEXT=.sl
+STATICLIBEXT=.a
+EXEEXT=
+DEBUGSYMEXT=.xcoff
+SHORTSUFFIX=mac
+endif
+endif
+ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),)
+FPCMADE=fpcmade.$(SHORTSUFFIX)
+ZIPSUFFIX=$(SHORTSUFFIX)
+ZIPCROSSPREFIX=
+ZIPSOURCESUFFIX=src
+ZIPEXAMPLESUFFIX=exm
+else
+FPCMADE=fpcmade.$(TARGETSUFFIX)
+ZIPSOURCESUFFIX=.source
+ZIPEXAMPLESUFFIX=.examples
+ifdef CROSSCOMPILE
+ZIPSUFFIX=.$(SOURCESUFFIX)
+ZIPCROSSPREFIX=$(TARGETSUFFIX)-
+else
+ZIPSUFFIX=.$(TARGETSUFFIX)
+ZIPCROSSPREFIX=
+endif
+endif
+ifndef ECHO
+ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ECHO),)
+ECHO= __missing_command_ECHO
+else
+ECHO:=$(firstword $(ECHO))
+endif
+else
+ECHO:=$(firstword $(ECHO))
+endif
+endif
+export ECHO
+ifndef DATE
+DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(DATE),)
+DATE= __missing_command_DATE
+else
+DATE:=$(firstword $(DATE))
+endif
+else
+DATE:=$(firstword $(DATE))
+endif
+endif
+export DATE
+ifndef GINSTALL
+GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(GINSTALL),)
+GINSTALL= __missing_command_GINSTALL
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+else
+GINSTALL:=$(firstword $(GINSTALL))
+endif
+endif
+export GINSTALL
+ifndef CPPROG
+CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(CPPROG),)
+CPPROG= __missing_command_CPPROG
+else
+CPPROG:=$(firstword $(CPPROG))
+endif
+endif
+export CPPROG
+ifndef RMPROG
+RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(RMPROG),)
+RMPROG= __missing_command_RMPROG
+else
+RMPROG:=$(firstword $(RMPROG))
+endif
+endif
+export RMPROG
+ifndef MVPROG
+MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MVPROG),)
+MVPROG= __missing_command_MVPROG
+else
+MVPROG:=$(firstword $(MVPROG))
+endif
+endif
+export MVPROG
+ifndef MKDIRPROG
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(MKDIRPROG),)
+MKDIRPROG= __missing_command_MKDIRPROG
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+else
+MKDIRPROG:=$(firstword $(MKDIRPROG))
+endif
+endif
+export MKDIRPROG
+ifndef ECHOREDIR
+ifndef inUnix
+ECHOREDIR=echo
+else
+ECHOREDIR=$(ECHO)
+endif
+endif
+ifndef COPY
+COPY:=$(CPPROG) -fp
+endif
+ifndef COPYTREE
+COPYTREE:=$(CPPROG) -Rfp
+endif
+ifndef MKDIRTREE
+MKDIRTREE:=$(MKDIRPROG) -p
+endif
+ifndef MOVE
+MOVE:=$(MVPROG) -f
+endif
+ifndef DEL
+DEL:=$(RMPROG) -f
+endif
+ifndef DELTREE
+DELTREE:=$(RMPROG) -rf
+endif
+ifndef INSTALL
+ifdef inUnix
+INSTALL:=$(GINSTALL) -c -m 644
+else
+INSTALL:=$(COPY)
+endif
+endif
+ifndef INSTALLEXE
+ifdef inUnix
+INSTALLEXE:=$(GINSTALL) -c -m 755
+else
+INSTALLEXE:=$(COPY)
+endif
+endif
+ifndef MKDIR
+MKDIR:=$(GINSTALL) -m 755 -d
+endif
+export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
+ifndef PPUMOVE
+PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(PPUMOVE),)
+PPUMOVE= __missing_command_PPUMOVE
+else
+PPUMOVE:=$(firstword $(PPUMOVE))
+endif
+endif
+export PPUMOVE
+ifndef FPCMAKE
+FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(FPCMAKE),)
+FPCMAKE= __missing_command_FPCMAKE
+else
+FPCMAKE:=$(firstword $(FPCMAKE))
+endif
+endif
+export FPCMAKE
+ifndef ZIPPROG
+ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(ZIPPROG),)
+ZIPPROG= __missing_command_ZIPPROG
+else
+ZIPPROG:=$(firstword $(ZIPPROG))
+endif
+endif
+export ZIPPROG
+ifndef TARPROG
+TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(TARPROG),)
+TARPROG= __missing_command_TARPROG
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+else
+TARPROG:=$(firstword $(TARPROG))
+endif
+endif
+export TARPROG
+ASNAME=$(BINUTILSPREFIX)as
+LDNAME=$(BINUTILSPREFIX)ld
+ARNAME=$(BINUTILSPREFIX)ar
+RCNAME=$(BINUTILSPREFIX)rc
+ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),win32)
+ifeq ($(CROSSBINDIR),)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
+endif
+endif
+endif
+ifndef ASPROG
+ifdef CROSSBINDIR
+ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT)
+else
+ASPROG=$(ASNAME)
+endif
+endif
+ifndef LDPROG
+ifdef CROSSBINDIR
+LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT)
+else
+LDPROG=$(LDNAME)
+endif
+endif
+ifndef RCPROG
+ifdef CROSSBINDIR
+RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT)
+else
+RCPROG=$(RCNAME)
+endif
+endif
+ifndef ARPROG
+ifdef CROSSBINDIR
+ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT)
+else
+ARPROG=$(ARNAME)
+endif
+endif
+AS=$(ASPROG)
+LD=$(LDPROG)
+RC=$(RCPROG)
+AR=$(ARPROG)
+PPAS=ppas$(SRCBATCHEXT)
+ifdef inUnix
+LDCONFIG=ldconfig
+else
+LDCONFIG=
+endif
+ifdef DATE
+DATESTR:=$(shell $(DATE) +%Y%m%d)
+else
+DATESTR=
+endif
+ifndef UPXPROG
+ifeq ($(OS_TARGET),go32v2)
+UPXPROG:=1
+endif
+ifeq ($(OS_TARGET),win32)
+UPXPROG:=1
+endif
+ifdef UPXPROG
+UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH))))
+ifeq ($(UPXPROG),)
+UPXPROG=
+else
+UPXPROG:=$(firstword $(UPXPROG))
+endif
+else
+UPXPROG=
+endif
+endif
+export UPXPROG
+ZIPOPT=-9
+ZIPEXT=.zip
+ifeq ($(USETAR),bz2)
+TAROPT=vj
+TAREXT=.tar.bz2
+else
+TAROPT=vz
+TAREXT=.tar.gz
+endif
+override REQUIRE_PACKAGES=rtl 
+ifeq ($(FULL_TARGET),x86_64-linux)
+REQUIRE_PACKAGES_RTL=1
+endif
+ifdef REQUIRE_PACKAGES_RTL
+PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
+ifneq ($(PACKAGEDIR_RTL),)
+ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),)
+UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)
+else
+UNITDIR_RTL=$(PACKAGEDIR_RTL)
+endif
+ifdef CHECKDEPEND
+$(PACKAGEDIR_RTL)/$(FPCMADE):
+	$(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE)
+override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE)
+endif
+else
+PACKAGEDIR_RTL=
+UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR)))))
+ifneq ($(UNITDIR_RTL),)
+UNITDIR_RTL:=$(firstword $(UNITDIR_RTL))
+else
+UNITDIR_RTL=
+endif
+endif
+ifdef UNITDIR_RTL
+override COMPILER_UNITDIR+=$(UNITDIR_RTL)
+endif
+endif
+ifndef NOCPUDEF
+override FPCOPTDEF=$(CPU_TARGET)
+endif
+ifneq ($(OS_TARGET),$(OS_SOURCE))
+override FPCOPT+=-T$(OS_TARGET)
+endif
+ifneq ($(CPU_TARGET),$(CPU_SOURCE))
+override FPCOPT+=-P$(CPU_TARGET)
+endif
+ifeq ($(OS_SOURCE),openbsd)
+override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
+endif
+ifndef CROSSBOOTSTRAP
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
+endif
+ifneq ($(BINUTILSPREFIX),)
+override FPCOPT+=-Xr$(RLINKPATH)
+endif
+endif
+ifdef UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
+endif
+ifdef LIBDIR
+override FPCOPT+=$(addprefix -Fl,$(LIBDIR))
+endif
+ifdef OBJDIR
+override FPCOPT+=$(addprefix -Fo,$(OBJDIR))
+endif
+ifdef INCDIR
+override FPCOPT+=$(addprefix -Fi,$(INCDIR))
+endif
+ifdef LINKSMART
+override FPCOPT+=-XX
+endif
+ifdef CREATESMART
+override FPCOPT+=-CX
+endif
+ifdef DEBUG
+override FPCOPT+=-gl
+override FPCOPTDEF+=DEBUG
+endif
+ifdef RELEASE
+ifneq ($(findstring 2.0.,$(FPC_VERSION)),)
+ifeq ($(CPU_TARGET),i386)
+FPCCPUOPT:=-OG2p3
+endif
+ifeq ($(CPU_TARGET),powerpc)
+FPCCPUOPT:=-O1r
+endif
+else
+FPCCPUOPT:=-O2
+endif
+override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n
+override FPCOPTDEF+=RELEASE
+endif
+ifdef STRIP
+override FPCOPT+=-Xs
+endif
+ifdef OPTIMIZE
+override FPCOPT+=-O2
+endif
+ifdef VERBOSE
+override FPCOPT+=-vwni
+endif
+ifdef COMPILER_OPTIONS
+override FPCOPT+=$(COMPILER_OPTIONS)
+endif
+ifdef COMPILER_UNITDIR
+override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR))
+endif
+ifdef COMPILER_LIBRARYDIR
+override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR))
+endif
+ifdef COMPILER_OBJECTDIR
+override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR))
+endif
+ifdef COMPILER_INCLUDEDIR
+override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR))
+endif
+ifdef CROSSBINDIR
+override FPCOPT+=-FD$(CROSSBINDIR)
+endif
+ifdef COMPILER_TARGETDIR
+override FPCOPT+=-FE$(COMPILER_TARGETDIR)
+ifeq ($(COMPILER_TARGETDIR),.)
+override TARGETDIRPREFIX=
+else
+override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/
+endif
+endif
+ifdef COMPILER_UNITTARGETDIR
+override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR)
+ifeq ($(COMPILER_UNITTARGETDIR),.)
+override UNITTARGETDIRPREFIX=
+else
+override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/
+endif
+else
+ifdef COMPILER_TARGETDIR
+override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR)
+override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX)
+endif
+endif
+ifdef CREATESHARED
+override FPCOPT+=-Cg
+ifeq ($(CPU_TARGET),i386)
+override FPCOPT+=-Aas
+endif
+endif
+ifeq ($(findstring 2.0.,$(FPC_VERSION)),)
+ifeq ($(OS_TARGET),linux)
+ifeq ($(CPU_TARGET),x86_64)
+override FPCOPT+=-Cg
+endif
+endif
+endif
+ifdef LINKSHARED
+endif
+ifdef OPT
+override FPCOPT+=$(OPT)
+endif
+ifdef FPCOPTDEF
+override FPCOPT+=$(addprefix -d,$(FPCOPTDEF))
+endif
+ifdef CFGFILE
+override FPCOPT+=@$(CFGFILE)
+endif
+ifdef USEENV
+override FPCEXTCMD:=$(FPCOPT)
+override FPCOPT:=!FPCEXTCMD
+export FPCEXTCMD
+endif
+override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET)
+override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE)
+ifneq ($(AFULL_TARGET),$(AFULL_SOURCE))
+override ACROSSCOMPILE=1
+endif
+ifdef ACROSSCOMPILE
+override FPCOPT+=$(CROSSOPT)
+endif
+override COMPILER:=$(FPC) $(FPCOPT)
+ifeq (,$(findstring -s ,$(COMPILER)))
+EXECPPAS=
+else
+ifeq ($(FULL_SOURCE),$(FULL_TARGET))
+EXECPPAS:=@$(PPAS)
+endif
+endif
+.PHONY: fpc_units
+ifneq ($(TARGET_UNITS),)
+override ALLTARGET+=fpc_units
+override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS))
+override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS))
+override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES)
+endif
+fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES)
+.PHONY: fpc_exes
+ifndef CROSSINSTALL
+ifneq ($(TARGET_PROGRAMS),)
+override EXEFILES=$(addsuffix $(EXEEXT),$(TARGET_PROGRAMS))
+override EXEOFILES:=$(addsuffix $(OEXT),$(TARGET_PROGRAMS)) $(addprefix $(STATICLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))) $(addprefix $(IMPORTLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS)))
+override ALLTARGET+=fpc_exes
+override INSTALLEXEFILES+=$(EXEFILES)
+override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
+ifeq ($(OS_TARGET),os2)
+override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))
+endif
+ifeq ($(OS_TARGET),emx)
+override CLEANEXEFILES+=$(addsuffix $(AOUTEXT),$(TARGET_PROGRAMS))
+endif
+endif
+endif
+fpc_exes: $(COMPILER_TARGETDIR) $(COMPILER_UNITTARGETDIR) $(EXEFILES)
+ifdef TARGET_RSTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS))
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+.PHONY: fpc_all fpc_smart fpc_debug fpc_release fpc_shared
+$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET)
+	@$(ECHOREDIR) Compiled > $(FPCMADE)
+fpc_all: $(FPCMADE)
+fpc_smart:
+	$(MAKE) all LINKSMART=1 CREATESMART=1
+fpc_debug:
+	$(MAKE) all DEBUG=1
+fpc_release:
+	$(MAKE) all RELEASE=1
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res
+$(COMPILER_UNITTARGETDIR):
+	$(MKDIRTREE) $(COMPILER_UNITTARGETDIR)
+$(COMPILER_TARGETDIR):
+	$(MKDIRTREE) $(COMPILER_TARGETDIR)
+%$(PPUEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(PPUEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pp
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.pas
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.lpr
+	$(COMPILER) $<
+	$(EXECPPAS)
+%$(EXEEXT): %.dpr
+	$(COMPILER) $<
+	$(EXECPPAS)
+%.res: %.rc
+	windres -i $< -o $@
+vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
+vpath %$(OEXT) $(COMPILER_UNITTARGETDIR)
+vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
+.PHONY: fpc_shared
+override INSTALLTARGET+=fpc_shared_install
+ifndef SHARED_LIBVERSION
+SHARED_LIBVERSION=$(FPC_VERSION)
+endif
+ifndef SHARED_LIBNAME
+SHARED_LIBNAME=$(PACKAGE_NAME)
+endif
+ifndef SHARED_FULLNAME
+SHARED_FULLNAME=$(SHAREDLIBPREFIX)$(SHARED_LIBNAME)-$(SHARED_LIBVERSION)$(SHAREDLIBEXT)
+endif
+ifndef SHARED_LIBUNITS
+SHARED_LIBUNITS:=$(TARGET_UNITS) $(TARGET_IMPLICITUNITS)
+override SHARED_LIBUNITS:=$(filter-out $(INSTALL_BUILDUNIT),$(SHARED_LIBUNITS))
+endif
+fpc_shared:
+ifdef HASSHAREDLIB
+	$(MAKE) all CREATESHARED=1 LINKSHARED=1 CREATESMART=1
+ifneq ($(SHARED_BUILD),n)
+	$(PPUMOVE) -q $(SHARED_LIBUNITS) -i$(COMPILER_UNITTARGETDIR) -o$(SHARED_FULLNAME) -d$(COMPILER_UNITTARGETDIR)
+endif
+else
+	@$(ECHO) Shared Libraries not supported
+endif
+fpc_shared_install:
+ifneq ($(SHARED_BUILD),n)
+ifneq ($(SHARED_LIBUNITS),)
+ifneq ($(wildcard $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME)),)
+	$(INSTALL) $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME) $(INSTALL_SHAREDDIR)
+endif
+endif
+endif
+.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
+ifdef INSTALL_UNITS
+override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS))
+endif
+ifdef INSTALL_BUILDUNIT
+override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES))
+endif
+ifdef INSTALLPPUFILES
+override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES)))
+ifneq ($(UNITTARGETDIRPREFIX),)
+override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES)))
+override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES))))
+endif
+override INSTALL_CREATEPACKAGEFPC=1
+endif
+ifdef INSTALLEXEFILES
+ifneq ($(TARGETDIRPREFIX),)
+override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES)))
+endif
+endif
+fpc_install: all $(INSTALLTARGET)
+ifdef INSTALLEXEFILES
+	$(MKDIR) $(INSTALL_BINDIR)
+ifdef UPXPROG
+	-$(UPXPROG) $(INSTALLEXEFILES)
+endif
+	$(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR)
+endif
+ifdef INSTALL_CREATEPACKAGEFPC
+ifdef FPCMAKE
+ifdef PACKAGE_VERSION
+ifneq ($(wildcard Makefile.fpc),)
+	$(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) Package.fpc $(INSTALL_UNITDIR)
+endif
+endif
+endif
+endif
+ifdef INSTALLPPUFILES
+	$(MKDIR) $(INSTALL_UNITDIR)
+	$(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR)
+ifneq ($(INSTALLPPULINKFILES),)
+	$(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR)
+endif
+ifneq ($(wildcard $(LIB_FULLNAME)),)
+	$(MKDIR) $(INSTALL_LIBDIR)
+	$(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR)
+ifdef inUnix
+	ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME)
+endif
+endif
+endif
+ifdef INSTALL_FILES
+	$(MKDIR) $(INSTALL_DATADIR)
+	$(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR)
+endif
+fpc_sourceinstall: distclean
+	$(MKDIR) $(INSTALL_SOURCEDIR)
+	$(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR)
+fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS))
+ifdef HASEXAMPLES
+	$(MKDIR) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef EXAMPLESOURCEFILES
+	$(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR)
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR)
+endif
+.PHONY: fpc_distinstall
+fpc_distinstall: install exampleinstall
+.PHONY: fpc_zipinstall fpc_zipsourceinstall fpc_zipexampleinstall
+ifndef PACKDIR
+ifndef inUnix
+PACKDIR=$(BASEDIR)/../fpc-pack
+else
+PACKDIR=/tmp/fpc-pack
+endif
+endif
+ifndef ZIPNAME
+ifdef DIST_ZIPNAME
+ZIPNAME=$(DIST_ZIPNAME)
+else
+ZIPNAME=$(PACKAGE_NAME)
+endif
+endif
+ifndef FULLZIPNAME
+FULLZIPNAME=$(ZIPCROSSPREFIX)$(ZIPPREFIX)$(ZIPNAME)$(ZIPSUFFIX)
+endif
+ifndef ZIPTARGET
+ifdef DIST_ZIPTARGET
+ZIPTARGET=DIST_ZIPTARGET
+else
+ZIPTARGET=install
+endif
+endif
+ifndef USEZIP
+ifdef inUnix
+USETAR=1
+endif
+endif
+ifndef inUnix
+USEZIPWRAPPER=1
+endif
+ifdef USEZIPWRAPPER
+ZIPPATHSEP=$(PATHSEP)
+ZIPWRAPPER=$(subst /,$(PATHSEP),$(DIST_DESTDIR)/fpczip$(SRCBATCHEXT))
+else
+ZIPPATHSEP=/
+endif
+ZIPCMD_CDPACK:=cd $(subst /,$(ZIPPATHSEP),$(PACKDIR))
+ZIPCMD_CDBASE:=cd $(subst /,$(ZIPPATHSEP),$(BASEDIR))
+ifdef USETAR
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(TAREXT)
+ZIPCMD_ZIP:=$(TARPROG) cf$(TAROPT) $(ZIPDESTFILE) *
+else
+ZIPDESTFILE:=$(DIST_DESTDIR)/$(FULLZIPNAME)$(ZIPEXT)
+ZIPCMD_ZIP:=$(subst /,$(ZIPPATHSEP),$(ZIPPROG)) -Dr $(ZIPOPT) $(ZIPDESTFILE) *
+endif
+fpc_zipinstall:
+	$(MAKE) $(ZIPTARGET) INSTALL_PREFIX=$(PACKDIR) ZIPINSTALL=1
+	$(MKDIR) $(DIST_DESTDIR)
+	$(DEL) $(ZIPDESTFILE)
+ifdef USEZIPWRAPPER
+ifneq ($(ECHOREDIR),echo)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDPACK))" > $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_ZIP))" >> $(ZIPWRAPPER)
+	$(ECHOREDIR) -e "$(subst \,\\,$(ZIPCMD_CDBASE))" >> $(ZIPWRAPPER)
+else
+	echo $(ZIPCMD_CDPACK) > $(ZIPWRAPPER)
+	echo $(ZIPCMD_ZIP) >> $(ZIPWRAPPER)
+	echo $(ZIPCMD_CDBASE) >> $(ZIPWRAPPER)
+endif
+ifdef inUnix
+	/bin/sh $(ZIPWRAPPER)
+else
+	$(ZIPWRAPPER)
+endif
+	$(DEL) $(ZIPWRAPPER)
+else
+	$(ZIPCMD_CDPACK) ; $(ZIPCMD_ZIP) ; $(ZIPCMD_CDBASE)
+endif
+	$(DELTREE) $(PACKDIR)
+fpc_zipsourceinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=sourceinstall ZIPSUFFIX=$(ZIPSOURCESUFFIX)
+fpc_zipexampleinstall:
+ifdef HASEXAMPLES
+	$(MAKE) fpc_zipinstall ZIPTARGET=exampleinstall ZIPSUFFIX=$(ZIPEXAMPLESUFFIX)
+endif
+fpc_zipdistinstall:
+	$(MAKE) fpc_zipinstall ZIPTARGET=distinstall
+.PHONY: fpc_clean fpc_cleanall fpc_distclean
+ifdef EXEFILES
+override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES))
+endif
+ifdef CLEAN_UNITS
+override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS))
+endif
+ifdef CLEANPPUFILES
+override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES)))
+ifdef DEBUGSYMEXT
+override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES))
+endif
+override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES))
+override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES)))
+endif
+fpc_clean: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+ifdef CLEAN_FILES
+	-$(DEL) $(CLEAN_FILES)
+endif
+ifdef LIB_NAME
+	-$(DEL) $(LIB_NAME) $(LIB_FULLNAME)
+endif
+	-$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT)
+fpc_cleanall: $(CLEANTARGET)
+ifdef CLEANEXEFILES
+	-$(DEL) $(CLEANEXEFILES)
+endif
+ifdef COMPILER_UNITTARGETDIR
+ifdef CLEANPPUFILES
+	-$(DEL) $(CLEANPPUFILES)
+endif
+ifneq ($(CLEANPPULINKFILES),)
+	-$(DEL) $(CLEANPPULINKFILES)
+endif
+ifdef CLEANRSTFILES
+	-$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES))
+endif
+endif
+	-$(DELTREE) units
+	-$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
+ifneq ($(PPUEXT),.ppu)
+	-$(DEL) *.o *.ppu *.a
+endif
+	-$(DELTREE) *$(SMARTEXT)
+	-$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE)
+	-$(DEL) *_ppas$(BATCHEXT)
+ifdef AOUTEXT
+	-$(DEL) *$(AOUTEXT)
+endif
+ifdef DEBUGSYMEXT
+	-$(DEL) *$(DEBUGSYMEXT)
+endif
+fpc_distclean: cleanall
+.PHONY: fpc_baseinfo
+override INFORULES+=fpc_baseinfo
+fpc_baseinfo:
+	@$(ECHO)
+	@$(ECHO)  == Package info ==
+	@$(ECHO)  Package Name..... $(PACKAGE_NAME)
+	@$(ECHO)  Package Version.. $(PACKAGE_VERSION)
+	@$(ECHO)
+	@$(ECHO)  == Configuration info ==
+	@$(ECHO)
+	@$(ECHO)  FPC.......... $(FPC)
+	@$(ECHO)  FPC Version.. $(FPC_VERSION)
+	@$(ECHO)  Source CPU... $(CPU_SOURCE)
+	@$(ECHO)  Target CPU... $(CPU_TARGET)
+	@$(ECHO)  Source OS.... $(OS_SOURCE)
+	@$(ECHO)  Target OS.... $(OS_TARGET)
+	@$(ECHO)  Full Source.. $(FULL_SOURCE)
+	@$(ECHO)  Full Target.. $(FULL_TARGET)
+	@$(ECHO)  SourceSuffix. $(SOURCESUFFIX)
+	@$(ECHO)  TargetSuffix. $(TARGETSUFFIX)
+	@$(ECHO)
+	@$(ECHO)  == Directory info ==
+	@$(ECHO)
+	@$(ECHO)  Required pkgs... $(REQUIRE_PACKAGES)
+	@$(ECHO)
+	@$(ECHO)  Basedir......... $(BASEDIR)
+	@$(ECHO)  FPCDir.......... $(FPCDIR)
+	@$(ECHO)  CrossBinDir..... $(CROSSBINDIR)
+	@$(ECHO)  UnitsDir........ $(UNITSDIR)
+	@$(ECHO)  PackagesDir..... $(PACKAGESDIR)
+	@$(ECHO)
+	@$(ECHO)  GCC library..... $(GCCLIBDIR)
+	@$(ECHO)  Other library... $(OTHERLIBDIR)
+	@$(ECHO)
+	@$(ECHO)  == Tools info ==
+	@$(ECHO)
+	@$(ECHO)  As........ $(AS)
+	@$(ECHO)  Ld........ $(LD)
+	@$(ECHO)  Ar........ $(AR)
+	@$(ECHO)  Rc........ $(RC)
+	@$(ECHO)
+	@$(ECHO)  Mv........ $(MVPROG)
+	@$(ECHO)  Cp........ $(CPPROG)
+	@$(ECHO)  Rm........ $(RMPROG)
+	@$(ECHO)  GInstall.. $(GINSTALL)
+	@$(ECHO)  Echo...... $(ECHO)
+	@$(ECHO)  Shell..... $(SHELL)
+	@$(ECHO)  Date...... $(DATE)
+	@$(ECHO)  FPCMake... $(FPCMAKE)
+	@$(ECHO)  PPUMove... $(PPUMOVE)
+	@$(ECHO)  Upx....... $(UPXPROG)
+	@$(ECHO)  Zip....... $(ZIPPROG)
+	@$(ECHO)
+	@$(ECHO)  == Object info ==
+	@$(ECHO)
+	@$(ECHO)  Target Loaders........ $(TARGET_LOADERS)
+	@$(ECHO)  Target Units.......... $(TARGET_UNITS)
+	@$(ECHO)  Target Implicit Units. $(TARGET_IMPLICITUNITS)
+	@$(ECHO)  Target Programs....... $(TARGET_PROGRAMS)
+	@$(ECHO)  Target Dirs........... $(TARGET_DIRS)
+	@$(ECHO)  Target Examples....... $(TARGET_EXAMPLES)
+	@$(ECHO)  Target ExampleDirs.... $(TARGET_EXAMPLEDIRS)
+	@$(ECHO)
+	@$(ECHO)  Clean Units......... $(CLEAN_UNITS)
+	@$(ECHO)  Clean Files......... $(CLEAN_FILES)
+	@$(ECHO)
+	@$(ECHO)  Install Units....... $(INSTALL_UNITS)
+	@$(ECHO)  Install Files....... $(INSTALL_FILES)
+	@$(ECHO)
+	@$(ECHO)  == Install info ==
+	@$(ECHO)
+	@$(ECHO)  DateStr.............. $(DATESTR)
+	@$(ECHO)  ZipName.............. $(ZIPNAME)
+	@$(ECHO)  ZipPrefix............ $(ZIPPREFIX)
+	@$(ECHO)  ZipCrossPrefix....... $(ZIPCROSSPREFIX)
+	@$(ECHO)  ZipSuffix............ $(ZIPSUFFIX)
+	@$(ECHO)  FullZipName.......... $(FULLZIPNAME)
+	@$(ECHO)  Install FPC Package.. $(INSTALL_FPCPACKAGE)
+	@$(ECHO)
+	@$(ECHO)  Install base dir..... $(INSTALL_BASEDIR)
+	@$(ECHO)  Install binary dir... $(INSTALL_BINDIR)
+	@$(ECHO)  Install library dir.. $(INSTALL_LIBDIR)
+	@$(ECHO)  Install units dir.... $(INSTALL_UNITDIR)
+	@$(ECHO)  Install source dir... $(INSTALL_SOURCEDIR)
+	@$(ECHO)  Install doc dir...... $(INSTALL_DOCDIR)
+	@$(ECHO)  Install example dir.. $(INSTALL_EXAMPLEDIR)
+	@$(ECHO)  Install data dir..... $(INSTALL_DATADIR)
+	@$(ECHO)
+	@$(ECHO)  Dist destination dir. $(DIST_DESTDIR)
+	@$(ECHO)  Dist zip name........ $(DIST_ZIPNAME)
+	@$(ECHO)
+.PHONY: fpc_info
+fpc_info: $(INFORULES)
+.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \
+	fpc_makefile_dirs
+fpc_makefile:
+	$(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc
+fpc_makefile_sub1:
+ifdef TARGET_DIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS))
+endif
+ifdef TARGET_EXAMPLEDIRS
+	$(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS))
+endif
+fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS))
+fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2
+fpc_makefiles: fpc_makefile fpc_makefile_dirs
+all: fpc_all
+debug: fpc_debug
+smart: fpc_smart
+release: fpc_release
+units: fpc_units
+examples:
+shared: fpc_shared
+install: fpc_install
+sourceinstall: fpc_sourceinstall
+exampleinstall: fpc_exampleinstall
+distinstall: fpc_distinstall
+zipinstall: fpc_zipinstall
+zipsourceinstall: fpc_zipsourceinstall
+zipexampleinstall: fpc_zipexampleinstall
+zipdistinstall: fpc_zipdistinstall
+clean: fpc_clean
+distclean: fpc_distclean
+cleanall: fpc_cleanall
+info: fpc_info
+makefiles: fpc_makefiles
+.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles
+ifneq ($(wildcard fpcmake.loc),)
+include fpcmake.loc
+endif
+cdmcmd$(EXEEXT): chmcmd.lpr
+chmls$(EXEEXT): chmls.lpr

+ 27 - 0
packages/extra/chm/Makefile.fpc

@@ -0,0 +1,27 @@
+#
+#   Makefile.fpc for BFD library
+#
+
+[package]
+name=chm
+version=2.0.0
+
+[target]
+units=fasthtmlparser htmlutil paslzx paslzxcomp paslznonslide chmbase chmtypes \
+      chmspecialfiles chmsitemap chmwriter chmfilewriter chmreader  
+programs=chmcmd chmls
+examples=
+
+[require]
+package=rtl
+
+[install]
+fpcpackage=y
+
+[default]
+fpcdir=../../..
+
+[rules]
+cdmcmd$(EXEEXT): chmcmd.lpr
+
+chmls$(EXEEXT): chmls.lpr

+ 204 - 0
packages/extra/chm/chmbase.pas

@@ -0,0 +1,204 @@
+{ Copyright (C) <2005> <Andrew Haines> chmbase.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+unit chmbase;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils;
+  
+type
+  {$PACKRECORDS C}
+  TITSFHeader= record
+    ITSFsig: array [0..3] of char;
+    Version: LongWord;
+    HeaderLength: LongWord;
+    Unknown_1: LongWord;
+    TimeStamp: LongWord; //bigendian
+    LanguageID: LongWord;
+    Guid1: TGuid;
+    Guid2: TGuid;
+  end;
+  TITSFHeaderEntry = record
+    PosFromZero: QWord;
+    Length: QWord;
+  end;
+  
+  //Version 3 has this qword. 2 does not
+  TITSFHeaderSuffix = record
+    Offset: QWord; // offset within file of content section 0
+  end;
+  
+  TITSPHeaderPrefix = record
+    Unknown1: LongWord;// = $01FE
+    Unknown2: LongWord;// = 0
+    FileSize: QWord;
+    Unknown3: LongWord;// =0
+    Unknown4: LongWord;// =0
+  end;
+  
+  TITSPHeader = record
+    ITSPsig: array [0..3] of char; // = 'ITSP'
+    Version: LongWord;             // =1
+    DirHeaderLength: Longword;     // Length of the directory header
+    Unknown1: LongWord;            // =$0a
+    ChunkSize: LongWord;           // $1000
+    Density: LongWord; // usually = 2
+    IndexTreeDepth: LongWord;// 1 if there is no index 2 if there is one level of PMGI chunks
+    IndexOfRootChunk: LongInt;// -1 if no root chunk
+    FirstPMGLChunkIndex,
+    LastPMGLChunkIndex: LongWord;
+    Unknown2: LongInt; // = -1
+    DirectoryChunkCount: LongWord;
+    LanguageID: LongWord;
+    GUID: TGuid;
+    LengthAgain: LongWord; //??? $54
+    Unknown3: LongInt; // = -1
+    Unknown4: LongInt; // = -1
+    Unknown5: LongInt; // = -1
+  end;
+  
+  TPMGchunktype = (ctPMGL, ctPMGI, ctUnknown);
+  
+  TPMGListChunk = record
+    PMGLsig: array [0..3] of char;
+    UnusedSpace: Longword; ///!!! this value can also represent the size of quickref area in the end of the chunk
+    Unknown1: Longword; //always 0
+    PreviousChunkIndex: LongInt; // chunk number of the prev listing chunk when reading dir in sequence
+                                 // (-1 if this is the first listing chunk)
+    NextChunkIndex: LongInt; // chunk number of the next listing chunk (-1 if this is the last chunk)
+  end;
+
+  PPMGListChunkEntry = ^TPMGListChunkEntry;
+  TPMGListChunkEntry = record
+    //NameLength: LongInt; we don't need this permanantly so I've moved it to a temp var
+    Name: String;
+    ContentSection: LongWord;//QWord;
+    ContentOffset: QWord;
+    DecompressedLength: QWord;
+  end;
+  
+  TPMGIIndexChunk = record
+    PMGIsig: array [0..3] of char;
+    UnusedSpace: LongWord; // has a quickref area
+  end;
+  
+  TPMGIIndexChunkEntry = record
+    Name: String;
+    ListingChunk: DWord;
+  end;
+
+  
+const
+  ITSFHeaderGUID : TGuid = '{7C01FD10-7BAA-11D0-9E0C-00A0C922E6EC}';
+  ITSFFileSig: array [0..3] of char = 'ITSF';
+  
+  ITSPHeaderGUID : TGuid = '{5D02926A-212E-11D0-9DF9-00A0C922E6EC}';
+  ITSPHeaderSig: array [0..3] of char = 'ITSP';
+
+  // this function will advance the stream to the end of the compressed integer
+  // and return the value
+  function GetCompressedInteger(const Stream: TStream): DWord;
+  // returns the number of bytes written to the stream
+  function WriteCompressedInteger(const Stream: TStream; ANumber: DWord): DWord;
+  function WriteCompressedInteger(Buffer: Pointer; ANumber: DWord): DWord;
+  
+  // stupid needed function
+  function ChmCompareText(S1, S2: String): Integer; inline;
+
+
+implementation
+
+function GetCompressedInteger(const Stream: TStream): DWord;
+var
+  total: QWord = 0;
+  temp: Byte;
+  Sanity: Integer = 0;
+begin
+  try
+  temp := Stream.ReadByte;
+  while temp >= $80 do begin
+    total := total shl 7;
+    total := total + temp and $7f;
+    temp := Stream.ReadByte;
+    Inc(Sanity);
+    if Sanity > 8 then begin
+      Result := 0;
+      Exit;
+    end;
+  end;
+  Result := (total shl 7) + temp;
+  except
+    Result := 0;
+  end;
+end;
+
+// returns how many bytes were written
+function WriteCompressedInteger(const Stream: TStream; ANumber: DWord): DWord;
+var
+  Buffer: QWord; // Easily large enough
+begin
+  Result := WriteCompressedInteger(@Buffer, ANumber);
+  Result := Stream.Write(Buffer, Result);
+end;
+
+// returns how many bytes were written
+function WriteCompressedInteger(Buffer: Pointer; ANumber: DWord): DWord;
+var
+  bit: dword;
+  mask: QWord;
+  buf: PByte;
+  Value: QWord = 0;
+  TheEnd: DWord = 0;
+begin
+  bit := (sizeof(dWord)*8)div 7*7;
+  buf := @Value;
+  while True do begin
+    mask := $7f shl bit;
+    if (bit = 0) or ((ANumber and mask)<>0) then break;
+    Dec(bit, 7);
+  end;
+
+  while True do begin
+    buf^ := Byte(((ANumber shr bit)and $7f));
+    if(bit = 0) then break;
+    buf^ := buf^ or $80;
+    Inc(buf);
+    Dec(bit, 7);
+    Inc(TheEnd);
+  end;
+  
+  buf := @Value;
+  Result := TheEnd+1;
+  Move(Value, Buffer^, Result);
+  if Result > 8 then WriteLn(' ', ANumber,' WRITE_COMPRESSED_INTEGER too big!: ', Result, ' ');
+end;
+
+function ChmCompareText(S1, S2: String): Integer; inline;
+begin
+  // for our purposes the CompareText function will not work.
+  Result := CompareStr(LowerCase(S1), Lowercase(S2));
+end;
+
+end.
+

+ 279 - 0
packages/extra/chm/chmcmd.lpi

@@ -0,0 +1,279 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <ActiveEditorIndexAtStart Value="1"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+      <Language Value=""/>
+      <CharSet Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="22">
+      <Unit0>
+        <Filename Value="chmcmd.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="chmcmd"/>
+        <CursorPos X="1" Y="20"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="9"/>
+        <UsageCount Value="212"/>
+        <Loaded Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="../chmfilewriter.pas"/>
+        <UnitName Value="chmfilewriter"/>
+        <CursorPos X="5" Y="70"/>
+        <TopLine Value="58"/>
+        <UsageCount Value="5"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmwriter.pas"/>
+        <UnitName Value="chmwriter"/>
+        <CursorPos X="21" Y="849"/>
+        <TopLine Value="820"/>
+        <EditorIndex Value="1"/>
+        <UsageCount Value="107"/>
+        <Bookmarks Count="1">
+          <Item0 X="31" Y="622" ID="0"/>
+        </Bookmarks>
+        <Loaded Value="True"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmreader.pas"/>
+        <UnitName Value="chmreader"/>
+        <CursorPos X="20" Y="436"/>
+        <TopLine Value="416"/>
+        <UsageCount Value="5"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="../chmtypes.pas"/>
+        <UnitName Value="chmtypes"/>
+        <CursorPos X="24" Y="186"/>
+        <TopLine Value="163"/>
+        <UsageCount Value="5"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmbase.pas"/>
+        <UnitName Value="chmbase"/>
+        <CursorPos X="19" Y="126"/>
+        <TopLine Value="32"/>
+        <EditorIndex Value="4"/>
+        <UsageCount Value="86"/>
+        <Loaded Value="True"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="../../../fpc/rtl/objpas/classes/classesh.inc"/>
+        <CursorPos X="15" Y="791"/>
+        <TopLine Value="774"/>
+        <UsageCount Value="11"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="../../../fpc/rtl/objpas/classes/streams.inc"/>
+        <CursorPos X="3" Y="592"/>
+        <TopLine Value="587"/>
+        <UsageCount Value="11"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmfilewriter.pas"/>
+        <UnitName Value="chmfilewriter"/>
+        <CursorPos X="5" Y="65"/>
+        <TopLine Value="43"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="100"/>
+        <Loaded Value="True"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="../../../../olddrive/downloads/hhm-0.1.1/hhm.c"/>
+        <CursorPos X="26" Y="1225"/>
+        <TopLine Value="1219"/>
+        <UsageCount Value="105"/>
+        <SyntaxHighlighter Value="C++"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/paslzxcomp.pas"/>
+        <UnitName Value="paslzxcomp"/>
+        <CursorPos X="6" Y="51"/>
+        <TopLine Value="35"/>
+        <EditorIndex Value="6"/>
+        <UsageCount Value="90"/>
+        <Loaded Value="True"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/paslznonslide.pas"/>
+        <UnitName Value="paslznonslide"/>
+        <CursorPos X="11" Y="245"/>
+        <TopLine Value="215"/>
+        <EditorIndex Value="7"/>
+        <UsageCount Value="117"/>
+        <Loaded Value="True"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/paslznonslide.s"/>
+        <CursorPos X="21" Y="786"/>
+        <TopLine Value="629"/>
+        <UsageCount Value="23"/>
+        <SyntaxHighlighter Value="None"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="../../../../olddrive/downloads/hhm-0.1.1/lzx_compress/lz_nonslide.s"/>
+        <CursorPos X="4" Y="56"/>
+        <TopLine Value="27"/>
+        <UsageCount Value="4"/>
+        <SyntaxHighlighter Value="None"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="../../../../olddrive/downloads/hhm-0.1.1/lzx_compress/lz_nonslide.c"/>
+        <CursorPos X="80" Y="233"/>
+        <TopLine Value="54"/>
+        <EditorIndex Value="8"/>
+        <UsageCount Value="104"/>
+        <Loaded Value="True"/>
+        <SyntaxHighlighter Value="C++"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="../../../../olddrive/downloads/hhm-0.1.1/lzx_compress/lz_nonslide.test"/>
+        <CursorPos X="15" Y="843"/>
+        <TopLine Value="708"/>
+        <UsageCount Value="21"/>
+        <SyntaxHighlighter Value="None"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="../../../../olddrive/downloads/hhm-0.1.1/lzx_compress/lzx_layer.c"/>
+        <CursorPos X="14" Y="432"/>
+        <TopLine Value="414"/>
+        <EditorIndex Value="11"/>
+        <UsageCount Value="82"/>
+        <Loaded Value="True"/>
+        <SyntaxHighlighter Value="C++"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="../../../../olddrive/downloads/hhm-0.1.1/lzx_compress/lzx_compress.h"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="5"/>
+        <EditorIndex Value="10"/>
+        <UsageCount Value="82"/>
+        <Loaded Value="True"/>
+        <SyntaxHighlighter Value="C++"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="../../../../olddrive/downloads/hhm-0.1.1/lzx_compress/lz_nonslide.h"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="12"/>
+        <UsageCount Value="82"/>
+        <Loaded Value="True"/>
+        <SyntaxHighlighter Value="C++"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmspecialfiles.pas"/>
+        <UnitName Value="chmspecialfiles"/>
+        <CursorPos X="45" Y="93"/>
+        <TopLine Value="45"/>
+        <EditorIndex Value="5"/>
+        <UsageCount Value="80"/>
+        <Loaded Value="True"/>
+      </Unit19>
+      <Unit20>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/fiftimaintree.pas"/>
+        <UnitName Value="fiftimaintree"/>
+        <CursorPos X="7" Y="16"/>
+        <TopLine Value="1"/>
+        <EditorIndex Value="3"/>
+        <UsageCount Value="35"/>
+        <Loaded Value="True"/>
+      </Unit20>
+      <Unit21>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmtypes.pas"/>
+        <UnitName Value="chmtypes"/>
+        <CursorPos X="46" Y="232"/>
+        <TopLine Value="11"/>
+        <EditorIndex Value="2"/>
+        <UsageCount Value="12"/>
+        <Loaded Value="True"/>
+      </Unit21>
+    </Units>
+    <JumpHistory Count="8" HistoryIndex="7">
+      <Position1>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmwriter.pas"/>
+        <Caret Line="823" Column="20" TopLine="813"/>
+      </Position1>
+      <Position2>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmwriter.pas"/>
+        <Caret Line="766" Column="12" TopLine="735"/>
+      </Position2>
+      <Position3>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmwriter.pas"/>
+        <Caret Line="89" Column="104" TopLine="63"/>
+      </Position3>
+      <Position4>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmwriter.pas"/>
+        <Caret Line="794" Column="34" TopLine="782"/>
+      </Position4>
+      <Position5>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmwriter.pas"/>
+        <Caret Line="365" Column="55" TopLine="348"/>
+      </Position5>
+      <Position6>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmwriter.pas"/>
+        <Caret Line="486" Column="53" TopLine="469"/>
+      </Position6>
+      <Position7>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmwriter.pas"/>
+        <Caret Line="498" Column="21" TopLine="481"/>
+      </Position7>
+      <Position8>
+        <Filename Value="../../../lazarus/components/chmhelp/packages/chm/chmwriter.pas"/>
+        <Caret Line="798" Column="32" TopLine="781"/>
+      </Position8>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="/home/andrew/programming/projects/chmmaker/;/home/andrew/programming/lazarus/components/chmhelp/packages/chm/;/home/andrew/programming/projects/lzxcompress/"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <SmartLinkUnit Value="True"/>
+      <Generate Value="Faster"/>
+      <Optimizations>
+        <OptimizationLevel Value="2"/>
+      </Optimizations>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="True"/>
+      </Debugging>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="ECodetoolError"/>
+      </Item1>
+      <Item2>
+        <Name Value="EFOpenError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 41 - 0
packages/extra/chm/chmcmd.lpr

@@ -0,0 +1,41 @@
+{ Copyright (C) <2005> <Andrew Haines> chmcmd.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING, included in this distribution,
+  for details about the copyright.
+}
+program chmcmd;
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, chmfilewriter;
+
+var
+  OutStream: TFileStream;
+  Project: TChmProject;
+begin
+  if Paramcount = 1 then begin
+    Project := TChmProject.Create;
+    Project.LoadFromFile(ParamStr(1));
+    OutStream := TFileStream.Create(Project.OutputFileName, fmCreate, fmOpenWrite);
+    Project.WriteChm(OutStream);
+    OutStream.Free;
+    Project.Free;
+  end;
+end.
+

+ 207 - 0
packages/extra/chm/chmfilewriter.pas

@@ -0,0 +1,207 @@
+{ Copyright (C) <2005> <Andrew Haines> chmfilewriter.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+unit chmfilewriter;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, chmwriter;
+  
+type
+  TChmProject = class;
+  
+  TChmProgressCB = procedure (Project: TChmProject; CurrentFile: String) of object;
+
+  { TChmProject }
+
+  TChmProject = class
+  private
+    FAutoFollowLinks: Boolean;
+    FDefaultFont: String;
+    FDefaultPage: String;
+    FFiles: TStrings;
+    FIndexFileName: String;
+    FMakeSearchable: Boolean;
+    FFileName: String;
+    FOnProgress: TChmProgressCB;
+    FOutputFileName: String;
+    FTableOfContentsFileName: String;
+    FTitle: String;
+  protected
+    function GetData(const DataName: String; out PathInChm: String; out FileName: String; var Stream: TStream): Boolean;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure LoadFromFile(AFileName: String);
+    procedure SaveToFile(AFileName: String);
+    procedure WriteChm(AOutStream: TStream);
+    function ProjectDir: String;
+    // though stored in the project file, it is only there for the program that uses the unit
+    // since we actually write to a stream
+    property OutputFileName: String read FOutputFileName write FOutputFileName;
+    property FileName: String read FFileName write FFileName;
+    property Files: TStrings read FFiles write FFiles;
+    property AutoFollowLinks: Boolean read FAutoFollowLinks write FAutoFollowLinks;
+    property TableOfContentsFileName: String read FTableOfContentsFileName write FTableOfContentsFileName;
+    property Title: String read FTitle write FTitle;
+    property IndexFileName: String read FIndexFileName write FIndexFileName;
+    property MakeSearchable: Boolean read FMakeSearchable write FMakeSearchable;
+    property DefaultPage: String read FDefaultPage write FDefaultPage;
+    property DefaultFont: String read FDefaultFont write FDefaultFont;
+    
+    property OnProgress: TChmProgressCB read FOnProgress write FOnProgress;
+  end;
+
+implementation
+
+uses XmlCfg;
+
+{ TChmProject }
+
+function TChmProject.GetData(const DataName: String; out PathInChm: String; out
+  FileName: String; var Stream: TStream): Boolean;
+begin
+  Result := False; // Return true to abort compressing files
+
+  TMemoryStream(Stream).LoadFromFile(ProjectDir+DataName);
+  WriteLn('Reading: ', DataName);
+  // clean up the filename
+  FileName := StringReplace(ExtractFileName(DataName), '\', '/', [rfReplaceAll]);
+  FileName := StringReplace(FileName, '//', '/', [rfReplaceAll]);
+  
+  PathInChm := '/'+ExtractFilePath(DataName);
+  if Assigned(FOnProgress) then FOnProgress(Self, DataName);
+end;
+
+constructor TChmProject.Create;
+begin
+  FFiles := TStringList.Create;
+end;
+
+destructor TChmProject.Destroy;
+begin
+  FFIles.Free;
+  inherited Destroy;
+end;
+
+procedure TChmProject.LoadFromFile(AFileName: String);
+var
+  Cfg: TXMLConfig;
+  FileCount: Integer;
+  I: Integer;
+begin
+  Cfg := TXMLConfig.Create(nil);
+  Cfg.Filename := AFileName;
+  FileName := AFileName;
+  
+  Files.Clear;
+  FileCount := Cfg.GetValue('Files/Count/Value', 0);
+  for I := 0 to FileCount-1 do begin
+    Files.Add(Cfg.GetValue('Files/FileName'+IntToStr(I)+'/Value',''));
+  end;
+  IndexFileName := Cfg.GetValue('Files/IndexFile/Value','');
+  TableOfContentsFileName := Cfg.GetValue('Files/TOCFile/Value','');
+  
+  AutoFollowLinks := Cfg.GetValue('Settings/AutoFollowLinks/Value', False);
+  MakeSearchable := Cfg.GetValue('Settings/MakeSearchable/Value', False);
+  DefaultPage := Cfg.GetValue('Settings/DefaultPage/Value', '');
+  Title := Cfg.GetValue('Settings/Title/Value', '');
+  OutputFileName := Cfg.GetValue('Settings/OutputFileName/Value', '');
+  DefaultFont := Cfg.GetValue('Settings/DefaultFont/Value', '');
+  Cfg.Free;
+end;
+
+procedure TChmProject.SaveToFile(AFileName: String);
+var
+  Cfg: TXMLConfig;
+  I: Integer;
+
+begin
+  Cfg := TXMLConfig.Create(nil);
+  Cfg.StartEmpty := True;
+  Cfg.Filename := FileName;
+  Cfg.Clear;
+  Cfg.SetValue('Files/Count/Value', Files.Count);
+  for I := 0 to Files.Count-1 do begin
+    Cfg.SetValue('Files/FileName'+IntToStr(I)+'/Value', Files.Strings[I]);
+  end;
+  Cfg.SetValue('Files/IndexFile/Value', IndexFileName);
+  Cfg.SetValue('Files/TOCFile/Value', TableOfContentsFileName);
+
+  Cfg.SetValue('Settings/AutoFollowLinks/Value', AutoFollowLinks);
+  Cfg.SetValue('Settings/MakeSearchable/Value', MakeSearchable);
+  Cfg.SetValue('Settings/DefaultPage/Value', DefaultPage);
+  Cfg.SetValue('Settings/Title/Value', Title);
+  Cfg.SetValue('Settings/OutputFileName/Value', OutputFileName);
+  Cfg.SetValue('Settings/DefaultFont/Value', DefaultFont);
+  Cfg.Free;
+end;
+
+function TChmProject.ProjectDir: String;
+begin
+  Result := ExtractFilePath(FileName);
+end;
+
+procedure TChmProject.WriteChm(AOutStream: TStream);
+var
+  Writer: TChmWriter;
+  TOCStream,
+  IndexStream: TFileStream;
+begin
+  IndexStream := nil;
+  TOCStream := nil;
+
+  Writer := TChmWriter.Create(AOutStream, False);
+  // our callback to get data
+  Writer.OnGetFileData := @GetData;
+  
+  // give it the list of files
+  Writer.FilesToCompress.AddStrings(Files);
+
+  // Assign the TOC and index files
+  if (IndexFileName <> '') and FileExists(IndexFileName) then begin
+    IndexStream := TFileStream.Create(IndexFileName, fmOpenRead);
+    Writer.IndexStream := IndexStream;
+  end;
+  if (TableOfContentsFileName <> '') and FileExists(TableOfContentsFileName) then begin
+    TOCStream := TFileStream.Create(TableOfContentsFileName, fmOpenRead);
+    Writer.TOCStream := TOCStream;
+  end;
+  
+  // now some settings in the chm
+  Writer.DefaultPage := DefaultPage;
+  Writer.Title := Title;
+  Writer.DefaultFont := DefaultFont;
+  Writer.FullTextSearch := MakeSearchable;
+  
+  // and write!
+  Writer.Execute;
+  
+  if Assigned(TOCStream) then TOCStream.Free;
+  if Assigned(IndexStream) then IndexStream.Free;
+end;
+
+
+
+end.
+

+ 66 - 0
packages/extra/chm/chmls.lpi

@@ -0,0 +1,66 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="/"/>
+    <Version Value="5"/>
+    <General>
+      <MainUnit Value="0"/>
+      <IconPath Value="./"/>
+      <TargetFileExt Value=""/>
+      <ActiveEditorIndexAtStart Value="1"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+      <Language Value=""/>
+      <CharSet Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="chmls.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="chmls"/>
+        <CursorPos X="22" Y="66"/>
+        <TopLine Value="41"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="29"/>
+        <Loaded Value="True"/>
+      </Unit0>
+    </Units>
+    <JumpHistory Count="0">
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <SearchPaths>
+      <OtherUnitFiles Value="/home/andrew/programming/lazarus/components/chmhelp/packages/chm/"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="ECodetoolError"/>
+      </Item1>
+      <Item2>
+        <Name Value="EFOpenError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

+ 97 - 0
packages/extra/chm/chmls.lpr

@@ -0,0 +1,97 @@
+{ Copyright (C) <2005> <Andrew Haines> chmls.lpr
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING, included in this distribution,
+  for details about the copyright.
+}
+program chmls;
+
+{$IFDEF MSWINDOWS}
+{$apptype console}
+{$ENDIF}
+
+{$mode objfpc}{$H+}
+
+uses
+  Classes, chmreader, chmbase, Sysutils
+  { add your units here };
+type
+
+  { TJunkObject }
+
+  TJunkObject = class
+    procedure OnFileEntry(Name: String; Offset, UncompressedSize, ASection: Integer);
+  end;
+  
+
+var
+  ITS: TITSFReader;
+  Stream: TFileStream;
+  I : Integer;
+  Section: Integer = -1;
+  JunkObject: TJunkObject;
+
+procedure WriteStr(Str: String; CharWidth: Integer);
+  var
+    OutString: String;
+    Len: Integer;
+  begin
+    Len := Length(Str);
+    SetLength(OutString, CharWidth-Len);
+    FillChar(OutString[1], CharWidth-Len, ' ');
+
+    Write(OutString + Str); // to sdtout
+  end;
+
+{ TJunkObject }
+
+procedure TJunkObject.OnFileEntry(Name: String; Offset, UncompressedSize,
+  ASection: Integer);
+begin
+  Inc(I);
+  if (Section > -1) and (ASection <> Section) then Exit;
+  if (I = 1) or (I mod 40 = 0) then
+    WriteLn(StdErr, '<Section> <Offset> <UnCompSize>  <Name>');
+  Write(' ');
+  Write(ASection);
+  Write('      ');
+  WriteStr(IntToStr(Offset), 10);
+  Write('  ');
+  WriteStr(IntToStr(UncompressedSize), 11);
+  Write('  ');
+  WriteLn(Name);
+end;
+
+// Start of program
+begin
+  if Paramcount < 1 then begin
+    WriteLn('   Usage:  chmls filename.chm [section number]');
+    exit;
+  end;
+  if ParamCount > 1 then Section := StrToInt(ParamStr(2));
+  
+  Stream := TFileStream.Create(ParamStr(1), fmOpenRead);
+  JunkObject := TJunkObject.Create;
+  ITS:= TITSFReader.Create(Stream, True);
+  I := 0;
+  ITS.GetCompleteFileList(@JunkObject.OnFileEntry);
+  
+  WriteLn('Total Files in chm: ', I);
+  ITS.Free;
+  JunkObject.Free;
+end.
+

+ 1188 - 0
packages/extra/chm/chmreader.pas

@@ -0,0 +1,1188 @@
+{ Copyright (C) <2005> <Andrew Haines> chmreader.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.modifiedLGPL, included in this distribution,
+  for details about the copyright.
+}
+unit chmreader;
+
+{$mode objfpc}{$H+}
+
+//{$DEFINE CHM_DEBUG}
+{ $DEFINE CHM_DEBUG_CHUNKS}
+
+interface
+
+uses
+  Classes, SysUtils, chmbase, paslzx;
+  
+type
+
+  TLZXResetTableArr = array of QWord;
+  
+  PContextItem = ^TContextItem;
+  TContextItem = record
+    Context: THelpContext;
+    Url: String;
+  end;
+  
+  TContextList = class(TList)
+  public
+    procedure AddContext(Context: THelpContext; Url: String);
+    function GetURL(Context: THelpContext): String;
+    procedure Clear; override;
+  end;
+  { TITSFReader }
+
+  TFileEntryForEach = procedure(Name: String; Offset, UncompressedSize, Section: Integer) of object;
+
+  TITSFReader = class(TObject)
+  protected
+    fStream: TStream;
+    fFreeStreamOnDestroy: Boolean;
+    fChmHeader: TITSFHeader;
+    fHeaderSuffix: TITSFHeaderSuffix;
+    fDirectoryHeader: TITSPHeader;
+    fDirectoryHeaderPos: Int64;
+    fDirectoryHeaderLength: QWord;
+    fDirectoryEntriesStartPos: Int64;
+    fDirectoryEntries: array of TPMGListChunkEntry;
+    fCachedEntry: TPMGListChunkEntry; //contains the last entry found by ObjectExists
+    fDirectoryEntriesCount: LongWord;
+  private
+    procedure ReadHeader;
+    function  GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TPMGchunktype;
+    function  GetDirectoryChunk(Index: Integer; OutStream: TStream): Integer;
+    function  ReadPMGLchunkEntryFromStream(Stream: TMemoryStream; var PMGLEntry: TPMGListChunkEntry): Boolean;
+    function  ReadPMGIchunkEntryFromStream(Stream: TMemoryStream; var PMGIEntry: TPMGIIndexChunkEntry): Boolean;
+    procedure LookupPMGLchunk(Stream: TMemoryStream; out PMGLChunk: TPMGListChunk);
+    procedure LookupPMGIchunk(Stream: TMemoryStream; out PMGIChunk: TPMGIIndexChunk);
+
+    procedure GetSections(out Sections: TStringList);
+    function  GetBlockFromSection(SectionPrefix: String; StartPos: QWord; BlockLength: QWord): TMemoryStream;
+    function  FindBlocksFromUnCompressedAddr(var ResetTableEntry: TPMGListChunkEntry;
+       out CompressedSize: Int64; out UnCompressedSize: Int64; out LZXResetTable: TLZXResetTableArr): QWord;  // Returns the blocksize
+  public
+    constructor Create(AStream: TStream; FreeStreamOnDestroy: Boolean); virtual;
+    destructor Destroy; override;
+  public
+    ChmLastError: LongInt;
+    function IsValidFile: Boolean;
+    procedure GetCompleteFileList(ForEach: TFileEntryForEach);
+    function ObjectExists(Name: String): QWord; // zero if no. otherwise it is the size of the object
+                                                // NOTE directories will return zero size even if they exist
+    function GetObject(Name: String): TMemoryStream; // YOU must Free the stream
+    property CachedEntry: TPMGListChunkEntry read fCachedEntry;
+  end;
+  
+  { TChmReader }
+
+  TChmReader = class(TITSFReader)
+  protected
+    fDefaultPage: String;
+    fIndexFile: String;
+    fTOCFile: String;
+    fTitle: String;
+    fPreferedFont: String;
+    fContextList: TContextList;
+    fLocaleID: DWord;
+  private
+    procedure ReadCommonData;
+  public
+    constructor Create(AStream: TStream; FreeStreamOnDestroy: Boolean); override;
+    destructor Destroy; override;
+  public
+    function GetContextUrl(Context: THelpContext): String;
+    function HasContextList: Boolean;
+    property DefaultPage: String read fDefaultPage;
+    property IndexFile: String read fIndexFile;
+    property TOCFile: String read fTOCFile;
+    property Title: String read fTitle write fTitle;
+    property PreferedFont: String read fPreferedFont;
+    property LocaleID: dword read fLocaleID;
+  end;
+
+  { TChmFileList }
+  TChmFileList = class;
+  TChmFileOpenEvent = procedure(ChmFileList: TChmFileList; Index: Integer) of object;
+  TChmFileList = class(TStringList)
+  protected
+    fLastChm: TChmReader;
+    fUnNotifiedFiles: TList;
+    fOnOpenNewFile: TChmFileOpenEvent;
+    procedure Delete(Index: Integer); override;
+    function GetChm(AIndex: Integer): TChmReader;
+    function GetFileName(AIndex: Integer): String;
+    procedure OpenNewFile(AFileName: String);
+    function CheckOpenFile(AFileName: String): Boolean;
+    function MetaObjectExists(var Name: String): QWord;
+    function MetaGetObject(Name: String): TMemoryStream;
+    procedure SetOnOpenNewFile(AValue: TChmFileOpenEvent);
+  public
+    constructor Create(PrimaryFileName: String);
+    destructor Destroy; override;
+    function GetObject(Name: String): TMemoryStream;
+    function IsAnOpenFile(AFileName: String): Boolean;
+    function ObjectExists(Name: String; fChm: TChmReader = nil): QWord;
+    //properties
+    property Chm[Index: Integer]: TChmReader read GetChm;
+    property FileName[Index: Integer]: String read GetFileName;
+    property OnOpenNewFile: TChmFileOpenEvent read fOnOpenNewFile write SetOnOpenNewFile;
+  end;
+  
+//ErrorCodes
+const
+  ERR_NO_ERR = 0;
+  ERR_STREAM_NOT_ASSIGNED = 1;
+  ERR_NOT_SUPPORTED_VERSION = 2;
+  ERR_NOT_VALID_FILE = 3;
+  ERR_UNKNOWN_ERROR = 10;
+  
+  function ChmErrorToStr(Error: Integer): String;
+
+implementation
+
+function ChmErrorToStr(Error: Integer): String;
+begin
+  Result := '';
+  case Error of
+    ERR_STREAM_NOT_ASSIGNED    : Result := 'ERR_STREAM_NOT_ASSIGNED';
+    ERR_NOT_SUPPORTED_VERSION  : Result := 'ERR_NOT_SUPPORTED_VERSION';
+    ERR_NOT_VALID_FILE         : Result := 'ERR_NOT_VALID_FILE';
+    ERR_UNKNOWN_ERROR          : Result := 'ERR_UNKNOWN_ERROR';
+  end;
+end;
+
+function ChunkType(Stream: TMemoryStream): TPMGchunktype;
+var
+  ChunkID: array[0..3] of char;
+begin
+  Result := ctUnknown;
+  if Stream.Size< 4 then exit;
+  Move(Stream.Memory^, ChunkId[0], 4);
+  if ChunkID = 'PMGL' then Result := ctPMGL
+  else if ChunkID = 'PMGI' then Result := ctPMGI;
+end;
+
+{ TITSFReader }
+
+procedure TITSFReader.ReadHeader;
+var
+fHeaderEntries: array [0..1] of TITSFHeaderEntry;
+begin
+  fStream.Position := 0;
+  fStream.Read(fChmHeader,SizeOf(fChmHeader));
+
+  // Fix endian issues
+  {$IFDEF ENDIAN_BIG}
+  fChmHeader.Version := LEtoN(fChmHeader.Version);
+  fChmHeader.HeaderLength := LEtoN(fChmHeader.HeaderLength);
+  //Unknown_1
+  fChmHeader.TimeStamp := BEtoN(fChmHeader.TimeStamp);//bigendian
+  fChmHeader.LanguageID := LEtoN(fChmHeader.LanguageID);
+  //Guid1
+  //Guid2
+  {$ENDIF}
+  
+  if not IsValidFile then Exit;
+  
+  // Copy EntryData into memory
+  fStream.Read(fHeaderEntries[0], SizeOf(fHeaderEntries));
+
+  if fChmHeader.Version > 2 then
+    fStream.Read(fHeaderSuffix.Offset, SizeOf(QWord));
+  fHeaderSuffix.Offset := LEtoN(fHeaderSuffix.Offset);
+  // otherwise this is set in fill directory entries
+  
+  fStream.Position := LEtoN(fHeaderEntries[1].PosFromZero);
+  fDirectoryHeaderPos := LEtoN(fHeaderEntries[1].PosFromZero);
+  fStream.Read(fDirectoryHeader, SizeOf(fDirectoryHeader));
+  {$IFDEF ENDIAN_BIG}
+  with fDirectoryHeader do begin
+    Version := LEtoN(Version);
+    DirHeaderLength := LEtoN(DirHeaderLength);
+    //Unknown1
+    ChunkSize := LEtoN(ChunkSize);
+    Density := LEtoN(Density);
+    IndexTreeDepth := LEtoN(IndexTreeDepth);
+    IndexOfRootChunk := LEtoN(IndexOfRootChunk);
+    FirstPMGLChunkIndex := LEtoN(FirstPMGLChunkIndex);
+    LastPMGLChunkIndex := LEtoN(LastPMGLChunkIndex);
+    //Unknown2
+    DirectoryChunkCount := LEtoN(DirectoryChunkCount);
+    LanguageID := LEtoN(LanguageID);
+    //GUID: TGuid;
+    LengthAgain := LEtoN(LengthAgain);
+  end;
+  {$ENDIF}
+  {$IFDEF CHM_DEBUG}
+  WriteLn('PMGI depth = ', fDirectoryHeader.IndexTreeDepth);
+  WriteLn('PMGI Root =  ', fDirectoryHeader.IndexOfRootChunk);
+  {$ENDIF}
+  fDirectoryEntriesStartPos := fStream.Position;
+  fDirectoryHeaderLength := LEtoN(fHeaderEntries[1].Length);
+end;
+
+procedure TChmReader.ReadCommonData;
+   // A little helper proc to make reading a null terminated string easier
+   function ReadString(const Stream: TStream): String;
+   var
+     buf: array[0..49] of char;
+   begin
+     Result := '';
+     repeat
+       Stream.Read(buf, 50);
+       Result := Result + buf;
+     until Pos(#0, buf) > -1;
+   end;
+   procedure ReadFromSystem;
+   var
+     //Version: DWord;
+     EntryType: Word;
+     EntryLength: Word;
+     Data: array[0..511] of char;
+     fSystem: TMemoryStream;
+     Tmp: String;
+   begin
+     fSystem := TMemoryStream(GetObject('/#SYSTEM'));
+     if fSystem = nil then begin
+       exit;
+     end;
+     fSystem.Position := 0;
+     if fSystem.Size < SizeOf(DWord) then begin
+       fSystem.Free;
+       Exit;
+     end;
+     {Version := }LEtoN(fSystem.ReadDWord);
+     while fSystem.Position < fSystem.Size do begin
+       EntryType := LEtoN(fSystem.ReadWord);
+       EntryLength := LEtoN(fSystem.ReadWord);
+       case EntryType of
+         0: // Table of contents
+         begin
+           if EntryLength > 511 then EntryLength := 511;
+           fSystem.Read(Data[0], EntryLength);
+           Data[EntryLength] := #0;
+           fTOCFile := '/'+Data;
+         end;
+         1: // Index File
+         begin
+           if EntryLength > 511 then EntryLength := 511;
+           fSystem.Read(Data[0], EntryLength);
+           Data[EntryLength] := #0;
+           fIndexFile := '/'+Data;
+         end;
+         2: // DefaultPage
+         begin
+           if EntryLength > 511 then EntryLength := 511;
+           fSystem.Read(Data[0], EntryLength);
+           Data[EntryLength] := #0;
+           fDefaultPage := '/'+Data;
+         end;
+         3: // Title of chm
+         begin
+           if EntryLength > 511 then EntryLength := 511;
+           fSystem.Read(Data[0], EntryLength);
+           Data[EntryLength] := #0;
+           fTitle := Data;
+         end;
+         4: // Locale ID
+         begin
+           fLocaleID := LEtoN(fSystem.ReadDWord);
+           fSystem.Position := (fSystem.Position + EntryLength) - SizeOf(DWord);
+         end;
+         6: // chm file name. use this to get the index and toc name
+         begin
+           if EntryLength > 511 then EntryLength := 511;
+           fSystem.Read(Data[0], EntryLength);
+           Data[EntryLength] := #0;
+           if (fIndexFile = '') then begin
+             Tmp := '/'+Data+'.hhk';
+             if (ObjectExists(Tmp) > 0) then begin
+               fIndexFile := Tmp;
+             end
+           end;
+           if (fTOCFile = '') then begin
+             Tmp := '/'+Data+'.hhc';
+             if (ObjectExists(Tmp) > 0) then begin
+               fTOCFile := Tmp;
+             end;
+           end;
+         end;
+         16: // Prefered font
+         begin
+           if EntryLength > 511 then EntryLength := 511;
+           fSystem.Read(Data[0], EntryLength);
+           Data[EntryLength] := #0;
+           fPreferedFont := Data;
+         end;
+       else
+         // Skip entries we are not interested in
+         fSystem.Position := fSystem.Position + EntryLength;
+       end;
+     end;
+     fSystem.Free;
+   end;
+   procedure ReadFromWindows;
+   var
+     fWindows,
+     fStrings: TMemoryStream;
+     EntryCount,
+     EntrySize: DWord;
+     EntryStart: Int64;
+     StrPosition: DWord;
+     X: Integer;
+     OffSet: Int64;
+   begin
+     fWindows := TMemoryStream(GetObject('/#WINDOWS'));
+     if fWindows = nil then begin
+       exit;
+     end;
+     fStrings := TMemoryStream(GetObject('/#STRINGS'));
+     if fStrings = nil then begin
+       if fWindows <> nil then fWindows.Free;
+       Exit;
+     end;
+     fWindows.Position := 0;
+     if (fWindows.Size = 0) or (fStrings.Size = 0) then begin
+       fWindows.Free;
+       fStrings.Free;
+       Exit;
+     end;
+     EntryCount := LEtoN(fWindows.ReadDWord);
+     EntrySize := LEtoN(fWindows.ReadDWord);
+     OffSet := fWindows.Position;
+     for X := 0 to EntryCount -1 do begin
+       EntryStart := OffSet + (X*EntrySize);
+       if fTitle = '' then begin
+         fWindows.Position := EntryStart + $14;
+         StrPosition := LEtoN(fWindows.ReadDWord);
+         fStrings.Position := StrPosition;
+         fTitle := '/'+ReadString(fStrings);
+       end;
+       if fTOCFile = '' then begin
+         fWindows.Position := EntryStart + $60;
+         StrPosition := LEtoN(fWindows.ReadDWord);
+         fStrings.Position := StrPosition;
+         fTOCFile := '/'+ReadString(fStrings);
+       end;
+       if fIndexFile = '' then begin
+         fWindows.Position := EntryStart + $64;
+         StrPosition := LEtoN(fWindows.ReadDWord);
+         fStrings.Position := StrPosition;
+         fIndexFile := '/'+ReadString(fStrings);
+       end;
+       if fDefaultPage = '' then begin
+         fWindows.Position := EntryStart + $68;
+         StrPosition := LEtoN(fWindows.ReadDWord);
+         fStrings.Position := StrPosition;
+         fDefaultPage := '/'+ReadString(fStrings);
+       end;
+     end;
+   end;
+   procedure ReadContextIds;
+   var
+     fIVB,
+     fStrings: TStream;
+     Str: String;
+     Value: DWord;
+     OffSet: DWord;
+     //TotalSize: DWord;
+   begin
+     fIVB := GetObject('/#IBV');
+     if fIVB = nil then Exit;
+     fStrings := GetObject('/#STRINGS');
+     if fStrings = nil then begin
+       fIVB.Free;
+       Exit;
+     end;
+     fIVB.Position := 0;
+     {TotalSize := }LEtoN(fIVB.ReadDWord);
+     while fIVB.Position < fIVB.Size do begin
+       Value := LEtoN(fIVB.ReadDWord);
+       OffSet := LEtoN(fIVB.ReadDWord);
+       fStrings.Position := Offset;
+       Str := '/'+ReadString(fStrings);
+       fContextList.AddContext(Value, Str);
+     end;
+   end;
+begin
+   ReadFromSystem;
+   ReadFromWindows;
+   ReadContextIds;
+   {$IFDEF CHM_DEBUG}   
+   WriteLn('TOC=',fTocfile);
+   WriteLn('DefaultPage=',fDefaultPage);
+   {$ENDIF}
+end;
+
+constructor TChmReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean);
+begin
+  inherited Create(AStream, FreeStreamOnDestroy);
+  if not IsValidFile then exit;
+
+  fContextList := TContextList.Create;
+  ReadCommonData;
+end;
+
+destructor TChmReader.Destroy;
+begin
+  fContextList.Free;
+  inherited Destroy;
+end;
+
+function TITSFReader.GetChunkType(Stream: TMemoryStream; ChunkIndex: LongInt): TPMGchunktype;
+var
+  Sig: array[0..3] of char;
+begin
+  Result := ctUnknown;
+  Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex);
+
+  Stream.Read(Sig, 4);
+  if Sig = 'PMGL' then Result := ctPMGL
+  else if Sig = 'PMGI' then Result := ctPMGI;
+end;
+
+function TITSFReader.GetDirectoryChunk(Index: Integer; OutStream: TStream): Integer;
+begin
+  Result := Index;
+  fStream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * Index);
+  OutStream.Position := 0;
+  OutStream.Size := fDirectoryHeader.ChunkSize;
+  OutStream.CopyFrom(fStream, fDirectoryHeader.ChunkSize);
+  OutStream.Position := 0;
+end;
+
+procedure TITSFReader.LookupPMGLchunk(Stream: TMemoryStream; out PMGLChunk: TPMGListChunk);
+begin
+  //Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex);
+  Stream.Read(PMGLChunk, SizeOf(PMGLChunk));
+  {$IFDEF ENDIAN_BIG}
+  with PMGLChunk do begin
+    UnusedSpace := LEtoN(UnusedSpace);
+    //Unknown1
+    PreviousChunkIndex := LEtoN(PreviousChunkIndex);
+    NextChunkIndex := LEtoN(NextChunkIndex);
+  end;
+  {$ENDIF}
+end;
+
+function TITSFReader.ReadPMGLchunkEntryFromStream(Stream: TMemoryStream; var PMGLEntry: TPMGListChunkEntry): Boolean;
+var
+Buf: array [0..1023] of char;
+NameLength: LongInt;
+begin
+  Result := False;
+  //Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex);
+  NameLength := LongInt(GetCompressedInteger(Stream));
+
+  if NameLength > 1022 then NameLength := 1022;
+  Stream.Read(buf[0], NameLength);
+  buf[NameLength] := #0;
+  PMGLEntry.Name := buf;
+  PMGLEntry.ContentSection := LongWord(GetCompressedInteger(Stream));
+  PMGLEntry.ContentOffset := GetCompressedInteger(Stream);
+  PMGLEntry.DecompressedLength := GetCompressedInteger(Stream);
+  if NameLength = 0 then Exit; // failed GetCompressedInteger sanity check
+  Result := True;
+end;
+
+procedure TITSFReader.LookupPMGIchunk(Stream: TMemoryStream; out PMGIChunk: TPMGIIndexChunk);
+begin
+  //Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex);
+  Stream.Read(PMGIChunk, SizeOf(PMGIChunk));
+  {$IFDEF ENDIAN_BIG}
+  with PMGIChunk do begin
+    UnusedSpace := LEtoN(UnusedSpace);
+  end;
+  {$ENDIF}
+end;
+
+function TITSFReader.ReadPMGIchunkEntryFromStream(Stream: TMemoryStream;
+  var PMGIEntry: TPMGIIndexChunkEntry): Boolean;
+var
+Buf: array [0..1023] of char;
+NameLength: LongInt;
+begin
+  Result := False;
+  //Stream.Position := fDirectoryEntriesStartPos + (fDirectoryHeader.ChunkSize * ChunkIndex);
+  NameLength := LongInt(GetCompressedInteger(Stream));
+  if NameLength > 1023 then NameLength := 1023;
+  Stream.Read(buf, NameLength);
+
+  buf[NameLength] := #0;
+  PMGIEntry.Name := buf;
+  
+  PMGIEntry.ListingChunk := GetCompressedInteger(Stream);
+  if NameLength = 0 then Exit; // failed GetCompressedInteger sanity check
+  Result := True;
+end;
+
+constructor TITSFReader.Create(AStream: TStream; FreeStreamOnDestroy: Boolean);
+begin
+  fStream := AStream;
+  fFreeStreamOnDestroy := FreeStreamOnDestroy;
+  ReadHeader;
+  if not IsValidFile then Exit;
+end;
+
+destructor TITSFReader.Destroy;
+begin
+  SetLength(fDirectoryEntries, 0);
+  if fFreeStreamOnDestroy then FreeAndNil(fStream);
+
+  inherited Destroy;
+end;
+
+function TITSFReader.IsValidFile: Boolean;
+begin
+  if (fStream = nil) then ChmLastError := ERR_STREAM_NOT_ASSIGNED
+  else if (fChmHeader.ITSFsig <> 'ITSF') then ChmLastError := ERR_NOT_VALID_FILE
+  else if (fChmHeader.Version <> 2) and (fChmHeader.Version <> 3) then
+    ChmLastError := ERR_NOT_SUPPORTED_VERSION;
+  Result := ChmLastError = ERR_NO_ERR;
+end;
+
+procedure TITSFReader.GetCompleteFileList(ForEach: TFileEntryForEach);
+var
+  ChunkStream: TMemoryStream;
+  I : Integer;
+  Entry: TPMGListChunkEntry;
+  PMGLChunk: TPMGListChunk;
+  CutOffPoint: Integer;
+  NameLength: Integer;
+  {$IFDEF CHM_DEBUG_CHUNKS}
+  PMGIChunk: TPMGIIndexChunk;
+  PMGIndex: Integer;
+  {$ENDIF}
+begin
+  if ForEach = nil then Exit;
+  ChunkStream := TMemoryStream.Create;
+  {$IFDEF CHM_DEBUG_CHUNKS}
+  WriteLn('ChunkCount = ',fDirectoryHeader.DirectoryChunkCount);
+  {$ENDIF}
+  for I := 0 to fDirectoryHeader.DirectoryChunkCount-1 do begin
+    GetDirectoryChunk(I, ChunkStream);
+    case ChunkType(ChunkStream) of
+    ctPMGL:
+     begin
+       LookupPMGLchunk(ChunkStream, PMGLChunk);
+       {$IFDEF CHM_DEBUG_CHUNKS}
+        WriteLn('PMGL: ', I, ' Prev PMGL: ', PMGLChunk.PreviousChunkIndex, ' Next PMGL: ', PMGLChunk.NextChunkIndex);
+       {$ENDIF}
+       CutOffPoint := ChunkStream.Size - PMGLChunk.UnusedSpace;
+       while ChunkStream.Position <  CutOffPoint do begin
+         NameLength := GetCompressedInteger(ChunkStream);
+         if (ChunkStream.Position > CutOffPoint) then Continue; // we have entered the quickref section
+         SetLength(Entry.Name, NameLength);
+         ChunkStream.ReadBuffer(Entry.Name[1], NameLength);
+         if (Entry.Name = '') or (ChunkStream.Position > CutOffPoint) then Break; // we have entered the quickref section
+         Entry.ContentSection := GetCompressedInteger(ChunkStream);
+         if ChunkStream.Position > CutOffPoint then Break; // we have entered the quickref section
+         Entry.ContentOffset := GetCompressedInteger(ChunkStream);
+         if ChunkStream.Position > CutOffPoint then Break; // we have entered the quickref section
+         Entry.DecompressedLength := GetCompressedInteger(ChunkStream);
+         if ChunkStream.Position > CutOffPoint then Break; // we have entered the quickref section
+         fCachedEntry := Entry; // if the caller trys to get this data we already know where it is :)
+         ForEach(Entry.Name, Entry.ContentOffset, Entry.DecompressedLength, Entry.ContentSection);
+       end;
+     end;
+    {$IFDEF CHM_DEBUG_CHUNKS}
+    ctPMGI:
+     begin
+       WriteLn('PMGI: ', I);
+       LookupPMGIchunk(ChunkStream, PMGIChunk);
+       CutOffPoint := ChunkStream.Size - PMGIChunk.UnusedSpace - 10;
+       while ChunkStream.Position <  CutOffPoint do begin
+         NameLength := GetCompressedInteger(ChunkStream);
+         SetLength(Entry.Name, NameLength);
+         ChunkStream.ReadBuffer(Entry.Name[1], NameLength);
+         PMGIndex := GetCompressedInteger(ChunkStream);
+         WriteLn(Entry.Name, '  ', PMGIndex);
+       end;
+     end;
+    ctUnknown: WriteLn('UNKNOWN CHUNKTYPE!' , I);
+    {$ENDIF}
+    end;
+  end;
+end;
+
+function TITSFReader.ObjectExists(Name: String): QWord;
+var
+  ChunkStream: TMemoryStream;
+  QuickRefCount: Word;
+  QuickRefIndex: array of Word;
+  ItemCount: Integer;
+  procedure ReadQuickRefSection;
+  var
+    OldPosn: Int64;
+    Posn: Integer;
+    I: Integer;
+  begin
+    OldPosn := ChunkStream.Position;
+    Posn := ChunkStream.Size-1-SizeOf(Word);
+    ChunkStream.Position := Posn;
+    
+    ItemCount := LEToN(ChunkStream.ReadWord);
+    //WriteLn('Max ITems for next block = ', ItemCount-1);
+    QuickRefCount := ItemCount  div (1 + (1 shl fDirectoryHeader.Density));
+    //WriteLn('QuickRefCount = ' , QuickRefCount);
+    SetLength(QuickRefIndex, QuickRefCount+1);
+    for I := 1 to QuickRefCount do begin
+      Dec(Posn, SizeOf(Word));
+      ChunkStream.Position := Posn;
+      QuickRefIndex[I] := LEToN(ChunkStream.ReadWord);
+    end;
+    Inc(QuickRefCount);
+    ChunkStream.Position := OldPosn;
+  end;
+  function ReadString(StreamPosition: Integer = -1): String;
+  var
+    NameLength: Integer;
+  begin
+    if StreamPosition > -1 then ChunkStream.Position := StreamPosition;
+
+    NameLength := GetCompressedInteger(ChunkStream);
+    SetLength(Result, NameLength);
+    ChunkStream.Read(Result[1], NameLength);
+  end;
+var
+  PMGLChunk: TPMGListChunk;
+  PMGIChunk: TPMGIIndexChunk;
+  //ChunkStream: TMemoryStream; declared above  
+  Entry: TPMGListChunkEntry;
+  NextIndex: Integer;
+  EntryName: String;  
+  CRes: Integer;
+  I: Integer;
+begin
+  Result := 0;
+
+  if Name = '' then Exit;
+  if fDirectoryHeader.DirectoryChunkCount = 0 then exit;
+
+  //WriteLn('Looking for ', Name);
+  if Name = fCachedEntry.Name then
+    Exit(fCachedEntry.DecompressedLength); // we've already looked it up
+
+  ChunkStream := TMemoryStream.Create;
+
+  try
+  
+  NextIndex := fDirectoryHeader.IndexOfRootChunk;
+  if NextIndex < 0 then NextIndex := 0; // no PMGI chunks
+  
+  while NextIndex > -1  do begin
+    GetDirectoryChunk(NextIndex, ChunkStream);
+    NextIndex := -1;
+    ReadQuickRefSection;
+    //WriteLn('In Block ', ChunkIndex);
+    case ChunkType(ChunkStream) of
+      ctUnknown: // something is wrong
+        begin
+          {$IFDEF CHM_DEBUG}WriteLn(ChunkIndex, ' << Unknown BlockType!');{$ENDIF}
+          Break;
+        end;
+      ctPMGI: // we must follow the PMGI tree until we reach a PMGL block
+        begin
+          LookupPMGIchunk(ChunkStream, PMGIChunk);          
+
+          //QuickRefIndex[0] := ChunkStream.Position;
+
+          I := 0;
+          while ChunkStream.Position <= ChunkStream.Size - PMGIChunk.UnusedSpace do begin;
+            EntryName := ReadString;
+            if EntryName = '' then break;
+            if ChunkStream.Position >= ChunkStream.Size - PMGIChunk.UnusedSpace then break;
+            CRes := ChmCompareText(Name, EntryName);
+            if CRes = 0 then begin
+              // no more need of this block. onto the next!              
+              NextIndex := GetCompressedInteger(ChunkStream);
+              Break;
+            end;
+            if  CRes < 0 then begin
+              if I = 0 then Break; // File doesn't exist
+              // file is in previous entry              
+              Break;
+            end;
+            NextIndex := GetCompressedInteger(ChunkStream);
+            Inc(I);
+          end;
+        end;
+      ctPMGL:
+        begin
+          LookupPMGLchunk(ChunkStream, PMGLChunk);
+          QuickRefIndex[0] := ChunkStream.Position;
+          I := 0;
+          while ChunkStream.Position <= ChunkStream.Size - PMGLChunk.UnusedSpace do begin
+            // we consume the entry by reading it            
+            Entry.Name := ReadString;
+            if Entry.Name = '' then break;
+            if ChunkStream.Position >= ChunkStream.Size - PMGLChunk.UnusedSpace then break;
+
+            Entry.ContentSection := GetCompressedInteger(ChunkStream);
+            Entry.ContentOffset := GetCompressedInteger(ChunkStream);
+            Entry.DecompressedLength := GetCompressedInteger(ChunkStream);
+
+            CRes := ChmCompareText(Name, Entry.Name);
+            if CRes = 0 then begin
+              fCachedEntry := Entry;
+              Result := Entry.DecompressedLength;              
+              Break;
+            end;
+            Inc(I);
+          end;
+        end; // case
+    end;
+  end;
+  finally
+  ChunkStream.Free;
+  end;
+end;
+
+function TITSFReader.GetObject(Name: String): TMemoryStream;
+var
+  SectionNames: TStringList;
+  Entry: TPMGListChunkEntry;
+  SectionName: String;
+begin
+  Result := nil;
+  if ObjectExists(Name) = 0 then begin
+    //WriteLn('Object ', name,' Doesn''t exist or is zero sized.');
+    Exit;
+  end;
+
+  Entry := fCachedEntry;
+  if Entry.ContentSection = 0 then begin
+    Result := TMemoryStream.Create;
+    fStream.Position := fHeaderSuffix.Offset+ Entry.ContentOffset;
+    Result.CopyFrom(fStream, fCachedEntry.DecompressedLength);
+  end
+  else begin // we have to get it from ::DataSpace/Storage/[MSCompressed,Uncompressed]/ControlData
+    GetSections(SectionNames);
+    FmtStr(SectionName, '::DataSpace/Storage/%s/',[SectionNames[Entry.ContentSection-1]]);
+    Result := GetBlockFromSection(SectionName, Entry.ContentOffset, Entry.DecompressedLength);
+    SectionNames.Free;
+  end;
+  if Result <> nil then Result.Position := 0;
+end;
+
+function TChmReader.GetContextUrl(Context: THelpContext): String;
+begin
+  // will get '' if context not found
+ Result := fContextList.GetURL(Context);
+end;
+
+function TChmReader.HasContextList: Boolean;
+begin
+  Result := fContextList.Count > 0;
+end;
+
+procedure TITSFReader.GetSections(out Sections: TStringList);
+var
+  Stream: TStream;
+  EntryCount: Word;
+  X: Integer;
+  {$IFDEF ENDIAN_BIG}
+  I: Integer;
+  {$ENDIF}
+  WString: array [0..31] of WideChar;
+  StrLength: Word;
+begin
+  Sections := TStringList.Create;
+  //WriteLn('::DataSpace/NameList Size = ', ObjectExists('::DataSpace/NameList'));
+  Stream := GetObject('::DataSpace/NameList');
+
+  if Stream = nil then begin
+    //WriteLn('Failed to get ::DataSpace/NameList!');
+    exit;
+  end;
+  
+  Stream.Position := 2;
+  EntryCount := LEtoN(Stream.ReadWord);
+  for X := 0 to EntryCount -1 do begin
+    StrLength := LEtoN(Stream.ReadWord);
+    if StrLength > 31 then StrLength := 31;
+    Stream.Read(WString, SizeOf(WideChar)*(StrLength+1)); // the strings are stored null terminated
+    {$IFDEF ENDIAN_BIG}
+    for I := 0 to StrLength-1 do
+      WString[I] := WideChar(LEtoN(Ord(WString[I])));
+    {$ENDIF}
+    Sections.Add(WString);
+  end;
+  // the sections are sorted alphabetically, this way section indexes will jive
+  Sections.Sort;
+  Stream.Free;
+end;
+
+function TITSFReader.GetBlockFromSection(SectionPrefix: String; StartPos: QWord;
+  BlockLength: QWord): TMemoryStream;
+var
+  Compressed: Boolean;
+  Sig: Array [0..3] of char;
+  CompressionVersion: LongWord;
+  CompressedSize: Int64;
+  UnCompressedSize: Int64;
+  //LZXResetInterval: LongWord;
+  //LZXWindowSize: LongWord;
+  //LZXCacheSize: LongWord;
+  ResetTableEntry: TPMGListChunkEntry;
+  ResetTable: TLZXResetTableArr;
+  WriteCount: QWord;
+  BlockWriteLength: QWord;
+  WriteStart: LongWord;
+  ReadCount:LongInt;
+  LZXState: PLZXState;
+  InBuf: array of Byte;
+  OutBuf: PByte;
+  BlockSize: QWord;
+  X: Integer;
+  FirstBlock, LastBlock: LongInt;
+  ResultCode: LongInt;
+  procedure ReadBlock;
+  begin
+    if ReadCount > Length(InBuf) then
+      SetLength(InBuf, ReadCount);
+    fStream.Read(InBuf[0], ReadCount);
+  end;
+begin
+  // okay now the fun stuff ;)
+  Result := nil;
+  Compressed := ObjectExists(SectionPrefix+'Transform/{7FC28940-9D31-11D0-9B27-00A0C91E9C7C}/InstanceData/ResetTable')>0;
+  // the easy method
+  if Not(Compressed) then begin
+    if ObjectExists(SectionPrefix+'Content') > 0 then begin
+      Result := TMemoryStream.Create;
+      fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + StartPos;
+      Result.CopyFrom(fStream, BlockLength);
+    end;
+    Exit;
+  end
+  else
+    ResetTableEntry := fCachedEntry;
+
+  // First make sure that it is a compression we can read
+  if ObjectExists(SectionPrefix+'ControlData') > 0 then begin
+    fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + 4;
+    fStream.Read(Sig, 4);
+    if Sig <> 'LZXC' then Exit;
+    CompressionVersion := LEtoN(fStream.ReadDWord);
+    if CompressionVersion > 2 then exit;
+    {LZXResetInterval := }LEtoN(fStream.ReadDWord);
+    {LZXWindowSize := }LEtoN(fStream.ReadDWord);
+    {LZXCacheSize := }LEtoN(fStream.ReadDWord);
+
+
+    BlockSize := FindBlocksFromUnCompressedAddr(ResetTableEntry, CompressedSize, UnCompressedSize, ResetTable);
+    if UncompressedSize > 0 then ; // to avoid a compiler note
+    if StartPos > 0 then
+      FirstBlock := StartPos div BlockSize
+    else
+      FirstBlock := 0;
+    LastBlock := (StartPos+BlockLength) div BlockSize;
+
+    if ObjectExists(SectionPrefix+'Content') = 0 then exit;
+    //WriteLn('Compressed Data start''s at: ', fHeaderSuffix.Offset + fCachedEntry.ContentOffset,' Size is: ', fCachedEntry.DecompressedLength);
+    Result := TMemoryStream.Create;
+    Result.Size := BlockLength;
+    SetLength(InBuf,BlockSize);
+    OutBuf := GetMem(BlockSize);
+    // First Init a PLZXState
+    LZXState := LZXinit(16);
+    if LZXState = nil then begin
+      Exit;
+    end;
+    // if FirstBlock is odd (1,3,5,7 etc) we have to read the even block before it first.
+    if (FirstBlock <> 0) and (FirstBlock mod 2 > 0) then begin
+      fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + (ResetTable[FirstBLock-1]);
+      ReadCount := ResetTable[FirstBlock] - ResetTable[FirstBlock-1];
+      BlockWriteLength:=BlockSize;
+      ReadBlock;
+      ResultCode := LZXdecompress(LZXState, @InBuf[0], OutBuf, ReadCount, LongInt(BlockWriteLength));
+    end;
+    // now start the actual decompression loop
+    for X := FirstBlock to LastBlock do begin
+      fStream.Position := fHeaderSuffix.Offset + fCachedEntry.ContentOffset + (ResetTable[X]);
+
+      if X = FirstBLock then
+        WriteStart := StartPos - (X*BlockSize)
+      else
+        WriteStart := 0;
+
+      if X = High(ResetTable) then
+        ReadCount := CompressedSize - ResetTable[X]
+      else
+        ReadCount := ResetTable[X+1] - ResetTable[X];
+
+      BlockWriteLength := BlockSize;
+      
+      if FirstBlock = LastBlock then begin
+        WriteCount := BlockLength;
+      end
+      else if X = LastBlock then
+        WriteCount := (StartPos+BlockLength) - (X*BlockSize)
+      else WriteCount := BlockSize - WriteStart;
+
+      ReadBlock;
+      ResultCode := LZXdecompress(LZXState, @InBuf[0], OutBuf, ReadCount, LongInt(BlockWriteLength));
+
+      //now write the decompressed data to the stream
+      if ResultCode = DECR_OK then begin
+        Result.Write(OutBuf[WriteStart], Int64(WriteCount));
+      end
+      else begin
+        {$IFDEF CHM_DEBUG} // windows gui program will cause an exception with writeln's
+        WriteLn('Decompress FAILED with error code: ', ResultCode);
+        {$ENDIF}
+        Result.Free;
+        Result := Nil;
+        FreeMem(OutBuf);
+        SetLength(ResetTable,0);
+        LZXteardown(LZXState);
+        Exit;
+      end;
+      
+      // if the next block is an even numbered block we have to reset the decompressor state
+      if (X < LastBlock) and (X mod 2 > 0) then LZXreset(LZXState);
+
+    end;
+    FreeMem(OutBuf);
+    SetLength(ResetTable,0);
+    LZXteardown(LZXState);
+  end;
+end;
+
+function TITSFReader.FindBlocksFromUnCompressedAddr(var ResetTableEntry: TPMGListChunkEntry;
+  out CompressedSize: Int64; out UnCompressedSize: Int64; out LZXResetTable: TLZXResetTableArr): QWord;
+var
+  BlockCount: LongWord;
+  {$IFDEF ENDIAN_BIG}
+  I: Integer;
+  {$ENDIF}
+begin
+  Result := 0;
+  fStream.Position := fHeaderSuffix.Offset + ResetTableEntry.ContentOffset;
+  fStream.ReadDWord;
+  BlockCount := LEtoN(fStream.ReadDWord);
+  fStream.ReadDWord;
+  fStream.ReadDWord; // TableHeaderSize;
+  fStream.Read(UnCompressedSize, SizeOf(QWord));
+  UnCompressedSize := LEtoN(UnCompressedSize);
+  fStream.Read(CompressedSize, SizeOf(QWord));
+  CompressedSize := LEtoN(CompressedSize);
+  fStream.Read(Result, SizeOf(QWord)); // block size
+  Result := LEtoN(Result);
+
+  // now we are located at the first block index
+
+  SetLength(LZXResetTable, BlockCount);
+  fStream.Read(LZXResetTable[0], SizeOf(QWord)*BlockCount);
+  {$IFDEF ENDIAN_BIG}
+  for I := 0 to High(LZXResetTable) do
+    LZXResetTable[I] := LEtoN(LZXResetTable[I]);
+  {$ENDIF}
+end;
+
+{ TContextList }
+
+procedure TContextList.AddContext(Context: THelpContext; Url: String);
+var
+  ContextItem: PContextItem;
+begin
+  New(ContextItem);
+  Add(ContextItem);
+  ContextItem^.Context := Context;
+  ContextItem^.Url := Url;
+end;
+
+function TContextList.GetURL(Context: THelpContext): String;
+var
+  X: Integer;
+begin
+  Result := '';
+  for X := 0 to Count-1 do begin
+    if PContextItem(Get(X))^.Context = Context then begin
+      Result := PContextItem(Get(X))^.Url;
+      Exit;
+    end;
+  end;
+end;
+
+procedure TContextList.Clear;
+var
+  X: Integer;
+begin
+  for X := Count-1 downto 0 do begin
+    Dispose(PContextItem(Get(X)));
+    Delete(X);
+  end;
+end;
+
+
+{ TChmFileList }
+
+procedure TChmFileList.Delete(Index: Integer);
+begin
+  Chm[Index].Free;
+  inherited Delete(Index);
+end;
+
+function TChmFileList.GetChm(AIndex: Integer): TChmReader;
+begin
+  Result := TChmReader(Objects[AIndex]);
+end;
+
+function TChmFileList.GetFileName(AIndex: Integer): String;
+begin
+  Result := Strings[AIndex];
+end;
+
+procedure TChmFileList.OpenNewFile(AFileName: String);
+var
+AStream: TFileStream;
+AChm: TChmReader;
+AIndex: Integer;
+begin
+  if not FileExists(AFileName) then exit;
+  AStream := TFileStream.Create(AFileName, fmOpenRead);
+  AChm := TChmReader.Create(AStream, True);
+  AIndex := AddObject(AFileName, AChm);
+  fLastChm := AChm;
+  if Assigned(fOnOpenNewFile) then fOnOpenNewFile(Self, AIndex)
+  else fUnNotifiedFiles.Add(AChm);
+end;
+
+function TChmFileList.CheckOpenFile(AFileName: String): Boolean;
+var
+  X: Integer;
+  
+begin
+  Result := False;
+  for X := 0 to Count-1 do begin
+    if ExtractFileName(FileName[X]) = AFileName then begin
+      fLastChm := Chm[X];
+      Result := True;
+      Exit;
+    end;
+  end;
+  if not Result then begin
+    AFileName := ExtractFilePath(FileName[0])+AFileName;
+    if FileExists(AFileName) and (ExtractFileExt(AFileName) = '.chm') then OpenNewFile(AFileName);
+    Result := True;
+  end;
+end;
+
+function TChmFileList.MetaObjectExists(var Name: String): QWord;
+var
+  AFileName: String;
+  URL: String;
+  fStart, fEnd: Integer;
+  Found: Boolean;
+begin
+  Found := False;
+  Result := 0;
+  //Known META file link types
+  //       ms-its:name.chm::/topic.htm
+  //mk:@MSITStore:name.chm::/topic.htm
+  if Pos('ms-its:', Name) > 0 then begin
+    fStart := Pos('ms-its:', Name)+Length('ms-its:');
+    fEnd := Pos('::', Name)-fStart;
+    AFileName := Copy(Name, fStart, fEnd);
+    fStart := fEnd+fStart+2;
+    fEnd := Length(Name) - (fStart-1);
+    URL := Copy(Name, fStart, fEnd);
+    Found := True;
+  end
+  else if Pos('mk:@MSITStore:', Name) > 0 then begin
+    fStart := Pos('mk:@MSITStore:', Name)+Length('mk:@MSITStore:');
+    fEnd := Pos('::', Name)-fStart;
+    AFileName := Copy(Name, fStart, fEnd);
+    fStart := fEnd+fStart+2;
+    fEnd := Length(Name) - (fStart-1);
+    URL := Copy(Name, fStart, fEnd);
+    Found := True;
+  end;
+  if not Found then exit;
+  if CheckOpenFile(AFileName) then
+    Result := fLastChm.ObjectExists(URL);
+  if Result > 0 then NAme := Url;
+end;
+
+function TChmFileList.MetaGetObject(Name: String): TMemoryStream;
+begin
+  Result := nil;
+  if MetaObjectExists(Name) > 0 then Result := fLastChm.GetObject(Name);
+end;
+
+constructor TChmFileList.Create(PrimaryFileName: String);
+begin
+  inherited Create;
+  fUnNotifiedFiles := TList.Create;
+  OpenNewFile(PrimaryFileName);
+end;
+
+destructor TChmFileList.Destroy;
+begin
+  fUnNotifiedFiles.Free;
+end;
+
+procedure TChmFileList.SetOnOpenNewFile(AValue: TChmFileOpenEvent);
+var
+  X: Integer;
+begin
+  fOnOpenNewFile := AValue;
+  if AValue = nil then exit;
+  for X := 0 to fUnNotifiedFiles.Count-1 do
+    AValue(Self, X);
+  fUnNotifiedFiles.Clear;
+end;
+
+function TChmFileList.ObjectExists(Name: String; fChm: TChmReader = nil): QWord;
+begin
+  Result := 0;
+  if Count = 0 then exit;
+  if fChm <> nil then fLastChm := fChm;
+  Result := fLastChm.ObjectExists(Name);
+  if Result = 0 then begin
+    Result := Chm[0].ObjectExists(Name);
+    if Result > 0 then fLastChm := Chm[0];
+  end;
+  if Result = 0 then begin
+    Result := MetaObjectExists(Name);
+  end;
+end;
+
+function TChmFileList.GetObject(Name: String): TMemoryStream;
+begin
+  Result := nil;
+  if Count = 0 then exit;
+  Result := fLastChm.GetObject(Name);
+  if Result = nil then Result := MetaGetObject(Name);
+end;
+
+function TChmFileList.IsAnOpenFile(AFileName: String): Boolean;
+var
+  X: Integer;
+begin
+  Result := False;
+  for X := 0 to Count-1 do begin
+    if AFileName = FileName[X] then Exit(True);
+  end;
+end;
+
+end.
+

+ 502 - 0
packages/extra/chm/chmsitemap.pas

@@ -0,0 +1,502 @@
+{ Copyright (C) <2005> <Andrew Haines> chmsitemap.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+unit chmsitemap; 
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, fasthtmlparser;
+  
+type
+  TChmSiteMapItems = class; // forward
+  TChmSiteMap = class;
+  
+  { TChmSiteMapItem }
+
+  TChmSiteMapItem = class(TPersistent)
+  private
+    FChildren: TChmSiteMapItems;
+    FComment: String;
+    FImageNumber: Integer;
+    FIncreaseImageIndex: Boolean;
+    FLocal: String;
+    FOwner: TChmSiteMapItems;
+    FSeeAlso: String;
+    FText: String;
+    FURL: String;
+    procedure SetChildren(const AValue: TChmSiteMapItems);
+  published
+    constructor Create(AOwner: TChmSiteMapItems);
+    destructor Destroy; override;
+    property Children: TChmSiteMapItems read FChildren write SetChildren;
+    property Text: String read FText write FText; // Name for TOC; KeyWord for index
+    property Local: String read FLocal write FLocal;
+    property URL: String read FURL write FURL;
+    property SeeAlso: String read FSeeAlso write FSeeAlso;
+    property ImageNumber: Integer read FImageNumber write FImageNumber default -1;
+    property IncreaseImageIndex: Boolean read FIncreaseImageIndex write FIncreaseImageIndex;
+    property Comment: String read FComment write FComment;
+    property Owner: TChmSiteMapItems read FOwner;
+    //property FrameName: String read FFrameName write FFrameName;
+    //property WindowName: String read FWindowName write FWindowName;
+    //property Type_: Integer read FType_ write FType_; either Local or URL
+    //property Merge: Boolean read FMerge write FMerge;
+  end;
+
+  { TChmSiteMapItems }
+
+  TChmSiteMapItems = class(TPersistent)
+  private
+    FList: TList;
+    FOwner: TChmSiteMap;
+    FParentItem: TChmSiteMapItem;
+    function GetCount: Integer;
+    function GetItem(AIndex: Integer): TChmSiteMapItem;
+    procedure SetItem(AIndex: Integer; const AValue: TChmSiteMapItem);
+  public
+    constructor Create(AOwner: TChmSiteMap; AParentItem: TChmSiteMapItem);
+    destructor Destroy; override;
+    procedure Delete(AIndex: Integer);
+    function Add(AItem: TChmSiteMapItem): Integer;
+    function NewItem: TChmSiteMapItem;
+    function Insert(AItem: TChmSiteMapItem; AIndex: Integer): Integer;
+    procedure Clear;
+    property Item[AIndex: Integer]: TChmSiteMapItem read GetItem write SetItem;
+    property Count: Integer read GetCount;
+    property ParentItem: TChmSiteMapItem read FParentItem;
+    property Owner: TChmSiteMap read FOwner;
+  end;
+  
+
+  { TChmSiteMapTree }
+  TSiteMapType = (stTOC, stIndex);
+  
+  TSiteMapTag = (smtUnknown, smtNone, smtHTML, smtHEAD, smtBODY);
+  TSiteMapTags = set of TSiteMapTag;
+
+  TSiteMapBodyTag = (smbtUnknown, smbtNone, smbtUL, smbtLI, smbtOBJECT, smbtPARAM);
+  TSiteMapBodyTags = set of TSiteMapBodyTag;
+  
+  TLIObjectParamType = (ptName, ptLocal, ptKeyword);
+
+  TChmSiteMap = class
+  private
+    FAutoGenerated: Boolean;
+    FBackgroundColor: LongInt;
+    FCurrentItems: TChmSiteMapItems;
+    FExWindowStyles: LongInt;
+    FFont: String;
+    FForegroundColor: LongInt;
+    FFrameName: String;
+    FImageList: String;
+    FImageWidth: Integer;
+    FSiteMapTags: TSiteMapTags;
+    FSiteMapBodyTags: TSiteMapBodyTags;
+    FHTMLParser: THTMLParser;
+    FItems: TChmSiteMapItems;
+    FSiteMapType: TSiteMapType;
+    FUseFolderImages: Boolean;
+    FWindowName: String;
+    FLevel: Integer;
+    FWindowStyles: LongInt;
+    procedure SetItems(const AValue: TChmSiteMapItems);
+  protected
+    procedure FoundTag (ACaseInsensitiveTag, AActualTag: string);
+    procedure FoundText(AText: string);
+  public
+    constructor Create(AType: TSiteMapType);
+    destructor Destroy; override;
+    procedure LoadFromFile(AFileName: String);
+    procedure LoadFromStream(AStream: TStream);
+    procedure SaveToStream(AStream: TStream);
+    property Items: TChmSiteMapItems read FItems write SetItems;
+    property SiteMapType: TSiteMapType read FSiteMapType;
+    // SiteMap properties. most of these are invalid for the index
+    property FrameName: String read FFrameName write FFrameName;
+    property WindowName: String read FWindowName write FWindowName;
+    property ImageList: String read FImageList write FImageList;
+    property ImageWidth: Integer read FImageWidth write FImageWidth;
+    property BackgroundColor: LongInt read FBackgroundColor write FBackgroundColor;
+    property ForegroundColor: LongInt read FForegroundColor write FForegroundColor;
+    property ExWindowStyles: LongInt read FExWindowStyles write FExWindowStyles;
+    property WindowStyles: LongInt read FWindowStyles write FWindowStyles;
+    property UseFolderImages: Boolean read FUseFolderImages write FUseFolderImages;
+    property Font: String read FFont write FFont;
+    property AutoGenerated: Boolean read FAutoGenerated write FAutoGenerated;
+  end;
+
+implementation
+uses HTMLUtil;
+
+{ TChmSiteMapTree }
+
+procedure TChmSiteMap.SetItems(const AValue: TChmSiteMapItems);
+begin
+  if FItems=AValue then exit;
+  FItems:=AValue;
+end;
+
+procedure TChmSiteMap.FoundTag(ACaseInsensitiveTag, AActualTag: string);
+    function ActiveItem: TChmSiteMapItem;
+    begin
+      Result := FCurrentItems.Item[FCurrentItems.Count-1]
+    end;
+    procedure IncreaseULevel;
+    begin
+      if FCurrentItems = nil then FCurrentItems := Items
+      else begin
+        //WriteLn('NewLevel. Count = ', FCurrentItems.Count, ' Index = ',Items.Count-1);
+        FCurrentItems := ActiveItem.Children;
+      end;
+      Inc(FLevel);
+    end;
+    procedure DecreaseULevel;
+    begin
+      if Assigned(FCurrentItems) and Assigned(FCurrentItems.ParentItem) then
+        FCurrentItems := FCurrentItems.ParentItem.Owner
+      else FCurrentItems := nil;
+      Dec(FLevel);
+    end;
+    procedure NewSiteMapItem;
+    begin
+      FCurrentItems.Add(TChmSiteMapItem.Create(FCurrentItems));
+    end;
+var
+  TagName,
+  TagAttribute,
+  TagAttributeName,
+  TagAttributeValue: String;
+  I: Integer;
+begin
+  //WriteLn('TAG:', AActualTag);
+  TagName := GetTagName(ACaseInsensitiveTag);
+
+  if not (smtHTML in FSiteMapTags) then begin
+    if TagName = 'HTML' then Include(FSiteMapTags, smtHTML);
+  end
+  else begin // looking for /HTML
+    if TagName = '/HTML' then Exclude(FSiteMapTags, smtHTML);
+  end;
+  
+  if (smtHTML in FSiteMapTags) then begin
+     if not (smtBODY in FSiteMapTags) then begin
+       if TagName = 'BODY' then Include(FSiteMapTags, smtBODY);
+     end
+     else begin
+       if TagName = '/BODY' then Exclude(FSiteMapTags, smtBODY);
+     end;
+     
+     if (smtBODY in FSiteMapTags) then begin
+       //WriteLn('GOT TAG: ', AActualTag);
+       if TagName = 'UL' then begin
+         //WriteLN('Inc Level');
+         IncreaseULevel;
+       end
+       else if TagName = '/UL' then begin
+         //WriteLN('Dec Level');
+         DecreaseULevel;
+       end
+       else if TagName = 'OBJECT' then begin
+         Include(FSiteMapBodyTags, smbtOBJECT);
+         If FLevel > 0 then // if it is zero it is the site properties
+           NewSiteMapItem;
+       end
+       else if TagName = '/OBJECT' then begin
+         Exclude(FSiteMapBodyTags, smbtOBJECT);
+       end
+       else begin // we are the properties of the object tag
+         if (smbtOBJECT in FSiteMapBodyTags) then begin
+           if LowerCase(GetTagName(AActualTag)) = 'param' then begin
+
+             TagAttributeName := GetVal(AActualTag, 'name');
+             TagAttributeValue := GetVal(AActualTag, 'value');
+
+             if TagAttributeName <> '' then begin
+               if CompareText(TagAttributeName, 'keyword') = 0 then begin
+                 ActiveItem.Text := TagAttributeValue;
+               end
+               else if CompareText(TagAttributeName, 'name') = 0 then begin
+                 if ActiveItem.Text = '' then ActiveItem.Text := TagAttributeValue;
+               end
+               else if CompareText(TagAttributeName, 'local') = 0 then begin
+                 ActiveItem.Local := TagAttributeValue;
+               end
+               else if CompareText(TagAttributeName, 'URL') = 0 then begin
+                 ActiveItem.URL := TagAttributeValue;
+               end
+               else if CompareText(TagAttributeName, 'ImageNumber') = 0 then begin
+                 ActiveItem.ImageNumber := StrToInt(TagAttributeValue);
+               end
+               else if CompareText(TagAttributeName, 'New') = 0 then begin
+                 ActiveItem.IncreaseImageIndex := (LowerCase(TagAttributeValue) = 'yes');
+               end
+               else if CompareText(TagAttributeName, 'Comment') = 0 then begin
+                 ActiveItem.Comment := TagAttributeValue;
+               end;
+               //else if CompareText(TagAttributeName, '') = 0 then begin
+               //end;
+             end;
+           end;
+         end;
+       end;
+     end;
+  end
+end;
+
+procedure TChmSiteMap.FoundText(AText: string);
+begin
+  //WriteLn('TEXT:', AText);
+end;
+
+constructor TChmSiteMap.Create(AType: TSiteMapType);
+begin
+  Inherited Create;
+  FSiteMapType := AType;
+  FSiteMapTags := [smtNone];
+  FSiteMapBodyTags := [smbtNone];
+  FItems := TChmSiteMapItems.Create(Self, nil);  ;
+end;
+
+destructor TChmSiteMap.Destroy;
+begin
+  if Assigned(FHTMLParser) then FHTMLParser.Free;
+  FItems.Free;
+  Inherited Destroy;
+end;
+
+procedure TChmSiteMap.LoadFromFile(AFileName: String);
+var
+  Buffer: String;
+  TmpStream: TMemoryStream;
+begin
+  if Assigned(FHTMLParser) then FHTMLParser.Free;
+  TmpStream := TMemoryStream.Create;
+  TmpStream.LoadFromFile(AFileName);
+  SetLength(Buffer, TmpStream.Size);
+  TmpStream.Position := 0;
+  TmpStream.Read(Buffer[1], TmpStream.Size);
+  FHTMLParser := THTMLParser.Create(Buffer);
+  FHTMLParser.OnFoundTag := @FoundTag;
+  FHTMLParser.OnFoundText := @FoundText;
+  FHTMLParser.Exec;
+  FHTMLParser.Free;
+end;
+
+procedure TChmSiteMap.LoadFromStream(AStream: TStream);
+var
+  Buffer: String;
+begin
+  if Assigned(FHTMLParser) then FHTMLParser.Free;
+  SetLength(Buffer, AStream.Size-AStream.Position);
+  if AStream.Read(Buffer[1], AStream.Size-AStream.Position) > 0 then begin;
+    FHTMLParser := THTMLParser.Create(Buffer);
+    FHTMLParser.OnFoundTag := @FoundTag;
+    FHTMLParser.OnFoundText := @FoundText;
+    FHTMLParser.Exec;
+    FHTMLParser.Free;
+  end;
+end;
+
+procedure TChmSiteMap.SaveToStream(AStream: TStream);
+var
+  Indent: Integer;
+  procedure WriteString(AString: String);
+  var
+    I: Integer;
+  begin
+     for I := 0 to Indent-1 do AStream.WriteByte(Byte(' '));
+     AStream.Write(AString[1], Length(AString));
+     AStream.WriteByte(10);
+  end;
+  procedure WriteParam(AName: String; AValue: String);
+  begin
+    WriteString('<param name="'+AName+'" value="'+AValue+'">');
+  end;
+  procedure WriteEntries(AItems: TChmSiteMapItems);
+  var
+    I : Integer;
+    Item: TChmSiteMapItem;
+  begin
+    for I := 0 to AItems.Count-1 do begin
+
+      
+      Item := AItems.Item[I];
+      WriteString('<LI> <OBJECT type="text/sitemap">');
+      Inc(Indent, 8);
+      //Merge
+      //if (SiteMapType = stIndex) and (Item.Text <> '') then WriteParam('Keyword', Item.Text);
+      if Item.Text <> '' then WriteParam('Name', Item.Text);
+      if Item.Local <> '' then WriteParam('Local', Item.Local);
+      if Item.URL <> '' then WriteParam('URL', Item.URL);
+      if (SiteMapType = stIndex) and (Item.SeeAlso <> '') then WriteParam('See Also', Item.SeeAlso);
+      //if Item.FrameName <> '' then WriteParam('FrameName', Item.FrameName);
+      //if Item.WindowName <> '' then WriteParam('WindowName', Item.WindowName);
+      if Item.Comment <> '' then WriteParam('Comment', Item.Comment);
+      if (SiteMapType = stTOC) and (Item.IncreaseImageIndex) then WriteParam('New', 'yes'); // is this a correct value?
+      if (SiteMapType = stTOC) and (Item.ImageNumber <> -1) then WriteParam('ImageNumber', IntToStr(Item.ImageNumber));
+
+      Dec(Indent, 3);
+      WriteString('</OBJECT>');
+      Dec(Indent, 5);
+
+      // Now Sub Entries
+      if Item.Children.Count > 0 then begin
+        WriteString('<UL>');
+        Inc(Indent, 8);
+        WriteEntries(Item.Children);
+        Dec(Indent, 8);
+        WriteString('</UL>');
+      end;
+      
+
+
+    end;
+  end;
+begin
+  Indent := 0;
+  WriteString('<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">');
+  WriteString('<HTML>');
+  WriteString('<HEAD>');
+  WriteString('<meta name="GENERATOR" content="Microsoft&reg; HTML Help Workshop 4.1">');  // Should we change this?
+  WriteString('<!-- Sitemap 1.0 -->');
+  WriteString('</HEAD><BODY>');
+  
+  // Site Properties
+  WriteString('<OBJECT type="text/site properties">');
+  Inc(Indent, 8);
+    if SiteMapType = stTOC then begin
+      if FrameName <> '' then WriteParam('FrameName', FrameName);
+      if WindowName <> '' then WriteParam('WindowName', WindowName);
+      if ImageList <> '' then WriteParam('ImageList', ImageList);
+      if ImageWidth > 0 then WriteParam('Image Width', IntToStr(ImageWidth));
+      if BackgroundColor <> 0 then WriteParam('Background', hexStr(BackgroundColor, 4));
+      if ForegroundColor <> 0 then WriteParam('Foreground', hexStr(ForegroundColor, 4));
+      if ExWindowStyles <> 0 then WriteParam('ExWindow Styles', hexStr(ExWindowStyles, 4));
+      if WindowStyles <> 0 then WriteParam('Window Styles', hexStr(WindowStyles, 4));
+      if UseFolderImages then WriteParam('ImageType', 'Folder');
+    end;
+    // both TOC and Index have font
+    if Font <> '' then
+      WriteParam('Font', Font);
+    Dec(Indent, 8);
+  WriteString('</OBJECT>');
+  
+  // And now the items
+  if Items.Count > 0 then begin
+    WriteString('<UL>');
+    Inc(Indent, 8);
+    // WriteEntries
+    WriteEntries(Items);
+    Dec(Indent, 8);
+    WriteString('</UL>');
+  end;
+  
+  WriteString('</BODY></HTML>');
+  
+  AStream.Size := AStream.Position;
+end;
+
+{ TChmSiteMapItem }
+
+procedure TChmSiteMapItem.SetChildren(const AValue: TChmSiteMapItems);
+begin
+  if FChildren = AValue then exit;
+  FChildren := AValue;
+end;
+
+constructor TChmSiteMapItem.Create(AOwner: TChmSiteMapItems);
+begin
+  Inherited Create;
+  FOwner := AOwner;
+  FChildren := TChmSiteMapItems.Create(Owner.Owner, Self);
+end;
+
+destructor TChmSiteMapItem.Destroy;
+begin
+  FChildren.Free;
+  Inherited Destroy;
+end;
+
+{ TChmSiteMapItems }
+
+function TChmSiteMapItems.GetItem(AIndex: Integer): TChmSiteMapItem;
+begin
+  Result := TChmSiteMapItem(FList.Items[AIndex]);
+end;
+
+function TChmSiteMapItems.GetCount: Integer;
+begin
+  Result := FList.Count;
+end;
+
+procedure TChmSiteMapItems.SetItem(AIndex: Integer; const AValue: TChmSiteMapItem);
+begin
+  FList.Items[AIndex] := AValue;
+end;
+
+constructor TChmSiteMapItems.Create(AOwner: TChmSiteMap; AParentItem: TChmSiteMapItem);
+begin
+  FList := TList.Create;
+  FParentItem := AParentItem;
+  FOwner := AOwner;
+end;
+
+destructor TChmSiteMapItems.Destroy;
+begin
+  Clear;
+  FList.Free;
+  inherited Destroy;
+end;
+
+procedure TChmSiteMapItems.Delete(AIndex: Integer);
+begin
+  Item[AIndex].Free;
+  FList.Delete(AIndex);
+end;
+
+function TChmSiteMapItems.Add(AItem: TChmSiteMapItem): Integer;
+begin
+  Result := FList.Add(AItem);
+end;
+
+function TChmSiteMapItems.NewItem: TChmSiteMapItem;
+begin
+  Result := TChmSiteMapItem.Create(Self);
+  Add(Result);
+end;
+
+function TChmSiteMapItems.Insert(AItem: TChmSiteMapItem; AIndex: Integer): Integer;
+begin
+  Result := AIndex;
+  FList.Insert(AIndex, AItem);
+end;
+
+procedure TChmSiteMapItems.Clear;
+var
+  I: LongInt;
+begin
+  for I := Count downto 0 do Delete(I);
+end;
+
+end.
+

+ 133 - 0
packages/extra/chm/chmspecialfiles.pas

@@ -0,0 +1,133 @@
+{ Copyright (C) <2005> <Andrew Haines> chmspecialfiles.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+unit chmspecialfiles;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, chmtypes;
+  
+
+  
+  function WriteNameListToStream(const AStream: TStream; SectionNames: TSectionNames): Integer;
+  function WriteControlDataToStream(const AStream: TStream; const LZXResetInterval, WindowSize, CacheSize: DWord): Integer;
+  function WriteSpanInfoToStream(const AStream: TStream; UncompressedSize: QWord): Integer;
+  function WriteTransformListToStream(const AStream: TStream): Integer;
+  function WriteResetTableToStream(const AStream: TStream; ResetTableStream: TMemoryStream): Integer;
+  function WriteContentToStream(const AStream: TStream; ContentStream: TMemoryStream): Integer;
+  
+implementation
+
+function WriteNameListToStream(const AStream: TStream; SectionNames: TSectionNames): Integer;
+var
+  MSCompressedName: WideString = 'MSCompressed'#0; // Length 13
+  UnCompressedName: WideString = 'Uncompressed'#0;
+  I: Integer;
+  Size: Word = 2;
+  NEntries: Word = 0;
+begin
+  //  ::DataSpace/NameList
+  {$IFDEF ENDIAN_BIG}
+    for I := 1 to 13 do begin
+      PWord(@MSCompressedName[I])^ := NToLE(PWord(@MSCompressedName[I])^);
+      PWord(@MSCompressedName[I])^ := NToLE(PWord(@UnCompressedName[I])^);
+    end;
+  {$ENDIF}
+
+  if snUnCompressed in SectionNames then begin
+    Inc(Size, 14);
+    Inc(NEntries);
+  end;
+
+  if snMSCompressed in SectionNames then begin
+    Inc(Size, 14);
+    Inc(NEntries);
+  end;
+  
+  AStream.WriteWord(NToLE(Size));
+  AStream.WriteWord(NToLE(NEntries));
+  if snUnCompressed in SectionNames then begin
+    AStream.WriteWord(NToLE(12));
+    AStream.Write(UnCompressedName[1], 13*2);
+  end;
+  if snMSCompressed in SectionNames then begin
+    AStream.WriteWord(NToLE(12));
+    AStream.Write(MSCompressedName[1], 13*2);
+  end;
+  
+  Result := Size * SizeOf(Word);
+end;
+
+function WriteControlDataToStream(const AStream: TStream; const LZXResetInterval,
+  WindowSize, CacheSize: DWord): Integer;
+var
+  LZXC: array [0..3] of char = 'LZXC';
+begin
+  //  ::DataSpace/Storage/MSCompressed/ControlData
+  Result := AStream.Position;
+  AStream.WriteDWord(NToLE(6)); // number of dwords following this one
+  AStream.Write(LZXC, 4);
+  AStream.WriteDWord(NToLE(2)); // Version
+  AStream.WriteDWord(NToLE(LZXResetInterval));
+  AStream.WriteDWord(NToLE(WindowSize));
+  AStream.WriteDWord(NToLE(CacheSize)); // what is this??
+  AStream.WriteDWord(0);
+  Result := AStream.Position - Result;
+end;
+
+function WriteSpanInfoToStream(const AStream: TStream; UncompressedSize: QWord): Integer;
+begin
+  //  ::DataSpace/Storage/MSCompressed/SpanInfo
+  Result := AStream.Write(NToLE(UncompressedSize), SizeOf(QWord));
+end;
+
+function WriteTransformListToStream(const AStream: TStream): Integer;
+const
+//AGuid = '{7FC28940-9D31-11D0-9B27-00A0C91E9C7C}';
+// use the broken guid
+AGuid = '{'#0'7'#0'F'#0'C'#0'2'#0'8'#0'9'#0'4'#0'0'#0'-'#0'9'#0'D'#0'3'#0'1'#0'-'#0'1'#0'1'#0'D'#0'0'#0; //-9B27-00A0C91E9C7C}';
+begin
+  //  ::DataSpace/Storage/MSCompressed/Transform/List
+  Result := AStream.Write(AGuid, SizeOf(AGuid));
+end;
+
+function WriteResetTableToStream(const AStream: TStream;
+  ResetTableStream: TMemoryStream): Integer;
+begin
+  //  ::DataSpace/Storage/MSCompressed/Transform/{7FC28940-9D31-11D0-9B27-00A0C91E9C7C}/InstanceData/
+  //  ::DataSpace/Storage/MSCompressed/Transform/{7FC28940-9D31-11D0-9B27-00A0C91E9C7C}/InstanceData/ResetTable
+  ResetTableStream.Position := 0;
+  Result := AStream.CopyFrom(ResetTableStream, ResetTableStream.Size-SizeOf(QWord));
+end;
+
+function WriteContentToStream(const AStream: TStream; ContentStream: TMemoryStream): Integer;
+begin
+  //  ::DataSpace/Storage/MSCompressed/Content
+  ContentStream.Position := 0;
+  //WriteLn('Compressed Data start''s at: ', AStream.Position,' Size is: ', ContentStream.Size);
+  Result := AStream.CopyFrom(ContentStream, ContentStream.Size);
+
+end;
+
+end.
+

+ 288 - 0
packages/extra/chm/chmtypes.pas

@@ -0,0 +1,288 @@
+{ Copyright (C) <2005> <Andrew Haines> chmtypes.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+unit chmtypes;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils; 
+  
+type
+  TSectionName = (snMSCompressed, snUnCompressed);
+  
+  TSectionNames = set of TSectionName;
+  
+   { TDirectoryChunk }
+
+  TDirectoryChunk = class(TObject)
+  private
+    FHeaderSize: Integer;
+    FQuickRefEntries: Word;
+    Buffer: array[0..$1000-1] of byte;
+    CurrentPos: Integer;
+    FItemCount: Word;
+    FClearCount: Integer;
+  public
+    function CanHold(ASize: Integer): Boolean;
+    function FreeSpace: Integer;
+    procedure WriteHeader(AHeader: Pointer);
+    procedure WriteEntry(Size: Integer; Data: Pointer);
+    procedure WriteChunkToStream(Stream: TStream); overload;
+    procedure Clear;
+    property ItemCount: Word read FItemCount;
+    constructor Create(AHeaderSize: Integer);
+  end;
+  
+  { TPMGIDirectoryChunk }
+
+  TPMGIDirectoryChunk = class(TDirectoryChunk)
+  private
+    FChunkLevelCount: Integer;
+    FParentChunk: TPMGIDirectoryChunk;
+  public
+    procedure WriteChunkToStream(Stream: TStream; var AIndex: Integer; Final: Boolean = False); overload;
+    property ParentChunk: TPMGIDirectoryChunk read FParentChunk write FParentChunk;
+    property ChunkLevelCount: Integer read FChunkLevelCount write FChunkLevelCount;
+  end;
+
+  PFileEntryRec = ^TFileEntryRec;
+  TFileEntryRec = record
+    Path: String;
+    Name: String;
+    DecompressedOffset: QWord;
+    DecompressedSize: QWord;
+    Compressed: Boolean; // True means it goes in section1 False means section0
+  end;
+
+  { TFileEntryList }
+
+  TFileEntryList = class(TList)
+  private
+    FPaths: TStringList;
+    function GetFileEntry(Index: Integer): TFileEntryRec;
+    procedure SetFileEntry(Index: Integer; const AValue: TFileEntryRec);
+  public
+    function AddEntry(AFileEntry: TFileEntryRec; CheckPathIsAdded: Boolean = True): Integer;
+    procedure Delete(Index: Integer);
+    property FileEntry[Index: Integer]: TFileEntryRec read GetFileEntry write SetFileEntry;
+    procedure Sort;
+    constructor Create;
+    destructor Destroy; override;
+
+  end;
+
+
+implementation
+uses chmbase;
+
+{ TDirectoryChunk }
+
+function TDirectoryChunk.CanHold(ASize: Integer): Boolean;
+begin
+  Result := CurrentPos < $1000-1 - ASize - (SizeOf(Word) * (FQuickRefEntries+2));
+end;
+
+function TDirectoryChunk.FreeSpace: Integer;
+begin
+  Result := $1000 - CurrentPos;
+end;
+
+procedure TDirectoryChunk.WriteHeader(AHeader: Pointer);
+begin
+  Move(AHeader^, Buffer[0], FHeaderSize);
+end;
+
+procedure TDirectoryChunk.WriteEntry(Size: Integer; Data: Pointer);
+var
+  ReversePos: Integer;
+  Value: Word;
+begin
+  if not CanHold(Size) then Raise Exception.Create('Trying to write past the end of the buffer');
+  Move(Data^, Buffer[CurrentPos], Size);
+  Inc(CurrentPos, Size);
+  Inc(FItemCount);
+  
+  // now put a quickref entry if needed
+  if ItemCount mod 5 = 0 then begin
+    Inc(FQuickRefEntries);
+    ReversePos := ($1000-1) - SizeOf(Word) - (SizeOf(Word)*FQuickRefEntries);
+    Value := NtoLE(CurrentPos - Size);
+    Move(Value, Buffer[ReversePos], SizeOf(Word));
+  end;
+end;
+
+procedure TDirectoryChunk.WriteChunkToStream(Stream: TStream);
+var
+  ReversePos: Integer;
+begin
+  ReversePos := $1000-1 - SizeOf(Word);
+  FItemCount := NtoLE(ItemCount);
+  Move(ItemCount, Buffer[ReversePos], SizeOf(Word));
+
+  Stream.Write(Buffer[0], $1000);
+  {$IFDEF DEBUG_CHM_CHUNKS}
+  WriteLn('Writing ', Copy(PChar(@Buffer[0]),0,4),' ChunkToStream');
+  {$ENDIF}
+end;
+
+procedure TDirectoryChunk.Clear;
+begin
+  FillChar(Buffer, $1000, 0);
+  FItemCount := 0;
+  CurrentPos := FHeaderSize;
+  FQuickRefEntries := 0;
+  Inc(FClearCount);
+end;
+
+constructor TDirectoryChunk.Create(AHeaderSize: Integer);
+begin
+  FHeaderSize := AHeaderSize;
+  CurrentPos := FHeaderSize;
+end;
+
+{ TFileEntryList }
+
+function TFileEntryList.GetFileEntry(Index: Integer): TFileEntryRec;
+begin
+  Result := PFileEntryRec(Items[Index])^;
+end;
+
+procedure TFileEntryList.SetFileEntry(Index: Integer; const AValue: TFileEntryRec);
+begin
+  PFileEntryRec(Items[Index])^ := AValue;
+end;
+
+function TFileEntryList.AddEntry(AFileEntry: TFileEntryRec; CheckPathIsAdded: Boolean = True): Integer;
+var
+  TmpEntry: PFileEntryRec;
+begin
+  New(TmpEntry);
+  //WriteLn('Adding: ', AFileEntry.Path+AFileEntry.Name,' Size = ', AFileEntry.DecompressedSize,' Offset = ', AFileEntry.DecompressedOffset);
+  if CheckPathIsAdded and (FPaths.IndexOf(AFileEntry.Path) < 0) then begin
+    // all paths are included in the list of files in section 0 with a size and offset of 0
+    FPaths.Add(AFileEntry.Path);
+    TmpEntry^.Path := AFileEntry.Path;
+    TmpEntry^.Name := '';
+    TmpEntry^.DecompressedOffset := 0;
+    TmpEntry^.DecompressedSize := 0;
+    TmpEntry^.Compressed := False;
+    (Self as TList).Add(TmpEntry);
+    New(TmpEntry);
+  end;
+  TmpEntry^ := AFileEntry;
+  Result := (Self as TList).Add(TmpEntry);
+end;
+
+procedure TFileEntryList.Delete(Index: Integer);
+begin
+  Dispose(PFileEntryRec(Items[Index]));
+  Inherited Delete(Index);
+end;
+
+function FileEntrySortFunc(Item1, Item2: PFileEntryRec): Integer;
+var
+  Str1, Str2: String;
+begin
+  Str1 := Item1^.Path + Item1^.Name;
+  Str2 := Item2^.Path + Item2^.Name;
+  Result := ChmCompareText(Str1, Str2);
+end;
+
+procedure TFileEntryList.Sort;
+begin
+  Inherited Sort(TListSortCompare(@FileEntrySortFunc));
+end;
+
+constructor TFileEntryList.Create;
+begin
+  Inherited Create;
+  FPaths := TStringList.Create;
+end;
+
+destructor TFileEntryList.Destroy;
+var
+  I: Integer;
+begin
+  for I := Count-1 downto 0 do
+    Delete(I);
+  FPaths.Free;
+  inherited Destroy;
+end;
+
+{ TPMGIDirectoryChunk }
+procedure TPMGIDirectoryChunk.WriteChunkToStream(Stream: TStream; var AIndex: Integer
+  ; Final: Boolean = False);
+var
+  NewBuffer: array[0..512] of byte;
+  EntryLength,
+  WriteSize: Integer;
+  OldPos, NewPos, NewStart: Int64;
+  procedure FinishBlock;
+  var
+    Header: TPMGIIndexChunk;
+  begin
+    Inc(AIndex);
+    Header.PMGIsig := 'PMGI';
+    Header.UnusedSpace := FParentChunk.FreeSpace;
+    FParentChunk.WriteHeader(@Header);
+    FParentChunk.WriteChunkToStream(Stream, AIndex, Final);
+    FParentChunk.Clear;
+  end;
+begin
+  if FItemCount < 1 then begin
+    WriteLn('WHAT ARE YOU DOING!!');
+    Dec(AIndex);
+    Exit;
+  end;
+  OldPos := Stream.Position;
+  WriteChunkToStream(Stream);
+  NewPos := Stream.Position;
+  Inc(FChunkLevelCount);
+  
+  if Final and (ChunkLevelCount < 2) then begin
+    FParentChunk.Free;
+    FParentChunk := nil;
+    Exit;
+  end;
+  if FParentChunk = nil then FParentChunk := TPMGIDirectoryChunk.Create(FHeaderSize);
+
+  NewStart := OldPos+FHeaderSize;
+  Stream.Position := NewStart;
+  EntryLength := GetCompressedInteger(Stream);
+  WriteSize := (Stream.Position - NewStart) + EntryLength;
+  Move(Buffer[FHeaderSize], NewBuffer[0], WriteSize);
+  Inc(WriteSize, WriteCompressedInteger(@NewBuffer[WriteSize], AIndex));
+
+  Stream.Position := NewPos;
+
+  if not FParentChunk.CanHold(WriteSize) then begin
+    FinishBlock;
+  end;
+  
+  FParentChunk.WriteEntry(WriteSize, @NewBuffer[0]);
+  if Final then FinishBlock;
+  //WriteLn(ChunkLevelCount);
+end;
+
+end.
+

+ 872 - 0
packages/extra/chm/chmwriter.pas

@@ -0,0 +1,872 @@
+{ Copyright (C) <2005> <Andrew Haines> chmwriter.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+unit chmwriter;
+{$MODE OBJFPC}{$H+}
+
+interface
+uses Classes, ChmBase, chmtypes, chmspecialfiles;
+
+type
+
+  TGetDataFunc = function (const DataName: String; out PathInChm: String; out FileName: String; var Stream: TStream): Boolean of object;
+  //  DataName :  A FileName or whatever so that the getter can find and open the file to add
+  //  PathInChm:  This is the absolute path in the archive. i.e. /home/user/helpstuff/
+  //              becomes '/' and /home/user/helpstuff/subfolder/ > /subfolder/
+  //  FileName :  /home/user/helpstuff/index.html > index.html
+  //  Stream   :  the file opened with DataName should be written to this stream
+  
+
+
+  { TChmWriter }
+
+  TChmWriter = class(TObject)
+  private
+  
+  
+    ForceExit: Boolean;
+  
+  
+  
+    FDefaultFont: String;
+    FDefaultPage: String;
+    FFullTextSearch: Boolean;
+    FInternalFiles: TFileEntryList; // Contains a complete list of files in the chm including
+    FFrameSize: LongWord;           // uncompressed files and special internal files of the chm
+    FCurrentStream: TStream; // used to buffer the files that are to be compressed
+    FCurrentIndex: Integer;
+    FOnGetFileData: TGetDataFunc;
+    FStringsStream: TMemoryStream;
+    FContextStream: TMemoryStream; // the #IVB file
+    FSection0: TMemoryStream;
+    FSection1: TMemoryStream; // Compressed Stream
+    FSection1Size: Int64;
+    FSection1ResetTable: TMemoryStream; // has a list of frame positions NOT window positions
+    FDirectoryListings: TStream;
+    FIndexStream: TStream;
+    FOutStream: TStream;
+    FFileNames: TStrings;
+    FDestroyStream: Boolean;
+    FTitle: String;
+    FTOCStream: TStream;
+    FWindowSize: LongWord;
+    FReadCompressedSize: Int64; // Current Size of Uncompressed data that went in Section1 (compressed)
+    // Linear order of file
+    ITSFHeader: TITSFHeader;
+    HeaderSection0Table: TITSFHeaderEntry;  // points to HeaderSection0
+    HeaderSection1Table: TITSFHeaderEntry; // points to HeaderSection1
+    HeaderSuffix: TITSFHeaderSuffix; //contains the offset of CONTENTSection0 from zero
+    HeaderSection0: TITSPHeaderPrefix;
+    HeaderSection1: TITSPHeader; // DirectoryListings header
+    // DirectoryListings
+    // CONTENT Section 0 (section 1 is contained in section 0)
+    // EOF
+    // end linear header parts
+    procedure InitITSFHeader;
+    procedure InitHeaderSectionTable;
+    procedure WriteHeader(Stream: TStream);
+    procedure CreateDirectoryListings;
+    procedure WriteDirectoryListings(Stream: TStream);
+    procedure StartCompressingStream;
+    procedure WriteTOC;
+    procedure WriteIndex;
+    procedure WriteSYSTEM;
+    procedure WriteITBITS;
+    procedure WriteSTRINGS;
+    procedure WriteIVB; // context ids
+    procedure WriteREADMEFile;
+    procedure WriteSection0;
+    procedure WriteSection1;
+    procedure WriteDataSpaceFiles(const AStream: TStream);
+    function AddString(AString: String): LongWord;
+    // callbacks for lzxcomp
+    function  AtEndOfData: Longbool;
+    function  GetData(Count: LongInt; Buffer: PByte): LongInt;
+    function  WriteCompressedData(Count: Longint; Buffer: Pointer): LongInt;
+    procedure MarkFrame(UnCompressedTotal, CompressedTotal: LongWord);
+    // end callbacks
+  public
+    constructor Create(OutStream: TStream; FreeStreamOnDestroy: Boolean);
+    destructor Destroy; override;
+    procedure Execute;
+    procedure AddStreamToArchive(AFileName, APath: String; AStream: TStream; Compress: Boolean = True);
+    procedure AddContext(AContext: DWord; ATopic: String);
+    property WindowSize: LongWord read FWindowSize write FWindowSize default 2; // in $8000 blocks
+    property FrameSize: LongWord read FFrameSize write FFrameSize default 1; // in $8000 blocks
+    property FilesToCompress: TStrings read FFileNames;
+    property OnGetFileData: TGetDataFunc read FOnGetFileData write FOnGetFileData;
+    property OutStream: TStream read FOutStream;
+    property Title: String read FTitle write FTitle;
+    property FullTextSearch: Boolean read FFullTextSearch write FFullTextSearch;
+    property DefaultFont: String read FDefaultFont write FDefaultFont;
+    property DefaultPage: String read FDefaultPage write FDefaultPage;
+    property TOCStream: TStream read FTOCStream write FTOCStream;
+    property IndexStream: TStream read FIndexStream write FIndexStream;
+    //property LocaleID: dword read ITSFHeader.LanguageID write ITSFHeader.LanguageID;
+  end;
+
+implementation
+uses dateutils, sysutils, paslzxcomp;
+
+const
+
+  LZX_WINDOW_SIZE = 16; // 16 = 2 frames = 1 shl 16
+  LZX_FRAME_SIZE = $8000;
+
+{ TChmWriter }
+
+procedure TChmWriter.InitITSFHeader;
+begin
+  with ITSFHeader do begin
+    ITSFsig := ITSFFileSig;
+    Version := NToLE(3);
+    // we fix endian order when this is written to the stream
+    HeaderLength := NToLE(SizeOf(TITSFHeader) + (SizeOf(TITSFHeaderEntry)*2) + SizeOf(TITSFHeaderSuffix));
+    Unknown_1 := NToLE(1);
+    TimeStamp:= NToBE(MilliSecondOfTheDay(Now)); //bigendian
+    LanguageID := NToLE($0409); // English / English_US
+    Guid1 := ITSFHeaderGUID;
+    Guid2 := ITSFHeaderGUID;
+  end;
+end;
+
+procedure TChmWriter.InitHeaderSectionTable;
+begin
+  // header section 0
+  HeaderSection0Table.PosFromZero := LEToN(ITSFHeader.HeaderLength);
+  HeaderSection0Table.Length := SizeOf(TITSPHeaderPrefix);
+  // header section 1
+  HeaderSection1Table.PosFromZero := HeaderSection0Table.PosFromZero + HeaderSection0Table.Length;
+  HeaderSection1Table.Length := SizeOf(TITSPHeader)+FDirectoryListings.Size;
+  
+  //contains the offset of CONTENT Section0 from zero
+  HeaderSuffix.Offset := HeaderSection1Table.PosFromZero + HeaderSection1Table.Length;
+  
+  // now fix endian stuff
+  HeaderSection0Table.PosFromZero := NToLE(HeaderSection0Table.PosFromZero);
+  HeaderSection0Table.Length := NToLE(HeaderSection0Table.Length);
+  HeaderSection1Table.PosFromZero := NToLE(HeaderSection1Table.PosFromZero);
+  HeaderSection1Table.Length := NToLE(HeaderSection1Table.Length);
+
+  with HeaderSection0 do begin // TITSPHeaderPrefix;
+    Unknown1 := NToLE($01FE);
+    Unknown2 := 0;
+    // at this point we are putting together the headers. content sections 0 and 1 are complete
+    FileSize := NToLE(HeaderSuffix.Offset + FSection0.Size + FSection1Size);
+    Unknown3 := 0;
+    Unknown4 := 0;
+  end;
+  with HeaderSection1 do begin // TITSPHeader; // DirectoryListings header
+    ITSPsig := ITSPHeaderSig;
+    Version := NToLE(1);
+    DirHeaderLength := NToLE(SizeOf(TITSPHeader));  // Length of the directory header
+    Unknown1 := NToLE($0A);
+    ChunkSize := NToLE($1000);
+    Density := NToLE(2);
+    // updated when directory listings were created
+    //IndexTreeDepth := 1 ; // 1 if there is no index 2 if there is one level of PMGI chunks. will update as
+    //IndexOfRootChunk := -1;// if no root chunk
+    //FirstPMGLChunkIndex,
+    //LastPMGLChunkIndex: LongWord;
+    
+    Unknown2 := NToLE(-1);
+    //DirectoryChunkCount: LongWord;
+    LanguageID := NToLE($0409);
+    GUID := ITSPHeaderGUID;
+    LengthAgain := NToLE($54);
+    Unknown3 := NToLE(-1);
+    Unknown4 := NToLE(-1);
+    Unknown5 := NToLE(-1);
+  end;
+  
+  // more endian stuff
+  HeaderSuffix.Offset := NToLE(HeaderSuffix.Offset);
+end;
+
+procedure TChmWriter.WriteHeader(Stream: TStream);
+begin
+  Stream.Write(ITSFHeader, SizeOf(TITSFHeader));
+  Stream.Write(HeaderSection0Table, SizeOf(TITSFHeaderEntry));
+  Stream.Write(HeaderSection1Table, SizeOf(TITSFHeaderEntry));
+  Stream.Write(HeaderSuffix, SizeOf(TITSFHeaderSuffix));
+  Stream.Write(HeaderSection0, SizeOf(TITSPHeaderPrefix));
+
+end;
+
+procedure TChmWriter.CreateDirectoryListings;
+type
+  TFirstListEntry = record
+    Entry: array[0..511] of byte;
+    Size: Integer;
+  end;
+var
+  Buffer: array [0..511] of Byte;
+  IndexBlock: TPMGIDirectoryChunk;
+  ListingBlock: TDirectoryChunk;
+  I: Integer;
+  Size: Integer;
+  FESize: Integer;
+  FileName: String;
+  FileNameSize: Integer;
+  LastListIndex,
+  LastIndexIndex: Integer;
+  FirstListEntry: TFirstListEntry;
+  ChunkIndex: Integer;
+  ListHeader: TPMGListChunk;
+const
+  PMGL = 'PMGL';
+  PMGI = 'PMGI';
+  procedure UpdateLastListChunk;
+  var
+    Tmp: Int64;
+  begin
+    if ChunkIndex < 1 then begin
+      Exit;
+    end;
+    Tmp := FDirectoryListings.Position;
+    FDirectoryListings.Position := (LastListIndex) * $1000;
+    FDirectoryListings.Read(ListHeader, SizeOf(TPMGListChunk));
+    FDirectoryListings.Position := (LastListIndex) * $1000;
+    ListHeader.NextChunkIndex := NToLE(ChunkIndex);
+    FDirectoryListings.Write(ListHeader, SizeOf(TPMGListChunk));
+    FDirectoryListings.Position := Tmp;
+  end;
+  procedure WriteIndexChunk(ShouldFinish: Boolean = False);
+  var
+    IndexHeader: TPMGIIndexChunk;
+    ParentIndex,
+    TmpIndex: TPMGIDirectoryChunk;
+  begin
+    with IndexHeader do begin
+      PMGIsig := PMGI;
+      UnusedSpace := IndexBlock.FreeSpace;
+    end;
+    IndexBlock.WriteHeader(@IndexHeader);
+    IndexBlock.WriteChunkToStream(FDirectoryListings, ChunkIndex, ShouldFinish);
+    IndexBlock.Clear;
+    if HeaderSection1.IndexOfRootChunk < 0 then HeaderSection1.IndexOfRootChunk := ChunkIndex;
+    if ShouldFinish then begin;
+      HeaderSection1.IndexTreeDepth := 2;
+      ParentIndex := IndexBlock.ParentChunk;
+      if ParentIndex <> nil then repeat // the parent index is notified by our child index when to write
+        HeaderSection1.IndexOfRootChunk := ChunkIndex;
+        TmpIndex := ParentIndex;
+        ParentIndex := ParentIndex.ParentChunk;
+        TmpIndex.Free;
+        Inc(HeaderSection1.IndexTreeDepth);
+        Inc(ChunkIndex);
+      until ParentIndex = nil;
+    end;
+    Inc(ChunkIndex);
+
+  end;
+  procedure WriteListChunk;
+  begin
+    with ListHeader do begin
+      PMGLsig := PMGL;
+      UnusedSpace := NToLE(ListingBlock.FreeSpace);
+      Unknown1 :=  0;
+      PreviousChunkIndex := NToLE(LastListIndex);
+      NextChunkIndex := NToLE(-1); // we update this when we write the next chunk
+    end;
+    if HeaderSection1.FirstPMGLChunkIndex <= 0 then
+      HeaderSection1.FirstPMGLChunkIndex := NToLE(ChunkIndex);
+    HeaderSection1.LastPMGLChunkIndex := NToLE(ChunkIndex);
+    ListingBlock.WriteHeader(@ListHeader);
+    ListingBlock.WriteChunkToStream(FDirectoryListings);
+    ListingBlock.Clear;
+    UpdateLastListChunk;
+
+    LastListIndex := ChunkIndex;
+    Inc(ChunkIndex);
+    // now add to index
+    if not IndexBlock.CanHold(FirstListEntry.Size) then
+      WriteIndexChunk;
+    IndexBlock.WriteEntry(FirstListEntry.Size, @FirstListEntry.Entry[0])
+  end;
+begin
+  // first sort the listings
+  FInternalFiles.Sort;
+  HeaderSection1.IndexTreeDepth := 1;
+  
+  ChunkIndex := 0;
+
+  IndexBlock := TPMGIDirectoryChunk.Create(SizeOf(TPMGIIndexChunk));
+  ListingBlock := TDirectoryChunk.Create(SizeOf(TPMGListChunk));
+  
+  LastIndexIndex := -1;
+  LastListIndex  := -1;
+
+  // add files to a pmgl block until it is full.
+  // after the block is full make a pmgi block and add the first entry of the pmgl block
+  // repeat until the index block is full and start another.
+  // the pmgi chunks take care of needed parent chunks in the tree
+  for I := 0 to FInternalFiles.Count-1 do begin
+    Size := 0;
+    FileName := FInternalFiles.FileEntry[I].Path + FInternalFiles.FileEntry[I].Name;
+    FileNameSize := Length(FileName);
+    // filename length
+    Inc(Size, WriteCompressedInteger(@Buffer[Size], FileNameSize));
+    // filename
+    Move(FileName[1], Buffer[Size], FileNameSize);
+    Inc(Size, FileNameSize);
+    FESize := Size;
+    // File is compressed...
+    Inc(Size, WriteCompressedInteger(@Buffer[Size], Ord(FInternalFiles.FileEntry[I].Compressed)));
+    // Offset from section start
+    Inc(Size, WriteCompressedInteger(@Buffer[Size], FInternalFiles.FileEntry[I].DecompressedOffset));
+    // Size when uncompressed
+    Inc(Size, WriteCompressedInteger(@Buffer[Size], FInternalFiles.FileEntry[I].DecompressedSize));
+
+    if not ListingBlock.CanHold(Size) then
+      WriteListChunk;
+    
+    ListingBlock.WriteEntry(Size, @Buffer[0]);
+    
+    if ListingBlock.ItemCount = 1 then begin // add the first list item to the index
+      Move(Buffer[0], FirstListEntry.Entry[0], FESize);
+      FirstListEntry.Size := FESize + WriteCompressedInteger(@FirstListEntry.Entry[FESize], ChunkIndex);
+    end;
+  end;
+  if ListingBlock.ItemCount > 0 then WriteListChunk;
+
+  if ChunkIndex > 1 then begin
+    if (IndexBlock.ItemCount > 1)
+    or ( (IndexBlock.ItemCount > 0) and (HeaderSection1.IndexOfRootChunk > -1) )
+    then WriteIndexChunk(True);
+  end;
+
+  HeaderSection1.DirectoryChunkCount := NToLE(FDirectoryListings.Size div $1000);
+
+  IndexBlock.Free;
+  ListingBlock.Free;
+  
+  //now fix some endian stuff
+  HeaderSection1.IndexOfRootChunk := NToLE(HeaderSection1.IndexOfRootChunk);
+  HeaderSection1.IndexTreeDepth := NtoLE(HeaderSection1.IndexTreeDepth);
+end;
+
+procedure TChmWriter.WriteDirectoryListings(Stream: TStream);
+begin
+  Stream.Write(HeaderSection1, SizeOf(HeaderSection1));
+  FDirectoryListings.Position := 0;
+  Stream.CopyFrom(FDirectoryListings, FDirectoryListings.Size);
+  FDirectoryListings.Position := 0;
+  //TMemoryStream(FDirectoryListings).SaveToFile('dirlistings.pmg');
+end;
+
+procedure TChmWriter.WriteIndex;
+var
+  Entry: TFileEntryRec;
+  TmpTitle: String;
+begin
+  if IndexStream = nil then Exit;
+
+  if Title <> '' then TmpTitle := Title
+  else TmpTitle := 'default';
+  
+  AddStreamToArchive(TmpTitle+'.hhk', '/', IndexStream);
+end;
+
+procedure TChmWriter.WriteSystem;
+var
+  Entry: TFileEntryRec;
+  EntryCode,
+  EntryLength: Word;
+  TmpStr: String;
+  TmpTitle: String;
+const
+  VersionStr = 'HHA Version 4.74.8702'; // does this matter?
+begin
+  // this creates the /#SYSTEM file
+  Entry.Name := '#SYSTEM';
+  Entry.Path := '/';
+  Entry.Compressed := False;
+  Entry.DecompressedOffset := FSection0.Position;
+  // EntryCodeOrder: 10 9 4 2 3 16 6 0 1 5
+  FSection0.WriteDWord(NToLE(Word(3))); // Version
+  if Title <> '' then
+    TmpTitle := Title
+  else
+    TmpTitle := 'default';
+
+  // Code -> Length -> Data
+  // 10
+  FSection0.WriteWord(NToLE(Word(10)));
+  FSection0.WriteWord(NToLE(Word(SizeOf(DWord))));
+  FSection0.WriteDWord(NToLE(MilliSecondOfTheDay(Now)));
+  // 9
+  FSection0.WriteWord(NToLE(Word(9)));
+  FSection0.WriteWord(NToLE(Word(SizeOf(VersionStr)+1)));
+  FSection0.Write(VersionStr, SizeOf(VersionStr));
+  FSection0.WriteByte(0);
+  // 4 A struct that is only needed to set if full text search is on.
+  FSection0.WriteWord(NToLE(Word(4)));
+  FSection0.WriteWord(NToLE(Word(36))); // size
+  FSection0.WriteDWord(NToLE($0409));
+  FSection0.WriteDWord(NToLE(DWord(Ord(FFullTextSearch))));
+  FSection0.WriteDWord(0);
+  FSection0.WriteDWord(0);
+  FSection0.WriteDWord(0);
+  // two for a QWord
+  FSection0.WriteDWord(0);
+  FSection0.WriteDWord(0);
+  
+  FSection0.WriteDWord(0);
+  FSection0.WriteDWord(0);
+
+  
+
+  
+  ////////////////////////<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+  // 2  default page to load
+  if FDefaultPage <> '' then begin
+    FSection0.WriteWord(NToLE(Word(2)));
+    FSection0.WriteWord(NToLE(Word(Length(FDefaultPage)+1)));
+    FSection0.Write(FDefaultPage[1], Length(FDefaultPage));
+    FSection0.WriteByte(0);
+  end;
+  // 3  Title
+  if FTitle <> '' then begin
+    FSection0.WriteWord(NToLE(Word(3)));
+    FSection0.WriteWord(NToLE(Word(Length(FTitle)+1)));
+    FSection0.Write(FTitle[1], Length(FTitle));
+  end;
+
+  // 16 Default Font
+  if FDefaultFont <> '' then begin
+    FSection0.WriteWord(NToLE(Word(16)));
+    FSection0.WriteWord(NToLE(Word(Length(FDefaultFont)+1)));
+    FSection0.Write(FDefaultFont[1], Length(FDefaultFont));
+  end;
+  
+  // 6
+  // unneeded. if output file is :  /somepath/OutFile.chm the value here is outfile(lowercase)
+  
+  // 0 Table of contents filename
+  if TOCStream <> nil then begin
+    TmpStr := TmpTitle+'.hhc';
+    FSection0.WriteWord(0);
+    FSection0.WriteWord(NToLE(Word(Length(TmpStr)+1)));
+    FSection0.Write(TmpStr[1], Length(TmpStr));
+    FSection0.WriteByte(0);
+  end;
+  // 1
+  // hhk Index
+  if IndexStream <> nil then begin
+    TmpStr := TmpTitle+'.hhk';
+    FSection0.WriteWord(NToLE(Word(1)));
+    FSection0.WriteWord(NToLE(Word(Length(TmpStr)+1)));
+    FSection0.Write(TmpStr[1], Length(TmpStr));
+    FSection0.WriteByte(0);
+  end;
+  // 5 Default Window.
+  // Not likely needed
+  
+  Entry.DecompressedSize := FSection0.Position - Entry.DecompressedOffset;
+  FInternalFiles.AddEntry(Entry);
+end;
+
+procedure TChmWriter.WriteITBITS;
+var
+  Entry: TFileEntryRec;
+begin
+  // This is an empty and useless file
+  Entry.Name := '#ITBITS';
+  Entry.Path := '/';
+  Entry.Compressed := False;
+  Entry.DecompressedOffset := FSection0.Position;
+  Entry.DecompressedSize := 0;
+  
+  FInternalFiles.AddEntry(Entry);
+end;
+
+procedure TChmWriter.WriteSTRINGS;
+begin
+  if FStringsStream.Size = 0 then;
+    FStringsStream.WriteByte(0);
+  FStringsStream.Position := 0;
+  AddStreamToArchive('#STRINGS', '/', FStringsStream);
+end;
+
+procedure TChmWriter.WriteIVB;
+begin
+  if FContextStream = nil then exit;
+
+  FContextStream.Position := 0;
+  // the size of all the entries
+  FContextStream.WriteDWord(NToLE(FContextStream.Size-SizeOf(dword)));
+  
+  FContextStream.Position := 0;
+  AddStreamToArchive('#IVB', '/', FContextStream);
+end;
+
+procedure TChmWriter.WriteREADMEFile;
+const DISCLAIMER_STR = 'This archive was not made by the MS HTML Help Workshop(r)(tm) program.';
+var
+  Entry: TFileEntryRec;
+begin
+  // This procedure puts a file in the archive that says it wasn't compiled with the MS compiler
+  Entry.Compressed := False;
+  Entry.DecompressedOffset := FSection0.Position;
+  FSection0.Write(DISCLAIMER_STR, SizeOf(DISCLAIMER_STR));
+  Entry.DecompressedSize := FSection0.Position - Entry.DecompressedOffset;
+  Entry.Path := '/';
+  Entry.Name := '_::_README_::_'; //try to use a name that won't conflict with normal names
+  FInternalFiles.AddEntry(Entry);
+end;
+
+
+procedure TChmWriter.WriteSection0;
+begin
+  FSection0.Position := 0;
+  FOutStream.CopyFrom(FSection0, FSection0.Size);
+end;
+
+procedure TChmWriter.WriteSection1;
+begin
+  WriteContentToStream(FOutStream, FSection1);
+end;
+
+procedure TChmWriter.WriteDataSpaceFiles(const AStream: TStream);
+var
+  Entry: TFileEntryRec;
+begin
+  // This procedure will write all files starting with ::
+  Entry.Compressed := False; // None of these files are compressed
+
+  //  ::DataSpace/NameList
+  Entry.DecompressedOffset := FSection0.Position;
+  Entry.DecompressedSize := WriteNameListToStream(FSection0, [snUnCompressed,snMSCompressed]);
+  Entry.Path := '::DataSpace/';
+  Entry.Name := 'NameList';
+  FInternalFiles.AddEntry(Entry, False);
+
+  //  ::DataSpace/Storage/MSCompressed/ControlData
+  Entry.DecompressedOffset := FSection0.Position;
+  Entry.DecompressedSize := WriteControlDataToStream(FSection0, 2, 2, 1);
+  Entry.Path := '::DataSpace/Storage/MSCompressed/';
+  Entry.Name := 'ControlData';
+  FInternalFiles.AddEntry(Entry, False);
+  
+  //  ::DataSpace/Storage/MSCompressed/SpanInfo
+  Entry.DecompressedOffset := FSection0.Position;
+  Entry.DecompressedSize := WriteSpanInfoToStream(FSection0, FReadCompressedSize);
+  Entry.Path := '::DataSpace/Storage/MSCompressed/';
+  Entry.Name := 'SpanInfo';
+  FInternalFiles.AddEntry(Entry, False);
+
+  //  ::DataSpace/Storage/MSCompressed/Transform/List
+  Entry.DecompressedOffset := FSection0.Position;
+  Entry.DecompressedSize := WriteTransformListToStream(FSection0);
+  Entry.Path := '::DataSpace/Storage/MSCompressed/Transform/';
+  Entry.Name := 'List';
+  FInternalFiles.AddEntry(Entry, False);
+
+  //  ::DataSpace/Storage/MSCompressed/Transform/{7FC28940-9D31-11D0-9B27-00A0C91E9C7C}/
+  //  ::DataSpace/Storage/MSCompressed/Transform/{7FC28940-9D31-11D0-9B27-00A0C91E9C7C}/InstanceData/ResetTable
+  Entry.DecompressedOffset := FSection0.Position;
+  Entry.DecompressedSize := WriteResetTableToStream(FSection0, FSection1ResetTable);
+  Entry.Path := '::DataSpace/Storage/MSCompressed/Transform/{7FC28940-9D31-11D0-9B27-00A0C91E9C7C}/InstanceData/';
+  Entry.Name := 'ResetTable';
+  FInternalFiles.AddEntry(Entry, True);
+
+
+  //  ::DataSpace/Storage/MSCompressed/Content do this last
+  Entry.DecompressedOffset := FSection0.Position;
+  Entry.DecompressedSize := FSection1Size; // we will write it directly to FOutStream later
+  Entry.Path := '::DataSpace/Storage/MSCompressed/';
+  Entry.Name := 'Content';
+  FInternalFiles.AddEntry(Entry, False);
+
+  
+end;
+
+function TChmWriter.AddString(AString: String): LongWord;
+begin
+  // #STRINGS starts with a null char
+  if FStringsStream.Size = 0 then FStringsStream.WriteByte(0);
+  // each entry is a null terminated string
+  Result := FStringsStream.Position;
+  FStringsStream.WriteBuffer(AString[1], Length(AString));
+  FStringsStream.WriteByte(0);
+end;
+
+function _AtEndOfData(arg: pointer): LongBool; cdecl;
+begin
+  Result := TChmWriter(arg).AtEndOfData;
+end;
+
+function TChmWriter.AtEndOfData: LongBool;
+begin
+  Result := ForceExit or (FCurrentIndex >= FFileNames.Count-1);
+  if Result then
+    Result := Integer(FCurrentStream.Position) >= Integer(FCurrentStream.Size)-1;
+end;
+
+function _GetData(arg: pointer; Count: LongInt; Buffer: Pointer): LongInt; cdecl;
+begin
+  Result := TChmWriter(arg).GetData(Count, PByte(Buffer));
+end;
+
+function TChmWriter.GetData(Count: LongInt; Buffer: PByte): LongInt;
+var
+  FileEntry: TFileEntryRec;
+begin
+  Result := 0;
+  while (Result < Count) and (not AtEndOfData) do begin
+    Inc(Result, FCurrentStream.Read(Buffer[Result], Count-Result));
+    if (Result < Count) and (not AtEndOfData)
+    then begin
+      // the current file has been read. move to the next file in the list
+      FCurrentStream.Position := 0;
+      Inc(FCurrentIndex);
+      ForceExit := OnGetFileData(FFileNames[FCurrentIndex], FileEntry.Path, FileEntry.Name, FCurrentStream);
+      FileEntry.DecompressedSize := FCurrentStream.Size;
+      FileEntry.DecompressedOffset := FReadCompressedSize; //269047723;//to test writing really large numbers
+      FileEntry.Compressed := True;
+      
+      FInternalFiles.AddEntry(FileEntry);
+      // So the next file knows it's offset
+      Inc(FReadCompressedSize,  FileEntry.DecompressedSize);
+      FCurrentStream.Position := 0;
+    end;
+  end;
+end;
+
+function _WriteCompressedData(arg: pointer; Count: LongInt; Buffer: Pointer): LongInt; cdecl;
+begin
+  Result := TChmWriter(arg).WriteCompressedData(Count, Buffer);
+end;
+
+function TChmWriter.WriteCompressedData(Count: Longint; Buffer: Pointer): LongInt;
+begin
+  // we allocate a MB at a time to limit memory reallocation since this
+  // writes usually 2 bytes at a time
+  if FSection1.Position >= FSection1.Size-1 then begin
+    FSection1.Size := FSection1.Size+$100000;
+  end;
+  Inc(FSection1Size, FSection1.Write(Buffer^, Count));
+
+end;
+
+procedure _MarkFrame(arg: pointer; UncompressedTotal, CompressedTotal: LongWord); cdecl;
+begin
+  TChmWriter(arg).MarkFrame(UncompressedTotal, CompressedTotal);
+end;
+
+procedure TChmWriter.MarkFrame(UnCompressedTotal, CompressedTotal: LongWord);
+  procedure WriteQWord(Value: QWord);
+  begin
+    FSection1ResetTable.Write(NToLE(Value), 8);
+  end;
+  procedure IncEntryCount;
+  var
+    OldPos: Int64;
+    Value: DWord;
+  begin
+    OldPos := FSection1ResetTable.Position;
+    FSection1ResetTable.Position := $4;
+    Value := LeToN(FSection1ResetTable.ReadDWord)+1;
+    FSection1ResetTable.Position := $4;
+    FSection1ResetTable.WriteDWord(NToLE(Value));
+    FSection1ResetTable.Position := OldPos;
+  end;
+  procedure UpdateTotalSizes;
+  var
+    OldPos: Int64;
+    Value: DWord;
+  begin
+    OldPos := FSection1ResetTable.Position;
+    FSection1ResetTable.Position := $10;
+    WriteQWord(FReadCompressedSize); // size of read data that has been compressed
+    WriteQWord(CompressedTotal);
+    FSection1ResetTable.Position := OldPos;
+  end;
+var
+  Tmp : QWord;
+begin
+  if FSection1ResetTable.Size = 0 then begin
+    // Write the header
+    FSection1ResetTable.WriteDWord(NtoLE(2));
+    FSection1ResetTable.WriteDWord(0); // number of entries. we will correct this with IncEntryCount
+    FSection1ResetTable.WriteDWord(NtoLE(8)); // Size of Entries (qword)
+    FSection1ResetTable.WriteDWord(NtoLE($28)); // Size of this header
+    WriteQWord(0); // Total Uncompressed Size
+    WriteQWord(0); // Total Compressed Size
+    WriteQWord(NtoLE($8000)); // Block Size
+    WriteQWord(0); // First Block start
+  end;
+  IncEntryCount;
+  UpdateTotalSizes;
+  WriteQWord(CompressedTotal); // Next Block Start
+  // We have to trim the last entry off when we are done because there is no next block in that case
+end;
+
+constructor TChmWriter.Create(OutStream: TStream; FreeStreamOnDestroy: Boolean);
+begin
+  if OutStream = nil then Raise Exception.Create('TChmWriter.OutStream Cannot be nil!');
+  FCurrentStream := TMemoryStream.Create;
+  FCurrentIndex := -1;
+  FOutStream := OutStream;
+  FInternalFiles := TFileEntryList.Create;
+  FStringsStream := TmemoryStream.Create;
+  FSection0 := TMemoryStream.Create;
+  FSection1 := TMemoryStream.Create;
+  FSection1ResetTable := TMemoryStream.Create;
+  FDirectoryListings := TMemoryStream.Create;
+  FDestroyStream := FreeStreamOnDestroy;
+  FFileNames := TStringList.Create;
+end;
+
+destructor TChmWriter.Destroy;
+begin
+  if FDestroyStream then FOutStream.Free;
+  if Assigned(FContextStream) then FContextStream.Free;
+  FInternalFiles.Free;
+  FCurrentStream.Free;
+  FStringsStream.Free;
+  FSection0.Free;
+  FSection1.Free;
+  FSection1ResetTable.Free;
+  FDirectoryListings.Free;
+  FFileNames.Free;
+  inherited Destroy;
+end;
+
+procedure TChmWriter.Execute;
+begin
+  InitITSFHeader;
+  FOutStream.Position := 0;
+  FSection1Size := 0;
+
+  // write any internal files to FCurrentStream that we want in the compressed section
+  WriteIVB;
+  WriteTOC;
+  WriteIndex;
+  WriteSTRINGS;
+  
+  // written to Section0 (uncompressed)
+  WriteREADMEFile;
+  
+  // move back to zero so that we can start reading from zero :)
+  FReadCompressedSize := FCurrentStream.Size;
+  FCurrentStream.Position := 0;  // when compressing happens, first the FCurrentStream is read
+                                 // before loading user files. So we can fill FCurrentStream with
+                                 // internal files first.
+
+  // this gathers ALL files that should be in section1 (the compressed section)
+  StartCompressingStream;
+  FSection1.Size := FSection1Size;
+
+  // This creates and writes the #ITBITS (empty) file to section0
+  WriteITBITS;
+  // This creates and writes the #SYSTEM file to section0
+  WriteSystem;
+
+  //this creates all special files in the archive that start with ::DataSpace
+  WriteDataSpaceFiles(FSection0);
+  
+  // creates all directory listings including header
+  CreateDirectoryListings;
+
+  // do this after we have compressed everything so that we know the values that must be written
+  InitHeaderSectionTable;
+
+  // Now we can write everything to FOutStream
+  WriteHeader(FOutStream);
+  WriteDirectoryListings(FOutStream);
+  WriteSection0; //does NOT include section 1 even though section0.content IS section1
+  WriteSection1; // writes section 1 to FOutStream
+end;
+
+
+// this procedure is used to manually add files to compress to an internal stream that is
+// processed before FileToCompress is called. Files added this way should not be
+// in the FilesToCompress property.
+procedure TChmWriter.AddStreamToArchive(AFileName, APath: String; AStream: TStream; Compress: Boolean = True);
+var
+  TargetStream: TStream;
+  Entry: TFileEntryRec;
+begin
+  if AStream = nil then Exit;
+  if Compress then
+    TargetStream := FCurrentStream
+  else
+    TargetStream := FSection0;
+
+  Entry.Name := AFileName;
+  Entry.Path := APath;
+  Entry.Compressed :=  Compress;
+  Entry.DecompressedOffset := TargetStream.Position;
+  Entry.DecompressedSize := AStream.Size;
+  FInternalFiles.AddEntry(Entry);
+  AStream.Position := 0;
+  FCurrentStream.CopyFrom(AStream, AStream.Size);
+end;
+
+procedure TChmWriter.AddContext(AContext: DWord; ATopic: String);
+var
+  Offset: DWord;
+begin
+  if FContextStream = nil then begin
+    // #IVB starts with a dword which is the size of the stream - sizeof(dword)
+    FContextStream.WriteDWord(0);
+    // we will update this when we write the file to the final stream
+  end;
+  // an entry is a context id and then the offset of the name of the topic in the strings file
+  FContextStream.WriteDWord(NToLE(AContext));
+  Offset := NToLE(AddString(ATopic));
+  FContextStream.WriteDWord(Offset);
+end;
+
+procedure TChmWriter.StartCompressingStream;
+var
+  LZXdata: Plzx_data;
+  WSize: LongInt;
+begin
+  lzx_init(@LZXdata, LZX_WINDOW_SIZE, @_GetData, Self, @_AtEndOfData,
+              @_WriteCompressedData, Self, @_MarkFrame, Self);
+
+  WSize := 1 shl LZX_WINDOW_SIZE;
+  while not AtEndOfData do begin
+    lzx_reset(LZXdata);
+    lzx_compress_block(LZXdata, WSize, True);
+  end;
+
+  //we have to mark the last frame manually
+  MarkFrame(LZXdata^.len_uncompressed_input, LZXdata^.len_compressed_output);
+
+  lzx_finish(LZXdata, nil);
+end;
+
+procedure TChmWriter.WriteTOC;
+var
+  TmpTitle: String;
+begin
+  if TOCStream = nil then Exit;
+  if Title <> '' then TmpTitle := Title
+  else TmpTitle := 'default';
+
+  AddStreamToArchive(TmpTitle+'.hhc', '/', TOCStream);
+end;
+
+
+end.

+ 310 - 0
packages/extra/chm/fasthtmlparser.pas

@@ -0,0 +1,310 @@
+{ Copyright (C) <2005> <Andrew Haines> fasthtmlparser.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+// TODO:
+{
+  - OnDone event when parser is finished
+  - advanced parsing NAME=VALUE pairs
+}
+{
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+                    FastHTMLParser unit to parse HTML
+                  (disect html into its tags and text.)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+ TITLE        : Fast HTML Parser (modified)
+ CLASS        : TjsFastHTMLParser
+ VERSION      : 0.4La
+
+ AUTHOR       : James Azarja
+                http://www.jazarsoft.com/
+
+ CONTRIBUTORS : L505
+                http://z505.com
+
+                YourName Here...
+
+
+ LEGAL        : Copyright (C) 2004 Jazarsoft, All Rights Reserved.
+                Modified 2005 Lars (L505)
+
+--------------------------------------------------------------------------------
+
+  - Modified for use as a pure command line unit (no dialogs) for freepascal.
+  - Also added UPPERCASE tags so that when you check for <font> it returns all
+    tags like <FONT> and <FoNt> and <font>
+
+ Use it for what reasons:
+    -make your own web browsers,
+    -make your own text copies of web pages for caching purposes
+    -Grab content from websites -without- using regular expressions
+    -Seems to be MUCH MUCH FASTER than regular expressions, as it is after all
+     a true parser
+    -convert website tables into spreadsheets (parse <TD> and <TR>, turn in to
+     CSV or similar)
+    -convert websites into text files (parse all text, and tags <BR> <P> )
+    -convert website tables into CSV/Database (<parse <TD> and <TR>)
+    -find certain info from a web page.. i.e. all the bold text or hyperlinks in
+     a page.
+    -Parse websites remotely from a CGI app using something like Sockets or
+     Synapse and SynWrap to first get the HTML site. This would allow you to
+     dynamically parse info from websites and display data on your site in real
+     time.
+    -HTML editor.. WYSIWYG or a partial WYSIWYG editor. Ambitious, but possible.
+    -HTML property editor. Not completely wysiwyg but ability to edit proprties
+     of tags. Work would need to be done to parse each property in a tag.
+
+
+--------------------------------------------------------------------------------
+ LICENSE/TERMS
+--------------------------------------------------------------------------------
+
+ This code may be used and modified by anyone so long as  this header and
+ copyright  information remains intact.
+
+ The code is provided "AS-IS" and without WARRANTY OF ANY KIND,
+ expressed, implied or otherwise, including and without limitation, any
+ warranty of merchantability or fitness for a  particular purpose. 
+
+ In no event shall the author be liable for any special, incidental,
+ indirect or consequential damages whatsoever (including, without
+ limitation, damages for loss of profits, business interruption, loss
+ of information, or any other loss), whether or not advised of the
+ possibility of damage, and on any theory of liability, arising out of
+ or in connection with the use or inability to use this software.  
+
+
+--------------------------------------------------------------------------------
+ HISTORY:
+--------------------------------------------------------------------------------
+
+ 0.1     -  James:
+             Initial Development
+             mostly based on Peter Irlam works & ideas
+
+ 0.2     -  James:
+             Some minor bug has fixed
+
+ 0.3     -  James:
+             Some jsHTMLUtil function bug has been fixed
+
+ 0.4     -  James:
+             jsHTMLUtil Tag Attributes bug has been fixed
+             thanks to Dmitry [[email protected]]
+
+ 0.4L.1a -  L505:
+             Made unit work with freepascal, added UPCASE (case insensitive)
+             exec function
+
+ 0.4L.1b -  L505:
+             Changed case insensitive version to a new class instead of
+             the old ExecUpcase
+
+                                                                                                                                                          //
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+}
+
+{$IFDEF FPC}{$MODE DELPHI}{$H+}{$ENDIF}
+
+
+// {$DEFINE DEBUGLN_ON}
+
+unit FastHTMLParser;
+
+
+interface
+
+uses
+ {$IFDEF KOL_MCK}
+  KOL;
+ {$else}
+  SysUtils;
+ {$ENDIF}
+
+
+{$IFDEF DEBUGLN_ON}
+  // dummy, default debugging
+  procedure debugproc(s: string);
+  // for custom debugging, assign this in your units 
+  var debugln: procedure(s: string) = debugproc;
+{$ENDIF}
+
+type
+
+  // when tag content found in HTML, including names and values
+  // case insensitive analysis available via NoCaseTag
+  TOnFoundTag = procedure(NoCaseTag, ActualTag: string) of object;
+
+  // when text  found in the HTML
+  TOnFoundText = procedure(Text: string) of object;
+
+  // Lars's modified html parser, case insensitive or case sensitive 
+  THTMLParser = class(TObject)
+    public
+      OnFoundTag: TOnFoundTag;
+      OnFoundText: TOnFoundText;
+      Raw: Pchar;
+      constructor Create(sRaw: string);overload;
+      constructor Create(pRaw: PChar);overload;
+      procedure Exec;
+      procedure NilOnFoundTag(NoCaseTag, ActualTag: string);
+      procedure NilOnFoundText(Text: string);
+  end;
+
+
+implementation
+
+
+// default debugging, do nothing, let user do his own by assigning DebugLn var
+procedure debugproc(s: string);
+begin 
+end;
+
+function CopyBuffer(StartIndex: PChar; Length: Integer): string;
+var
+  S: string;
+begin
+  SetLength(S, Length);
+  StrLCopy(@S[1], StartIndex, Length);
+  Result:= S;
+end;
+
+
+
+{ ************************ THTMLParser ************************************** }
+
+constructor THTMLParser.Create(pRaw: Pchar);
+begin
+  if pRaw = '' then exit;
+  if pRaw = nil then exit;
+  Raw:= pRaw;
+end;
+
+constructor THTMLParser.Create(sRaw: string);
+begin
+  if sRaw = '' then exit;
+  Raw:= Pchar(sRaw);
+end;
+
+{ default dummy "do nothing" events if events are unassigned }
+procedure THTMLParser.NilOnFoundTag(NoCaseTag, ActualTag: string);
+begin 
+end;
+
+procedure THTMLParser.NilOnFoundText(Text: string);
+begin 
+end;
+
+procedure THTMLParser.Exec;
+var
+  L: Integer;
+  TL: Integer;
+  I: Integer;
+  Done: Boolean;
+  TagStart,
+  TextStart,
+  P: PChar;   // Pointer to current char.
+  C: Char;
+begin
+  {$IFDEF DEBUGLN_ON}debugln('FastHtmlParser Exec Begin');{$ENDIF}
+  { set nil events once rather than checking for nil each time tag is found }
+  if not assigned(OnFoundText) then
+    OnFoundText:= NilOnFoundText;
+  if not assigned(OnFoundTag) then
+    OnFoundTag:= NilOnFoundTag;
+
+  TL:= StrLen(Raw);
+  I:= 0;
+  P:= Raw;
+  Done:= False;
+  if P <> nil then
+  begin
+    TagStart:= nil;
+    repeat
+      TextStart:= P;
+      { Get next tag position }
+      while Not (P^ in [ '<', #0 ]) do
+      begin
+        Inc(P); Inc(I);
+        if I >= TL then
+        begin
+          Done:= True;
+          Break;
+        end;
+      end;
+      if Done then Break;
+
+      { Is there any text before ? }
+      if (TextStart <> nil) and (P > TextStart) then
+      begin
+        L:= P - TextStart;
+        { Yes, copy to buffer }
+        OnFoundText( CopyBuffer(TextStart, L) );
+      end else
+      begin
+        TextStart:= nil;
+      end;
+      { No }
+
+      TagStart:= P;
+      while Not (P^ in [ '>', #0]) do
+      begin
+        // Find string in tag
+        if (P^ = '"') or (P^ = '''') then
+        begin
+          C:= P^;
+          Inc(P); Inc(I); // Skip current char " or '
+
+          // Skip until string end
+          while Not (P^ in [C, #0]) do
+          begin
+            Inc(P);Inc(I);
+          end;
+        end;
+
+        Inc(P);Inc(I);
+        if I >= TL then
+        begin
+          Done:= True;
+          Break;
+        end;
+      end;
+      if Done then Break;
+
+      { Copy this tag to buffer }
+      L:= P - TagStart + 1;
+
+      OnFoundTag( uppercase(CopyBuffer(TagStart, L )), CopyBuffer(TagStart, L ) ); //L505: added uppercase
+      Inc(P); Inc(I);
+      if I >= TL then Break;
+    until (Done);
+  end;
+  {$IFDEF DEBUGLN_ON}debugln('FastHtmlParser Exec End');{$ENDIF}
+end;
+
+
+end.
+
+
+
+

+ 387 - 0
packages/extra/chm/htmlutil.pas

@@ -0,0 +1,387 @@
+{ Copyright (C) <2005> <Andrew Haines> htmlutil.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+{ modified from jsFastHtmlParser  for use with freepascal 
+  
+ Original Author:
+  James Azarja
+
+ Contributor:
+  Lars aka L505
+  http://z505.com 
+
+ Note: this isn't perfect, it needs to be improved.. see comments  }
+  
+unit HTMLUtil; {$ifdef fpc} {$MODE Delphi} {$H+}{$endif}
+
+interface
+
+uses 
+  SysUtils, strutils;
+
+{ most commonly used }
+function GetVal(tag, attribname_ci: string): string;
+function GetTagName(Tag: string): string;
+
+{ less commonly used, but useful }
+function GetUpTagName(tag: string): string;
+function GetNameValPair(tag, attribname_ci: string): string;
+function GetValFromNameVal(namevalpair: string): string;
+
+{ old buggy code}
+function GetVal_JAMES(tag, attribname_ci: string): string;
+function GetNameValPair_JAMES(tag, attribname_ci: string): string;
+
+{ rarely needed NAME= case sensitivity }
+function GetNameValPair_cs(tag, attribname: string): string;
+
+
+implementation
+
+function CopyBuffer(StartIndex: PChar; Len: integer): string;
+var s : String;
+begin
+  SetLength(s, Len);
+  StrLCopy(@s[1], StartIndex, Len);
+  result:= s;
+end;
+
+{ Return tag name, case preserved }
+function GetTagName(Tag: string): string;
+var
+  P : Pchar;
+  S : Pchar;
+begin
+  P := Pchar(Tag);
+  while P^ in ['<',' ',#9] do inc(P);
+  S := P;
+  while Not (P^ in [' ','>',#0]) do inc(P);
+  if P > S then
+    Result := CopyBuffer( S, P-S)
+  else
+   Result := '';
+end;
+
+{ Return tag name in uppercase }
+function GetUpTagName(tag: string): string;
+var
+  P : Pchar;
+  S : Pchar;
+begin
+  P := Pchar(uppercase(Tag));
+  while P^ in ['<',' ',#9] do inc(P);
+  S := P;
+  while Not (P^ in [' ','>',#0]) do inc(P);
+  if P > S then
+    Result := CopyBuffer( S, P-S)
+  else
+   Result := '';
+end;
+
+
+{ Return name=value pair ignoring case of NAME, preserving case of VALUE
+  Lars' fixed version }
+function GetNameValPair(tag, attribname_ci: string): string;
+var
+  P    : Pchar;
+  S    : Pchar;
+  UpperTag,
+  UpperAttrib   : string;
+  Start: integer;
+  L    : integer;
+  C    : char;
+begin
+  // must be space before case insensitive NAME, i.e. <a HREF="" STYLE=""
+  UpperAttrib:= ' ' + Uppercase(attribname_ci);
+  UpperTag:= Uppercase(Tag);
+  P:= Pchar(UpperTag);
+  S:= StrPos(P, Pchar(UpperAttrib));
+
+  if S <> nil then
+  begin
+    inc(S); // skip space
+    P:= S;
+
+    // Skip 
+    while not (P^ in ['=', ' ', '>', #0]) do
+      inc(P);
+
+    if (P^ = '=') then inc(P);
+    
+    while not (P^ in [' ','>',#0]) do
+    begin
+      if (P^ in ['"','''']) then
+      begin
+        C:= P^;
+        inc(P); { Skip quote }
+      end else
+        C:= ' ';
+
+      { thanks to Dmitry [[email protected]] }
+      while not (P^ in [C, '>', #0]) do
+        Inc(P);
+
+      if (P^ <> '>') then inc(P); { Skip current character, except '>' }
+
+      break;
+    end;
+
+    L:= P - S;
+    Start:= S - Pchar(UpperTag);
+    P:= Pchar(Tag);
+    S:= P;
+    inc(S, Start);
+ 
+    result:= CopyBuffer(S, L);
+  end;
+end;
+
+
+{ Get value of attribute, e.g WIDTH=36 -return-> 36, preserves case sensitive }
+function GetValFromNameVal(namevalpair: string): string;
+var
+  P: Pchar;
+  S: Pchar;
+  C: Char;
+begin
+  P:= Pchar(namevalpair);
+  S:= StrPos(P, '=');
+
+  if S <> nil then     
+  begin
+    inc(S); // skip equal
+    P:= S;  // set P to a character after =
+
+    if (P^ in ['"','''']) then
+    begin
+      C:= P^;
+      Inc(P); { Skip current character }
+    end else
+      C:= ' ';
+
+    S:= P;
+    while not (P^ in [C, #0]) do
+      inc(P);
+
+    if (P <> S) then { Thanks to Dave Keighan ([email protected]) }
+      Result:= CopyBuffer(S, P - S) 
+    else
+      Result:= '';
+  end;
+end;
+
+
+{ return value of an attribute (attribname_ci), case ignored for NAME portion, but return value case is preserved } 
+function GetVal(tag, attribname_ci: string): string;
+var namevalpair: string;
+begin
+  // returns full name=value pair
+  namevalpair:= GetNameValPair(tag, attribname_ci);
+  // extracts value portion only
+  result:= GetValFromNameVal(namevalpair);
+end;
+
+
+{ ----------------------------------------------------------------------------
+  BELOW FUNCTIONS ARE OBSOLETE OR RARELY NEEDED SINCE THEY EITHER CONTAIN BUGS
+  OR THEY ARE TOO CASE SENSITIVE (FOR THE TAG NAME PORTION OF THE ATTRIBUTE  }
+
+{ James old buggy code for testing purposes. 
+  Bug: when finding 'ID', function finds "width", even though width <> "id" }
+function GetNameValPair_JAMES(tag, attribname_ci: string): string;
+var
+  P    : Pchar;
+  S    : Pchar;
+  UT,
+  UA   : string;
+  Start: integer;
+  L    : integer;
+  C    : char;
+begin
+  UA:= Uppercase(attribname_ci);
+  UT:= Uppercase(Tag);
+  P:= Pchar(UT);
+  S:= StrPos(P, Pchar(UA));
+  if S <> nil then
+  begin
+
+    P := S;
+
+    // Skip attribute name
+    while not (P^ in ['=',' ','>',#0]) do
+      inc(P);
+
+    if (P^ = '=') then inc(P);
+    
+    while not (P^ in [' ','>',#0]) do
+    begin
+
+      if (P^ in ['"','''']) then
+      begin
+        C:= P^;
+        inc(P); { Skip current character }
+      end else
+        C:= ' ';
+
+      { thanks to Dmitry [[email protected]] }
+      while not (P^ in [C, '>', #0]) do
+        Inc(P);
+
+      if (P^ <> '>') then inc(P); { Skip current character, except '>' }
+      break;
+    end;
+
+    L:= P - S;
+    Start:= S - Pchar(UT);
+    P:= Pchar(Tag);
+    S:= P;
+    inc(S, Start);
+    result:= CopyBuffer(S, L);
+  end;
+end;
+
+
+{ James old buggy code for testing purposes }
+function GetVal_JAMES(tag, attribname_ci: string): string;
+var namevalpair: string;
+begin
+  namevalpair:= GetNameValPair_JAMES(tag, attribname_ci);
+  result:= GetValFromNameVal(namevalpair);
+end;
+
+{ return name=value portion, case sensitive, case preserved }
+function GetNameValPair_cs(Tag, attribname: string): string;
+var
+  P    : Pchar;
+  S    : Pchar;
+  C    : Char;
+begin
+  P := Pchar(Tag);
+  S := StrPos(P, Pchar(attribname));
+  if S<>nil then
+  begin
+    P := S;
+
+    // Skip attribute name
+    while not (P^ in ['=',' ','>',#0]) do
+      inc(P);
+
+    if (P^ = '=') then inc(P);
+    
+    while not (P^ in [' ','>',#0]) do
+    begin
+
+      if (P^ in ['"','''']) then
+      begin
+        C:= P^;
+        inc(P); { Skip current character }
+      end else
+        C:= ' ';
+
+      { thanks to Dmitry [[email protected]] }
+      while not (P^ in [C, '>', #0]) do
+        inc(P);
+
+      if (P^<>'>') then inc(P); { Skip current character, except '>' }
+      break;
+    end;
+
+    if P > S then
+      Result:= CopyBuffer(S, P - S) 
+    else
+      Result:= '';
+  end;
+end;
+
+
+end.
+
+
+
+
+
+(* alternative, not needed
+
+{ return value (case preserved) from a name=value pair, ignores case in given NAME= portion }
+function GetValFromNameVal(namevalpair: string): string;
+
+  type 
+    TAttribPos = record
+      startpos: longword; // start pos of value
+      len: longword;      // length of value
+    end;
+
+  { returns case insensitive start position and length of just the value 
+    substring in name=value pair}
+  function ReturnPos(attribute: string): TAttribPos;
+  var
+    P    : Pchar;
+    S    : Pchar;
+    C    : Char;
+  begin
+    result.startpos:= 0;
+    result.len:= 0;
+    P:= Pchar(uppercase(Attribute));
+    // get substring including and everything after equal
+    S:= StrPos(P, '=');
+    result.startpos:= pos('=', P); 
+
+    if S <> nil then
+    begin
+      inc(S);  
+      // set to character after =
+      inc(result.startpos);
+      P:= S; 
+
+      if (P^ in ['"','''']) then
+      begin
+        C:= P^;
+        // skip quote 
+        inc(P); 
+        inc(result.startpos);
+      end else
+        C:= ' ';
+
+      S:= P;
+      // go to end quote or end of value
+      while not (P^ in [C, #0]) do
+        inc(P);
+
+      if (P <> S) then 
+      begin
+        result.len:= p - s;
+      end;
+    end;
+
+  end;
+
+var 
+  found: TAttribPos;
+begin
+  found:= ReturnPos(namevalpair);
+  // extract using coordinates
+  result:= MidStr(namevalpair, found.startpos, found.len);
+end;
+
+*)
+
+
+
+

+ 344 - 0
packages/extra/chm/paslznonslide.pas

@@ -0,0 +1,344 @@
+{ Renewed copyright, with permission of the author:
+  Copyright (C) 2002 Matthew T. Russotto
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+unit paslznonslide;
+{$MODE OBJFPC}
+
+interface
+{$IFDEF FPC}
+{$PACKRECORDS C}
+{$ENDIF}
+
+{$DEFINE LAZY}
+{$DEFINE DEBUG_LZ}
+
+type
+
+  u_char = Byte;
+  Pu_char  = ^u_char;
+  PPu_char = ^Pu_char;
+
+     Plz_info = ^lz_info;
+
+
+     get_chars_t = function (lzi:plz_info; n:longint; buf:pu_char):longint; cdecl;
+
+     output_match_t = function (lzi:plz_info; match_pos:longint; match_len:longint):longint; cdecl;
+
+     output_literal_t = procedure (lzi:plz_info; ch:u_char); cdecl;
+  { window size in bytes  }
+  { size of longest match in bytes  }
+  { location within stream  }
+
+  lz_info = record
+          wsize : longint;
+          max_match : longint;
+          min_match : longint;
+          block_buf : pu_char;
+          block_bufe : pu_char;
+          block_buf_size : longint;
+          chars_in_buf : longint;
+          cur_loc : longint;
+          block_loc : longint;
+          frame_size : longint;
+          max_dist : longint;
+          prevtab : ppu_char;
+          lentab : plongint;
+          eofcount : smallint;
+          stop : smallint;
+          analysis_valid : smallint;
+          get_chars : get_chars_t;
+          output_match : output_match_t;
+          output_literal : output_literal_t;
+          user_data : pointer;
+       end;
+
+  procedure lz_init(lzi:plz_info; wsize:longint; max_dist:longint; max_match:longint; min_match:longint;
+              frame_size:longint; get_chars:get_chars_t; output_match:output_match_t; output_literal:output_literal_t; user_data:pointer);
+
+  procedure lz_release(lzi:plz_info);
+
+  procedure lz_reset(lzi:plz_info);
+
+  procedure lz_stop_compressing(lzi:plz_info);
+
+  function lz_left_to_process(lzi:plz_info):longint;
+
+  { returns # chars read in but unprocessed  }
+  function lz_compress(lzi:plz_info; nchars:longint):longint;
+
+
+implementation
+{$IFDEF DEBUG_LZ}
+uses Sysutils;
+{$ENDIF}
+
+const
+  MAX_MATCH = 253;
+  MIN_MATCH = 2;
+
+procedure lz_init(lzi:plz_info; wsize:longint; max_dist:longint; max_match:longint; min_match:longint;
+              frame_size:longint; get_chars:get_chars_t; output_match:output_match_t; output_literal:output_literal_t; user_data:pointer);
+begin
+  { the reason for the separate max_dist value is LZX can't reach the
+     first three characters in its nominal window.  But using a smaller
+     window results in inefficiency when dealing with reset intervals
+     which are the length of the nominal window }
+
+  lzi^.wsize := wsize;
+  if (max_match > wsize) then
+    lzi^.max_match := wsize
+  else
+    lzi^.max_match := max_match;
+
+  lzi^.min_match := min_match;
+  if (lzi^.min_match < 3) then lzi^.min_match := 3;
+
+  lzi^.max_dist := max_dist;
+  lzi^.block_buf_size := wsize + lzi^.max_dist;
+  lzi^.block_buf := GetMem(lzi^.block_buf_size);
+  lzi^.block_bufe := lzi^.block_buf + lzi^.block_buf_size;
+  
+  
+  //assert(lzi^.block_buf != NULL);
+
+  lzi^.cur_loc := 0;
+  lzi^.block_loc := 0;
+  lzi^.chars_in_buf := 0;
+  lzi^.eofcount := 0;
+  lzi^.get_chars := get_chars;
+  lzi^.output_match := output_match;
+  lzi^.output_literal := output_literal;
+  lzi^.user_data := user_data;
+  lzi^.frame_size := frame_size;
+  lzi^.lentab := AllocMem(sizeof(longint)* lzi^.block_buf_size);
+  lzi^.prevtab := AllocMem(sizeof(pu_char)* lzi^.block_buf_size);
+  lzi^.analysis_valid := 0;
+end;
+
+procedure lz_release(lzi:plz_info);
+begin
+  freemem(lzi^.block_buf);
+  freemem(lzi^.lentab);
+  freemem(lzi^.prevtab);
+end;
+
+procedure lz_reset(lzi: plz_info);
+var
+  residual: longint;
+  
+begin
+  residual := lzi^.chars_in_buf - lzi^.block_loc;
+  move(PByte(lzi^.block_buf)[lzi^.block_loc], lzi^.block_buf[0], residual);
+
+  lzi^.chars_in_buf := residual;
+  lzi^.block_loc := 0;
+  lzi^.analysis_valid := 0;
+end;
+
+function lz_left_to_process(lzi: plz_info): longint;
+begin
+  lz_left_to_process := lzi^.chars_in_buf - lzi^.block_loc;
+end;
+
+procedure fill_blockbuf(lzi: plz_info; maxchars: longint);
+var
+  toread: longint;
+  readhere: pu_char;
+  nread: longint;
+begin
+  if (lzi^.eofcount <> 0) then exit;
+  Dec(maxchars, lz_left_to_process(lzi));
+  toread := lzi^.block_buf_size - lzi^.chars_in_buf;
+  if (toread > maxchars) then toread := maxchars;
+  readhere := lzi^.block_buf + lzi^.chars_in_buf;
+  nread := lzi^.get_chars(lzi, toread, readhere);
+  Inc(lzi^.chars_in_buf, nread);
+  if (nread <> toread) then
+    Inc(lzi^.eofcount);
+end;
+
+procedure lz_analyze_block(lzi: plz_info);
+var
+  lenp,
+  lentab: plongint;
+  prevtab, prevp: PPu_char;
+  bbp, bbe: Pu_char;
+  chartab: array [0..255] of pu_char;
+  cursor: pu_char;
+  prevlen,
+  ch,
+  maxlen: longint;
+  maxcursor: PtrUInt;
+  wasinc: Boolean;
+  max_dist: longint;
+  I: longint;
+begin
+  max_dist := lzi^.max_dist;
+
+  FillChar(chartab[0], sizeof(chartab), 0);
+
+  prevtab := lzi^.prevtab;
+  prevp := prevtab;
+  lentab := lzi^.lentab;
+  lenp := lentab;
+
+  FillChar(prevtab[0], sizeof(prevtab) * lzi^.chars_in_buf, 0);
+  FillChar(lentab[0], sizeof(prevtab) * lzi^.chars_in_buf, 0);
+  
+  bbp := lzi^.block_buf;
+  bbe := bbp + lzi^.chars_in_buf;
+  while (bbp < bbe) do begin
+    ch := bbp^;
+    if (chartab[ch] <> nil) then begin
+      prevp^ := chartab[ch];
+      lenp^ := 1;
+    end;
+    chartab[ch] := bbp;
+    Inc(bbp);
+    Inc(prevp);
+    Inc(lenp);
+  end;
+
+  for maxlen := 1 to lzi^.max_match-1 do begin
+    wasinc := False;
+    bbp := bbe - maxlen;
+    lenp := lentab + lzi^.chars_in_buf - maxlen;
+    prevp := prevtab + lzi^.chars_in_buf - maxlen;
+
+    //for I := 0 to (bbp-2 - lzi^.block_buf) do begin // we don't use the value of i
+    while (bbp > lzi^.block_buf) do begin
+      Dec(bbp);
+      Dec(prevp);
+      Dec(lenp);
+      if lenp^ = maxlen then begin
+	ch := bbp[maxlen];
+	cursor := prevp^;
+        while (cursor <> nil) and ((bbp - cursor) <= max_dist) do begin
+	  prevlen := (cursor - lzi^.block_buf + lentab)^;
+	  if (cursor[maxlen] = ch) then begin
+	    prevp^ := cursor;
+	    Inc(lenp^);
+            wasinc := True;
+	    break;
+          end;
+
+	  if (prevlen <> maxlen) then break;
+          cursor := (cursor - lzi^.block_buf + prevtab)^;
+        end;
+      end;
+    end;
+    if not wasinc then break;
+  end;
+
+  lzi^.analysis_valid := 1;
+end;
+
+procedure lz_stop_compressing(lzi:plz_info);
+begin
+    lzi^.stop := 1;
+end;
+
+function lz_compress(lzi:plz_info; nchars:longint):longint;
+var
+  bbp, bbe: pu_char;
+  lentab, lenp: plongint;
+  prevtab, prevp: ppu_char;
+  len: longint;
+  holdback: longint;
+  trimmed: smallint;
+  residual: longint;
+  bytes_to_move: longint;
+begin
+  lzi^.stop := 0;
+  while ((lz_left_to_process(lzi) <> 0) or  (lzi^.eofcount =0)) and ((lzi^.stop =0) and (nchars > 0)) do begin
+    if (lzi^.analysis_valid = 0)
+    or ((lzi^.eofcount =0) and (lzi^.chars_in_buf- lzi^.block_loc < nchars)) then begin
+      residual := lzi^.chars_in_buf - lzi^.block_loc;
+      bytes_to_move := lzi^.max_dist + residual;
+      if (bytes_to_move > lzi^.chars_in_buf) then
+	bytes_to_move := lzi^.chars_in_buf;
+ 
+      move(PByte(lzi^.block_buf)[lzi^.chars_in_buf - bytes_to_move], lzi^.block_buf, bytes_to_move);
+
+      lzi^.block_loc := bytes_to_move - residual;
+      lzi^.chars_in_buf := bytes_to_move;
+      fill_blockbuf(lzi, nchars);
+      lz_analyze_block(lzi);
+    end;
+    prevp := lzi^.prevtab + lzi^.block_loc;
+    prevtab := prevp;
+    lenp := lzi^.lentab + lzi^.block_loc;
+    lentab := lenp;
+    bbp := lzi^.block_buf + lzi^.block_loc;
+    holdback := lzi^.max_match;
+    if (lzi^.eofcount <> 0) then holdback := 0;
+    if (lzi^.chars_in_buf < (nchars + lzi^.block_loc)) then
+      bbe := lzi^.block_buf + lzi^.chars_in_buf - holdback
+    else
+      bbe := bbp + nchars;
+    while ((bbp < bbe) and (lzi^.stop = 0)) do begin
+      trimmed := 0;
+      len := lenp^;
+      if ((lzi^.frame_size <> 0) and (len > (lzi^.frame_size - lzi^.cur_loc mod lzi^.frame_size))) then begin
+	trimmed := 1;
+	len := (lzi^.frame_size - lzi^.cur_loc mod lzi^.frame_size);
+      end;
+      if (len > nchars) then begin
+	trimmed := 1;
+	len := nchars;
+      end;
+      if (len >= lzi^.min_match) then begin
+{$ifdef LAZY}
+	if ((bbp < bbe -1) and (trimmed = 0) and
+	    ((lenp[1] > (len + 1)))) then begin
+	  len := 1;
+	  //* this is the lazy eval case */
+        end
+	else
+{$endif}
+	  if (lzi^.output_match(lzi, (prevp^ - lzi^.block_buf) - lzi^.block_loc, len) < 0) then begin
+	    len := 1; //* match rejected */
+          end;
+      end
+      else
+	len := 1;
+
+      if (len < lzi^.min_match) then begin
+	//assert(len == 1);
+	lzi^.output_literal(lzi, bbp^);
+      end;
+      Inc(bbp,len);
+      Inc(prevp, len);
+      Inc(lenp, len);
+      Inc(lzi^.cur_loc, len);
+      Inc(lzi^.block_loc, len);
+      
+      //assert(nchars >= len);
+
+      Dec(nchars, len);
+
+    end;
+  end;
+  lz_compress := 0;
+end;
+
+end.

+ 1017 - 0
packages/extra/chm/paslzx.pas

@@ -0,0 +1,1017 @@
+{ Copyright (C) <2005> <Andrew Haines> paslzx.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.LCL, included in this distribution,
+  for details about the copyright.
+}
+
+{***************************************************************************
+ *                     paslzx.pas - LZX decompression routines             *
+ *                           -------------------                           *
+ *                                                                         *
+ *  maintainer: Andrew Haines <[email protected]>                         *
+ *  source:     modified lzx.c from chmlib 0.37-4                          *
+ *  notes:      The lzx.c file was taken from cabextract v0.5, which was,  *
+ *              itself, a modified version of the lzx decompression code   *
+ *              from unlzx. This file would not be available without the   *
+ *              invaluable help from Micha Nelissen fixing my errors.      *
+ *                                                                         *
+ *              Licensed with permission of Stuart Caie with a modified    *
+ *              LGPL.                                                      *
+ *                                                                         *
+ *  platforms:  Should work on any platform that FreePascal is available   *
+ *              on. However it has been tested on only an amd64(Linux) and *
+ *              x86(Linux and Windows). Only tested on little endian pc's. *
+ ***************************************************************************}
+
+unit paslzx;
+
+{$mode objfpc}{$H+}{$R+}
+
+interface
+
+uses
+  Classes, SysUtils;
+  
+const
+  DECR_OK = 0;
+  DECR_DATAFORMAT =  1;
+  DECR_ILLEGALDATA = 2;
+  DECR_NOMEMORY = 3;
+  
+  
+  // some constants defined by the LZX specification
+  LZX_MIN_MATCH             =   2;
+  LZX_MAX_MATCH             =   257;
+  LZX_NUM_CHARS             =   256;
+  LZX_BLOCKTYPE_INVALID     =   0;  // also blocktypes 4-7 invalid
+  LZX_BLOCKTYPE_VERBATIM    =   1;
+  LZX_BLOCKTYPE_ALIGNED     =   2;
+  LZX_BLOCKTYPE_UNCOMPRESSED=   3;
+  LZX_PRETREE_NUM_ELEMENTS  =   20;
+  LZX_ALIGNED_NUM_ELEMENTS  =   8;  // aligned offset tree #elements
+  LZX_NUM_PRIMARY_LENGTHS   =   7;  // this one missing from spec!
+  LZX_NUM_SECONDARY_LENGTHS =   249;// length tree #elements
+  
+  // LZX huffman defines: tweak tablebits as desired
+  LZX_PRETREE_MAXSYMBOLS    = LZX_PRETREE_NUM_ELEMENTS;
+  LZX_PRETREE_TABLEBITS     = 6;
+  LZX_MAINTREE_MAXSYMBOLS   = LZX_NUM_CHARS + 50*8;
+  LZX_MAINTREE_TABLEBITS    = 12;
+  LZX_LENGTH_MAXSYMBOLS     = LZX_NUM_SECONDARY_LENGTHS+1;
+  LZX_LENGTH_TABLEBITS      = 12;
+  LZX_ALIGNED_MAXSYMBOLS    = LZX_ALIGNED_NUM_ELEMENTS;
+  LZX_ALIGNED_TABLEBITS     = 7;
+
+  LZX_LENTABLE_SAFETY       = 64; // we allow length table decoding overruns
+  
+  extra_bits: array [0..50] of Byte = (
+    0,  0,  0,  0,  1,  1,  2,  2,  3,  3,  4,  4,  5,  5,  6,  6,
+    7,  7,  8,  8,  9,  9,  10, 10, 11, 11, 12, 12, 13, 13, 14, 14,
+    15, 15, 16, 16, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
+    17, 17, 17
+  );
+  
+  position_base: array [0..50] of dword = (
+          0,       1,       2,      3,      4,      6,      8,     12,     16,     24,     32,       48,      64,      96,     128,     192,
+        256,     384,     512,    768,   1024,   1536,   2048,   3072,   4096,   6144,   8192,    12288,   16384,   24576,   32768,   49152,
+      65536,   98304,  131072, 196608, 262144, 393216, 524288, 655360, 786432, 917504, 1048576, 1179648, 1310720, 1441792, 1572864, 1703936,
+    1835008, 1966080, 2097152
+  );
+type
+
+  { TBits }
+
+  TBufBits = class
+  private
+    bitbuf: dword;
+    bitsleft: LongInt;
+  public
+    procedure Init;
+    procedure ensure(num: LongInt; var inpos:PByte);
+    function peek(numbits: LongInt): dword;
+    function remove(numbits: LongInt): dword;
+    function read(numbits: LongInt; var inpos: PByte): dword;
+  end;
+
+  TLZX_PRETREE_TABLE = record
+    Table: array [0..(1 shl LZX_PRETREE_TABLEBITS) + (LZX_PRETREE_MAXSYMBOLS shl 1)-1] of Word;
+    Len: array [0..LZX_PRETREE_MAXSYMBOLS + LZX_LENTABLE_SAFETY-1] of Byte;
+  end;
+  TLZX_MAINTREE_TABLE = record
+    Table: array [0..(1 shl LZX_MAINTREE_TABLEBITS) + (LZX_MAINTREE_MAXSYMBOLS shl 1)-1] of Word;
+    Len: array [0..LZX_MAINTREE_MAXSYMBOLS + LZX_LENTABLE_SAFETY-1] of Byte;
+  end;
+
+  TLZX_LENGTH_TABLE = record
+    Table: array [0..(1 shl LZX_LENGTH_TABLEBITS) + (LZX_LENGTH_MAXSYMBOLS shl 1)-1] of Word;
+    Len: array [0..LZX_LENGTH_MAXSYMBOLS + LZX_LENTABLE_SAFETY-1] of Byte;
+  end;
+
+  TLZX_ALIGNED_TABLE = record
+    Table: array [0..(1 shl LZX_ALIGNED_TABLEBITS) + (LZX_ALIGNED_MAXSYMBOLS shl 1)-1] of Word;
+    Len: array [0..LZX_ALIGNED_MAXSYMBOLS + LZX_LENTABLE_SAFETY-1] of Byte;
+  end;
+
+  PLZXState = ^TLZXState;
+  TLZXState = record
+    window: PByte;           // the actual decoding window
+    window_size,             // window size (32Kb through 2Mb)
+    actual_size,             // window size when it was first allocated
+    window_posn,             // current offset within the window
+    R0, R1, R2: dword;       // for the LRU offset system
+    main_elements : Word;    // number of main tree elements
+    header_read: LongInt;    // have we started decoding at all yet?
+    block_type: Word;        // type of this block
+    block_length,            // uncompressed length of this block
+    block_remaining,         // uncompressed bytes still left to decode
+    frames_read: dword;      // the number of CFDATA blocks
+    intel_filesize,          // magic header value used for transform
+    intel_curpos: LongInt;   // current offset in transform space
+    intel_started: LongInt;  // have we seen any translatable data yet?
+
+    PreTreeTable: TLZX_PRETREE_TABLE;
+    MainTreeTable: TLZX_MAINTREE_TABLE;
+    LengthTable: TLZX_LENGTH_TABLE;
+    AlignedTAble: TLZX_ALIGNED_TABLE;
+  end;
+  
+  // create an lzx state object
+  function LZXinit(window: LongInt): PLZXState;
+  
+  // destroy an lzx state object
+  procedure LZXteardown(pState: PLZXState);
+  
+  // reset an lzx stream
+  function LZXreset(pState: PLZXState): LongInt;
+  
+  function LZXdecompress(pState: PLZXstate; inpos, outpos: PByte; inlen, outlen: LongInt): LongInt;
+
+implementation
+
+const
+  ULONG_BITS = sizeof(LongInt)shl 3;
+  
+function make_decode_table(nsyms: dword; nbits: dword; length: PByte; table: PWord): LongInt;
+var
+  Sym: Word;
+  leaf: dword;
+  bit_num: Byte = 1;
+  fill: dword;
+  pos: dword = 0; //* the current position in the decode table */
+  table_mask: dword;
+  bit_mask: dword; //* don't do 0 length codes */
+  next_symbol: dword; //* base of allocation for long codes */
+begin
+    Result := 0;
+    table_mask :=  1 shl nbits;
+    bit_mask := table_mask shr 1;
+    next_symbol := bit_mask;
+    //* fill entries for codes short enough for a direct mapping */
+    while (bit_num <= nbits) do begin
+        for sym := 0 to nsyms-1 do begin
+            if (length[sym] = bit_num) then begin
+                leaf := pos;
+
+                Inc(pos, bit_mask);
+                if pos > table_mask then begin
+                  Result := 1; //* table overrun */
+                  exit;
+                end;
+
+                //* fill all possible lookups of this symbol with the symbol itself */
+                fill := bit_mask;
+                while fill > 0 do
+                begin
+                  dec(fill);
+                  table[leaf] := sym;
+                  Inc(leaf);
+                end;
+            end;
+        end;
+        bit_mask := bit_mask shr 1;
+        Inc(bit_num);
+    end;
+
+    //* if there are any codes longer than nbits */
+    if pos <> table_mask then begin
+        //* clear the remainder of the table */
+        for sym := pos to table_mask-1 do table[sym] := 0;
+
+        //* give ourselves room for codes to grow by up to 16 more bits */
+        pos := pos shl 16;
+        table_mask := table_mask shl 16;
+        bit_mask := 1 shl 15;
+
+        while (bit_num <= 16) do begin
+            for sym := 0 to nsyms-1 do begin
+                if (length[sym] = bit_num) then begin
+                    leaf := pos shr 16;
+                    for fill := 0 to (bit_num - nbits)-1 do begin
+                        //* if this path hasn't been taken yet, 'allocate' two entries */
+                        if (table[leaf] = 0) then begin
+                            table[(next_symbol shl 1)] := 0;
+                            table[(next_symbol shl 1)+1] := 0;
+                            table[leaf] := Word(next_symbol);
+                            Inc(next_symbol);
+                        end;
+                        //* follow the path and select either left or right for next bit */
+                        leaf := table[leaf] shl 1;
+                        if ((pos shr (15-fill)) and 1) > 0 then Inc(leaf);
+                    end;
+                    table[leaf] := sym;
+
+                    pos := pos + bit_mask;
+                    if (pos > table_mask) then begin
+                      Result := 1; //* table overflow */
+                      exit;
+                    end;
+                end;
+            end;
+            bit_mask := bit_mask shr 1;
+            Inc(bit_num);
+        end;
+    end;
+
+    //* full table? */
+    if (pos = table_mask) then begin
+      Result := 0;
+      Exit;
+    end;
+
+    //* either erroneous table, or all elements are 0 - let's find out. */
+    for sym := 0 to nsyms-1 do begin
+      if length[sym] > 0 then begin
+        Result := 1;
+        Exit;
+      end;
+    end;
+    Result := 0;
+end;
+
+type
+  PLZX_bits = ^TLzx_bits;
+  Tlzx_bits = record
+    bb: dword;
+    bl: LongInt;
+    ip: PByte;
+  end;
+
+function READ_HUFFSYM(Table: PWord; Len: PByte; const bits: TBufBits; var inpos: PByte;
+             var i, j: DWord; const TableBits, MaxSymbols: DWord; out z: LongInt): LongInt;
+var
+  hufftbl: PWord;
+begin
+  bits.ensure(16, inpos);
+  hufftbl := Table;
+  i := hufftbl[bits.peek(TableBits)];
+  if (i) >= MaxSymbols then begin
+      j := 1 shl (ULONG_BITS - TableBits);
+      repeat
+      j := j shr 1;
+      i := i shl 1;
+      i := i or ord((bits.bitbuf and j) <> 0);
+      if j = 0 then begin
+         Result := DECR_ILLEGALDATA;
+         Exit;
+      end;
+      i := hufftbl[i];
+      until i < MaxSymbols;
+  end;
+  z := i;
+  j := Len[z];
+  bits.remove(j);
+  Result := 0;
+end;
+
+function lzx_read_lens(pState: PLZXState; lens: PByte; first: dword; last: dword; lb: Plzx_bits): LongInt;
+var
+    i: dword = 0;
+    j: dword = 0;
+    x,y: dword;
+    z: LongInt;
+
+    inpos: PByte;
+    bits: TBufBits;
+begin
+    bits := TBufBits.Create;
+    bits.bitbuf := lb^.bb;
+    bits.bitsleft := lb^.bl;
+    
+    inpos := lb^.ip;
+
+
+    for X := 0 to 19 do begin
+        y := bits.read(4, inpos);
+        pState^.PreTreeTable.Len[x] := byte(y);
+    end;
+    if make_decode_table(LZX_PRETREE_MAXSYMBOLS, LZX_PRETREE_TABLEBITS,
+                      @pState^.PreTreeTable.Len[0],@pState^.PreTreeTable.Table[0]) >0 then
+    begin
+       Result := DECR_ILLEGALDATA;
+       bits.Free;
+       Exit;
+    end;
+
+
+    x := first;
+    while x < last do begin
+        if READ_HUFFSYM(@pState^.PreTreeTable.Table[0], @pstate^.PreTreeTable.Len[0], bits, inpos, i, j,
+                     LZX_PRETREE_TABLEBITS, LZX_PRETREE_MAXSYMBOLS, z) <> 0 then
+        begin
+           Result := DECR_ILLEGALDATA;
+           bits.Free;
+           Exit;
+        end;
+        if (z = 17) then begin
+            y := bits.read(4, inpos);
+            Inc(y, 4);
+            while y > 0 do begin
+              dec(y);
+              Lens[x] := 0;
+              Inc(x);
+            end;
+        end
+        else if (z = 18) then begin
+            y := bits.read(5, inpos);
+            Inc(y, 20);
+            while y > 0 do begin 
+              dec(y);
+              lens[x] := 0;
+              inc(x);
+            end;
+        end
+        else if (z = 19) then begin
+            y := bits.read(1, inpos);
+            Inc(y, 4);
+            if READ_HUFFSYM(@pState^.PreTreeTable.Table[0], @pstate^.PreTreeTable.Len[0], bits, inpos, i, j,
+                         LZX_PRETREE_TABLEBITS, LZX_PRETREE_MAXSYMBOLS, z) <> 0 then
+            begin
+              Result := DECR_ILLEGALDATA;
+              bits.Free;
+              Exit;
+            end;
+            z := lens[x] - z;
+            if (z < 0) then z := z + 17;
+            while y > 0 do begin
+              dec(y);
+              lens[x] := byte(z);
+              inc(x);
+            end;
+        end
+        else begin
+            z := lens[x] - z;
+            if (z < 0) then  z := z + 17;
+            lens[x] := byte(z);
+            inc(x);
+        end;
+    end;
+
+    lb^.bb := bits.bitbuf;
+    lb^.bl := bits.bitsleft;
+    lb^.ip := inpos;
+    Result := 0;
+    bits.Free;
+end;
+  
+  
+//////////////////////////////////////////////////////////////////////////////////////
+
+function LZXinit(window: LongInt): PLZXState;
+var
+  pState: PLZXState;
+  wndsize: dword;
+  i,
+  posn_slots: LongInt;
+begin
+    Result := nil;
+    wndsize := 1 shl window;
+
+    //* LZX supports window sizes of 2^15 (32Kb) through 2^21 (2Mb) */
+    //* if a previously allocated window is big enough, keep it     */
+    if (window < 15) or (window > 21) then begin
+      Exit;
+    end;
+
+    //* allocate state and associated window */
+    New(pState);
+    pState^.window := GetMem(wndsize);
+    if pState^.window = nil then
+    begin
+        Dispose(pState);
+        Result := nil;
+        exit;
+    end;
+    pState^.actual_size := wndsize;
+    pState^.window_size := wndsize;
+
+    //* calculate required position slots */
+    if (window = 20) then posn_slots := 42
+    else if (window = 21) then posn_slots := 50
+    else posn_slots := window shl 1;
+
+    ///** alternatively **/
+    ///* posn_slots=i=0; while (i < wndsize) i += 1 << extra_bits[posn_slots++]; */
+
+    ///* initialize other state */
+    pState^.R0 := 1;
+    pState^.R1 := 1;
+    pState^.R2 := 1;
+    
+    pState^.main_elements   := LZX_NUM_CHARS + (posn_slots shl 3);
+    pState^.header_read     := 0;
+    pState^.frames_read     := 0;
+    pState^.block_remaining := 0;
+    pState^.block_type      := LZX_BLOCKTYPE_INVALID;
+    pState^.intel_curpos    := 0;
+    pState^.intel_started   := 0;
+    pState^.window_posn     := 0;
+
+    ///* initialise tables to 0 (because deltas will be applied to them) */
+    for i := 0 to LZX_MAINTREE_MAXSYMBOLS-1 do pState^.MainTreeTable.Len[i] := 0;
+    for i := 0 to LZX_LENGTH_MAXSYMBOLS-1 do pState^.LengthTable.Len[i] := 0;
+
+    Result := pState;
+end;
+
+procedure LZXteardown(pState: PLZXState);
+begin
+    if pState <> nil then
+    begin
+        if pState^.window <> nil then
+            Freemem(pState^.window);
+        Dispose(pState);
+    end;
+end;
+
+function LZXreset(pState: PLZXState): LongInt;
+var
+    i: LongInt;
+begin
+    pState^.R0 := 1;
+    pState^.R1 := 1;
+    pState^.R2 := 1;
+    pState^.header_read     := 0;
+    pState^.frames_read     := 0;
+    pState^.block_remaining := 0;
+    pState^.block_type      := LZX_BLOCKTYPE_INVALID;
+    pState^.intel_curpos    := 0;
+    pState^.intel_started   := 0;
+    pState^.window_posn     := 0;
+
+    for i := 0 to (LZX_MAINTREE_MAXSYMBOLS + LZX_LENTABLE_SAFETY - 1) do pState^.MainTreeTable.Len[i] := 0;
+    for i := 0 to LZX_LENGTH_MAXSYMBOLS+LZX_LENTABLE_SAFETY-1 do pState^.LengthTable.Len[i] := 0;
+    Result := DECR_OK;
+end;
+
+function LZXdecompress(pState: PLZXstate; inpos, outpos: PByte; inlen,
+  outlen: LongInt): LongInt;
+var
+  endinp: PByte;
+  window: PByte;
+  runsrc,
+  rundest: PByte;
+  window_posn: dword;
+  window_size: dword;
+  R0,
+  r1,
+  R2: dword;
+  bits: TBufBits;
+  match_offset,
+  i,j,k : dword;
+  lb: tlzx_bits;
+  togo,
+  this_run,
+  main_element,
+  aligned_bits: LongInt;
+  match_length,
+  length_footer,
+  extra,
+  verbatim_bits: LongInt;
+  data,
+  dataend: PByte;
+  curpos,
+  filesize,
+  abs_off,
+  rel_off: LongInt;
+    function READ_LENGTHS(Len: PByte; first: dword; last: dword): Longint;
+    begin
+       Result := 0;
+       lb.bb := bits.bitbuf;
+       lb.bl := bits.bitsleft;
+       lb.ip := inpos;
+       if (lzx_read_lens(pState, Len,first,last,@lb)) > 0 then begin
+           Result := DECR_ILLEGALDATA;
+           Exit;
+       end;
+       bits.bitbuf := lb.bb;
+       bits.bitsleft := lb.bl;
+       inpos := lb.ip;
+    end;
+
+    procedure HandleBlockTypeAligned;
+    var
+      i, j: dword;
+    begin
+      for i := 0 to 7 do begin
+        j:= bits.read(3, inpos);
+        pState^.AlignedTAble.Len[i] := Word(j);
+      end;
+      if make_decode_table(LZX_ALIGNED_MAXSYMBOLS, LZX_ALIGNED_TABLEBITS,
+        @pState^.AlignedTAble.Len[0],@pState^.AlignedTAble.Table[0]) >0 then
+      begin
+         Result := DECR_ILLEGALDATA;
+         Exit;
+      end;
+    end;
+
+    procedure HandleBlockTypeVerbatim;
+    begin
+      if (
+      READ_LENGTHS(@pState^.MainTreeTable.Len[0], 0, 256) = DECR_ILLEGALDATA)
+      or (
+      READ_LENGTHS(@pState^.MainTreeTable.Len[0], 256, pState^.main_elements) = DECR_ILLEGALDATA)
+      then begin
+        Result := DECR_ILLEGALDATA;
+        Exit;
+      end;
+      if make_decode_table(LZX_MAINTREE_MAXSYMBOLS, LZX_MAINTREE_TABLEBITS,
+        @pState^.MainTreeTable.Len[0], @pState^.MainTreeTable.Table[0]) >0 then
+      begin
+         Result := DECR_ILLEGALDATA;
+         Exit;
+      end;
+
+      if pState^.MainTreeTable.Len[$E8] <> 0 then
+        pState^.intel_started := 1;
+
+      if READ_LENGTHS(@pState^.LengthTable.Len[0], 0, LZX_NUM_SECONDARY_LENGTHS) = DECR_ILLEGALDATA then begin
+        Result := DECR_ILLEGALDATA;
+        Exit;
+      end;
+      if make_decode_table(LZX_LENGTH_MAXSYMBOLS, LZX_LENGTH_TABLEBITS,
+        @pState^.LengthTable.Len[0],@pState^.LengthTable.Table[0]) >0 then
+      begin
+         Result := DECR_ILLEGALDATA;
+         Exit;
+      end;
+    end;
+    
+begin
+    endinp := inpos + inlen;
+    window := pState^.window;
+
+    window_posn := pState^.window_posn;
+    window_size := pState^.window_size;
+    R0 := pState^.R0;
+    R1 := pState^.R1;
+    R2 := pState^.R2;
+    
+    togo := outlen;//, this_run, main_element, aligned_bits;
+    bits := TBufBits.Create;
+    bits.Init;
+    //* read header if necessary */
+    if (pState^.header_read) = 0 then begin
+        i := 0;
+        j := 0;
+        k := bits.read(1, inpos);
+        if (k) > 0 then begin
+            i := bits.read(16, inpos);
+            j := bits.read(16, inpos);
+        end;
+        pState^.intel_filesize := (i shl 16) or j; ///* or 0 if not encoded */
+        pState^.header_read := 1;
+    end;
+
+    ///* main decoding loop */
+    while (togo > 0) do begin
+        ///* last block finished, new block expected */
+        if (pState^.block_remaining = 0) then begin
+            if (pState^.block_type = LZX_BLOCKTYPE_UNCOMPRESSED) then begin
+                if (pState^.block_length and 1) > 0 then Inc(inpos); //* realign bitstream to word */
+                bits.Init;
+            end;
+
+            pState^.block_type := Word(bits.read(3, inpos));
+            i := bits.read(16, inpos);
+            j := bits.read(8, inpos);
+            
+            pState^.block_length := (i shl 8) or j;
+            pState^.block_remaining :=  pState^.block_length;
+
+            case (pState^.block_type) of
+                LZX_BLOCKTYPE_ALIGNED:
+                begin
+                    HandleBlockTypeAligned;
+                    //* rest of aligned header is same as verbatim */
+                    HandleBlockTypeVerbatim;
+                end;
+                LZX_BLOCKTYPE_VERBATIM:
+                begin
+                    HandleBlockTypeVerbatim;
+                end;
+                LZX_BLOCKTYPE_UNCOMPRESSED:
+                begin
+                    pState^.intel_started := 1; //* because we can't assume otherwise */
+                    bits.ensure(16, inpos); //* get up to 16 pad bits into the buffer */
+                    if (bits.bitsleft > 16) then Dec(inpos ,2); //* and align the bitstream! */
+                    R0 := inpos[0] or (inpos[1]shl 8)or(inpos[2]shl 16)or(inpos[3]shl 24);
+                    Inc(inpos,4);
+                    R1 := inpos[0] or (inpos[1]shl 8)or(inpos[2]shl 16)or(inpos[3]shl 24);
+                    Inc(inpos,4);
+                    R2 := inpos[0] or (inpos[1]shl 8)or(inpos[2]shl 16)or(inpos[3]shl 24);
+                    Inc(inpos,4);
+                end;
+            else
+                Result := DECR_ILLEGALDATA;
+                bits.Free;
+                Exit;
+            end;
+        end;
+
+        //* buffer exhaustion check */
+        if (inpos > endinp) then begin
+            {* it's possible to have a file where the next run is less than
+             * 16 bits in size. In this case, the READ_HUFFSYM() macro used
+             * in building the tables will exhaust the buffer, so we should
+             * allow for this, but not allow those accidentally read bits to
+             * be used (so we check that there are at least 16 bits
+             * remaining - in this boundary case they aren't really part of
+             * the compressed data)
+             *}
+            if (inpos > (endinp+2)) or (bits.bitsleft < 16) then begin
+              Result := DECR_ILLEGALDATA;
+              bits.Free;
+              Exit;
+            end;
+        end;
+
+        this_run := pState^.block_remaining;
+        while (this_run > 0) and (togo > 0) do begin
+
+            if (this_run > togo) then this_run := togo;
+            Dec(togo, this_run);
+            Dec(pState^.block_remaining, this_run);
+
+            //* apply 2^x-1 mask */
+            window_posn := window_posn and (window_size - 1);
+            //* runs can't straddle the window wraparound */
+            if ((window_posn + this_run) > window_size) then begin
+                 Result := DECR_DATAFORMAT;
+                 bits.Free;
+                 Exit;
+            end;
+            case (pState^.block_type) of
+
+                LZX_BLOCKTYPE_VERBATIM:
+                begin
+                    while (this_run > 0) do begin
+                        if READ_HUFFSYM(@pState^.MainTreeTable.Table[0], @pState^.MainTreeTable.Len[0],
+                              bits, inpos, i, j, LZX_MAINTREE_TABLEBITS, LZX_MAINTREE_MAXSYMBOLS,
+                              main_element) <> 0 then
+                        begin
+                          Result := DECR_ILLEGALDATA;
+                          bits.Free;
+                          Exit;
+                        end;
+
+                        if (main_element < LZX_NUM_CHARS) then begin
+                            //* literal: 0 to LZX_NUM_CHARS-1 */
+                            window[window_posn] := Byte(main_element);
+                            Inc(window_posn);
+                            Dec(this_run);
+                        end
+                        else begin
+                            //* match: LZX_NUM_CHARS + ((slot<<3) | length_header (3 bits)) */
+                            Dec(main_element, LZX_NUM_CHARS);
+
+                            match_length := main_element and LZX_NUM_PRIMARY_LENGTHS;
+                            if (match_length = LZX_NUM_PRIMARY_LENGTHS) then begin
+                                if READ_HUFFSYM(@pState^.LengthTable.Table[0], @pState^.LengthTable.Len[0],
+                                    bits, inpos, i, j, LZX_LENGTH_TABLEBITS, LZX_LENGTH_MAXSYMBOLS,
+                                    length_footer) <> 0 then
+                                begin
+                                  Result := DECR_ILLEGALDATA;
+                                  bits.Free;
+                                  Exit;
+                                end;
+                                Inc(match_length, length_footer);
+                            end;
+                            Inc(match_length, LZX_MIN_MATCH);
+
+                            match_offset := main_element shr 3;
+
+                            if (match_offset > 2) then begin
+                                //* not repeated offset */
+                                if (match_offset <> 3) then begin
+                                    extra := extra_bits[match_offset];
+                                    verbatim_bits := bits.read(extra, inpos);
+                                    match_offset := position_base[match_offset] - 2 + verbatim_bits;
+                                end
+                                else begin
+                                    match_offset := 1;
+                                end;
+
+                                //* update repeated offset LRU queue */
+                                R2 := R1;
+                                R1 := R0;
+                                R0 := match_offset;
+                            end
+                            else if (match_offset = 0) then begin
+                                match_offset := R0;
+                            end
+                            else if (match_offset = 1) then begin
+                                match_offset := R1;
+                                R1 := R0;
+                                R0 := match_offset;
+                            end
+                            else begin //* match_offset == 2 */
+                                match_offset := R2;
+                                R2 := R0;
+                                R0 := match_offset;
+                            end;
+
+                            rundest := window + window_posn;
+                            runsrc  := rundest - match_offset;
+                            Inc(window_posn, match_length);
+                            if (window_posn > window_size) then begin
+                              Result := DECR_ILLEGALDATA;
+                              bits.Free;
+                              Exit;
+                            end;
+                            Dec(this_run, match_length);
+
+                            ///* copy any wrapped around source data */
+                            while ((runsrc < window) and (match_length > 0)) do begin
+                                Dec(match_length);
+                                rundest^ := (runsrc + window_size)^;
+                                Inc(rundest);
+                                Inc(runsrc);
+                            end;
+                            //* copy match data - no worries about destination wraps */
+                            while (match_length > 0) do begin
+                              Dec(match_length);
+                              rundest^ := runsrc^;
+                              Inc(rundest);
+                              Inc(runsrc);
+                            end;
+
+                        end
+                    end;
+                end;
+                LZX_BLOCKTYPE_ALIGNED:
+                begin
+                    while (this_run > 0) do begin
+                        if READ_HUFFSYM(@pState^.MainTreeTable.Table[0], @pState^.MainTreeTable.Len[0], bits,
+                             inpos, i, j, LZX_MAINTREE_TABLEBITS, LZX_MAINTREE_MAXSYMBOLS, main_element) <> 0 then
+                        begin
+                          Result := DECR_ILLEGALDATA;
+                          bits.Free;
+                          Exit;
+                        end;
+
+                        if (main_element < LZX_NUM_CHARS) then begin
+                            //* literal: 0 to LZX_NUM_CHARS-1 */
+                            window[window_posn] := Byte(main_element);
+                            Inc(window_posn);
+                            Dec(this_run);
+                        end
+                        else begin
+                            //* match: LZX_NUM_CHARS + ((slot<<3) | length_header (3 bits)) */
+                            Dec(main_element, LZX_NUM_CHARS);
+
+                            match_length := main_element and LZX_NUM_PRIMARY_LENGTHS;
+                            if (match_length = LZX_NUM_PRIMARY_LENGTHS) then begin
+                                if READ_HUFFSYM(@pState^.LengthTable.Table[0], @pState^.LengthTable.Len[0],
+                                     bits, inpos, i, j, LZX_LENGTH_TABLEBITS,
+                                     LZX_LENGTH_MAXSYMBOLS, length_footer) <> 0 then
+                                begin
+                                  Result := DECR_ILLEGALDATA;
+                                  bits.Free;
+                                  Exit;
+                                end;
+                                Inc(match_length, length_footer);
+                            end;
+                            Inc(match_length, LZX_MIN_MATCH);
+
+                            match_offset := main_element shr 3;
+
+                            if (match_offset > 2) then begin
+                                //* not repeated offset */
+                                extra := extra_bits[match_offset];
+                                match_offset := position_base[match_offset] - 2;
+                                if (extra > 3) then begin
+                                    //* verbatim and aligned bits */
+                                    Dec(extra, 3);
+                                    verbatim_bits := bits.read(extra, inpos);
+                                    Inc(match_offset, (verbatim_bits shl 3));
+                                    if READ_HUFFSYM(@pState^.AlignedTAble.Table[0], @pState^.AlignedTAble.Len[0],
+                                        bits, inpos, i, j, LZX_ALIGNED_TABLEBITS, LZX_ALIGNED_MAXSYMBOLS,
+                                        aligned_bits) <> 0 then
+                                    begin
+                                      Result := DECR_ILLEGALDATA;
+                                      bits.Free;
+                                      Exit;
+                                    end;
+                                    Inc(match_offset, aligned_bits);
+                                end
+                                else if (extra = 3) then begin
+                                    //* aligned bits only */
+                                    if READ_HUFFSYM(@pState^.AlignedTAble.Table[0], @pState^.AlignedTAble.Len[0],
+                                          bits, inpos, i, j, LZX_ALIGNED_TABLEBITS, LZX_ALIGNED_MAXSYMBOLS,
+                                          aligned_bits) <> 0 then
+                                    begin
+                                      Result := DECR_ILLEGALDATA;
+                                      bits.Free;
+                                      Exit;
+                                    end;
+                                    Inc(match_offset, aligned_bits);
+                                end
+                                else if (extra > 0) then begin //* extra==1, extra==2 */
+                                    //* verbatim bits only */
+                                    verbatim_bits := bits.read(extra, inpos);
+                                    Inc(match_offset, verbatim_bits);
+                                end
+                                else begin //* extra == 0 */
+                                    //* ??? */
+                                    match_offset := 1;
+                                end;
+
+                                //* update repeated offset LRU queue */
+                                R2 := R1;
+                                R1 := R0;
+                                R0 := match_offset;
+                            end
+                            else if (match_offset = 0) then begin
+                                match_offset := R0;
+                            end
+                            else if (match_offset = 1) then begin
+                                match_offset := R1;
+                                R1 := R0;
+                                R0 := match_offset;
+                            end
+                            else begin //* match_offset == 2 */
+                                match_offset := R2;
+                                R2 := R0;
+                                R0 := match_offset;
+                            end;
+
+                            rundest := window + window_posn;
+                            runsrc  := rundest - match_offset;
+                            Inc(window_posn, match_length);
+                            if (window_posn > window_size) then begin
+                              Result := DECR_ILLEGALDATA;
+                              bits.Free;
+                              Exit;
+                            end;
+                            Dec(this_run, match_length);
+
+                            //* copy any wrapped around source data */
+                            while ((runsrc < window) and (match_length > 0)) do begin
+                                Dec(match_length);
+                                rundest^ := (runsrc + window_size)^;
+                                Inc(rundest);
+                                Inc(runsrc);
+                            end;
+                            //* copy match data - no worries about destination wraps */
+                            while (match_length > 0) do begin
+                                Dec(match_length);
+                                rundest^ := runsrc^;
+                                Inc(rundest);
+                                Inc(runsrc);
+                            end;
+                        end;
+                    end;
+                end;
+                LZX_BLOCKTYPE_UNCOMPRESSED:
+                begin
+                    if ((inpos + this_run) > endinp) then begin
+                        Result := DECR_ILLEGALDATA;
+                        bits.Free;
+                        Exit;
+                    end;
+                    Move(inpos^, (window + window_posn)^,  this_run);
+                    Inc(inpos, this_run);
+                    Inc(window_posn, this_run);
+                end;
+            else
+              Result := DECR_ILLEGALDATA; ///* might as well */
+              bits.Free;
+              Exit;
+            end;
+            this_run := pState^.block_remaining;
+        end;
+    end;
+
+    if (togo <> 0) then begin
+        Result := DECR_ILLEGALDATA;
+        bits.Free;
+        Exit;
+    end;
+    if window_posn = 0 then
+      Move((window + window_size - outlen)^, outpos^, outlen)
+    else
+      Move((window + window_posn - outlen)^, outpos^, outlen);
+
+    pState^.window_posn := window_posn;
+    pState^.R0 := R0;
+    pState^.R1 := R1;
+    pState^.R2 := R2;
+
+    //* intel E8 decoding */
+    if ((pState^.frames_read < 32768) and (pState^.intel_filesize <> 0)) then begin
+        if (outlen <= 6 or not pState^.intel_started) then begin
+            Inc(pState^.intel_curpos, outlen);
+        end
+        else begin
+            data    := outpos;
+            dataend := data + outlen - 10;
+            curpos  := pState^.intel_curpos;
+            filesize  := pState^.intel_filesize;
+
+            pState^.intel_curpos := curpos + outlen;
+
+            while (data < dataend) do begin
+                if data^ <> $E8 then begin
+                  Inc(curpos);
+                  Inc(Data);
+                  continue;
+                end;
+                Inc(Data);
+                abs_off := data[0] or (data[1]shl 8) or (data[2]shl 16) or (data[3]shl 24);
+
+                if (abs_off >= curpos-1) and (abs_off < filesize) then begin
+                    if (abs_off >= 0) then
+                        rel_off := abs_off - curpos
+                    else
+                        rel_off := abs_off + filesize;
+                    {$IFDEF ENDIAN_BIG}
+                    PLongWord(data)^ := Swap(rel_off);
+                    {$ELSE}
+                    PLongword(data)^ := rel_off;
+                    {$ENDIF}
+                end;
+                Inc(data, 4);
+                Inc(curpos, 5);
+            end;
+        end;
+    end;
+    Inc(pState^.frames_read);
+    bits.Free;
+    Result := DECR_OK;
+end;
+
+{ TBufBits }
+
+procedure TBufBits.Init;
+begin
+  bitsleft := 0;
+  bitbuf := 0;
+end;
+
+procedure TBufBits.ensure(num: LongInt; var inpos:PByte);
+begin
+  while (bitsleft < num) do begin
+    bitbuf := bitbuf or (((inpos[1]shl 8) or inpos[0]) shl (ULONG_BITS-16 - bitsleft));
+    Inc(bitsleft, 16);
+    Inc(inpos, 2);
+  end;
+end;
+
+function TBufBits.peek(numbits: LongInt): dword;
+begin
+  Result := bitbuf shr (ULONG_BITS - numbits);
+end;
+
+function TBufBits.remove(numbits: LongInt): dword;
+begin
+  bitbuf := bitbuf  shl numbits;
+  Result := bitbuf;
+  Dec(bitsleft, numbits);
+end;
+
+function TBufBits.read(numbits: LongInt; var inpos: PByte): dword;
+begin
+  ensure(numbits, inpos);
+  Result := peek(numbits);
+  remove(numbits);
+end;
+
+end.
+
+
+

+ 1160 - 0
packages/extra/chm/paslzxcomp.pas

@@ -0,0 +1,1160 @@
+{ Copyright (C) <2005> <Andrew Haines> paslzxcomp.pas
+
+  This library is free software; you can redistribute it and/or modify it
+  under the terms of the GNU Library General Public License as published by
+  the Free Software Foundation; either version 2 of the License, or (at your
+  option) any later version.
+
+  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 Library General Public License
+  for more details.
+
+  You should have received a copy of the GNU Library General Public License
+  along with this library; if not, write to the Free Software Foundation,
+  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+{
+  See the file COPYING.FPC, included in this distribution,
+  for details about the copyright.
+}
+unit paslzxcomp;
+{$MODE OBJFPC}
+{$GOTO ON}
+interface
+
+uses paslznonslide;
+
+  const
+     MIN_MATCH = 2;
+     MAX_MATCH = 257;
+     NUM_CHARS = 256;
+     NUM_PRIMARY_LENGTHS = 7;
+     NUM_SECONDARY_LENGTHS = 249;
+  { the names of these constants are specific to this library  }
+     LZX_MAX_CODE_LENGTH = 16;
+     LZX_FRAME_SIZE = 32768;
+     LZX_PRETREE_SIZE = 20;
+     LZX_ALIGNED_BITS = 3;
+     LZX_ALIGNED_SIZE = 8;
+     LZX_VERBATIM_BLOCK = 1;
+     LZX_ALIGNED_OFFSET_BLOCK = 2;
+
+
+{$IFDEF FPC}
+{$PACKRECORDS C}
+{$ENDIF}
+
+
+  {
+      File lzx_compress.h, part of lzxcomp library
+      Copyright (C) 2002 Matthew T. Russotto
+  
+      This program is free software; you can redistribute it and/or modify
+      it under the terms of the GNU Lesser General Public License as published by
+      the Free Software Foundation; version 2.1 only
+  
+      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 Lesser General Public License for more details.
+  
+      You should have received a copy of the GNU Lesser 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
+   }
+   type
+  PPlzx_data = ^Plzx_data;
+  Plzx_data  = ^lzx_data;
+
+
+     TGetBytesFunc = function (arg:pointer; n:longint; buf:pointer):longint; cdecl;
+
+     TWriteBytesFunc = function (arg:pointer; n:longint; buf:pointer):longint; cdecl;
+
+     TMarkFrameFunc = procedure (arg:pointer; uncomp:dword; comp:dword); cdecl;
+
+     TIsEndOfFileFunc = function (arg:pointer): longbool; cdecl;
+  { add more here? Error codes, # blocks, # frames, etc?  }
+
+     lzx_results = record
+          len_compressed_output : longint;
+          len_uncompressed_input : longint;
+       end;
+       
+  phuff_entry = ^huff_entry;
+  huff_entry = record
+   codelength: smallint;
+   code: word;
+  end;
+       
+  lzx_data = record
+    in_arg : pointer;
+    out_arg: pointer;
+    mark_frame_arg: pointer;
+    get_bytes: TGetBytesFunc;
+    at_eof: TIsEndOfFileFunc;
+    put_bytes: TWriteBytesFunc;
+    mark_frame: TMarkFrameFunc;
+    lzi: plz_info;
+    {/* a 'frame' is an 0x8000 byte thing.  Called that because otherwise
+     I'd confuse myself overloading 'block' */}
+    left_in_frame: longint;
+    left_in_block: longint;
+    R0, R1, R2: longint;
+    num_position_slots: longint;
+    //* this is the LZX block size */
+    block_size: longint;
+    main_freq_table: plongint;
+    length_freq_table: array [0..NUM_SECONDARY_LENGTHS-1] of longint;
+    aligned_freq_table: array [0..LZX_ALIGNED_SIZE-1] of longint;
+    block_codes: plongword;
+    block_codesp: plongword;
+    main_tree: phuff_entry;
+    length_tree: array[0..NUM_SECONDARY_LENGTHS-1] of huff_entry;
+    aligned_tree: array[0..LZX_ALIGNED_SIZE-1] of huff_entry;
+    main_tree_size: longint;
+    bit_buf: word;
+    bits_in_buf: longint;
+    main_entropy: double;
+    last_ratio: double;
+    prev_main_treelengths: pbyte;
+    prev_length_treelengths: array [0..NUM_SECONDARY_LENGTHS-1] of byte;
+    len_uncompressed_input: longword;
+    len_compressed_output: longword;
+    need_1bit_header: smallint;
+    subdivide: smallint; //* 0 = don't subdivide, 1 = allowed, -1 = requested */
+  end;
+  Plzx_results  = ^lzx_results;
+
+  function lzx_init(lzxdp:Pplzx_data; wsize_code:longint; get_bytes:TGetBytesFunc; get_bytes_arg:pointer; at_eof:TIsEndOfFileFunc;
+             put_bytes:TWriteBytesFunc; put_bytes_arg:pointer; mark_frame:TMarkFrameFunc; mark_frame_arg:pointer):longint;
+
+  procedure lzx_reset(lzxd:plzx_data);
+
+  function lzx_compress_block(lzxd:plzx_data; block_size:longint; subdivide: LongBool):longint;
+
+  function lzx_finish(lzxd:plzx_data; lzxr:plzx_results):longint;
+
+implementation
+uses math, sysutils;
+var
+  rloge2: double; // set in initialization section
+  
+const
+  num_position_slots: array [0..6] of smallint = (30, 32, 34, 36, 38, 42, 50);
+  
+  extra_bits: array [0..50] of Byte = (
+    0,  0,  0,  0,  1,  1,  2,  2,  3,  3,  4,  4,  5,  5,  6,  6,
+    7,  7,  8,  8,  9,  9,  10, 10, 11, 11, 12, 12, 13, 13, 14, 14,
+    15, 15, 16, 16, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17,
+    17, 17, 17
+  );
+
+  position_base: array [0..50] of dword = (
+          0,       1,       2,      3,      4,      6,      8,     12,     16,     24,     32,       48,      64,      96,     128,     192,
+        256,     384,     512,    768,   1024,   1536,   2048,   3072,   4096,   6144,   8192,    12288,   16384,   24576,   32768,   49152,
+      65536,   98304,  131072, 196608, 262144, 393216, 524288, 655360, 786432, 917504, 1048576, 1179648, 1310720, 1441792, 1572864, 1703936,
+    1835008, 1966080, 2097152
+  );
+
+type
+  pih_elem = ^ih_elem;
+  ih_elem = record
+    freq: longint;
+    sym: smallint;
+    pathlength: smallint;
+    parent: pih_elem;
+    left: pih_elem;
+    right: pih_elem;
+  end;
+  ph_elem = ^h_elem;
+  h_elem = record
+    freq: longint;
+    sym: smallint;
+    pathlength: smallint;
+    parent: pih_elem;
+    code: word;
+  end;
+
+function cmp_leaves(const in_a: ph_elem; const in_b: ph_elem): longint;
+begin
+
+  if (in_a^.freq = 0) and (in_b^.freq <> 0) then
+    Exit(1);
+  if (in_a^.freq <> 0) and (in_b^.freq = 0) then
+    Exit(-1);
+
+  if (in_a^.freq = in_b^.freq) then
+    Exit(in_a^.sym - in_b^.sym);
+
+  Exit(in_a^.freq - in_b^.freq);
+end;
+
+function cmp_pathlengths(const in_a: ph_elem; const in_b: ph_elem): longint;
+begin
+  if (in_a^.pathlength = in_b^.pathlength) then
+  //* see note on canonical pathlengths */
+    Exit(in_b^.sym - in_a^.sym);
+
+  Exit(in_b^.pathlength - in_a^.pathlength);
+end;
+
+type
+  TQSortCompFunc = function(const in_a: ph_elem; const in_b: ph_elem): longint;
+
+procedure qsort(a_array: ph_elem; nelem: integer; cmpfunc: TQSortCompFunc);
+
+var
+  tmp: h_elem;
+
+  procedure QuickSort(L, R: Integer);
+  var
+    I, J, Pivot: Integer;
+  begin
+    repeat
+      I := L;
+      J := R;
+      Pivot := (L + R) div 2;
+      repeat
+        while cmpfunc(@a_array[I], @a_array[Pivot]) < 0 do Inc(I);
+        while cmpfunc(@a_array[J], @a_array[Pivot]) > 0 do Dec(J);
+        if I <= J then
+        begin
+          // exchange I and J
+          tmp := a_array[I];
+          a_array[I] := a_array[J];
+          a_array[J] := tmp;
+
+          if Pivot = I then
+            Pivot := J
+          else if Pivot = J then
+            Pivot := I;
+          Inc(I);
+          Dec(j);
+        end;
+      until I > J;
+      if L < J then
+        QuickSort(L,J);
+      L := I;
+    until I >= R;
+  end;
+begin
+  QuickSort(0, nelem - 1);
+end;
+
+procedure build_huffman_tree(nelem: longint; max_code_length: longint; freq: plongint; tree: phuff_entry);
+var
+  leaves: ph_elem;
+  inodes: pih_elem;
+  next_inode: pih_elem;
+  cur_inode: pih_elem;
+  cur_leaf :ph_elem;
+  leaves_left,
+  nleaves,
+  pathlength: longint;
+  cur_code: word;
+  codes_too_long: smallint = 0;
+  f1, f2: pih_elem;
+  i: longint;
+begin
+  leaves := GetMem(nelem * sizeof(h_elem));
+  for i := 0 to nelem-1 do begin
+    leaves[i].freq := freq[i];
+    leaves[i].sym := i;
+    leaves[i].pathlength := 0;
+  end;
+
+  qsort(leaves, nelem, @cmp_leaves);
+
+
+  leaves_left := 0;
+  while leaves_left < nelem do begin
+    if (leaves[leaves_left].freq) = 0 then break;
+    Inc(leaves_left);
+  end;
+  nleaves := leaves_left;
+
+  if (nleaves >= 2) then begin
+    inodes := AllocMem((nelem-1) * sizeof(ih_elem));
+    repeat
+      if (codes_too_long <> 0) then begin
+        leaves_left := 0;
+        while leaves_left < nelem do begin
+          if (leaves[leaves_left].freq = 0) then break;
+	  if (leaves[leaves_left].freq <> 1) then begin
+            leaves[leaves_left].freq := leaves[leaves_left].freq shr 1;
+            codes_too_long := 0;
+            Inc(leaves_left);
+          end;
+
+        end;
+        if codes_too_long <> 0 then
+          raise Exception.Create('!codes_too_long');
+      end;
+
+      cur_leaf := leaves;
+      cur_inode := inodes;
+      next_inode := cur_inode;
+
+      repeat
+	f1 := nil;
+        f2 := nil;
+	if (leaves_left <> 0) and
+	    ((cur_inode = next_inode) or
+	     (cur_leaf^.freq <= cur_inode^.freq)) then begin
+          f1 := pih_elem(cur_leaf);
+          Inc(cur_leaf);
+	  Dec(leaves_left);
+        end
+	else if (cur_inode <> next_inode) then begin
+	  f1 := cur_inode;
+          Inc(cur_inode);
+        end;
+
+	if ((leaves_left <> 0) and
+	    ((cur_inode = next_inode) or
+	     (cur_leaf^.freq <= cur_inode^.freq))) then begin
+          f2 := pih_elem(cur_leaf);
+          Inc(cur_leaf);
+	  Dec(leaves_left);
+        end
+	else if (cur_inode <> next_inode) then begin
+          f2 := cur_inode;
+          Inc(cur_inode);
+        end;
+
+	if (f1 <> nil) and (f2 <> nil) then begin
+	  next_inode^.freq := f1^.freq + f2^.freq;
+	  next_inode^.sym := -1;
+	  next_inode^.left := f1;
+	  next_inode^.right := f2;
+	  next_inode^.parent := nil;
+	  f1^.parent := next_inode;
+	  f2^.parent := next_inode;
+	  if (f1^.pathlength > f2^.pathlength) then
+	    next_inode^.pathlength := f1^.pathlength + 1
+	  else
+	    next_inode^.pathlength := f2^.pathlength + 1;
+	  if (next_inode^.pathlength > max_code_length) then begin
+	    codes_too_long := 1;
+	    break;
+          end;
+          Inc(next_inode);
+        end;
+      until (f1 = nil) and (f2 = nil);
+    until codes_too_long = 0;
+
+    //* now traverse tree depth-first */
+    cur_inode := next_inode - 1;
+    pathlength := 0;
+    cur_inode^.pathlength := -1;
+    repeat
+      //* precondition: at unmarked node*/
+      if (cur_inode^.sym = -1) then begin //*&& (cur_inode^.left)*/
+	//* left node of unmarked node is unmarked */
+	cur_inode := cur_inode^.left;
+	cur_inode^.pathlength := -1;
+        Inc(pathlength);
+      end
+      else begin
+	//* mark node */
+	cur_inode^.pathlength := pathlength;
+//#if 0
+//	if (cur_inode^.right) {
+//	  /* right node of previously unmarked node is unmarked */
+//	  cur_inode = cur_inode^.right;
+//	  cur_inode^.pathlength = -1;
+//	  pathlength++;
+//	}
+//	else
+//#endif
+          begin
+
+	    //* time to come up.  Keep coming up until an unmarked node is reached */
+	    //* or the tree is exhausted */
+            repeat
+	      cur_inode := cur_inode^.parent;
+	      Dec(pathlength);
+
+	    //while (cur_inode && (cur_inode^.pathlength != -1));
+            until (cur_inode = nil) or (cur_inode^.pathlength = -1);
+	    if (cur_inode <> nil) then begin
+	      //* found unmarked node; mark it and go right */
+	      cur_inode^.pathlength := pathlength;
+	      cur_inode := cur_inode^.right;
+	      cur_inode^.pathlength := -1;
+	      Inc(pathlength);
+	      //* would be complex if cur_inode could be null here.  It can't */
+            end
+          end;
+      end;
+    until cur_inode = nil;
+
+    freemem(inodes);
+
+    ///* the pathlengths are already in order, so this sorts by symbol */
+    qsort(leaves, nelem, @cmp_pathlengths);
+
+//#if 0
+//    pathlength = leaves[0].pathlength;
+//    cur_code = 0;
+//    for (i = 0; i < nleaves; i++) {
+//      while (leaves[i].pathlength < pathlength) {
+// (!(cur_code & 1));
+//	cur_code >>= 1;
+//	pathlength--;
+//      }
+//      leaves[i].code = cur_code;
+//      cur_code++;
+//    }
+//#else
+    pathlength := leaves[nleaves-1].pathlength;
+    if leaves[0].pathlength > 16  then
+      raise Exception.Create('leaves[0].pathlength <= 16');
+    //* this method cannot deal with bigger codes, though
+    //					   the other canonical method can in some cases
+    //					   (because it starts with zeros ) */
+    cur_code := 0;
+    for i := nleaves-1 downto 0 do begin
+      while (leaves[i].pathlength > pathlength) do begin
+        cur_code := cur_code shl 1;
+	Inc(pathlength);
+      end;
+      leaves[i].code := cur_code;
+      Inc(cur_code);
+    end;
+//#endif
+
+  end
+  else if (nleaves = 1) then begin
+    //* 0 symbols is OK (not according to doc, but according to Caie) */
+    //* but if only one symbol is present, two symbols are required */
+    nleaves := 2;
+    leaves[0].pathlength := 1;
+    leaves[1].pathlength := 1;
+    if (leaves[1].sym > leaves[0].sym) then begin
+      leaves[1].code := 1;
+      leaves[0].code := 0;
+    end
+    else begin
+      leaves[0].code := 1;
+      leaves[1].code := 0;
+    end;
+  end;
+
+  Fillchar(tree^, nelem * sizeof(huff_entry), 0);
+  for i := 0 to nleaves-1 do begin
+    tree[leaves[i].sym].codelength := leaves[i].pathlength;
+    tree[leaves[i].sym].code := leaves[i].code;
+  end;
+
+  freemem(leaves);
+end;
+
+function lzx_get_chars(lzi: plz_info; n: longint; buf: pbyte): longint; cdecl;
+var
+  //* force lz compression to stop after every block */
+  chars_read,
+  chars_pad: longint;
+
+  lzud: plzx_data;
+begin
+  lzud := plzx_data(lzi^.user_data);
+  
+  chars_read := lzud^.get_bytes(lzud^.in_arg, n, buf);
+  Dec(lzud^.left_in_frame, chars_read mod LZX_FRAME_SIZE);
+  if (lzud^.left_in_frame < 0) then
+    Inc(lzud^.left_in_frame, LZX_FRAME_SIZE);
+
+  if ((chars_read < n) and (lzud^.left_in_frame <> 0)) then begin
+    chars_pad := n - chars_read;
+    if (chars_pad > lzud^.left_in_frame) then chars_pad := lzud^.left_in_frame;
+    //*  never emit a full frame of padding.  This prevents silliness when
+    //   lzx_compress is called when at EOF but EOF not yet detected */
+    if (chars_pad = LZX_FRAME_SIZE) then chars_pad := 0;
+    FillChar(buf[chars_read], chars_pad, 0);
+    Dec(lzud^.left_in_frame, chars_pad);
+    Inc(chars_read, chars_pad);
+  end;
+  lzx_get_chars := chars_read;
+end;
+
+function find_match_at(lzi: plz_info; loc: longint; match_len: longint; match_locp: plongint): longint;
+var
+  matchb,
+  nmatchb,
+  c1, c2: pbyte;
+  j: longint;
+begin
+  if -match_locp^ = loc then Exit(-1);
+  if loc < match_len then Exit(-1);
+
+  matchb := lzi^.block_buf + lzi^.block_loc + match_locp^;
+  nmatchb := lzi^.block_buf + lzi^.block_loc - loc;
+  c1 := matchb;
+  c2 := nmatchb;
+  j := 0;
+  while j < match_len do begin
+    if c1^ <> c2^ then begin
+      break;
+    end;
+    Inc(c1);
+    Inc(c2);
+    Inc(j);
+  end;
+  
+  if (j = match_len) then begin
+    match_locp^ := -loc;
+    Exit(0);
+  end;
+  Exit(-1);
+end;
+
+procedure check_entropy(lzud: plzx_data; main_index: longint);
+var
+    freq,
+    n_ln_n,
+    rn_ln2,
+    cur_ratio: double;
+    n: longint;
+begin
+    //* delete old entropy accumulation */
+    if (lzud^.main_freq_table[main_index] <> 1) then begin
+      freq := double(lzud^.main_freq_table[main_index])-1;
+      lzud^.main_entropy := lzud^.main_entropy + (freq * ln(freq));
+    end;
+    //* add new entropy accumulation */
+    freq := double(lzud^.main_freq_table[main_index]);
+    lzud^.main_entropy := lzud^.main_entropy - (freq * ln(freq));
+    n := lzud^.block_codesp - lzud^.block_codes;
+
+    if (((n and $0FFF) = 0) and (lzud^.left_in_block >= $1000)) then begin
+      n_ln_n := (double(n) * ln(double(n)));
+      rn_ln2 := (rloge2 / double(n));
+      cur_ratio := (n * rn_ln2 *(n_ln_n + lzud^.main_entropy) + 24 + 3 * 80 + NUM_CHARS + (lzud^.main_tree_size-NUM_CHARS)*3 + NUM_SECONDARY_LENGTHS ) / double(n);
+
+      if (cur_ratio > lzud^.last_ratio) then begin
+        lzud^.subdivide := -1;
+        lz_stop_compressing(lzud^.lzi);
+      end;
+      lzud^.last_ratio := cur_ratio;
+
+    end;
+
+end;
+
+function lzx_output_match(lzi: plz_info; match_pos, match_len: longint): longint; cdecl;
+var
+  lzud: plzx_data;
+  formatted_offset,
+  position_footer: longword;
+  length_footer,
+  length_header: byte;
+  len_pos_header: word;
+  position_slot: longint;
+  btdt: smallint;
+  left, right, mid: longint;
+label testforr;
+begin
+  lzud := plzx_data(lzi^.user_data);
+
+  position_footer := 0;
+  btdt := 0;
+ testforr:
+  if (match_pos = -lzud^.R0) then begin
+    match_pos := 0;
+    formatted_offset := 0;
+    position_slot := 0;
+  end
+  else if (match_pos = -lzud^.R1) then begin
+    lzud^.R1 := lzud^.R0;
+    lzud^.R0 := -match_pos;
+    match_pos := 1;
+    formatted_offset := 1;
+    position_slot := 1;
+  end
+  else if (match_pos = -lzud^.R2) then begin
+    lzud^.R2 := lzud^.R0;
+    lzud^.R0 := -match_pos;
+    match_pos := 2;
+    formatted_offset := 2;
+    position_slot := 2;
+  end
+  else begin
+    if (btdt = 0) then begin
+      btdt := 1;
+      if (find_match_at(lzi, lzud^.R0, match_len, @match_pos) = 0) then
+	goto testforr;
+      if (find_match_at(lzi, lzud^.R1, match_len, @match_pos) = 0) then
+	goto testforr;
+      if (find_match_at(lzi, lzud^.R2, match_len, @match_pos) = 0) then
+        goto testforr;
+    end;
+
+    formatted_offset := -match_pos + 2;
+
+    if ((match_len < 3) or
+	((formatted_offset >= 64) and (match_len < 4)) or
+	((formatted_offset >= 2048) and (match_len < 5)) or
+	((formatted_offset >= 65536) and (match_len < 6))) then begin
+      //* reject matches where extra_bits will likely be bigger than just outputting
+      //  literals.  The numbers are basically derived through guessing
+      //  and trial and error */
+      Exit(-1); //* reject the match */
+    end;
+
+    lzud^.R2 := lzud^.R1;
+    lzud^.R1 := lzud^.R0;
+    lzud^.R0 := -match_pos;
+
+  ///* calculate position base using binary search of table; if log2 can be
+  //   done in hardware, approximation might work;
+  //   trunc(log2(formatted_offset*formatted_offset)) gets either the proper
+  //   position slot or the next one, except for slots 0, 1, and 39-49
+
+  //   Slots 0-1 are handled by the R0-R1 procedures
+
+  //   Slots 36-49 (formatted_offset >= 262144) can be found by
+  //   (formatted_offset/131072) + 34 ==
+  //   (formatted_offset >> 17) + 34;
+  //*/
+    if (formatted_offset >= 262144) then begin
+      position_slot := (formatted_offset shr 17) + 34;
+    end
+    else begin
+      left := 3;
+      right := lzud^.num_position_slots - 1;
+      position_slot := -1;
+      while (left <= right) do begin
+	mid := (left + right) div 2;
+	if (position_base[mid] <= formatted_offset) and
+	    (position_base[mid+1] > formatted_offset) then begin
+	  position_slot := mid;
+	  break;
+        end;
+	if (formatted_offset > position_base[mid]) then
+	  //* too low */
+	  left := mid + 1
+	else //* too high */
+	  right := mid;
+      end;
+      if not(position_slot >= 0) then
+      raise Exception.Create('position_slot >= 0');
+
+      //* FIXME precalc extra_mask table */
+    end;
+    position_footer := ((LongWord(1) shl extra_bits[position_slot]) - 1) and formatted_offset;
+  end;
+
+  //* match length = 8 bits */
+  //* position_slot = 6 bits */
+  //* position_footer = 17 bits */
+  //* total = 31 bits */
+  //* plus one to say whether it's a literal or not */
+  lzud^.block_codesp^ := $80000000 or //* bit 31 in intelligent bit ordering */
+    (position_slot shl 25) or //* bits 30-25 */
+    (position_footer shl 8) or //* bits 8-24 */
+    (match_len - MIN_MATCH); //* bits 0-7 */
+  Inc(lzud^.block_codesp);
+
+  if (match_len < (NUM_PRIMARY_LENGTHS + MIN_MATCH)) then begin
+    length_header := match_len - MIN_MATCH;
+    //*    length_footer = 255; */ /* not necessary */
+  end
+  else begin
+    length_header := NUM_PRIMARY_LENGTHS;
+    length_footer := match_len - (NUM_PRIMARY_LENGTHS + MIN_MATCH);
+    Inc(lzud^.length_freq_table[length_footer]);
+  end;
+  len_pos_header := (position_slot shl 3) or length_header;
+  Inc(lzud^.main_freq_table[len_pos_header + NUM_CHARS]);
+  if (extra_bits[position_slot] >= 3) then begin
+    Inc(lzud^.aligned_freq_table[position_footer and 7]);
+  end;
+
+  Dec(lzud^.left_in_block, match_len);
+
+  if (lzud^.subdivide <> 0) then
+    check_entropy(lzud, len_pos_header + NUM_CHARS);
+  Exit(0); ///* accept the match */
+end;
+
+procedure lzx_output_literal(lzi: plz_info; ch: byte); cdecl;
+var
+  lzud: plzx_data;
+begin
+  lzud := plzx_data(lzi^.user_data);
+
+  Dec(lzud^.left_in_block);
+  lzud^.block_codesp^ := ch;
+  Inc(lzud^.block_codesp);
+  Inc(lzud^.main_freq_table[ch]);
+  if (lzud^.subdivide <> 0) then
+    check_entropy(lzud, ch);
+end;
+
+procedure lzx_write_bits(lzxd: plzx_data; nbits: longint; bits: longword); cdecl;
+var
+  cur_bits,
+  shift_bits,
+  rshift_bits: longint;
+  mask_bits: word;
+begin
+  cur_bits := lzxd^.bits_in_buf;
+  while ((cur_bits + nbits) >= 16) do begin
+    shift_bits := 16 - cur_bits;
+    rshift_bits := nbits - shift_bits;
+    if (shift_bits = 16) then begin
+      lzxd^.bit_buf := (bits shr rshift_bits) and $FFFF;
+    end
+    else begin
+      mask_bits := (1 shl shift_bits) - 1;
+      lzxd^.bit_buf := lzxd^.bit_buf shl shift_bits;
+      lzxd^.bit_buf := lzxd^.bit_buf or (bits shr rshift_bits) and mask_bits;
+    end;
+{$IFDEF ENDIAN_BIG}
+    lzxd^.bit_buf := ((lzxd^.bit_buf and $FF)shl8) or (lzxd^.bit_buf shr 8);
+{$ENDIF}
+    lzxd^.put_bytes(lzxd^.out_arg, sizeof(lzxd^.bit_buf), @lzxd^.bit_buf);
+    Inc(lzxd^.len_compressed_output, sizeof(lzxd^.bit_buf));
+    lzxd^.bit_buf := 0;
+    Dec(nbits, shift_bits);
+    cur_bits := 0;
+  end;
+  //* (cur_bits + nbits) < 16.  If nbits := 0, we're done.
+  //   otherwise move bits in */
+  shift_bits := nbits;
+  mask_bits := (1 shl shift_bits) - 1;
+  lzxd^.bit_buf := lzxd^.bit_buf shl shift_bits;
+  lzxd^.bit_buf := lzxd^.bit_buf or bits and mask_bits;
+  Inc(cur_bits, nbits);
+
+  lzxd^.bits_in_buf := cur_bits;
+end;
+
+procedure lzx_align_output(lzxd: plzx_data);
+begin
+  if (lzxd^.bits_in_buf <> 0) then begin
+    lzx_write_bits(lzxd, 16 - lzxd^.bits_in_buf, 0);
+  end;
+  if (lzxd^.mark_frame <> nil) then
+    lzxd^.mark_frame(lzxd^.mark_frame_arg, lzxd^.len_uncompressed_input, lzxd^.len_compressed_output);
+end;
+
+procedure lzx_write_compressed_literals(lzxd: plzx_data; block_type: longint);
+var
+  cursor: plongword;
+  endp: plongword;
+  position_slot: word;
+  position_footer,
+  match_len_m2, //* match length minus 2, which is MIN_MATCH */
+  verbatim_bits,
+  block_code: longword;
+  length_header,
+  length_footer,
+  len_pos_header: word;
+  huffe: phuff_entry;
+  frame_count: longint;
+begin
+  cursor := lzxd^.block_codes;
+  endp := lzxd^.block_codesp;
+  frame_count := (lzxd^.len_uncompressed_input mod LZX_FRAME_SIZE);
+
+  Dec(lzxd^.len_uncompressed_input, frame_count); //* will be added back in later */
+  while (cursor < endp) do begin
+    block_code := cursor^;
+    Inc(cursor);
+    if (block_code and $80000000) <> 0 then begin
+      {*
+       *    0x80000000 |                bit 31 in intelligent bit ordering
+       * (position_slot shl 25) |        bits 30-25
+       * (position_footer shl 8) |       bits 8-24
+       * (match_len - MIN_MATCH);       bits 0-7
+       *
+       *}
+
+      match_len_m2 := block_code and $FF; //* 8 bits */
+      position_footer := (block_code shr 8)and $1FFFF; //* 17 bits */
+      position_slot := (block_code shr 25) and $3F; //* 6 bits */
+
+      if (match_len_m2 < NUM_PRIMARY_LENGTHS) then begin
+	length_header := match_len_m2;
+	length_footer := 255; //* personal encoding for NULL */
+      end
+      else begin
+	length_header := NUM_PRIMARY_LENGTHS;
+	length_footer := match_len_m2 - NUM_PRIMARY_LENGTHS;
+      end;
+      len_pos_header := (position_slot shl 3) or length_header;
+      huffe := @lzxd^.main_tree[len_pos_header+NUM_CHARS];
+      lzx_write_bits(lzxd, huffe^.codelength, huffe^.code);
+      if (length_footer <> 255) then begin
+	huffe := @lzxd^.length_tree[length_footer];
+	lzx_write_bits(lzxd, huffe^.codelength, huffe^.code);
+      end;
+      if ((block_type = LZX_ALIGNED_OFFSET_BLOCK) and (extra_bits[position_slot] >= 3)) then begin
+	//* aligned offset block and code */
+	verbatim_bits := position_footer shr 3;
+	lzx_write_bits(lzxd, extra_bits[position_slot] - 3, verbatim_bits);
+	huffe := @lzxd^.aligned_tree[position_footer and 7];
+	lzx_write_bits(lzxd, huffe^.codelength, huffe^.code);
+      end
+      else begin
+	verbatim_bits := position_footer;
+	lzx_write_bits(lzxd, extra_bits[position_slot], verbatim_bits);
+      end;
+      Inc(frame_count, match_len_m2 + 2);
+    end
+    else begin
+      //* literal */
+      if not(block_code < NUM_CHARS) then
+      raise Exception.Create('block_code < NUM_CHARS');
+      
+      huffe := @lzxd^.main_tree[block_code];
+      lzx_write_bits(lzxd, huffe^.codelength, huffe^.code);
+      Inc(frame_count);
+    end;
+    if (frame_count = LZX_FRAME_SIZE) then begin
+      Inc(lzxd^.len_uncompressed_input, frame_count);
+      lzx_align_output(lzxd);
+      frame_count := 0;
+    end;
+    if not(frame_count < LZX_FRAME_SIZE) then
+    raise Exception.Create('frame_count < LZX_FRAME_SIZE');
+  end;
+  Inc(lzxd^.len_uncompressed_input, frame_count);
+end;
+
+function lzx_write_compressed_tree(lzxd: plzx_data; tree: phuff_entry; prevlengths: pbyte;
+			  treesize: longint): longint;
+var
+  codes,
+  runs: pbyte;
+  freqs: array [0..LZX_PRETREE_SIZE-1] of longint;
+  cur_run: longint;
+  last_len: longint;
+  pretree: array [0..19] of huff_entry;
+  codep,
+  codee,
+  runp: pbyte;
+  excess,
+  i,
+  cur_code: longint;
+begin
+  codes := getmem(treesize*sizeof(byte));
+  codep := codes;
+  runs := getmem(treesize*sizeof(byte));
+  runp := runs;
+  Fillchar(freqs[0], sizeof(freqs), 0);
+  cur_run := 1;
+  last_len := tree[0].codelength;
+  for i := 1 to treesize do begin
+    if ((i = treesize) or (tree[i].codelength <> last_len)) then begin
+      if (last_len = 0) then begin
+	while (cur_run >= 20) do begin
+	  excess := cur_run - 20;
+	  if (excess > 31) then excess := 31;
+	  codep^ := 18;
+          Inc(codep);
+	  runp^ := excess;
+          Inc(runp);
+	  Dec(cur_run, excess + 20);
+	  Inc(freqs[18]);
+        end;
+	while (cur_run >= 4) do begin
+	  excess := cur_run - 4;
+	  if (excess > 15) then excess := 15;
+	  codep^ := 17;
+          Inc(codep);
+	  runp^ := excess;
+          Inc(runp);
+	  Dec(cur_run, excess + 4);
+	  Inc(freqs[17]);
+        end;
+	while (cur_run > 0) do begin
+	  codep^ := prevlengths[i - cur_run];
+	  Inc(freqs[codep^]);
+          Inc(codep);
+	  runp^ := 0; //* not necessary */
+          Inc(runp);
+	  Dec(cur_run);
+        end;
+      end
+      else begin
+	while (cur_run >= 4) do begin
+	  if (cur_run = 4) then excess := 0
+	  else excess := 1;
+	  codep^ := 19;
+          Inc(codep);
+	  runp^ := excess;
+          Inc(runp);
+	  Inc(freqs[19]);
+	  //* right, MS lies again.  Code is NOT
+	  //   prev_len + len (mod 17), it's prev_len - len (mod 17)*/
+	  codep^ := prevlengths[i-cur_run] - last_len;
+	  if (codep^ > 16) then Inc(codep^, 17);
+	  Inc(freqs[codep^]);
+          Inc(codep);
+	  runp^ := 0; //* not necessary */
+          Inc(runp);
+	  Dec(cur_run, excess+4);
+        end;
+	while (cur_run > 0) do begin
+	  codep^ := prevlengths[i-cur_run] - last_len;
+	  if (codep^ > 16) then Inc(codep^, 17);
+	  runp^ := 0; //* not necessary */
+          Inc(runp);
+	  Dec(cur_run);
+	  Inc(freqs[codep^]);
+          Inc(codep);
+        end;
+      end;
+      if (i <> treesize) then
+	last_len := tree[i].codelength;
+      cur_run := 0;
+    end;
+    Inc(cur_run);
+  end;
+  codee := codep;
+  //* now create the huffman table and write out the pretree */
+  build_huffman_tree(LZX_PRETREE_SIZE, 16, @freqs[0], pretree);
+  for i := 0 to LZX_PRETREE_SIZE-1 do begin
+    lzx_write_bits(lzxd, 4, pretree[i].codelength);
+  end;
+  codep := codes;
+  runp := runs;
+  cur_run := 0;
+  while (codep < codee) do begin
+    cur_code := codep^;
+    Inc(codep);
+    lzx_write_bits(lzxd, pretree[cur_code].codelength, pretree[cur_code].code);
+    if (cur_code = 17) then begin
+      Inc(cur_run, runp^ + 4);
+      lzx_write_bits(lzxd, 4, runp^);
+    end
+    else if (cur_code = 18) then begin
+      Inc(cur_run, runp^ + 20);
+      lzx_write_bits(lzxd, 5, runp^);
+    end
+    else if (cur_code = 19) then begin
+      Inc(cur_run, runp^ + 4);
+      lzx_write_bits(lzxd, 1, runp^);
+      cur_code := codep^;
+      Inc(codep);
+      lzx_write_bits(lzxd, pretree[cur_code].codelength, pretree[cur_code].code);
+      Inc(runp);
+    end
+    else begin
+      Inc(cur_run);
+    end;
+    Inc(runp);
+  end;
+  freemem(codes);
+  freemem(runs);
+  Exit(0);
+end;
+
+procedure lzx_reset(lzxd:plzx_data);
+begin
+  lzxd^.need_1bit_header := 1;
+  lzxd^.R0 := 1;
+  lzxd^.R1 := 1;
+  lzxd^.R2 := 1;
+  Fillchar(lzxd^.prev_main_treelengths[0], lzxd^.main_tree_size * sizeof(byte), 0);
+  Fillchar(lzxd^.prev_length_treelengths[0], NUM_SECONDARY_LENGTHS * sizeof(byte), 0);
+  lz_reset(lzxd^.lzi);
+end;
+
+function lzx_compress_block(lzxd:plzx_data; block_size:longint; subdivide:longbool):longint;
+var
+  i: longint;
+  written_sofar: longword = 0;
+  block_type: longint;
+  uncomp_bits,
+  comp_bits,
+  comp_bits_ovh,
+  uncomp_length: longword;
+begin
+  if ((lzxd^.block_size <> block_size) or (lzxd^.block_codes = nil)) then begin
+    if (lzxd^.block_codes <> nil) then freemem(lzxd^.block_codes);
+    lzxd^.block_size := block_size;
+    lzxd^.block_codes :=  GetMem(block_size * sizeof(longword));
+  end;
+
+  lzxd^.subdivide := Ord(subdivide);
+
+  lzxd^.left_in_block := block_size;
+  lzxd^.left_in_frame := LZX_FRAME_SIZE;
+  lzxd^.main_entropy := 0.0;
+  lzxd^.last_ratio := 9999999.0;
+  lzxd^.block_codesp := lzxd^.block_codes;
+
+
+  Fillchar(lzxd^.length_freq_table[0], NUM_SECONDARY_LENGTHS * sizeof(longint), 0);
+  Fillchar(lzxd^.main_freq_table[0], lzxd^.main_tree_size * sizeof(longint), 0);
+  Fillchar(lzxd^.aligned_freq_table[0], LZX_ALIGNED_SIZE * sizeof(longint), 0);
+
+  while ((lzxd^.left_in_block<>0) and ((lz_left_to_process(lzxd^.lzi)<>0) or not(lzxd^.at_eof(lzxd^.in_arg)))) do begin
+    lz_compress(lzxd^.lzi, lzxd^.left_in_block);
+
+    if (lzxd^.left_in_frame = 0) then begin
+      lzxd^.left_in_frame := LZX_FRAME_SIZE;
+    end;
+    
+    if lzxd^.at_eof(lzxd^.in_arg) then Sleep(500);
+    if ((lzxd^.subdivide<0)
+      or (lzxd^.left_in_block = 0)
+      or ((lz_left_to_process(lzxd^.lzi) = 0) and lzxd^.at_eof(lzxd^.in_arg))) then begin
+      //* now one block is LZ-analyzed. */
+      //* time to write it out */
+      uncomp_length := lzxd^.block_size - lzxd^.left_in_block - written_sofar;
+      //* uncomp_length will sometimes be 0 when input length is
+      //  an exact multiple of frame size */
+      if (uncomp_length = 0) then
+        continue;
+      if (lzxd^.subdivide < 0) then begin
+	lzxd^.subdivide := 1;
+      end;
+
+      if (lzxd^.need_1bit_header <> 0) then begin
+	//* one bit Intel preprocessing header */
+	//* always 0 because this implementation doesn't do Intel preprocessing */
+	lzx_write_bits(lzxd, 1, 0);
+	lzxd^.need_1bit_header := 0;
+      end;
+
+      //* handle extra bits */
+      uncomp_bits := 0;
+      comp_bits := 0;
+      
+      build_huffman_tree(LZX_ALIGNED_SIZE, 7, @lzxd^.aligned_freq_table[0], @lzxd^.aligned_tree[0]);
+      for i := 0 to LZX_ALIGNED_SIZE-1 do begin
+	Inc(uncomp_bits, lzxd^.aligned_freq_table[i]* 3);
+	Inc(comp_bits, lzxd^.aligned_freq_table[i]* lzxd^.aligned_tree[i].codelength);
+      end;
+      comp_bits_ovh := comp_bits + LZX_ALIGNED_SIZE * 3;
+      if (comp_bits_ovh < uncomp_bits) then
+      	block_type := LZX_ALIGNED_OFFSET_BLOCK
+      else
+	block_type := LZX_VERBATIM_BLOCK;
+
+
+      //* block type */
+      lzx_write_bits(lzxd, 3, block_type);
+      //* uncompressed length */
+      lzx_write_bits(lzxd, 24, uncomp_length);
+
+      written_sofar := lzxd^.block_size - lzxd^.left_in_block;
+
+      //* now write out the aligned offset trees if present */
+      if (block_type = LZX_ALIGNED_OFFSET_BLOCK) then begin
+        for i := 0 to LZX_ALIGNED_SIZE-1 do begin
+	  lzx_write_bits(lzxd, 3, lzxd^.aligned_tree[i].codelength);
+        end;
+      end;
+      //* end extra bits */
+      build_huffman_tree(lzxd^.main_tree_size, LZX_MAX_CODE_LENGTH,
+			 lzxd^.main_freq_table, lzxd^.main_tree);
+      build_huffman_tree(NUM_SECONDARY_LENGTHS, 16,
+			 @lzxd^.length_freq_table[0], @lzxd^.length_tree[0]);
+
+      //* now write the pre-tree and tree for main 1 */
+      lzx_write_compressed_tree(lzxd, lzxd^.main_tree, lzxd^.prev_main_treelengths, NUM_CHARS);
+
+      //* now write the pre-tree and tree for main 2*/
+      lzx_write_compressed_tree(lzxd, lzxd^.main_tree + NUM_CHARS,
+				lzxd^.prev_main_treelengths + NUM_CHARS,
+				lzxd^.main_tree_size - NUM_CHARS);
+
+      //* now write the pre tree and tree for length */
+      lzx_write_compressed_tree(lzxd, @lzxd^.length_tree[0], @lzxd^.prev_length_treelengths[0],
+				NUM_SECONDARY_LENGTHS);
+
+      //* now write literals */
+      lzx_write_compressed_literals(lzxd, block_type);
+
+      //* copy treelengths somewhere safe to do delta compression */
+      for i := 0 to lzxd^.main_tree_size-1 do begin
+	lzxd^.prev_main_treelengths[i] := lzxd^.main_tree[i].codelength;
+      end;
+      for i := 0 to NUM_SECONDARY_LENGTHS-1 do begin
+        lzxd^.prev_length_treelengths[i] := lzxd^.length_tree[i].codelength;
+      end;
+      lzxd^.main_entropy := 0.0;
+      lzxd^.last_ratio := 9999999.0;
+      lzxd^.block_codesp := lzxd^.block_codes;
+
+      Fillchar(lzxd^.length_freq_table[0], NUM_SECONDARY_LENGTHS * sizeof(longint), 0);
+      Fillchar(lzxd^.main_freq_table[0], lzxd^.main_tree_size * sizeof(longint), 0);
+      Fillchar(lzxd^.aligned_freq_table[0], LZX_ALIGNED_SIZE * sizeof(longint), 0);
+    end;
+  end;
+  Exit(0);
+end;
+
+function lzx_init(lzxdp:Pplzx_data; wsize_code:longint; get_bytes:TGetBytesFunc; get_bytes_arg:pointer; at_eof:TIsEndOfFileFunc;
+             put_bytes:TWriteBytesFunc; put_bytes_arg:pointer; mark_frame:TMarkFrameFunc; mark_frame_arg:pointer):longint;var
+  wsize: longint;
+  lzxd: plzx_data;
+begin
+  if ((wsize_code < 15) or (wsize_code > 21)) then begin
+    Exit(-1);
+  end;
+  
+  //lzx_init_static(); I hardcoded this instead
+
+  New(lzxd);
+  FillChar(lzxd^, Sizeof(lzxd), 0);
+  lzxdp^ := lzxd;
+
+  if (lzxd = nil) then
+    Exit(-2);
+
+  lzxd^.in_arg := get_bytes_arg;
+  lzxd^.out_arg := put_bytes_arg;
+  lzxd^.mark_frame_arg := mark_frame_arg;
+  lzxd^.get_bytes := get_bytes;
+  lzxd^.put_bytes := put_bytes;
+  lzxd^.at_eof := at_eof;
+  lzxd^.mark_frame := mark_frame;
+
+  wsize := 1 shl (wsize_code);
+
+  lzxd^.bits_in_buf := 0;
+  lzxd^.block_codes := nil;
+  lzxd^.num_position_slots := num_position_slots[wsize_code-15];
+  lzxd^.main_tree_size := (NUM_CHARS + 8 * lzxd^.num_position_slots);
+
+  lzxd^.main_freq_table := GetMem(sizeof(longint) * lzxd^.main_tree_size);
+  lzxd^.main_tree := GetMem(sizeof(huff_entry)* lzxd^.main_tree_size);
+  lzxd^.prev_main_treelengths := GetMem(sizeof(byte)*lzxd^.main_tree_size);
+
+  New(lzxd^.lzi);
+  //* the -3 prevents matches at wsize, wsize-1, wsize-2, all of which are illegal */
+  lz_init(lzxd^.lzi, wsize, wsize - 3, MAX_MATCH, MIN_MATCH, LZX_FRAME_SIZE,
+	  @lzx_get_chars, @lzx_output_match, @lzx_output_literal,lzxd);
+  lzxd^.len_uncompressed_input := 0;
+  lzxd^.len_compressed_output := 0;
+  lzx_reset(lzxd);
+  Exit(0);
+end;
+
+function lzx_finish(lzxd:plzx_data; lzxr:plzx_results):longint;
+begin
+  if (lzxr <> nil) then begin
+    lzxr^.len_compressed_output := lzxd^.len_compressed_output;
+    lzxr^.len_uncompressed_input := lzxd^.len_uncompressed_input;
+  end;
+  lz_release(lzxd^.lzi);
+  Dispose(lzxd^.lzi);
+  freemem(lzxd^.prev_main_treelengths);
+  freemem(lzxd^.main_tree);
+  freemem(lzxd^.main_freq_table);
+  dispose(lzxd);
+  Exit(0);
+end;
+
+initialization
+  rloge2 := 1.0 / ln(2);
+end.