* moved to packages

fcl/Makefile

@@ -1,481 +0,0 @@
-#
-# Makefile generated by fpcmake v0.99.13 on 1999-12-24 16:08
-#
-
-defaultrule: all
-
-#####################################################################
-# Autodetect OS (Linux or Dos or Windows NT)
-# define inlinux when running under linux
-# define inWinNT when running under WinNT
-#####################################################################
-
-# We need only / in the path
-override PATH:=$(subst \,/,$(PATH))
-
-# Search for PWD and determine also if we are under linux
-PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
-ifeq ($(PWD),)
-PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
-ifeq ($(PWD),)
-nopwd:
-	@echo You need the GNU utils package to use this Makefile!
-	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
-	@exit
-else
-inlinux=1
-endif
-else
-PWD:=$(firstword $(PWD))
-endif
-
-# Detect NT - NT sets OS to Windows_NT
-ifndef inlinux
-ifeq ($(OS),Windows_NT)
-inWinNT=1
-endif
-endif
-
-# Detect OS/2 - OS/2 has OS2_SHELL defined
-ifndef inlinux
-ifndef inWinNT
-ifdef OS2_SHELL
-inOS2=1
-endif
-endif
-endif
-
-# The extension of executables
-ifdef inlinux
-EXEEXT=
-else
-EXEEXT=.exe
-endif
-
-# The path which is search separated by spaces
-ifdef inlinux
-SEARCHPATH=$(subst :, ,$(PATH))
-else
-SEARCHPATH=$(subst ;, ,$(PATH))
-endif
-
-#####################################################################
-# FPC version/target Detection
-#####################################################################
-
-# What compiler to use ?
-ifndef FPC
-# Compatibility with old makefiles
-ifdef PP
-FPC=$(PP)
-else
-ifdef inOS2
-FPC=ppos2$(EXEEXT)
-else
-FPC=ppc386$(EXEEXT)
-endif
-endif
-endif
-
-# Target OS
-ifndef OS_TARGET
-OS_TARGET:=$(shell $(FPC) -iTO)
-endif
-
-# Source OS
-ifndef OS_SOURCE
-OS_SOURCE:=$(shell $(FPC) -iSO)
-endif
-
-# Target CPU
-ifndef CPU_TARGET
-CPU_TARGET:=$(shell $(FPC) -iTP)
-endif
-
-# Source CPU
-ifndef CPU_SOURCE
-CPU_SOURCE:=$(shell $(FPC) -iSP)
-endif
-
-# FPC version
-ifndef FPC_VERSION
-FPC_VERSION:=$(shell $(FPC) -iV)
-endif
-
-export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
-
-#####################################################################
-# Default Settings
-#####################################################################
-
-# Release ? Then force OPT and don't use extra opts via commandline
-ifndef REDIRFILE
-REDIRFILE=log
-endif
-
-ifdef RELEASE
-override OPT:=-Xs -OG2p3 -n
-endif
-
-# Verbose settings (warning,note,info)
-ifdef VERBOSE
-override OPT+=-vwni
-endif
-
-ifdef REDIR
-ifndef inlinux
-override FPC=redir -eo $(FPC)
-endif
-# set the verbosity to max
-override OPT+=-va
-override REDIR:= >> $(REDIRFILE)
-endif
-
-#####################################################################
-# User Settings
-#####################################################################
-
-
-# Targets
-
-override DIROBJECTS+=$(wildcard go32v2 linux win32 os2 tests)
-
-# Clean
-
-
-# Install
-
-ZIPTARGET=install
-
-# Defaults
-
-
-# Directories
-
-ifndef PACKAGEDIR
-PACKAGEDIR=$(FPCDIR)/packages
-endif
-ifndef COMPONENTDIR
-COMPONENTDIR=$(FPCDIR)/components
-endif
-
-# Packages
-
-
-# Libraries
-
-
-#####################################################################
-# Standard rules
-#####################################################################
-
-all: $(addsuffix _all,$(OS_TARGET))
-
-debug: $(addsuffix _debug,$(OS_TARGET))
-
-examples: $(addsuffix _examples,$(OS_TARGET))
-
-test: $(addsuffix _test,$(OS_TARGET))
-
-smart: $(addsuffix _smart,$(OS_TARGET))
-
-shared: $(addsuffix _shared,$(OS_TARGET))
-
-showinstall: $(addsuffix _showinstall,$(OS_TARGET))
-
-install: $(addsuffix _install,$(OS_TARGET))
-
-sourceinstall: $(addsuffix _sourceinstall,$(OS_TARGET))
-
-zipinstall: $(addsuffix _zipinstall,$(OS_TARGET))
-
-zipinstalladd: $(addsuffix _zipinstalladd,$(OS_TARGET))
-
-clean: $(addsuffix _clean,$(OS_TARGET))
-
-cleanall: $(addsuffix _cleanall,$(OS_TARGET))
-
-depend: $(addsuffix _depend,$(OS_TARGET))
-
-info: $(addsuffix _info,$(OS_TARGET))
-
-.PHONY:  all debug examples test smart shared showinstall install sourceinstall zipinstall zipinstalladd clean cleanall depend info
-
-#####################################################################
-# Package depends
-#####################################################################
-
-ifneq ($(wildcard $(RTLDIR)),)
-ifeq ($(wildcard $(RTLDIR)/$(FPCMADE)),)
-override COMPILEPACKAGES+=rtl
-rtl_package:
-	$(MAKE) -C $(RTLDIR) all
-endif
-endif
-
-.PHONY:  rtl_package
-
-
-# Target Dirs
-
-OBJECTDIRGO32V2=1
-OBJECTDIRLINUX=1
-OBJECTDIRWIN32=1
-OBJECTDIROS2=1
-OBJECTDIRTESTS=1
-
-# Dir go32v2
-
-ifdef OBJECTDIRGO32V2
-.PHONY:  go32v2_all go32v2_debug go32v2_examples go32v2_test go32v2_smart go32v2_shared go32v2_showinstall go32v2_install go32v2_sourceinstall go32v2_zipinstall go32v2_zipinstalladd go32v2_clean go32v2_cleanall go32v2_depend go32v2_info
-
-go32v2_all:
-	$(MAKE) -C go32v2 all
-
-go32v2_debug:
-	$(MAKE) -C go32v2 debug
-
-go32v2_examples:
-	$(MAKE) -C go32v2 examples
-
-go32v2_test:
-	$(MAKE) -C go32v2 test
-
-go32v2_smart:
-	$(MAKE) -C go32v2 smart
-
-go32v2_shared:
-	$(MAKE) -C go32v2 shared
-
-go32v2_showinstall:
-	$(MAKE) -C go32v2 showinstall
-
-go32v2_install:
-	$(MAKE) -C go32v2 install
-
-go32v2_sourceinstall:
-	$(MAKE) -C go32v2 sourceinstall
-
-go32v2_zipinstall:
-	$(MAKE) -C go32v2 zipinstall
-
-go32v2_zipinstalladd:
-	$(MAKE) -C go32v2 zipinstalladd
-
-go32v2_clean:
-	$(MAKE) -C go32v2 clean
-
-go32v2_cleanall:
-	$(MAKE) -C go32v2 cleanall
-
-go32v2_depend:
-	$(MAKE) -C go32v2 depend
-
-go32v2_info:
-	$(MAKE) -C go32v2 info
-endif
-
-# Dir linux
-
-ifdef OBJECTDIRLINUX
-.PHONY:  linux_all linux_debug linux_examples linux_test linux_smart linux_shared linux_showinstall linux_install linux_sourceinstall linux_zipinstall linux_zipinstalladd linux_clean linux_cleanall linux_depend linux_info
-
-linux_all:
-	$(MAKE) -C linux all
-
-linux_debug:
-	$(MAKE) -C linux debug
-
-linux_examples:
-	$(MAKE) -C linux examples
-
-linux_test:
-	$(MAKE) -C linux test
-
-linux_smart:
-	$(MAKE) -C linux smart
-
-linux_shared:
-	$(MAKE) -C linux shared
-
-linux_showinstall:
-	$(MAKE) -C linux showinstall
-
-linux_install:
-	$(MAKE) -C linux install
-
-linux_sourceinstall:
-	$(MAKE) -C linux sourceinstall
-
-linux_zipinstall:
-	$(MAKE) -C linux zipinstall
-
-linux_zipinstalladd:
-	$(MAKE) -C linux zipinstalladd
-
-linux_clean:
-	$(MAKE) -C linux clean
-
-linux_cleanall:
-	$(MAKE) -C linux cleanall
-
-linux_depend:
-	$(MAKE) -C linux depend
-
-linux_info:
-	$(MAKE) -C linux info
-endif
-
-# Dir win32
-
-ifdef OBJECTDIRWIN32
-.PHONY:  win32_all win32_debug win32_examples win32_test win32_smart win32_shared win32_showinstall win32_install win32_sourceinstall win32_zipinstall win32_zipinstalladd win32_clean win32_cleanall win32_depend win32_info
-
-win32_all:
-	$(MAKE) -C win32 all
-
-win32_debug:
-	$(MAKE) -C win32 debug
-
-win32_examples:
-	$(MAKE) -C win32 examples
-
-win32_test:
-	$(MAKE) -C win32 test
-
-win32_smart:
-	$(MAKE) -C win32 smart
-
-win32_shared:
-	$(MAKE) -C win32 shared
-
-win32_showinstall:
-	$(MAKE) -C win32 showinstall
-
-win32_install:
-	$(MAKE) -C win32 install
-
-win32_sourceinstall:
-	$(MAKE) -C win32 sourceinstall
-
-win32_zipinstall:
-	$(MAKE) -C win32 zipinstall
-
-win32_zipinstalladd:
-	$(MAKE) -C win32 zipinstalladd
-
-win32_clean:
-	$(MAKE) -C win32 clean
-
-win32_cleanall:
-	$(MAKE) -C win32 cleanall
-
-win32_depend:
-	$(MAKE) -C win32 depend
-
-win32_info:
-	$(MAKE) -C win32 info
-endif
-
-# Dir os2
-
-ifdef OBJECTDIROS2
-.PHONY:  os2_all os2_debug os2_examples os2_test os2_smart os2_shared os2_showinstall os2_install os2_sourceinstall os2_zipinstall os2_zipinstalladd os2_clean os2_cleanall os2_depend os2_info
-
-os2_all:
-	$(MAKE) -C os2 all
-
-os2_debug:
-	$(MAKE) -C os2 debug
-
-os2_examples:
-	$(MAKE) -C os2 examples
-
-os2_test:
-	$(MAKE) -C os2 test
-
-os2_smart:
-	$(MAKE) -C os2 smart
-
-os2_shared:
-	$(MAKE) -C os2 shared
-
-os2_showinstall:
-	$(MAKE) -C os2 showinstall
-
-os2_install:
-	$(MAKE) -C os2 install
-
-os2_sourceinstall:
-	$(MAKE) -C os2 sourceinstall
-
-os2_zipinstall:
-	$(MAKE) -C os2 zipinstall
-
-os2_zipinstalladd:
-	$(MAKE) -C os2 zipinstalladd
-
-os2_clean:
-	$(MAKE) -C os2 clean
-
-os2_cleanall:
-	$(MAKE) -C os2 cleanall
-
-os2_depend:
-	$(MAKE) -C os2 depend
-
-os2_info:
-	$(MAKE) -C os2 info
-endif
-
-# Dir tests
-
-ifdef OBJECTDIRTESTS
-.PHONY:  tests_all tests_debug tests_examples tests_test tests_smart tests_shared tests_showinstall tests_install tests_sourceinstall tests_zipinstall tests_zipinstalladd tests_clean tests_cleanall tests_depend tests_info
-
-tests_all:
-	$(MAKE) -C tests all
-
-tests_debug:
-	$(MAKE) -C tests debug
-
-tests_examples:
-	$(MAKE) -C tests examples
-
-tests_test:
-	$(MAKE) -C tests test
-
-tests_smart:
-	$(MAKE) -C tests smart
-
-tests_shared:
-	$(MAKE) -C tests shared
-
-tests_showinstall:
-	$(MAKE) -C tests showinstall
-
-tests_install:
-	$(MAKE) -C tests install
-
-tests_sourceinstall:
-	$(MAKE) -C tests sourceinstall
-
-tests_zipinstall:
-	$(MAKE) -C tests zipinstall
-
-tests_zipinstalladd:
-	$(MAKE) -C tests zipinstalladd
-
-tests_clean:
-	$(MAKE) -C tests clean
-
-tests_cleanall:
-	$(MAKE) -C tests cleanall
-
-tests_depend:
-	$(MAKE) -C tests depend
-
-tests_info:
-	$(MAKE) -C tests info
-endif
-

fcl/Makefile.fpc

@@ -1,12 +0,0 @@
-#
-#   Makefile.fpc for Free Component Library
-#
-
-[targets]
-dirs=go32v2 linux win32 os2 tests
-
-[sections]
-none=1
-
-[defaults]
-defaultdir=$(OS_TARGET)

fcl/db/Dataset.txt

@@ -1,322 +0,0 @@
-Contents
-========
-
-+ General remarks
-+ Fields system
-+ The buffers
-+ Dataset implementation
-+ Scalable Datasets.
-
-===============
-General remarks
-===============
-
-- All fields and descendents implemented.
-- No calculated fields.
-- No Datasource yet. (although DataEvent is implemented in TField)
-- No persistent fields; this must be added later.
-
-
-=============
-Fields system
-=============
-
-Buffers are completely handled by the Dataset. Fields don't handle
-their own buffers. Only during validation, the FValueBuffer of the 
-field is used. 
-
-This allows the dataset to allocate a number of buffers for the current
-record and the N next records. (getnextrecords/getpriorrecords method)
-
-This means that all field mechanisms MUST pass through GetData/SetData,
-since FValueBuffer is only valid during validation.
-
-===========
-The Buffers
-===========
-
-A buffer contains all the data for 1 record of the dataset, and also
-the bookmark information. (bookmarkinformation is REQUIRED)
-
-The dataset allocates by default 'DefultBufferCount+1' records(buffers)
-This constant can be changed, at the beginning of dataset.inc;
-if you know you'll be working with big datasets, you can 
-increase this constant.
-
-The buffers are stored as pchars in the FBuffers array;
-The following constants are userd when handling this array:
-
-FBuffercount : The number of buffers allocated, minus one.
-FRecordCount : The number of buffers that is actually filled in.
-FActiveBuffer : The index of the active record.
-FCurrentRecord : The current Buffer. Should be phased out.
-
-So the following picture follows from this:
-
-+---------------+
-|  0            |
-+---------------+
-|  1            |
-+---------------+
-|               |
-   ...
-|               |
-+---------------+
-| FActivebuffer |
-+---------------+
-|               |
-    ...
-|               |
-+---------------+
-|FRecordCount-1 |
-+---------------+
-|               |
-  ...
-|               |
-+---------------+
-| FBufferCount  |
-+---------------+ 
-
-The array is zero based. 
-
-The following methods are used to manipulate the array:
-
-GetNextRecords: Tries to fill up the entire array, going forward
-GetPriorRecords: tries to fill up the entire array, going backward
-GetNextRecord: gets the next record. Shifts the array if FrecordCount=BufferCount-1
-GetPriorRecord: gets the previous record. Shifts the array if FrecordCount=BufferCount-1
-
-For the last 2 methods: the underlying record pointer must be on the 
-last/first record in the dataset, or it will go wrong.
-
-resync tries to refresh the array from the underlying dataset; it uses the
-bookmarks for that.
-
-=======================
-Dataset implementations
-=======================
-
-TDataset does most of the work associated with fields, buffers and
-navigating/editing/adding/removing records of some source of data. 
-There are, however, some methods that need to be filled in so that 
-a real TDataset can be implemented. 
-
-In order to have a working Dataset, the following Methods  need to be 
-overridden in order to make a dataset descendant:
-
-function AllocRecordBuffer: PChar; virtual; abstract;
------------------------------------------------------
-
-Must allocate enough memory to store a complete record in the dataset.
-Optionally, this buffer must contain enough memory to store bookmarkdata.
-The descendent must be able to construct a bookmark from this buffer.
-
-procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
------------------------------------------------------------------
-
-Must free the memory allocated in the AllocRecordBuffer call.
-
-procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
----------------------------------------------------------------------------
-
-Puts the bookmarkdata for Buffer into the area pointed to by Data.
-
-function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
---------------------------------------------------------------------------
-
-Returns the bookmarkflag associated with Buffer.
-
-function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
-----------------------------------------------------------------------------------
-
-Puts the data for field Field from the active buffer into Buffer. 
-This is called whenever a field value is demanded, so it must be
-efficient. 
-
-function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
------------------------------------------------------------------------------------
-
-This method must do 3 things:
-1) Get the record data for the next/current/previous record, depending
-   on the GetMode value. It should return 
-    grOK    if all was OK.
-    grBOF   if the previous record was requested, and we are at the start. 
-    grEOF   if the next record was requested, and we are at the end.
-    grError if an error occurred.
-   
-2) If DoCheck is True, and the result is grError, then an exception must be
-    raised.
-
-3) It should initialize bookmark data for this record with flag 'bfCurrent'
-   This data can be stored in the bufer, if space was allocated for it with
-   AllocRecordBuffer.
- 
-function GetRecordSize: Word; virtual; abstract;
-------------------------------------------------
-
-Should return the record size; this includes ONLY the data portion
-of teh buffer; it excludes any bookmark or housekeeping info you may
-have put in the buffer.
-
-procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
----------------------------------------------------------------------------------
-
-Adds a record to the dataset. The record's data is in Buffer and Append
-indicates whether the record should be appended (True) or Inserted (False).
-Note that for SQL based datasets, this has no meaning.
-
-procedure InternalClose; virtual; abstract;
--------------------------------------------
-
-Closes the dataset. Any resources allocated in InternalOpen should be freed
-here.
-
-procedure InternalDelete; virtual; abstract;
---------------------------------------------
-
-Deletes the current Record.
-
-procedure InternalFirst; virtual; abstract;
--------------------------------------------
-
-This is called when 'First' is called; After this method, getrecord
-should return 'grBOF' if the previous record is requested, and it should
-return the next record if the next record is requested.
-
-procedure InternalGotoBookmark(ABookmark: Pointer); virtual; abstract;
-----------------------------------------------------------------------
-
-Set the record position on the position that is associated with the
-ABookMark data. The ABookMark data is the data that is acquired through
-the GetBookMarkData call, and should be kept for each record.
-
-procedure InternalHandleException; virtual; abstract;
------------------------------------------------------
-
-Not needed yet. Just implement an empty call.
-
-procedure InternalInitFieldDefs; virtual; abstract;
----------------------------------------------------
-
-This method should be called from InternalOpen, and should
-initialize FieldDef definitions for all fields in a record.
-It should add these definitions to the FFielddefs object.
-
-
-procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
----------------------------------------------------------------
-
-This method is called to initialize a field buffer when the dataset
-is put into edit or append mode. Mostly,you'll want to zero out the 
-buffer.
-
-procedure InternalLast; virtual; abstract;
-------------------------------------------
-
-This is called when 'Last' is called; After this method, getrecord
-should return 'grEOF' if the next record is requested, and it should
-return the last record if the previous record is requested.
-
-procedure InternalOpen; virtual; abstract;
-------------------------------------------
-
-Open the dataset. You must call internalinitfielddefs; 
-if DefaultFields is True, then you must call CreateFields,
-which will create the necessary TFields from the fielddefs.
-
-procedure InternalPost; virtual; abstract;
-------------------------------------------
-
-Post the data in the active buffer to the underlying dataset.
-
-procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
-----------------------------------------------------------------
-
-Set the current record to the record in Buffer; if bookmark data 
-is specified in this buffer, that data can be used to determine which 
-record this should be.
-
-function IsCursorOpen: Boolean; virtual; abstract;
---------------------------------------------------
-
-This function should return True if data is available, even if the dataset
-is not active.
-
-procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
-----------------------------------------------------------------------------------
-
-Set the bookmarkflag 'Value' on the data in Buffer.
-
-procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
----------------------------------------------------------------------------
-
-Move the bookmarkdata in 'Data' to the bookmarkdata associated with Buffer
-
-procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
---------------------------------------------------------------------------
-
-Move the data in associated with Field from Buffer to the activebuffer.
-
-=================
-Scalable datasets
-=================
-
-In order to have Scalable database access, the concept of TDatabase and
-TDBDataset is introduced. The idea is that, in a visual IDE, the change
-from one database to another is achieved by simply removing one TDatabase
-descendent (Say, TMySqlDatabase) with another (Say, TPostGreSQLDatabase)
-and that the Datasets remain untouched.
-
-In order to make this possible, the following scheme is used:
-
-when a TDBdataset descendant is put on Active, it requests a TRecordSet
-from the TDatabase. The TRecordSet is an abstract object that should be
-implemented together with each database. The TDBDataset then uses the
-TRecordSet to navigate through the records and edit/add/modify them.
-The TDBdataset implements the abstract methods of Tdataset in order to
-achive this.
-
-There will be 2 descendants of TDBdataset: TTable and TQuery; both will
-implement the last abstract methods of TDataset in order to achieve a
-complete TDataset implementation.
-
-TDBDataset implements most of the initialization of fields, so the
-implementation of TRecordSet will be as bare bones as possible.
-
-What is needed:
----------------
-
-Some properties describing the data:
-
-FieldCount : Number of fields in a record;
-FieldTypes[Index] : Types of the fields (TFieldType), zero based.
-FieldNames[Index] : Names of the fields. Zero based.
-FieldSizes[index] : Size of the fields, zero based.
-BookmarkSize        : Size of a bookmark.
-
-Some properties with the data content:
-
-FieldBuffers[Index] : Buffers containing the actual data of the current record.
-                      (Nil if the field is empty)
-                      This data should be of size indicated FieldSizes, and 
-                      in a format that matches the fieldtype.
-BookMarkBuffer      : Buffer with the current bookmark.
-
-Some methods
-------------
-
-
-OpenRecordSet : Opens the recordset; it should initialize the FieldCount 
-                and FieldTypes, FieldNames, and FieldSizes array data.
-
-CloseRecordSet : Do whatever is needed to close the recordset.
-
-GotoBookMark : go to the record described by the bookmark. Returns True
-               if successfull, false if not.
-
-Next  : Goto the next record. Returns true or false 
-Prior : Goto previous record. Returns true or false
-First : Goto the first record. Returns True or false
-Last  : Goto the last record. Returns True or False
-
-AppendBuffer : Append a buffer to the records.

fcl/db/Makefile

@@ -1,1077 +0,0 @@
-#
-# Makefile generated by fpcmake v0.99.13 on 1999-12-24 16:08
-#
-
-defaultrule: all
-
-#####################################################################
-# Autodetect OS (Linux or Dos or Windows NT)
-# define inlinux when running under linux
-# define inWinNT when running under WinNT
-#####################################################################
-
-# We need only / in the path
-override PATH:=$(subst \,/,$(PATH))
-
-# Search for PWD and determine also if we are under linux
-PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
-ifeq ($(PWD),)
-PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
-ifeq ($(PWD),)
-nopwd:
-	@echo You need the GNU utils package to use this Makefile!
-	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
-	@exit
-else
-inlinux=1
-endif
-else
-PWD:=$(firstword $(PWD))
-endif
-
-# Detect NT - NT sets OS to Windows_NT
-ifndef inlinux
-ifeq ($(OS),Windows_NT)
-inWinNT=1
-endif
-endif
-
-# Detect OS/2 - OS/2 has OS2_SHELL defined
-ifndef inlinux
-ifndef inWinNT
-ifdef OS2_SHELL
-inOS2=1
-endif
-endif
-endif
-
-# The extension of executables
-ifdef inlinux
-EXEEXT=
-else
-EXEEXT=.exe
-endif
-
-# The path which is search separated by spaces
-ifdef inlinux
-SEARCHPATH=$(subst :, ,$(PATH))
-else
-SEARCHPATH=$(subst ;, ,$(PATH))
-endif
-
-#####################################################################
-# Default target
-#####################################################################
-
-override CPU_TARGET:=i386
-
-#####################################################################
-# FPC version/target Detection
-#####################################################################
-
-# What compiler to use ?
-ifndef FPC
-# Compatibility with old makefiles
-ifdef PP
-FPC=$(PP)
-else
-ifdef inOS2
-FPC=ppos2$(EXEEXT)
-else
-FPC=ppc386$(EXEEXT)
-endif
-endif
-endif
-
-# Target OS
-ifndef OS_TARGET
-OS_TARGET:=$(shell $(FPC) -iTO)
-endif
-
-# Source OS
-ifndef OS_SOURCE
-OS_SOURCE:=$(shell $(FPC) -iSO)
-endif
-
-# Target CPU
-ifndef CPU_TARGET
-CPU_TARGET:=$(shell $(FPC) -iTP)
-endif
-
-# Source CPU
-ifndef CPU_SOURCE
-CPU_SOURCE:=$(shell $(FPC) -iSP)
-endif
-
-# FPC version
-ifndef FPC_VERSION
-FPC_VERSION:=$(shell $(FPC) -iV)
-endif
-
-export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
-
-#####################################################################
-# Default Settings
-#####################################################################
-
-# Release ? Then force OPT and don't use extra opts via commandline
-ifndef REDIRFILE
-REDIRFILE=log
-endif
-
-ifdef RELEASE
-override OPT:=-Xs -OG2p3 -n
-endif
-
-# Verbose settings (warning,note,info)
-ifdef VERBOSE
-override OPT+=-vwni
-endif
-
-ifdef REDIR
-ifndef inlinux
-override FPC=redir -eo $(FPC)
-endif
-# set the verbosity to max
-override OPT+=-va
-override REDIR:= >> $(REDIRFILE)
-endif
-
-#####################################################################
-# User Settings
-#####################################################################
-
-
-# Targets
-
-override UNITOBJECTS+=db ddg_ds ddg_rec mysqldb
-override EXAMPLEOBJECTS+=testds createds mtest tested
-
-# Clean
-
-
-# Install
-
-ZIPTARGET=install
-
-# Defaults
-
-override NEEDOPT=-S2
-
-# Directories
-
-ifndef FPCDIR
-FPCDIR=../..
-endif
-ifndef PACKAGEDIR
-PACKAGEDIR=$(FPCDIR)/packages
-endif
-ifndef COMPONENTDIR
-COMPONENTDIR=$(FPCDIR)/components
-endif
-ifndef TARGETDIR
-TARGETDIR=.
-endif
-
-# Packages
-
-override PACKAGES+=mysql
-override NEEDUNITDIR+=$(FPCDIR)/fcl/$(OS_TARGET)
-ifneq ($(wildcard $(PACKAGEDIR)/mysql/$(OS_TARGET)),)
-override NEEDUNITDIR+=$(PACKAGEDIR)/mysql/$(OS_TARGET)
-else
-override NEEDUNITDIR+=$(PACKAGEDIR)/mysql
-endif
-
-# Libraries
-
-override NEEDGCCLIB=1
-
-# Info
-
-INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall 
-
-#####################################################################
-# Default Directories
-#####################################################################
-
-# Base dir
-ifdef PWD
-BASEDIR:=$(shell $(PWD))
-else
-BASEDIR=.
-endif
-
-# this can be set to 'rtl' when the RTL units are installed
-ifndef UNITPREFIX
-UNITPREFIX=units
-endif
-
-# set the prefix directory where to install everything
-ifndef PREFIXINSTALLDIR
-ifdef inlinux
-PREFIXINSTALLDIR=/usr
-else
-PREFIXINSTALLDIR=/pp
-endif
-endif
-export PREFIXINSTALLDIR
-
-# create fcldir,rtldir,unitdir
-ifdef FPCDIR
-override FPCDIR:=$(subst \,/,$(FPCDIR))
-ifneq ($(FPCDIR),.)
-override RTLDIR=$(FPCDIR)/rtl/$(OS_TARGET)
-override FCLDIR=$(FPCDIR)/fcl/$(OS_TARGET)
-override UNITSDIR=$(FPCDIR)/units/$(OS_TARGET)
-endif
-endif
-
-# On linux, try to find where libgcc.a is.
-ifdef inlinux
-ifndef GCCLIBDIR
-GCCLIBDIR:=$(shell dirname `(gcc -v 2>&1)| head -n 1| awk '{ print $$4 } '`)
-endif
-endif
-export GCCLIBDIR
-
-#####################################################################
-# Install Directories
-#####################################################################
-
-# set the base directory where to install everything
-ifndef BASEINSTALLDIR
-ifdef inlinux
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION)
-else
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)
-endif
-endif
-
-# set the directory where to install the binaries
-ifndef BININSTALLDIR
-ifdef inlinux
-BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
-else
-BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
-endif
-endif
-
-# set the directory where to install the units.
-ifndef UNITINSTALLDIR
-UNITINSTALLDIR=$(BASEINSTALLDIR)/$(UNITPREFIX)/$(OS_TARGET)
-endif
-
-# Where to install shared libraries
-ifndef LIBINSTALLDIR
-ifdef inlinux
-LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
-else
-LIBINSTALLDIR=$(UNITINSTALLDIR)
-endif
-endif
-
-# Where the source files will be stored
-ifndef SOURCEINSTALLDIR
-ifdef inlinux
-SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION)
-else
-SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source
-endif
-endif
-
-# Where the doc files will be stored
-ifndef DOCINSTALLDIR
-ifdef inlinux
-DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc/$(FPC_VERSION)
-else
-DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
-endif
-endif
-
-# Where the some extra (data)files will be stored
-ifndef EXTRAINSTALLDIR
-EXTRAINSTALLDIR=$(BASEINSTALLDIR)
-endif
-
-
-#####################################################################
-# Compiler Command Line
-#####################################################################
-
-# Load commandline OPTDEF and add FPC_CPU define
-override FPCOPTDEF:=-d$(CPU_TARGET)
-
-# Load commandline OPT and add target and unit dir to be sure
-ifneq ($(OS_TARGET),$(OS_SOURCE))
-override FPCOPT+=-T$(OS_TARGET)
-endif
-
-ifdef NEEDOPT
-override FPCOPT+=$(NEEDOPT)
-endif
-
-ifdef RTLDIR
-override FPCOPT+=-Fu$(RTLDIR)
-endif
-
-ifdef UNITSDIR
-override FPCOPT+=-Fu$(UNITSDIR)
-endif
-
-ifdef NEEDUNITDIR
-override FPCOPT+=$(addprefix -Fu,$(NEEDUNITDIR))
-endif
-
-# Add GCC lib path if asked
-ifdef GCCLIBDIR
-override FPCOPT+=-Fl$(GCCLIBDIR)
-endif
-
-# Target dirs
-ifdef TARGETDIR
-override FPCOPT+=-FE$(TARGETDIR)
-endif
-
-# Smartlinking
-ifdef SMARTLINK
-override FPCOPT+=-CX
-endif
-
-# Debug
-ifdef DEBUG
-override FPCOPT+=-g
-endif
-
-# Add commandline options
-ifdef OPT
-override FPCOPT+=$(OPT)
-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
-
-# Add defines from FPCOPTDEF to FPCOPT
-ifdef FPCOPTDEF
-override FPCOPT+=$(FPCOPTDEF)
-endif
-
-# Error file ?
-ifdef ERRORFILE
-override FPCOPT+=-Fr$(ERRORFILE)
-endif
-
-# Was a config file specified ?
-ifdef CFGFILE
-override FPCOPT+=@$(CFGFILE)
-endif
-
-# For win32 the options are passed using the environment variable FPCEXTCMD
-ifeq ($(OS_SOURCE),win32)
-override FPCEXTCMD:=$(FPCOPT)
-override FPCOPT:=!FPCEXTCMD
-export FPCEXTCMD
-endif
-
-# Compiler commandline
-override COMPILER:=$(FPC) $(FPCOPT)
-
-#####################################################################
-# Shell tools
-#####################################################################
-
-# To copy pograms
-ifndef COPY
-COPY:=cp -fp
-endif
-
-# Copy a whole tree
-ifndef COPYTREE
-COPYTREE:=cp -rfp
-endif
-
-# To move pograms
-ifndef MOVE
-MOVE:=mv -f
-endif
-
-# Check delete program
-ifndef DEL
-DEL:=rm -f
-endif
-
-# Check deltree program
-ifndef DELTREE
-DELTREE:=rm -rf
-endif
-
-# To install files
-ifndef INSTALL
-ifdef inlinux
-INSTALL:=install -m 644
-else
-INSTALL:=$(COPY)
-endif
-endif
-
-# To install programs
-ifndef INSTALLEXE
-ifdef inlinux
-INSTALLEXE:=install -m 755
-else
-INSTALLEXE:=$(COPY)
-endif
-endif
-
-# To make a directory.
-ifndef MKDIR
-ifdef inlinux
-MKDIR:=install -m 755 -d
-else
-MKDIR:=ginstall -m 755 -d
-endif
-endif
-
-export COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
-
-#####################################################################
-# Default Tools
-#####################################################################
-
-# assembler, redefine it if cross compiling
-ifndef AS
-AS=as
-endif
-
-# linker, but probably not used
-ifndef LD
-LD=ld
-endif
-
-# ppas.bat / ppas.sh
-ifdef inlinux
-PPAS=ppas.sh
-else
-ifdef inOS2
-PPAS=ppas.cmd
-else
-PPAS=ppas.bat
-endif
-endif
-
-# also call ppas if with command option -s
-ifeq (,$(findstring -s ,$(COMPILER)))
-EXECPPAS=
-else
-EXECPPAS:=@$(PPAS)
-endif
-
-# ldconfig to rebuild .so cache
-ifdef inlinux
-LDCONFIG=ldconfig
-else
-LDCONFIG=
-endif
-
-# echo
-ifndef ECHO
-ECHO:=$(strip $(wildcard $(addsuffix /echo$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO:=echo
-else
-ECHO:=$(firstword $(ECHO))
-endif
-endif
-export ECHO
-
-# ppdep
-ifndef PPDEP
-PPDEP:=$(strip $(wildcard $(addsuffix /ppdep$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPDEP),)
-PPDEP=
-else
-PPDEP:=$(firstword $(PPDEP))
-endif
-endif
-export PPDEP
-
-# ppumove
-ifndef PPUMOVE
-PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUMOVE),)
-PPUMOVE=
-else
-PPUMOVE:=$(firstword $(PPUMOVE))
-endif
-endif
-export PPUMOVE
-
-# ppufiles
-ifndef PPUFILES
-PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUFILES),)
-PPUFILES=
-else
-PPUFILES:=$(firstword $(PPUFILES))
-endif
-endif
-export PPUFILES
-
-# Look if UPX is found for go32v2 and win32. We can't use $UPX becuase
-# upx uses that one itself (PFV)
-ifndef UPXPROG
-ifeq ($(OS_TARGET),go32v2)
-UPXPROG:=1
-endif
-ifeq ($(OS_TARGET),win32)
-UPXPROG:=1
-endif
-ifdef UPXPROG
-UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(UPXPROG),)
-UPXPROG=
-else
-UPXPROG:=$(firstword $(UPXPROG))
-endif
-else
-UPXPROG=
-endif
-endif
-export UPXPROG
-
-# gdate/date
-ifndef DATE
-DATE:=$(strip $(wildcard $(addsuffix /date$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(DATE),)
-DATE:=$(strip $(wildcard $(addsuffix /gdate$(EXEEXT),$(SEACHPATH))))
-ifeq ($(DATE),)
-DATE=
-else
-DATE:=$(firstword $(DATE))
-endif
-else
-DATE:=$(firstword $(DATE))
-endif
-endif
-export DATE
-
-ifdef DATE
-DATESTR:=$(shell $(DATE) +%Y%m%d)
-else
-DATESTR=
-endif
-
-# ZipProg, you can't use Zip as the var name (PFV)
-ifndef ZIPPROG
-ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ZIPPROG),)
-ZIPPROG=
-else
-ZIPPROG:=$(firstword $(ZIPPROG)) -D9 -r
-endif
-endif
-export ZIPPROG
-
-ifndef ZIPEXT
-ZIPEXT=.zip
-endif
-
-#####################################################################
-# Default extensions
-#####################################################################
-
-# Default needed extensions (Go32v2,Linux)
-LOADEREXT=.as
-PPLEXT=.ppl
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.so
-PACKAGESUFFIX=
-FPCMADE=fpcmade
-
-# Go32v1
-ifeq ($(OS_TARGET),go32v1)
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-STATICLIBEXT=.a1
-SHAREDLIBEXT=.so1
-PACKAGESUFFIX=v1
-FPCMADE=fpcmade.v1
-endif
-
-# Go32v2
-ifeq ($(OS_TARGET),go32v2)
-PACKAGESUFFIX=go32
-FPCMADE=fpcmade.dos
-endif
-
-# Linux
-ifeq ($(OS_TARGET),linux)
-PACKAGESUFFIX=linux
-FPCMADE=fpcmade.lnx
-endif
-
-# Win32
-ifeq ($(OS_TARGET),win32)
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=win32
-FPCMADE=fpcmade.w32
-endif
-
-# OS/2
-ifeq ($(OS_TARGET),os2)
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-SMARTEXT=.so
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=os2
-FPCMADE=fpcmade.os2
-endif
-
-# library prefix
-LIBPREFIX=lib
-ifeq ($(OS_TARGET),go32v2)
-LIBPREFIX=
-endif
-ifeq ($(OS_TARGET),go32v1)
-LIBPREFIX=
-endif
-
-# determine which .pas extension is used
-ifndef PASEXT
-ifdef EXEOBJECTS
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
-else
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
-endif
-ifeq ($(TESTPAS),)
-PASEXT=.pp
-else
-PASEXT=.pas
-endif
-endif
-
-#####################################################################
-# Standard rules
-#####################################################################
-
-all: fpc_all
-
-debug: fpc_debug
-
-examples: fpc_examples
-
-test: fpc_test
-
-smart: fpc_smart
-
-shared: fpc_shared
-
-showinstall: fpc_showinstall
-
-install: fpc_install
-
-sourceinstall: fpc_sourceinstall
-
-zipinstall: fpc_zipinstall
-
-zipinstalladd: fpc_zipinstalladd
-
-clean: fpc_clean
-
-cleanall: fpc_cleanall
-
-info: fpc_info
-
-.PHONY:  all debug examples test smart shared showinstall install sourceinstall zipinstall zipinstalladd clean cleanall info
-
-#####################################################################
-# Package depends
-#####################################################################
-
-ifneq ($(wildcard $(RTLDIR)),)
-ifeq ($(wildcard $(RTLDIR)/$(FPCMADE)),)
-override COMPILEPACKAGES+=rtl
-rtl_package:
-	$(MAKE) -C $(RTLDIR) all
-endif
-endif
-ifneq ($(wildcard $(FCLDIR)),)
-ifeq ($(wildcard $(FCLDIR)/$(FPCMADE)),)
-override COMPILEPACKAGES+=fcl
-fcl_package:
-	$(MAKE) -C $(FCLDIR) all
-endif
-endif
-
-PACKAGEMYSQL=1
-ifdef PACKAGEMYSQL
-ifneq ($(wildcard $(PACKAGEDIR)/mysql),)
-ifeq ($(wildcard $(PACKAGEDIR)/mysql/$(FPCMADE)),)
-override COMPILEPACKAGES+=mysql
-mysql_package:
-	$(MAKE) -C $(PACKAGEDIR)/mysql all
-endif
-endif
-endif
-
-.PHONY:  rtl_package fcl_package mysql_package
-
-#####################################################################
-# Units
-#####################################################################
-
-.PHONY: fpc_units
-
-override ALLTARGET+=fpc_units
-
-override UNITPPUFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS))
-override INSTALLPPUFILES+=$(UNITPPUFILES)
-override CLEANPPUFILES+=$(UNITPPUFILES)
-
-fpc_units: $(UNITPPUFILES)
-
-#####################################################################
-# Examples
-#####################################################################
-
-.PHONY: fpc_examples fpc_test
-
-override EXAMPLEFILES:=$(addsuffix $(EXEEXT),$(EXAMPLEOBJECTS))
-override EXAMPLEOFILES:=$(addsuffix $(OEXT),$(EXAMPLEOBJECTS))
-
-override CLEANEXEFILES+=$(EXAMPLEFILES) $(EXAMPLEOFILES)
-
-fpc_examples: all $(EXAMPLEFILES)
-
-fpc_test: examples
-
-#####################################################################
-# General compile rules
-#####################################################################
-
-.PHONY: fpc_all fpc_debug
-
-$(FPCMADE):
-	@$(ECHO) Compiled > $(FPCMADE)
-
-fpc_all: $(addsuffix _package,$(COMPILEPACKAGES)) \
-	 $(addsuffix _component,$(COMPILECOMPONENTS)) \
-	 $(ALLTARGET) $(FPCMADE)
-
-fpc_debug:
-	$(MAKE) all DEBUG=1
-
-# General compile rules, available for both possible PASEXT
-
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
-
-%$(PPUEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(PPUEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-#####################################################################
-# Library
-#####################################################################
-
-.PHONY: fpc_smart fpc_shared
-
-# Default sharedlib units are all unit objects
-ifndef SHAREDLIBUNITOBJECTS
-SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
-endif
-
-fpc_smart:
-	$(MAKE) all SMARTLINK=1
-
-fpc_shared: all
-ifdef inlinux
-ifndef LIBNAME
-	@$(ECHO) "LIBNAME not set"
-else
-	$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
-endif
-else
-	@$(ECHO) "Shared Libraries not supported"
-endif
-
-#####################################################################
-# Install rules
-#####################################################################
-
-.PHONY: fpc_showinstall fpc_install
-
-ifdef EXTRAINSTALLUNITS
-override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))
-endif
-
-ifdef INSTALLPPUFILES
-ifdef PPUFILES
-ifdef inlinux
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
-INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
-else
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
-endif
-else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
-endif
-endif
-
-fpc_showinstall: $(SHOWINSTALLTARGET)
-ifdef INSTALLEXEFILES
-	@$(ECHO) -e $(addprefix "\n"$(BININSTALLDIR)/,$(INSTALLEXEFILES))
-endif
-ifdef INSTALLPPUFILES
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPUFILES))
-ifneq ($(INSTALLPPULINKFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	@$(ECHO) -e $(addprefix "\n"$(EXTRAINSTALLDIR)/,$(EXTRAINSTALLFILES))
-endif
-
-fpc_install: $(INSTALLTARGET)
-# Create UnitInstallFiles
-ifdef INSTALLEXEFILES
-	$(MKDIR) $(BININSTALLDIR)
-# Compress the exes if upx is defined
-ifdef UPXPROG
-	-$(UPXPROG) $(INSTALLEXEFILES)
-endif
-	$(INSTALLEXE) $(INSTALLEXEFILES) $(BININSTALLDIR)
-endif
-ifdef INSTALLPPUFILES
-	$(MKDIR) $(UNITINSTALLDIR)
-	$(INSTALL) $(INSTALLPPUFILES) $(UNITINSTALLDIR)
-ifneq ($(INSTALLPPULINKFILES),)
-	$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	$(MKDIR) $(LIBINSTALLDIR)
-	$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	$(MKDIR) $(EXTRAINSTALLDIR)
-	$(INSTALL) $(EXTRAINSTALLFILES) $(EXTRAINSTALLDIR)
-endif
-
-#####################################################################
-# Source install rules
-#####################################################################
-
-.PHONY: fpc_sourceinstall
-
-fpc_sourceinstall: clean
-	$(MKDIR) $(SOURCEINSTALLDIR)
-	$(COPYTREE) $(BASEDIR) $(SOURCEINSTALLDIR)
-
-#####################################################################
-# Zip
-#####################################################################
-
-.PHONY: fpc_zipinstall fpc_zipinstalladd
-
-# Temporary path to pack a file
-ifndef PACKDIR
-ifndef inlinux
-PACKDIR=pack_tmp
-else
-PACKDIR=/tmp/fpc-pack
-endif
-endif
-
-# Test dir if none specified
-ifndef DESTZIPDIR
-DESTZIPDIR:=$(BASEDIR)
-endif
-
-# Add .zip/.tar.gz extension
-ifdef ZIPNAME
-ifndef inlinux
-override ZIPNAME:=$(ZIPNAME)$(ZIPEXT)
-endif
-endif
-
-# Note: This will not remove the zipfile first
-fpc_zipinstalladd:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	gzip -d $(DESTZIPDIR)/$(ZIPNAME).tar.gz
-	cd $(PACKDIR) ; tar rv --file $(DESTZIPDIR)/$(ZIPNAME).tar * ; cd $(BASEDIR)
-	gzip $(DESTZIPDIR)/$(ZIPNAME).tar
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-# First remove the zip and then install
-fpc_zipinstall:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	cd $(PACKDIR) ; tar cvz --file $(DESTZIPDIR)/$(ZIPNAME).tar.gz * ; cd $(BASEDIR)
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-#####################################################################
-# Clean rules
-#####################################################################
-
-.PHONY: fpc_clean fpc_cleanall
-
-ifdef EXTRACLEANUNITS
-override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS))
-endif
-
-ifdef CLEANPPUFILES
-ifdef PPUFILES
-CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
-else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
-endif
-endif
-
-fpc_clean: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-ifdef CLEANPPUFILES
-	-$(DEL) $(CLEANPPUFILES)
-endif
-ifneq ($(CLEANPPULINKFILES),)
-	-$(DEL) $(CLEANPPULINKFILES)
-endif
-ifdef EXTRACLEANFILES
-	-$(DEL) $(EXTRACLEANFILES)
-endif
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-fpc_cleanall: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-	-$(DELTREE) *$(SMARTEXT)
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-#####################################################################
-# Info rules
-#####################################################################
-
-.PHONY: fpc_info fpc_cfginfo fpc_objectinfo fpc_toolsinfo fpc_installinfo \
-	fpc_dirinfo
-
-fpc_info: $(INFOTARGET)
-
-fpc_infocfg:
-	@$(ECHO)
-	@$(ECHO)  == Configuration info ==
-	@$(ECHO)
-	@$(ECHO)  FPC....... $(FPC)
-	@$(ECHO)  Version... $(FPC_VERSION)
-	@$(ECHO)  CPU....... $(CPU_TARGET)
-	@$(ECHO)  Source.... $(OS_SOURCE)
-	@$(ECHO)  Target.... $(OS_TARGET)
-	@$(ECHO)
-
-fpc_infoobjects:
-	@$(ECHO)
-	@$(ECHO)  == Object info ==
-	@$(ECHO)
-	@$(ECHO)  LoaderObjects..... $(LOADEROBJECTS)
-	@$(ECHO)  UnitObjects....... $(UNITOBJECTS)
-	@$(ECHO)  ExeObjects........ $(EXEOBJECTS)
-	@$(ECHO)
-	@$(ECHO)  ExtraCleanUnits... $(EXTRACLEANUNITS)
-	@$(ECHO)  ExtraCleanFiles... $(EXTRACLEANFILES)
-	@$(ECHO)
-	@$(ECHO)  ExtraInstallUnits. $(EXTRAINSTALLUNITS)
-	@$(ECHO)  ExtraInstallFiles. $(EXTRAINSTALLFILES)
-	@$(ECHO)
-
-fpc_infoinstall:
-	@$(ECHO)
-	@$(ECHO)  == Install info ==
-	@$(ECHO)
-ifdef DATE
-	@$(ECHO)  DateStr.............. $(DATESTR)
-endif
-	@$(ECHO)  PackageSuffix........ $(PACKAGESUFFIX)
-	@$(ECHO)
-	@$(ECHO)  BaseInstallDir....... $(BASEINSTALLDIR)
-	@$(ECHO)  BinInstallDir........ $(BININSTALLDIR)
-	@$(ECHO)  LibInstallDir........ $(LIBINSTALLDIR)
-	@$(ECHO)  UnitInstallDir....... $(UNITINSTALLDIR)
-	@$(ECHO)  SourceInstallDir..... $(SOURCEINSTALLDIR)
-	@$(ECHO)  DocInstallDir........ $(DOCINSTALLDIR)
-	@$(ECHO)  ExtraInstallDir...... $(EXTRAINSTALLDIR)
-	@$(ECHO)
-
-#####################################################################
-# Users rules
-#####################################################################
-
-db$(PPUEXT): db.pp fields.inc dataset.inc dbs.inc
-
-ddg_ds$(PPUEXT): db$(PPUEXT) ddg_rec$(PPUEXT) ddg_ds$(PASEXT)
-
-testds$(EXEEXT): ddg_ds$(PPUEXT) testds$(PASEXT)
-
-tested$(EXEEXT): ddg_ds$(PPUEXT) tested$(PASEXT)
-
-createds$(EXEEXT): createds$(PASEXT) ddg_rec$(PPUEXT)
-
-mysqldb$(PPUEXT): db$(PPUEXT) mysqldb$(PASEXT)
-
-mtest$(EXEEXT): mysqldb$(PPUEXT) mtest$(PASEXT)

fcl/db/Makefile.fpc

@@ -1,38 +0,0 @@
-#
-#   Makefile.fpc for TDataSet for FCL
-#
-
-[targets]
-units=db ddg_ds ddg_rec mysqldb
-examples=testds createds mtest tested
-
-[packages]
-fcl=1
-packages=mysql 
-
-[dirs]
-fpcdir=../..
-targetdir=.
-
-[libs]
-libgcc=1
-
-[defaults]
-defaultcpu=i386
-defaultoptions=-S2
-
-
-[rules]
-db$(PPUEXT): db.pp fields.inc dataset.inc dbs.inc
-
-ddg_ds$(PPUEXT): db$(PPUEXT) ddg_rec$(PPUEXT) ddg_ds$(PASEXT)
-
-testds$(EXEEXT): ddg_ds$(PPUEXT) testds$(PASEXT)
-
-tested$(EXEEXT): ddg_ds$(PPUEXT) tested$(PASEXT)
-
-createds$(EXEEXT): createds$(PASEXT) ddg_rec$(PPUEXT)
-
-mysqldb$(PPUEXT): db$(PPUEXT) mysqldb$(PASEXT)
-
-mtest$(EXEEXT): mysqldb$(PPUEXT) mtest$(PASEXT)

fcl/db/README

@@ -1,57 +0,0 @@
-This is the Database directory of the Free Component Library.
-
-At the moment, there is a read/write implementation of TDataset.
-The blob support is not tested yet.
-
-Compiling the units:
-
-Just run 'make all' and all should go fine, provided
-1) The mysql unit is in the compiler path (the makefile will try to compile
-   it in the packages mysql subdirectory)
-2) the mysqlclient library is in /usr/lib (if you want to compile the mtest 
-   program)
-if these conditions are not satisfied, you should edit the makefile
-and add -Fl/path/to/libmysqlclient to NEEDOPTS as well as
-the -Fu/path/to/mysql/unit option.
-
-Compiling the examples:
-
-If the units compile fine, then the examples can be compiled by doing
-'make examples'. see also the above remarks.
-
-there are 2 descendents of TDataset to demonstrate/test the 
-TDataset implementation.
-
-TddgDataset : 
-
-  Implemented in ddg_ds and ddg_rec. The dataset as
-  implemented in the Delphi 4 Developers Guide.
-  To test it, do a 
-   createds filename
-   testds filename
-   tested filename
-  the first creates a flat file, filled with 100 records;
-  the second tests the navigation methods of TDataset on this file.
-  the third tests the editing methods of TDataset (Append,Insert 
-  and edit)
-
-TMySQLdataset :
-  Implemented in mysqldb. You need the mysql units for this.
-  This is a temporary implementation based on the code from
-     Rangel Gustavo Reale ([email protected]) 
-  it will be used as a base for the DBdataset scalable dataset
-  implementation.
-  To test it, do a 
-     mtest db user pwd SQL
-  this will run the query SQL on the database db with user
-  'user' and password 'pwd', and dump the result. Take care
-  that you don't specify blob fields.
-  To test it on the table created by the mkdb shell script
-  that comes with the Free Pascal mysql unit, I did a
-      mtest test michael pwd 'select * from FPdev'
-
-I haven't implemented/tested blob fields yet.
-
-Enjoy !
-
-Michael.              

fcl/db/createds.pp

@@ -1,76 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999 by Michael Van Canneyt, member of the 
-    Free Pascal development team
-
-    Creates a flat datafile for use with testds.
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-program createds;
-
-{$mode delphi}
-
-uses ddg_rec,sysutils;
-
-Type IndexFile = File Of Longint;
-
-Var F : TDDGDataFile;
-    I : Integer;
-    S : String;
-    L : IndexFile;
-    TableName : String;
-    IndexName : String;
-    ARec : TDDGData;
-    
-begin
-  If ParamCount<>1 then
-    begin
-    Writeln('Usage: createds tablename');
-    Halt(1);
-    end;
-  TableName:=ChangeFileExt(paramstr(1),'.ddg');
-  IndexName:=ChangeFileExt(TableName,'.ddx');
-  Assign(F,TableName);
-  Rewrite(F);
-  For I:=1 to 100 do
-    begin
-    S:=Format('This is person %d.',[i]);
-    With Arec Do 
-      begin
-      Name:=S; 
-      height:=I*0.001;
-      LongField:=i*4;
-      ShoeSize:=I;
-      WordField:=i*2;
-      DateTimeField:=Now;
-      TimeField:=Time;
-      DateField:=Date;
-      Even:=(I mod 2) = 0
-      end;
-    Write(F,ARec);
-    end;
-  Close(F);
-  Assign(L,IndexName);
-  Rewrite(L);
-  For I:=0 to 100-1 do
-    Write(L,I);
-  Close(L);  
-end.
-{
-  $Log$
-  Revision 1.3  1999-11-11 17:31:09  michael
-  + Added Checks for all simple field types.
-  + Initial implementation of Insert/Append
-
-  Revision 1.2  1999/10/24 17:07:54  michael
-  + Added copyright header
-
-}

fcl/db/database.inc

@@ -1,181 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999 by Michael Van Canneyt, member of the 
-    Free Pascal development team
-
-    TDatabase and related objects implementation
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{ ---------------------------------------------------------------------
-    TDatabase
-  ---------------------------------------------------------------------}
-
-Procedure TDatabase.CheckConnected;
-
-begin
-  If Not Connected Then
-    DatabaseError(SNotConnected,Self);
-end;
-
-
-Procedure TDatabase.CheckDisConnected;
-begin
-  If Connected Then
-    DatabaseError(SConnected,Self);
-end;
-  
-procedure TDataBase.Loaded;
-
-begin
-  //!! To be implemented.
-end;
-
-procedure TDataBase.SetConnected (Value : boolean);
-
-begin
-  If Value<>FConnected then
-    begin
-    If Value then 
-      DoInternalConnect
-    else
-      begin
-      Closedatasets;
-      DoInternalDisConnect;
-      end;
-    FConnected:=Value;
-    end;
-end;
-
-
-procedure TDatabase.Notification(AComponent: TComponent; Operation: TOperation);
-
-begin
-  //!! To be implemented.
-end;
-
-constructor TDatabase.Create(AOwner: TComponent);
-
-begin
-  Inherited Create(AOwner);
-end;
-
-destructor TDatabase.Destroy;
-
-begin
-  Connected:=False;
-  RemoveDatasets;
-  FDatasets.Free;
-  Inherited Destroy;
-end;
-
-procedure TDatabase.Close;
-
-begin
-  Connected:=False;
-end;
-
-procedure TDatabase.CloseDataSets;
-
-Var I : longint;
-
-begin
-  If Assigned(FDatasets) then 
-    begin
-    For I:=FDatasets.Count-1 downto 0 do
-      TDBDataset(FDatasets[i]).Close;
-    end;
-end;
-
-procedure TDatabase.RemoveDataSets;
-
-Var I : longint;
-
-begin
-  If Assigned(FDatasets) then 
-    For I:=FDataSets.Count-1 downto 0 do
-      TDBDataset(FDataSets[i]).Database:=Nil;
-end;
-
-procedure TDatabase.Open;
-
-begin
-  Connected:=True;
-end;
-
-
-Function TDatabase.GetDataSetCount : Longint;
-
-begin
-  If Assigned(FDatasets) Then
-    Result:=FDatasets.Count
-  else
-    Result:=0;
-end;
-
-
-Function TDatabase.GetDataset(Index : longint) : TDBDataset;
-
-begin
-  If Assigned(FDatasets) then
-    Result:=TDBDataset(FDatasets[Index])
-  else
-    DatabaseError(SNoDatasets);
-end;
-
-procedure TDatabase.RegisterDataset (DS : TDBDataset);
-
-Var I : longint;
-
-begin
-  I:=FDatasets.IndexOf(DS);
-  If I=-1 then
-    FDatasets.Add(DS)
-  else
-    DatabaseErrorFmt(SDatasetRegistered,[DS.Name]);
-end;
-
-procedure TDatabase.UnRegisterDataset (DS : TDBDataset);
-
-Var I : longint;
-
-begin
-  I:=FDatasets.IndexOf(DS);
-  If I<>-1 then
-    FDatasets.Delete(I)
-  else
-    DatabaseErrorFmt(SNoDatasetRegistered,[DS.Name]);
-end;
-
-{ ---------------------------------------------------------------------
-    TDBdataset
-  ---------------------------------------------------------------------}
-
-Procedure TDBDataset.SetDatabase (Value : TDatabase);
-
-begin
-  CheckInactive;
-  If Value<>FDatabase then
-    begin
-    If Assigned(FDatabase) then
-      FDatabase.UnregisterDataset(Self);
-    If Value<>Nil Then
-      Value.RegisterDataset(Self);
-    FDatabase:=Value; 
-    end;
-end;  
-
-{
-  $Log$
-  Revision 1.2  1999-10-24 17:07:54  michael
-  + Added copyright header
-
-}

fcl/db/dataset.inc

@@ -1,1494 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999 by Michael Van Canneyt, member of the
-    Free Pascal development team
-
-    Dataset implementation
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-{ ---------------------------------------------------------------------
-    TDataSet
-  ---------------------------------------------------------------------}
-
-Const
-  DefaultBufferCount = 10;
-
-constructor TDataSet.Create(AOwner: TComponent);
-
-begin
-  Inherited Create(AOwner);
-  FFieldDefs:=TFieldDefs.Create(Self);
-  FFieldList:=TFields.Create(Self);
-end;
-
-
-
-destructor TDataSet.Destroy;
-
-begin
-  Active:=False;
-  FFieldDefs.Free;
-  FFieldList.Free;
-  Inherited Destroy;
-end;
-
-
-Procedure TDataset.ActivateBuffers;
-
-begin
-  FBOF:=False;
-  FEOF:=False;
-  FRecordCount:=1;
-  FActiveRecord:=0;
-end;
-
-Procedure TDataset.UpdateFieldDefs;
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.BindFields(Binding: Boolean);
-
-Var I : longint;
-
-begin
-  {
-     Here some magic will be needed later; for now just simply set
-     Just set fieldno from listindex...
-     Later we should take it from the fielddefs.
-  }
-  For I:=0 to FFieldList.Count-1 do
-    FFieldList[i].FFieldNo:=I;
-end;
-
-Function TDataset.BookmarkAvailable: Boolean;
-
-Const BookmarkStates = [dsBrowse,dsEdit,dsInsert];
-
-begin
-  Result:=(Not IsEmpty) and (State in BookmarkStates)
-          and (getBookMarkFlag(ActiveBuffer)=bfCurrent);
-end;
-
-Procedure TDataset.CalculateFields(Buffer: PChar);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.CheckActive;
-
-begin
-  If Not Active then
-    DataBaseError(SInactiveDataset);
-end;
-
-Procedure TDataset.CheckInactive;
-
-begin
-  If Active then
-    DataBaseError(SActiveDataset);
-end;
-
-Procedure TDataset.ClearBuffers;
-
-begin
-  FRecordCount:=0;
-  FactiveRecord:=0;
-  FCurrentRecord:=-1;
-  FBOF:=True;
-  FEOF:=True;
-end;
-
-Procedure TDataset.ClearCalcFields(Buffer: PChar);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.CloseBlob(Field: TField);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.CloseCursor;
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.CreateFields;
-
-Var I : longint;
-
-begin
-{$ifdef DSDebug}
-  Writeln ('Creating fields');
-{$endif}
-  For I:=0 to fielddefs.Count-1 do
-    With Fielddefs.Items[I] do
-      If DataType<>ftUnknown then
-        CreateField(self);
-end;
-
-Procedure TDataset.DataEvent(Event: TDataEvent; Info: Longint);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.DestroyFields;
-
-begin
-  FFieldList.Clear;
-end;
-
-Procedure TDataset.DoAfterCancel;
-
-begin
- If assigned(FAfterCancel) then
-   FAfterCancel(Self);
-end;
-
-Procedure TDataset.DoAfterClose;
-
-begin
- If assigned(FAfterClose) then
-   FAfterClose(Self);
-end;
-
-Procedure TDataset.DoAfterDelete;
-
-begin
- If assigned(FAfterDelete) then
-   FAfterDelete(Self);
-end;
-
-Procedure TDataset.DoAfterEdit;
-
-begin
- If assigned(FAfterEdit) then
-   FAfterEdit(Self);
-end;
-
-Procedure TDataset.DoAfterInsert;
-
-begin
- If assigned(FAfterInsert) then
-   FAfterInsert(Self);
-end;
-
-Procedure TDataset.DoAfterOpen;
-
-begin
- If assigned(FAfterOpen) then
-   FAfterOpen(Self);
-end;
-
-Procedure TDataset.DoAfterPost;
-
-begin
- If assigned(FAfterPost) then
-   FAfterPost(Self);
-end;
-
-Procedure TDataset.DoAfterScroll;
-
-begin
- If assigned(FAfterScroll) then
-   FAfterScroll(Self);
-end;
-
-Procedure TDataset.DoBeforeCancel;
-
-begin
- If assigned(FBeforeCancel) then
-   FBeforeCancel(Self);
-end;
-
-Procedure TDataset.DoBeforeClose;
-
-begin
- If assigned(FBeforeClose) then
-   FBeforeClose(Self);
-end;
-
-Procedure TDataset.DoBeforeDelete;
-
-begin
- If assigned(FBeforeDelete) then
-   FBeforeDelete(Self);
-end;
-
-Procedure TDataset.DoBeforeEdit;
-
-begin
- If assigned(FBeforeEdit) then
-   FBeforeEdit(Self);
-end;
-
-Procedure TDataset.DoBeforeInsert;
-
-begin
- If assigned(FBeforeInsert) then
-   FBeforeInsert(Self);
-end;
-
-Procedure TDataset.DoBeforeOpen;
-
-begin
- If assigned(FBeforeOpen) then
-   FBeforeOpen(Self);
-end;
-
-Procedure TDataset.DoBeforePost;
-
-begin
- If assigned(FBeforePost) then
-   FBeforePost(Self);
-end;
-
-Procedure TDataset.DoBeforeScroll;
-
-begin
- If assigned(FBeforeScroll) then
-   FBeforeScroll(Self);
-end;
-
-Procedure TDataset.DoInternalOpen;
-
-begin
-  FBufferCount:=0;
-  FDefaultFields:=FieldCount=0;
-  DoBeforeOpen;
-  Try
-    {$ifdef dsdebug}
-    Writeln ('Calling internal open');
-    {$endif}
-    InternalOpen;
-    FBOF:=True;
-    {$ifdef dsdebug}
-    Writeln ('Setting state to browse');
-    {$endif}
-    SetState(dsBrowse);
-    {$ifdef dsdebug}
-    Writeln ('Setting buffer size');
-    {$endif}
-    SetBufListSize(DefaultBufferCount);
-    {$ifdef dsdebug}
-    Writeln ('Getting next records');
-    {$endif}
-    GetNextRecords;
-    DoAfterOpen;
-    DoAfterScroll;
-  except
-    SetState(dsInactive);
-    DoInternalClose;
-    raise;
-  end;
-end;
-
-Function TDataset.RequiredBuffers : longint;
-{
-  If later some datasource requires more buffers (grids etc)
-  then it should be taken into account here...
-}
-
-begin
-  Result:=0;
-end;
-
-Procedure TDataset.DoInternalClose;
-
-begin
-  FreeFieldBuffers;
-  ClearBuffers;
-  SetState(dsInactive);
-  InternalClose;
-end;
-
-Procedure TDataset.DoOnCalcFields;
-
-begin
- If assigned(FOnCalcfields) then
-   FOnCalcFields(Self);
-end;
-
-Procedure TDataset.DoOnNewRecord;
-
-begin
- If assigned(FOnNewRecord) then
-   FOnNewRecord(Self);
-end;
-
-Function TDataset.FieldByNumber(FieldNo: Longint): TField;
-
-begin
-  Result:=FFieldList.FieldByNumber(FieldNo);
-end;
-
-Function TDataset.FindRecord(Restart, GoForward: Boolean): Boolean;
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.FreeFieldBuffers;
-
-Var I : longint;
-
-begin
-  For I:=0 to FFieldList.Count-1 do
-    FFieldList[i].FreeBuffers;
-end;
-
-Function TDataset.GetBookmarkStr: TBookmarkStr;
-
-begin
-  Result:='';
-  If BookMarkAvailable then
-    begin
-    SetLength(Result,FBookMarkSize);
-    GetBookMarkData(ActiveBuffer,Pointer(Result));
-    end
-end;
-
-Function TDataset.GetBuffer (Index : longint) : Pchar;
-
-begin
-  Result:=FBuffers[Index];
-end;
-
-Procedure TDataset.GetCalcFields(Buffer: PChar);
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.GetCanModify: Boolean;
-
-begin
-  Result:=True;
-end;
-
-Procedure TDataset.GetChildren(Proc: TGetChildProc; Root: TComponent);
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.GetField (Index : Longint) : TField;
-
-begin
-  Result:=FFIeldList[index];
-end;
-
-{
-  This is not yet allowed, FPC doesn't allow typed consts of Classes...
-
-Const
-  DefFieldClasses : Array [TFieldType] of TFieldClass =
-    ( { ftUnknown} Tfield,
-      { ftString} TStringField,
-      { ftSmallint} TLongIntField,
-      { ftInteger} TLongintField,
-      { ftWord} TLongintField,
-      { ftBoolean} TBooleanField,
-      { ftFloat} TFloatField,
-      { ftDate} TDateField,
-      { ftTime} TTimeField,
-      { ftDateTime} TDateTimeField,
-      { ftBytes} TBytesField,
-      { ftVarBytes} TVarBytesField,
-      { ftAutoInc} TAutoIncField,
-      { ftBlob} TBlobField,
-      { ftMemo} TMemoField,
-      { ftGraphic} TGraphicField,
-      { ftFmtMemo} TMemoField,
-      { ftParadoxOle} Nil,
-      { ftDBaseOle} Nil,
-      { ftTypedBinary} Nil,
-      { ftCursor} Nil
-    );
-}
-
-Function TDataset.GetFieldClass(FieldType: TFieldType): TFieldClass;
-
-begin
-  Case FieldType of
-     ftUnknown : Result:=Tfield;
-     ftString: Result := TStringField;
-     ftSmallint: Result := TSmallIntField;
-     ftInteger: Result := TLongintField;
-     ftWord: Result := TWordField;
-     ftBoolean: Result := TBooleanField;
-     ftFloat: Result := TFloatField;
-     ftDate: Result := TDateField;
-     ftTime: Result := TTimeField;
-     ftDateTime: Result := TDateTimeField;
-     ftBytes: Result := TBytesField;
-     ftVarBytes: Result := TVarBytesField;
-     ftAutoInc: Result := TAutoIncField;
-     ftBlob: Result := TBlobField;
-     ftMemo: Result := TMemoField;
-     ftGraphic: Result := TGraphicField;
-     ftFmtMemo: Result := TMemoField;
-     ftParadoxOle: Result := Nil;
-     ftDBaseOle: Result := Nil;
-     ftTypedBinary: Result := Nil;
-     ftCursor: Result := Nil;
-  end;
-end;
-
-Function TDataset.GetIsIndexField(Field: TField): Boolean;
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.GetNextRecord: Boolean;
-
-Var Shifted : Boolean;
-
-begin
-{$ifdef dsdebug}
-  Writeln ('Getting next record. Internal RecordCount : ',FRecordCount);
-{$endif}
-  Shifted:=FRecordCount=FBufferCount;
-  If Shifted then
-    begin
-    ShiftBuffers(0,1);
-    Dec(FRecordCount);
-    end;
-{$ifdef dsdebug}
-  Writeln ('Getting data into buffer : ',FRecordCount);
-{$endif}
-  Result:=GetRecord(FBuffers[FRecordCount],gmNext,True)=grOK;
-  If Result then
-    begin
-    If FRecordCount=0 then
-      ActivateBuffers
-    else
-      If FRecordCount<FBufferCount then
-        Inc(FRecordCount);
-    FCurrentRecord:=FRecordCount;
-    end
-  else
-    begin
-    if shifted then
-      begin
-      ShiftBuffers(0,-1);
-      inc(FRecordCount);
-      end;
-    CursorPosChanged;
-    end;
-{$ifdef dsdebug}
-  Writeln ('Result getting next record : ',Result);
-{$endif}
-end;
-
-Function TDataset.GetNextRecords: Longint;
-
-begin
-  Result:=0;
-{$ifdef dsdebug}
-  Writeln ('Getting next record(s), need :',FBufferCount);
-{$endif}
-  While (FRecordCount<FBufferCount) and GetNextRecord do
-    Inc(Result);
-{$ifdef dsdebug}
-  Writeln ('Result Getting next record(s), GOT :',RESULT);
-{$endif}
-end;
-
-Function TDataset.GetPriorRecord: Boolean;
-
-Var Shifted : boolean;
-
-begin
-{$ifdef dsdebug}
-  Writeln ('Getting previous record');
-{$endif}
-  Shifted:=FRecordCount>0;
-  If Shifted Then
-    begin
-    SetCurrentRecord(0);
-    ShiftBuffers(0,-1);
-    end;
-  Result:=GetRecord(FBuffers[0],gmPrior,True)=grOK;
-  If Result then
-    begin
-    If FRecordCount=0 then
-      ActivateBuffers
-    else
-      begin
-      If FrecordCount<FBufferCount then
-        Inc(FRecordCount);
-      end;
-    FCurrentRecord:=0;
-    end
-  else
-    begin
-    If Shifted then
-      begin
-      ShiftBuffers(0,1);
-      end;
-    CursorPosChanged;
-    end;
-end;
-
-Function TDataset.GetPriorRecords: Longint;
-
-begin
-  Result:=0;
-{$ifdef dsdebug}
-  Writeln ('Getting previous record(s), need :',FBufferCount);
-{$endif}
-  While (FRecordCount<FbufferCount) and GetPriorRecord do
-    Inc(Result);
-end;
-
-Function TDataset.GetRecNo: Longint;
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.GetRecordCount: Longint;
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.InitFieldDefs;
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.InitRecord(Buffer: PChar);
-
-begin
-  InternalInitRecord(Buffer);
-  ClearCalcFields(Buffer);
-end;
-
-Procedure TDataset.InternalCancel;
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.InternalEdit;
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.InternalRefresh;
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.Loaded;
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.OpenCursor(InfoQuery: Boolean);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.RefreshInternalCalcFields(Buffer: PChar);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.RestoreState(const Value: TDataSetState);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.SetActive (Value : Boolean);
-
-begin
-  If Value<>Factive then
-    If Value then
-      DoInternalOpen
-    else
-      DoInternalClose;
-  FActive:=Value;
-end;
-
-Procedure TDataset.SetBookmarkStr(const Value: TBookmarkStr);
-
-begin
-  GotoBookMark(Pointer(Value))
-end;
-
-Procedure TDataset.SetBufListSize(Value: Longint);
-
-Var I : longint;
-
-begin
-  If Value=FBufferCount Then exit;
-  I:=RequiredBuffers; // Save 1 call.
-  If Value<I Then
-    Value:=I;
-  If Value>FBufferCount then
-    begin
-   {$ifdef dsdebug}
-    Writeln ('Reallocating memory :',(Value+1)*SizeOf(PChar));
-   {$endif}
-    ReAllocMem(FBuffers,(Value+1)*SizeOf(PChar));
-   {$ifdef dsdebug}
-    Writeln ('Filling memory :',(Value-FBufferCount)*SizeOf(PChar));
-   {$endif}
-    FillChar(FBuffers[FBufferCount],(Value+1-FBufferCount)*SizeOF(Pchar),#0);
-   {$ifdef dsdebug}
-    Writeln ('Filled memory :');
-   {$endif}
-    Try
-     {$ifdef dsdebug}
-      Writeln ('Assigning buffers :',(Value+1)*SizeOf(PChar));
-     {$endif}
-      For I:=FBufferCount to Value do
-        FBuffers[i]:=AllocRecordBuffer;
-     {$ifdef dsdebug}
-      Writeln ('Assigned buffers :',(Value+1)*SizeOf(PChar));
-     {$endif}
-    except
-      I:=FBufferCount;
-      While (I<=Value) and (FBuffers[i]<>Nil) do
-        begin
-        FreeRecordBuffer(FBuffers[i]);
-        Inc(i);
-        end;
-      raise;
-    end;
-    end
-  else
-    begin
-    For I:=Value+1 to FBufferCount do
-      FreeRecordBuffer(FBuffers[i]);
-    ReAllocMem(FBuffers,Value*SizeOf(Pchar));
-    end;
-  FBufferCount:=Value;
-end;
-
-Procedure TDataset.SetChildOrder(Component: TComponent; Order: Longint);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.SetCurrentRecord(Index: Longint);
-
-begin
-  If FCurrentRecord<>Index then
-    begin
-    {$ifdef DSdebug}
-    Writeln ('Setting current record to',index);
-    {$endif}
-    Case GetBookMarkFlag(FBuffers[Index]) of
-      bfCurrent : InternalSetToRecord(FBuffers[Index]);
-      bfBOF : InternalFirst;
-      bfEOF : InternalLast;
-      end;
-    FCurrentRecord:=index;
-    end;
-end;
-
-Procedure TDataset.SetField (Index : Longint;Value : TField);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.SetFilterOptions(Value: TFilterOptions);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.SetFilterText(const Value: string);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.SetFiltered(Value: Boolean);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.SetFound(const Value: Boolean);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.SetModified(Value: Boolean);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.SetName(const Value: TComponentName);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.SetOnFilterRecord(const Value: TFilterRecordEvent);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.SetRecNo(Value: Longint);
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.SetState(Value: TDataSetState);
-
-begin
-  If Value<>FState then
-    begin
-    FState:=Value;
-    end;
-end;
-
-Function TDataset.SetTempState(const Value: TDataSetState): TDataSetState;
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.TempBuffer: PChar;
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.UpdateIndexDefs;
-
-begin
-  //!! To be implemented
-end;
-
-
-
-Function TDataset.ControlsDisabled: Boolean;
-
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.ActiveBuffer: PChar;
-
-
-begin
-{$ifdef dsdebug}
-//  Writeln ('Active buffer requested. Returning:',ActiveRecord);
-{$endif}
-  Result:=FBuffers[ActiveRecord];
-end;
-
-Procedure TDataset.Append;
-
-begin
-  DoInsertAppend(True);
-end;
-
-Procedure TDataset.AppendRecord(const Values: array of const);
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.BookmarkValid(ABookmark: TBookmark): Boolean;
-{
-  Should be overridden by descendant objects.
-}
-begin
-  Result:=False
-end;
-
-Procedure TDataset.Cancel;
-
-begin
-  If State in [dsEdit,dsInsert] then
-    begin
-    DoBeforeCancel;
-    UpdateCursorPos;
-    InternalCancel;
-    FreeFieldBuffers;
-    SetState(dsBrowse);
-    Resync([]);
-    DoAfterCancel;
-    end;
-end;
-
-Procedure TDataset.CheckBrowseMode;
-
-begin
-  CheckActive;
-  If State In [dsedit,dsinsert] then
-    begin
-    UpdateRecord;
-    If Modified then
-      Post
-    else
-      Cancel;
-    end;
-end;
-
-Procedure TDataset.ClearFields;
-
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.Close;
-
-begin
-  Active:=False;
-end;
-
-Function TDataset.CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint;
-
-begin
-  Result:=0;
-end;
-
-Function TDataset.CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream;
-
-
-begin
-  Result:=Nil;
-end;
-
-Procedure TDataset.CursorPosChanged;
-
-
-begin
-  FCurrentRecord:=-1;
-end;
-
-Procedure TDataset.Delete;
-
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.DisableControls;
-
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.DoInsertAppend(DoAppend : Boolean);
-
-Var Buffer : PChar;
-    BookBeforeInsert : TBookmarkStr;
-    
-begin
-  If Not CanModify then
-    DatabaseError(SDatasetReadOnly,Self);
-  CheckBrowseMode;
-  DoBeforeInsert;
-  DoBeforeScroll;
-  If Not DoAppend then 
-    begin
-    {$ifdef dsdebug}
-    Writeln ('going to insert mode');
-    {$endif}
-    // need to scroll up al buffers after current one,
-    // but copy current bookmark to insert buffer.
-    BookBeforeInsert:=Bookmark;
-    ShiftBuffers(1,FActiveRecord);
-    // Active buffer is now edit buffer. Initialize.
-    InitRecord(ActiveBuffer);
-    // Put bookmark in edit buffer.
-    if FRecordCount=0 then
-      SetBookmarkFlag(ActiveBuffer,bfBOF)
-    else
-      SetBookMarkData(ActiveBuffer,Pointer(BookBeforeInsert));
-    // update buffer count.
-    If FRecordCount<FBufferCount then 
-      Inc(FRecordCount);
-    end
-  else
-    // Tricky, need to get last record and scroll down.
-    begin
-    {$ifdef dsdebug}
-    Writeln ('going to append mode');
-    {$endif}
-    Buffer:=FBuffers[0];
-    InitRecord(Buffer);
-    // just mark buffer as last. GetPreviousrecords will do an internallast
-    // Because of this...
-    SetBookMarkFlag(Buffer,bfEOF);
-    FRecordCount:=1;
-    {$ifdef dsdebug}
-    Writeln ('getting prior records');
-    {$endif}
-    GetPriorRecords;
-    // update active record.
-    FactiveRecord:=FRecordCount-1;
-    end;
-  SetState(dsInsert);
-  try 
-    DoOnNewRecord;
-  except
-    UpdateCursorPos;
-    resync([]);
-    raise;
-  end;
-  // mark as not modified.
-  FModified:=False;
-  // Final events.
-  DoAfterInsert;
-  DoAfterScroll;
-  {$ifdef dsdebug}
-  Writeln ('Done with append');
-  {$endif}
-end;
-
-Procedure TDataset.Edit;
-
-begin
-  If Not CanModify then
-    DatabaseError(SDatasetReadOnly,Self);
-  If State in [dsedit,dsinsert] then exit;
-  If FRecordCount = 0 then
-    begin
-    Insert;
-    Exit;
-    end;
-  CheckBrowseMode;
-  DoBeforeEdit;
-  If Not TryDoing(@InternalEdit,OnEditError) then 
-    exit;
-  SetState(dsedit);
-  DoAfterEdit;
-end;
-
-Procedure TDataset.EnableControls;
-
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.FieldByName(const FieldName: string): TField;
-
-
-begin
-  Result:=FindField(FieldName);
-  If Result=Nil then
-    DatabaseErrorFmt(SFieldNotFound,[FieldName],Self);
-end;
-
-Function TDataset.FindField(const FieldName: string): TField;
-
-
-begin
-  Result:=FFieldList.FindField(FieldName);
-end;
-
-Function TDataset.FindFirst: Boolean;
-
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.FindLast: Boolean;
-
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.FindNext: Boolean;
-
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.FindPrior: Boolean;
-
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.First;
-
-
-begin
-  CheckBrowseMode;
-  DoBeforeScroll;
-  ClearBuffers;
-  try
-    InternalFirst;
-    GetNextRecords;
-  finally
-    FBOF:=True;
-    DoAfterScroll;
-  end;
-end;
-
-Procedure TDataset.FreeBookmark(ABookmark: TBookmark);
-
-
-begin
-  FreeMem(ABookMark,FBookMarkSize);
-end;
-
-Function TDataset.GetBookmark: TBookmark;
-
-
-begin
-  if BookmarkAvailable then
-    begin
-    GetMem (Result,FBookMarkSize);
-    GetBookMarkdata(ActiveBuffer,Result);
-    end
-  else
-    Result:=Nil;
-end;
-
-Function TDataset.GetCurrentRecord(Buffer: PChar): Boolean;
-
-
-begin
-  Result:=False;
-end;
-
-Procedure TDataset.GetFieldList(List: TList; const FieldNames: string);
-
-
-begin
-
-end;
-
-Procedure TDataset.GetFieldNames(List: TStrings);
-
-
-begin
-  FFieldList.GetFieldNames(List);
-end;
-
-Procedure TDataset.GotoBookmark(ABookmark: TBookmark);
-
-
-begin
-  If Assigned(ABookMark) then
-    begin
-    CheckBrowseMode;
-    DoBeforeScroll;
-    InternalGotoBookMark(ABookMark);
-    Resync([rmExact,rmCenter]);
-    DoAfterScroll;
-    end;
-end;
-
-Procedure TDataset.Insert;
-
-begin
-  DoInsertAppend(False);
-end;
-
-Procedure TDataset.InsertRecord(const Values: array of const);
-
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.IsEmpty: Boolean;
-
-begin
-  Result:=(Bof and Eof);
-end;
-
-Function TDataset.IsSequenced: Boolean;
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.Last;
-
-begin
-  CheckBrowseMode;
-  DoBeforeScroll;
-  ClearBuffers;
-  try
-    InternalLast;
-    GetPriorRecords;
-    FActiveRecord:=FRecordCount-1;
-  finally
-    FEOF:=true;
-    DoAfterScroll;
-  end;
-end;
-
-Function TDataset.MoveBy(Distance: Longint): Longint;
-
-  Procedure Scrollforward;
-
-  begin
-{$ifdef dsdebug}
-    Writeln('Scrolling forward :',Distance);
-    Writeln('Active buffer : ',FActiveRecord);
-    Writeln('RecordCunt    : ',FRecordCount);
-{$endif}
-    While (Distance>0) and not FEOF do
-      begin
-      If FActiveRecord<FRecordCount-1 then
-        begin
-        Inc(FActiveRecord);
-        Dec(Distance)
-        end
-      else
-        begin
-       {$ifdef dsdebug}
-           Writeln('Moveby : need next record');
-       {$endif}
-        If GetNextRecord then
-          Dec(Distance)
-        else
-          FEOF:=true;
-        end;
-      end
-  end;
-
-  Procedure ScrollBackward;
-
-  begin
-
-{$ifdef dsdebug}
-    Writeln('Scrolling backward:',Abs(Distance));
-    Writeln('Active buffer : ',FActiveRecord);
-    Writeln('RecordCunt    : ',FRecordCount);
-{$endif}
-    While (Distance<0) and not FBOF do
-      begin
-      If FActiveRecord>0 then
-        begin
-        Dec(FActiveRecord);
-        Inc(Distance)
-        end
-      else
-        begin
-       {$ifdef dsdebug}
-           Writeln('Moveby : need next record');
-       {$endif}
-        If GetPriorRecord then
-          Inc(Distance)
-        else
-          FBOF:=true;
-        end;
-      end
-  end;
-
-begin
-  CheckBrowseMode;
-  Result:=0;
-  DoBeforeScroll;
-  If ((Distance>0) and FEOF) or
-     ((Distance<0) and FBOF) then
-    exit;
-  Try
-    If Distance>0 then
-      ScrollForward
-    else
-      ScrollBackward;
-  finally
-     DoAfterScroll;
-  end;
-end;
-
-Procedure TDataset.Next;
-
-begin
-  MoveBy(1);
-end;
-
-Procedure TDataset.Open;
-
-begin
-  Active:=True;
-end;
-
-Procedure TDataset.Post;
-  
-  Procedure Checkrequired;
-  
-    Var I : longint;
-    
-  begin
-    For I:=0 to FFieldList.Count-1 do
-      With FFieldList[i] do 
-        // Required fields that are NOT autoinc !! Autoinc cannot be set !!
-        if Required and not ReadOnly and
-           (FieldKind=fkData) and Not (DataType=ftAutoInc) then
-          DatabaseErrorFmt(SNeedField,[DisplayName],Self);
-  end;  
-
-begin
-  if State in [dsEdit,dsInsert] then
-    begin
-{$ifdef dsdebug}    
-    writeln ('Post: checking required fields');
-{$endif}
-    CheckRequired;
-    DoBeforePost;
-    If Not TryDoing(@InternalPost,OnPostError) then exit;
-{$ifdef dsdebug}    
-    writeln ('Post: Internalpost succeeded');
-{$endif}
-    FreeFieldBuffers;
-{$ifdef dsdebug}    
-    writeln ('Post: Freeing field buffers');
-{$endif}
-    SetState(dsBrowse);
-{$ifdef dsdebug}    
-    writeln ('Post: Browse mode set');
-{$endif}
-    Resync([]);
-    DoAfterPost;
-    end;
-end;
-
-Procedure TDataset.Prior;
-
-begin
-  MoveBy(-1);
-end;
-
-Procedure TDataset.Refresh;
-
-begin
-  CheckbrowseMode;
-  UpdateCursorPos;
-  InternalRefresh;
-  Resync([]);
-end;
-
-Procedure TDataset.Resync(Mode: TResyncMode);
-
-Var Count,ShiftCount : Longint;
-
-begin
-  // See if we can find the requested record.
-  If rmExact in Mode then
-    begin
-    { throw an exception if not found.
-      Normally the descendant should do this if DoCheck is true. }
-    If GetRecord(Fbuffers[FRecordCount-1],gmcurrent,True)<>grOk Then
-      DatabaseError(SNoSuchRecord,Self);
-    end
-  else
-    { Can we find a record in the neighbourhood ?
-      Use Shortcut evaluation for this, or we'll have some funny results. }
-    If (GetRecord(Fbuffers[FRecordCount-1],gmcurrent,True)<>grOk) and
-       (GetRecord(Fbuffers[FRecordCount-1],gmprior,True)<>grOk) and
-       (GetRecord(Fbuffers[FRecordCount-1],gmprior,True)<>grOk) then
-       begin
-       // nothing found, invalidate buffer and bail out.
-       ClearBuffers;
-       Exit;
-       end;
-  If (rmCenter in Mode) then
-    ShiftCount:=FbufferCount div 2
-  else
-    // keep current position.
-    ShiftCount:=FActiveRecord;
-  // Reposition on 0
-  ShiftBuffers(0,FRecordCount-1);
-  ActivateBuffers;
-  Count:=0;
-  Writeln ('Getting previous',ShiftCount,' records');
-  While (Count<ShiftCount) and GetPriorRecord do Inc(Count);
-  FActiveRecord:=Count;
-  // fill rest of buffers, adjust ActiveBuffer.
-  SetCurrentRecord(FRecordCount-1);
-  GetNextRecords;
-  Inc(FActiveRecord,GetPriorRecords);
-end;
-
-Procedure TDataset.SetFields(const Values: array of const);
-
-Var I  : longint;
-
-begin
-  For I:=0 to high(Values) do
-    Case Values[I].vtype of
-      vtInteger : FieldByNumber(i).AsLongInt:=Values[I].VInteger;
-      // needs Completion..
-    end;
-end;
-
-Procedure TDataset.Translate(Src, Dest: PChar; ToOem: Boolean);
-
-begin
-  //!! To be implemented
-end;
-
-Function Tdataset.TryDoing (P : TDataOperation; Ev : TDatasetErrorEvent) : Boolean;
-
-Var Retry : TDataAction;
-
-begin
-  {$ifdef dsdebug}
-  Writeln ('Trying to do');
-  If P=Nil then writeln ('Procedure to call is nil !!!');
-  {$endif dsdebug}
-  Result:=True;
-  Retry:=daRetry;
-  while Retry=daRetry do
-    Try 
-  {$ifdef dsdebug}
-  Writeln ('Trying : updatecursorpos');
-  {$endif dsdebug}
-      UpdateCursorPos;
-  {$ifdef dsdebug}
-  Writeln ('Trying to do it');
-  {$endif dsdebug}
-      P;
-      exit;
-    except
-      On E : EDatabaseError do 
-        begin
-        retry:=daFail;
-        If Assigned(Ev) then
-          Ev(Self,E,Retry);
-        Case Retry of
-          daFail : Raise;
-          daAbort : Result:=False;
-        end;
-        end;
-    else
-      Raise;  
-    end;
-  {$ifdef dsdebug}
-  Writeln ('Exit Trying to do');
-  {$endif dsdebug}
-end;
-
-Procedure TDataset.UpdateCursorPos;
-
-begin
-  If FRecordCount>0 then
-    SetCurrentRecord(FactiveRecord);
-end;
-
-Procedure TDataset.UpdateRecord;
-
-begin
-  //!! To be implemented
-end;
-
-Procedure TDataset.RemoveField (Field : TField);
-
-begin
-  //!! To be implemented
-end;
-
-Function TDataset.Getfieldcount : Longint;
-
-begin
-  Result:=FFieldList.Count;
-end;
-
-Procedure TDataset.ShiftBuffers (Offset, Distance : longint);
-
-Var Temp : Pointer;
-    MoveSize : Longint;
-
-  Procedure ShiftBuffersUp;
-  begin
-    {$ifdef DSDEBUG}
-    writeln ('Shifting buffers up from ',OffSet,' with distance :',Distance);
-    writeln ('Moving ',(FBufferCount-Distance), ' Buffers at ',Distance);
-    {$endif}
-    Move(FBuffers[Offset],Temp^,MoveSize);
-    Move(FBuffers[Offset+Distance],FBuffers[Offset],(FBufferCount-Distance-Offset)*SizeOf(Pchar));
-    Move(Temp^,FBuffers[FBufferCount-Distance-Offset],MoveSize);
-  end;
-
-  Procedure ShiftBuffersDown;
-
-  begin
-    // Distance is NEGATIVE
-    {$ifdef DSDEBUG}
-    writeln ('Shifting buffers down with distance :',Abs(Distance));
-    writeln ('Moving ',Movesize div 4,' Buffers at ',FBufferCount+Distance);
-    {$endif}
-    Move(FBuffers[FbufferCount+Distance],Temp^ ,MoveSize);
-    Move(FBuffers[0],FBuffers[Abs(Distance)],(FBufferCount+Distance)*SizeOf(Pchar));
-    Move(Temp^ ,FBuffers[0],MoveSize);
-  end;
-
-begin
-  If Abs(Distance)>=BufferCount then Exit;
-  try
-    MoveSize:=SizeOf(Pchar)*Abs(Distance);
-    GetMem(Temp,MoveSize);
-    If Distance<0 Then
-      ShiftBuffersDown
-    else If Distance>0 then
-      ShiftBuffersUp;
-  Finally
-    FreeMem(temp);
-  end;
-end;
-
-{
-  $Log$
-  Revision 1.6  1999-12-01 22:11:02  michael
-  + tested edit and insert methods
-
-  Revision 1.5  1999/11/12 22:53:32  michael
-  + Added append() insert() tested append. Datetime as string works now
-
-  Revision 1.4  1999/11/11 17:31:09  michael
-  + Added Checks for all simple field types.
-  + Initial implementation of Insert/Append
-
-  Revision 1.3  1999/11/09 13:33:47  peter
-    * reallocmem fixes
-
-  Revision 1.2  1999/10/24 17:07:54  michael
-  + Added copyright header
-
-}

fcl/db/db.pp

@@ -1,1276 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999 by Michael Van Canneyt, member of the
-    Free Pascal development team
-
-
-    DB header file with interface section.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-unit db;
-
-{$mode objfpc}
-{$h+}
-
-interface
-
-uses Classes,Sysutils;
-
-const
-
-  dsMaxBufferCount = MAXINT div 8;
-  dsMaxStringSize = 8192;
-
-  // Used in AsBoolean for string fields to determine
-  // whether it's true or false.
-  YesNoChars : Array[Boolean] of char = ('Y','N');
-
-type
-
-{ Auxiliary type }
-  TStringFieldBuffer = Array[0..dsMaxStringSize] of Char;
-
-{ Misc Dataset types }
-
-  TDataSetState = (dsInactive, dsBrowse, dsEdit, dsInsert, dsSetKey,
-    dsCalcFields, dsFilter, dsNewValue, dsOldValue, dsCurValue);
-
-  TDataEvent = (deFieldChange, deRecordChange, deDataSetChange,
-    deDataSetScroll, deLayoutChange, deUpdateRecord, deUpdateState,
-    deCheckBrowseMode, dePropertyChange, deFieldListChange, deFocusControl);
-
-  TUpdateStatus = (usUnmodified, usModified, usInserted, usDeleted);
-
-{ Forward declarations }
-
-  TFieldDef = class;
-  TFieldDefs = class;
-  TField = class;
-  TFields = Class;
-  TDataSet = class;
-  TDataBase = Class;
-
-{ Exception classes }
-
-  EDatabaseError = class(Exception);
-
-{ TFieldDef }
-
-  TFieldClass = class of TField;
-
-  TFieldType = (ftUnknown, ftString, ftSmallint, ftInteger, ftWord,
-    ftBoolean, ftFloat, ftDate, ftTime, ftDateTime,
-    ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic,
-    ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor);
-
-  TFieldDef = class(TComponent)
-  Private
-    FDataType : TFieldType;
-    FFieldNo : Longint;
-    FInternalCalcField : Boolean;
-    FPrecision : Longint;
-    FRequired : Boolean;
-    FSize : Word;
-    FName : String;
-    Function GetFieldClass : TFieldClass;
-  public
-    constructor Create(AOwner: TFieldDefs; const AName: string;
-      ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint);
-    destructor Destroy; override;
-    function CreateField(AOwner: TComponent): TField;
-    property InternalCalcField: Boolean read FInternalCalcField write FInternalCalcField;
-    property DataType: TFieldType read FDataType;
-    property FieldClass: TFieldClass read GetFieldClass;
-    property FieldNo: Longint read FFieldNo;
-    property Name: string read FName;
-    property Precision: Longint read FPrecision write FPrecision;
-    property Required: Boolean read FRequired;
-    property Size: Word read FSize;
-  end;
-
-{ TFieldDefs }
-
-  TFieldDefs = class(TComponent)
-  private
-    FDataSet: TDataSet;
-    FItems: TList;
-    FUpdated: Boolean;
-    function GetCount: Longint;
-    function GetItem(Index: Longint): TFieldDef;
-  public
-    constructor Create(ADataSet: TDataSet);
-    destructor Destroy; override;
-    procedure Add(const AName: string; ADataType: TFieldType; ASize: Word;
-      ARequired: Boolean);
-    procedure Assign(FieldDefs: TFieldDefs);
-    procedure Clear;
-    function Find(const AName: string): TFieldDef;
-    function IndexOf(const AName: string): Longint;
-    procedure Update;
-    property Count: Longint read GetCount;
-    property Items[Index: Longint]: TFieldDef read GetItem; default;
-  end;
-
-{ TField }
-
-  TFieldKind = (fkData, fkCalculated, fkLookup, fkInternalCalc);
-  TFieldKinds = Set of TFieldKind;
-
-  TFieldNotifyEvent = procedure(Sender: TField) of object;
-  TFieldGetTextEvent = procedure(Sender: TField; var Text: string;
-    DisplayText: Boolean) of object;
-  TFieldSetTextEvent = procedure(Sender: TField; const Text: string) of object;
-  TFieldRef = ^TField;
-  TFieldChars = set of Char;
-  { TAlignment may need to come from somewhere else }
-  TAlignMent = (taLeftjustify,taCenter,taRightJustify);
-
-  TField = class(TComponent)
-  Private
-    FAlignMent : TAlignment;
-    FAttributeSet : String;
-    FBuffers : ppchar;
-    FCalculated : Boolean;
-    FCanModify : Boolean;
-    FConstraintErrorMessage : String;
-    FCustomConstraint : String;
-    FDataSet : TDataSet;
-    FDataSize : Word;
-    FDataType : TFieldType;
-    FDefaultExpression : String;
-    FDisplayLabel : String;
-    FDisplayWidth : Longint;
-    FEditText : String;
-    FFieldKind : TFieldKind;
-    FFieldName : String;
-    FFieldNo : Longint;
-    FFields : TFields;
-    FHasConstraints : Boolean;
-    FImportedConstraint : String;
-    FIsIndexField : Boolean;
-    FKeyFields : String;
-    FLookupCache : Boolean;
-    FLookupDataSet : TDataSet;
-    FLookupKeyfields : String;
-    FLookupresultField : String;
-    FOffset : Word;
-    FOnChange : TFieldNotifyEvent;
-    FOnGetText: TFieldGetTextEvent;
-    FOnSetText: TFieldSetTextEvent;
-    FOnValidate: TFieldNotifyEvent;
-    FOrigin : String;
-    FReadOnly : Boolean;
-    FRequired : Boolean;
-    FSize : Word;
-    FValidChars : TFieldChars;
-    FValueBuffer : Pointer;
-    FValidating : Boolean;
-    FVisible : Boolean;
-    Function GetIndex : longint;
-    Procedure SetDataset(VAlue : TDataset);
-  protected
-    function AccessError(const TypeName: string): EDatabaseError;
-    procedure CheckInactive;
-    class procedure CheckTypeSize(AValue: Longint); virtual;
-    procedure Change; virtual;
-    procedure DataChanged;
-    procedure FreeBuffers; virtual;
-    function GetAsBoolean: Boolean; virtual;
-    function GetAsDateTime: TDateTime; virtual;
-    function GetAsFloat: Extended; virtual;
-    function GetAsLongint: Longint; virtual;
-    function GetAsString: string; virtual;
-    function GetCanModify: Boolean; virtual;
-    function GetDataSize: Word; virtual;
-    function GetDefaultWidth: Longint; virtual;
-    function GetDisplayName : String; 
-    function GetIsNull: Boolean; virtual;
-    function GetParentComponent: TComponent; override;
-    procedure GetText(var AText: string; ADisplayText: Boolean); virtual;
-    function HasParent: Boolean; override;
-    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
-    procedure PropertyChanged(LayoutAffected: Boolean);
-    procedure ReadState(Reader: TReader); override;
-    procedure SetAsBoolean(AValue: Boolean); virtual;
-    procedure SetAsDateTime(AValue: TDateTime); virtual;
-    procedure SetAsFloat(AValue: Extended); virtual;
-    procedure SetAsLongint(AValue: Longint); virtual;
-    procedure SetAsString(const AValue: string); virtual;
-    procedure SetDataType(AValue: TFieldType);
-    procedure SetSize(AValue: Word); virtual;
-    procedure SetParentComponent(AParent: TComponent); override;
-    procedure SetText(const AValue: string); virtual;
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-    procedure Assign(Source: TPersistent); override;
-    procedure Clear; virtual;
-    procedure FocusControl;
-    function GetData(Buffer: Pointer): Boolean;
-    class function IsBlob: Boolean; virtual;
-    function IsValidChar(InputChar: Char): Boolean; virtual;
-    procedure SetData(Buffer: Pointer);
-    procedure SetFieldType(AValue: TFieldType); virtual;
-    procedure Validate(Buffer: Pointer);
-    property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
-    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
-    property AsFloat: Extended read GetAsFloat write SetAsFloat;
-    property AsLongint: Longint read GetAsLongint write SetAsLongint;
-    property AsString: string read GetAsString write SetAsString;
-    property AttributeSet: string read FAttributeSet write FAttributeSet;
-    property Calculated: Boolean read FCalculated write FCalculated;
-    property CanModify: Boolean read FCanModify;
-    property DataSet: TDataSet read FDataSet write SetDataSet;
-    property DataSize: Word read GetDataSize;
-    property DataType: TFieldType read FDataType;
-    property FieldNo: Longint read FFieldNo;
-    property IsIndexField: Boolean read FIsIndexField;
-    property IsNull: Boolean read GetIsNull;
-    property Offset: word read FOffset;
-    property Size: Word read FSize write FSize;
-    property Text: string read FEditText write FEditText;
-    property ValidChars : TFieldChars Read FValidChars;
-  published
-    property AlignMent : TAlignMent Read FAlignMent write FAlignment;
-    property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
-    property ConstraintErrorMessage: string read FConstraintErrorMessage write FConstraintErrorMessage;
-    property DefaultExpression: string read FDefaultExpression write FDefaultExpression;
-    property DisplayLabel : string read FDisplayLabel write FDisplayLabel;
-    property DisplayName : String Read GetDisplayName; 
-    property DisplayWidth: Longint read FDisplayWidth write FDisplayWidth;
-    property FieldKind: TFieldKind read FFieldKind write FFieldKind;
-    property FieldName: string read FFieldName write FFieldName;
-    property HasConstraints: Boolean read FHasConstraints;
-    property Index: Longint read GetIndex;
-    property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
-    property LookupDataSet: TDataSet read FLookupDataSet write FLookupDataSet;
-    property LookupKeyFields: string read FLookupKeyFields write FLookupKeyFields;
-    property LookupResultField: string read FLookupResultField write FLookupResultField;
-    property KeyFields: string read FKeyFields write FKeyFields;
-    property LookupCache: Boolean read FLookupCache write FLookupCache;
-    property Origin: string read FOrigin write FOrigin;
-    property ReadOnly: Boolean read FReadOnly write FReadOnly;
-    property Required: Boolean read FRequired write FRequired;
-    property Visible: Boolean read FVisible write FVisible;
-    property OnChange: TFieldNotifyEvent read FOnChange write FOnChange;
-    property OnGetText: TFieldGetTextEvent read FOnGetText write FOnGetText;
-    property OnSetText: TFieldSetTextEvent read FOnSetText write FOnSetText;
-    property OnValidate: TFieldNotifyEvent read FOnValidate write FOnValidate;
-  end;
-
-{ TStringField }
-
-  TStringField = class(TField)
-  protected
-    class procedure CheckTypeSize(AValue: Longint); override;
-    function GetAsBoolean: Boolean; override;
-    function GetAsDateTime: TDateTime; override;
-    function GetAsFloat: Extended; override;
-    function GetAsLongint: Longint; override;
-    function GetAsString: string; override;
-    function GetDataSize: Word; override;
-    function GetDefaultWidth: Longint; override;
-    procedure GetText(var AText: string; DisplayText: Boolean); override;
-    function GetValue(var AValue: string): Boolean;
-    procedure SetAsBoolean(AValue: Boolean); override;
-    procedure SetAsDateTime(AValue: TDateTime); override;
-    procedure SetAsFloat(AValue: Extended); override;
-    procedure SetAsLongint(AValue: Longint); override;
-    procedure SetAsString(const AValue: string); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    property Value: string read GetAsString write SetAsString;
-  published
-    property Size default 20;
-  end;
-
-{ TNumericField }
-  TNumericField = class(TField)
-  Private
-    FDisplayFormat : String;
-    FEditFormat : String;
-  protected
-    procedure RangeError(AValue, Min, Max: Extended);
-    procedure SetDisplayFormat(const AValue: string);
-    procedure SetEditFormat(const AValue: string);
-  public
-    constructor Create(AOwner: TComponent); override;
-  published
-    property DisplayFormat: string read FDisplayFormat write SetDisplayFormat;
-    property EditFormat: string read FEditFormat write SetEditFormat;
-  end;
-
-{ TLongintField }
-
-  TLongintField = class(TNumericField)
-  private
-    FMinValue,
-    FMaxValue,
-    FMinRange,
-    FMAxRange  : Longint;
-    Procedure SetMinValue (AValue : longint);
-    Procedure SetMaxValue (AValue : longint);
-  protected
-    function GetAsFloat: Extended; override;
-    function GetAsLongint: Longint; override;
-    function GetAsString: string; override;
-    function GetDataSize: Word; override;
-    procedure GetText(var AText: string; DisplayText: Boolean); override;
-    function GetValue(var AValue: Longint): Boolean;
-    procedure SetAsFloat(AValue: Extended); override;
-    procedure SetAsLongint(AValue: Longint); override;
-    procedure SetAsString(const AValue: string); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    Function CheckRange(AValue : longint) : Boolean;
-    property Value: Longint read GetAsLongint write SetAsLongint;
-  published
-    property MaxValue: Longint read FMaxValue write SetMaxValue default 0;
-    property MinValue: Longint read FMinValue write SetMinValue default 0;
-  end;
-  TIntegerField = TLongintField;
-
-{ TSmallintField }
-
-  TSmallintField = class(TLongintField)
-  protected
-    function GetDataSize: Word; override;
-  public
-    constructor Create(AOwner: TComponent); override;
-  end;
-
-{ TWordField }
-
-  TWordField = class(TLongintField)
-  protected
-    function GetDataSize: Word; override;
-  public
-    constructor Create(AOwner: TComponent); override;
-  end;
-
-{ TAutoIncField }
-
-  TAutoIncField = class(TLongintField)
-  Protected
-    Procedure SetAsLongInt(AValue : Longint); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-  end;
-
-{ TFloatField }
-
-  TFloatField = class(TNumericField)
-  private
-    FMaxValue : Extended;
-    FMinValue : Extended;
-    FPrecision : Longint;
-  protected
-    function GetAsFloat: Extended; override;
-    function GetAsLongint: Longint; override;
-    function GetAsString: string; override;
-    function GetDataSize: Word; override;
-    procedure GetText(var theText: string; DisplayText: Boolean); override;
-    procedure SetAsFloat(AValue: Extended); override;
-    procedure SetAsLongint(AValue: Longint); override;
-    procedure SetAsString(const AValue: string); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    Function CheckRange(AValue : Extended) : Boolean;
-    property Value: Extended read GetAsFloat write SetAsFloat;
-
-  published
-    property MaxValue: Extended read FMaxValue write FMaxValue;
-    property MinValue: Extended read FMinValue write FMinValue;
-    property Precision: Longint read FPrecision write FPrecision default 15;
-  end;
-
-
-{ TBooleanField }
-
-  TBooleanField = class(TField)
-  private
-    FDisplayValues : String;
-    // First byte indicates uppercase or not.
-    FDisplays : Array[Boolean,Boolean] of string;
-    Procedure SetDisplayValues(AValue : String);
-  protected
-    function GetAsBoolean: Boolean; override;
-    function GetAsString: string; override;
-    function GetDataSize: Word; override;
-    function GetDefaultWidth: Longint; override;
-    procedure SetAsBoolean(AValue: Boolean); override;
-    procedure SetAsString(const AValue: string); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    property Value: Boolean read GetAsBoolean write SetAsBoolean;
-  published
-    property DisplayValues: string read FDisplayValues write SetDisplayValues;
-  end;
-
-{ TDateTimeField }
-
-  TDateTimeField = class(TField)
-  private
-    FDisplayFormat : String;
-  protected
-    function GetAsDateTime: TDateTime; override;
-    function GetAsFloat: Extended; override;
-    function GetAsString: string; override;
-    function GetDataSize: Word; override;
-    procedure GetText(var theText: string; DisplayText: Boolean); override;
-    procedure SetAsDateTime(AValue: TDateTime); override;
-    procedure SetAsFloat(AValue: Extended); override;
-    procedure SetAsString(const AValue: string); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    property Value: TDateTime read GetAsDateTime write SetAsDateTime;
-  published
-    property DisplayFormat: string read FDisplayFormat write FDisplayFormat;
-  end;
-
-{ TDateField }
-
-  TDateField = class(TDateTimeField)
-  protected
-    function GetDataSize: Word; override;
-  public
-    constructor Create(AOwner: TComponent); override;
-  end;
-
-{ TTimeField }
-
-  TTimeField = class(TDateTimeField)
-  protected
-    function GetDataSize: Word; override;
-  public
-    constructor Create(AOwner: TComponent); override;
-  end;
-
-{ TBinaryField }
-
-  TBinaryField = class(TField)
-  protected
-    class procedure CheckTypeSize(AValue: Longint); override;
-    function GetAsString: string; override;
-    procedure GetText(var TheText: string; DisplayText: Boolean); override;
-    procedure SetAsString(const AValue: string); override;
-    procedure SetText(const AValue: string); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-  published
-    property Size default 16;
-  end;
-
-{ TBytesField }
-
-  TBytesField = class(TBinaryField)
-  protected
-    function GetDataSize: Word; override;
-  public
-    constructor Create(AOwner: TComponent); override;
-  end;
-
-{ TVarBytesField }
-
-  TVarBytesField = class(TBytesField)
-  protected
-    function GetDataSize: Word; override;
-  public
-    constructor Create(AOwner: TComponent); override;
-  end;
-
-{ TBCDField }
-
-  TBCDField = class(TNumericField)
-  private
-  protected
-    class procedure CheckTypeSize(AValue: Longint); override;
-    function GetAsFloat: Extended; override;
-    function GetAsLongint: Longint; override;
-    function GetAsString: string; override;
-    function GetDataSize: Word; override;
-    function GetDefaultWidth: Longint; override;
-    procedure GetText(var TheText: string; DisplayText: Boolean); override;
-    procedure SetAsFloat(AValue: Extended); override;
-    procedure SetAsLongint(AValue: Longint); override;
-    procedure SetAsString(const AValue: string); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-  published
-    property Size default 4;
-  end;
-
-{ TBlobField }
-  TBlobStreamMode = (bmRead, bmWrite, bmReadWrite);
-  TBlobType = ftBlob..ftTypedBinary;
-
-  TBlobField = class(TField)
-  private
-    FBlobSize : Longint;
-    FBlobType : TBlobType;
-    FModified : Boolean;
-    FTransliterate : Boolean;
-    Function GetBlobStream (Mode : TBlobStreamMode) : TStream;
-  protected
-    procedure AssignTo(Dest: TPersistent); override;
-    procedure FreeBuffers; override;
-    function GetAsString: string; override;
-    function GetBlobSize: Longint; virtual;
-    function GetIsNull: Boolean; override;
-    procedure GetText(var TheText: string; DisplayText: Boolean); override;
-    procedure SetAsString(const AValue: string); override;
-    procedure SetText(const AValue: string); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    procedure Assign(Source: TPersistent); override;
-    procedure Clear; override;
-    class function IsBlob: Boolean; override;
-    procedure LoadFromFile(const FileName: string);
-    procedure LoadFromStream(Stream: TStream);
-    procedure SaveToFile(const FileName: string);
-    procedure SaveToStream(Stream: TStream);
-    procedure SetFieldType(AValue: TFieldType); override;
-    property BlobSize: Longint read FBlobSize;
-    property Modified: Boolean read FModified write FModified;
-    property Value: string read GetAsString write SetAsString;
-    property Transliterate: Boolean read FTransliterate write FTransliterate;
-  published
-    property BlobType: TBlobType read FBlobType write FBlobType;
-    property Size default 0;
-  end;
-
-{ TMemoField }
-
-  TMemoField = class(TBlobField)
-  public
-    constructor Create(AOwner: TComponent); override;
-  published
-    property Transliterate default True;
-  end;
-
-{ TGraphicField }
-
-  TGraphicField = class(TBlobField)
-  public
-    constructor Create(AOwner: TComponent); override;
-  end;
-
-{ TIndexDef }
-
-  TIndexDefs = class;
-
-  TIndexOptions = set of (ixPrimary, ixUnique, ixDescending,
-    ixCaseInsensitive, ixExpression);
-
-  TIndexDef = class
-  Private
-    FExpression : String;
-    FFields : String;
-    FName : String;
-    FOptions : TIndexOptions;
-    FSource : String;
-  public
-    constructor Create(Owner: TIndexDefs; const AName, TheFields: string;
-      TheOptions: TIndexOptions);
-    destructor Destroy; override;
-    property Expression: string read FExpression;
-    property Fields: string read FFields;
-    property Name: string read FName;
-    property Options: TIndexOptions read FOptions;
-    property Source: string read FSource write FSource;
-  end;
-
-{ TIndexDefs }
-
-  TIndexDefs = class
-  Private
-    FCount : Longint;
-    FUpDated : Boolean;
-    Function GetItem (Index : longint) : TindexDef;
-  public
-    constructor Create(DataSet: TDataSet);
-    destructor Destroy; override;
-    procedure Add(const Name, Fields: string; Options: TIndexOptions);
-    procedure Assign(IndexDefs: TIndexDefs);
-    procedure Clear;
-    function FindIndexForFields(const Fields: string): TIndexDef;
-    function GetIndexForFields(const Fields: string;
-      CaseInsensitive: Boolean): TIndexDef;
-    function IndexOf(const Name: string): Longint;
-    procedure Update;
-    property Count: Longint read FCount;
-    property Items[Index: Longint]: TIndexDef read GetItem; default;
-    property Updated: Boolean read FUpdated write FUpdated;
-  end;
-
-{ TCheckConstraint }
-
-  TCheckConstraint = class(TCollectionItem)
-  Private
-    FCustomConstraint : String;
-    FErrorMessage : String;
-    FFromDictionary : Boolean;
-    FImportedConstraint : String;
-  public
-    procedure Assign(Source: TPersistent); override;
-  //  function GetDisplayName: string; override;
-  published
-    property CustomConstraint: string read FCustomConstraint write FCustomConstraint;
-    property ErrorMessage: string read FErrorMessage write FErrorMessage;
-    property FromDictionary: Boolean read FFromDictionary write FFromDictionary;
-    property ImportedConstraint: string read FImportedConstraint write FImportedConstraint;
-  end;
-
-{ TCheckConstraints }
-
-  TCheckConstraints = class(TCollection)
-  Private
-   Function GetItem(Index : Longint) : TCheckConstraint;
-   Procedure SetItem(index : Longint; Value : TCheckConstraint);
-  protected
-    function GetOwner: TPersistent; override;
-  public
-    constructor Create(Owner: TPersistent);
-    function Add: TCheckConstraint;
-    property Items[Index: Longint]: TCheckConstraint read GetItem write SetItem; default;
-  end;
-
-{ TFields }
-
-  Tfields = Class(TObject)
-    Private
-      FDataset : TDataset;
-      FFieldList : TList;
-      FOnChange : TNotifyEvent;
-      FValidFieldKinds : TFieldKinds;
-    Protected
-      Procedure Changed;
-      Procedure CheckfieldKind(Fieldkind : TFieldKind; Field : TField);
-      Function GetCount : Longint;
-      Function GetField (Index : longint) : TField;
-      Procedure SetFieldIndex (Field : TField;Value : Integer);
-      Property OnChange : TNotifyEvent Read FOnChange Write FOnChange;
-      Property ValidFieldKinds : TFieldKinds Read FValidFieldKinds;
-    Public
-      Constructor Create(ADataset : TDataset);
-      Destructor Destroy;override;
-      Procedure Add(Field : TField);
-      Procedure CheckFieldName (Const Value : String);
-      Procedure CheckFieldNames (Const Value : String);
-      Procedure Clear;
-      Function FindField (Const Value : String) : TField;
-      Function FieldByName (Const Value : String) : TField;
-      Function FieldByNumber(FieldNo : Integer) : TField;
-      Procedure GetFieldNames (Values : TStrings);
-      Function IndexOf(Field : TField) : Longint;
-      procedure Remove(Value : TField);
-      Property Count : Integer Read GetCount;
-      Property Dataset : TDataset Read FDataset;
-      Property Fields [Index : Integer] : TField Read GetField; default;
-    end;
-
-
-{ TDataSet }
-
-  TBookmark = Pointer;
-  TBookmarkStr = string;
-
-  PBookmarkFlag = ^TBookmarkFlag;
-  TBookmarkFlag = (bfCurrent, bfBOF, bfEOF, bfInserted);
-
-  PBufferList = ^TBufferList;
-  TBufferList = array[0..dsMaxBufferCount - 1] of PChar;
-
-  TGetMode = (gmCurrent, gmNext, gmPrior);
-
-  TGetResult = (grOK, grBOF, grEOF, grError);
-
-  TResyncMode = set of (rmExact, rmCenter);
-
-  TDataAction = (daFail, daAbort, daRetry);
-
-  TUpdateKind = (ukModify, ukInsert, ukDelete);
-
-
-  TLocateOption = (loCaseInsensitive, loPartialKey);
-  TLocateOptions = set of TLocateOption;
-
-  TDataOperation = procedure of object;
-
-  TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
-  TDataSetErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
-    var Action: TDataAction) of object;
-
-  TFilterOption = (foCaseInsensitive, foNoPartialCompare);
-  TFilterOptions = set of TFilterOption;
-
-  TFilterRecordEvent = procedure(DataSet: TDataSet;
-    var Accept: Boolean) of object;
-
-  TDatasetClass = Class of TDataset;
-  TBufferArray = ^pchar;
-
-  TDataSet = class(TComponent)
-  Private
-    FActive: Boolean;
-    FActiveRecord: Longint;
-    FAfterCancel: TDataSetNotifyEvent;
-    FAfterClose: TDataSetNotifyEvent;
-    FAfterDelete: TDataSetNotifyEvent;
-    FAfterEdit: TDataSetNotifyEvent;
-    FAfterInsert: TDataSetNotifyEvent;
-    FAfterOpen: TDataSetNotifyEvent;
-    FAfterPost: TDataSetNotifyEvent;
-    FAfterScroll: TDataSetNotifyEvent;
-    FAutoCalcFields: Boolean;
-    FBOF: Boolean;
-    FBeforeCancel: TDataSetNotifyEvent;
-    FBeforeClose: TDataSetNotifyEvent;
-    FBeforeDelete: TDataSetNotifyEvent;
-    FBeforeEdit: TDataSetNotifyEvent;
-    FBeforeInsert: TDataSetNotifyEvent;
-    FBeforeOpen: TDataSetNotifyEvent;
-    FBeforePost: TDataSetNotifyEvent;
-    FBeforeScroll: TDataSetNotifyEvent;
-    FBlobFieldCount: Longint;
-    FBookmark: TBookmarkStr;
-    FBookmarkSize: Longint;
-    FBuffers : TBufferArray;
-    FBufferCount: Longint;
-    FCalcBuffer: PChar;
-    FCalcFieldsSize: Longint;
-    FCanModify: Boolean;
-    FConstraints: TCheckConstraints;
-    FCurrentRecord: Longint;
-    FDefaultFields: Boolean;
-    FEOF: Boolean;
-    FFieldList : TFields;
-    FFieldCount : Longint;
-    FFieldDefs: TFieldDefs;
-    FFilterOptions: TFilterOptions;
-    FFilterText: string;
-    FFiltered: Boolean;
-    FFound: Boolean;
-    FInternalCalcFields: Boolean;
-    FModified: Boolean;
-    FOnCalcFields: TDataSetNotifyEvent;
-    FOnDeleteError: TDataSetErrorEvent;
-    FOnEditError: TDataSetErrorEvent;
-    FOnFilterRecord: TFilterRecordEvent;
-    FOnNewRecord: TDataSetNotifyEvent;
-    FOnPostError: TDataSetErrorEvent;
-    FRecNo: Longint;
-    FRecordCount: Longint;
-    FRecordSize: Word;
-    FState: TDataSetState;
-    Procedure DoInsertAppend(DoAppend : Boolean);
-    Procedure DoInternalOpen;
-    Procedure DoInternalClose;
-    Function  GetBuffer (Index : longint) : Pchar;
-    Function  GetField (Index : Longint) : TField;
-    Procedure RemoveField (Field : TField);
-    Procedure SetActive (Value : Boolean);
-    Procedure SetField (Index : Longint;Value : TField);
-    Procedure ShiftBuffers (Offset,Distance : Longint);
-    Function  TryDoing (P : TDataOperation; Ev : TDatasetErrorEvent) : Boolean;
-    Procedure UpdateFieldDefs;
-  protected
-    procedure ActivateBuffers; virtual;
-    procedure BindFields(Binding: Boolean);
-    function  BookmarkAvailable: Boolean;
-    procedure CalculateFields(Buffer: PChar); virtual;
-    procedure CheckActive; virtual;
-    procedure CheckInactive; virtual;
-    procedure ClearBuffers; virtual;
-    procedure ClearCalcFields(Buffer: PChar); virtual;
-    procedure CloseBlob(Field: TField); virtual;
-    procedure CloseCursor; virtual;
-    procedure CreateFields;
-    procedure DataEvent(Event: TDataEvent; Info: Longint); virtual;
-    procedure DestroyFields; virtual;
-    procedure DoAfterCancel; virtual;
-    procedure DoAfterClose; virtual;
-    procedure DoAfterDelete; virtual;
-    procedure DoAfterEdit; virtual;
-    procedure DoAfterInsert; virtual;
-    procedure DoAfterOpen; virtual;
-    procedure DoAfterPost; virtual;
-    procedure DoAfterScroll; virtual;
-    procedure DoBeforeCancel; virtual;
-    procedure DoBeforeClose; virtual;
-    procedure DoBeforeDelete; virtual;
-    procedure DoBeforeEdit; virtual;
-    procedure DoBeforeInsert; virtual;
-    procedure DoBeforeOpen; virtual;
-    procedure DoBeforePost; virtual;
-    procedure DoBeforeScroll; virtual;
-    procedure DoOnCalcFields; virtual;
-    procedure DoOnNewRecord; virtual;
-    function  FieldByNumber(FieldNo: Longint): TField;
-    function  FindRecord(Restart, GoForward: Boolean): Boolean; virtual;
-    procedure FreeFieldBuffers; virtual;
-    function  GetBookmarkStr: TBookmarkStr; virtual;
-    procedure GetCalcFields(Buffer: PChar); virtual;
-    function  GetCanModify: Boolean; virtual;
-    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
-    function  GetFieldClass(FieldType: TFieldType): TFieldClass; virtual;
-    Function  GetfieldCount : Integer;
-    function  GetIsIndexField(Field: TField): Boolean; virtual;
-    function  GetNextRecords: Longint; virtual;
-    function  GetNextRecord: Boolean; virtual;
-    function  GetPriorRecords: Longint; virtual;
-    function  GetPriorRecord: Boolean; virtual;
-    function  GetRecordCount: Longint; virtual;
-    function  GetRecNo: Longint; virtual;
-    procedure InitFieldDefs; virtual;
-    procedure InitRecord(Buffer: PChar); virtual;
-    procedure InternalCancel; virtual;
-    procedure InternalEdit; virtual;
-    procedure InternalRefresh; virtual;
-    procedure Loaded; override;
-    procedure OpenCursor(InfoQuery: Boolean); virtual;
-    procedure RefreshInternalCalcFields(Buffer: PChar); virtual;
-    Function  RequiredBuffers : longint;
-    procedure RestoreState(const Value: TDataSetState);
-    procedure SetBookmarkStr(const Value: TBookmarkStr); virtual;
-    procedure SetBufListSize(Value: Longint);
-    procedure SetChildOrder(Component: TComponent; Order: Longint); override;
-    procedure SetCurrentRecord(Index: Longint); virtual;
-    procedure SetFiltered(Value: Boolean); virtual;
-    procedure SetFilterOptions(Value: TFilterOptions); virtual;
-    procedure SetFilterText(const Value: string); virtual;
-    procedure SetFound(const Value: Boolean);
-    procedure SetModified(Value: Boolean);
-    procedure SetName(const Value: TComponentName); override;
-    procedure SetOnFilterRecord(const Value: TFilterRecordEvent); virtual;
-    procedure SetRecNo(Value: Longint); virtual;
-    procedure SetState(Value: TDataSetState);
-    function SetTempState(const Value: TDataSetState): TDataSetState;
-    function TempBuffer: PChar;
-    procedure UpdateIndexDefs; virtual;
-    property ActiveRecord: Longint read FActiveRecord;
-    property CurrentRecord: Longint read FCurrentRecord;
-    property BlobFieldCount: Longint read FBlobFieldCount;
-    property BookmarkSize: Longint read FBookmarkSize write FBookmarkSize;
-    property Buffers[Index: Longint]: PChar read GetBuffer;
-    property BufferCount: Longint read FBufferCount;
-    property CalcBuffer: PChar read FCalcBuffer;
-    property CalcFieldsSize: Longint read FCalcFieldsSize;
-    property InternalCalcFields: Boolean read FInternalCalcFields;
-    property Constraints: TCheckConstraints read FConstraints write FConstraints;
-  protected { abstract methods }
-    function AllocRecordBuffer: PChar; virtual; abstract;
-    procedure FreeRecordBuffer(var Buffer: PChar); virtual; abstract;
-    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
-    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; virtual; abstract;
-    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; virtual; abstract;
-    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; virtual; abstract;
-    function GetRecordSize: Word; virtual; abstract;
-    procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); virtual; abstract;
-    procedure InternalClose; virtual; abstract;
-    procedure InternalDelete; virtual; abstract;
-    procedure InternalFirst; virtual; abstract;
-    procedure InternalGotoBookmark(ABookmark: Pointer); virtual; abstract;
-    procedure InternalHandleException; virtual; abstract;
-    procedure InternalInitFieldDefs; virtual; abstract;
-    procedure InternalInitRecord(Buffer: PChar); virtual; abstract;
-    procedure InternalLast; virtual; abstract;
-    procedure InternalOpen; virtual; abstract;
-    procedure InternalPost; virtual; abstract;
-    procedure InternalSetToRecord(Buffer: PChar); virtual; abstract;
-    function IsCursorOpen: Boolean; virtual; abstract;
-    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); virtual; abstract;
-    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); virtual; abstract;
-    procedure SetFieldData(Field: TField; Buffer: Pointer); virtual; abstract;
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-    function ActiveBuffer: PChar;
-    procedure Append;
-    procedure AppendRecord(const Values: array of const);
-    function BookmarkValid(ABookmark: TBookmark): Boolean; virtual;
-    procedure Cancel; virtual;
-    procedure CheckBrowseMode;
-    procedure ClearFields;
-    procedure Close;
-    function  ControlsDisabled: Boolean;
-    function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Longint; virtual;
-    function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; virtual;
-    procedure CursorPosChanged;
-    procedure Delete;
-    procedure DisableControls;
-    procedure Edit;
-    procedure EnableControls;
-    function FieldByName(const FieldName: string): TField;
-    function FindField(const FieldName: string): TField;
-    function FindFirst: Boolean;
-    function FindLast: Boolean;
-    function FindNext: Boolean;
-    function FindPrior: Boolean;
-    procedure First;
-    procedure FreeBookmark(ABookmark: TBookmark); virtual;
-    function GetBookmark: TBookmark; virtual;
-    function GetCurrentRecord(Buffer: PChar): Boolean; virtual;
-    procedure GetFieldList(List: TList; const FieldNames: string);
-    procedure GetFieldNames(List: TStrings);
-    procedure GotoBookmark(ABookmark: TBookmark);
-    procedure Insert;
-    procedure InsertRecord(const Values: array of const);
-    function IsEmpty: Boolean;
-    function IsSequenced: Boolean; virtual;
-    procedure Last;
-    function MoveBy(Distance: Longint): Longint;
-    procedure Next;
-    procedure Open;
-    procedure Post; virtual;
-    procedure Prior;
-    procedure Refresh;
-    procedure Resync(Mode: TResyncMode); virtual;
-    procedure SetFields(const Values: array of const);
-    procedure Translate(Src, Dest: PChar; ToOem: Boolean); virtual;
-    procedure UpdateCursorPos;
-    procedure UpdateRecord;
-    property BOF: Boolean read FBOF;
-    property Bookmark: TBookmarkStr read GetBookmarkStr write SetBookmarkStr;
-    property CanModify: Boolean read GetCanModify;
-    property DefaultFields: Boolean read FDefaultFields;
-    property EOF: Boolean read FEOF;
-    property FieldCount: Longint read GetFieldCount;
-    property FieldDefs: TFieldDefs read FFieldDefs write FFieldDefs;
-    property Fields[Index: Longint]: TField read GetField write SetField;
-    property Found: Boolean read FFound;
-    property Modified: Boolean read FModified;
-    property RecordCount: Longint read GetRecordCount;
-    property RecNo: Longint read FRecNo write FRecNo;
-    property RecordSize: Word read FRecordSize;
-    property State: TDataSetState read FState;
-    property Fields : TFields Read FFieldList;
-    property Filter: string read FFilterText write FFilterText;
-    property Filtered: Boolean read FFiltered write FFiltered default False;
-    property FilterOptions: TFilterOptions read FFilterOptions write FFilterOptions;
-    property Active: Boolean read FActive write SetActive default False;
-    property AutoCalcFields: Boolean read FAutoCalcFields write FAutoCalcFields;
-    property BeforeOpen: TDataSetNotifyEvent read FBeforeOpen write FBeforeOpen;
-    property AfterOpen: TDataSetNotifyEvent read FAfterOpen write FAfterOpen;
-    property BeforeClose: TDataSetNotifyEvent read FBeforeClose write FBeforeClose;
-    property AfterClose: TDataSetNotifyEvent read FAfterClose write FAfterClose;
-    property BeforeInsert: TDataSetNotifyEvent read FBeforeInsert write FBeforeInsert;
-    property AfterInsert: TDataSetNotifyEvent read FAfterInsert write FAfterInsert;
-    property BeforeEdit: TDataSetNotifyEvent read FBeforeEdit write FBeforeEdit;
-    property AfterEdit: TDataSetNotifyEvent read FAfterEdit write FAfterEdit;
-    property BeforePost: TDataSetNotifyEvent read FBeforePost write FBeforePost;
-    property AfterPost: TDataSetNotifyEvent read FAfterPost write FAfterPost;
-    property BeforeCancel: TDataSetNotifyEvent read FBeforeCancel write FBeforeCancel;
-    property AfterCancel: TDataSetNotifyEvent read FAfterCancel write FAfterCancel;
-    property BeforeDelete: TDataSetNotifyEvent read FBeforeDelete write FBeforeDelete;
-    property AfterDelete: TDataSetNotifyEvent read FAfterDelete write FAfterDelete;
-    property BeforeScroll: TDataSetNotifyEvent read FBeforeScroll write FBeforeScroll;
-    property AfterScroll: TDataSetNotifyEvent read FAfterScroll write FAfterScroll;
-    property OnCalcFields: TDataSetNotifyEvent read FOnCalcFields write FOnCalcFields;
-    property OnDeleteError: TDataSetErrorEvent read FOnDeleteError write FOnDeleteError;
-    property OnEditError: TDataSetErrorEvent read FOnEditError write FOnEditError;
-    property OnFilterRecord: TFilterRecordEvent read FOnFilterRecord write SetOnFilterRecord;
-    property OnNewRecord: TDataSetNotifyEvent read FOnNewRecord write FOnNewRecord;
-    property OnPostError: TDataSetErrorEvent read FOnPostError write FOnPostError;
-  end;
-
- { TDBDataset }
-
-  TDBDatasetClass = Class of TDBDataset;
-  TDBDataset = Class(TDataset)
-    Private
-      FDatabase : TDatabase;
-      Procedure SetDatabase (Value : TDatabase);
-    Published
-      Property DataBase : TDatabase Read FDatabase Write SetDatabase;
-    end;
-
-  { TDatabase }
-
-  TLoginEvent = procedure(Database: TDatabase;
-    LoginParams: TStrings) of object;
-
-  TDatabaseClass = Class Of TDatabase;
-
-  TDatabase = class(TComponent)
-  private
-    FConnected : Boolean;
-    FDataBaseName : String;
-    FDataSets : TList;
-    FDirectOry : String;
-    FKeepConnection : Boolean;
-    FLoginPrompt : Boolean;
-    FOnLogin : TLoginEvent;
-    FParams : TStrings;
-    FSQLBased : Boolean;
-    Function GetDataSetCount : Longint;
-    Function GetDataset(Index : longint) : TDBDataset;
-    procedure SetConnected (Value : boolean);
-    procedure RegisterDataset (DS : TDBDataset);
-    procedure UnRegisterDataset (DS : TDBDataset);
-    procedure RemoveDataSets;
-  protected
-    Procedure CheckConnected;
-    Procedure CheckDisConnected;
-    procedure Loaded; override;
-    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
-    Procedure DoInternalConnect; Virtual;Abstract;
-    Procedure DoInternalDisConnect; Virtual;Abstract;
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-    procedure Close;
-    procedure Open;
-    procedure CloseDataSets;
-    procedure StartTransaction; virtual; abstract;
-    procedure EndTransaction; virtual; abstract;
-    property DataSetCount: Longint read GetDataSetCount;
-    property DataSets[Index: Longint]: TDBDataSet read GetDataSet;
-    property Directory: string read FDirectory write FDirectory;
-    property IsSQLBased: Boolean read FSQLBased;
-  published
-    property Connected: Boolean read FConnected write SetConnected;
-    property DatabaseName: string read FDatabaseName write FDatabaseName;
-    property KeepConnection: Boolean read FKeepConnection write FKeepConnection;
-    property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt;
-    property Params : TStrings read FParams Write FParams;
-    property OnLogin: TLoginEvent read FOnLogin write FOnLogin;
-  end;
-
-Const
-  Fieldtypenames : Array [TFieldType] of String[15] =
-    ( 'Unknown',
-      'String',
-      'Smallint',
-      'Integer',
-      'Word',
-      'Boolean',
-      'Float',
-      'Date',
-      'Time',
-      'DateTime',
-      'Bytes',
-      'VarBytes',
-      'AutoInc',
-      'Blob',
-      'Memo',
-      'Graphic',
-      'FmtMemo',
-      'ParadoxOle',
-      'DBaseOle',
-      'TypedBinary',
-      'Cursor'
-    );
-{ Auxiliary functions }
-
-Procedure DatabaseError (Const Msg : String);
-Procedure DatabaseError (Const Msg : String; Comp : TComponent);
-Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
-Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
-                            Comp : TComponent);
-
-implementation
-
-{ ---------------------------------------------------------------------
-    Auxiliary functions
-  ---------------------------------------------------------------------}
-
-
-
-Procedure DatabaseError (Const Msg : String);
-
-begin
-  Raise EDataBaseError.Create(Msg);
-end;
-
-Procedure DatabaseError (Const Msg : String; Comp : TComponent);
-
-begin
-  Raise EDatabaseError.CreateFmt('%s : %s',[Comp.Name,Msg]);
-end;
-
-Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of Const);
-
-begin
-  Raise EDatabaseError.CreateFmt(Fmt,Args);
-end;
-
-Procedure DatabaseErrorFmt (Const Fmt : String; Args : Array Of const;
-                            Comp : TComponent);
-begin
-  Raise EDatabaseError.CreateFmt(Format('%s : %s',[Comp.Name,Fmt]),Args);
-end;
-
-
-{$i dbs.inc}
-
-{ TIndexDef }
-
-constructor TIndexDef.Create(Owner: TIndexDefs; const AName, TheFields: string;
-      TheOptions: TIndexOptions);
-
-begin
-  //!! To be implemented
-end;
-
-
-
-destructor TIndexDef.Destroy;
-
-begin
-  //!! To be implemented
-end;
-
-
-{ TIndexDefs }
-
-Function TIndexDefs.GetItem (Index : longint) : TindexDef;
-
-begin
-  //!! To be implemented
-end;
-
-
-constructor TIndexDefs.Create(DataSet: TDataSet);
-
-begin
-  //!! To be implemented
-end;
-
-
-destructor TIndexDefs.Destroy;
-
-begin
-  //!! To be implemented
-end;
-
-
-procedure TIndexDefs.Add(const Name, Fields: string; Options: TIndexOptions);
-
-begin
-  //!! To be implemented
-end;
-
-
-procedure TIndexDefs.Assign(IndexDefs: TIndexDefs);
-
-begin
-  //!! To be implemented
-end;
-
-
-procedure TIndexDefs.Clear;
-
-begin
-  //!! To be implemented
-end;
-
-
-function TIndexDefs.FindIndexForFields(const Fields: string): TIndexDef;
-
-begin
-  //!! To be implemented
-end;
-
-
-function TIndexDefs.GetIndexForFields(const Fields: string;
-  CaseInsensitive: Boolean): TIndexDef;
-
-begin
-  //!! To be implemented
-end;
-
-
-function TIndexDefs.IndexOf(const Name: string): Longint;
-
-begin
-  //!! To be implemented
-end;
-
-
-procedure TIndexDefs.Update;
-
-begin
-  //!! To be implemented
-end;
-
-
-
-{ TCheckConstraint }
-
-procedure TCheckConstraint.Assign(Source: TPersistent);
-
-begin
-  //!! To be implemented
-end;
-
-
-
-{ TCheckConstraints }
-
-Function TCheckConstraints.GetItem(Index : Longint) : TCheckConstraint;
-
-begin
-  //!! To be implemented
-end;
-
-
-Procedure TCheckConstraints.SetItem(index : Longint; Value : TCheckConstraint);
-
-begin
-  //!! To be implemented
-end;
-
-
-function TCheckConstraints.GetOwner: TPersistent;
-
-begin
-  //!! To be implemented
-end;
-
-
-constructor TCheckConstraints.Create(Owner: TPersistent);
-
-begin
-  //!! To be implemented
-end;
-
-
-function TCheckConstraints.Add: TCheckConstraint;
-
-begin
-  //!! To be implemented
-end;
-
-
-
-{$i dataset.inc}
-{$i fields.inc}
-{$i database.inc}
-
-end.
-
-{
-  $Log$
-  Revision 1.5  1999-11-12 22:53:32  michael
-  + Added append() insert() tested append. Datetime as string works now
-
-  Revision 1.4  1999/11/11 17:31:09  michael
-  + Added Checks for all simple field types.
-  + Initial implementation of Insert/Append
-
-  Revision 1.3  1999/11/09 13:33:47  peter
-    * reallocmem fixes
-
-  Revision 1.2  1999/10/24 17:07:54  michael
-  + Added copyright header
-
-}

fcl/db/dbs.inc

@@ -1,58 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999 by Michael Van Canneyt, member of the
-    Free Pascal development team
-
-    Constants used for displaying messages in DB unit
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-Const
-  SUnknownFieldType = 'Unknown field type : %s';
-  SUnknownField = 'No field named "%s" was found in dataset "%s"';
-  SNeedFieldName = 'Field needs a name';  
-  SInvalidTypeConversion = 'Invalid type conversion to %s in field %s';
-  SReadOnlyField = 'Field %s cannot be modified, it is read-only.';
-  SInvalidFieldSize = 'Invalid field size : %d';
-  SNoDataset = 'No dataset asssigned for field : "%s"';
-  SDuplicateFieldName = 'Duplicate fieldname : "%s"';
-  SFieldNotFound = 'Field not found : "%s"';
-  SInvalidFieldKind = '%s : invalid field kind : ';
-  SRangeError = '%f is not between %f and %f for %s';
-  SNotAninteger = '"%s" is not a valid integer';
-  SCantSetAutoIncFields = 'AutoInc Fields are read-only';
-  SNotAFloat = '"%s" is not a valid float';
-  SInvalidDisplayValues = '"%s" are not valid boolean displayvalues';
-  SNotABoolean = '"%s" is not a valid boolean';
-  SInactiveDataset = 'Operation cannot be performed on an inactive dataset';
-  SActiveDataset = 'Operation cannot be performed on an active dataset';
-  SNoDatasets = 'No datasets are attached to the database';
-  SDatasetRegistered = 'Dataset already registered : "%s"';
-  SNoDatasetRegistered = 'No such dataset registered : "%s"';
-  SNotConnected = 'Operation cannot be performed on an disconnected database';
-  SConnected = 'Operation cannot be performed on an connected database';
-  SNoSuchRecord = 'Could not find the requested record.';  
-  SDatasetReadOnly = 'Dataset is read-only.';
-  SNeedField = 'Field %s is required, but not supplied.';
-  
-{
-  $Log$
-  Revision 1.4  1999-11-12 22:53:32  michael
-  + Added append() insert() tested append. Datetime as string works now
-
-  Revision 1.3  1999/11/11 17:31:09  michael
-  + Added Checks for all simple field types.
-  + Initial implementation of Insert/Append
-
-  Revision 1.2  1999/10/24 17:07:54  michael
-  + Added copyright header
-
-}  

fcl/db/ddg_ds.pp

@@ -1,529 +0,0 @@
-unit DDG_DS;
-
-{$define dsdebug}
-
-interface
-
-uses Db, Classes, DDG_Rec;
-
-type
-
-  PInteger =  ^Integer;
-  
-  // Bookmark information record to support TDataset bookmarks:
-  PDDGBookmarkInfo = ^TDDGBookmarkInfo;
-  TDDGBookmarkInfo = record
-    BookmarkData: Integer;
-    BookmarkFlag: TBookmarkFlag;
-  end;
-
-  // List used to maintain access to file of record:
-  TIndexList = class(TList)
-  public
-    procedure LoadFromFile(const FileName: string); virtual;
-    procedure LoadFromStream(Stream: TStream); virtual;
-    procedure SaveToFile(const FileName: string); virtual;
-    procedure SaveToStream(Stream: TStream); virtual;
-  end;
-
-  // Specialized DDG TDataset descendant for our "table" data:
-  TDDGDataSet = class(TDataSet)
-  private
-    function GetDataFileSize: Integer;
-  public
-    FDataFile: TDDGDataFile;
-    FIdxName: string;
-    FIndexList: TIndexList;
-    FTableName: string;
-    FRecordPos: Integer;
-    FRecordSize: Integer;
-    FBufferSize: Integer;
-    procedure SetTableName(const Value: string);
-  protected
-    { Mandatory overrides }
-    // Record buffer methods:
-    function AllocRecordBuffer: PChar; override;
-    procedure FreeRecordBuffer(var Buffer: PChar); override;
-    procedure InternalInitRecord(Buffer: PChar); override;
-    function GetRecord(Buffer: PChar; GetMode: TGetMode;
-      DoCheck: Boolean): TGetResult; override;
-    function GetRecordSize: Word; override;
-    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
-    // Bookmark methods:
-    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
-    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
-    procedure InternalGotoBookmark(ABookmark: Pointer); override;
-    procedure InternalSetToRecord(Buffer: PChar); override;
-    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
-    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
-    // Navigational methods:
-    procedure InternalFirst; override;
-    procedure InternalLast; override;
-    // Editing methods:
-    procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
-    procedure InternalDelete; override;
-    procedure InternalPost; override;
-    // Misc methods:
-    procedure InternalClose; override;
-    procedure InternalHandleException; override;
-    procedure InternalInitFieldDefs; override;
-    procedure InternalOpen; override;
-    function IsCursorOpen: Boolean; override;
-    { Optional overrides }
-    function GetRecordCount: Integer; override;
-    function GetRecNo: Integer; override;
-    procedure SetRecNo(Value: Integer); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
-
-    // Additional procedures
-    procedure EmptyTable;
-  published
-    property Active;
-    property TableName: string read FTableName write SetTableName;
-    property BeforeOpen;
-    property AfterOpen;
-    property BeforeClose;
-    property AfterClose;
-    property BeforeInsert;
-    property AfterInsert;
-    property BeforeEdit;
-    property AfterEdit;
-    property BeforePost;
-    property AfterPost;
-    property BeforeCancel;
-    property AfterCancel;
-    property BeforeDelete;
-    property AfterDelete;
-    property BeforeScroll;
-    property AfterScroll;
-    property OnDeleteError;
-    property OnEditError;
-
-    // Additional Properties
-    property DataFileSize: Integer read GetDataFileSize;
-  end;
-
-implementation
-
-uses SysUtils;
-
-const
-  feDDGTable = '.ddg';
-  feDDGIndex = '.ddx';
-  // note that file is not being locked!
-
-{ TIndexList }
-
-procedure TIndexList.LoadFromFile(const FileName: string);
-var
-  F: TFileStream;
-begin
-  F := TFileStream.Create(FileName, fmOpenRead);
-  try
-    LoadFromStream(F);
-  finally
-    F.Free;
-  end;
-end;
-
-procedure TIndexList.LoadFromStream(Stream: TStream);
-var
-  Value: Integer;
-begin
-  while Stream.Position < Stream.Size do
-  begin
-    Stream.Read(Value, SizeOf(Value));
-    Add(Pointer(Value));
-  end;
-end;
-
-procedure TIndexList.SaveToFile(const FileName: string);
-var
-  F: TFileStream;
-begin
-  F := TFileStream.Create(FileName, fmCreate);
-  try
-    SaveToStream(F);
-  finally
-    F.Free;
-  end;
-end;
-
-procedure TIndexList.SaveToStream(Stream: TStream);
-var
-  i: Integer;
-  Value: Integer;
-begin
-  for i := 0 to Count - 1 do
-  begin
-    Value := Integer(Items[i]);
-    Stream.Write(Value, SizeOf(Value));
-  end;
-end;
-
-{ TDDGDataSet }
-
-constructor TDDGDataSet.Create(AOwner: TComponent);
-begin
-  FIndexList := TIndexList.Create;
-  FRecordSize := SizeOf(TDDGData);
-  FBufferSize := FRecordSize + SizeOf(TDDGBookmarkInfo);
-  inherited Create(AOwner);
-end;
-
-destructor TDDGDataSet.Destroy;
-begin
-  inherited Destroy;
-  FIndexList.Free;
-end;
-
-function TDDGDataSet.AllocRecordBuffer: PChar;
-begin
-  Result := AllocMem(FBufferSize);
-end;
-
-procedure TDDGDataSet.FreeRecordBuffer(var Buffer: PChar);
-begin
-  FreeMem(Buffer);
-end;
-
-procedure TDDGDataSet.InternalInitRecord(Buffer: PChar);
-begin
-  FillChar(Buffer^, FBufferSize, 0);
-end;
-
-function TDDGDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
-  DoCheck: Boolean): TGetResult;
-var
-  IndexPos: Integer;
-begin
- if FIndexList.Count < 1 then
-    Result := grEOF
-  else begin
-    Result := grOk;
-    case GetMode of
-      gmPrior:
-        if FRecordPos <= 0 then
-        begin
-          Result := grBOF;
-          FRecordPos := -1;
-        end
-        else
-          Dec(FRecordPos);
-      gmCurrent:
-        if (FRecordPos < 0) or (FRecordPos >= RecordCount) then
-           Result := grError;
-      gmNext:
-        if FRecordPos >= RecordCount-1 then
-          Result := grEOF
-        else
-          Inc(FRecordPos);
-    end;
-    if Result = grOk then
-    begin
-      IndexPos := Integer(FIndexList[FRecordPos]);
-      Seek(FDataFile, IndexPos);
-      BlockRead(FDataFile, PDDGData(Buffer)^, 1);
-      with PDDGBookmarkInfo(Buffer + FRecordSize)^ do
-      begin
-        BookmarkData := FRecordPos;
-        BookmarkFlag := bfCurrent;
-      end;
-    end
-    else if (Result = grError) and DoCheck then
-      DatabaseError('No records');
-  end;
-end;
-
-function TDDGDataSet.GetRecordSize: Word;
-begin
-  Result := FRecordSize;
-end;
-
-function TDDGDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
-begin
-  Result := True;
-  case Field.Index of
-    0:
-      begin
-        Move(ActiveBuffer^, Buffer^, Field.Size);
-        Result := PChar(Buffer)^ <> #0;
-      end;
-    1: Move(PDDGData(ActiveBuffer)^.Height, Buffer^, Field.DataSize);
-    2: Move(PDDGData(ActiveBuffer)^.LongField, Buffer^, Field.DataSize);
-    3: Move(PDDGData(ActiveBuffer)^.ShoeSize, Buffer^, Field.DataSize);
-    4: Move(PDDGData(ActiveBuffer)^.WordField, Buffer^, Field.DataSize);
-    5: Move(PDDGData(ActiveBuffer)^.DateTimeField, Buffer^, Field.DataSize);
-    6: Move(PDDGData(ActiveBuffer)^.TimeField, Buffer^, Field.DataSize);
-    7: Move(PDDGData(ActiveBuffer)^.DateField, Buffer^, Field.DataSize);
-    8: Move(PDDGData(ActiveBuffer)^.Even, Buffer^, Field.DataSize);
-  end;
-end;
-
-procedure TDDGDataSet.SetFieldData(Field: TField; Buffer: Pointer);
-begin
-  case Field.Index of
-    0: Move(Buffer^, ActiveBuffer^, Field.Size);
-    1: Move(Buffer^, PDDGData(ActiveBuffer)^.Height, Field.DataSize);
-    2: Move(Buffer^, PDDGData(ActiveBuffer)^.LongField, Field.DataSize);
-    3: Move(Buffer^, PDDGData(ActiveBuffer)^.ShoeSize, Field.DataSize);
-    4: Move(Buffer^, PDDGData(ActiveBuffer)^.WordField, Field.DataSize);
-    5: Move(Buffer^, PDDGData(ActiveBuffer)^.DateTimeField, Field.DataSize);
-    6: Move(Buffer^, PDDGData(ActiveBuffer)^.TimeField, Field.DataSize);
-    7: Move(Buffer^, PDDGData(ActiveBuffer)^.DateField, Field.DataSize);
-    8: Move(Buffer^, PDDGData(ActiveBuffer)^.Even, Field.DataSize);
-  end;
-  DataEvent(deFieldChange, Longint(Field));
-end;
-
-procedure TDDGDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
-begin
-  PInteger(Data)^ := PDDGBookmarkInfo(Buffer + FRecordSize)^.BookmarkData;
-end;
-
-function TDDGDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
-begin
-  Result := PDDGBookmarkInfo(Buffer + FRecordSize)^.BookmarkFlag;
-end;
-
-procedure TDDGDataSet.InternalGotoBookmark(ABookmark: Pointer);
-begin
-  FRecordPos := PInteger(ABookmark)^;
-  Writeln ('Bookmark : Setting record position to : ',FrecordPos);
-end;
-
-procedure TDDGDataSet.InternalSetToRecord(Buffer: PChar);
-begin
-  // bookmark value is the same as an offset into the file
-  FRecordPos := PDDGBookmarkInfo(Buffer + FRecordSize)^.Bookmarkdata;
-end;
-
-procedure TDDGDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
-begin
-  PDDGBookmarkInfo(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;
-end;
-
-procedure TDDGDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
-begin
-  PDDGBookmarkInfo(Buffer + FRecordSize)^.BookmarkFlag := Value;
-end;
-
-procedure TDDGDataSet.InternalFirst;
-begin
-  FRecordPos := -1;
-end;
-
-procedure TDDGDataSet.InternalInitFieldDefs;
-begin
-  // create FieldDefs which map to each field in the data record
-  FieldDefs.Clear;
-  TFieldDef.Create(FieldDefs, 'Name', ftString, SizeOf(TNameStr), False, 1);
-  TFieldDef.Create(FieldDefs, 'Height', ftFloat, 0, False, 2);
-  TFieldDef.Create(FieldDefs, 'LongField',ftInteger, 0, False, 3);
-  TFieldDef.Create(FieldDefs, 'ShoeSize', ftSmallint, 0, False, 4);
-  TFieldDef.Create(FieldDefs, 'WordField', ftword, 0, false, 5);
-  TFieldDef.Create(FieldDefs, 'DateTimeField', ftDateTime, 0, false, 6);
-  TFieldDef.Create(FieldDefs, 'TimeField',ftTime, 0, false, 7);
-  TFieldDef.Create(FieldDefs, 'DateField',ftDate, 0, false, 8);
-  TFieldDef.Create(FieldDefs, 'Booleanfield',ftboolean, 0, False, 9); 
-end;
-
-procedure TDDGDataSet.InternalLast;
-begin
-  FRecordPos := FIndexList.Count;
-end;
-
-procedure TDDGDataSet.InternalClose;
-begin
-  if FileRec(FDataFile).Mode <> 0 then
-    CloseFile(FDataFile);
-  FIndexList.SaveToFile(FIdxName);
-  FIndexList.Clear;
-  if DefaultFields then
-    DestroyFields;
-  FRecordPos := -1;
-  FillChar(FDataFile, SizeOf(FDataFile), 0);
-end;
-
-procedure TDDGDataSet.InternalHandleException;
-begin
-  // standard implementation for this method:
-  // Application.HandleException(Self);
-end;
-
-procedure TDDGDataSet.InternalDelete;
-begin
-  FIndexList.Delete(FRecordPos);
-  if FRecordPos >= FIndexList.Count then Dec(FRecordPos);
-end;
-
-procedure TDDGDataSet.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
-var
-  RecPos: Integer;
-begin
-  Seek(FDataFile, FileSize(FDataFile));
-  BlockWrite(FDataFile, PDDGData(Buffer)^, 1);
-  if DoAppend then
-  begin
-    FIndexList.Add(Pointer(FileSize(FDataFile) - 1));
-    InternalLast;
-  end
-  else begin
-    if FRecordPos = -1 then RecPos := 0
-    else RecPos := FRecordPos;
-    FIndexList.Insert(RecPos, Pointer(FileSize(FDataFile) - 1));
-  end;
-  FIndexList.SaveToFile(FIdxName);
-end;
-
-procedure TDDGDataSet.InternalOpen;
-var
-  HFile: THandle;
-begin
-  // make sure table and index files exist
-  FIdxName := ChangeFileExt(FTableName, feDDGIndex);
-  if not (FileExists(FTableName) and FileExists(FIdxName)) then
-    begin
- {
-    if MessageDlg('Table or index file not found.  Create new table?',
-      mtConfirmation, [mbYes, mbNo], 0) = mrYes then
-    begin
-      HFile := FileCreate(FTableName);
-      if HFile = -1 then
-        DatabaseError('Error creating table file');
-      FileClose(HFile);
-      HFile := FileCreate(FIdxName);
-      if HFile = -1 then
-        DatabaseError('Error creating index file');
-      FileClose(HFile);
-    end
-   else
- }  
-      DatabaseError('Could not open table');
-  end;
-  // open data file
-  FileMode := fmOpenReadWrite;
-  Writeln ('OPening data file');
-  AssignFile(FDataFile, FTableName);
-  Reset(FDataFile);  
-  try
-    writeln ('Loading index file');
-    FIndexList.LoadFromFile(FIdxName); // initialize index TList from file
-    FRecordPos := -1;                  // initial record pos before BOF
-    BookmarkSize := SizeOf(Integer);   // initialize bookmark size for VCL
-    InternalInitFieldDefs;             // initialize FieldDef objects
-    // Create TField components when no persistent fields have been created
-    {$ifdef dsdebug}
-    writeln ('Creating Fields');
-    {$endif}
-    if DefaultFields then CreateFields;
-    {$ifdef dsdebug}
-    writeln ('Binding Fields');
-    {$endif}
-    BindFields(True);                  // bind FieldDefs to actual data
-  except
-    {$ifdef dsdebug}
-    Writeln ('Caught Exception !!');
-    {$endif}
-    CloseFile(FDataFile);
-    FillChar(FDataFile, SizeOf(FDataFile), 0);
-    raise;
-  end;
- {$ifdef dsdebug}
-  Writeln ('End of internalopen');
- {$endif}
-end;
-
-procedure TDDGDataSet.InternalPost;
-var
-  RecPos, InsPos: Integer;
-begin
- {$ifdef dsdebug}
-  Writeln ('Starting internal post.');
- {$endif}
-  if FRecordPos = -1 then
-    RecPos := 0
-  else begin
-    if State = dsEdit then RecPos := Integer(FIndexList[FRecordPos])
-    else RecPos := FileSize(FDataFile);
-  end;
-  Seek(FDataFile, RecPos);
- {$ifdef dsdebug}
-  Writeln ('Writing record to disk.');
- {$endif}
-  BlockWrite(FDataFile, PDDGData(ActiveBuffer)^, 1);
-  if State <> dsEdit then
-  begin
-    if FRecordPos = -1 then InsPos := 0
-    else InsPos := FRecordPos;
-    FIndexList.Insert(InsPos, Pointer(RecPos));
-  end;
- {$ifdef dsdebug}
-  Writeln ('Writing index to disk.');
- {$endif}
-  FIndexList.SaveToFile(FIdxName);
-end;
-
-function TDDGDataSet.IsCursorOpen: Boolean;
-begin
-  Result := FileRec(FDataFile).Mode <> 0;
-end;
-
-function TDDGDataSet.GetRecordCount: Integer;
-begin
-  Result := FIndexList.Count;
-end;
-
-function TDDGDataSet.GetRecNo: Integer;
-begin
-  UpdateCursorPos;
-  if (FRecordPos = -1) and (RecordCount > 0) then
-    Result := 1
-  else
-    Result := FRecordPos + 1;
-end;
-
-procedure TDDGDataSet.SetRecNo(Value: Integer);
-begin
-  if (Value >= 0) and (Value <= FIndexList.Count-1) then
-  begin
-    FRecordPos := Value - 1;
-    Resync([]);
-  end;
-end;
-
-procedure TDDGDataSet.SetTableName(const Value: string);
-begin
-  CheckInactive;
-  FTableName := Value;
-  if ExtractFileExt(FTableName) = '' then
-    FTableName := FTableName + feDDGTable;
-  FIdxName := ChangeFileExt(FTableName, feDDGIndex);
-end;
-
-function TDDGDataSet.GetDataFileSize: Integer;
-begin
-  Result := FileSize(FDataFile);
-end;
-
-procedure TDDGDataSet.EmptyTable;
-var
-  HFile: THandle;
-begin
-  Close;
-
-  DeleteFile(FTableName);
-  HFile := FileCreate(FTableName);
-  FileClose(HFile);
-
-  DeleteFile(FIdxName);
-  HFile := FileCreate(FIdxName);
-  FileClose(HFile);
-
-  Open;
-end;
-
-end.

fcl/db/ddg_rec.pp

@@ -1,32 +0,0 @@
-unit DDG_Rec;
-
-interface
-
-uses sysutils;
-
-type
-
-  // arbitary-length array of char used for name field
-  TNameStr = array[0..31] of char;
-
-  // this record info represents the "table" structure:
-  PDDGData = ^TDDGData;
-  TDDGData = record
-    Name: TNameStr;
-    Height: Extended;
-    LongField : Longint;
-    ShoeSize: SmallInt;
-    WordField : Word;
-    DatetimeField : TDateTime;
-    TimeField : TDateTime;
-    DateField : TDateTime;
-    Even : Boolean;
-  end;
-
-  // Pascal file of record which holds "table" data:
-  TDDGDataFile = file of TDDGData;
-
-
-implementation
-
-end.

fcl/db/fields.inc

@@ -1,1765 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999 by Michael Van Canneyt, member of the 
-    Free Pascal development team
-
-    TFields and related components implementations.
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-PRocedure DumpMem (P : Pointer;Size : Longint);
-
-Type PByte = ^Byte;
-
-Var i : longint;
-
-begin
-  Write ('Memory dump : ');
-  For I:=0 to Size-1 do
-    Write (Pbyte(P)[i],' ');
-  Writeln;  
-end;
-
-{ ---------------------------------------------------------------------
-    TFieldDef
-  ---------------------------------------------------------------------}
-     
-Constructor TFieldDef.Create(AOwner: TFieldDefs; const AName: string;
-      ADataType: TFieldType; ASize: Word; ARequired: Boolean; AFieldNo: Longint);
-
-begin
-  Inherited Create(AOwner);
-  FName:=Aname;
-  FDatatype:=ADatatype;
-  FSize:=ASize;
-  FRequired:=ARequired;
-  FPrecision:=-1;
-  // Correct sizes.
-  If FDataType=ftFloat then
-    begin
-    If Not FSize in [4,8,10] then FSize:=10
-    end
-  else If FDataType in [ftWord,ftsmallint,ftinteger] Then
-    If Not FSize in [1,2,4] then FSize:=4;
-  FFieldNo:=AFieldNo;
-  AOwner.FItems.Add(Self);
-end;
-
-Destructor TFieldDef.Destroy;
-
-Var I : longint;
-
-begin
-  Inherited destroy;
-end;
-
-Function TFieldDef.CreateField(AOwner: TComponent): TField;
-
-Var TheField : TFieldClass;
-
-begin
-  Writeln ('Creating field');
-  TheField:=GetFieldClass;
-  if TheField=Nil then
-    DatabaseErrorFmt(SUnknownFieldType,[FName]);
-  Result:=Thefield.Create(AOwner);
-  Try
-    Result.Size:=FSize;
-    Result.Required:=FRequired;
-    Result.FieldName:=FName;
-    Result.SetFieldType(DataType);
-    Writeln ('Trying to set dataset');
-    Result.Dataset:=TFieldDefs(Owner).FDataset;
-    If Result is TFloatField then
-      TFloatField(Result).Precision:=FPrecision;
-  except
-    Result.Free;
-    Raise;
-  end;
-end;
-
-Function TFieldDef.GetFieldClass : TFieldClass;
-
-begin
-  //!! Should be owner as tdataset but that doesn't work ??
-  
-  If Assigned(Owner) then
-    Result:=TFieldDefs(Owner).FDataSet.GetFieldClass(FDataType)
-  else
-    Result:=Nil;  
-end;
-
-{ ---------------------------------------------------------------------
-    TFieldDefs
-  ---------------------------------------------------------------------}
-
-destructor TFieldDefs.Destroy;
-
-begin
-  FItems.Free;
-  // This will destroy all fielddefs since we own them...
-  Inherited Destroy;
-end;
-
-procedure TFieldDefs.Add(const AName: string; ADataType: TFieldType; ASize: Word;
-  ARequired: Boolean);
-
-begin
-  Writeln ('Adding fielddef');
-  If Length(Name)=0 Then 
-    DatabaseError(SNeedFieldName);
-  // the fielddef will register itself here as a owned component.
-  // fieldno is 1 based !
-  FItems.Add(TFieldDef.Create(Self,AName,ADataType,ASize,Arequired,FItems.Count+1));
-end;
-
-function TFieldDefs.GetCount: Longint;
-
-begin
-  Result:=FItems.Count;
-end;
-
-function TFieldDefs.GetItem(Index: Longint): TFieldDef;
-
-begin
-  Result:=TFieldDef(FItems[Index]);
-end;
-
-constructor TFieldDefs.Create(ADataSet: TDataSet);
-
-begin
-  Inherited Create(ADataSet);
-  FItems:=TList.Create;
-  FDataset:=ADataset;
-end;
-
-procedure TFieldDefs.Assign(FieldDefs: TFieldDefs);
-
-Var I : longint;
-
-begin
-  Clear;
-  For i:=1 to FieldDefs.Count-1 do
-    With FieldDefs[i] do 
-      Add(Name,DataType,Size,Required);
-end;
-
-procedure TFieldDefs.Clear;
-
-Var I : longint;
-
-begin
-  For I:=FItems.Count-1 downto 0 do
-    TFieldDef(Fitems[i]).Free;
-end;
-
-function TFieldDefs.Find(const AName: string): TFieldDef;
-
-Var I : longint;
-
-begin
-  I:=IndexOf(AName);
-  If I=-1 Then
-    DataBaseErrorFmt(SUnknownField,[AName,FDataSet.Name]);
-  Result:=TFieldDef(Fitems[i]);
-end;
-
-function TFieldDefs.IndexOf(const AName: string): Longint;
-
-Var I : longint;
-
-begin
-  For I:=0 to Fitems.Count-1 do
-    If AnsiCompareText(TFieldDef(FItems[I]).Name,AName)=0 then
-      begin
-      Result:=I;
-      Exit;
-      end;
-  Result:=-1;
-end;
-
-procedure TFieldDefs.Update;
-
-begin
-  FDataSet.UpdateFieldDefs;
-end;
-
-{ ---------------------------------------------------------------------
-    TField
-  ---------------------------------------------------------------------}
-
-Const 
-  SBoolean = 'Boolean';
-  SDateTime = 'TDateTime';
-  SFloat = 'Float';
-  SInteger = 'Integer';
-  SString = 'String';
-
-constructor TField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-  FVisible:=True;
-  FValidChars:=[#0..#155];
-end;
-
-destructor TField.Destroy; 
-
-begin
-  IF Assigned(FDataSet) then
-    begin
-    FDataSet.Active:=False;
-    FDataSet.RemoveField(Self);
-    end;
-  Inherited Destroy;
-end;
-
-function TField.AccessError(const TypeName: string): EDatabaseError;
-
-begin
-  Result:=EDatabaseError.CreateFmt(SinvalidTypeConversion,[TypeName,FFieldName]);
-end;
-
-procedure TField.Assign(Source: TPersistent); 
-
-begin
-  //!! To be implemented
-end;
-
-procedure TField.Change; 
-
-begin
-  If Assigned(FOnChange) Then 
-    FOnChange(Self);
-end;
-
-procedure TField.CheckInactive;
-
-begin
-  If Assigned(FDataSet) then 
-    FDataset.CheckInactive;
-end;
-
-procedure TField.Clear; 
-
-begin
-  SetData(Nil);
-end;
-
-procedure TField.DataChanged;
-
-begin
-  FDataset.DataEvent(deFieldChange,longint(Self));
-end;
-
-procedure TField.FocusControl;
-
-begin
-  FDataSet.DataEvent(deFocusControl,longint(Self));
-end;
-
-procedure TField.FreeBuffers; 
-
-begin
-  // Empty. Provided for backward compatibiliy;
-  // TDataset manages the buffers.
-end;
-
-function TField.GetAsBoolean: Boolean; 
-
-begin
-  AccessError(SBoolean);
-end;
-
-function TField.GetAsDateTime: TDateTime; 
-
-begin
-  AccessError(SdateTime);
-end;
-
-function TField.GetAsFloat: Extended; 
-
-begin
-  AccessError(SDateTime);
-end;
-
-function TField.GetAsLongint: Longint; 
-
-begin
-  AccessError(SInteger);
-end;
-
-function TField.GetAsString: string; 
-
-begin
-  AccessError(SString);
-end;
-
-function TField.GetCanModify: Boolean; 
-
-begin
-  Result:=Not ReadOnly;
-  If Result then 
-    begin
-    Result:=Assigned(DataSet);
-    If Result then
-      Result:=Not(DataSet.CanModify);
-    end;
-end;
-
-function TField.GetData(Buffer: Pointer): Boolean;
-
-begin
-  IF FDataset=Nil then
-    DatabaseErrorFmt(SNoDataset,[FieldName]);
-  If FVAlidating then
-    begin
-    result:=Not(FValueBuffer=Nil);
-    If Result then
-      Move (FValueBuffer^,Buffer^ ,DataSize);
-    end
-  else
-    Result:=FDataset.GetFieldData(Self,Buffer);
-end;
-
-function TField.GetDataSize: Word; 
-
-begin
-  Result:=0;
-end;
-
-function TField.GetDefaultWidth: Longint; 
-
-begin
-  Result:=10;
-end;
-
-function TField.GetDisplayName  : String;
-
-begin
-  If FDisplayLabel<>'' then
-    result:=FDisplayLabel
-  else
-    Result:=FFieldName;
-end;
-
-function TField.getIndex : longint;
-
-begin
-  If Assigned(FDataset) then
-    Result:=FDataset.FFieldList.IndexOf(Self)
-  else
-    Result:=-1;
-end;
-
-function TField.GetIsNull: Boolean; 
-
-begin
-  Result:=Not(GetData (Nil));
-end;
-
-function TField.GetParentComponent: TComponent; 
-
-begin
-  //!! To be implemented
-end;
-
-procedure TField.GetText(var AText: string; ADisplayText: Boolean); 
-
-begin
-  AText:=GetAsString;
-end;
-
-function TField.HasParent: Boolean; 
-
-begin
-  HasParent:=True;
-end;
-
-function TField.IsValidChar(InputChar: Char): Boolean; 
-
-begin
-  // FValidChars must be set in Create.
-  Result:=InputChar in FValidChars;
-end;
-
-procedure TField.Notification(AComponent: TComponent; Operation: TOperation); 
-
-begin
-  Inherited Notification(AComponent,Operation);
-end;
-
-procedure TField.PropertyChanged(LayoutAffected: Boolean);
-
-begin
-  If (FDataset<>Nil) and (FDataset.Active) then
-    If LayoutAffected then
-      FDataset.DataEvent(deLayoutChange,0)
-    else
-      FDataset.DataEvent(deDatasetchange,0);
-end;
-
-procedure TField.ReadState(Reader: TReader); 
-
-begin
-  //!! To be implemented
-end;
-
-procedure TField.SetAsBoolean(AValue: Boolean); 
-
-begin
-  AccessError(SBoolean);
-end;
-
-procedure TField.SetAsDateTime(AValue: TDateTime); 
-
-begin
-  AccessError(SDateTime);
-end;
-
-procedure TField.SetAsFloat(AValue: Extended); 
-
-begin
-  AccessError(SFloat);
-end;
-
-procedure TField.SetAsLongint(AValue: Longint); 
-
-begin
-  AccessError(SInteger);
-end;
-
-procedure TField.SetAsString(const AValue: string); 
-
-begin
-  AccessError(SString);
-end;
-
-procedure TField.SetData(Buffer: Pointer);
-
-begin
-  If Not Assigned(FDataset) then
-    EDatabaseError.CreateFmt(SNoDataset,[FieldName]);
-  FDataSet.SetFieldData(Self,Buffer);  
-end;
-
-Procedure TField.SetDataset (Value : TDataset);
-
-begin
-  Writeln ('Setting dataset');
-  If Value=FDataset then exit;
-  If Assigned(FDataset) Then FDataset.CheckInactive;
-  If Assigned(Value) then
-    begin
-    Value.CheckInactive;
-// ?? Identifier idents no member ??
-    Value.FFieldList.CheckFieldName(FFieldName);
-    end;
-  If Assigned(FDataset) then
-    FDataset.FFieldList.Remove(Self);
-  If Assigned(Value) then 
-    begin
-    Writeln('Adding field to list..');
-    Value.FFieldList.Add(Self);
-    end;
-  FDataset:=Value;    
-end;
-
-procedure TField.SetDataType(AValue: TFieldType);
-
-begin
-  FDataType := AValue;
-end;
-
-procedure TField.SetFieldType(AValue: TFieldType); 
-
-begin
-  //!! To be implemented
-end;
-
-procedure TField.SetParentComponent(AParent: TComponent); 
-
-begin
-  //!! To be implemented
-end;
-
-procedure TField.SetSize(AValue: Word); 
-
-begin
-  CheckInactive;
-  CheckTypeSize(AValue);
-  FSize:=AValue;
-end;
-
-procedure TField.SetText(const AValue: string); 
-
-begin
-  AsString:=AValue;
-end;
-
-procedure TField.Validate(Buffer: Pointer);
-
-begin
-  If assigned(OnValidate) Then
-    begin
-    FValueBuffer:=Buffer;
-    FValidating:=True;
-    Try
-      OnValidate(Self);
-    finally
-      FValidating:=False;
-    end;
-    end;   
-end;
-
-class function Tfield.IsBlob: Boolean; 
-
-begin
-  Result:=False;
-end;
-
-class procedure TField.CheckTypeSize(AValue: Longint); 
-
-begin
-  If (AValue<>0) and Not IsBlob Then
-    DatabaseErrorFmt(SInvalidFieldSize,[AValue]);
-end;
-
-{ ---------------------------------------------------------------------
-    TStringField
-  ---------------------------------------------------------------------}
-  
-
-constructor TStringField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-  SetDataType(ftString);
-  Size:=20;
-end;
-
-class procedure TStringField.CheckTypeSize(AValue: Longint); 
-
-begin
-  If (AValue<1) or (AValue>dsMaxStringSize) Then
-    databaseErrorFmt(SInvalidFieldSize,[AValue])
-end;
-
-function TStringField.GetAsBoolean: Boolean; 
-
-Var S : String;
-
-begin
-  S:=GetAsString;
-  result := (Length(S)>0) and (Upcase(S[1]) in ['T',YesNoChars[True]]);
-end;
-
-function TStringField.GetAsDateTime: TDateTime; 
-
-begin
-  Result:=StrToDateTime(GetAsString);
-end;
-
-function TStringField.GetAsFloat: Extended; 
-
-begin
-  Result:=StrToFloat(GetAsString);
-end;
-
-function TStringField.GetAsLongint: Longint; 
-
-begin
-  Result:=StrToInt(GetAsString);
-end;
-
-function TStringField.GetAsString: string; 
-
-begin
-  If Not GetValue(Result) then 
-    Result:='';
-end;
-
-function TStringField.GetDataSize: Word; 
-
-begin
-  Result:=Size+1;
-end;
-
-function TStringField.GetDefaultWidth: Longint; 
-
-begin
-  result:=Size;
-end;
-
-Procedure TStringField.GetText(var AText: string; DisplayText: Boolean); 
-
-begin
-    AText:=GetAsString;
-end;
-
-function TStringField.GetValue(var AValue: string): Boolean;
-
-Var Buf : TStringFieldBuffer;
-
-begin
-  Result:=GetData(@Buf);
-  If Result then
-    AValue:=Buf;
-end;
-
-procedure TStringField.SetAsBoolean(AValue: Boolean); 
-
-begin
-  If AValue Then
-    SetAsString('T')
-  else
-    SetAsString('F');
-end;
-
-procedure TStringField.SetAsDateTime(AValue: TDateTime); 
-
-begin
-  SetAsString(DateTimeToStr(AValue));
-end;
-
-procedure TStringField.SetAsFloat(AValue: Extended); 
-
-begin
-  SetAsString(FloatToStr(AValue));
-end;
-
-procedure TStringField.SetAsLongint(AValue: Longint); 
-
-begin
-  SetAsString(intToStr(AValue));
-end;
-
-procedure TStringField.SetAsString(const AValue: string); 
-
-Const NullByte : char = #0;
-
-begin
-  IF Length(AValue)=0 then
-    SetData(@NullByte)
-  else
-    SetData(@AValue[1]);  
-end;
-
-{ ---------------------------------------------------------------------
-    TNumericField
-  ---------------------------------------------------------------------}
-
-
-constructor TNumericField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-  AlignMent:=taRightJustify;
-end;
-
-procedure TNumericField.RangeError(AValue, Min, Max: Extended);
-
-begin
-  DatabaseErrorFMT(SRangeError,[AValue,Min,Max,FieldName]);
-end;
-
-procedure TNumericField.SetDisplayFormat(const AValue: string);
-
-begin
- If FDisplayFormat<>AValue then
-   begin
-   FDisplayFormat:=AValue;
-   PropertyChanged(True);
-   end;
-end;
-
-procedure TNumericField.SetEditFormat(const AValue: string);
-
-begin
-  If FEDitFormat<>AValue then
-    begin
-    FEDitFormat:=AVAlue;
-    PropertyChanged(True);
-    end;
-end;
-
-{ ---------------------------------------------------------------------
-    TLongintField
-  ---------------------------------------------------------------------}
-
-
-constructor TLongintField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-  SetDatatype(ftinteger);
-  FMinRange:=$80000000;
-  FMaxRange:=$7fffffff;
-  FValidchars:=['+','-','0'..'9'];
-end;
-
-function TLongintField.GetAsFloat: Extended; 
-
-begin
-  Result:=GetAsLongint;
-end;
-
-function TLongintField.GetAsLongint: Longint; 
-
-begin
-  If Not GetValue(Result) then 
-    Result:=0;
-end;
-
-function TLongintField.GetAsString: string; 
-
-Var L : Longint;
-
-begin
-  If GetValue(L) then
-    Result:=IntTostr(L)
-  else
-    Result:='';
-end;
-
-function TLongintField.GetDataSize: Word; 
-
-begin
-  Result:=SizeOf(Longint);
-end;
-
-procedure TLongintField.GetText(var AText: string; DisplayText: Boolean); 
-
-var l : longint;
-    fmt : string;
-
-begin
-  Atext:='';
-  If Not GetData(@l) then exit;
-  If DisplayText or (FEditFormat='') then
-    fmt:=FDisplayFormat
-  else
-    fmt:=FEditFormat;
-{  // no formatFloat yet
-  If length(fmt)<>0 then
-    AText:=FormatFloat(fmt,L)
-  else
-}
-    Str(L,AText);
-end;
-
-function TLongintField.GetValue(var AValue: Longint): Boolean;
-
-Type 
-  PSmallint = ^SmallInt;
-  PLongint = ^Longint;
-  PWord = ^Word;
-
-Var L : Longint;
-    P : PLongint;
-    
-begin
-  P:=@L;
-  Result:=GetData(P);
-  If Result then
-    Case Datatype of
-      ftInteger,ftautoinc  : AValue:=Plongint(P)^;
-      ftword               : Avalue:=Pword(P)^;
-      ftsmallint           : AValue:=PSmallint(P)^;
-    end;
-end;
-
-procedure TLongintField.SetAsFloat(AValue: Extended); 
-
-begin
-  SetAsLongint(Round(Avalue));
-end;
-
-procedure TLongintField.SetAsLongint(AValue: Longint); 
-
-begin
-  If CheckRange(AValue) then
-    SetData(@AValue)
-  else
-    RangeError(Avalue,FMinrange,FMaxRange);
-end;
-
-procedure TLongintField.SetAsString(const AValue: string); 
-
-Var L,Code : longint;
-
-begin
-  If length(AValue)=0 then
-    Clear
-  else
-    begin
-    Val(AVAlue,L,Code);
-    If Code=0 then
-      SetAsLongint(L)
-    else
-      DatabaseErrorFMT(SNotAnInteger,[Avalue]);
-    end;
-end;
-
-Function TLongintField.CheckRange(AValue : longint) : Boolean;
-
-begin
-  if FMaxValue=0 Then
-    Result:=(AValue<=FMaxRange) and (AValue>=FMinRange)
-  else
-    Result:=(AValue<=FMaxValue) and (AValue>=FMinValue);
-end;
-
-Procedure TLongintField.SetMaxValue (AValue : longint);
-
-begin
-  If (AValue>=FMinRange) and (AValue<=FMaxRange) then
-    FMaxValue:=AValue
-  else
-    RangeError(AValue,FMinRange,FMaxRange);
-end;
-
-Procedure TLongintField.SetMinValue (AValue : longint);
-
-begin
-  If (AValue>=FMinRange) and (AValue<=FMaxRange) then
-    FMinValue:=AValue
-  else
-    RangeError(AValue,FMinRange,FMaxRange);
-end;
-
-{ TSmallintField }
-
-function TSmallintField.GetDataSize: Word; 
-
-begin
-  Result:=SizeOf(SmallInt);
-end;
-
-constructor TSmallintField.Create(AOwner: TComponent); 
-
-begin
-  inherited Create(AOwner);
-  SetDataType(ftSmallInt);
-  FMinRange:=-32768;
-  FMaxRange:=32767;
-end;
-
-
-{ TWordField }
-
-function TWordField.GetDataSize: Word; 
-
-begin
-  Result:=SizeOf(Word);
-end;
-
-constructor TWordField.Create(AOwner: TComponent); 
-
-begin
-  inherited Create(AOwner);
-  SetDataType(ftWord);
-  FMinRange:=0;
-  FMaxRange:=65535;
-  FValidchars:=['+','0'..'9'];
-end;
-
-{ TAutoIncField }
-
-constructor TAutoIncField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOWner);
-  SetDataType(ftAutoInc);
-end;
-
-Procedure TAutoIncField.SetAsLongint(AValue : Longint); 
-
-begin
-  DataBaseError(SCantSetAutoIncfields);
-end;
-
-{ TFloatField }
-
-function TFloatField.GetAsFloat: Extended; 
-
-begin
-  If Not GetData(@Result) Then 
-    Result:=0.0;
-end;
-
-function TFloatField.GetAsLongint: Longint; 
-
-begin
-  Result:=Round(GetAsFloat);
-end;
-
-function TFloatField.GetAsString: string; 
-
-Var R : Extended;
-   
-begin
-  If GetData(@R) then 
-    Result:=FloatToStr(R)
-  else
-    Result:='';
-end;
-
-function TFloatField.GetDataSize: Word; 
-
-begin
-  Result:=SizeOf(Extended);
-end;
-
-procedure TFloatField.GetText(var TheText: string; DisplayText: Boolean); 
-
-Var 
-    fmt : string;
-    E : Extended;
-    
-begin
-  text:='';
-  If Not GetData(@E) then exit;
-  If DisplayText or (Length(FEditFormat) = 0) Then
-    Fmt:=FDisplayFormat 
-  else
-    Fmt:=FEditFormat;
-{  // No formatfloat yet
-  If fmt<>'' then
-    TheText:=FormatFloat(fmt,E)
-  else
-}
-    Text:=FloatToStrF(E,ffgeneral,FPrecision,0);
-end;
-
-procedure TFloatField.SetAsFloat(AValue: Extended); 
-
-begin
-  If CheckRange(AValue) then
-    SetData(@Avalue)
-  else
-    RangeError(AValue,FMinValue,FMaxValue);
-end;
-
-procedure TFloatField.SetAsLongint(AValue: Longint); 
-
-begin
-  SetAsFloat(Avalue);
-end;
-
-procedure TFloatField.SetAsString(const AValue: string); 
-
-Var R : Extended;
-    Code : longint;
-
-begin
-  Val(AVAlue,R,Code);
-  If Code<>0 then
-    DatabaseErrorFmt(SNotAFloat,[AVAlue])
-  Else
-    SetAsFloat(R);
-end;
-
-constructor TFloatField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-  SetDatatype(ftfloat);
-end;
-
-Function TFloatField.CheckRange(AValue : Extended) : Boolean;
-
-begin
-  If (FMinValue<>0) or (FmaxValue<>0) then
-    Result:=(AValue>=FMinValue) and (AVAlue<=FMAxValue)
-  else
-    Result:=True;
-end;
-
-
-{ TBooleanField }
-
-function TBooleanField.GetAsBoolean: Boolean; 
-
-begin
-  If not GetData(@Result) then 
-    Result:=False;
-end;
-
-function TBooleanField.GetAsString: string; 
-
-Var B : boolean;
-
-begin
-  If Getdata(@B) then
-    Result:=FDisplays[False,B]
-  else
-    result:='';
-end;
-
-function TBooleanField.GetDataSize: Word; 
-
-begin
-  Result:=SizeOf(Boolean);
-end;
-
-function TBooleanField.GetDefaultWidth: Longint; 
-
-begin
-  Result:=Length(FDisplays[false,false]);
-  If Result<Length(FDisplays[false,True]) then
-    Result:=Length(FDisplays[false,True]);
-end;
-
-procedure TBooleanField.SetAsBoolean(AValue: Boolean); 
-
-begin
-  SetData(@AValue);
-end;
-
-procedure TBooleanField.SetAsString(const AValue: string); 
-
-Var Temp : string;
-
-begin
-  Temp:=UpperCase(AValue);
-  If Temp=FDisplays[True,True] Then
-    SetAsBoolean(True)
-  else If Temp=FDisplays[True,False] then
-    SetAsBoolean(False)
-  else
-    DatabaseErrorFmt(SNotABoolean,[AValue]);
-end;
-
-constructor TBooleanField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-  SetDataType(ftBoolean);
-  DisplayValues:='True;False';
-end;
-
-Procedure TBooleanField.SetDisplayValues(AValue : String);
-
-Var I : longint;
-
-begin
-  If FDisplayValues<>AValue then
-    begin
-    I:=Pos(';',AValue);
-    If (I<2) or (I=Length(AValue)) then
-      DatabaseErrorFmt(SInvalidDisplayValues,[AValue]);
-    FdisplayValues:=AValue;
-    // Store display values and their uppercase equivalents;
-    FDisplays[False,True]:=Copy(AValue,1,I-1);
-    FDisplays[True,True]:=UpperCase(FDisplays[False,True]);
-    FDisplays[False,False]:=Copy(AValue,I+1,Length(AValue)-i);
-    FDisplays[True,False]:=UpperCase(FDisplays[False,False]);
-    PropertyChanged(True);
-    end;
-end;
-
-{ TDateTimeField }
-
-
-function TDateTimeField.GetAsDateTime: TDateTime; 
-
-begin
-  If Not GetData(@Result) then
-    Result:=0;
-end;
-
-
-function TDateTimeField.GetAsFloat: Extended; 
-
-begin
-  Result:=GetAsdateTime;
-end;
-
-
-function TDateTimeField.GetAsString: string; 
-
-begin
-  GetText(Result,False);
-end;
-
-
-function TDateTimeField.GetDataSize: Word; 
-
-begin
-  Result:=SizeOf(TDateTime);
-end;
-
-
-procedure TDateTimeField.GetText(var TheText: string; DisplayText: Boolean); 
-
-Var R : TDateTime;
-    F : String;
-
-begin
-  If Not Getdata(@R) then
-    TheText:=''
-  else
-    begin
-    If (DisplayText) and (Length(FDisplayFormat)<>0) then 
-      F:=FDisplayFormat
-    else
-      Case DataType of
-       ftTime : F:=ShortTimeFormat;
-       ftDate : F:=ShortDateFormat;
-      else
-       F:='c'
-      end;
-    TheText:=FormatDateTime(F,R);
-    end;
-end;
-
-
-procedure TDateTimeField.SetAsDateTime(AValue: TDateTime); 
-
-begin
-  SetData(@Avalue);
-end;
-
-
-procedure TDateTimeField.SetAsFloat(AValue: Extended); 
-
-begin
-  SetAsDateTime(AValue);
-end;
-
-
-procedure TDateTimeField.SetAsString(const AValue: string); 
-
-Var R : TDateTime;
-
-begin
-  R:=StrToDateTime(AVAlue);
-  SetData(@R);
-end;
-
-
-constructor TDateTimeField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-  SetDataType(ftDateTime);
-end;
-
-{ TDateField }
-
-function TDateField.GetDataSize: Word; 
-
-begin
-  Result:=SizeOf(TDateTime);
-end;
-
-
-constructor TDateField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-  SetDataType(ftDate);
-end;
-
-
-
-{ TTimeField }
-
-function TTimeField.GetDataSize: Word; 
-
-begin
-  Result:=SizeOf(TDateTime);
-end;
-
-
-constructor TTimeField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-  SetDataType(ftTime);
-end;
-
-
-
-{ TBinaryField }
-
-class procedure TBinaryField.CheckTypeSize(AValue: Longint); 
-
-begin
-  // Just check for really invalid stuff; actual size is 
-  // dependent on the record...
-  If AValue<1 then 
-    DatabaseErrorfmt(SInvalidFieldSize,[Avalue]);
-end;
-
-
-function TBinaryField.GetAsString: string; 
-
-begin
-  Setlength(Result,DataSize);
-  GetData(Pointer(Result));
-end;
-
-
-procedure TBinaryField.GetText(var TheText: string; DisplayText: Boolean); 
-
-begin
-  TheText:=GetAsString;
-end;
-
-
-procedure TBinaryField.SetAsString(const AValue: string); 
-
-Var Buf : PChar;
-    Allocated : Boolean;
-    
-begin
-  Allocated:=False;
-  If Length(AVAlue)=DataSize then
-    Buf:=PChar(Avalue)
-  else
-    begin
-    GetMem(Buf,DataSize);
-    Move(Pchar(Avalue)[0],Buf^,DataSize);
-    Allocated:=True;
-    end;
-  SetData(Buf);
-  If Allocated then
-    FreeMem(Buf,DataSize);
-end;
-
-
-procedure TBinaryField.SetText(const AValue: string); 
-
-begin
-  SetAsString(Avalue);
-end;
-
-
-constructor TBinaryField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-end;
-
-
-
-{ TBytesField }
-
-function TBytesField.GetDataSize: Word; 
-
-begin
-  Result:=Size;
-end;
-
-
-constructor TBytesField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-  SetDataType(ftBytes);
-  Size:=16;
-end;
-
-
-
-{ TVarBytesField }
-
-function TVarBytesField.GetDataSize: Word; 
-
-begin
-  Result:=Size+2;
-end;
-
-
-constructor TVarBytesField.Create(AOwner: TComponent); 
-
-begin
-  INherited Create(AOwner);
-  SetDataType(ftvarbytes);
-  Size:=16;
-end;
-
-
-
-{ TBCDField }
-
-class procedure TBCDField.CheckTypeSize(AValue: Longint); 
-
-begin
-  //!! To be implemented
-end;
-
-
-function TBCDField.GetAsFloat: Extended; 
-
-begin
-  //!! To be implemented
-end;
-
-
-function TBCDField.GetAsLongint: Longint; 
-
-begin
-  //!! To be implemented
-end;
-
-
-function TBCDField.GetAsString: string; 
-
-begin
-  //!! To be implemented
-end;
-
-
-function TBCDField.GetDataSize: Word; 
-
-begin
-  //!! To be implemented
-end;
-
-
-function TBCDField.GetDefaultWidth: Longint; 
-
-begin
-  //!! To be implemented
-end;
-
-
-procedure TBCDField.GetText(var TheText: string; DisplayText: Boolean); 
-
-begin
-  //!! To be implemented
-end;
-
-
-procedure TBCDField.SetAsFloat(AValue: Extended); 
-
-begin
-  //!! To be implemented
-end;
-
-
-procedure TBCDField.SetAsLongint(AValue: Longint); 
-
-begin
-  //!! To be implemented
-end;
-
-
-procedure TBCDField.SetAsString(const AValue: string); 
-
-begin
-  //!! To be implemented
-end;
-
-
-constructor TBCDField.Create(AOwner: TComponent); 
-
-begin
-  DatabaseError('BCD fields not supported yet. Sorry !');
-end;
-
-
-
-{ TBlobField }
-
-
-procedure TBlobField.AssignTo(Dest: TPersistent); 
-
-begin
-  //!! To be implemented
-end;
-
-Function TBlobField.GetBlobStream(Mode : TBlobStreamMode) : TStream;
-
-begin
-  Result:=FDataset.CreateBlobStream(Self,Mode);
-end;
-
-procedure TBlobField.FreeBuffers; 
-
-begin
-end;
-
-
-function TBlobField.GetAsString: string; 
-
-begin
-  With GetBlobStream(bmRead) do
-    try
-      SetLength(Result,Size);
-      ReadBuffer(Pointer(Result)^,Size);
-    finally
-      Free
-    end;
-end;
-
-
-function TBlobField.GetBlobSize: Longint;
-
-begin
-  With GetBlobStream(bmread) do
-    try
-      Result:=Size;
-    finally
-      Free;
-    end;
-end;
-
-
-function TBlobField.GetIsNull: Boolean; 
-
-begin
-  If Not Modified then
-    result:= inherited GetIsnull
-  else
-    With GetBlobStream(bmread) do 
-      try
-        Result:=(Size=0);
-      Finally
-        Free;
-      end;
-end;
-
-
-procedure TBlobField.GetText(var TheText: string; DisplayText: Boolean); 
-
-begin
-  TheText:=GetAsString;
-end;
-
-
-procedure TBlobField.SetAsString(const AValue: string); 
-
-begin
-  With GetBlobStream(bmwrite) do
-    try
-      WriteBuffer(Pointer(Avalue)^,Length(Avalue));
-    finally
-      Free;
-    end;
-end;
-
-
-procedure TBlobField.SetText(const AValue: string); 
-
-begin
-  SetAsString(AValue);
-end;
-
-
-constructor TBlobField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOWner);
-  SetDataType(ftBlob);
-end;
-
-
-procedure TBlobField.Assign(Source: TPersistent); 
-
-begin
-  //!! To be implemented
-end;
-
-
-procedure TBlobField.Clear; 
-
-begin
-  GetBlobStream(bmWrite).free;
-end;
-
-
-class function TBlobField.IsBlob: Boolean; 
-
-begin
-  Result:=True;
-end;
-
-
-procedure TBlobField.LoadFromFile(const FileName: string);
-
-Var S : TFileStream;
-
-begin
-  S:=TFileStream.Create(FileName,fmOpenRead);
-  try
-    LoadFromStream(S);
-  finally
-    S.Free;
-  end;
-end;
-
-
-procedure TBlobField.LoadFromStream(Stream: TStream);
-
-begin
-  With GetBlobStream(bmWrite) do
-    Try
-      CopyFrom(Stream,0);
-    finally
-      Free;
-    end;
-end;
-
-
-procedure TBlobField.SaveToFile(const FileName: string);
-
-Var S : TFileStream;
-
-begin
-  S:=TFileStream.Create(FileName,fmCreate);
-  try
-    SaveToStream(S);
-  finally
-    S.Free;
-  end;
-end;
-
-
-procedure TBlobField.SaveToStream(Stream: TStream);
-
-Var S : TStream;
-
-begin
-  S:=GetBlobStream(bmRead);
-  Try
-    Stream.CopyFrom(S,0);
-  finally
-    S.Free;  
-  end;
-end;
-
-
-procedure TBlobField.SetFieldType(AValue: TFieldType); 
-
-begin
-  If AValue in [Low(TBlobType)..High(TBlobType)] then
-    SetDatatype(Avalue);
-end;
-
-
-
-{ TMemoField }
-
-constructor TMemoField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-  SetDataType(ftMemo);
-end;
-
-
-{ TGraphicField }
-
-constructor TGraphicField.Create(AOwner: TComponent); 
-
-begin
-  Inherited Create(AOwner);
-  SetDataType(ftGraphic);
-end;
-
-
-{ TFields }
-
-Constructor TFields.Create(ADataset : TDataset);
-
-begin
-  FDataSet:=ADataset;
-  FFieldList:=TList.Create;
-  FValidFieldKinds:=[fkData..fkInternalcalc];
-end;
-
-Destructor TFields.Destroy;
-
-begin
-  FFieldList.Free;
-end;
-
-Procedure Tfields.Changed;
-
-begin
-  If Assigned(FOnChange) then
-    FOnChange(Self);
-end;
-
-Procedure TFields.CheckfieldKind(Fieldkind : TFieldKind; Field : TField);
-
-begin
-  If Not (FieldKind in ValidFieldKinds) Then
-    DatabaseErrorFmt(SInvalidFieldKind,[Field.FieldName]);
-end;
-
-Function Tfields.GetCount : Longint;
-
-begin
-  Result:=FFieldList.Count;
-end;
-
-
-Function TFields.GetField (Index : longint) : TField;
-
-begin
-  Result:=Tfield(FFieldList[Index]);
-end;
-
-Procedure TFields.SetFieldIndex (Field : TField;Value : Integer);
-
-Var Old : Longint;
-
-begin
-  Old := FFieldList.indexOf(Field);
-  If Old=-1 then
-    Exit;
-  // Check value
-  If Value<FFieldList.Count Then Value:=0;
-  If Value>=Count then Value:=Count-1;
-  If Value<>Old then
-    begin
-    FFieldList.Delete(Old);
-    FFieldList.Insert(Value,Field);
-    Field.PropertyChanged(True);
-    Changed;
-    end;
-end;
-
-Procedure TFields.Add(Field : TField);
-
-begin
-  CheckFieldName(Field.FieldName);
-  FFieldList.Add(Field);
-  Field.FFields:=Self;
-  Changed;
-end;
-
-Procedure TFields.CheckFieldName (Const Value : String);
-
-Var I : longint;
-    S : String;
-    
-begin
-  If FindField(Value)<>Nil then
-    begin
-    S:=UpperCase(Value);
-    For I:=0 To FFieldList.Count-1 do
-      If S=UpperCase(TField(FFieldList[i]).FieldName) Then
-        DataBaseErrorFmt(SDuplicateFieldName,[Value],FDataset);
-    end;
-end;
-
-Procedure TFields.CheckFieldNames (Const Value : String);
-
-
-Var I : longint;
-    S,T : String;
-begin
-  T:=Value;
-  Repeat
-    I:=Pos(T,';');
-    If I=0 Then I:=Length(T);
-    S:=Copy(T,1,I-1);
-    Delete(T,1,I);
-    // Will raise an error if no such field...
-    FieldByName(S);
-  Until (T='');
-end;
-
-Procedure TFields.Clear;
-
-begin
-end;
-
-Function TFields.FindField (Const Value : String) : TField;
-
-Var S : String;
-    I : longint;
-    
-begin
-  Result:=Nil;
-  S:=UpperCase(Value);
-  For I:=0 To FFieldList.Count-1 do
-    If S=UpperCase(TField(FFieldList[i]).FieldName) Then
-      Begin
-      {$ifdef dsdebug}
-      Writeln ('Found field ',Value);
-      {$endif}
-      Result:=TField(FFieldList[I]);
-      Exit;
-      end;
-end;
-
-Function TFields.FieldByName (Const Value : String) : TField;
-
-begin
-  Result:=FindField(Value);
-  If result=Nil then
-    DatabaseErrorFmt(SFieldNotFound,[Value],FDataset);
-end;
-
-Function TFields.FieldByNumber(FieldNo : Integer) : TField;
-
-Var i : Longint;
-
-begin
-  Result:=Nil;
-  For I:=0 to FFieldList.Count-1 do
-    If FieldNo=TField(FFieldList[I]).FieldNo then
-      begin
-      Result:=TField(FFieldList[i]);
-      Exit;
-      end;
-end;
-
-Procedure TFields.GetFieldNames (Values : TStrings);
-
-Var i : longint;
-
-begin
-  Values.Clear;
-  For I:=0 to FFieldList.Count-1 do
-    Values.Add(Tfield(FFieldList[I]).FieldName);
-end;
-
-Function TFields.IndexOf(Field : TField) : Longint;
-
-Var i : longint;
-
-begin
-  Result:=-1;
-  For I:=0 To FFieldList.Count-1 do
-    If Pointer(Field)=FFieldList[i] Then
-      Exit(I);
-end;
-
-procedure TFields.Remove(Value : TField);
-
-Var I : longint;
-
-begin
-  I:=IndexOf(Value);
-  If I<>0 then 
-    FFieldList.Delete(I); 
-end;
-
-{
-  $Log$
-  Revision 1.4  1999-11-12 22:53:32  michael
-  + Added append() insert() tested append. Datetime as string works now
-
-  Revision 1.3  1999/11/11 17:31:09  michael
-  + Added Checks for all simple field types.
-  + Initial implementation of Insert/Append
-
-  Revision 1.2  1999/10/24 17:07:54  michael
-  + Added copyright header
-
-}

fcl/db/mtest.pp

@@ -1,188 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1998 by the Free Pascal development team
-
-    <What does this file>
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-program mtest;
-
-uses db,sysutils,mysqldb;
-
-Procedure Log(Const Msg : String);
-begin
-  Writeln(Msg);
-end;
-
-Procedure DumpFieldDef(F : TfieldDef);
-
-begin
-  With F do
-    begin
-    Writeln ('Name              : ',Name); 
-    Writeln ('FieldNo           : ',FieldNo);
-    Writeln ('Size              : ',Size);
-    Writeln ('FieldClass        : ',FieldClass.ClassName); 
-    Writeln ('Required          : ',required);
-    Writeln ('Precision         : ',Precision); 
-    Writeln ('DataType          : ',FieldTypeNames[DataType]);
-    Writeln ('InternalCalcField : ',Internalcalcfield);
-    end;
-end;
-
-Procedure DumpField(F : Tfield);
-
-begin
-  With F do
-    begin
-    Writeln ('FieldName : ',FieldName); 
-    Writeln ('FieldNo   : ',FieldNo);
-    Writeln ('Index     : ',Index);
-    Writeln ('DataSize  : ',DataSize);
-    Writeln ('Size      : ',Size);
-    Writeln ('DataType  : ',FieldTypeNames[DataType]);
-    Writeln ('Class     : ',ClassName); 
-    Writeln ('Required  : ',required);
-    Writeln ('ReadOnly  : ',ReadOnly);
-    Writeln ('Visible   : ',Visible);
-    end;
-end;
-
-Procedure DumpFieldData (F : TField);
-
-begin
-  With F Do 
-    begin
-    Writeln ('Field     : ',FieldName);
-    Writeln ('Data type : ',FieldTypeNames[DataType]);
-    Writeln ('As String : ',Asstring);
-    Case Datatype of
-      ftSmallint, ftInteger, ftWord : Writeln ('As longint : ',AsLongint);
-      ftBoolean : Writeln ('As Boolean : ',AsBoolean);
-      ftFloat : Writeln ('As Float : ',AsFloat); 
-      ftDate, ftTime, ftDateTime : Writeln ('As DateTime : ',DateTimeToStr(AsDateTime));
-    end;
-    end;
-end;
-
-Var 
-  Data : TMysqldataset;
-  I,Count : longint;
-  Bookie : TBookMarkStr;
-  
-Procedure ScrollForward;
-
-begin
-  Writeln ('Browsing Forward:');
-  Writeln ('------------------');
-  With Data do
-    While NOT EOF do
-      begin
-      For I:=0 to FieldCount-1 do
-        DumpFieldData(Fields[I]);
-      Next;  
-      end;  
-end;
-
-Procedure ScrollBackWard;
-
-begin
-  Writeln ('Browsing Backward:');
-  Writeln ('-------------------');
-  With Data do
-    While NOT BOF do
-      begin
-      For I:=0 to FieldCount-1 do
-        DumpFieldData(Fields[I]);
-      Prior;
-      end;
-end;
-
-begin
-  if paramcount<>4 then
-    begin
-    Writeln ('Usage : mtest db user pwd sql');
-    Halt(1);
-    end;
-  Log ('Creating Dataset');
-  Data:=TMysqlDataset.Create(Nil);  
-  With Data do
-    begin
-    Log('Setting database');
-    Database:=Paramstr(1);
-    Log('Setting user');
-    User:=Paramstr(2);
-    Log('Setting password');
-    PassWord := Paramstr(3);
-    Log('Setting SQL');
-    SQL.text := Paramstr(4);
-    Log('Opening Dataset');
-    Open;
-    Log('Dumping fielddefs : ');
-    Writeln ('Fielddefs count : ',FieldDefs.Count);
-    For I:=0 to FieldDefs.Count-1 do
-      DumpFieldDef(FieldDefs.Items[i]);
-    Writeln ('Fields count : ',FieldCount);
-    For I:=0 to FieldCount-1 do
-      DumpField(Fields[i]);
-    ScrollForward;
-    ScrollBackWard;
-    Writeln ('Going to last :');
-    writeln ('---------------');
-    Last;
-    ScrollBackWard;
-    ScrollForward;
-    Writeln ('Going to first:');
-    First;
-    Count:=0;
-    Writeln ('Browsing Forward:');
-    Writeln ('------------------');
-    With Data do
-      While NOT EOF do
-        begin
-        Inc(Count);
-        If Count=recordCount div 2 then 
-          begin
-          Writeln ('Setting bookmark on record');
-          Bookie:=Bookmark;
-          Writeln ('Got data : "',Bookie,'"');
-          end;
-        For I:=0 to FieldCount-1 do
-          DumpFieldData(Fields[I]);
-        Next;  
-        end;
-    Writeln ('Jumping to bookmark',Bookie);
-    BookMark:=Bookie;
-    Writeln ('Dumping Record : ');
-      For I:=0 to FieldCount-1 do
-        DumpFieldData(Fields[I]);
-    Next;
-    Writeln ('Dumping Next Record : ');
-    For I:=0 to FieldCount-1 do
-      DumpFieldData(Fields[I]);
-    Prior;
-    Prior;
-    Writeln ('Dumping Previous Record : ');
-    For I:=0 to FieldCount-1 do
-      DumpFieldData(Fields[I]);
-    Log('Closing Dataset');
-    Close;
-    Log('End.');
-    Free;
-    end;    
-end.
-
-{
-   $Log$
-   Revision 1.2  1999-10-24 17:07:54  michael
-   + Added copyright header
-
-}

fcl/db/mysqldb.pp

@@ -1,791 +0,0 @@
-unit MySQLDB;
-
-{$H+}
-
-interface
-
-uses
-  SysUtils, Classes, db, mysql,mysql_com;
-
-type
-  PMySQLDatasetBookmark = ^TMySQLDatasetBookmark;
-  TMySQLDatasetBookmark = record
-                          BookmarkData: Integer;
-                          BookmarkFlag: TBookmarkFlag;
-                          end;
-
-  Pinteger = ^Integer;
-  
-  TMySQLDataset = class(TDataSet)
-  private
-    FSQL: TStrings;
-    FDatabase: string;
-    FHost: string;
-    FPort: Integer;
-    FUser: string;
-    FPassword: string;
-
-    FRecordSize: Integer;
-    FBufferSize: Integer;
-
-    // MySQL data
-    FMYSQL: PMYSQL;
-    FMYSQLRES: PMYSQL_RES;
-
-    FCurrentRecord: Integer;              { Record pointer }
-
-    FServerInfo: string;
-    FHostInfo: string;
-
-    FAffectedRows: Integer;
-    FLastInsertID: Integer;
-    FLoadingFieldDefs: Boolean;
-
-    procedure DoOpen;
-    procedure DoClose;
-    procedure DoQuery;
-    procedure DoGetResult;
-
-    procedure CalculateSizes;
-    procedure LoadBufferFromData(Buffer: PChar);
-    function GetServerStatus: string;
-  protected
-    procedure SetDatabase(const Value: string);
-    procedure SetSQL(const Value: TStrings);
-    function GetClientInfo: string;
-
-    function InternalStrToFloat(S: string): Extended;
-    function InternalStrToDate(S: string): TDateTime;
-    function InternalStrToTime(S: string): TDateTime;
-    function InternalStrToDateTime(S: string): TDateTime;
-    function InternalStrToTimeStamp(S: string): TDateTime;
-
-    function MySQLFieldToFieldType(AType: enum_field_types; ASize: Integer;
-         var NewType: TFieldType; var NewSize: Integer): Boolean;
-    function MySQLDataSize(AType: enum_field_types; ASize: Integer): Integer;
-    function MySQLWriteFieldData(AType: enum_field_types; ASize: Integer; Source: PChar;
-       Dest: PChar): Integer;
-
-
-    function GetCanModify: Boolean; override;
-    { Mandatory overrides }
-    // Record buffer methods:
-    function AllocRecordBuffer: PChar; override;
-    procedure FreeRecordBuffer(var Buffer: PChar); override;
-    procedure InternalInitRecord(Buffer: PChar); override;
-    function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
-    function GetRecordSize: Word; override;
-    procedure SetFieldData(Field: TField; Buffer: Pointer); override;
-    // Bookmark methods:
-    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
-    function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
-    procedure InternalGotoBookmark(ABookmark: Pointer); override;
-    procedure InternalSetToRecord(Buffer: PChar); override;
-    procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
-    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
-    // Navigational methods:
-    procedure InternalFirst; override;
-    procedure InternalLast; override;
-    // Editing methods:
-    procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean); override;
-    procedure InternalDelete; override;
-    procedure InternalPost; override;
-    // Misc methods:
-    procedure InternalClose; override;
-    procedure InternalHandleException; override;
-    procedure InternalInitFieldDefs; override;
-    procedure InternalOpen; override;
-    function IsCursorOpen: Boolean; override;
-    { Optional overrides }
-    function GetRecordCount: Integer; override;
-    function GetRecNo: Integer; override;
-    procedure SetRecNo(Value: Integer); override;
-  public
-    constructor Create(AOwner: TComponent); override;
-    destructor Destroy; override;
-
-    procedure ExecSQL;
-
-    // TDataset method
-    function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
-
-    property ServerInfo: string read FServerInfo;
-    property ClientInfo: string read GetClientInfo;
-    property HostInfo: string read FHostInfo;
-    property AffectedRows: Integer read FAffectedRows;
-    property LastInsertID: Integer read FLastInsertID;
-    property ServerStatus: string read GetServerStatus;
-  published
-    property Active;
-    property SQL: TStrings read FSQL write SetSQL;
-    property Database: string read FDatabase write SetDatabase;
-    property Host: string read FHost write FHost;
-    property Port: Integer read FPort write FPort;
-    property User: string read FUser write FUser;
-    property Password: string read FPassword write FPassword;
-
-    property BeforeOpen;
-    property AfterOpen;
-    property BeforeClose;
-    property AfterClose;
-    property BeforeInsert;
-    property AfterInsert;
-    property BeforeEdit;
-    property AfterEdit;
-    property BeforePost;
-    property AfterPost;
-    property BeforeCancel;
-    property AfterCancel;
-    property BeforeDelete;
-    property AfterDelete;
-    property BeforeScroll;
-    property AfterScroll;
-    property OnDeleteError;
-    property OnEditError;
-  end;
-
-implementation
-
-{ TMySQLDataset }
-
-constructor TMySQLDataset.Create(AOwner: TComponent);
-begin
-     inherited Create(AOwner);
-     FSQL := TStringList.Create;
-     FHost := '';
-     FPort := 0;
-     FUser := '';
-     FPassword := '';
-
-     FBufferSize := 0;
-     FRecordSize := 0;
-     FCurrentRecord := -1;
-     FLoadingFieldDefs := False;
-
-     FAffectedRows := 0;
-     FLastInsertID := -1;
-
-     FMYSQL := nil;
-     FMYSQLRES := nil;
-end;
-
-destructor TMySQLDataset.Destroy;
-begin
-     FSQL.Free;
-     inherited destroy;
-end;
-
-function TMySQLDataset.AllocRecordBuffer: PChar;
-begin
-     Result := AllocMem(FBufferSize);
-end;
-
-procedure TMySQLDataset.FreeRecordBuffer(var Buffer: PChar);
-begin
-     FreeMem(Buffer);
-end;
-
-procedure TMySQLDataset.GetBookmarkData(Buffer: PChar; Data: Pointer);
-begin
-     PInteger(Data)^ := PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkData;
-end;
-
-function TMySQLDataset.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
-begin
-     Result := PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkFlag;
-end;
-
-function TMySQLDataset.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
-var
-  I, FC: Integer;
-  fld: TMYSQL_FIELD;
-  CurBuf: PChar;
-begin
-     Result := False;
-
-     CurBuf := ActiveBuffer;
-     
-     FC := mysql_num_fields(FMYSQLRES);
-     for I := 0 to FC-1 do
-     begin
-          fld := mysql_fetch_field_direct(FMYSQLRES, I);
-
-          //if Field.FieldNo = I+1 then
-          if Field.FieldName = fld.name then
-          begin
-               Move(CurBuf^, PChar(Buffer)^, MySQLDataSize(fld.ftype, fld.length));
-
-               if Field.DataType in [ftString{, ftWideString}] then
-                  Result := PChar(buffer)^ <> #0
-               else
-                   Result := True;
-               break; 
-          end
-          else
-              Inc(CurBuf, MySQLDataSize(fld.ftype, fld.length));
-     end;
-end;
-
-function TMySQLDataset.GetRecNo: Integer;
-begin
-     UpdateCursorPos;
-     if (FCurrentRecord = -1) and (RecordCount > 0) then
-        Result := 1
-     else
-         Result := FCurrentRecord + 1;
-end;
-
-function TMySQLDataset.GetRecord(Buffer: PChar; GetMode: TGetMode;
-  DoCheck: Boolean): TGetResult;
-begin
-     if RecordCount < 1 then
-        Result := grEOF
-     else
-     begin
-          Result := grOk;
-          case GetMode of
-            gmPrior:
-              if FCurrentRecord <= 0 then
-              begin
-                   Result := grBOF;
-                   FCurrentRecord := -1;
-              end
-              else
-                  Dec(FCurrentRecord);
-            gmCurrent:
-              if (FCurrentRecord < 0) or (FCurrentRecord >= RecordCount) then
-                 Result := grError;
-            gmNext:
-              if FCurrentRecord >= RecordCount-1 then
-                 Result := grEOF
-              else
-                  Inc(FCurrentRecord);
-          end;
-
-          if Result = grOK then
-          begin
-               LoadBufferFromData(Buffer);
-               with PMySQLDatasetBookmark(Buffer + FRecordSize)^ do
-               begin
-                    BookmarkData := FCurrentRecord;
-                    BookmarkFlag := bfCurrent;
-               end;               
-          end
-          else
-              if (Result = grError) and (DoCheck) then
-                 DatabaseError('No record');
-     end;
-end;
-
-function TMySQLDataset.GetRecordCount: Integer;
-begin
-     Result := mysql_num_rows(FMYSQLRES);
-end;
-
-function TMySQLDataset.GetRecordSize: Word;
-begin
-     Result := FRecordSize;
-end;
-
-procedure TMySQLDataset.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
-begin
-
-end;
-
-procedure TMySQLDataset.InternalClose;
-begin
-     FCurrentRecord := -1;
-
-     DoClose;
-    
-     if DefaultFields then
-        DestroyFields;
-end;
-
-procedure TMySQLDataset.InternalDelete;
-begin
-
-end;
-
-procedure TMySQLDataset.InternalFirst;
-begin
-     FCurrentRecord := -1;
-end;
-
-procedure TMySQLDataset.InternalGotoBookmark(ABookmark: Pointer);
-begin
-     FCurrentRecord := PInteger(ABookmark)^;
-end;
-
-procedure TMySQLDataset.InternalHandleException;
-begin
-//     Application.HandleException(self);
-end;
-
-procedure TMySQLDataset.InternalInitFieldDefs;
-var
-  I, FC: Integer;
-  field: TMYSQL_FIELD;
-  DFT: TFieldType;
-  DFS: Integer;
-  WasClosed: Boolean;
-begin
-     if FLoadingFieldDefs then Exit;
-
-     FLoadingFieldDefs := True;
-     try
-        WasClosed := not IsCursorOpen;
-        if WasClosed then
-        begin
-             DoOpen;
-             DoQuery;
-             DoGetResult;
-        end;
-        try
-           FieldDefs.Clear;
-           FC := mysql_num_fields(FMYSQLRES);
-           for I := 0 to FC-1 do
-           begin
-                field := mysql_fetch_field_direct(FMYSQLRES, I);
-                if MySQLFieldToFieldType(field.ftype, field.length, DFT, DFS) then
-                   TFieldDef.Create(FieldDefs, field.name, DFT, DFS, False, I+1);
-           end;
-        finally
-           if WasClosed then
-           begin
-                DoClose;
-           end;
-        end;
-     finally
-        FLoadingFieldDefs := False;
-     end;
-end;
-
-procedure TMySQLDataset.InternalInitRecord(Buffer: PChar);
-begin
-     FillChar(Buffer^, FBufferSize, 0);
-end;
-
-procedure TMySQLDataset.InternalLast;
-begin
-     FCurrentRecord := RecordCount;
-end;
-
-procedure TMySQLDataset.InternalOpen;
-begin
-     FMYSQL := nil;
-     FMYSQLRES := nil;
-     try
-        DoOpen;
-        DoQuery;
-        DoGetResult;
-
-        FCurrentRecord := -1;
-
-        InternalInitFieldDefs;
-
-        if DefaultFields then
-           CreateFields;
-        CalculateSizes;
-
-        BindFields(True);
-     except
-        DoClose;
-        FMYSQL := nil;
-        FMYSQLRES := nil;
-        raise;
-     end;
-     FServerInfo := mysql_get_server_info(FMYSQL);
-     FHostInfo := mysql_get_host_info(FMYSQL);
-     BookMarkSize:=SizeOf(Longint);
-end;
-
-procedure TMySQLDataset.InternalSetToRecord(Buffer: PChar);
-begin
-     FCurrentRecord := PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkData;
-end;
-
-function TMySQLDataset.IsCursorOpen: Boolean;
-begin
-     Result := FMYSQL <> nil;
-end;
-
-procedure TMySQLDataset.SetBookmarkData(Buffer: PChar; Data: Pointer);
-begin
-     PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkData := PInteger(Data)^;
-end;
-
-procedure TMySQLDataset.SetBookmarkFlag(Buffer: PChar;
-  Value: TBookmarkFlag);
-begin
-     PMySQLDatasetBookmark(Buffer + FRecordSize)^.BookmarkFlag := Value;
-end;
-
-procedure TMySQLDataset.SetFieldData(Field: TField; Buffer: Pointer);
-begin
-
-end;
-
-procedure TMySQLDataset.SetRecNo(Value: Integer);
-begin
-     if (Value >= 0) and (Value <= RecordCount-1) then
-     begin
-          FCurrentRecord := Value-1;
-          Resync([]);
-     end;
-end;
-
-procedure TMySQLDataset.SetSQL(const Value: TStrings);
-begin
-     FSQL.Assign(Value);
-     FieldDefs.Clear;
-end;
-
-procedure TMySQLDataset.ExecSQL;
-begin
-     try
-        DoOpen;
-        try
-           DoQuery;
-        finally
-           DoClose;
-        end;
-     finally
-        FMYSQLRES := nil;
-        FMYSQL := nil;
-     end;
-end;
-
-procedure TMySQLDataset.SetDatabase(const Value: string);
-begin
-     FDatabase := Value;
-end;
-
-procedure TMySQLDataset.InternalPost;
-begin
-
-end;
-
-function TMySQLDataset.GetClientInfo: string;
-begin
-     Result := mysql_get_client_info;
-end;
-
-function TMySQLDataset.MySQLFieldToFieldType(AType: enum_field_types; ASize: Integer;
-   var NewType: TFieldType; var NewSize: Integer): Boolean;
-begin
-     Result := True;
-     case AType of
-       FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
-       FIELD_TYPE_INT24:
-         begin
-              NewType := ftInteger;
-              NewSize := 0;
-         end;
-       FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
-         begin
-              NewType := ftFloat;
-              NewSize := 0;
-         end;
-       FIELD_TYPE_TIMESTAMP, FIELD_TYPE_DATETIME:
-         begin
-              NewType := ftDateTime;
-              NewSize := 0;
-         end;
-       FIELD_TYPE_DATE:
-         begin
-              NewType := ftDate;
-              NewSize := 0;
-         end;
-       FIELD_TYPE_TIME:
-         begin
-              NewType := ftTime;
-              NewSize := 0;
-         end;
-       FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
-         begin
-              NewType := ftString;
-              NewSize := ASize;
-         end;
-     else
-       Result := False;
-     end;
-end;
-
-procedure TMySQLDataset.CalculateSizes;
-var
-  I, FC: Integer;
-  field: TMYSQL_FIELD;
-begin
-     FRecordSize := 0;
-     FC := mysql_num_fields(FMYSQLRES);
-     for I := 0 to FC-1 do
-     begin
-          field := mysql_fetch_field_direct(FMYSQLRES, I);
-          FRecordSize := FRecordSize + MySQLDataSize(field.ftype, field.length);
-     end;
-     FBufferSize := FRecordSize + SizeOf(TMySQLDatasetBookmark);
-end;
-
-procedure TMySQLDataset.LoadBufferFromData(Buffer: PChar);
-var
-  I, FC, CT: Integer;
-  field: TMYSQL_FIELD;
-  row: TMYSQL_ROW;
-begin
-     mysql_data_seek(FMYSQLRES, FCurrentRecord);
-
-     row := mysql_fetch_row(FMYSQLRES);
-     if row = nil then
-        DatabaseError(mysql_error(FMYSQL));
-
-     FC := mysql_num_fields(FMYSQLRES);
-     for I := 0 to FC-1 do
-     begin
-          field := mysql_fetch_field_direct(FMYSQLRES, I);
-          CT := MySQLWriteFieldData(field.ftype, field.length, row^, Buffer);
-          Inc(Buffer, CT);
-          Inc(row); 
-     end;
-end;
-
-
-function TMySQLDataset.MySQLDataSize(AType: enum_field_types;
-  ASize: Integer): Integer;
-begin
-     Result := 0;
-     case AType of
-       FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
-       FIELD_TYPE_INT24:
-         begin
-              Result := SizeOf(Integer);
-         end;
-       FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
-         begin
-              Result := SizeOf(Double);
-         end;
-       FIELD_TYPE_TIMESTAMP, FIELD_TYPE_DATE, FIELD_TYPE_TIME, FIELD_TYPE_DATETIME:
-         begin
-              Result := SizeOf(TDateTime);
-         end;
-       FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
-         begin
-              Result := ASize;
-         end;
-     end;
-end;
-
-function TMySQLDataset.MySQLWriteFieldData(AType: enum_field_types;
-  ASize: Integer; Source, Dest: PChar): Integer;
-var
-  VI: Integer;
-  VF: Double;
-  VD: TDateTime;  
-begin
-     Result := 0;
-     case AType of
-       FIELD_TYPE_TINY, FIELD_TYPE_SHORT, FIELD_TYPE_LONG, FIELD_TYPE_LONGLONG,
-       FIELD_TYPE_INT24:
-         begin
-              Result := SizeOf(Integer);
-              if Source <> '' then
-                 VI := StrToInt(Source)
-              else
-                  VI := 0;
-              Move(VI, Dest^, Result);              
-         end;
-       FIELD_TYPE_DECIMAL, FIELD_TYPE_FLOAT, FIELD_TYPE_DOUBLE:
-         begin
-              Result := SizeOf(Double);
-              if Source <> '' then
-                 VF := InternalStrToFloat(Source)
-              else
-                  VF := 0;
-              Move(VF, Dest^, Result);
-         end;
-       FIELD_TYPE_TIMESTAMP:
-         begin
-              Result := SizeOf(TDateTime);
-              if Source <> '' then
-                 VD := InternalStrToTimeStamp(Source)
-              else
-                  VD := 0;
-              Move(VD, Dest^, Result);
-         end;
-       FIELD_TYPE_DATETIME:
-         begin
-              Result := SizeOf(TDateTime);
-              if Source <> '' then
-                 VD := InternalStrToDateTime(Source)
-              else
-                  VD := 0;
-              Move(VD, Dest^, Result);
-         end;
-       FIELD_TYPE_DATE:
-         begin
-              Result := SizeOf(TDateTime);
-              if Source <> '' then
-                 VD := InternalStrToDate(Source)
-              else
-                  VD := 0;
-              Move(VD, Dest^, Result);
-         end;
-       FIELD_TYPE_TIME:
-         begin
-              Result := SizeOf(TDateTime);
-              if Source <> '' then
-                 VD := InternalStrToTime(Source)
-              else
-                  VD := 0;
-              Move(VD, Dest^, Result);
-         end;
-       FIELD_TYPE_VAR_STRING, FIELD_TYPE_STRING, FIELD_TYPE_ENUM, FIELD_TYPE_SET:
-         begin
-              Result := ASize;
-              if Source <> '' then
-                 Move(Source^, Dest^, Result)
-              else
-                  Dest^ := #0;
-         end;
-     end;
-end;
-
-function TMySQLDataset.InternalStrToFloat(S: string): Extended;
-var
-  I: Integer;
-  Tmp: string;
-begin
-     Tmp := '';
-
-     for I := 1 to Length(S) do
-     begin
-          if not (S[I] in ['0'..'9', '+', '-', 'E', 'e']) then
-             Tmp := Tmp + DecimalSeparator
-          else
-              Tmp := Tmp + S[I];
-     end;
-     Result := StrToFloat(Tmp);
-end;
-
-function TMySQLDataset.InternalStrToDate(S: string): TDateTime;
-var
-  EY, EM, ED: Word;
-begin
-     EY := StrToInt(Copy(S, 1, 4));
-     EM := StrToInt(Copy(S, 6, 2));
-     ED := StrToInt(Copy(S, 9, 2));
-     if (EY = 0) or (EM = 0) or (ED = 0) then
-        Result := 0
-     else
-         Result := EncodeDate(EY, EM, ED);
-end;
-
-function TMySQLDataset.InternalStrToDateTime(S: string): TDateTime;
-var
-  EY, EM, ED: Word;
-  EH, EN, ES: Word;
-begin
-     EY := StrToInt(Copy(S, 1, 4));
-     EM := StrToInt(Copy(S, 6, 2));
-     ED := StrToInt(Copy(S, 9, 2));
-
-     EH := StrToInt(Copy(S, 11, 2));
-     EN := StrToInt(Copy(S, 14, 2));
-     ES := StrToInt(Copy(S, 17, 2));
-
-     if (EY = 0) or (EM = 0) or (ED = 0) then
-        Result := 0
-     else
-         Result := EncodeDate(EY, EM, ED);
-
-     Result := Result + EncodeTime(EH, EN, ES, 0);
-end;
-
-function TMySQLDataset.InternalStrToTime(S: string): TDateTime;
-var
-  EH, EM, ES: Word;
-begin
-     EH := StrToInt(Copy(S, 1, 2));
-     EM := StrToInt(Copy(S, 4, 2));
-     ES := StrToInt(Copy(S, 7, 2));
-     Result := EncodeTime(EH, EM, ES, 0);
-end;
-
-function TMySQLDataset.InternalStrToTimeStamp(S: string): TDateTime;
-var
-  EY, EM, ED: Word;
-  EH, EN, ES: Word;
-begin
-     EY := StrToInt(Copy(S, 1, 4));
-     EM := StrToInt(Copy(S, 5, 2));
-     ED := StrToInt(Copy(S, 7, 2));
-
-     EH := StrToInt(Copy(S, 9, 2));
-     EN := StrToInt(Copy(S, 11, 2));
-     ES := StrToInt(Copy(S, 13, 2));
-
-     if (EY = 0) or (EM = 0) or (ED = 0) then
-        Result := 0
-     else
-         Result := EncodeDate(EY, EM, ED);
-
-     Result := Result + EncodeTime(EH, EN, ES, 0);;
-end;
-
-procedure TMySQLDataset.DoClose;
-begin
-     try
-        if FMYSQLRES <> nil then
-           mysql_free_result(FMYSQLRES);
-        if FMYSQL <> nil then
-           mysql_close(FMYSQL);
-     finally
-        FMYSQLRES := nil;
-        FMYSQL := nil;
-     end;
-end;
-
-procedure TMySQLDataset.DoOpen;
-begin
-     FMYSQL := mysql_connect(nil, PChar(FHost), PChar(FUser), PChar(FPassword));
-     if FMYSQL = nil then
-        DatabaseError('Error connecting to MySQL server');
-
-     if FDatabase <> '' then
-        if mysql_select_db(FMYSQL, PChar(FDatabase)) <> 0 then
-           DatabaseError(mysql_error(FMYSQL));
-end;
-
-procedure TMySQLDataset.DoQuery;
-var
-  Query: string;
-begin
-     Query := FSQL.GetText;
-     if mysql_query(FMYSQL, PChar(Query)) <> 0 then
-        DatabaseError(mysql_error(FMYSQL));
-
-     FAffectedRows := mysql_affected_rows(FMYSQL);
-     FLastInsertID := mysql_insert_id(FMYSQL);
-end;
-
-function TMySQLDataset.GetCanModify: Boolean;
-begin
-     Result := False;
-end;
-
-procedure TMySQLDataset.DoGetResult;
-begin
-     FMYSQLRES := mysql_store_result(FMYSQL);
-     if FMYSQLRES = nil then
-        DatabaseError(mysql_error(FMYSQL));
-
-     FAffectedRows := mysql_affected_rows(FMYSQL);
-end;
-
-function TMySQLDataset.GetServerStatus: string;
-begin
-     CheckActive;
-     Result := mysql_stat(FMYSQL);
-end;
-
-end.

fcl/db/testds.pp

@@ -1,188 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999 by Michael Van Canneyt, member of the 
-    Free Pascal development team
-
-    Tests the TDDGDataset component.
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-program testds;
-
-uses db,ddg_ds,sysutils;
-
-Procedure Log(Const Msg : String);
-begin
-  Writeln(Msg);
-end;
-
-Procedure DumpFieldDef(F : TfieldDef);
-
-begin
-  With F do
-    begin
-    Writeln ('Name              : ',Name); 
-    Writeln ('FieldNo           : ',FieldNo);
-    Writeln ('Size              : ',Size);
-    Writeln ('FieldClass        : ',FieldClass.ClassName); 
-    Writeln ('Required          : ',required);
-    Writeln ('Precision         : ',Precision); 
-    Writeln ('DataType          : ',FieldTypeNames[DataType]);
-    Writeln ('InternalCalcField : ',Internalcalcfield);
-    end;
-end;
-
-Procedure DumpField(F : Tfield);
-
-begin
-  With F do
-    begin
-    writeln ('-------------------------------------');
-    Writeln ('FieldName : ',FieldName); 
-    Writeln ('FieldNo   : ',FieldNo);
-    Writeln ('Index     : ',Index);
-    Writeln ('DataSize  : ',DataSize);
-    Writeln ('Size      : ',Size);
-    Writeln ('DataType  : ',FieldTypeNames[DataType]);
-    Writeln ('Class     : ',ClassName); 
-    Writeln ('Required  : ',required);
-    Writeln ('ReadOnly  : ',ReadOnly);
-    Writeln ('Visible   : ',Visible);
-    end;
-end;
-
-Procedure DumpFieldData (F : TField);
-
-begin
-  With F Do 
-    begin
-    Writeln ('Field     : ',FieldName);
-    Writeln ('Data type : ',FieldTypeNames[DataType]);
-    Writeln ('As String : ',Asstring);
-    Case Datatype of
-      ftSmallint, ftInteger, ftWord : Writeln ('As longint : ',AsLongint);
-      ftBoolean : Writeln ('As Boolean : ',AsBoolean);
-      ftFloat : Writeln ('As Float : ',AsFloat); 
-      ftDate, ftTime, ftDateTime : Writeln ('As DateTime : ',DateTimeToStr(AsDateTime));
-    end;
-    end;
-end;
-
-Var 
-  Data : TDDGdataset;
-  I,Count : longint;
-  Bookie : TBookMarkStr;
-  
-Procedure ScrollForward;
-
-begin
-  Writeln ('Browsing Forward:');
-  Writeln ('------------------');
-  With Data do
-    While NOT EOF do
-      begin
-      Writeln ('================================================');
-      For I:=0 to FieldCount-1 do
-        DumpFieldData(Fields[I]);
-      Next;  
-      end;  
-end;
-
-Procedure ScrollBackWard;
-
-begin
-  Writeln ('Browsing Backward:');
-  Writeln ('-------------------');
-  With Data do
-    While NOT BOF do
-      begin
-      For I:=0 to FieldCount-1 do
-        DumpFieldData(Fields[I]);
-      Prior;
-      end;
-end;
-
-begin
-  if paramcount<>1 then
-    begin
-    Writeln ('Usage : testds tablename');
-    Halt(1);
-    end;
-  Log ('Creating Dataset');
-  Data:=TDDGDataset.Create(Nil);  
-  With Data do
-    begin
-    Log('Setting Tablename');
-    TableName:=Paramstr(1);
-    Log('Opening Dataset');
-    Open;
-    Log('Dumping fielddefs : ');
-    Writeln ('Fielddefs count : ',FieldDefs.Count);
-    For I:=0 to FieldDefs.Count-1 do
-      DumpFieldDef(FieldDefs.Items[i]);
-    Writeln ('Fields count : ',FieldCount);
-    For I:=0 to FieldCount-1 do
-      DumpField(Fields[i]);
-    ScrollForward;
-    ScrollBackWard;
-    Writeln ('Going to last :');
-    writeln ('---------------');
-    Last;
-    ScrollBackWard;
-    ScrollForward;
-    Writeln ('Going to first:');
-    First;
-    Count:=0;
-    Writeln ('Browsing Forward:');
-    Writeln ('------------------');
-    With Data do
-      While NOT EOF do
-        begin
-        Inc(Count);
-        If Count=50 then 
-          begin
-          Writeln ('Setting bookmark on record');
-          Bookie:=Bookmark;
-          Writeln ('Got data : "',Bookie,'"');
-          end;
-        For I:=0 to FieldCount-1 do
-          DumpFieldData(Fields[I]);
-        Next;  
-        end;
-    Writeln ('Jumping to bookmark',Bookie);
-    BookMark:=Bookie;
-    Writeln ('Dumping Record : ');
-      For I:=0 to FieldCount-1 do
-        DumpFieldData(Fields[I]);
-    Next;
-    Writeln ('Dumping Next Record : ');
-    For I:=0 to FieldCount-1 do
-      DumpFieldData(Fields[I]);
-    Prior;
-    Prior;
-    Writeln ('Dumping Previous Record : ');
-    For I:=0 to FieldCount-1 do
-      DumpFieldData(Fields[I]);
-    Log('Closing Dataset');
-    Close;
-    Log('End.');
-    Free;
-    end;    
-end.
-{
-  $Log$
-  Revision 1.3  1999-11-11 17:31:09  michael
-  + Added Checks for all simple field types.
-  + Initial implementation of Insert/Append
-
-  Revision 1.2  1999/10/24 17:07:54  michael
-  + Added copyright header
-
-}

fcl/db/tested.pp

@@ -1,255 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1999 by Michael Van Canneyt, member of the 
-    Free Pascal development team
-
-    Tests the TDDGDataset component.
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-program testds;
-
-uses db,ddg_ds,sysutils;
-
-Procedure Log(Const Msg : String);
-begin
-  Writeln(Msg);
-end;
-
-Procedure DumpFieldDef(F : TfieldDef);
-
-begin
-  With F do
-    begin
-    Writeln ('Name              : ',Name); 
-    Writeln ('FieldNo           : ',FieldNo);
-    Writeln ('Size              : ',Size);
-    Writeln ('FieldClass        : ',FieldClass.ClassName); 
-    Writeln ('Required          : ',required);
-    Writeln ('Precision         : ',Precision); 
-    Writeln ('DataType          : ',FieldTypeNames[DataType]);
-    Writeln ('InternalCalcField : ',Internalcalcfield);
-    end;
-end;
-
-Procedure DumpField(F : Tfield);
-
-begin
-  With F do
-    begin
-    writeln ('-------------------------------------');
-    Writeln ('FieldName : ',FieldName); 
-    Writeln ('FieldNo   : ',FieldNo);
-    Writeln ('Index     : ',Index);
-    Writeln ('DataSize  : ',DataSize);
-    Writeln ('Size      : ',Size);
-    Writeln ('DataType  : ',FieldTypeNames[DataType]);
-    Writeln ('Class     : ',ClassName); 
-    Writeln ('Required  : ',required);
-    Writeln ('ReadOnly  : ',ReadOnly);
-    Writeln ('Visible   : ',Visible);
-    end;
-end;
-
-Procedure DumpFieldData (F : TField);
-
-begin
-  With F Do 
-    begin
-    Writeln ('Field     : ',FieldName);
-    Writeln ('Data type : ',FieldTypeNames[DataType]);
-    Writeln ('As String : ',Asstring);
-    Case Datatype of
-      ftSmallint, ftInteger, ftWord : Writeln ('As longint : ',AsLongint);
-      ftBoolean : Writeln ('As Boolean : ',AsBoolean);
-      ftFloat : Writeln ('As Float : ',AsFloat); 
-      ftDate, ftTime, ftDateTime : Writeln ('As DateTime : ',DateTimeToStr(AsDateTime));
-    end;
-    end;
-end;
-
-procedure DumpFields (DS : TDataset);
-
-Var I : longint;
-
-begin
-  With DS do 
-    begin
-    Writeln('Dumping fields');
-    For I:=0 to FieldCount-1 do
-      DumpFieldData(Fields[i]);
-    end;
-end;
-
-Var 
-  Data : TDDGdataset;
-  I,Count : longint;
-  Bookie : TBookMarkStr;
-  
-Procedure ScrollForward;
-
-begin
-  Writeln ('Browsing Forward:');
-  Writeln ('------------------');
-  With Data do
-    While NOT EOF do
-      begin
-      Writeln ('================================================');
-      For I:=0 to FieldCount-1 do
-        DumpFieldData(Fields[I]);
-      Next;  
-      end;  
-end;
-
-Procedure ScrollBackWard;
-
-begin
-  Writeln ('Browsing Backward:');
-  Writeln ('-------------------');
-  With Data do
-    While NOT BOF do
-      begin
-      For I:=0 to FieldCount-1 do
-        DumpFieldData(Fields[I]);
-      Prior;
-      end;
-end;
-
-begin
-  if paramcount<>1 then
-    begin
-    Writeln ('Usage : testds tablename');
-    Halt(1);
-    end;
-  Log ('Creating Dataset');
-  Data:=TDDGDataset.Create(Nil);  
-  With Data do
-    begin
-    Log('Setting Tablename');
-    TableName:=Paramstr(1);
-    Log('Opening Dataset');
-    Open;
-    Log('Dumping fielddefs : ');
-    Writeln ('Fielddefs count : ',FieldDefs.Count);
-    For I:=0 to FieldDefs.Count-1 do
-      DumpFieldDef(FieldDefs.Items[i]);
-    Writeln ('Fields count : ',FieldCount);
-    For I:=0 to FieldCount-1 do
-      DumpField(Fields[i]);
-    ScrollForward;
-    ScrollBackWard;
-    Writeln ('Doing append');
-    writeln ('------------');
-    Append;
-    FieldByName('Name').AsString:='AppendName';
-    FieldByName('Height').AsFloat:=9.99E9;
-    FieldByName('LongField').AsLongInt:=999;
-    FieldByName('ShoeSize').AsLongInt:=999;
-    FieldByName('WordField').AsLongInt:=999;
-    FieldByName('BooleanField').AsBoolean:=False;
-    FieldByName('DateTimeField').AsDateTime:=Now;
-    FieldByName('DateField').AsDateTime:=Date;
-    FieldByName('TimeField').AsDateTime:=Time;
-    Writeln ('End of append, going to post');
-    Post;
-    DumpFields(Data);
-    Writeln ('Doing Last');
-    Writeln ('----------');
-    Last;
-    DumpFields(Data);
-    Writeln ('Doing Prior');
-    Writeln ('----------');
-    Prior;
-    DumpFields(Data);
-    Writeln ('Doing Insert at position 8');
-    writeln ('--------------------------');
-    first;
-    for I:=1 to 7 do 
-      Next;
-    Insert;
-    FieldByName('Name').AsString:='Insertname';
-    FieldByName('Height').AsFloat:=8.99E8;
-    FieldByName('LongField').AsLongInt:=888;
-    FieldByName('ShoeSize').AsLongInt:=888;
-    FieldByName('WordField').AsLongInt:=888;
-    FieldByName('BooleanField').AsBoolean:=True;
-    FieldByName('DateTimeField').AsDateTime:=Now;
-    FieldByName('DateField').AsDateTime:=Date;
-    FieldByName('TimeField').AsDateTime:=Time;
-    Post;
-    Writeln ('Doing field dump');
-    writeln ('----------------');
-    DumpFields(Data);
-    Writeln ('Doing Prior');
-    Writeln ('-----------');
-    Prior;
-    DumpFields(Data);
-    Writeln ('Doing Next');
-    Writeln ('----------');
-    Next;
-    DumpFields(Data);
-    Writeln ('Doing Next');
-    Writeln ('----------');
-    Next;
-    DumpFields(Data);
-    Writeln ('Doing Edit at position 5');
-    writeln ('-------------------------');
-    first;
-    for I:=1 to 4 do 
-      Next;
-    Edit;
-    FieldByName('Name').AsString:='Editname';
-    FieldByName('Height').AsFloat:=3.33E3;
-    FieldByName('LongField').AsLongInt:=333;
-    FieldByName('ShoeSize').AsLongInt:=333;
-    FieldByName('WordField').AsLongInt:=333;
-    FieldByName('BooleanField').AsBoolean:=False;
-    FieldByName('DateTimeField').AsDateTime:=Now;
-    FieldByName('DateField').AsDateTime:=Date;
-    FieldByName('TimeField').AsDateTime:=Time;
-    Post;
-    Writeln ('Doing field dump');
-    writeln ('----------------');
-    DumpFields(Data);
-    Writeln ('Doing Prior');
-    Writeln ('-----------');
-    Prior;
-    DumpFields(Data);
-    Writeln ('Doing Next');
-    Writeln ('----------');
-    Next;
-    DumpFields(Data);
-    Writeln ('Doing Next');
-    Writeln ('----------');
-    Next;
-    DumpFields(Data);
-    Writeln ('Closing.');   
-    Close;
-    end;
-end.
-{
-  $Log$
-  Revision 1.3  1999-12-01 22:11:02  michael
-  + tested edit and insert methods
-
-  Revision 1.2  1999/12/01 10:11:58  michael
-  + test of insert works now
-
-  Revision 1.1  1999/11/14 19:26:17  michael
-  + Initial implementation
-
-  Revision 1.3  1999/11/11 17:31:09  michael
-  + Added Checks for all simple field types.
-  + Initial implementation of Insert/Append
-
-  Revision 1.2  1999/10/24 17:07:54  michael
-  + Added copyright header
-
-}

fcl/go32v2/Makefile

@@ -1,1047 +0,0 @@
-#
-# Makefile generated by fpcmake v0.99.13 on 1999-12-24 16:08
-#
-
-defaultrule: all
-
-#####################################################################
-# Autodetect OS (Linux or Dos or Windows NT)
-# define inlinux when running under linux
-# define inWinNT when running under WinNT
-#####################################################################
-
-# We need only / in the path
-override PATH:=$(subst \,/,$(PATH))
-
-# Search for PWD and determine also if we are under linux
-PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
-ifeq ($(PWD),)
-PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
-ifeq ($(PWD),)
-nopwd:
-	@echo You need the GNU utils package to use this Makefile!
-	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
-	@exit
-else
-inlinux=1
-endif
-else
-PWD:=$(firstword $(PWD))
-endif
-
-# Detect NT - NT sets OS to Windows_NT
-ifndef inlinux
-ifeq ($(OS),Windows_NT)
-inWinNT=1
-endif
-endif
-
-# Detect OS/2 - OS/2 has OS2_SHELL defined
-ifndef inlinux
-ifndef inWinNT
-ifdef OS2_SHELL
-inOS2=1
-endif
-endif
-endif
-
-# The extension of executables
-ifdef inlinux
-EXEEXT=
-else
-EXEEXT=.exe
-endif
-
-# The path which is search separated by spaces
-ifdef inlinux
-SEARCHPATH=$(subst :, ,$(PATH))
-else
-SEARCHPATH=$(subst ;, ,$(PATH))
-endif
-
-#####################################################################
-# Default target
-#####################################################################
-
-override OS_TARGET:=go32v2
-
-#####################################################################
-# FPC version/target Detection
-#####################################################################
-
-# What compiler to use ?
-ifndef FPC
-# Compatibility with old makefiles
-ifdef PP
-FPC=$(PP)
-else
-ifdef inOS2
-FPC=ppos2$(EXEEXT)
-else
-FPC=ppc386$(EXEEXT)
-endif
-endif
-endif
-
-# Target OS
-ifndef OS_TARGET
-OS_TARGET:=$(shell $(FPC) -iTO)
-endif
-
-# Source OS
-ifndef OS_SOURCE
-OS_SOURCE:=$(shell $(FPC) -iSO)
-endif
-
-# Target CPU
-ifndef CPU_TARGET
-CPU_TARGET:=$(shell $(FPC) -iTP)
-endif
-
-# Source CPU
-ifndef CPU_SOURCE
-CPU_SOURCE:=$(shell $(FPC) -iSP)
-endif
-
-# FPC version
-ifndef FPC_VERSION
-FPC_VERSION:=$(shell $(FPC) -iV)
-endif
-
-export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
-
-#####################################################################
-# Default Settings
-#####################################################################
-
-# Release ? Then force OPT and don't use extra opts via commandline
-ifndef REDIRFILE
-REDIRFILE=log
-endif
-
-ifdef RELEASE
-override OPT:=-Xs -OG2p3 -n
-endif
-
-# Verbose settings (warning,note,info)
-ifdef VERBOSE
-override OPT+=-vwni
-endif
-
-ifdef REDIR
-ifndef inlinux
-override FPC=redir -eo $(FPC)
-endif
-# set the verbosity to max
-override OPT+=-va
-override REDIR:= >> $(REDIRFILE)
-endif
-
-#####################################################################
-# User Settings
-#####################################################################
-
-
-# Pre Settings
-
-# Include files
-INC=../inc
-XML=../xml
-
-# INCUNITS,XMLUNITS is defined in makefile.inc
-# They are default units for all platforms.
-include $(INC)/Makefile.inc
-include $(XML)/Makefile.inc
-
-# Targets
-
-override UNITOBJECTS+=classes $(INCUNITS) $(XMLUNITS) zstream
-
-# Clean
-
-
-# Install
-
-ZIPTARGET=install
-
-# Defaults
-
-override NEEDOPT=-S2
-
-# Directories
-
-vpath %$(PASEXT) $(INC) $(XML)
-ifndef FPCDIR
-FPCDIR=../..
-endif
-ifndef PACKAGEDIR
-PACKAGEDIR=$(FPCDIR)/packages
-endif
-ifndef COMPONENTDIR
-COMPONENTDIR=$(FPCDIR)/components
-endif
-override NEEDINCDIR=$(INC)
-ifndef TARGETDIR
-TARGETDIR=.
-endif
-
-# Packages
-
-override PACKAGES+=paszlib
-ifneq ($(wildcard $(PACKAGEDIR)/paszlib/$(OS_TARGET)),)
-override NEEDUNITDIR+=$(PACKAGEDIR)/paszlib/$(OS_TARGET)
-else
-override NEEDUNITDIR+=$(PACKAGEDIR)/paszlib
-endif
-
-# Libraries
-
-
-# Info
-
-INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall 
-
-#####################################################################
-# Default Directories
-#####################################################################
-
-# Base dir
-ifdef PWD
-BASEDIR:=$(shell $(PWD))
-else
-BASEDIR=.
-endif
-
-# this can be set to 'rtl' when the RTL units are installed
-ifndef UNITPREFIX
-UNITPREFIX=units
-endif
-
-# set the prefix directory where to install everything
-ifndef PREFIXINSTALLDIR
-ifdef inlinux
-PREFIXINSTALLDIR=/usr
-else
-PREFIXINSTALLDIR=/pp
-endif
-endif
-export PREFIXINSTALLDIR
-
-# create fcldir,rtldir,unitdir
-ifdef FPCDIR
-override FPCDIR:=$(subst \,/,$(FPCDIR))
-ifneq ($(FPCDIR),.)
-override RTLDIR=$(FPCDIR)/rtl/$(OS_TARGET)
-override FCLDIR=$(FPCDIR)/fcl/$(OS_TARGET)
-override UNITSDIR=$(FPCDIR)/units/$(OS_TARGET)
-endif
-endif
-
-#####################################################################
-# Install Directories
-#####################################################################
-
-# set the base directory where to install everything
-ifndef BASEINSTALLDIR
-ifdef inlinux
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION)
-else
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)
-endif
-endif
-
-# set the directory where to install the binaries
-ifndef BININSTALLDIR
-ifdef inlinux
-BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
-else
-BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
-endif
-endif
-
-# set the directory where to install the units.
-ifndef UNITINSTALLDIR
-UNITINSTALLDIR=$(BASEINSTALLDIR)/$(UNITPREFIX)/$(OS_TARGET)
-endif
-
-# Where to install shared libraries
-ifndef LIBINSTALLDIR
-ifdef inlinux
-LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
-else
-LIBINSTALLDIR=$(UNITINSTALLDIR)
-endif
-endif
-
-# Where the source files will be stored
-ifndef SOURCEINSTALLDIR
-ifdef inlinux
-SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION)
-else
-SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source
-endif
-endif
-
-# Where the doc files will be stored
-ifndef DOCINSTALLDIR
-ifdef inlinux
-DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc/$(FPC_VERSION)
-else
-DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
-endif
-endif
-
-# Where the some extra (data)files will be stored
-ifndef EXTRAINSTALLDIR
-EXTRAINSTALLDIR=$(BASEINSTALLDIR)
-endif
-
-
-#####################################################################
-# Compiler Command Line
-#####################################################################
-
-# Load commandline OPTDEF and add FPC_CPU define
-override FPCOPTDEF:=-d$(CPU_TARGET)
-
-# Load commandline OPT and add target and unit dir to be sure
-ifneq ($(OS_TARGET),$(OS_SOURCE))
-override FPCOPT+=-T$(OS_TARGET)
-endif
-
-ifdef NEEDOPT
-override FPCOPT+=$(NEEDOPT)
-endif
-
-ifdef RTLDIR
-override FPCOPT+=-Fu$(RTLDIR)
-endif
-
-ifdef UNITSDIR
-override FPCOPT+=-Fu$(UNITSDIR)
-endif
-
-ifdef NEEDUNITDIR
-override FPCOPT+=$(addprefix -Fu,$(NEEDUNITDIR))
-endif
-
-ifdef NEEDINCDIR
-override FPCOPT+=$(addprefix -Fi,$(NEEDINCDIR))
-endif
-
-
-# Target dirs
-ifdef TARGETDIR
-override FPCOPT+=-FE$(TARGETDIR)
-endif
-
-# Smartlinking
-ifdef SMARTLINK
-override FPCOPT+=-CX
-endif
-
-# Debug
-ifdef DEBUG
-override FPCOPT+=-g
-endif
-
-# Add commandline options
-ifdef OPT
-override FPCOPT+=$(OPT)
-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
-
-# Add defines from FPCOPTDEF to FPCOPT
-ifdef FPCOPTDEF
-override FPCOPT+=$(FPCOPTDEF)
-endif
-
-# Error file ?
-ifdef ERRORFILE
-override FPCOPT+=-Fr$(ERRORFILE)
-endif
-
-# Was a config file specified ?
-ifdef CFGFILE
-override FPCOPT+=@$(CFGFILE)
-endif
-
-# For win32 the options are passed using the environment variable FPCEXTCMD
-ifeq ($(OS_SOURCE),win32)
-override FPCEXTCMD:=$(FPCOPT)
-override FPCOPT:=!FPCEXTCMD
-export FPCEXTCMD
-endif
-
-# Compiler commandline
-override COMPILER:=$(FPC) $(FPCOPT)
-
-#####################################################################
-# Shell tools
-#####################################################################
-
-# To copy pograms
-ifndef COPY
-COPY:=cp -fp
-endif
-
-# Copy a whole tree
-ifndef COPYTREE
-COPYTREE:=cp -rfp
-endif
-
-# To move pograms
-ifndef MOVE
-MOVE:=mv -f
-endif
-
-# Check delete program
-ifndef DEL
-DEL:=rm -f
-endif
-
-# Check deltree program
-ifndef DELTREE
-DELTREE:=rm -rf
-endif
-
-# To install files
-ifndef INSTALL
-ifdef inlinux
-INSTALL:=install -m 644
-else
-INSTALL:=$(COPY)
-endif
-endif
-
-# To install programs
-ifndef INSTALLEXE
-ifdef inlinux
-INSTALLEXE:=install -m 755
-else
-INSTALLEXE:=$(COPY)
-endif
-endif
-
-# To make a directory.
-ifndef MKDIR
-ifdef inlinux
-MKDIR:=install -m 755 -d
-else
-MKDIR:=ginstall -m 755 -d
-endif
-endif
-
-export COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
-
-#####################################################################
-# Default Tools
-#####################################################################
-
-# assembler, redefine it if cross compiling
-ifndef AS
-AS=as
-endif
-
-# linker, but probably not used
-ifndef LD
-LD=ld
-endif
-
-# ppas.bat / ppas.sh
-ifdef inlinux
-PPAS=ppas.sh
-else
-ifdef inOS2
-PPAS=ppas.cmd
-else
-PPAS=ppas.bat
-endif
-endif
-
-# also call ppas if with command option -s
-ifeq (,$(findstring -s ,$(COMPILER)))
-EXECPPAS=
-else
-EXECPPAS:=@$(PPAS)
-endif
-
-# ldconfig to rebuild .so cache
-ifdef inlinux
-LDCONFIG=ldconfig
-else
-LDCONFIG=
-endif
-
-# echo
-ifndef ECHO
-ECHO:=$(strip $(wildcard $(addsuffix /echo$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO:=echo
-else
-ECHO:=$(firstword $(ECHO))
-endif
-endif
-export ECHO
-
-# ppdep
-ifndef PPDEP
-PPDEP:=$(strip $(wildcard $(addsuffix /ppdep$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPDEP),)
-PPDEP=
-else
-PPDEP:=$(firstword $(PPDEP))
-endif
-endif
-export PPDEP
-
-# ppumove
-ifndef PPUMOVE
-PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUMOVE),)
-PPUMOVE=
-else
-PPUMOVE:=$(firstword $(PPUMOVE))
-endif
-endif
-export PPUMOVE
-
-# ppufiles
-ifndef PPUFILES
-PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUFILES),)
-PPUFILES=
-else
-PPUFILES:=$(firstword $(PPUFILES))
-endif
-endif
-export PPUFILES
-
-# Look if UPX is found for go32v2 and win32. We can't use $UPX becuase
-# upx uses that one itself (PFV)
-ifndef UPXPROG
-ifeq ($(OS_TARGET),go32v2)
-UPXPROG:=1
-endif
-ifeq ($(OS_TARGET),win32)
-UPXPROG:=1
-endif
-ifdef UPXPROG
-UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(UPXPROG),)
-UPXPROG=
-else
-UPXPROG:=$(firstword $(UPXPROG))
-endif
-else
-UPXPROG=
-endif
-endif
-export UPXPROG
-
-# gdate/date
-ifndef DATE
-DATE:=$(strip $(wildcard $(addsuffix /date$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(DATE),)
-DATE:=$(strip $(wildcard $(addsuffix /gdate$(EXEEXT),$(SEACHPATH))))
-ifeq ($(DATE),)
-DATE=
-else
-DATE:=$(firstword $(DATE))
-endif
-else
-DATE:=$(firstword $(DATE))
-endif
-endif
-export DATE
-
-ifdef DATE
-DATESTR:=$(shell $(DATE) +%Y%m%d)
-else
-DATESTR=
-endif
-
-# ZipProg, you can't use Zip as the var name (PFV)
-ifndef ZIPPROG
-ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ZIPPROG),)
-ZIPPROG=
-else
-ZIPPROG:=$(firstword $(ZIPPROG)) -D9 -r
-endif
-endif
-export ZIPPROG
-
-ifndef ZIPEXT
-ZIPEXT=.zip
-endif
-
-#####################################################################
-# Default extensions
-#####################################################################
-
-# Default needed extensions (Go32v2,Linux)
-LOADEREXT=.as
-PPLEXT=.ppl
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.so
-PACKAGESUFFIX=
-FPCMADE=fpcmade
-
-# Go32v1
-ifeq ($(OS_TARGET),go32v1)
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-STATICLIBEXT=.a1
-SHAREDLIBEXT=.so1
-PACKAGESUFFIX=v1
-FPCMADE=fpcmade.v1
-endif
-
-# Go32v2
-ifeq ($(OS_TARGET),go32v2)
-PACKAGESUFFIX=go32
-FPCMADE=fpcmade.dos
-endif
-
-# Linux
-ifeq ($(OS_TARGET),linux)
-PACKAGESUFFIX=linux
-FPCMADE=fpcmade.lnx
-endif
-
-# Win32
-ifeq ($(OS_TARGET),win32)
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=win32
-FPCMADE=fpcmade.w32
-endif
-
-# OS/2
-ifeq ($(OS_TARGET),os2)
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-SMARTEXT=.so
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=os2
-FPCMADE=fpcmade.os2
-endif
-
-# library prefix
-LIBPREFIX=lib
-ifeq ($(OS_TARGET),go32v2)
-LIBPREFIX=
-endif
-ifeq ($(OS_TARGET),go32v1)
-LIBPREFIX=
-endif
-
-# determine which .pas extension is used
-ifndef PASEXT
-ifdef EXEOBJECTS
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
-else
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
-endif
-ifeq ($(TESTPAS),)
-PASEXT=.pp
-else
-PASEXT=.pas
-endif
-endif
-
-#####################################################################
-# Standard rules
-#####################################################################
-
-all: fpc_all
-
-debug: fpc_debug
-
-smart: fpc_smart
-
-shared: fpc_shared
-
-showinstall: fpc_showinstall
-
-install: fpc_install
-
-sourceinstall: fpc_sourceinstall
-
-zipinstall: fpc_zipinstall
-
-zipinstalladd: fpc_zipinstalladd
-
-clean: fpc_clean
-
-cleanall: fpc_cleanall
-
-info: fpc_info
-
-.PHONY:  all debug smart shared showinstall install sourceinstall zipinstall zipinstalladd clean cleanall info
-
-#####################################################################
-# Package depends
-#####################################################################
-
-ifneq ($(wildcard $(RTLDIR)),)
-ifeq ($(wildcard $(RTLDIR)/$(FPCMADE)),)
-override COMPILEPACKAGES+=rtl
-rtl_package:
-	$(MAKE) -C $(RTLDIR) all
-endif
-endif
-
-PACKAGEPASZLIB=1
-ifdef PACKAGEPASZLIB
-ifneq ($(wildcard $(PACKAGEDIR)/paszlib),)
-ifeq ($(wildcard $(PACKAGEDIR)/paszlib/$(FPCMADE)),)
-override COMPILEPACKAGES+=paszlib
-paszlib_package:
-	$(MAKE) -C $(PACKAGEDIR)/paszlib all
-endif
-endif
-endif
-
-.PHONY:  rtl_package paszlib_package
-
-#####################################################################
-# Units
-#####################################################################
-
-.PHONY: fpc_units
-
-override ALLTARGET+=fpc_units
-
-override UNITPPUFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS))
-override INSTALLPPUFILES+=$(UNITPPUFILES)
-override CLEANPPUFILES+=$(UNITPPUFILES)
-
-fpc_units: $(UNITPPUFILES)
-
-#####################################################################
-# General compile rules
-#####################################################################
-
-.PHONY: fpc_all fpc_debug
-
-$(FPCMADE):
-	@$(ECHO) Compiled > $(FPCMADE)
-
-fpc_all: $(addsuffix _package,$(COMPILEPACKAGES)) \
-	 $(addsuffix _component,$(COMPILECOMPONENTS)) \
-	 $(ALLTARGET) $(FPCMADE)
-
-fpc_debug:
-	$(MAKE) all DEBUG=1
-
-# General compile rules, available for both possible PASEXT
-
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
-
-%$(PPUEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(PPUEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-#####################################################################
-# Library
-#####################################################################
-
-.PHONY: fpc_smart fpc_shared
-
-# Default sharedlib units are all unit objects
-ifndef SHAREDLIBUNITOBJECTS
-SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
-endif
-
-fpc_smart:
-	$(MAKE) all SMARTLINK=1
-
-fpc_shared: all
-ifdef inlinux
-ifndef LIBNAME
-	@$(ECHO) "LIBNAME not set"
-else
-	$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
-endif
-else
-	@$(ECHO) "Shared Libraries not supported"
-endif
-
-#####################################################################
-# Install rules
-#####################################################################
-
-.PHONY: fpc_showinstall fpc_install
-
-ifdef EXTRAINSTALLUNITS
-override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))
-endif
-
-ifdef INSTALLPPUFILES
-ifdef PPUFILES
-ifdef inlinux
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
-INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
-else
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
-endif
-else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
-endif
-endif
-
-fpc_showinstall: $(SHOWINSTALLTARGET)
-ifdef INSTALLEXEFILES
-	@$(ECHO) -e $(addprefix "\n"$(BININSTALLDIR)/,$(INSTALLEXEFILES))
-endif
-ifdef INSTALLPPUFILES
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPUFILES))
-ifneq ($(INSTALLPPULINKFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	@$(ECHO) -e $(addprefix "\n"$(EXTRAINSTALLDIR)/,$(EXTRAINSTALLFILES))
-endif
-
-fpc_install: $(INSTALLTARGET)
-# Create UnitInstallFiles
-ifdef INSTALLEXEFILES
-	$(MKDIR) $(BININSTALLDIR)
-# Compress the exes if upx is defined
-ifdef UPXPROG
-	-$(UPXPROG) $(INSTALLEXEFILES)
-endif
-	$(INSTALLEXE) $(INSTALLEXEFILES) $(BININSTALLDIR)
-endif
-ifdef INSTALLPPUFILES
-	$(MKDIR) $(UNITINSTALLDIR)
-	$(INSTALL) $(INSTALLPPUFILES) $(UNITINSTALLDIR)
-ifneq ($(INSTALLPPULINKFILES),)
-	$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	$(MKDIR) $(LIBINSTALLDIR)
-	$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	$(MKDIR) $(EXTRAINSTALLDIR)
-	$(INSTALL) $(EXTRAINSTALLFILES) $(EXTRAINSTALLDIR)
-endif
-
-#####################################################################
-# Source install rules
-#####################################################################
-
-.PHONY: fpc_sourceinstall
-
-fpc_sourceinstall: clean
-	$(MKDIR) $(SOURCEINSTALLDIR)
-	$(COPYTREE) $(BASEDIR) $(SOURCEINSTALLDIR)
-
-#####################################################################
-# Zip
-#####################################################################
-
-.PHONY: fpc_zipinstall fpc_zipinstalladd
-
-# Temporary path to pack a file
-ifndef PACKDIR
-ifndef inlinux
-PACKDIR=pack_tmp
-else
-PACKDIR=/tmp/fpc-pack
-endif
-endif
-
-# Test dir if none specified
-ifndef DESTZIPDIR
-DESTZIPDIR:=$(BASEDIR)
-endif
-
-# Add .zip/.tar.gz extension
-ifdef ZIPNAME
-ifndef inlinux
-override ZIPNAME:=$(ZIPNAME)$(ZIPEXT)
-endif
-endif
-
-# Note: This will not remove the zipfile first
-fpc_zipinstalladd:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	gzip -d $(DESTZIPDIR)/$(ZIPNAME).tar.gz
-	cd $(PACKDIR) ; tar rv --file $(DESTZIPDIR)/$(ZIPNAME).tar * ; cd $(BASEDIR)
-	gzip $(DESTZIPDIR)/$(ZIPNAME).tar
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-# First remove the zip and then install
-fpc_zipinstall:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	cd $(PACKDIR) ; tar cvz --file $(DESTZIPDIR)/$(ZIPNAME).tar.gz * ; cd $(BASEDIR)
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-#####################################################################
-# Clean rules
-#####################################################################
-
-.PHONY: fpc_clean fpc_cleanall
-
-ifdef EXTRACLEANUNITS
-override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS))
-endif
-
-ifdef CLEANPPUFILES
-ifdef PPUFILES
-CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
-else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
-endif
-endif
-
-fpc_clean: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-ifdef CLEANPPUFILES
-	-$(DEL) $(CLEANPPUFILES)
-endif
-ifneq ($(CLEANPPULINKFILES),)
-	-$(DEL) $(CLEANPPULINKFILES)
-endif
-ifdef EXTRACLEANFILES
-	-$(DEL) $(EXTRACLEANFILES)
-endif
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-fpc_cleanall: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-	-$(DELTREE) *$(SMARTEXT)
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-#####################################################################
-# Info rules
-#####################################################################
-
-.PHONY: fpc_info fpc_cfginfo fpc_objectinfo fpc_toolsinfo fpc_installinfo \
-	fpc_dirinfo
-
-fpc_info: $(INFOTARGET)
-
-fpc_infocfg:
-	@$(ECHO)
-	@$(ECHO)  == Configuration info ==
-	@$(ECHO)
-	@$(ECHO)  FPC....... $(FPC)
-	@$(ECHO)  Version... $(FPC_VERSION)
-	@$(ECHO)  CPU....... $(CPU_TARGET)
-	@$(ECHO)  Source.... $(OS_SOURCE)
-	@$(ECHO)  Target.... $(OS_TARGET)
-	@$(ECHO)
-
-fpc_infoobjects:
-	@$(ECHO)
-	@$(ECHO)  == Object info ==
-	@$(ECHO)
-	@$(ECHO)  LoaderObjects..... $(LOADEROBJECTS)
-	@$(ECHO)  UnitObjects....... $(UNITOBJECTS)
-	@$(ECHO)  ExeObjects........ $(EXEOBJECTS)
-	@$(ECHO)
-	@$(ECHO)  ExtraCleanUnits... $(EXTRACLEANUNITS)
-	@$(ECHO)  ExtraCleanFiles... $(EXTRACLEANFILES)
-	@$(ECHO)
-	@$(ECHO)  ExtraInstallUnits. $(EXTRAINSTALLUNITS)
-	@$(ECHO)  ExtraInstallFiles. $(EXTRAINSTALLFILES)
-	@$(ECHO)
-
-fpc_infoinstall:
-	@$(ECHO)
-	@$(ECHO)  == Install info ==
-	@$(ECHO)
-ifdef DATE
-	@$(ECHO)  DateStr.............. $(DATESTR)
-endif
-	@$(ECHO)  PackageSuffix........ $(PACKAGESUFFIX)
-	@$(ECHO)
-	@$(ECHO)  BaseInstallDir....... $(BASEINSTALLDIR)
-	@$(ECHO)  BinInstallDir........ $(BININSTALLDIR)
-	@$(ECHO)  LibInstallDir........ $(LIBINSTALLDIR)
-	@$(ECHO)  UnitInstallDir....... $(UNITINSTALLDIR)
-	@$(ECHO)  SourceInstallDir..... $(SOURCEINSTALLDIR)
-	@$(ECHO)  DocInstallDir........ $(DOCINSTALLDIR)
-	@$(ECHO)  ExtraInstallDir...... $(EXTRAINSTALLDIR)
-	@$(ECHO)
-
-#####################################################################
-# Users rules
-#####################################################################
-
-INCFILES=$(addprefix $(INC)/,$(INCNAMES))
-
-classes$(PPUEXT): $(INCFILES) classes$(PASEXT)
-
-inifiles$(PPUEXT): classes$(PPUEXT) inifiles$(PASEXT)
-
-ezcgi$(PPUEXT): ezcgi$(PASEXT) ezcgi.inc

fcl/go32v2/Makefile.fpc

@@ -1,40 +0,0 @@
-#
-#   Makefile.fpc for Free Component Library for Go32v2
-#
-
-[defaults]
-defaulttarget=go32v2
-defaultoptions=-S2
-
-[packages]
-packages=paszlib
-
-[dirs]
-fpcdir=../..
-targetdir=.
-incdir=$(INC)
-sourcesdir=$(INC) $(XML)
-
-[targets]
-units=classes $(INCUNITS) $(XMLUNITS) zstream
-
-
-[presettings]
-# Include files
-INC=../inc
-XML=../xml
-
-# INCUNITS,XMLUNITS is defined in makefile.inc
-# They are default units for all platforms.
-include $(INC)/Makefile.inc
-include $(XML)/Makefile.inc
-
-
-[rules]
-INCFILES=$(addprefix $(INC)/,$(INCNAMES))
-
-classes$(PPUEXT): $(INCFILES) classes$(PASEXT)
-
-inifiles$(PPUEXT): classes$(PPUEXT) inifiles$(PASEXT)
-
-ezcgi$(PPUEXT): ezcgi$(PASEXT) ezcgi.inc

fcl/go32v2/classes.pp

@@ -1,43 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
-
-    Classes unit for win32
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{$mode objfpc}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  strings,
-  sysutils;
-
-{$i classesh.inc}
-
-implementation
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-end.
-{
-  $Log$
-  Revision 1.4  1999-05-30 10:46:37  peter
-    * start of tthread for linux,win32
-
-}

fcl/go32v2/ezcgi.inc

@@ -1,9 +0,0 @@
-Uses Dos;
-
-{ Declared EXPLICITLY with Ansistring, so NO mistaking is possible }
-
-Function Getenv (Var EnvVar  : AnsiString): AnsiString;
-
-begin
-  Result:=Dos.Getenv(EnvVar); 
-end;

fcl/go32v2/pipes.inc

@@ -1,23 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1998 by Michael Van Canneyt
-
-    DOS/go32v2 specific part of pipe stream.
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-// No pipes under dos, sorry...
-
-Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
-
-begin
-  Result := False;
-end;

fcl/go32v2/thread.inc

@@ -1,101 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TThread                                      *}
-{****************************************************************************}
-
-
-procedure TThread.CallOnTerminate;
-
-begin
-end;
-
-
-function TThread.GetPriority: TThreadPriority;
-
-begin
-  GetPriority:=tpNormal;
-end;
-
-
-procedure TThread.SetPriority(Value: TThreadPriority);
-
-begin
-end;
-
-
-procedure TThread.SetSuspended(Value: Boolean);
-
-begin
-end;
-
-
-procedure TThread.DoTerminate;
-
-begin
-end;
-
-
-procedure TThread.Synchronize(Method: TThreadMethod);
-
-begin
-end;
-
-
-constructor TThread.Create(CreateSuspended: Boolean);
-
-begin
-end;
-
-
-destructor TThread.Destroy;
-
-begin
-end;
-
-
-procedure TThread.Resume;
-
-begin
-end;
-
-
-procedure TThread.Suspend;
-
-begin
-end;
-
-
-procedure TThread.Terminate;
-
-begin
-end;
-
-
-function TThread.WaitFor: Integer;
-
-begin
-  WaitFor:=0;
-end;
-
-
-{
-  $Log$
-  Revision 1.1  1999-05-30 10:46:39  peter
-    * start of tthread for linux,win32
-
-  Revision 1.2  1999/04/08 10:18:57  peter
-    * makefile updates
-
-}

fcl/inc/Makefile.inc

@@ -1,8 +0,0 @@
-#
-# This makefile sets some needed variable, common to all targets
-
-INCNAMES=classes.inc classesh.inc bits.inc collect.inc compon.inc filer.inc\
-         lists.inc parser.inc persist.inc reader.inc streams.inc stringl.inc\
-         writer.inc cregist.inc
-
-INCUNITS=inifiles ezcgi pipes rtfpars idea base64 gettext iostream

fcl/inc/base64.pp

@@ -1,302 +0,0 @@
-// $Id$
-
-// Encoding and decoding streams for base64 data as described in RFC2045
-
-{$MODE objfpc}
-{$H+}
-
-unit base64;
-
-interface
-
-uses classes;
-
-type
-
-  TBase64EncodingStream = class(TStream)
-  protected
-    OutputStream: TStream;
-    TotalBytesProcessed, BytesWritten: LongWord;
-    Buf: array[0..2] of Byte;
-    BufSize: Integer;    // # of bytes used in Buf
-  public
-    constructor Create(AOutputStream: TStream);
-    destructor Destroy; override;
-
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-  end;
-
-
-  TBase64DecodingStream = class(TStream)
-  protected
-    InputStream: TStream;
-    CurPos, InputStreamSize: LongInt;
-    Buf: array[0..2] of Byte;
-    BufPos: Integer;    // Offset of byte which is to be read next
-    fEOF: Boolean;
-  public
-    constructor Create(AInputStream: TStream);
-    procedure Reset;
-
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    property EOF: Boolean read fEOF;
-  end;
-
-
-
-implementation
-
-const
-
-  EncodingTable: PChar =
-    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
-
-  DecTable: array[Byte] of Byte =
-    (99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,  // 0-15
-     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,  // 16-31
-     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 62, 99, 99, 99, 63,  // 32-47
-     52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 99, 99, 99, 00, 99, 99,  // 48-63
-     99, 00, 01, 02, 03, 04, 05, 06, 07, 08, 09, 10, 11, 12, 13, 14,  // 64-79
-     15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 99, 99, 99, 99, 99,  // 80-95
-     99, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40,  // 96-111
-     41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 99, 99, 99, 99, 99,  // 112-127
-     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
-     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
-     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
-     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
-     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
-     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
-     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99,
-     99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99, 99);
-
-
-constructor TBase64EncodingStream.Create(AOutputStream: TStream);
-begin
-  inherited Create;
-  OutputStream := AOutputStream;
-end;
-
-destructor TBase64EncodingStream.Destroy;
-var
-  WriteBuf: array[0..3] of Char;
-begin
-  // Fill output to multiple of 4
-  case (TotalBytesProcessed mod 3) of
-    1: begin
-        WriteBuf[0] := EncodingTable[Buf[0] shr 2];
-        WriteBuf[1] := EncodingTable[(Buf[0] and 3) shl 4];
-	WriteBuf[2] := '=';
-	WriteBuf[3] := '=';
-        OutputStream.Write(WriteBuf, 4);
-      end;
-    2: begin
-        WriteBuf[0] := EncodingTable[Buf[0] shr 2];
-	WriteBuf[1] := EncodingTable[(Buf[0] and 3) shl 4 or (Buf[1] shr 4)];
-	WriteBuf[2] := EncodingTable[(Buf[1] and 15) shl 2];
-	WriteBuf[3] := '=';
-	OutputStream.Write(WriteBuf, 4);
-      end;
-  end;
-  inherited Destroy;
-end;
-
-function TBase64EncodingStream.Read(var Buffer; Count: Longint): Longint;
-begin
-  raise EStreamError.Create('Invalid stream operation');
-end;
-
-function TBase64EncodingStream.Write(const Buffer; Count: Longint): Longint;
-var
-  ReadNow: LongInt;
-  p: Pointer;
-  WriteBuf: array[0..3] of Char;
-begin
-  Inc(TotalBytesProcessed, Count);
-  Result := Count;
-
-  p := @Buffer;
-  while count > 0 do begin
-    // Fetch data into the Buffer
-    ReadNow := 3 - BufSize;
-    if ReadNow > Count then break;    // Not enough data available
-    Move(p^, Buf[BufSize], ReadNow);
-    Inc(p, ReadNow);
-    Dec(Count, ReadNow);
-
-    // Encode the 3 bytes in Buf
-    WriteBuf[0] := EncodingTable[Buf[0] shr 2];
-    WriteBuf[1] := EncodingTable[(Buf[0] and 3) shl 4 or (Buf[1] shr 4)];
-    WriteBuf[2] := EncodingTable[(Buf[1] and 15) shl 2 or (Buf[2] shr 6)];
-    WriteBuf[3] := EncodingTable[Buf[2] and 63];
-    OutputStream.Write(WriteBuf, 4);
-    Inc(BytesWritten, 4);
-    BufSize := 0;
-  end;
-  Move(p^, Buf[BufSize], count);
-  Inc(BufSize, count);
-end;
-
-function TBase64EncodingStream.Seek(Offset: Longint; Origin: Word): Longint;
-begin
-  Result := BytesWritten;
-  if BufSize > 0 then
-    Inc(Result, 4);
-
-  // This stream only supports the Seek modes needed for determining its size
-  if not ((((Origin = soFromCurrent) or (Origin = soFromEnd)) and (Offset = 0))
-     or ((Origin = soFromBeginning) and (Offset = Result))) then
-    raise EStreamError.Create('Invalid stream operation');
-end;
-
-
-
-
-constructor TBase64DecodingStream.Create(AInputStream: TStream);
-begin
-  inherited Create;
-  InputStream := AInputStream;
-  Reset;
-end;
-
-procedure TBase64DecodingStream.Reset;
-begin
-  InputStreamSize := -1;
-  BufPos := 3;
-  fEOF := False;
-end;
-
-function TBase64DecodingStream.Read(var Buffer; Count: Longint): Longint;
-var
-  p: PChar;
-  b: Char;
-  ReadBuf: array[0..3] of Byte;
-  ToRead, OrgToRead, HaveRead, ReadOK, i, j: Integer;
-begin
-  if Count <= 0 then exit(0);
-  if InputStreamSize <> -1 then begin
-    if CurPos + Count > InputStreamSize then
-      Count := InputStreamSize - CurPos;
-    if Count <= 0 then exit(0);
-  end;
-
-  Result := 0;
-  p := PChar(@Buffer);
-  while (Count > 0) and not fEOF do begin
-    if BufPos > 2 then begin
-      BufPos := 0;
-      // Read the next 4 valid bytes
-      ToRead := 4;
-      ReadOK := 0;
-      while ToRead > 0 do begin
-        OrgToRead := ToRead;
-        HaveRead := InputStream.Read(ReadBuf[ReadOK], ToRead);
-	//WriteLn('ToRead = ', ToRead, ', HaveRead = ', HaveRead, ', ReadOK=', ReadOk);
-	if HaveRead > 0 then begin
-	  i := ReadOk;
-	  while i <= HaveRead do begin
-	    ReadBuf[i] := DecTable[ReadBuf[i]];
-	    if ReadBuf[i] = 99 then
-	      for j := i to 3 do
-	        ReadBuf[i] := ReadBuf[i + 1]
-	    else begin
-	      Inc(i);
-	      Inc(ReadOK);
-	      Dec(ToRead);
-	    end;
-	  end;
-	end;
-	if HaveRead <> OrgToRead then begin
-	  //WriteLn('Ende? ReadOK=', ReadOK, ', count=', Count);
-	  for i := ReadOK to 3 do
-	    ReadBuf[i] := Ord('=');
-	  fEOF := True;
-	  if ReadOK < 2 then exit;    // Not enough data available in input stream
-	  break;
-	end;
-      end;
-
-      // Check for fill bytes
-      if (Count >= 2) and (ReadBuf[3] = Ord('=')) then begin
-        //WriteLn('Endemarkierung!');
-	fEOF := True;
-	if ReadBuf[2] = Ord('=') then
-	  Count := 1
-	else
-	  Count := 2;
-      end;
-
-      // Decode the 4 bytes in the buffer to 3 undecoded bytes
-      Buf[0] := ReadBuf[0] shl 2 or ReadBuf[1] shr 4;
-      Buf[1] := (ReadBuf[1] and 15) shl 4 or ReadBuf[2] shr 2;
-      Buf[2] := (ReadBuf[2] and 3) shl 6 or ReadBuf[3];
-    end;
-
-    p[0] := Chr(Buf[BufPos]);
-    Inc(p);
-    Inc(BufPos);
-    Inc(CurPos);
-    Dec(Count);
-    Inc(Result);
-  end;
-end;
-
-function TBase64DecodingStream.Write(const Buffer; Count: Longint): Longint;
-begin
-  raise EStreamError.Create('Invalid stream operation');
-end;
-
-function TBase64DecodingStream.Seek(Offset: Longint; Origin: Word): Longint;
-var
-  ipos: LongInt;
-  endbytes: array[0..1] of Char;
-begin
-  {This will work only if the input stream supports seeking / Size. If not, the
-   input stream will raise an exception; we don't handle them here but pass them
-   to the caller.}
-  if InputStreamSize = -1 then begin
-    ipos := InputStream.Position;
-    InputStreamSize := ((InputStream.Size - ipos + 3) div 4) * 3;
-    InputStream.Seek(-2, soFromEnd);
-    InputStream.Read(endbytes, 2);
-    InputStream.Position := ipos;
-    if endbytes[1] = '=' then begin
-      Dec(InputStreamSize);
-    if endbytes[0] = '=' then
-      Dec(InputStreamSize);
-    end;
-  end;
-
-  // This stream only supports the Seek modes needed for determining its size
-  if (Origin = soFromCurrent) and (Offset = 0) then
-    Result := CurPos
-  else if (Origin = soFromEnd) and (Offset = 0) then
-    Result := InputStreamSize
-  else if (Origin = soFromBeginning) and (Offset = CurPos) then
-    Result := CurPos
-  else
-    raise EStreamError.Create('Invalid stream operation');
-end;
-
-
-end.
-
-
-{
-  $Log$
-  Revision 1.4  1999-08-13 22:14:40  peter
-    * removed email separator at the bottom ;)
-
-  Revision 1.3  1999/08/13 16:31:41  michael
-  + Patch to support sizeless streams by Sebastian Guenter
-
-  Revision 1.2  1999/08/09 16:12:28  michael
-  * Fixes and new examples from Sebastian Guenther
-
-  Revision 1.1  1999/08/03 17:02:38  michael
-  * Base64 en/de cdeing streams added
-
-}

fcl/inc/bits.inc

@@ -1,371 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-{****************************************************************************}
-{*                               TBits                                      *}
-{****************************************************************************}
-
-{ ************* functions to match TBits class ************* }
-
-function TBits.getSize : longint;
-begin
-   result := (FSize shl BITSHIFT) - 1;
-end;
-
-procedure TBits.setSize(value : longint);
-begin
-   grow(value - 1);
-end;
-
-procedure TBits.SetBit(bit : longint; value : Boolean);
-begin
-   if value = True then
-      seton(bit)
-   else
-      clear(bit);
-end;
-
-function TBits.OpenBit : longint;
-var
-   loop : longint;
-   loop2 : longint;
-   startIndex : longint;
-begin
-   result := -1; {should only occur if the whole array is set}
-   for loop := 0 to FSize - 1 do
-   begin
-      if FBits^[loop] <> $FFFFFFFF then
-      begin
-         startIndex := loop * 32;
-         for loop2 := startIndex to startIndex + 31 do
-         begin
-            if get(loop2) = False then
-            begin
-               result := loop2;
-               break; { use this as the index to return }
-            end;
-         end;
-         break;  {stop looking for empty bit in records }
-      end;
-   end;
-
-   if result = -1 then
-      if FSize < MaxBitRec then
-          result := FSize * 32;  {first bit of next record}
-end;
-
-{ ******************** TBits ***************************** }
-
-constructor TBits.Create(theSize : longint);
-begin
-   FSize := 0;
-   FBits := nil;
-   findIndex := -1;
-   findState := True;  { no reason just setting it to something }
-   grow(theSize);
-end;
-
-destructor TBits.Destroy;
-begin
-   if FBits <> nil then
-      FreeMem(FBits, FSize * SizeOf(longint));
-   FBits := nil;
-
-   inherited Destroy;
-end;
-
-procedure TBits.grow(nbit : longint);
-var
-   newSize : longint;
-   loop : longint;
-begin
-
-   if nbit >= MaxBitFlags then
-      Raise EBitsError.Create('Bit index exceeds array limit');
-
-   newSize :=  (nbit shr BITSHIFT) + 1;
-
-   if newSize > FSize then
-   begin
-      ReAllocMem(FBits, newSize * SizeOf(longint));
-      if FBits <> nil then
-      begin
-         if newSize > FSize then
-            for loop := FSize to newSize - 1 do
-               FBits^[loop] := 0;
-
-         FSize := newSize;
-      end;
-   end;
-end;
-
-function TBits.getFSize : longint;
-begin
-   result := FSize;
-end;
-
-procedure TBits.seton(bit : longint);
-var
-   n : longint;
-begin
-   n := bit shr BITSHIFT;
-
-   grow(bit);
-
-   FBits^[n] := FBits^[n] or (longint(1) shl (bit and MASK));
-end;
-
-procedure TBits.clear(bit : longint);
-var
-   n : longint;
-begin
-   n := bit shr BITSHIFT;
-
-   grow(bit);
-
-   FBits^[n] := FBits^[n] and not(longint(1) shl (bit and MASK));
-end;
-
-procedure TBits.clearall;
-var
-   loop : longint;
-begin
-   for loop := 0 to FSize - 1 do
-      FBits^[loop] := 0;
-end;
-
-function TBits.get(bit : longint) : Boolean;
-var
-   n : longint;
-begin
-   result := False;
-
-   if bit >= MaxBitFlags then
-      Raise EBitsError.Create('Bit index exceeds array limit');
-
-   n := bit shr BITSHIFT;
-
-   if (n < FSize) then
-      result := (FBits^[n] and (longint(1) shl (bit and MASK))) <> 0;
-end;
-
-procedure TBits.andbits(bitset : TBits);
-var
-   n : longint;
-   loop : longint;
-begin
-   if FSize < bitset.getFSize then
-      n := FSize - 1
-   else
-      n := bitset.getFSize - 1;
-
-   for loop := 0 to n do
-      FBits^[loop] := FBits^[loop] and bitset.FBits^[loop];
-
-   for loop := n + 1 to FSize - 1 do
-      FBits^[loop] := 0;
-end;
-
-procedure TBits.notbits(bitset : TBits);
-var
-   n : longint;
-   jj : longint;
-   loop : longint;
-begin
-   if FSize < bitset.getFSize then
-      n := FSize - 1
-   else
-      n := bitset.getFSize - 1;
-
-   for loop := 0 to n do
-   begin
-      jj := FBits^[loop];
-      FBits^[loop] := FBits^[loop] and (jj xor bitset.FBits^[loop]);
-   end;
-end;
-
-procedure TBits.orbits(bitset : TBits);
-var
-   n : longint;
-   loop : longint;
-begin
-   if FSize < bitset.getFSize then
-      n := bitset.getFSize - 1
-   else
-      n := FSize - 1;
-
-   grow(n shl BITSHIFT);
-
-   for loop := 0 to n do
-      FBits^[loop] := FBits^[loop] or bitset.FBits^[loop];
-end;
-
-procedure TBits.xorbits(bitset : TBits);
-var
-   n : longint;
-   loop : longint;
-begin
-   if FSize < bitset.getFSize then
-      n := bitset.getFSize - 1
-   else
-      n := FSize - 1;
-
-   grow(n shl BITSHIFT);
-
-   for loop := 0 to n do
-      FBits^[loop] := FBits^[loop] xor bitset.FBits^[loop];
-end;
-
-function TBits.equals(bitset : TBits) : Boolean;
-var
-   n : longint;
-   loop : longint;
-begin
-   result := False;
-
-   if FSize < bitset.getFSize then
-      n := FSize - 1
-   else
-      n := bitset.getFSize - 1;
-
-   for loop := 0 to n do
-      if FBits^[loop] <> bitset.FBits^[loop] then exit;
-
-   if FSize - 1 > n then
-   begin
-      for loop := n to FSize - 1 do
-         if FBits^[loop] <> 0 then exit;
-   end
-   else if bitset.getFSize - 1 > n then
-      for loop := n to bitset.getFSize - 1 do
-         if bitset.FBits^[loop] <> 0 then exit;
-
-   result := True;  {passed all tests}
-end;
-
-
-{ us this in place of calling FindFirstBit. It sets the current }
-{ index used by FindNextBit and FindPrevBit                     }
-
-procedure TBits.SetIndex(index : longint);
-begin
-   findIndex := index;
-end;
-
-
-{ When state is set to True it looks for bits that are turned On (1) }
-{ and when it is set to False it looks for bits that are turned      }
-{ off (0).                                                           }
-
-function TBits.FindFirstBit(state : boolean) : longint;
-var
-   loop : longint;
-   loop2 : longint;
-   startIndex : longint;
-   compareVal : longint;
-begin
-   result := -1; {should only occur if none are set}
-
-   findState := state;
-
-   if state = False then
-      compareVal := $FFFFFFFF  { looking for off bits }
-   else
-      compareVal := $00000000; { looking for on bits }
-
-   for loop := 0 to FSize - 1 do
-   begin
-      if FBits^[loop] <> compareVal then
-      begin
-         startIndex := loop * 32;
-         for loop2 := startIndex to startIndex + 31 do
-         begin
-            if get(loop2) = state then
-            begin
-               result := loop2;
-               break; { use this as the index to return }
-            end;
-         end;
-         break;  {stop looking for bit in records }
-      end;
-   end;
-
-   findIndex := result;
-end;
-
-function TBits.FindNextBit : longint;
-var
-   loop : longint;
-   maxVal : longint;
-begin
-   result := -1;  { will occur only if no other bits set to }
-                  { current findState                        }
-
-   if findIndex > -1 then { must have called FindFirstBit first }
-   begin                  { or set the start index              }
-      maxVal := (FSize * 32) - 1;
-
-      for loop := findIndex + 1 to maxVal  do
-      begin
-         if get(loop) = findState then
-         begin
-            result := loop;
-            break;
-         end;
-      end;
-
-      findIndex := result;
-   end;
-end;
-
-function TBits.FindPrevBit : longint;
-var
-   loop : longint;
-begin
-   result := -1;  { will occur only if no other bits set to }
-                  { current findState                        }
-
-   if findIndex > -1 then { must have called FindFirstBit first }
-   begin                  { or set the start index              }
-      for loop := findIndex - 1 downto 0  do
-      begin
-         if get(loop) = findState then
-         begin
-            result := loop;
-            break;
-         end;
-      end;
-
-      findIndex := result;
-   end;
-end;
-
-
-{
-  $Log$
-  Revision 1.5  1999-11-01 13:56:58  peter
-    * adapted for new reallocmem
-
-  Revision 1.4  1999/04/09 12:13:31  michael
-  + Changed TBits to TbitsPlus from Michael A. Hess (renamed to Tbits)
-
-  Revision 1.3  1998/11/04 14:36:29  michael
-  Error handling always with exceptions
-
-  Revision 1.2  1998/11/04 10:46:42  peter
-    * exceptions work
-
-  Revision 1.1  1998/05/04 14:30:11  michael
-  * Split file according to Class; implemented dummys for all methods, so unit compiles.
-
-}

fcl/inc/classes.inc

@@ -1,772 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{**********************************************************************
- *       Class implementations are in separate files.                 *
- **********************************************************************}
-
-{
- Include all message strings
-
- Add a language with IFDEF LANG_NAME
- just befor the final ELSE. This way English will always be the default.
-}
-
-{$IFDEF LANG_GERMAN}
-{$i constsg.inc}
-{$ELSE}
-{$IFDEF LANG_SPANISH}
-{$i constss.inc}
-{$ELSE}
-{$i constse.inc}
-{$ENDIF}
-{$ENDIF}
-
-{ Utility routines }
-{$i util.inc}
-
-{ TBits implementation }
-{$i bits.inc}
-
-{ TReader implementation }
-{$i reader.inc}
-
-{ TWriter implementation }
-{$i writer.inc}
-
-{ TFiler implementation }
-{$i filer.inc}
-
-{ All streams implementations: }
-{ Tstreams THandleStream TFileStream TResourcseStreams TStringStream }
-{ TCustomMemoryStream TMemoryStream }
-{$i streams.inc}
-
-{ TParser implementation}
-{$i parser.inc}
-
-{ TCollection and TCollectionItem implementations }
-{$i collect.inc}
-
-{ TList and TThreadList implementations }
-{$i lists.inc}
-
-{ TStrings and TStringList implementations }
-{$i stringl.inc}
-
-{ TThread implementation }
-{$i thread.inc}
-
-{ TPersistent implementation }
-{$i persist.inc }
-
-{ TComponent implementation }
-{$i compon.inc}
-
-{ Class and component registration routines }
-{$I cregist.inc}
-
-
-{**********************************************************************
- *       Miscellaneous procedures and functions                       *
- **********************************************************************}
-
-{ Point and rectangle constructors }
-
-function Point(AX, AY: Integer): TPoint;
-
-begin
-  with Result do
-  begin
-    X := AX;
-    Y := AY;
-  end;
-end;
-
-
-function SmallPoint(AX, AY: SmallInt): TSmallPoint;
-
-begin
-  with Result do
-  begin
-    X := AX;
-    Y := AY;
-  end;
-end;
-
-
-function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
-
-begin
-  with Result do
-  begin
-    Left := ALeft;
-    Top := ATop;
-    Right := ARight;
-    Bottom := ABottom;
-  end;
-end;
-
-
-function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
-
-begin
-  with Result do
-  begin
-    Left := ALeft;
-    Top := ATop;
-    Right := ALeft + AWidth;
-    Bottom :=  ATop + AHeight;
-  end;
-end;
-
-
-
-
-
-{ Object filing routines }
-
-procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToInt: TIdentToInt;
-  IntToIdent: TIntToIdent);
-
-begin
-end;
-
-
-function IdentToInt(const Ident: string; var Int: Longint; const Map: array of TIdentMapEntry): Boolean;
-
-begin
-  IdentToInt:=false;
-end;
-
-
-function IntToIdent(Int: Longint; var Ident: string; const Map: array of TIdentMapEntry): Boolean;
-
-begin
-  IntToIdent:=false;
-end;
-
-
-function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
-
-begin
-  InitInheritedComponent:=false;
-end;
-
-
-function InitComponentRes(const ResName: string; Instance: TComponent): Boolean;
-
-begin
-  InitComponentRes:=false;
-end;
-
-
-function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
-
-begin
-  ReadComponentRes:=nil;
-end;
-
-
-function ReadComponentResEx(HInstance: THandle; const ResName: string): TComponent;
-
-begin
-  ReadComponentResEx:=nil;
-end;
-
-
-function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
-
-begin
-  ReadComponentResFile:=nil;
-end;
-
-
-procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
-
-begin
-end;
-
-
-
-procedure GlobalFixupReferences;
-
-begin
-end;
-
-
-procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
-
-begin
-end;
-
-
-procedure GetFixupInstanceNames(Root: TComponent;
-  const ReferenceRootName: string; Names: TStrings);
-
-begin
-end;
-
-
-procedure RedirectFixupReferences(Root: TComponent; const OldRootName,
-  NewRootName: string);
-
-begin
-end;
-
-
-procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
-
-begin
-end;
-
-
-procedure RemoveFixups(Instance: TPersistent);
-
-begin
-end;
-
-
-
-procedure BeginGlobalLoading;
-
-begin
-end;
-
-
-procedure NotifyGlobalLoading;
-
-begin
-end;
-
-
-procedure EndGlobalLoading;
-
-begin
-end;
-
-
-
-function CollectionsEqual(C1, C2: TCollection): Boolean;
-
-begin
-  CollectionsEqual:=false;
-end;
-
-
-
-{ Object conversion routines }
-
-procedure ObjectBinaryToText(Input, Output: TStream);
-
-  procedure OutStr(s: String);
-  begin
-    if Length(s) > 0 then
-      Output.Write(s[1], Length(s));
-  end;
-
-  procedure OutLn(s: String);
-  begin
-    OutStr(s + #10);
-  end;
-
-  procedure OutString(s: String);
-  var
-    res, NewStr: String;
-    i: Integer;
-    InString, NewInString: Boolean;
-  begin
-    res := '';
-    InString := False;
-    for i := 1 to Length(s) do begin
-      NewInString := InString;
-      case s[i] of
-        #0..#31: begin
-	    if InString then
-	      NewInString := False;
-	    NewStr := '#' + IntToStr(Ord(s[i]));
-	  end;
-        '''':
-	    if InString then NewStr := ''''''
-	    else NewStr := '''''''';
-	else begin
-	  if not InString then
-	    NewInString := True;
-	  NewStr := s[i];
-	end;
-      end;
-      if NewInString <> InString then begin
-        NewStr := '''' + NewStr;
-        InString := NewInString;
-      end;
-      res := res + NewStr;
-    end;
-    if InString then res := res + '''';
-    OutStr(res);
-  end;
-
-  function ReadInt(ValueType: TValueType): LongInt;
-  begin
-    case ValueType of
-      vaInt8: Result := ShortInt(Input.ReadByte);
-      vaInt16: Result := SmallInt(Input.ReadWord);
-      vaInt32: Result := LongInt(Input.ReadDWord);
-    end;
-  end;
-
-  function ReadInt: LongInt;
-  begin
-    Result := ReadInt(TValueType(Input.ReadByte));
-  end;
-
-  function ReadSStr: String;
-  var
-    len: Byte;
-  begin
-    len := Input.ReadByte;
-    SetLength(Result, len);
-    Input.Read(Result[1], len);
-  end;
-
-  procedure ReadPropList(indent: String);
-
-    procedure ProcessValue(ValueType: TValueType; Indent: String);
-
-      procedure Stop(s: String);
-      begin
-        WriteLn(s);
-        Halt;
-      end;
-
-      procedure ProcessBinary;
-      var
-        ToDo, DoNow, i: LongInt;
-        lbuf: array[0..31] of Byte;
-        s: String;
-      begin
-        ToDo := Input.ReadDWord;
-        OutLn('{');
-        while ToDo > 0 do begin
-          DoNow := ToDo;
-          if DoNow > 32 then DoNow := 32;
-  	  Dec(ToDo, DoNow);
- 	  s := Indent + '  ';
-	  Input.Read(lbuf, DoNow);
-	  for i := 0 to DoNow - 1 do
-	    s := s + IntToHex(lbuf[i], 2);
-          OutLn(s);
-        end;
-        OutLn(indent + '}');
-      end;
-
-    var
-      s: String;
-      len: LongInt;
-      IsFirst: Boolean;
-      ext: Extended;
-
-    begin
-      OutStr('(' + IntToStr(Ord(Valuetype)) + ') ');
-      case ValueType of
-        vaList: begin
-	    OutStr('(');
-	    IsFirst := True;
-	    while True do begin
-	      ValueType := TValueType(Input.ReadByte);
-	      if ValueType = vaNull then break;
-	      if IsFirst then begin
-	        OutLn('');
-	        IsFirst := False;
-	      end;
-	      OutStr(Indent + '  ');
-	      ProcessValue(ValueType, Indent + '  ');
-	    end;
-	    OutLn(Indent + ')');
-          end;
-        vaInt8: OutLn(IntToStr(ShortInt(Input.ReadByte)));
-        vaInt16: OutLn( IntToStr(SmallInt(Input.ReadWord)));
-        vaInt32: OutLn(IntToStr(LongInt(Input.ReadDWord)));
-        vaExtended: begin
-            Input.Read(ext, SizeOf(ext));
-            OutLn(FloatToStr(ext));
-          end;
-        vaString: begin
-            OutString(ReadSStr);
-            OutLn('');
-          end;
-        vaIdent: OutLn(ReadSStr);
-        vaFalse: OutLn('False');
-        vaTrue: OutLn('True');
-        vaBinary: ProcessBinary;
-        vaSet: begin
-            OutStr('[');
-  	    IsFirst := True;
-	    while True do begin
-	      s := ReadSStr;
-	      if Length(s) = 0 then break;
-	      if not IsFirst then OutStr(', ');
-	      IsFirst := False;
-	      OutStr(s);
-	    end;
-	    OutLn(']');
-          end;
-        vaLString: Stop('!!LString!!');
-        vaNil: Stop('nil');
-        vaCollection: begin
-            OutStr('<');
-            while Input.ReadByte <> 0 do begin
-	      OutLn(Indent);
-              Input.Seek(-1, soFromCurrent);
-	      OutStr(indent + '  item');
-	      ValueType := TValueType(Input.ReadByte);
-	      if ValueType <> vaList then
-	        OutStr('[' + IntToStr(ReadInt(ValueType)) + ']');
-	      OutLn('');
-	      ReadPropList(indent + '    ');
-	      OutStr(indent + '  end');
-            end;
-	    OutLn('>');
-	  end;
-        {vaSingle: begin OutLn('!!Single!!'); exit end;
-        vaCurrency: begin OutLn('!!Currency!!'); exit end;
-        vaDate: begin OutLn('!!Date!!'); exit end;
-        vaWString: begin OutLn('!!WString!!'); exit end;}
-        else
-          Stop(IntToStr(Ord(ValueType)));
-      end;
-    end;
-
-  begin
-    while Input.ReadByte <> 0 do begin
-      Input.Seek(-1, soFromCurrent);
-      OutStr(indent + ReadSStr + ' = ');
-      ProcessValue(TValueType(Input.ReadByte), Indent);
-    end;
-  end;
-
-  procedure ReadObject(indent: String);
-  var
-    b: Byte;
-    ObjClassName, ObjName: String;
-    ChildPos: LongInt;
-  begin
-    // Check for FilerFlags
-    b := Input.ReadByte;
-    if (b and $f0) = $f0 then begin
-      if (b and 2) <> 0 then ChildPos := ReadInt;
-    end else begin
-      b := 0;
-      Input.Seek(-1, soFromCurrent);
-    end;
-
-    ObjClassName := ReadSStr;
-    ObjName := ReadSStr;
-
-    OutStr(Indent);
-    if (b and 1) <> 0 then OutStr('inherited')
-    else OutStr('object');
-    OutStr(' ');
-    if ObjName <> '' then
-      OutStr(ObjName + ': ');
-    OutStr(ObjClassName);
-    if (b and 2) <> 0 then OutStr('[' + IntToStr(ChildPos) + ']');
-    OutLn('');
-
-    ReadPropList(indent + '  ');
-
-    while Input.ReadByte <> 0 do begin
-      Input.Seek(-1, soFromCurrent);
-      ReadObject(indent + '  ');
-    end;
-    OutLn(indent + 'end');
-  end;
-
-type
-  PLongWord = ^LongWord;
-const
-  signature: PChar = 'TPF0';
-begin
-  if Input.ReadDWord <> PLongWord(Pointer(signature))^ then
-    raise EReadError.Create('Illegal stream image' {###SInvalidImage});
-  ReadObject('');
-end;
-
-
-procedure ObjectTextToBinary(Input, Output: TStream);
-var
-  parser: TParser;
-
-  procedure WriteString(s: String);
-  begin
-    Output.WriteByte(Length(s));
-    Output.Write(s[1], Length(s));
-  end;
-
-  procedure WriteInteger(value: LongInt);
-  begin
-    if (value >= -128) and (value <= 127) then begin
-      Output.WriteByte(Ord(vaInt8));
-      Output.WriteByte(Byte(value));
-    end else if (value >= -32768) and (value <= 32767) then begin
-      Output.WriteByte(Ord(vaInt16));
-      Output.WriteWord(Word(value));
-    end else begin
-      Output.WriteByte(ord(vaInt32));
-      Output.WriteDWord(LongWord(value));
-    end;
-  end;
-
-  procedure ProcessProperty; forward;
-
-  procedure ProcessValue;
-  var
-    flt: Extended;
-    s: String;
-    stream: TMemoryStream;
-  begin
-    case parser.Token of
-      toInteger: WriteInteger(parser.TokenInt);
-      toFloat: begin
-          Output.WriteByte(Ord(vaExtended));
-	  flt := Parser.TokenFloat;
-          Output.Write(flt, SizeOf(flt));
-        end;
-      toString: begin
-          s := parser.TokenString;
-	  while parser.NextToken = '+' do begin
-	    parser.NextToken;	// Get next string fragment
-	    parser.CheckToken(toString);
-	    s := s + parser.TokenString;
-	  end;
-          Output.WriteByte(Ord(vaString));
-          WriteString(s);
-        end;
-      toSymbol:
-          if CompareText(parser.TokenString, 'True') = 0 then
-	    Output.WriteByte(Ord(vaTrue))
-	  else if CompareText(parser.TokenString, 'False') = 0 then
-	    Output.WriteByte(Ord(vaFalse))
-	  else if CompareText(parser.TokenString, 'nil') = 0 then
-	    Output.WriteByte(Ord(vaNil))
-	  else begin
-            Output.WriteByte(Ord(vaIdent));
-	    WriteString(parser.TokenString);
-          end;
-      // Set
-      '[': begin
-          parser.NextToken;
-	  Output.WriteByte(Ord(vaSet));
-	  if parser.Token <> ']' then
-	    while True do begin
-	      parser.CheckToken(toSymbol);
-	      WriteString(parser.TokenString);
-	      parser.NextToken;
-	      if parser.Token = ']' then break;
-	      parser.CheckToken(',');
-	      parser.NextToken;
-	    end;
-	  Output.WriteByte(0);
-        end;
-      // List
-      '(': begin
-          parser.NextToken;
-	  Output.WriteByte(Ord(vaList));
-	  while parser.Token <> ')' do ProcessValue;
-	  Output.WriteByte(0);
-        end;
-      // Collection
-      '<': begin
-          parser.NextToken;
-	  Output.WriteByte(Ord(vaCollection));
-          while parser.Token <> '>' do begin
-	    parser.CheckTokenSymbol('item');
-	    parser.NextToken;
-	    // ConvertOrder
-	    Output.WriteByte(Ord(vaList));
-	    while not parser.TokenSymbolIs('end') do ProcessProperty;
-	    parser.NextToken;	// Skip 'end'
-	    Output.WriteByte(0);
-	  end;
-	  Output.WriteByte(0);
-        end;
-      // Binary data
-      '{': begin
-          Output.WriteByte(Ord(vaBinary));
-	  stream := TMemoryStream.Create;
-	  try
-	    parser.HexToBinary(stream);
-	    Output.WriteDWord(stream.Size);
-	    Output.Write(Stream.Memory^, stream.Size);
-	  finally
-	    stream.Free;
-	  end;
-        end;
-    else WriteLn('Token: "', parser.Token, '" ', Ord(parser.Token));
-    end;
-    parser.NextToken;
-  end;
-
-  procedure ProcessProperty;
-  var
-    name: String;
-  begin
-    // Get name of property
-    parser.CheckToken(toSymbol);
-    name := parser.TokenString;
-    while True do begin
-      parser.NextToken;
-      if parser.Token <> '.' then break;
-      parser.NextToken;
-      parser.CheckToken(toSymbol);
-      name := name + '.' + parser.TokenString;
-    end;
-    // WriteLn(name);
-    WriteString(name);
-    parser.CheckToken('=');
-    parser.NextToken;
-    ProcessValue;
-  end;
-
-  procedure ProcessObject;
-  var
-    IsInherited: Boolean;
-    ObjectName, ObjectType: String;
-  begin
-    if parser.TokenSymbolIs('OBJECT') then
-      IsInherited := False
-    else begin
-      parser.CheckTokenSymbol('INHERITED');
-      IsInherited := True;
-    end;
-    parser.NextToken;
-    parser.CheckToken(toSymbol);
-    ObjectName := '';
-    ObjectType := parser.TokenString;
-    parser.NextToken;
-    if parser.Token = ':' then begin
-      parser.NextToken;
-      parser.CheckToken(toSymbol);
-      ObjectName := ObjectType;
-      ObjectType := parser.TokenString;
-      parser.NextToken;
-    end;
-    WriteString(ObjectType);
-    WriteString(ObjectName);
-
-    // Convert property list
-    while not (parser.TokenSymbolIs('END') or
-      parser.TokenSymbolIs('OBJECT') or
-      parser.TokenSymbolIs('INHERITED')) do
-      ProcessProperty;
-    Output.WriteByte(0);	// Terminate property list
-
-    // Convert child objects
-    while not parser.TokenSymbolIs('END') do ProcessObject;
-    parser.NextToken;		// Skip end token
-    Output.WriteByte(0);	// Terminate property list
-  end;
-
-const
-  signature: PChar = 'TPF0';
-begin
-  parser := TParser.Create(Input);
-  try
-    Output.Write(signature[0], 4);
-    ProcessObject;
-  finally
-    parser.Free;
-  end;
-end;
-
-
-procedure ObjectResourceToText(Input, Output: TStream);
-begin
-  Input.ReadResHeader;
-  ObjectBinaryToText(Input, Output);
-end;
-
-
-procedure ObjectTextToResource(Input, Output: TStream);
-var
-  StartPos, SizeStartPos, BinSize: LongInt;
-  parser: TParser;
-  name: String;
-begin
-  // Get form type name
-  StartPos := Input.Position;
-  parser := TParser.Create(Input);
-  try
-    if not parser.TokenSymbolIs('OBJECT') then parser.CheckTokenSymbol('INHERITED');
-    parser.NextToken;
-    parser.CheckToken(toSymbol);
-    parser.NextToken;
-    parser.CheckToken(':');
-    parser.NextToken;
-    parser.CheckToken(toSymbol);
-    name := parser.TokenString;
-  finally
-    parser.Free;
-    Input.Position := StartPos;
-  end;
-
-  // Write resource header
-  name := UpperCase(name);
-  Output.WriteByte($ff);
-  Output.WriteByte(10);
-  Output.WriteByte(0);
-  Output.Write(name[1], Length(name) + 1);	// Write null-terminated form type name
-  Output.WriteWord($1030);
-  SizeStartPos := Output.Position;
-  Output.WriteDWord(0);			// Placeholder for data size
-  ObjectTextToBinary(Input, Output);	// Convert the stuff!
-  BinSize := Output.Position - SizeStartPos - 4;
-  Output.Position := SizeStartPos;
-  Output.WriteDWord(BinSize);		// Insert real resource data size
-end;
-
-
-
-{ Utility routines }
-
-function LineStart(Buffer, BufPos: PChar): PChar;
-
-begin
-  Result := BufPos;
-  while Result > Buffer do begin
-    Dec(Result);
-    if Result[0] = #10 then break;
-  end;
-end;
-
-
-
-
-{
-  $Log$
-  Revision 1.13  1999-10-19 11:27:03  sg
-  * Added DFM<->ASCII conversion procedures
-
-  Revision 1.12  1999/09/30 19:31:42  fcl
-  * Implemented LineStart  (sg)
-
-  Revision 1.11  1999/09/11 21:59:31  fcl
-  * Moved class and registration functions to cregist.inc  (sg)
-
-  Revision 1.10  1999/04/13 08:52:29  michael
-  + Moved strings.inc to stringl.inc, to avoid conflict with strings unit
-
-  Revision 1.9  1999/04/08 10:18:50  peter
-    * makefile updates
-
-}

fcl/inc/classesh.inc

@@ -1,1141 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{ We NEED ansistrings !!}
-{$H+}
-
-type
-   { extra types to compile with FPC }
-
-   TRTLCriticalSection = class(TObject);
-   HRSRC = longint;
-   THANDLE = longint;
-   TComponentName = string;
-   IUnKnown = class(TObject);
-   TGUID = longint;
-   HMODULE = longint;
-
-   TPoint = record
-      x,y : integer;
-   end;
-
-   TSmallPoint = record
-      x,y : smallint;
-   end;
-
-   TRect = record
-      Left,Right,Top,Bottom : Integer;
-   end;
-
-const
-
-{ Maximum TList size }
-
-  MaxListSize = Maxint div 16;
-
-{ values for TShortCut }
-
-  scShift = $2000;
-  scCtrl = $4000;
-  scAlt = $8000;
-  scNone = 0;
-
-{ TStream seek origins }
-
-  soFromBeginning = 0;
-  soFromCurrent = 1;
-  soFromEnd = 2;
-
-{ TFileStream create mode }
-
-  fmCreate        = $FFFF;
-  fmOpenRead      = 0;
-  fmOpenWrite     = 1;
-  fmOpenReadWrite = 2;
-
-{ TParser special tokens }
-
-  toEOF     = Char(0);
-  toSymbol  = Char(1);
-  toString  = Char(2);
-  toInteger = Char(3);
-  toFloat   = Char(4);
-
-type
-
-{ Text alignment types }
-
-  TAlignment = (taLeftJustify, taRightJustify, taCenter);
-
-  { TLeftRight = taLeftJustify..taRightJustify; }
-
-{ Types used by standard events }
-
-  TShiftState = set of (ssShift, ssAlt, ssCtrl,
-    ssLeft, ssRight, ssMiddle, ssDouble,
-    // Extra additions
-    ssMeta, ssSuper, ssHyper, ssAltGr, ssCaps, ssNum, ssScroll);
-
-  { THelpContext = -MaxLongint..MaxLongint; }
-
-{ Standard events }
-
-
-  TNotifyEvent = procedure(Sender: TObject) of object;
-  THelpEvent = function (Command: Word; Data: Longint;
-    var CallHelp: Boolean): Boolean of object;
-  TGetStrProc = procedure(const S: string) of object;
-
-{ Exception classes }
-
-  EStreamError = class(Exception);
-  EFCreateError = class(EStreamError);
-  EFOpenError = class(EStreamError);
-  EFilerError = class(EStreamError);
-  EReadError = class(EFilerError);
-  EWriteError = class(EFilerError);
-  EClassNotFound = class(EFilerError);
-  EMethodNotFound = class(EFilerError);
-  EInvalidImage = class(EFilerError);
-  EResNotFound = class(Exception);
-  EListError = class(Exception);
-  EBitsError = class(Exception);
-  EStringListError = class(Exception);
-  EComponentError = class(Exception);
-  EParserError = class(Exception);
-  EOutOfResources = class(EOutOfMemory);
-  EInvalidOperation = class(Exception);
-
-{ Forward class declarations }
-
-  TStream = class;
-  TFiler = class;
-  TReader = class;
-  TWriter = class;
-  TComponent = class;
-
-{ TList class }
-
-  PPointerList = ^TPointerList;
-  TPointerList = array[0..MaxListSize - 1] of Pointer;
-  TListSortCompare = function (Item1, Item2: Pointer): Integer;
-
-  TList = class(TObject)
-  private
-    FList: PPointerList;
-    FCount: Integer;
-    FCapacity: Integer;
-  protected
-    function Get(Index: Integer): Pointer;
-    procedure Grow; virtual;
-    procedure Put(Index: Integer; Item: Pointer);
-    procedure SetCapacity(NewCapacity: Integer);
-    procedure SetCount(NewCount: Integer);
-  public
-    destructor Destroy; override;
-    function Add(Item: Pointer): Integer;
-    procedure Clear;
-    procedure Delete(Index: Integer);
-    class procedure Error(const Msg: string; Data: Integer); virtual;
-    procedure Exchange(Index1, Index2: Integer);
-    function Expand: TList;
-    function First: Pointer;
-    function IndexOf(Item: Pointer): Integer;
-    procedure Insert(Index: Integer; Item: Pointer);
-    function Last: Pointer;
-    procedure Move(CurIndex, NewIndex: Integer);
-    function Remove(Item: Pointer): Integer;
-    procedure Pack;
-    procedure Sort(Compare: TListSortCompare);
-    property Capacity: Integer read FCapacity write SetCapacity;
-    property Count: Integer read FCount write SetCount;
-    property Items[Index: Integer]: Pointer read Get write Put; default;
-    property List: PPointerList read FList;
-  end;
-
-{ TThreadList class }
-
-  TThreadList = class
-  private
-    FList: TList;
-    FLock: TRTLCriticalSection;
-  public
-    constructor Create;
-    destructor Destroy; { override; }
-    procedure Add(Item: Pointer);
-    procedure Clear;
-    function  LockList: TList;
-    procedure Remove(Item: Pointer);
-    procedure UnlockList;
-  end;
-
-const
-   BITSHIFT = 5;
-   MASK = 31; {for longs that are 32-bit in size}
-   MaxBitRec = $FFFF Div (SizeOf(longint));
-   MaxBitFlags = MaxBitRec * 32;
-
-type
-   TBitArray = array[0..MaxBitRec - 1] of longint;
-
-   TBits = class(TObject)
-   private
-      { Private declarations }
-      FBits : ^TBitArray;
-      FSize : longint;  { total longints currently allocated }
-      findIndex : longint;
-      findState : boolean;
-
-      { functions and properties to match TBits class }
-      procedure SetBit(bit : longint; value : Boolean);
-      function getSize : longint;
-      procedure setSize(value : longint);
-   public
-      { Public declarations }
-      constructor Create(theSize : longint); virtual;
-      destructor Destroy; override;
-      function  getFSize : longint;
-      procedure seton(bit : longint);
-      procedure clear(bit : longint);
-      procedure clearall;
-      procedure andbits(bitset : TBits);
-      procedure orbits(bitset : TBits);
-      procedure xorbits(bitset : TBits);
-      procedure notbits(bitset : TBits);
-      function  get(bit : longint) : boolean;
-      procedure grow(nbit : longint);
-      function  equals(bitset : TBits) : Boolean;
-      procedure SetIndex(index : longint);
-      function  FindFirstBit(state : boolean) : longint;
-      function  FindNextBit : longint;
-      function  FindPrevBit : longint;
-
-      { functions and properties to match TBits class }
-      function OpenBit: longint;
-      property Bits[bit: longint]: Boolean read get write SetBit; default;
-      property Size: longint read getSize write setSize;
-   end;
-
-{ TPersistent abstract class }
-
-{$M+}
-
-  TPersistent = class(TObject)
-  private
-    procedure AssignError(Source: TPersistent);
-  protected
-    procedure AssignTo(Dest: TPersistent); virtual;
-    procedure DefineProperties(Filer: TFiler); virtual;
-    function  GetOwner: TPersistent; dynamic;
-  public
-    destructor Destroy; override;
-    procedure Assign(Source: TPersistent); virtual;
-    function  GetNamePath: string; virtual; {dynamic;}
-  end;
-
-{$M-}
-
-{ TPersistent class reference type }
-
-  TPersistentClass = class of TPersistent;
-
-{ TCollection class }
-
-  TCollection = class;
-
-  TCollectionItem = class(TPersistent)
-  private
-    FCollection: TCollection;
-    FID: Integer;
-    function GetIndex: Integer;
-    procedure SetCollection(Value: TCollection);
-  protected
-    procedure Changed(AllItems: Boolean);
-    function GetNamePath: string; override;
-    function GetOwner: TPersistent; override;
-    function GetDisplayName: string; virtual;
-    procedure SetIndex(Value: Integer); virtual;
-    procedure SetDisplayName(const Value: string); virtual;
-  public
-    constructor Create(ACollection: TCollection); virtual;
-    destructor Destroy; override;
-    property Collection: TCollection read FCollection write SetCollection;
-    property ID: Integer read FID;
-    property Index: Integer read GetIndex write SetIndex;
-    property DisplayName: string read GetDisplayName write SetDisplayName;
-  end;
-
-  TCollectionItemClass = class of TCollectionItem;
-
-  TCollection = class(TPersistent)
-  private
-    FItemClass: TCollectionItemClass;
-    FItems: TList;
-    FUpdateCount: Integer;
-    FNextID: Integer;
-    FPropName: string;
-    function GetCount: Integer;
-    function GetPropName: string;
-    procedure InsertItem(Item: TCollectionItem);
-    procedure RemoveItem(Item: TCollectionItem);
-  protected
-    { Design-time editor support }
-    function GetAttrCount: Integer; dynamic;
-    function GetAttr(Index: Integer): string; dynamic;
-    function GetItemAttr(Index, ItemIndex: Integer): string; dynamic;
-    function GetNamePath: string; override;
-    procedure Changed;
-    function GetItem(Index: Integer): TCollectionItem;
-    procedure SetItem(Index: Integer; Value: TCollectionItem);
-    procedure SetItemName(Item: TCollectionItem); virtual;
-    procedure SetPropName; virtual;
-    procedure Update(Item: TCollectionItem); virtual;
-    property PropName: string read GetPropName write FPropName;
-  public
-    constructor Create(AItemClass: TCollectionItemClass);
-    destructor Destroy; override;
-    function Add: TCollectionItem;
-    procedure Assign(Source: TPersistent); override;
-    procedure BeginUpdate;
-    procedure Clear;
-    procedure EndUpdate;
-    function FindItemID(ID: Integer): TCollectionItem;
-    property Count: Integer read GetCount;
-    property ItemClass: TCollectionItemClass read FItemClass;
-    property Items[Index: Integer]: TCollectionItem read GetItem write SetItem;
-  end;
-
-  TStrings = class;
-
-{ IStringsAdapter interface }
-{ Maintains link between TStrings and IStrings implementations }
-
-  { !!!! Interfaces aren't supported by FPC
-  IStringsAdapter = interface
-    procedure ReferenceStrings(S: TStrings);
-    procedure ReleaseStrings;
-  end;
-  }
-  IStringsAdapter = class(TObject);
-
-{ TStrings class }
-
-  TStrings = class(TPersistent)
-  private
-    FUpdateCount: Integer;
-    FAdapter: IStringsAdapter;
-    function GetCommaText: string;
-    function GetName(Index: Integer): string;
-    function GetValue(const Name: string): string;
-    procedure ReadData(Reader: TReader);
-    procedure SetCommaText(const Value: string);
-    procedure SetStringsAdapter(const Value: IStringsAdapter);
-    procedure SetValue(const Name, Value: string);
-    procedure WriteData(Writer: TWriter);
-  protected
-    procedure DefineProperties(Filer: TFiler); override;
-    procedure Error(const Msg: string; Data: Integer);
-    function Get(Index: Integer): string; virtual; abstract;
-    function GetCapacity: Integer; virtual;
-    function GetCount: Integer; virtual; abstract;
-    function GetObject(Index: Integer): TObject; virtual;
-    function GetTextStr: string; virtual;
-    procedure Put(Index: Integer; const S: string); virtual;
-    procedure PutObject(Index: Integer; AObject: TObject); virtual;
-    procedure SetCapacity(NewCapacity: Integer); virtual;
-    procedure SetTextStr(const Value: string); virtual;
-    procedure SetUpdateState(Updating: Boolean); virtual;
-  public
-    destructor Destroy; override;
-    function Add(const S: string): Integer; virtual;
-    function AddObject(const S: string; AObject: TObject): Integer; virtual;
-    procedure Append(const S: string);
-    procedure AddStrings(TheStrings: TStrings); virtual;
-    procedure Assign(Source: TPersistent); override;
-    procedure BeginUpdate;
-    procedure Clear; virtual; abstract;
-    procedure Delete(Index: Integer); virtual; abstract;
-    procedure EndUpdate;
-    function Equals(TheStrings: TStrings): Boolean;
-    procedure Exchange(Index1, Index2: Integer); virtual;
-    function GetText: PChar; virtual;
-    function IndexOf(const S: string): Integer; virtual;
-    function IndexOfName(const Name: string): Integer;
-    function IndexOfObject(AObject: TObject): Integer;
-    procedure Insert(Index: Integer; const S: string); virtual; abstract;
-    procedure InsertObject(Index: Integer; const S: string;
-      AObject: TObject);
-    procedure LoadFromFile(const FileName: string); virtual;
-    procedure LoadFromStream(Stream: TStream); virtual;
-    procedure Move(CurIndex, NewIndex: Integer); virtual;
-    procedure SaveToFile(const FileName: string); virtual;
-    procedure SaveToStream(Stream: TStream); virtual;
-    procedure SetText(TheText: PChar); virtual;
-    property Capacity: Integer read GetCapacity write SetCapacity;
-    property CommaText: string read GetCommaText write SetCommaText;
-    property Count: Integer read GetCount;
-    property Names[Index: Integer]: string read GetName;
-    property Objects[Index: Integer]: TObject read GetObject write PutObject;
-    property Values[const Name: string]: string read GetValue write SetValue;
-    property Strings[Index: Integer]: string read Get write Put; default;
-    property Text: string read GetTextStr write SetTextStr;
-    property StringsAdapter: IStringsAdapter read FAdapter write SetStringsAdapter;
-  end;
-
-{ TStringList class }
-
-  TDuplicates = (dupIgnore, dupAccept, dupError);
-
-  PStringItem = ^TStringItem;
-  TStringItem = record
-    FString: string;
-    FObject: TObject;
-  end;
-
-  PStringItemList = ^TStringItemList;
-  TStringItemList = array[0..MaxListSize] of TStringItem;
-
-  TStringList = class(TStrings)
-  private
-    FList: PStringItemList;
-    FCount: Integer;
-    FCapacity: Integer;
-    FSorted: Boolean;
-    FDuplicates: TDuplicates;
-    FOnChange: TNotifyEvent;
-    FOnChanging: TNotifyEvent;
-    procedure ExchangeItems(Index1, Index2: Integer);
-    procedure Grow;
-    procedure QuickSort(L, R: Integer);
-    procedure InsertItem(Index: Integer; const S: string);
-    procedure SetSorted(Value: Boolean);
-  protected
-    procedure Changed; virtual;
-    procedure Changing; virtual;
-    function Get(Index: Integer): string; override;
-    function GetCapacity: Integer; override;
-    function GetCount: Integer; override;
-    function GetObject(Index: Integer): TObject; override;
-    procedure Put(Index: Integer; const S: string); override;
-    procedure PutObject(Index: Integer; AObject: TObject); override;
-    procedure SetCapacity(NewCapacity: Integer); override;
-    procedure SetUpdateState(Updating: Boolean); override;
-  public
-    destructor Destroy; override;
-    function Add(const S: string): Integer; override;
-    procedure Clear; override;
-    procedure Delete(Index: Integer); override;
-    procedure Exchange(Index1, Index2: Integer); override;
-    function Find(const S: string; var Index: Integer): Boolean; virtual;
-    function IndexOf(const S: string): Integer; override;
-    procedure Insert(Index: Integer; const S: string); override;
-    procedure Sort; virtual;
-    property Duplicates: TDuplicates read FDuplicates write FDuplicates;
-    property Sorted: Boolean read FSorted write SetSorted;
-    property OnChange: TNotifyEvent read FOnChange write FOnChange;
-    property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
-  end;
-
-{ TStream abstract class }
-
-  TStream = class(TObject)
-  private
-    function GetPosition: Longint;
-    procedure SetPosition(Pos: Longint);
-    function GetSize: Longint;
-  protected
-    procedure SetSize(NewSize: Longint); virtual;
-  public
-    function Read(var Buffer; Count: Longint): Longint; virtual; abstract;
-    function Write(const Buffer; Count: Longint): Longint; virtual; abstract;
-    function Seek(Offset: Longint; Origin: Word): Longint; virtual; abstract;
-    procedure ReadBuffer(var Buffer; Count: Longint);
-    procedure WriteBuffer(const Buffer; Count: Longint);
-    function CopyFrom(Source: TStream; Count: Longint): Longint;
-    function ReadComponent(Instance: TComponent): TComponent;
-    function ReadComponentRes(Instance: TComponent): TComponent;
-    procedure WriteComponent(Instance: TComponent);
-    procedure WriteComponentRes(const ResName: string; Instance: TComponent);
-    procedure WriteDescendent(Instance, Ancestor: TComponent);
-    procedure WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
-    procedure ReadResHeader;
-    function ReadByte : Byte;
-    function ReadWord : Word;
-    function ReadDWord : Cardinal;
-    function ReadAnsiString : String;
-    procedure WriteByte(b : Byte);
-    procedure WriteWord(w : Word);
-    procedure WriteDWord(d : Cardinal);
-    Procedure WriteAnsiString (S : String);
-    property Position: Longint read GetPosition write SetPosition;
-    property Size: Longint read GetSize write SetSize;
-  end;
-
-{ THandleStream class }
-
-  THandleStream = class(TStream)
-  private
-    FHandle: Integer;
-  public
-    constructor Create(AHandle: Integer);
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    property Handle: Integer read FHandle;
-  end;
-
-{ TFileStream class }
-
-  TFileStream = class(THandleStream)
-  Private
-    FFileName : String;
-  protected
-    procedure SetSize(NewSize: Longint); override;
-  public
-    constructor Create(const AFileName: string; Mode: Word);
-    destructor Destroy; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    property FileName : String Read FFilename;
-  end;
-
-{ TCustomMemoryStream abstract class }
-
-  TCustomMemoryStream = class(TStream)
-  private
-    FMemory: Pointer;
-    FSize, FPosition: Longint;
-  protected
-    procedure SetPointer(Ptr: Pointer; ASize: Longint);
-  public
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    procedure SaveToStream(Stream: TStream);
-    procedure SaveToFile(const FileName: string);
-    property Memory: Pointer read FMemory;
-  end;
-
-{ TMemoryStream }
-
-  TMemoryStream = class(TCustomMemoryStream)
-  private
-    FCapacity: Longint;
-    procedure SetCapacity(NewCapacity: Longint);
-  protected
-    function Realloc(var NewCapacity: Longint): Pointer; virtual;
-    property Capacity: Longint read FCapacity write SetCapacity;
-  public
-    destructor Destroy; override;
-    procedure Clear;
-    procedure LoadFromStream(Stream: TStream);
-    procedure LoadFromFile(const FileName: string);
-    procedure SetSize(NewSize: Longint); override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-  end;
-
-{ TStringStream }
-
-  TStringStream = class(TStream)
-  private
-    FDataString: string;
-    FPosition: Integer;
-  protected
-    procedure SetSize(NewSize: Longint); override;
-  public
-    constructor Create(const AString: string);
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function ReadString(Count: Longint): string;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    procedure WriteString(const AString: string);
-    property DataString: string read FDataString;
-  end;
-
-{ TResourceStream }
-
-  TResourceStream = class(TCustomMemoryStream)
-  private
-    HResInfo: HRSRC;
-    HGlobal: THandle;
-    procedure Initialize(Instance: THandle; Name, ResType: PChar);
-  public
-    constructor Create(Instance: THandle; const ResName: string; ResType: PChar);
-    constructor CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
-    destructor Destroy; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-  end;
-
-{ TStreamAdapter }
-{ Implements OLE IStream on VCL TStream }
-{ we don't need that yet
-  TStreamAdapter = class(TInterfacedObject, IStream)
-  private
-    FStream: TStream;
-  public
-    constructor Create(Stream: TStream);
-    function Read(pv: Pointer; cb: Longint;
-      pcbRead: PLongint): HResult; stdcall;
-    function Write(pv: Pointer; cb: Longint;
-      pcbWritten: PLongint): HResult; stdcall;
-    function Seek(dlibMove: Largeint; dwOrigin: Longint;
-      out libNewPosition: Largeint): HResult; stdcall;
-    function SetSize(libNewSize: Largeint): HResult; stdcall;
-    function CopyTo(stm: IStream; cb: Largeint; out cbRead: Largeint;
-      out cbWritten: Largeint): HResult; stdcall;
-    function Commit(grfCommitFlags: Longint): HResult; stdcall;
-    function Revert: HResult; stdcall;
-    function LockRegion(libOffset: Largeint; cb: Largeint;
-      dwLockType: Longint): HResult; stdcall;
-    function UnlockRegion(libOffset: Largeint; cb: Largeint;
-      dwLockType: Longint): HResult; stdcall;
-    function Stat(out statstg: TStatStg;
-      grfStatFlag: Longint): HResult; stdcall;
-    function Clone(out stm: IStream): HResult; stdcall;
-  end;
-}
-{ TFiler }
-
-  TValueType = (vaNull, vaList, vaInt8, vaInt16, vaInt32, vaExtended,
-    vaString, vaIdent, vaFalse, vaTrue, vaBinary, vaSet, vaLString,
-    vaNil, vaCollection);
-
-  TFilerFlag = (ffInherited, ffChildPos);
-  TFilerFlags = set of TFilerFlag;
-
-  TReaderProc = procedure(Reader: TReader) of object;
-  TWriterProc = procedure(Writer: TWriter) of object;
-  TStreamProc = procedure(Stream: TStream) of object;
-
-  TFiler = class(TObject)
-  private
-    FStream: TStream;
-    FBuffer: Pointer;
-    FBufSize: Integer;
-    FBufPos: Integer;
-    FBufEnd: Integer;
-    FRoot: TComponent;
-    FAncestor: TPersistent;
-    FIgnoreChildren: Boolean;
-  public
-    constructor Create(Stream: TStream; BufSize: Integer);
-    destructor Destroy; override;
-    procedure DefineProperty(const Name: string;
-      ReadData: TReaderProc; WriteData: TWriterProc;
-      HasData: Boolean); virtual; abstract;
-    procedure DefineBinaryProperty(const Name: string;
-      ReadData, WriteData: TStreamProc;
-      HasData: Boolean); virtual; abstract;
-    procedure FlushBuffer; virtual; abstract;
-    property Root: TComponent read FRoot write FRoot;
-    property Ancestor: TPersistent read FAncestor write FAncestor;
-    property IgnoreChildren: Boolean read FIgnoreChildren write FIgnoreChildren;
-  end;
-
-{ TReader }
-
-  TFindMethodEvent = procedure(Reader: TReader; const MethodName: string;
-    var Address: Pointer; var Error: Boolean) of object;
-  TSetNameEvent = procedure(Reader: TReader; Component: TComponent;
-    var Name: string) of object;
-  TReferenceNameEvent = procedure(Reader: TReader; var Name: string) of object;
-  TAncestorNotFoundEvent = procedure(Reader: TReader; const ComponentName: string;
-    ComponentClass: TPersistentClass; var Component: TComponent) of object;
-  TReadComponentsProc = procedure(Component: TComponent) of object;
-  TReaderError = procedure(Reader: TReader; const Message: string; var Handled: Boolean) of object;
-
-  TReader = class(TFiler)
-  private
-    FOwner: TComponent;
-    FParent: TComponent;
-    FFixups: TList;
-    FLoaded: TList;
-    FOnFindMethod: TFindMethodEvent;
-    FOnSetName: TSetNameEvent;
-    FOnReferenceName: TReferenceNameEvent;
-    FOnAncestorNotFound: TAncestorNotFoundEvent;
-    FOnError: TReaderError;
-    FCanHandleExcepts: Boolean;
-    FPropName: string;
-    procedure CheckValue(Value: TValueType);
-    procedure DoFixupReferences;
-    procedure FreeFixups;
-    function GetPosition: Longint;
-    procedure PropertyError;
-    procedure ReadBuffer;
-    procedure ReadData(Instance: TComponent);
-    procedure ReadDataInner(Instance: TComponent);
-    procedure ReadProperty(AInstance: TPersistent);
-    procedure ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
-    function ReadSet(SetType: Pointer): Integer;
-    procedure SetPosition(Value: Longint);
-    procedure SkipSetBody;
-    procedure SkipValue;
-    procedure SkipProperty;
-    procedure SkipComponent(SkipHeader: Boolean);
-  protected
-    function Error(const Message: string): Boolean; virtual;
-    function FindMethod(ARoot: TComponent; const AMethodName: string): Pointer; virtual;
-    procedure SetName(Component: TComponent; var Name: string); virtual;
-    procedure ReferenceName(var Name: string); virtual;
-    function FindAncestorComponent(const Name: string;
-      ComponentClass: TPersistentClass): TComponent; virtual;
-  public
-    destructor Destroy; override;
-    procedure BeginReferences;
-    procedure DefineProperty(const Name: string;
-      rd : TReaderProc; wd : TWriterProc;
-      HasData: Boolean); override;
-    procedure DefineBinaryProperty(const Name: string;
-      rd, wd: TStreamProc;
-      HasData: Boolean); override;
-    function EndOfList: Boolean;
-    procedure EndReferences;
-    procedure FixupReferences;
-    procedure FlushBuffer; override;
-    function NextValue: TValueType;
-    procedure Read(var Buf; Count: Longint);
-    function ReadBoolean: Boolean;
-    function ReadChar: Char;
-    procedure ReadCollection(Collection: TCollection);
-    function ReadComponent(Component: TComponent): TComponent;
-    procedure ReadComponents(AOwner, AParent: TComponent;
-      Proc: TReadComponentsProc);
-    function ReadFloat: Extended;
-    function ReadIdent: string;
-    function ReadInteger: Longint;
-    procedure ReadListBegin;
-    procedure ReadListEnd;
-    procedure ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer);
-    function ReadRootComponent(ARoot: TComponent): TComponent;
-    procedure ReadSignature;
-    function ReadStr: string;
-    function ReadString: string;
-    function ReadValue: TValueType;
-    procedure CopyValue(Writer: TWriter); {!!!}
-    property Owner: TComponent read FOwner write FOwner;
-    property Parent: TComponent read FParent write FParent;
-    property Position: Longint read GetPosition write SetPosition;
-    property OnError: TReaderError read FOnError write FOnError;
-    property OnFindMethod: TFindMethodEvent read FOnFindMethod write FOnFindMethod;
-    property OnSetName: TSetNameEvent read FOnSetName write FOnSetName;
-    property OnReferenceName: TReferenceNameEvent read FOnReferenceName write FOnReferenceName;
-    property OnAncestorNotFound: TAncestorNotFoundEvent read FOnAncestorNotFound write FOnAncestorNotFound;
-  end;
-
-{ TWriter }
-
-  TWriter = class(TFiler)
-  private
-    FRootAncestor: TComponent;
-    FPropPath: string;
-    FAncestorList: TList;
-    FAncestorPos: Integer;
-    FChildPos: Integer;
-    procedure AddAncestor(Component: TComponent);
-    function GetPosition: Longint;
-    procedure SetPosition(Value: Longint);
-    procedure WriteBuffer;
-    procedure WriteData(Instance: TComponent); // linker optimization
-    procedure WriteProperty(Instance: TPersistent; PropInfo: Pointer);
-    procedure WriteProperties(Instance: TPersistent);
-    procedure WritePropName(const PropName: string);
-  protected
-    procedure WriteBinary(wd : TStreamProc);
-    procedure WritePrefix(Flags: TFilerFlags; AChildPos: Integer);
-    procedure WriteValue(Value: TValueType);
-  public
-    destructor Destroy; override;
-    procedure DefineProperty(const Name: string;
-      rd : TReaderProc; wd : TWriterProc;
-      HasData: Boolean); override;
-    procedure DefineBinaryProperty(const Name: string;
-      rd, wd: TStreamProc;
-      HasData: Boolean); override;
-    procedure FlushBuffer; override;
-    procedure Write(const Buf; Count: Longint);
-    procedure WriteBoolean(Value: Boolean);
-    procedure WriteCollection(Value: TCollection);
-    procedure WriteComponent(Component: TComponent);
-    procedure WriteChar(Value: Char);
-    procedure WriteDescendent(ARoot: TComponent; AAncestor: TComponent);
-    procedure WriteFloat(Value: Extended);
-    procedure WriteIdent(const Ident: string);
-    procedure WriteInteger(Value: Longint);
-    procedure WriteListBegin;
-    procedure WriteListEnd;
-    procedure WriteRootComponent(ARoot: TComponent);
-    procedure WriteSignature;
-    procedure WriteStr(const Value: string);
-    procedure WriteString(const Value: string);
-    property Position: Longint read GetPosition write SetPosition;
-    property RootAncestor: TComponent read FRootAncestor write FRootAncestor;
-  end;
-
-{ TParser }
-
-  TParser = class(TObject)
-  private
-    FStream: TStream;
-    FOrigin: Longint;
-    FBuffer: PChar;
-    FBufPtr: PChar;
-    FBufEnd: PChar;
-    FSourcePtr: PChar;
-    FSourceEnd: PChar;
-    FTokenPtr: PChar;
-    FStringPtr: PChar;
-    FSourceLine: Integer;
-    FSaveChar: Char;
-    FToken: Char;
-    procedure ReadBuffer;
-    procedure SkipBlanks;
-  public
-    constructor Create(Stream: TStream);
-    destructor Destroy; override;
-    procedure CheckToken(T: Char);
-    procedure CheckTokenSymbol(const S: string);
-    procedure Error(const Ident: string);
-    procedure ErrorFmt(const Ident: string; const Args: array of const);
-    procedure ErrorStr(const Message: string);
-    procedure HexToBinary(Stream: TStream);
-    function NextToken: Char;
-    function SourcePos: Longint;
-    function TokenComponentIdent: String;
-    function TokenFloat: Extended;
-    function TokenInt: Longint;
-    function TokenString: string;
-    function TokenSymbolIs(const S: string): Boolean;
-    property SourceLine: Integer read FSourceLine;
-    property Token: Char read FToken;
-  end;
-
-{ TThread }
-
-  EThread = class(Exception);
-
-  TThreadMethod = procedure of object;
-  TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest,
-    tpTimeCritical);
-
-  TThread = class
-  private
-    FHandle: THandle;
-    FThreadID: THandle;
-    FTerminated: Boolean;
-    FSuspended: Boolean;
-    FFreeOnTerminate: Boolean;
-    FFinished: Boolean;
-    FReturnValue: Integer;
-    FOnTerminate: TNotifyEvent;
-    FMethod: TThreadMethod;
-    FSynchronizeException: TObject;
-    procedure CallOnTerminate;
-    function GetPriority: TThreadPriority;
-    procedure SetPriority(Value: TThreadPriority);
-    procedure SetSuspended(Value: Boolean);
-  protected
-    procedure DoTerminate; virtual;
-    procedure Execute; virtual; abstract;
-    procedure Synchronize(Method: TThreadMethod);
-    property ReturnValue: Integer read FReturnValue write FReturnValue;
-    property Terminated: Boolean read FTerminated;
-  public
-{$ifdef linux}
-    { Needed for linux }
-    FStackPointer : integer;
-    FStackSize    : integer;
-    FCallExitProcess : boolean;
-{$endif}
-    constructor Create(CreateSuspended: Boolean);
-    destructor Destroy; { override; }
-    procedure Resume;
-    procedure Suspend;
-    procedure Terminate;
-    function WaitFor: Integer;
-    property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate;
-    property Handle: THandle read FHandle;
-    property Priority: TThreadPriority read GetPriority write SetPriority;
-    property Suspended: Boolean read FSuspended write SetSuspended;
-    property ThreadID: THandle read FThreadID;
-    property OnTerminate: TNotifyEvent read FOnTerminate write FOnTerminate;
-  end;
-
-{ TComponent class }
-
-  TOperation = (opInsert, opRemove);
-  TComponentState = set of (csLoading, csReading, csWriting, csDestroying,
-    csDesigning, csAncestor, csUpdating, csFixups);
-  TComponentStyle = set of (csInheritable, csCheckPropAvail);
-  TGetChildProc = procedure (Child: TComponent) of object;
-
-  {
-  TComponentName = type string;
-
-  IVCLComObject = interface
-    function GetTypeInfoCount(out Count: Integer): Integer; stdcall;
-    function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;
-    function GetIDsOfNames(const IID: TGUID; Names: Pointer;
-      NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;
-    function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
-      Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
-    function SafeCallException(ExceptObject: TObject;
-      ExceptAddr: Pointer): Integer;
-    procedure FreeOnRelease;
-  end;
-  }
-
-  TComponent = class(TPersistent)
-  private
-    FOwner: TComponent;
-    FName: TComponentName;
-    FTag: Longint;
-    FComponents: TList;
-    FFreeNotifies: TList;
-    FDesignInfo: Longint;
-    FVCLComObject: Pointer;
-    FComponentState: TComponentState;
-    // function GetComObject: IUnknown;
-    function GetComponent(AIndex: Integer): TComponent;
-    function GetComponentCount: Integer;
-    function GetComponentIndex: Integer;
-    procedure Insert(AComponent: TComponent);
-    procedure ReadLeft(Reader: TReader);
-    procedure ReadTop(Reader: TReader);
-    procedure Remove(AComponent: TComponent);
-    procedure SetComponentIndex(Value: Integer);
-    procedure SetReference(Enable: Boolean);
-    procedure WriteLeft(Writer: TWriter);
-    procedure WriteTop(Writer: TWriter);
-  protected
-    FComponentStyle: TComponentStyle;
-    procedure ChangeName(const NewName: TComponentName);
-    procedure DefineProperties(Filer: TFiler); override;
-    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); dynamic;
-    function GetChildOwner: TComponent; dynamic;
-    function GetChildParent: TComponent; dynamic;
-    function GetNamePath: string; override;
-    function GetOwner: TPersistent; override;
-    procedure Loaded; virtual;
-    procedure Notification(AComponent: TComponent;
-      Operation: TOperation); virtual;
-    procedure ReadState(Reader: TReader); virtual;
-    procedure SetAncestor(Value: Boolean);
-    procedure SetDesigning(Value: Boolean);
-    procedure SetName(const NewName: TComponentName); virtual;
-    procedure SetChildOrder(Child: TComponent; Order: Integer); dynamic;
-    procedure SetParentComponent(Value: TComponent); dynamic;
-    procedure Updating; dynamic;
-    procedure Updated; dynamic;
-    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); dynamic;
-    procedure ValidateRename(AComponent: TComponent;
-      const CurName, NewName: string); virtual;
-    procedure ValidateContainer(AComponent: TComponent); dynamic;
-    procedure ValidateInsert(AComponent: TComponent); dynamic;
-    procedure WriteState(Writer: TWriter); virtual;
-    { IUnknown }
-    //!!!!! function QueryInterface(const IID: TGUID; out Obj): Integer; stdcall;
-    //!!!! function _AddRef: Integer; stdcall;
-    //!!!! function _Release: Integer; stdcall;
-    { IDispatch }
-    //!!!! function GetTypeInfoCount(out Count: Integer): Integer; stdcall;
-    //!!!! function GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): Integer; stdcall;
-    //!!!! function GetIDsOfNames(const IID: TGUID; Names: Pointer;
-    //!!!!   NameCount, LocaleID: Integer; DispIDs: Pointer): Integer; stdcall;
-    //!!!! function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
-    //!!!!   Flags: Word; var Params; VarResult, ExcepInfo, ArgErr: Pointer): Integer; stdcall;
-  public
-    constructor Create(AOwner: TComponent); virtual;
-    destructor Destroy; override;
-    procedure DestroyComponents;
-    procedure Destroying;
-    function FindComponent(const AName: string): TComponent;
-    procedure FreeNotification(AComponent: TComponent);
-    procedure FreeOnRelease;
-    function GetParentComponent: TComponent; dynamic;
-    function HasParent: Boolean; dynamic;
-    procedure InsertComponent(AComponent: TComponent);
-    procedure RemoveComponent(AComponent: TComponent);
-    function SafeCallException(ExceptObject: TObject;
-      ExceptAddr: Pointer): Integer; override;
-    // property ComObject: IUnknown read GetComObject;
-    property Components[Index: Integer]: TComponent read GetComponent;
-    property ComponentCount: Integer read GetComponentCount;
-    property ComponentIndex: Integer read GetComponentIndex write SetComponentIndex;
-    property ComponentState: TComponentState read FComponentState;
-    property ComponentStyle: TComponentStyle read FComponentStyle;
-    property DesignInfo: Longint read FDesignInfo write FDesignInfo;
-    property Owner: TComponent read FOwner;
-    property VCLComObject: Pointer read FVCLComObject write FVCLComObject;
-//!!  published
-    property Name: TComponentName read FName write SetName ; // stored False;
-    property Tag: Longint read FTag write FTag ; // default 0;
-  end;
-
-{ TComponent class reference type }
-
-  TComponentClass = class of TComponent;
-
-{ Component registration handlers }
-
-  TActiveXRegType = (axrComponentOnly, axrIncludeDescendants);
-
-var
-  RegisterComponentsProc: procedure(const Page: string;
-    ComponentClasses: array of TComponentClass);
-  RegisterNoIconProc: procedure(ComponentClasses: array of TComponentClass);
-{!!!!  RegisterNonActiveXProc: procedure(ComponentClasses: array of TComponentClass;
-    AxRegType: TActiveXRegType) = nil;
-  CurrentGroup: Integer = -1;
-  CreateVCLComObjectProc: procedure(Component: TComponent) = nil;}
-
-{ Point and rectangle constructors }
-
-function Point(AX, AY: Integer): TPoint;
-function SmallPoint(AX, AY: SmallInt): TSmallPoint;
-function Rect(ALeft, ATop, ARight, ABottom: Integer): TRect;
-function Bounds(ALeft, ATop, AWidth, AHeight: Integer): TRect;
-
-{ Class registration routines }
-
-procedure RegisterClass(AClass: TPersistentClass);
-procedure RegisterClasses(AClasses: array of TPersistentClass);
-procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
-procedure UnRegisterClass(AClass: TPersistentClass);
-procedure UnRegisterClasses(AClasses: array of TPersistentClass);
-procedure UnRegisterModuleClasses(Module: HMODULE);
-function FindClass(const ClassName: string): TPersistentClass;
-function GetClass(const ClassName: string): TPersistentClass;
-
-{ Component registration routines }
-
-procedure RegisterComponents(const Page: string;
-  ComponentClasses: array of TComponentClass);
-procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
-procedure RegisterNonActiveX(ComponentClasses: array of TComponentClass;
-  AxRegType: TActiveXRegType);
-
-
-{ Object filing routines }
-
-type
-  TIdentMapEntry = record
-    Value: Integer;
-    Name: String;
-  end;
-
-  TIdentToInt = function(const Ident: string; var Int: Longint): Boolean;
-  TIntToIdent = function(Int: Longint; var Ident: string): Boolean;
-  TFindGlobalComponent = function(const Name: string): TComponent;
-
-var
-  MainThreadID: THandle;
-  FindGlobalComponent: TFindGlobalComponent;
-
-procedure RegisterIntegerConsts(IntegerType: Pointer; IdentToInt: TIdentToInt;
-  IntToIdent: TIntToIdent);
-function IdentToInt(const Ident: string; var Int: Longint; const Map: array of TIdentMapEntry): Boolean;
-function IntToIdent(Int: Longint; var Ident: string; const Map: array of TIdentMapEntry): Boolean;
-
-function InitInheritedComponent(Instance: TComponent; RootAncestor: TClass): Boolean;
-function InitComponentRes(const ResName: string; Instance: TComponent): Boolean;
-function ReadComponentRes(const ResName: string; Instance: TComponent): TComponent;
-function ReadComponentResEx(HInstance: THandle; const ResName: string): TComponent;
-function ReadComponentResFile(const FileName: string; Instance: TComponent): TComponent;
-procedure WriteComponentResFile(const FileName: string; Instance: TComponent);
-
-procedure GlobalFixupReferences;
-procedure GetFixupReferenceNames(Root: TComponent; Names: TStrings);
-procedure GetFixupInstanceNames(Root: TComponent;
-  const ReferenceRootName: string; Names: TStrings);
-procedure RedirectFixupReferences(Root: TComponent; const OldRootName,
-  NewRootName: string);
-procedure RemoveFixupReferences(Root: TComponent; const RootName: string);
-procedure RemoveFixups(Instance: TPersistent);
-
-procedure BeginGlobalLoading;
-procedure NotifyGlobalLoading;
-procedure EndGlobalLoading;
-
-function CollectionsEqual(C1, C2: TCollection): Boolean;
-
-{ Object conversion routines }
-
-procedure ObjectBinaryToText(Input, Output: TStream);
-procedure ObjectTextToBinary(Input, Output: TStream);
-
-procedure ObjectResourceToText(Input, Output: TStream);
-procedure ObjectTextToResource(Input, Output: TStream);
-
-{ Utility routines }
-
-function LineStart(Buffer, BufPos: PChar): PChar;
-
-{
-  $Log$
-  Revision 1.18  1999-11-30 15:28:38  michael
-  + Added FileNAme property for filestreams
-
-  Revision 1.17  1999/10/20 20:24:21  florian
-    + sc* constants added as suggested by Shane Miller
-
-  Revision 1.16  1999/09/13 08:35:16  fcl
-  * Changed some argument names (Root->ARoot etc.) because the new compiler
-    now performs more ambiguity checks  (sg)
-
-  Revision 1.15  1999/09/11 22:01:03  fcl
-  * Activated component registration callbacks  (sg)
-
-  Revision 1.14  1999/08/26 21:11:25  peter
-    * ShiftState extended
-
-  Revision 1.13  1999/05/31 12:43:10  peter
-    * fixed tthread for linux additions
-
-  Revision 1.12  1999/05/14 17:52:53  peter
-    * removed wrong destroy overrides (gave errors with the new compiler)
-
-  Revision 1.11  1999/04/09 12:13:30  michael
-  + Changed TBits to TbitsPlus from Michael A. Hess (renamed to Tbits)
-
-  Revision 1.10  1998/10/30 14:52:49  michael
-  + Added format in interface
-  + Some errors in parser fixed, it uses exceptions now
-  + Strings now has no more syntax errors.
-
-  Revision 1.9  1998/10/24 13:45:35  michael
-  + Implemented stringlist. Untested, since classes broken.
-
-  Revision 1.8  1998/09/23 07:47:41  michael
-  + Some changes by TSE
-
-  Revision 1.7  1998/08/22 10:41:00  michael
-  + Some adaptations for changed comment and published handling
-
-  Revision 1.6  1998/06/11 13:46:32  michael
-  + Fixed some functions. TFileStream OK.
-
-  Revision 1.5  1998/06/10 21:53:06  michael
-  + Implemented Handle/FileStreams
-
-  Revision 1.4  1998/05/27 11:41:43  michael
-  Implemented TCollection and TCollectionItem
-
-  Revision 1.3  1998/05/06 12:58:35  michael
-  + Added WriteAnsiString method to TStream
-
-  Revision 1.2  1998/05/04 14:30:11  michael
-  * Split file according to Class; implemented dummys for all methods, so unit compiles.
-
-  Revision 1.1  1998/05/04 12:16:01  florian
-    + Initial revisions after making a new directory structure
-
-}

fcl/inc/collect.inc

@@ -1,362 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TCollectionItem                              *}
-{****************************************************************************}
-
-
-function TCollectionItem.GetIndex: Integer;
-
-begin
-  if FCollection<>nil then
-    Result:=FCollection.FItems.IndexOf(Pointer(Self))
-  else
-    Result:=-1;
-end;
-
-
-
-procedure TCollectionItem.SetCollection(Value: TCollection);
-
-begin
-  IF Value<>FCollection then
-    begin
-    If FCollection<>Nil then FCollection.RemoveItem(Self);
-    if Value<>Nil then Value.InsertItem(Self);
-    FCollection:=Value;
-    end;  
-end;
-
-
-
-procedure TCollectionItem.Changed(AllItems: Boolean);
-
-begin
- If (FCollection<>Nil) then
-  begin
-  If AllItems then 
-    FCollection.Update(Nil)
-  else
-    FCollection.Update(Self);
-  end;
-end;
-
-
-
-function TCollectionItem.GetNamePath: string;
-
-begin
-  If FCollection<>Nil then
-    Result:=FCollection.GetNamePath+'['+IntToStr(Index)+']'
-  else
-    Result:=ClassName; 
-end;
-
-
-function TCollectionItem.GetOwner: TPersistent;
-
-begin
-  Result:=FCollection;
-end;
-
-
-
-function TCollectionItem.GetDisplayName: string; 
-
-begin
-  Result:=ClassName;
-end;
-
-
-
-procedure TCollectionItem.SetIndex(Value: Integer);
-
-Var Temp : Longint;
-
-begin
-  Temp:=GetIndex;
-  If (Temp>-1) and (Temp<>Value) then
-    begin
-    FCollection.FItems.Move(Temp,Value);
-    Changed(True);
-    end; 
-end;
-
-
-procedure TCollectionItem.SetDisplayName(const Value: string);
-
-begin
-  Changed(False);
-end;
-
-
-
-constructor TCollectionItem.Create(ACollection: TCollection); 
-
-begin
-  Inherited Create;
-  SetCollection(ACollection);
-end;
-
-
-
-destructor TCollectionItem.Destroy; 
-
-begin
-  SetCollection(Nil);
-  Inherited Destroy;
-end;
-
-{****************************************************************************}
-{*                             TCollection                                  *}
-{****************************************************************************}
-
-
-
-function TCollection.GetCount: Integer;
-
-begin
-  If Assigned(FItems) Then
-    Result:=FItems.Count
-  else
-    Result:=0;
-end;
-
-
-Procedure TCollection.SetPropName;
-
-begin
-  //!! Should be replaced by the proper routines.
-  FPropName:='';
-end;
-
-
-function TCollection.GetPropName: string;
-
-Var TheOWner : TPersistent;
-
-begin
-  Result:=FPropNAme;
-  TheOWner:=GetOwner;
-  If (Result<>'') or (TheOwner=Nil) Or (TheOwner.Classinfo=Nil) then exit;
-  SetPropName;  
-  Result:=FPropName;
-end;
-
-
-
-procedure TCollection.InsertItem(Item: TCollectionItem);
-
-begin
-  If Not(Item Is FitemClass) then
-    exit;
-  FItems.add(Pointer(Item));
-  Item.FID:=FNextID;
-  inc(FNextID);
-  SetItemName(Item);
-  Changed;
-end;
-
-
-
-procedure TCollection.RemoveItem(Item: TCollectionItem);
-
-begin
-  FItems.Remove(Pointer(Item));
-  Item.FCollection:=Nil;
-  Changed;
-end;
-
-
-function TCollection.GetAttrCount: Integer; 
-
-begin
-  Result:=0;
-end;
-
-
-function TCollection.GetAttr(Index: Integer): string; 
-
-begin
-  Result:='';
-end;
-
-
-
-function TCollection.GetItemAttr(Index, ItemIndex: Integer): string; 
-
-
-begin
-   Result:=TCollectionItem(FItems.Items[ItemIndex]).DisplayName;
-end;
-
-
-
-function TCollection.GetNamePath: string; 
-
-Var OwnerName,ThePropName : String;
-
-begin
-  Result:=ClassName;
-  If GetOwner=Nil then Exit;
-  OwnerName:=GetOwner.GetNamePath;
-  If OwnerName='' then Exit;
-  ThePropName:=PropName;
-  if ThePropName='' then exit;
-  Result:=OwnerName+'.'+PropName;
-end;
-
-
-
-procedure TCollection.Changed;
-
-begin
-  Update(Nil);
-end;
-
-
-
-function TCollection.GetItem(Index: Integer): TCollectionItem;
-
-begin
-   Result:=TCollectionItem(FItems.Items[Index]);
-end;
-
-
-
-procedure TCollection.SetItem(Index: Integer; Value: TCollectionItem);
-
-begin
-  TCollectionItem(FItems.items[Index]).Assign(Value);
-end;
-
-
-
-procedure TCollection.SetItemName(Item: TCollectionItem); 
-
-begin
-end;
-
-
-
-procedure TCollection.Update(Item: TCollectionItem);
-
-begin
-end;
-
-
-
-constructor TCollection.Create(AItemClass: TCollectionItemClass);
-
-begin
-  inherited create;
-  FItemClass:=AItemClass;
-  FItems:=TList.Create;
-end;
-
-
-
-destructor TCollection.Destroy; 
-
-begin
-  If Assigned(FItems) Then Clear;
-  FItems.Free;
-  Inherited Destroy;
-end;
-
-
-
-function TCollection.Add: TCollectionItem;
-
-begin
-  Result:=FItemClass.Create(Self);
-end;
-
-
-
-procedure TCollection.Assign(Source: TPersistent);
-
-Var I : Longint;
-
-begin
-  If Source is TCollection then
-    begin
-    Clear;
-    For I:=0 To TCollection(Source).Count-1 do
-     Add.Assign(TCollection(Source).Items[I]);
-    exit;
-    end
-  else
-    Inherited Assign(Source);
-end;
-
-
-
-procedure TCollection.BeginUpdate;
-
-begin
-end;
-
-
-
-procedure TCollection.Clear;
-
-begin
-  If Assigned(FItems) then
-    While FItems.Count>0 do TCollectionItem(FItems.Last).Free;
-end;
-
-
-
-procedure TCollection.EndUpdate;
-
-begin
-end;
-
-
-
-function TCollection.FindItemID(ID: Integer): TCollectionItem;
-
-Var I : Longint;
-
-begin
-  Result:=Nil;
-  For I:=0 to Fitems.Count-1 do
-   begin
-   Result:=TCollectionItem(FItems.items[I]);
-   If Result.Id=Id then exit;
-   end;
-end;
-
-{
-  $Log$
-  Revision 1.6  1999-04-17 08:04:55  michael
-  + RemoveItem now sets FCollection, to avoid a loop.
-
-  Revision 1.5  1999/04/13 12:46:15  michael
-  + Some bug fixes by Romio
-
-  Revision 1.4  1999/04/05 09:56:04  michael
-  + Fixed bugs reported by Romio in TCollection
-
-  Revision 1.3  1998/10/02 22:41:23  michael
-  + Added exceptions for error handling
-
-  Revision 1.2  1998/05/27 11:41:41  michael
-  Implemented TCollection and TCollectionItem
-
-  Revision 1.1  1998/05/04 14:30:11  michael
-  * Split file according to Class; implemented dummys for all methods, so unit compiles.
-
-}

fcl/inc/compon.inc

@@ -1,490 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{****************************************************************************}
-{*                             TComponent                                   *}
-{****************************************************************************}
-
-Type
-  Longrec = Record
-    Hi,lo : word;
-    end;
-
-Function  TComponent.GetComponent(AIndex: Integer): TComponent;
-
-begin
-  If not assigned(FComponents) then
-    Result:=Nil
-  else
-    Result:=TComponent(FComponents.Items[Aindex]);
-end;
-
-
-Function  TComponent.GetComponentCount: Integer;
-
-begin
-  If not assigned(FComponents) then
-    result:=0
-  else
-    Result:=FComponents.Count;
-end;
-
-
-Function  TComponent.GetComponentIndex: Integer;
-
-begin
-  If Assigned(FOwner) and Assigned(FOwner.FComponents) then
-    Result:=FOWner.FComponents.IndexOf(Self)
-  else
-    Result:=-1;
-end;
-
-
-Procedure TComponent.Insert(AComponent: TComponent);
-
-begin
-  If not assigned(FComponents) then
-    FComponents:=TList.Create;
-  FComponents.Add(AComponent);
-  AComponent.FOwner:=Self;
-end;
-
-
-Procedure TComponent.ReadLeft(Reader: TReader);
-
-begin
-  LongRec(FDesignInfo).Lo:=Reader.ReadInteger;
-end;
-
-
-Procedure TComponent.ReadTop(Reader: TReader);
-
-begin
-  LongRec(FDesignInfo).Hi:=Reader.ReadInteger;
-end;
-
-
-Procedure TComponent.Remove(AComponent: TComponent);
-
-begin
-  AComponent.FOwner:=Nil;
-  If assigned(FCOmponents) then
-    begin
-    FComponents.Remove(AComponent);
-    IF FComponents.Count=0 then
-      begin
-      FComponents.Free;
-      FComponents:=Nil;
-      end;
-    end;
-end;
-
-
-Procedure TComponent.SetComponentIndex(Value: Integer);
-
-Var Temp,Count : longint;
-
-begin
-  If Not assigned(Fowner) then exit;
-  Temp:=getcomponentindex;
-  If temp<0 then exit;
-  If value<0 then value:=0;
-  Count:=Fowner.FComponents.Count;
-  If Value>=Count then value:=count-1;
-  If Value<>Temp then
-    begin
-    FOWner.FComponents.Delete(Temp);
-    FOwner.FComponents.Insert(Value,Self);
-    end;
-end;
-
-
-Procedure TComponent.SetReference(Enable: Boolean);
-
-begin
-  // For delphi compatibility only.
-end;
-
-
-Procedure TComponent.WriteLeft(Writer: TWriter);
-
-begin
-  Writer.WriteInteger(LongRec(FDesignInfo).Lo);
-end;
-
-
-Procedure TComponent.WriteTop(Writer: TWriter);
-
-begin
-  Writer.WriteInteger(LongRec(FDesignInfo).Hi);
-end;
-
-
-Procedure TComponent.ChangeName(const NewName: TComponentName);
-
-begin
-  FName:=NewName;
-end;
-
-
-Procedure TComponent.DefineProperties(Filer: TFiler);
-
-Var Ancestor : TComponent;
-    Temp : longint;
-
-begin
-  Temp:=0;
-  Ancestor:=TComponent(Filer.Ancestor);
-  If Assigned(Ancestor) then Temp:=Ancestor.FDesignInfo;
-{
-  Filer.Defineproperty('left',readleft,writeleft,
-                       (longrec(FDesignInfo).Lo<>Longrec(temp).Lo));
-  Filer.Defineproperty('top',readtop,writetop,
-                       (longrec(FDesignInfo).Hi<>Longrec(temp).Hi));
-}
-end;
-
-
-Procedure TComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
-
-begin
-  // Does nothing.
-end;
-
-
-Function  TComponent.GetChildOwner: TComponent;
-
-begin
- Result:=Nil;
-end;
-
-
-Function  TComponent.GetChildParent: TComponent;
-
-begin
-  Result:=Self;
-end;
-
-
-Function  TComponent.GetNamePath: string;
-
-begin
-  Result:=FName;
-end;
-
-
-Function  TComponent.GetOwner: TPersistent;
-
-begin
-  Result:=FOwner;
-end;
-
-
-Procedure TComponent.Loaded;
-
-begin
-  Exclude(FComponentState,csLoading);
-end;
-
-
-Procedure TComponent.Notification(AComponent: TComponent;
-  Operation: TOperation);
-
-Var Runner : Longint;
-
-begin
-  If (Operation=opRemove) and Assigned(FFreeNotifies) then
-    begin
-    FFreeNotifies.Remove(AComponent);
-    If FFreeNotifies.Count=0 then
-      begin
-      FFreeNotifies.Free;
-      FFreenotifies:=Nil;
-      end;
-    end;
-  If assigned(FComponents) then
-    For Runner:=0 To FComponents.Count-1 do
-      TComponent(FComponents.Items[Runner]).Notification(AComponent,Operation);
-end;
-
-
-Procedure TComponent.ReadState(Reader: TReader);
-
-begin
-  Reader.ReadData(Self);
-end;
-
-
-Procedure TComponent.SetAncestor(Value: Boolean);
-
-Var Runner : Longint;
-
-begin
-  If Value then
-    Include(FComponentState,csAncestor)
-  else
-    Include(FCOmponentState,csAncestor);
-  if Assigned(FComponents) then
-    For Runner:=0 To FComponents.Count do
-      TComponent(FComponents.Items[Runner]).SetAncestor(Value);
-end;
-
-
-Procedure TComponent.SetDesigning(Value: Boolean);
-
-Var Runner : Longint;
-
-begin
-  If Value then
-    Include(FComponentSTate,csDesigning)
-  else
-    Exclude(FComponentSTate,csDesigning);
-  if Assigned(FComponents) then
-    For Runner:=0 To FComponents.Count do
-      TComponent(FComponents.items[Runner]).SetDesigning(Value);
-end;
-
-
-Procedure TComponent.SetName(const NewName: TComponentName);
-
-begin
-  If FName=NewName then exit;
-  If not IsValidIdent(NewName) then
-    Raise EComponentError.CreateFmt(SInvalidName,[NewName]);
-  If Assigned(FOwner) Then
-    FOwner.ValidateRename(Self,FName,NewName)
-  else
-    ValidateRename(Nil,FName,NewName);
-  SetReference(False);
-  ChangeName(NewName);
-  Setreference(True);
-end;
-
-
-Procedure TComponent.SetChildOrder(Child: TComponent; Order: Integer);
-
-begin
-  // does nothing
-end;
-
-
-Procedure TComponent.SetParentComponent(Value: TComponent);
-
-begin
-  // Does nothing
-end;
-
-
-Procedure TComponent.Updating;
-
-begin
-  Include (FComponentState,csUpdating);
-end;
-
-
-Procedure TComponent.Updated;
-
-begin
-  Exclude(FComponentState,csUpdating);
-end;
-
-
-class Procedure TComponent.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
-
-begin
-  // For compatibility only.
-end;
-
-
-Procedure TComponent.ValidateRename(AComponent: TComponent;
-  const CurName, NewName: string);
-
-begin
-//!! This contradicts the Delphi manual.
-  If (AComponent<>Nil) and (CurName<>NewName) and
-     (FindComponent(NewName)<>Nil) then
-      raise EComponentError.Createfmt(SDuplicateName,[newname]);
-  If (csDesigning in FComponentState) and (FOwner<>Nil) then
-    FOwner.ValidateRename(AComponent,Curname,Newname);
-end;
-
-
-Procedure TComponent.ValidateContainer(AComponent: TComponent);
-
-begin
-end;
-
-
-Procedure TComponent.ValidateInsert(AComponent: TComponent);
-
-begin
-  // Does nothing.
-end;
-
-
-Procedure TComponent.WriteState(Writer: TWriter);
-
-begin
-  Writer.WriteData(self);
-end;
-
-
-Constructor TComponent.Create(AOwner: TComponent);
-
-begin
-  FComponentStyle:=[csInheritable];
-  If Assigned(AOwner) then AOwner.InsertComponent(Self);
-end;
-
-
-Destructor TComponent.Destroy;
-
-Var Runner : Longint;
-
-begin
-  If Assigned(FFreeNotifies) then
-    begin
-    For Runner:=0 To FFreeNotifies.Count-1 do
-      TComponent(FFreeNotifies.Items[Runner]).Notification (self,opRemove);
-    FFreeNotifies.Free;
-    FFreeNotifies:=Nil;
-    end;
-  Destroying;
-  DestroyComponents;
-  If FOwner<>Nil Then FOwner.RemoveComponent(Self);
-  inherited destroy;
-end;
-
-
-Procedure TComponent.DestroyComponents;
-
-Var acomponent: TComponent;
-
-begin
-  While assigned(FComponents) do
-    begin
-    aComponent:=TComponent(FComponents.Last);
-    Remove(aComponent);
-    Acomponent.Destroy;
-    end;
-end;
-
-
-Procedure TComponent.Destroying;
-
-Var Runner : longint;
-
-begin
-  If csDestroying in FComponentstate Then Exit;
-  include (FComponentState,csDestroying);
-  If Assigned(FComponents) then
-    for Runner:=0 to FComponents.Count-1 do
-      TComponent(FComponents.Items[Runner]).Destroying;
-end;
-
-
-Function  TComponent.FindComponent(const AName: string): TComponent;
-
-Var I : longint;
-
-begin
-  Result:=Nil;
-  If (AName='') or Not assigned(FComponents) then exit;
-  For i:=0 to FComponents.Count-1 do
-    if TComponent(FComponents[I]).Name=AName then
-      begin
-      Result:=TComponent(FComponents.Items[I]);
-      exit;
-      end;
-end;
-
-
-Procedure TComponent.FreeNotification(AComponent: TComponent);
-
-begin
-  If (Owner<>Nil) and (AComponent=Owner) then exit;
-  If not (Assigned(FFreeNotifies)) then
-    FFreeNotifies:=TList.Create;
-  If FFreeNotifies.IndexOf(AComponent)=-1 then
-    begin
-    FFreeNotifies.Add(AComponent);
-    AComponent.FreeNotification (self);
-    end;
-end;
-
-
-Procedure TComponent.FreeOnRelease;
-
-begin
-  // Delphi compatibility only at the moment.
-end;
-
-
-Function  TComponent.GetParentComponent: TComponent;
-
-begin
-  Result:=Nil;
-end;
-
-
-Function  TComponent.HasParent: Boolean;
-
-begin
-  Result:=False;
-end;
-
-
-Procedure TComponent.InsertComponent(AComponent: TComponent);
-
-begin
-  AComponent.ValidateContainer(Self);
-  ValidateRename(AComponent,'',AComponent.FName);
-  Insert(AComponent);
-  AComponent.SetReference(True);
-  If csDesigning in FComponentState then
-    AComponent.SetDesigning(true);
-  Notification(AComponent,opInsert);
-end;
-
-
-Procedure TComponent.RemoveComponent(AComponent: TComponent);
-
-begin
-  Notification(AComponent,opRemove);
-  AComponent.SetReference(False);
-  Remove(AComponent);
-  Acomponent.Setdesigning(False);
-  ValidateRename(AComponent,AComponent.FName,'');
-end;
-
-
-Function  TComponent.SafeCallException(ExceptObject: TObject;
-  ExceptAddr: Pointer): Integer;
-
-begin
-  SafeCallException:=0;
-end;
-
-{
-  $Log$
-  Revision 1.8  1999-04-12 14:41:00  michael
-  + Fixed TComponent methods where defaults are used
-
-  Revision 1.7  1999/04/12 08:02:48  michael
-  + Fixed bug in ValidateRename
-
-  Revision 1.6  1999/04/08 10:18:51  peter
-    * makefile updates
-
-}

fcl/inc/constse.inc

@@ -1,271 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-const
-  SAssignError = '%s can not be assigned to %s';
-  SFCreateError = 'File %s can not be created';
-  SFOpenError = 'File %s can not be opened';
-  SReadError = 'Stream-Read-Error';
-  SWriteError = 'Stream-Write-Error';
-  SMemoryStreamError = 'Can not expand Memory Stream';
-  SCantWriteResourceStreamError = 'Can not write to read-only ResourceStream';
-  SDuplicateReference = 'WriteObject was called twice for one instance';
-  SClassNotFound = 'Class %s not found';
-  SInvalidImage = 'Illegal stream image';
-  SResNotFound = 'Resource %s not found';
-  SClassMismatch = 'Resource %s has wrong class';
-  SListIndexError = 'List index exceeds bounds (%d)';
-  SListCapacityError = 'The maximum list capacity is reached (%d)';
-  SListCountError = 'List count too large (%d)';
-  SSortedListError = 'Operation not allowed on sorted StringLists';
-  SDuplicateString = 'Duplicate entries not allowed in StringList';
-  SInvalidTabIndex = 'Registerindex out of bounds';
-  SDuplicateName = 'A Component with name %s exists already';
-  SInvalidName = '"%s" is not a valid identifier name';
-  SDuplicateClass = 'A Class with name %s exists already';
-  SNoComSupport = '%s is not registered as COM-Class';
-  SLineTooLong = 'Line too long';
-
-  SInvalidPropertyValue = 'Invalid property value';
-  SInvalidPropertyPath = 'Invalid property path';
-  SUnknownProperty = 'Unknown property';
-  SReadOnlyProperty = 'Read-only property';
-  SPropertyException = 'Error when reading %s.%s: %s';
-  SAncestorNotFound = 'Ancestor of ''%s'' not found.';
-  SInvalidBitmap = 'Invalid Bitmap';
-  SInvalidIcon = 'Invalid Icon';
-  SInvalidMetafile = 'Invalid MetaFile';
-  SInvalidPixelFormat = 'Invalid PixelFormat';
-  SBitmapEmpty = 'Bitmap is empty';
-  SScanLine = 'Line index out of bounds';
-  SChangeIconSize = 'Can not change Icon size';
-  SOleGraphic = 'Invalid operation for TOleGraphic';
-  SUnknownExtension = 'Unknown extension (.%s)';
-  SUnknownClipboardFormat = 'Unknown Clipboard format';
-  SOutOfResources = 'Out of system resources';
-  SNoCanvasHandle = 'Canvas handle does not allow drawing';
-  SInvalidImageSize = 'Invalid image size';
-  STooManyImages = 'Too many images';
-  SDimsDoNotMatch = 'Image size mismatch';
-  SInvalidImageList = 'Invalid ImageList';
-  SReplaceImage = 'Image can not be replaced';
-  SImageIndexError = 'Invalid ImageList-Index';
-  SImageReadFail = 'The ImageList data could not be read from Stream';
-  SImageWriteFail = 'The ImageList data could not be written to Stream';
-  SWindowDCError = 'Error when??';
-  SClientNotSet = 'Client of TDrag was not initialized';
-  SWindowClass = 'Error when initializing Window Class';
-  SWindowCreate = 'Error when creating Window';
-  SCannotFocus = 'A disbled or invisible Window cannot get focus';
-  SParentRequired = 'Element ''%s'' has no parent Window';
-  SMDIChildNotVisible = 'A MDI-Child Windows can not be hidden.';
-  SVisibleChanged = 'Visible property cannot be changed in OnShow or OnHide handlers';
-  SCannotShowModal = 'A visible Window can not be made modal';
-  SScrollBarRange = 'Scrollbar property out of range';
-  SPropertyOutOfRange = 'Property %s out of range';
-  SMenuIndexError = 'Menu Index out of range';
-  SMenuReinserted = 'Menu reinserted';
-  SMenuNotFound = 'Menu entry not found in menu';
-  SNoTimers = 'No timers available';
-  SNotPrinting = 'Printer is not printing';
-  SPrinting = 'Printer is busy';
-  SPrinterIndexError = 'PrinterIndex out of range';
-  SInvalidPrinter = 'Selected printer is invalid';
-  SDeviceOnPort = '%s on %s';
-  SGroupIndexTooLow = 'GroupIndex must be greater than preceding menu groupindex';
-  STwoMDIForms = 'There is only one MDI window available';
-  SNoMDIForm = 'No MDI form is available, none is active';
-  SRegisterError = 'Invalid registry';
-  SImageCanvasNeedsBitmap = 'A Canvas can only be changedif it contains a bitmap';
-  SControlParentSetToSelf = 'A component can not have itself as parent';
-  SOKButton = 'OK';
-  SCancelButton = 'Cancel';
-  SYesButton = '&Yes';
-  SNoButton = '&No';
-  SHelpButton = '&Help';
-  SCloseButton = '&Close';
-  SIgnoreButton = '&Ignore';
-  SRetryButton = '&Retry';
-  SAbortButton = 'Abort';
-  SAllButton = '&All';
-
-  SFB = 'VH';
-  SFG = 'VG';
-  SBG = 'HG';
-  SOldTShape = 'Can not load older version of TShape';
-  SVMetafiles = 'MetaFiles';
-  SVEnhMetafiles = 'Enhanced MetaFiles';
-  SVIcons = 'Icons';
-  SVBitmaps = 'Bitmaps';
-  SGridTooLarge = 'Grid to large for this operation';
-  STooManyDeleted = 'Zu viele Zeilen oder Spalten gelöscht';
-  SIndexOutOfRange = 'Grid index out of range';
-  SFixedColTooBig = 'The number of fixed Columns must be less than the Column count';
-  SFixedRowTooBig = 'The number of fixed Rows must be less that the Row count';
-  SInvalidStringGridOp = 'Es können keine Zeilen des ''Grids'' gelöscht oder eingefügt werden';
-  SParseError = '%s in Line %d';
-
-  SIdentifierExpected = 'Identifier expected';
-  SStringExpected = 'String expected';
-  SNumberExpected = 'Number expected';
-
-  SCharExpected = '%s expected';
-
-  SSymbolExpected = '%s expected';
-
-  SInvalidNumber = 'Invalid numerical value';
-  SInvalidString = 'Invalid string constant';
-  SInvalidProperty = 'Invalid property value';
-  SInvalidBinary = 'Invalid binary';
-  SOutlineIndexError = 'Node index not found';
-  SOutlineExpandError = 'Parent node must be expanded';
-  SInvalidCurrentItem = 'Invalid item';
-  SMaskErr = 'Invalid mask';
-  SMaskEditErr = 'Invalid mask. Use the ESC-key to undo changes.';
-  SOutlineError = 'Invalid Node index';
-  SOutlineBadLevel = '???';
-  SOutlineSelection = 'Ungültige Auswahl';
-  SOutlineFileLoad = 'Fehler beim Dateiladen';
-  SOutlineLongLine = 'Zeile zu lang';
-  SOutlineMaxLevels = 'Maximale Gliederungstiefe überschritten';
-
-  SMsgDlgWarning = 'Warning';
-  SMsgDlgError = 'Error';
-  SMsgDlgInformation = 'Information';
-  SMsgDlgConfirm = 'Confirm';
-  SMsgDlgYes = '&Yes';
-  SMsgDlgNo = '&No';
-  SMsgDlgOK = 'OK';
-  SMsgDlgCancel = 'Cancel';
-  SMsgDlgHelp = '&Help';
-  SMsgDlgHelpNone = 'No help available';
-  SMsgDlgHelpHelp = 'Help';
-  SMsgDlgAbort = '&Abort';
-  SMsgDlgRetry = '&Retry';
-  SMsgDlgIgnore = '&Ignore';
-  SMsgDlgAll = '&All';
-  SMsgDlgNoToAll = 'N&o to all';
-  SMsgDlgYesToAll = 'Yes to A&lle';
-
-  SmkcBkSp = 'Backspace';
-  SmkcTab = 'Tab';
-  SmkcEsc = 'Esc';
-  SmkcEnter = 'Enter';
-  SmkcSpace = 'Space';
-  SmkcPgUp = 'Page up';
-  SmkcPgDn = 'Page down';
-  SmkcEnd = 'End';
-  SmkcHome = 'Home';
-  SmkcLeft = 'Left';
-  SmkcUp = 'Up';
-  SmkcRight = 'Right';
-  SmkcDown = 'Down';
-  SmkcIns = 'Insert';
-  SmkcDel = 'Delete';
-  SmkcShift = 'Shift+';
-  SmkcCtrl = 'Ctrl+';
-  SmkcAlt = 'Alt+';
-
-  srUnknown = '(Ukknown)';
-  srNone = '(Empty)';
-  SOutOfRange = 'Value must be between %d and %d';
-  SCannotCreateName = 'Cannot use standard name for and unknown component';
-
-  SDateEncodeError = 'Ungültiges Argument für Datumskodierung';
-  STimeEncodeError = 'Ungültiges Argument für Zeitkodierung';
-  SInvalidDate = '''''%s'''' ist kein gültiges Datum';
-  SInvalidTime = '''''%s'''' ist keine gültige Zeit';
-  SInvalidDateTime = '''''%s'''' ist kein gültiges Datum und Zeit';
-  SInsertLineError = 'Zeile kann nicht eingefügt werden';
-
-  SCannotDragForm = 'Formulare können nicht gezogen werden';
-  SPutObjectError = 'PutObject auf undefiniertes Element';
-  SCardDLLNotLoaded = 'CARDS.DLL kann nicht geladen werden';
-  SDuplicateCardId = 'Doppelte CardId gefunden';
-
-  SDdeErr = 'Ein Fehler wurde von der DDE zurückgeliefert  ($0%x)';
-  SDdeConvErr = 'DDE Fehler - Konversation wurde nicht hergestellt ($0%x)';
-  SDdeMemErr = 'Fehler trat auf, da unzureichender Speicher für DDE ($0%x)';
-  SDdeNoConnect = 'DDE-Konversation kann nicht eingerichtet werden';
-
-
-  SDefaultFilter = 'Alle Dateien (*.*)|*.*';
-  sAllFilter = 'Alle Dateien';
-  SNoVolumeLabel = ': [ - Ohne Namen - ]';
-
-  SConfirmCreateDir = 'Das angegebene Verzeichnis existiert nicht. Soll es angelegt werden?';
-  SSelectDirCap = 'Verzeichnis auswählen';
-  SCannotCreateDir = 'Das Verzeichnis kann nicht erstellt werden';
-  SDirNameCap = 'Verzeichnis&name:';
-  SDrivesCap = '&Laufwerke:';
-  SDirsCap = '&Verzeichnisse:';
-  SFilesCap = '&Dateien: (*.*)';
-  SNetworkCap = 'Ne&tzwerk...';
-
-  SColorPrefix = 'Farbe';
-  SColorTags = 'ABCDEFGHIJKLMNOP';
-
-  SInvalidClipFmt = 'Ungültiges Format der Zwischenablage';
-  SIconToClipboard = 'Zwischenablage unterstützt keine Symbole';
-
-  SDefault = 'Vorgabe';
-
-  SInvalidMemoSize = 'Text überschreitet Memo-Kapazität';
-  SCustomColors = 'Selbstdefinierte Farben';
-  SInvalidPrinterOp = 'Operation auf ausgewähltem Drucker nicht verfügbar';
-  SNoDefaultPrinter = 'Zur Zeit ist kein Standard-Drucker gewählt';
-
-  SIniFileWriteError = 'nach %s kann nicht geschrieben werden';
-
-  SBitsIndexError = 'Bits-Index außerhalb des zulässigen Bereichs';
-
-  SUntitled = '(Unbenannt)';
-
-  SInvalidRegType = 'Ungültiger Datentyp für ''%s''';
-  SRegCreateFailed = 'Erzeugung von Schlüssel %s misslungen';
-  SRegSetDataFailed = 'Konnte Daten für ''%s'' nicht setzen';
-  SRegGetDataFailed = 'Konnte Daten für ''%s'' nicht holen';
-
-  SUnknownConversion = 'Unbekannte Dateierweiterung für RichEdit-Konvertierung (.%s)';
-  SDuplicateMenus = 'Menü ''%s'' wird bereits von einem anderen Formular benutzt';
-
-  SPictureLabel = 'Bild:';
-  SPictureDesc = ' (%dx%d)';
-  SPreviewLabel = 'Vorschau';
-
-  SCannotOpenAVI = 'AVI kann nicht geöffnet werden';
-
-  SNotOpenErr = 'Kein MCI-Gerät geöffnet';
-  SMPOpenFilter = 'Alle Dateien (*.*)|*.*|Wave-Dateien (*.WAV)|*.WAV|Midi-Dateien (*.MID)|*.MID|Video für Windows (*.avi)|*.avi';
-  SMCINil = '';
-  SMCIAVIVideo = 'AVIVideo';
-  SMCICDAudio = 'CDAudio';
-  SMCIDAT = 'DAT';
-  SMCIDigitalVideo = 'DigitalVideo';
-  SMCIMMMovie = 'MMMovie';
-  SMCIOther = 'Andere';
-  SMCIOverlay = 'Overlay';
-  SMCIScanner = 'Scanner';
-  SMCISequencer = 'Sequencer';
-  SMCIVCR = 'VCR';
-  SMCIVideodisc = 'Videodisc';
-  SMCIWaveAudio = 'WaveAudio';
-  SMCIUnknownError = 'Unbekannter Fehlercode';
-
-  SBoldItalicFont = 'Fett kursiv';
-  SBoldFont = 'Fett';
-  SItalicFont = 'Kursiv';
-  SRegularFont = 'Normal';
-
-  SPropertiesVerb = 'Eigenschaften';

fcl/inc/constsg.inc

@@ -1,272 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-const
-  SAssignError = '%s kann nicht zu  %s zugewiesen werden';
-  SFCreateError = 'Datei %s kann nicht erstellt werden';
-  SFOpenError = 'Datei %s kann nicht geöffnet werden';
-  SReadError = 'Stream-Read-Fehler';
-  SWriteError = 'Stream-Write-Fehler';
-  SMemoryStreamError = 'Expandieren des Speicher-Stream wegen Speichermangel nicht möglich';
-  SCantWriteResourceStreamError = 'In einen zum Lesen geöffneten Ressourcen-Stream kann nicht geschrieben werden';
-  SDuplicateReference = 'Zweimaliger Aufruf von WriteObject für die gleiche Instanz';
-  SClassNotFound = 'Klasse %s nicht gefunden';
-  SInvalidImage = 'Ungültiges Stream-Format';
-  SResNotFound = 'Ressource %s nicht gefunden';
-  SClassMismatch = 'Ressource %s hat die falsche Klasse';
-  SListIndexError = 'Der Index der Liste überschreitet das Maximum (%d)';
-  SListCapacityError = 'Die Kapazität der Liste ist erschöpft (%d)';
-  SListCountError = 'Zu viele Einträge in der Liste (%d)';
-  SSortedListError = 'Operation bei sortierten Stringlisten nicht erlaubt';
-  SDuplicateString = 'In der Stringliste sind Duplikate nicht erlaubt';
-  SInvalidTabIndex = 'Registerindex außerhalb des zulässigen Bereichs';
-  SDuplicateName = 'Eine Komponente mit der Bezeichnung %s existiert bereits';
-  SInvalidName = '''''%s'''' ist kein gültiger Komponentenname';
-  SDuplicateClass = 'Eine Klasse mit der Bezeichnung %s existiert bereits';
-  SNoComSupport = '%s wurde nicht als COM-Klasse registriert';
-  SInvalidInteger = '''''%s'''' ist kein gültiger Integerwert';
-  SLineTooLong = 'Zeile zu lang';
-
-  SInvalidPropertyValue = 'Ungültiger Wert der Eigenschaft';
-  SInvalidPropertyPath = 'Ungültiger Pfad für Eigenschaft';
-  SUnknownProperty = 'Eigenschaft existiert nicht';
-  SReadOnlyProperty = 'Eigenschaft kann nur gelesen werden';
-  SPropertyException = 'Fehler beim Lesen von %s.%s: %s';
-  SAncestorNotFound = 'Vorfahr für ''%s'' nicht gefunden';
-  SInvalidBitmap = 'Bitmap ist ungültig';
-  SInvalidIcon = 'Ungültiges Symbol';
-  SInvalidMetafile = 'Metadatei ist ungültig';
-  SInvalidPixelFormat = 'Ungültiges Pixelformat';
-  SBitmapEmpty = 'Bitmap ist leer';
-  SScanLine = 'Bereichsüberschreitung bei Zeilenindex';
-  SChangeIconSize = 'Die Größe eines Symbols kann nicht geändert werden';
-  SOleGraphic = 'Ungültige Operation für TOleGraphic';
-  SUnknownExtension = 'Unbekannte Bilddateierweiterung (.%s)';
-  SUnknownClipboardFormat = 'Format der Zwischenablage wird nicht unterstützt';
-  SOutOfResources = 'Systemressourcen erschöpft.';
-  SNoCanvasHandle = 'Leinwand/Bild erlaubt kein Zeichnen';
-  SInvalidImageSize = 'Ungültige Bildgröße';
-  STooManyImages = 'Zu viele Bilder';
-  SDimsDoNotMatch = 'Bildgröße und Bildlistengröße stimmen nicht überein';
-  SInvalidImageList = 'Ungültige ImageList';
-  SReplaceImage = 'Bild kann nicht ersetzt werden';
-  SImageIndexError = 'Ungültiger ImageList-Index';
-  SImageReadFail = 'Die ImageList-Daten konnten nicht aus dem Stream gelesen werden';
-  SImageWriteFail = 'Die ImageList-Daten konnten nicht in den Stream geschrieben werden';
-  SWindowDCError = 'Fehler beim Erstellen des Fenster-Gerätekontexts';
-  SClientNotSet = 'Client von TDrag wurde nicht initialisiert';
-  SWindowClass = 'Fehler beim Erzeugen einer Fensterklasse';
-  SWindowCreate = 'Fehler beim Erzeugen eines Fensters';
-  SCannotFocus = 'Ein deaktiviertes oder unsichtbares Fenster kann nicht den Fokus erhalten';
-  SParentRequired = 'Element ''%s'' hat kein übergeordnetes Fenster';
-  SMDIChildNotVisible = 'Ein MDI-Kindformular kann nicht verborgen werden';
-  SVisibleChanged = 'Eigenschaft Visible kann in OnShow oder OnHide nicht verändert werden';
-  SCannotShowModal = 'Aus einem sichtbaren Fenster kann kein modales gemacht werden';
-  SScrollBarRange = 'Eigenschaft Scrollbar außerhalb des zulässigen Bereichs';
-  SPropertyOutOfRange = 'Eigenschaft %s außerhalb des gültigen Bereichs';
-  SMenuIndexError = 'Menüindex außerhalb des zulässigen Bereichs';
-  SMenuReinserted = 'Menü zweimal eingefügt';
-  SMenuNotFound = 'Untermenü ist nicht im Menü';
-  SNoTimers = 'Nicht genügend Timer verfügbar';
-  SNotPrinting = 'Der Drucker ist nicht am Drucken';
-  SPrinting = 'Das Drucken ist im Gang';
-  SPrinterIndexError = 'Druckerindex außerhalb des zulässigen Bereichs';
-  SInvalidPrinter = 'Ausgewählter Drucker ist ungültig';
-  SDeviceOnPort = '%s an %s';
-  SGroupIndexTooLow = 'GroupIndex kann nicht kleiner sein als der GroupIndex eines vorhergehenden Menüelementes';
-  STwoMDIForms = 'Es ist nur ein MDI-Formular pro Anwendung möglich';
-  SNoMDIForm = 'Formular kann nicht erstellt werden. Zur Zeit sind keine MDI-Formulare aktiv';
-  SRegisterError = 'Ungültige Komponentenregistrierung';
-  SImageCanvasNeedsBitmap = 'Ein Bild kann nur geändert werden, wenn es ein Bitmap enthält';
-  SControlParentSetToSelf = 'Ein Steuerelement kann nicht sich selbst als Vorfahr haben';
-  SOKButton = 'OK';
-  SCancelButton = 'Abbrechen';
-  SYesButton = '&Ja';
-  SNoButton = '&Nein';
-  SHelpButton = '&Hilfe';
-  SCloseButton = '&Schließen';
-  SIgnoreButton = '&Ignorieren';
-  SRetryButton = '&Wiederholen';
-  SAbortButton = 'Abbruch';
-  SAllButton = '&Alles';
-
-  SFB = 'VH';
-  SFG = 'VG';
-  SBG = 'HG';
-  SOldTShape = 'Kann ältere Version von TShape nicht laden';
-  SVMetafiles = 'Metadateien';
-  SVEnhMetafiles = 'Erweiterte Metadateien';
-  SVIcons = 'Symbole';
-  SVBitmaps = 'Bitmaps';
-  SGridTooLarge = 'Gitter zu groß für Operation';
-  STooManyDeleted = 'Zu viele Zeilen oder Spalten gelöscht';
-  SIndexOutOfRange = 'Gitterindex außerhalb des zulässigen Bereichs';
-  SFixedColTooBig = 'Die Anzahl fester Spalten muß kleiner sein als die Spaltenanzahl';
-  SFixedRowTooBig = 'Die Anzahl fester Zeilen muß kleiner sein als die Zeilenanzahl';
-  SInvalidStringGridOp = 'Es können keine Zeilen des ''Grids'' gelöscht oder eingefügt werden';
-  SParseError = '%s in Zeile %d';
-
-  SIdentifierExpected = 'Bezeichner erwartet';
-  SStringExpected = 'String erwartet';
-  SNumberExpected = 'Zahl erwartet';
-
-  SCharExpected = '%s erwartet';
-
-  SSymbolExpected = '%s erwartet';
-
-  SInvalidNumber = 'Ungültiger numerischer Wert';
-  SInvalidString = 'Ungültige Stringkonstante';
-  SInvalidProperty = 'Ungültiger Wert der Eigenschaft';
-  SInvalidBinary = 'Ungültiger Binärwert';
-  SOutlineIndexError = 'Gliederungsindex nicht gefunden';
-  SOutlineExpandError = 'Elternknoten muß expandiert sein';
-  SInvalidCurrentItem = 'Ungültiger Wert';
-  SMaskErr = 'Ungültiger Eingabewert';
-  SMaskEditErr = 'Ungültiger Eingabewert. Benutzen Sie die ESC-Taste, um die Änderungen rückgängig zu machen.';
-  SOutlineError = 'Ungültiger Gliederungsindex';
-  SOutlineBadLevel = 'Ungültige Zuweisung von Ebenen';
-  SOutlineSelection = 'Ungültige Auswahl';
-  SOutlineFileLoad = 'Fehler beim Dateiladen';
-  SOutlineLongLine = 'Zeile zu lang';
-  SOutlineMaxLevels = 'Maximale Gliederungstiefe überschritten';
-
-  SMsgDlgWarning = 'Warnung';
-  SMsgDlgError = 'Fehler';
-  SMsgDlgInformation = 'Information';
-  SMsgDlgConfirm = 'Bestätigen';
-  SMsgDlgYes = '&Ja';
-  SMsgDlgNo = '&Nein';
-  SMsgDlgOK = 'OK';
-  SMsgDlgCancel = 'Abbrechen';
-  SMsgDlgHelp = '&Hilfe';
-  SMsgDlgHelpNone = 'Keine Hilfe verfügbar';
-  SMsgDlgHelpHelp = 'Hilfe';
-  SMsgDlgAbort = '&Abbrechen';
-  SMsgDlgRetry = '&Wiederholen';
-  SMsgDlgIgnore = '&Ignorieren';
-  SMsgDlgAll = '&Alles';
-  SMsgDlgNoToAll = '&Alle Nein';
-  SMsgDlgYesToAll = 'A&lle Ja';
-
-  SmkcBkSp = 'Rück';
-  SmkcTab = 'Tab';
-  SmkcEsc = 'Esc';
-  SmkcEnter = 'Enter';
-  SmkcSpace = 'Leertaste';
-  SmkcPgUp = 'BildAuf';
-  SmkcPgDn = 'BildAb';
-  SmkcEnd = 'Ende';
-  SmkcHome = 'Pos1';
-  SmkcLeft = 'Linksbündig';
-  SmkcUp = 'Nach oben';
-  SmkcRight = 'Rechts';
-  SmkcDown = 'Nach unten';
-  SmkcIns = 'Einfg';
-  SmkcDel = 'Entf';
-  SmkcShift = 'Umsch+';
-  SmkcCtrl = 'Strg+';
-  SmkcAlt = 'Alt+';
-
-  srUnknown = '(Unbekannt)';
-  srNone = '(Leer)';
-  SOutOfRange = 'Wert muß zwischen %d und %d liegen';
-  SCannotCreateName = 'Für eine unbenannte Komponente kann kein Standard-Methodennamen erstellt werden';
-
-  SDateEncodeError = 'Ungültiges Argument für Datumskodierung';
-  STimeEncodeError = 'Ungültiges Argument für Zeitkodierung';
-  SInvalidDate = '''''%s'''' ist kein gültiges Datum';
-  SInvalidTime = '''''%s'''' ist keine gültige Zeit';
-  SInvalidDateTime = '''''%s'''' ist kein gültiges Datum und Zeit';
-  SInsertLineError = 'Zeile kann nicht eingefügt werden';
-
-  SCannotDragForm = 'Formulare können nicht gezogen werden';
-  SPutObjectError = 'PutObject auf undefiniertes Element';
-  SCardDLLNotLoaded = 'CARDS.DLL kann nicht geladen werden';
-  SDuplicateCardId = 'Doppelte CardId gefunden';
-
-  SDdeErr = 'Ein Fehler wurde von der DDE zurückgeliefert  ($0%x)';
-  SDdeConvErr = 'DDE Fehler - Konversation wurde nicht hergestellt ($0%x)';
-  SDdeMemErr = 'Fehler trat auf, da unzureichender Speicher für DDE ($0%x)';
-  SDdeNoConnect = 'DDE-Konversation kann nicht eingerichtet werden';
-
-
-  SDefaultFilter = 'Alle Dateien (*.*)|*.*';
-  sAllFilter = 'Alle Dateien';
-  SNoVolumeLabel = ': [ - Ohne Namen - ]';
-
-  SConfirmCreateDir = 'Das angegebene Verzeichnis existiert nicht. Soll es angelegt werden?';
-  SSelectDirCap = 'Verzeichnis auswählen';
-  SCannotCreateDir = 'Das Verzeichnis kann nicht erstellt werden';
-  SDirNameCap = 'Verzeichnis&name:';
-  SDrivesCap = '&Laufwerke:';
-  SDirsCap = '&Verzeichnisse:';
-  SFilesCap = '&Dateien: (*.*)';
-  SNetworkCap = 'Ne&tzwerk...';
-
-  SColorPrefix = 'Farbe';
-  SColorTags = 'ABCDEFGHIJKLMNOP';
-
-  SInvalidClipFmt = 'Ungültiges Format der Zwischenablage';
-  SIconToClipboard = 'Zwischenablage unterstützt keine Symbole';
-
-  SDefault = 'Vorgabe';
-
-  SInvalidMemoSize = 'Text überschreitet Memo-Kapazität';
-  SCustomColors = 'Selbstdefinierte Farben';
-  SInvalidPrinterOp = 'Operation auf ausgewähltem Drucker nicht verfügbar';
-  SNoDefaultPrinter = 'Zur Zeit ist kein Standard-Drucker gewählt';
-
-  SIniFileWriteError = 'nach %s kann nicht geschrieben werden';
-
-  SBitsIndexError = 'Bits-Index außerhalb des zulässigen Bereichs';
-
-  SUntitled = '(Unbenannt)';
-
-  SInvalidRegType = 'Ungültiger Datentyp für ''%s''';
-  SRegCreateFailed = 'Erzeugung von Schlüssel %s misslungen';
-  SRegSetDataFailed = 'Konnte Daten für ''%s'' nicht setzen';
-  SRegGetDataFailed = 'Konnte Daten für ''%s'' nicht holen';
-
-  SUnknownConversion = 'Unbekannte Dateierweiterung für RichEdit-Konvertierung (.%s)';
-  SDuplicateMenus = 'Menü ''%s'' wird bereits von einem anderen Formular benutzt';
-
-  SPictureLabel = 'Bild:';
-  SPictureDesc = ' (%dx%d)';
-  SPreviewLabel = 'Vorschau';
-
-  SCannotOpenAVI = 'AVI kann nicht geöffnet werden';
-
-  SNotOpenErr = 'Kein MCI-Gerät geöffnet';
-  SMPOpenFilter = 'Alle Dateien (*.*)|*.*|Wave-Dateien (*.WAV)|*.WAV|Midi-Dateien (*.MID)|*.MID|Video für Windows (*.avi)|*.avi';
-  SMCINil = '';
-  SMCIAVIVideo = 'AVIVideo';
-  SMCICDAudio = 'CDAudio';
-  SMCIDAT = 'DAT';
-  SMCIDigitalVideo = 'DigitalVideo';
-  SMCIMMMovie = 'MMMovie';
-  SMCIOther = 'Andere';
-  SMCIOverlay = 'Overlay';
-  SMCIScanner = 'Scanner';
-  SMCISequencer = 'Sequencer';
-  SMCIVCR = 'VCR';
-  SMCIVideodisc = 'Videodisc';
-  SMCIWaveAudio = 'WaveAudio';
-  SMCIUnknownError = 'Unbekannter Fehlercode';
-
-  SBoldItalicFont = 'Fett kursiv';
-  SBoldFont = 'Fett';
-  SItalicFont = 'Kursiv';
-  SRegularFont = 'Normal';
-
-  SPropertiesVerb = 'Eigenschaften';

fcl/inc/constss.inc

@@ -1,271 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-const
-  SAssignError = '%s no puede ser assignado a  %s';
-  SFCreateError = 'Fichero %s no puede ser creado';
-  SFOpenError = 'Fichero %s no puede ser abierto';
-  SReadError = 'Error-Lectura-Stream';
-  SWriteError = 'Error-Escritura-Stream';
-  SMemoryStreamError = 'No es posible expandir Memoria Stream';
-  SCantWriteResourceStreamError = 'No se puede escribir en un ResourceStream de solo lectura';
-  SDuplicateReference = 'WriteObject fue llamado dos veces por una sola instancia';
-  SClassNotFound = 'Clase %s no encontrada';
-  SInvalidImage = 'Imagen stream ilegal';
-  SResNotFound = 'No se encontro el resource %s';
-  SClassMismatch = 'El resource %s tiene una clase erronea';
-  SListIndexError = 'El indice de lista excede los limites (%d)';
-  SListCapacityError = 'La maxima capacidad de lista a sido alcanzada (%d)';
-  SListCountError = 'Contador de lista demasiado grande (%d)';
-  SSortedListError = 'Operacion no permitida en StringLists ordenado';
-  SDuplicateString = 'Entradas duplicadas no permitidas en StringList';
-  SInvalidTabIndex = 'Registerindex fuera de limites';
-  SDuplicateName = 'Un componente con el nombre %s existe actualmente';
-  SInvalidName = '"%s" no es un nombre identificador valido';
-  SDuplicateClass = 'Una Clase con el nombre %s existe actualmente';
-  SNoComSupport = '%s no esta registrado como COM-Class';
-  SLineTooLong = 'Linea demasiado larga';
-
-  SInvalidPropertyValue = 'Valor de propiedad no valido';
-  SInvalidPropertyPath = 'Path de propiedad no valido';
-  SUnknownProperty = 'Propiedad desconocidad';
-  SReadOnlyProperty = 'Propiedad de solo lectura';
-  SPropertyException = 'Error leyendo %s.%s: %s';
-{N}  SAncestorNotFound = 'Ancestor of ''%s'' not found.';
-  SInvalidBitmap = 'Bitmap no valido';
-  SInvalidIcon = 'Icono no valido';
-  SInvalidMetafile = 'MetaFile no valido';
-  SInvalidPixelFormat = 'PixelFormat no valido';
-  SBitmapEmpty = 'El bitmap esta vacio';
-  SScanLine = 'Indice de linea fuera de limites';
-  SChangeIconSize = 'No se puede cambiar el tama¤o del icono';
-  SOleGraphic = 'Operacion no valida para TOleGraphic';
-  SUnknownExtension = 'Extension desconocida (.%s)';
-  SUnknownClipboardFormat = 'Formato de Portapapeles desconocido';
-  SOutOfResources = 'Recursos de sistema agotados';
-  SNoCanvasHandle = 'El manejador Canvas no permite dibujar';
-  SInvalidImageSize = 'Tama¤o de imagen no valido';
-  STooManyImages = 'Demasiadas imagenes';
-  SDimsDoNotMatch = 'El tama¤o de la imagen no coincide';
-  SInvalidImageList = 'ImageList no valido';
-  SReplaceImage = 'La imagen no puede ser reemplazada';
-  SImageIndexError = 'ImageList-Index no valido';
-  SImageReadFail = 'Los datos de ImageList no pueden ser leido desde Stream';
-  SImageWriteFail = 'Los datos de ImageList no pueden ser escritos en Stream';
-  SWindowDCError = 'Error cuando??';
-  SClientNotSet = 'El cliente de TDrag no fue iniciado';
-  SWindowClass = 'Error inicializando Window Class';
-  SWindowCreate = 'Error creando una Ventana';
-{?}  SCannotFocus = 'Una Ventana invisible or desactivada no puede obtener el foco';
-  SParentRequired = 'El elemento ''%s'' no tiene una ventana padre';
-  SMDIChildNotVisible = 'Una ventana MDI-Child no puede ser ocultada.';
-  SVisibleChanged = 'Una propiedad visual no puede ser cambiada en el manejador OnShow o OnHide';
-{?}  SCannotShowModal = 'Una Ventana visible no puede ser hecha modal';
-  SScrollBarRange = 'Propiedad de Scrollbar fuera de limites';
-  SPropertyOutOfRange = 'Propiedad %s fuera de limites';
-  SMenuIndexError = 'Indice de menu fuera de rango';
-  SMenuReinserted = 'Menu reinsertado';
-  SMenuNotFound = 'Entrada de menu no encontra en menu';
-  SNoTimers = 'No hay timers disponibles';
-  SNotPrinting = 'La impresora no esta imprimiendo';
-  SPrinting = 'La impresora esta ocupada';
-  SPrinterIndexError = 'PrinterIndex fuera de rango';
-  SInvalidPrinter = 'La impresora seleccionada no es valida';
-  SDeviceOnPort = '%s en %s';
-  SGroupIndexTooLow = 'GroupIndex tiene que ser mayor que el goupindex del menu predecesor';
-  STwoMDIForms = 'Solo hay una ventana MDI disponible';
-  SNoMDIForm = 'No hay ningun MDI form disponible, none esta activado';
-  SRegisterError = 'Registro invalido';
-  SImageCanvasNeedsBitmap = 'Un Canvas solo puede ser cambiado si contiene un bitmap';
-  SControlParentSetToSelf = 'Un componente no puede tenerse a si mismo como padre';
-  SOKButton = 'Aceptar';
-  SCancelButton = 'Cancelar';
-  SYesButton = '&Si';
-  SNoButton = '&No';
-  SHelpButton = '&Ayuda';
-  SCloseButton = '&Cerrar';
-  SIgnoreButton = '&Ignorar';
-  SRetryButton = '&Reintentar';
-  SAbortButton = 'Abortar';
-  SAllButton = '&Todo';
-
-{?}  SFB = 'VH';
-{?}  SFG = 'VG';
-{?}  SBG = 'HG';
-  SOldTShape = 'No es posible cargar versiones antiguas de TShape';
-  SVMetafiles = 'MetaFiles';
-  SVEnhMetafiles = 'MetaFiles ampliados';
-  SVIcons = 'Iconos';
-  SVBitmaps = 'Bitmaps';
-  SGridTooLarge = 'Malla demasiado grande para esta operacion';
-{?}  STooManyDeleted = 'Zu viele Zeilen oder Spalten gelöscht';
-  SIndexOutOfRange = 'Indice de malla fuera de rango';
-  SFixedColTooBig = 'El numero de columnas fijas tiene que ser menor que el contador Column';
-  SFixedRowTooBig = 'El numero de filas fijas tiene que ser menor que el contador Row';
-{?}  SInvalidStringGridOp = 'Es können keine Zeilen des ''Grids'' gelöscht oder eingefügt werden';
-  SParseError = '%s en Linia %d';
-
-  SIdentifierExpected = 'Falta identificador';
-  SStringExpected = 'Falta string';
-  SNumberExpected = 'Falta numero';
-
-  SCharExpected = 'Falta %s';
-
-  SSymbolExpected = 'Falta %s';
-
-  SInvalidNumber = 'Valor numerico no valido';
-  SInvalidString = 'Constante string no valida';
-  SInvalidProperty = 'Valor de propiedad no valido';
-  SInvalidBinary = 'Binario no valido';
-  SOutlineIndexError = 'Indice de nodo no encontrado';
-  SOutlineExpandError = 'El nodo padre tiene que ser expandido';
-  SInvalidCurrentItem = 'Item no valido';
-  SMaskErr = 'Mascara no valida';
-  SMaskEditErr = 'Mascara no valida. Usa la tecla ESC para deshacer los cambios.';
-  SOutlineError = 'Indice de nodo no valido';
-  SOutlineBadLevel = '???';
-{?}  SOutlineSelection = 'Ungültige Auswahl';
-{?}  SOutlineFileLoad = 'Fehler beim Dateiladen';
-{?}  SOutlineLongLine = 'Zeile zu lang';
-{?}  SOutlineMaxLevels = 'Maximale Gliederungstiefe überschritten';
-
-  SMsgDlgWarning = 'Atencion';
-  SMsgDlgError = 'Error';
-  SMsgDlgInformation = 'Informacion';
-  SMsgDlgConfirm = 'Confirmar';
-  SMsgDlgYes = '&Si';
-  SMsgDlgNo = '&No';
-  SMsgDlgOK = 'Aceptar';
-  SMsgDlgCancel = 'Cancelar';
-  SMsgDlgHelp = '&Ayuda';
-  SMsgDlgHelpNone = 'No hay ayuda disponible';
-  SMsgDlgHelpHelp = 'Ayuda';
-  SMsgDlgAbort = 'A&bortar';
-  SMsgDlgRetry = '&Reintentar';
-  SMsgDlgIgnore = '&Ignorar';
-  SMsgDlgAll = '&Todo';
-  SMsgDlgNoToAll = 'N&o a todo';
-  SMsgDlgYesToAll = 'Si a To&do';
-
-  SmkcBkSp = 'Backspace';
-  SmkcTab = 'Tabulador';
-  SmkcEsc = 'Esc';
-  SmkcEnter = 'Intro';
-  SmkcSpace = 'Espacio';
-  SmkcPgUp = 'Pagina arriva';
-  SmkcPgDn = 'Pagina abajo';
-  SmkcEnd = 'Fin';
-  SmkcHome = 'Inicio';
-  SmkcLeft = 'Izquierda';
-  SmkcUp = 'Arriba';
-  SmkcRight = 'Derecha';
-  SmkcDown = 'Abajo';
-  SmkcIns = 'Insertar';
-  SmkcDel = 'Suprimir';
-  SmkcShift = 'Shift+';
-  SmkcCtrl = 'Ctrl+';
-  SmkcAlt = 'Alt+';
-
-  srUnknown = '(Desconocido)';
-  srNone = '(Vacio)';
-  SOutOfRange = 'El valor tiene que estar entre %d y %d';
-  SCannotCreateName = 'No es posible use el nombre estandard para un componente desconocido';
-
-{?}  SDateEncodeError = 'Ungültiges Argument für Datumskodierung';
-{?}  STimeEncodeError = 'Ungültiges Argument für Zeitkodierung';
-{?}  SInvalidDate = '''''%s'''' ist kein gültiges Datum';
-{?}  SInvalidTime = '''''%s'''' ist keine gültige Zeit';
-{?}  SInvalidDateTime = '''''%s'''' ist kein gültiges Datum und Zeit';
-{?}  SInsertLineError = 'Zeile kann nicht eingefügt werden';
-
-{?}  SCannotDragForm = 'Formulare können nicht gezogen werden';
-{?}  SPutObjectError = 'PutObject auf undefiniertes Element';
-{?}  SCardDLLNotLoaded = 'CARDS.DLL kann nicht geladen werden';
-{?}  SDuplicateCardId = 'Doppelte CardId gefunden';
-
-{?}  SDdeErr = 'Ein Fehler wurde von der DDE zurückgeliefert  ($0%x)';
-{?}  SDdeConvErr = 'DDE Fehler - Konversation wurde nicht hergestellt ($0%x)';
-{?}  SDdeMemErr = 'Fehler trat auf, da unzureichender Speicher für DDE ($0%x)';
-{?}  SDdeNoConnect = 'DDE-Konversation kann nicht eingerichtet werden';
-
-
-{?}  SDefaultFilter = 'Alle Dateien (*.*)|*.*';
-{?}  sAllFilter = 'Alle Dateien';
-{?}  SNoVolumeLabel = ': [ - Ohne Namen - ]';
-
-{?}  SConfirmCreateDir = 'Das angegebene Verzeichnis existiert nicht. Soll es angelegt werden?';
-{?}  SSelectDirCap = 'Verzeichnis auswählen';
-{?}  SCannotCreateDir = 'Das Verzeichnis kann nicht erstellt werden';
-{?}  SDirNameCap = 'Verzeichnis&name:';
-{?}  SDrivesCap = '&Laufwerke:';
-{?}  SDirsCap = '&Verzeichnisse:';
-{?}  SFilesCap = '&Dateien: (*.*)';
-{?}  SNetworkCap = 'Ne&tzwerk...';
-
-{?}  SColorPrefix = 'Farbe';
-  SColorTags = 'ABCDEFGHIJKLMNOP';
-
-{?}  SInvalidClipFmt = 'Ungültiges Format der Zwischenablage';
-{?}  SIconToClipboard = 'Zwischenablage unterstützt keine Symbole';
-
-{?}  SDefault = 'Vorgabe';
-
-{?}  SInvalidMemoSize = 'Text überschreitet Memo-Kapazität';
-{?}  SCustomColors = 'Selbstdefinierte Farben';
-{?}  SInvalidPrinterOp = 'Operation auf ausgewähltem Drucker nicht verfügbar';
-{?}  SNoDefaultPrinter = 'Zur Zeit ist kein Standard-Drucker gewählt';
-
-{?}  SIniFileWriteError = 'nach %s kann nicht geschrieben werden';
-
-{?}  SBitsIndexError = 'Bits-Index außerhalb des zulässigen Bereichs';
-
-{?}  SUntitled = '(Unbenannt)';
-
-{?}  SInvalidRegType = 'Ungültiger Datentyp für ''%s''';
-{?}  SRegCreateFailed = 'Erzeugung von Schlüssel %s misslungen';
-{?}  SRegSetDataFailed = 'Konnte Daten für ''%s'' nicht setzen';
-{?}  SRegGetDataFailed = 'Konnte Daten für ''%s'' nicht holen';
-
-{?}  SUnknownConversion = 'Unbekannte Dateierweiterung für RichEdit-Konvertierung (.%s)';
-{?}  SDuplicateMenus = 'Menü ''%s'' wird bereits von einem anderen Formular benutzt';
-
-{?}  SPictureLabel = 'Bild:';
-  SPictureDesc = ' (%dx%d)';
-{?}  SPreviewLabel = 'Vorschau';
-
-{?}  SCannotOpenAVI = 'AVI kann nicht geöffnet werden';
-
-{?}  SNotOpenErr = 'Kein MCI-Gerät geöffnet';
-{?}  SMPOpenFilter = 'Alle Dateien (*.*)|*.*|Wave-Dateien (*.WAV)|*.WAV|Midi-Dateien (*.MID)|*.MID|Video für Windows (*.avi)|*.avi';
-  SMCINil = '';
-  SMCIAVIVideo = 'AVIVideo';
-  SMCICDAudio = 'CDAudio';
-  SMCIDAT = 'DAT';
-  SMCIDigitalVideo = 'DigitalVideo';
-  SMCIMMMovie = 'MMMovie';
-  SMCIOther = 'Andere';
-  SMCIOverlay = 'Overlay';
-  SMCIScanner = 'Scanner';
-  SMCISequencer = 'Sequencer';
-  SMCIVCR = 'VCR';
-  SMCIVideodisc = 'Videodisc';
-  SMCIWaveAudio = 'WaveAudio';
-  SMCIUnknownError = 'Unbekannter Fehlercode';
-
-  SBoldItalicFont = 'Negrita cursiva';
-  SBoldFont = 'Negrita';
-  SItalicFont = 'Cursiva';
-  SRegularFont = 'Normal';
-
-{?}  SPropertiesVerb = 'Eigenschaften';

fcl/inc/cregist.inc

@@ -1,155 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1999 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-
-
-{ Class registration routines }
-
-procedure RegisterClass(AClass: TPersistentClass);
-
-begin
-end;
-
-
-procedure RegisterClasses(AClasses: array of TPersistentClass);
-
-begin
-end;
-
-
-procedure RegisterClassAlias(AClass: TPersistentClass; const Alias: string);
-
-begin
-end;
-
-
-procedure UnRegisterClass(AClass: TPersistentClass);
-
-begin
-end;
-
-
-procedure UnRegisterClasses(AClasses: array of TPersistentClass);
-
-begin
-end;
-
-
-procedure UnRegisterModuleClasses(Module: HMODULE);
-
-begin
-end;
-
-
-function FindClass(const ClassName: string): TPersistentClass;
-
-begin
-  FindClass:=nil;
-end;
-
-
-function GetClass(const ClassName: string): TPersistentClass;
-
-begin
-  GetClass:=nil;
-end;
-
-
-
-{ Component registration routines }
-
-type
-  TComponentPage = class(TCollectionItem)
-  public
-    Name: String;
-    Classes: TList;
-  end;
-var
-  ComponentPages: TCollection;
-
-procedure InitComponentPages;
-begin
-  ComponentPages := TCollection.Create(TComponentPage);
-  { Add a empty page which will be used for storing the NoIcon components }
-  ComponentPages.Add;
-end;
-
-procedure RegisterComponents(const Page: string;
-  ComponentClasses: array of TComponentClass);
-var
-  i: Integer;
-  pg: TComponentPage;
-begin
-  if Page = '' then exit;  { prevent caller from doing nonsense }
-
-  pg := nil;
-  if not Assigned(ComponentPages) then
-    InitComponentPages
-  else
-    for i := 0 to ComponentPages.Count - 1 do
-      if TComponentPage(ComponentPages.Items[i]).Name = Page then begin
-        pg := TComponentPage(ComponentPages.Items[i]);
-	break;
-      end;
-
-  if pg = nil then begin
-    pg := TComponentPage(ComponentPages.Add);
-    pg.Name := Page;
-  end;
-
-  if pg.Classes = nil then
-    pg.Classes := TList.Create;
-
-  for i := Low(ComponentClasses) to High(ComponentClasses) do
-    pg.Classes.Add(ComponentClasses[i]);
-
-  if Assigned(RegisterComponentsProc) then
-    RegisterComponentsProc(Page, ComponentClasses);
-end;
-
-
-procedure RegisterNoIcon(ComponentClasses: array of TComponentClass);
-var
-  pg: TComponentPage;
-  i: Integer;
-begin
-  if not Assigned(ComponentPages) then
-    InitComponentPages;
-
-  pg := TComponentPage(ComponentPages.Items[0]);
-  if pg.Classes = nil then
-    pg.Classes := TList.Create;
-
-  for i := Low(ComponentClasses) to High(ComponentClasses) do
-    pg.Classes.Add(ComponentClasses[i]);
-
-  if Assigned(RegisterNoIconProc) then
-    RegisterNoIconProc(ComponentClasses);
-end;
-
-
-procedure RegisterNonActiveX(ComponentClasses: array of TComponentClass;
-  AxRegType: TActiveXRegType);
-
-begin
-end;
-
-
-{
-  $Log$
-  Revision 1.1  1999-09-11 22:02:35  fcl
-  * Imported function skeletons from old classes.inc
-  * Implementation of RegisterComponents and RegisterNoIcon  (sg)
-
-}

fcl/inc/ezcgi.pp

@@ -1,392 +0,0 @@
-unit ezcgi;
-
-{$mode delphi}
-{$H+ }
-
-interface
-
-uses classes, strings, sysutils;
-
-const
-   hexTable = '0123456789ABCDEF';
-
-type
-   ECGIException = class(Exception);
-
-   TEZcgi = class(TObject)
-   private
-      { Private declarations }
-      FVariables : TStringList;
-      FName : String;
-      FEmail : String;
-      FQueryString : String;
-
-      { Token variables }
-      aString : String;
-      aSepStr : String;
-      aPos    : Byte;
-      aLenStr : Byte;
-      aLenSep : Byte;
-
-      procedure InitToken(aStr, aSep : String);
-      function NextToken(var aToken : String; var aSepChar : Char) : Boolean;
-
-      procedure GetQueryItems;
-      procedure ProcessRequest;
-      procedure LoadEnvVariables;
-      function GetVal(Index : String) : String;      
-      function GetName(Index : Integer) : String;      
-      function GetVariable(Index : Integer) : String;      
-      function GetVarCount : Integer;
-      procedure ReadPostQuery;
-      procedure ReadGetQuery;
-   protected
-      { Protected declarations }
-
-      procedure OutputError(errorMessage : String);
-   public
-      { Public declarations }
-      constructor Create;
-      destructor Destroy; override;
-      procedure Run;
-      procedure WriteContent(ctype : String);
-      procedure PutLine(sOut : String);
-      function GetValue(Index : String; defaultValue : String) : String;
-      
-      procedure DoPost; virtual;
-      procedure DoGet; virtual;
-
-      property Values[Index : String] : String read GetVal;
-      property Names[Index : Integer] : String read GetName;
-      property Variables[Index : Integer] : String read GetVariable;
-      property VariableCount : Integer read GetVarCount;
-      
-      property Name : String read FName write FName;
-      property Email : String read FEmail write FEmail;
-   end;
-
-implementation
-
-{ *********** Include OS-dependent Getenv Call ************ }
-
-{$I ezcgi.inc}
-
-{ *********** Public Methods *************** }
-
-constructor TEZcgi.Create;
-begin
-   FName := 'No name available';
-   FEmail := 'Email address unavailable';
-
-   FVariables := TStringList.Create;
-
-   LoadEnvVariables;
-   
-end;
-
-destructor TEZcgi.Destroy;
-begin
-   FVariables.Free;
-end;
-
-procedure TEZcgi.Run;
-begin
-   ProcessRequest;
-end;
-
-procedure TEZcgi.DoPost;
-begin
-  // Must be overriden by child class
-end;
-
-procedure TEZcgi.DoGet;
-begin
-  // Must be overriden by child class
-end;
-
-procedure TEZcgi.WriteContent(ctype : String);
-begin
-   writeln('Content-Type: ',ctype);
-   writeln;
-end;
-
-procedure TEZcgi.PutLine(sOut : String);
-begin
-   writeln(sOut);
-end;
-
-function TEZcgi.GetValue(Index, defaultValue : String) : String;
-begin
-   result := GetVal(Index);
-   if result = '' then
-      result := defaultValue;
-end;
-
-
-{ *********** Private Methods *************** }
-
-procedure TEZcgi.LoadEnvVariables;
-
-   procedure GetEData(variable : String);
-   var
-      tempStr : String;
-   begin
-      // This is a system dependent call !!
-      tempStr := GetEnv(variable);
-      if tempStr <> '' then
-         FVariables.Add(variable + '=' + tempStr);
-   end;
-
-begin
-
-   { Standard CGI Environment Variables }
-   GetEData('AUTH_TYPE');
-   GetEData('CONTENT_LENGTH');
-   GetEData('CONTENT_TYPE');
-   GetEData('GATEWAY_INTERFACE');
-   GetEData('PATH_INFO');
-   GetEData('PATH_TRANSLATED');
-   GetEData('QUERY_STRING');
-   GetEData('REMOTE_ADDR');
-   GetEData('REMOTE_HOST');
-   GetEData('REMOTE_IDENT');
-   GetEData('REMOTE_USER');
-   GetEData('REQUEST_METHOD');
-   GetEData('SCRIPT_NAME');
-   GetEData('SERVER_NAME');
-   GetEData('SERVER_PORT');
-   GetEData('SERVER_PROTOCOL');
-   GetEData('SERVER_SOFTWARE');
-
-
-   { Standard HTTP Environment Variables }
-   GetEData('HTTP_ACCEPT');
-   GetEData('HTTP_ACCEPT_CHARSET');
-   GetEData('HTTP_ACCEPT_ENCODING');
-   GetEData('HTTP_IF_MODIFIED_SINCE');
-   GetEData('HTTP_REFERER');
-   GetEData('HTTP_USER_AGENT');
-end;
-
-procedure TEZcgi.ProcessRequest;
-var
-   request : String;
-begin
-
-   request := GetVal('REQUEST_METHOD');
-   
-   if request = '' then
-      OutputError('No REQUEST_METHOD passed from server!')
-   else if request = 'POST' then
-   begin
-      ReadPostQuery;
-      DoPost;
-   end
-   else if request = 'GET' then
-      begin
-         ReadGetQuery;
-	 DoGet;
-      end
-   else
-      OutputError('Invalid REQUEST_METHOD passed from server!');
-end;
-
-function TEZcgi.GetVal(Index : String) : String;
-begin
-   result := FVariables.Values[Index];
-end;
-
-function TEZcgi.GetName(Index : Integer) : String;
-begin
-   result := FVariables.Names[Index];
-end;
-
-function TEZcgi.GetVariable(Index : Integer) : String;
-begin
-   result := FVariables[Index];
-end;
-
-function TEZcgi.GetVarCount : Integer;
-begin
-   result := FVariables.Count;
-end;
-
-procedure TEZcgi.ReadPostQuery;
-var
-   index : Integer;
-   ch : Char;
-   temp : String;
-   code : Word;
-   contentLength : Integer;
-   theType : String;
-      
-begin
-
-   temp := GetVal('CONTENT_LENGTH');
-   if Length(temp) > 0 then
-   begin
-      Val(temp, contentLength, code);
-      if code <> 0 then
-         contentLength := 0;
-   end;
-
-   if contentLength = 0 then
-      OutputError('No content length passed from server!');
-
-   theType := UpperCase(GetVal('CONTENT_TYPE'));
-
-   if theType <> 'APPLICATION/X-WWW-FORM-URLENCODED' then
-      OutputError('No content type passed from server!');
-
-   FQueryString := '';
-
-   for index := 0 to contentLength do
-   begin
-      Read(ch);
-      FQueryString := FQueryString + ch;
-   end;
-
-   GetQueryItems;
-end;
-
-procedure TEZcgi.ReadGetQuery;
-begin
-   FQueryString := GetVal('QUERY_STRING');
-
-   if FQueryString = '' then
-      OutputError('No QUERY_STRING passed from server!');
-
-   GetQueryItems;
-end;
-
-procedure TEZcgi.GetQueryItems;
-var
-   queryItem : String;
-   delimiter : Char;
-
-   function hexConverter(h1, h2 : Char) : Char;
-   var
-      thex : byte;
-   begin
-      tHex := (Pos(upcase(h1), hexTable) - 1) * 16;
-      tHex := tHex + Pos(upcase(h2), hexTable) - 1;
-
-      result := chr(thex);
-   end;
-
-   procedure Convert_ESC_Chars;
-   var
-      index : Integer;
-   begin
-      repeat
-         index := Pos('+', queryItem);
-	 if index > 0 then
-	    queryItem[index] := Chr(32);
-      until index = 0;
-      repeat
-         index := Pos('%', queryItem);
-	 if index > 0 then
-	 begin
-	    queryItem[index] := hexConverter(queryItem[index + 1], queryItem[index + 2]);
-	    system.Delete(queryItem, index + 1, 2);
-	 end;
-      until index = 0;
-   end;
-
-begin
-   InitToken(FQueryString, '&');
-   
-   while NextToken(queryItem, delimiter) do
-   begin
-      if queryItem <> '' then
-      begin
-         Convert_ESC_Chars;
-         FVariables.Add(queryItem);
-      end;
-   end;
-end;
-
-procedure TEZcgi.OutputError(errorMessage : String);
-begin
-   WriteContent('text/html');
-   writeln('<html><head><title>CGI ERROR</title></head>');
-   writeln('<body>');
-   writeln('<center><hr><h1>CGI ERROR</h1><hr></center><br><br>');
-   writeln('This CGI application encountered the following error: <br>');
-   writeln('<ul><br>');
-   writeln('<li> error: ',errorMessage,'<br><hr>'); 
-   writeln('<h5><p><i>Notify ',FName,' <a href="mailto:',FEmail,'">',FEmail,'</a></i></p></h5>');
-   writeln('</body></html>');
-
-   Raise ECGIException.Create(errorMessage);
-end;
-
-procedure TEZcgi.InitToken(aStr, aSep : String);
-begin
-     aString := aStr;
-     aSepStr := aSep;
-     aPos    := 1;
-     aLenStr := Length(aString);
-     aLenSep := Length(aSepStr);
-end;
-
-function TEZcgi.NextToken(var aToken : String; var aSepChar : Char) : Boolean;
-var
-   i : Byte;
-   j : Byte;
-   BoT : Byte;
-   EoT : Byte;
-   isSep : Boolean;
-
-begin
-   BoT := aPos;
-   EoT := aPos;
-   for i := aPos to aLenStr do
-   begin
-      IsSep := false;
-      for j := 1 to aLenSep do
-      begin
-         if aString[i] = aSepStr[j] then
-         begin
-            IsSep := true;
-            Break;
-         end;
-      end;
-      if IsSep then
-      begin
-         EoT  := i;
-         aPos := i + 1;
-         aSepChar := aString[i];
-         Break;
-      end
-      else
-      begin
-         if i = aLenStr then
-         begin
-            EoT  := i;
-            aPos := i;
-            Break;
-         end;
-      end;
-   end;
-   if aPos < aLenStr then
-   begin
-      aToken := Copy(aString, BoT, EoT - BoT);
-      Result := true;
-   end
-   else
-   begin
-      if aPos = aLenStr then
-      begin
-         aToken := Copy(aString, BoT, EoT - BoT + 1);
-         Result := true;
-         aPos   := aPos + 1;
-      end
-      else
-      begin
-         Result := false;
-      end;
-   end;
-end;
-
-end.

fcl/inc/filer.inc

@@ -1,42 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-{ *********************************************************************
-  *                         TFiler                                    *
-  *********************************************************************}
-
-Constructor TFiler.Create(Stream: TStream; BufSize: Integer);
-
-begin
-  FStream:=Stream;
-  GetMem(FBuffer,BufSize);
-  FBufSize:=BufSize;
-end;
-
-
-Destructor TFiler.Destroy;
-
-begin
-  If Assigned(FBuffer) then 
-   FreeMem (FBuffer,FBufSize);
-end;
-
-{
-  $Log$
-  Revision 1.2  1998-08-24 12:38:23  michael
-  small fixes
-
-  Revision 1.1  1998/05/04 14:30:11  michael
-  * Split file according to Class; implemented dummys for all methods, so unit compiles.
-
-}

fcl/inc/filerec.inc

@@ -1,50 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1993,97 by the Free Pascal development team
-
-    FileRec record definition
-
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{
-  This file contains the definition of the filerec record.
-  It is put separately, so it is available outside the system
-  unit without sacrificing TP compatibility.
-}
-
-const
-  filerecnamelength = 255;
-type
-  FileRec = Packed Record
-    Handle,
-    Mode,
-    RecSize   : longint;
-    _private  : array[1..32] of byte;
-    UserData  : array[1..16] of byte;
-    name      : array[0..filerecnamelength] of char;
-  End;
-
-{
-  $Log$
-  Revision 1.1  1999-08-09 16:18:00  michael
-  + Added filerec.inc for xmlread changes by Sebastian guenther
-
-  Revision 1.5  1998/09/14 10:48:15  peter
-    * FPC_ names
-    * Heap manager is now system independent
-
-  Revision 1.4  1998/09/04 18:16:13  peter
-    * uniform filerec/textrec (with recsize:longint and name:0..255)
-
-  Revision 1.3  1998/05/21 11:55:59  carl
-   * works with all OS
-}

fcl/inc/gettext.pp

@@ -1,272 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1998 by the Free Pascal development team
-
-    Gettext interface to resourcestrings.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{$MODE objfpc}
-{$H+}
-
-unit gettext;
-
-interface
-
-uses sysutils, classes;
-
-const
-  MOFileHeaderMagic = $950412de;
-
-type
-
-  TMOFileHeader = packed record
-    magic: LongWord;             // MOFileHeaderMagic
-    revision: LongWord;          // 0
-    nstrings: LongWord;          // Number of string pairs
-    OrigTabOffset: LongWord;     // Offset of original string offset table
-    TransTabOffset: LongWord;    // Offset of translated string offset table
-    HashTabSize: LongWord;       // Size of hashing table
-    HashTabOffset: LongWord;     // Offset of first hashing table entry
-  end;
-
-  TMOStringInfo = packed record
-    length: LongWord;
-    offset: LongWord;
-  end;
-
-  TMOStringTable = array[LongWord] of TMOStringInfo;
-  PMOStringTable = ^TMOStringTable;
-
-
-  TLongWordArray = array[LongWord] of LongWord;
-  PLongWordArray = ^TLongWordArray;
-
-  TPCharArray = array[LongWord] of PChar;
-  PPCharArray = ^TPCharArray;
-
-  TMOFile = class
-  protected
-    HashTableSize: LongWord;
-    HashTable: PLongWordArray;
-    OrigTable, TranslTable: PMOStringTable;
-    OrigStrings, TranslStrings: PPCharArray;
-  public
-    constructor Create(AFilename: String);
-    constructor Create(AStream: TStream);
-    function Translate(AOrig: PChar; ALen: Integer; AHash: LongWord): String;
-    function Translate(AOrig: String; AHash: LongWord): String;
-    function Translate(AOrig: String): String;
-  end;
-
-  EMOFileError = class(Exception)
-  end;
-
-
-  procedure TranslateResourceStrings(AFile: TMOFile);
-  procedure TranslateResourceStrings(AFilename: String);
-
-implementation
-
-uses dos;
-
-constructor TMOFile.Create(AStream: TStream);
-var
-  header: TMOFileHeader;
-  i: Integer;
-  s: String;
-begin
-  inherited Create;
-
-  AStream.Read(header, Sizeof(header));
-
-  if header.magic <> MOFileHeaderMagic then
-    raise EMOFileError.Create('Invalid magic - not a MO file?');
-
-{  WriteLn('Revision: ', header.revision);
-  WriteLn('# of strings: ', header.nstrings);
-  WriteLn('OrigTabOffset: ', header.OrigTabOffset);
-  WriteLn('TransTabOffset: ', header.TransTabOffset);
-  WriteLn('# of hashcodes: ', header.HashTabSize);
-  WriteLn('HashTabOffset: ', header.HashTabOffset);
-}
-  GetMem(OrigTable, header.nstrings * SizeOf(TMOStringInfo));
-  GetMem(TranslTable, header.nstrings * SizeOf(TMOStringInfo));
-  GetMem(OrigStrings, header.nstrings * SizeOf(PChar));
-  GetMem(TranslStrings, header.nstrings * SizeOf(PChar));
-
-
-  AStream.Position := header.OrigTabOffset;
-  AStream.Read(OrigTable^, header.nstrings * SizeOf(TMOStringInfo));
-
-  AStream.Position := header.TransTabOffset;
-  AStream.Read(TranslTable^, header.nstrings * SizeOf(TMOStringInfo));
-
-
-  // Read strings
-  for i := 0 to header.nstrings - 1 do begin
-    AStream.Position := OrigTable^[i].offset;
-    SetLength(s, OrigTable^[i].length);
-    AStream.Read(s[1], OrigTable^[i].length);
-    OrigStrings^[i] := StrNew(PChar(s));
-  end;
-
-  for i := 0 to header.nstrings - 1 do begin
-    AStream.Position := TranslTable^[i].offset;
-    SetLength(s, TranslTable^[i].length);
-    AStream.Read(s[1], TranslTable^[i].length);
-    TranslStrings^[i] := StrNew(PChar(s));
-  end;
-
-  // Read hashing table
-  HashTableSize := header.HashTabSize;
-  GetMem(HashTable, 4 * HashTableSize);
-  AStream.Position := header.HashTabOffset;
-  AStream.Read(HashTable^, 4 * HashTableSize);
-end;
-
-constructor TMOFile.Create(AFilename: String);
-var
-  f: TStream;
-begin
-  f := TFileStream.Create(AFilename, fmOpenRead);
-  try
-    Self.Create(f);
-  finally
-    f.Free;
-  end;
-end;
-
-
-function TMOFile.Translate(AOrig: PChar; ALen: Integer; AHash: LongWord): String;
-var
-  idx, incr, nstr: LongWord;
-begin
-  idx := AHash mod HashTableSize;
-  incr := 1 + (AHash mod (HashTableSize - 2));
-  while True do begin
-    nstr := HashTable^[idx];
-    if nstr = 0 then begin
-      Result := '';
-      exit;
-    end;
-    if (OrigTable^[nstr - 1].length = ALen) and
-       (StrComp(OrigStrings^[nstr - 1], AOrig) = 0) then begin
-      Result := TranslStrings^[nstr - 1];
-      exit;
-    end;
-    if idx >= HashTableSize - incr then
-      Dec(idx, HashTableSize - incr)
-    else
-      Inc(idx, incr);
-  end;
-end;
-
-function TMOFile.Translate(AOrig: String; AHash: LongWord): String;
-begin
-  Result := Translate(PChar(AOrig), Length(AOrig), AHash);
-end;
-
-function TMOFile.Translate(AOrig: String): String;
-begin
-  Result := Translate(AOrig, Hash(AOrig));
-end;
-
-
-// -------------------------------------------------------
-//   Resourcestring translation procedures
-// -------------------------------------------------------
-
-{
-  Define USEITERATOR if you want to translate the strings using
-  the SetResourceStrings call. This is not recommended for this
-  particular iplementation, since we must pass through a global 
-  variable TheFile : TMOFile. However that works too.
-}
-
-{$ifdef USEITERATOR}
-Var 
-  Thefile : TMOFile;
-
-Function Translate (Name,Value : AnsiString; Hash : Longint) : AnsiString;
-
-begin
-  Result:=TheFile.Translate(Value,Hash);
-end;
-
-procedure TranslateResourceStrings(AFile: TMOFile);
-var
-  i,j : Integer;
-  s : String;
-begin
-  TheFile:=AFile;
-  SetResourceStrings(@Translate);
-end;
-{$else}
-
-procedure TranslateResourceStrings(AFile: TMOFile);
-var
-  i,j,count : Integer;
-  s : String;
-begin
-  For I:=0 to ResourceStringTableCount-1 do
-    begin
-    Count:=ResourceStringCount(I);
-    For J:=0 to Count-1 do
-      begin
-      S:=AFile.Translate(GetResourceStringDefaultValue(I,J),
-                         GetResourceStringHash(I,J));
-      if S <> '' then
-        SetResourceStringValue(I,J,S);
-      end;
-    end;
-end;
-{$endif}
-
-procedure TranslateResourceStrings(AFilename: String);
-var
-  mo: TMOFile;
-  lang: String;
-begin
-  lang := Copy(GetEnv('LANG'), 1, 2);
-  try
-    mo := TMOFile.Create(Format(AFilename, [lang]));
-    TranslateResourceStrings(mo);
-    mo.Free;
-  except
-    on e: Exception do;
-  end;
-end;
-
-end.
-
-
-{
-  $Log$
-  Revision 1.5  1999-10-15 19:42:18  michael
-  hash is available in tables
-
-  Revision 1.4  1999/08/28 13:35:16  michael
-  * Uses now hash function of objpas
-
-  Revision 1.3  1999/08/27 15:53:36  michael
-  + Adapted to new resourcestring mechanism. Uses objpas interface only
-
-  Revision 1.2  1999/08/26 11:05:15  peter
-    * updated for new resourcestrings
-
-  Revision 1.1  1999/08/04 11:31:09  michael
-  * Added gettext
-
-  Revision 1.1  1999/07/25 16:23:31  michael
-  + Initial implementation from Sebastian Guenther
-
-}

fcl/inc/idea.pp

@@ -1,410 +0,0 @@
-UNIT IDEA;
-
-{
- IDEA encryption routines for pascal
- ported from PGP 2.3
-
- IDEA encryption routines for pascal, ported from PGP 2.3
- Copyright (C) for this port 1998 Ingo Korb
- Copyright (C) for the stream support 1999 Michael Van Canneyt
-
- 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 library 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., 675 Mass Ave, Cambridge, MA 02139, USA.
-}
-
-
-{$R-,Q-}
-{ Not nice but fast... }
-
-INTERFACE
-
-Uses Sysutils,Classes;
-
-CONST IDEAKEYSIZE = 16;
-      IDEABLOCKSIZE = 8;
-      ROUNDS = 8;
-      KEYLEN = (6*ROUNDS+4);
-
-TYPE IDEAkey = ARRAY[0..keylen-1] OF Word;
-     ideacryptkey = ARRAY[0..7] OF Word;
-     ideacryptdata = ARRAY[0..3] OF Word;
-
-PROCEDURE EnKeyIdea(userkey: ideacryptkey; VAR z: ideakey);
-PROCEDURE DeKeyIdea(z: IDEAKey; VAR dk: ideakey);
-PROCEDURE CipherIdea(input: ideacryptdata; VAR out: ideacryptdata; z: IDEAkey);
-
-Type  
-
-EIDEAError = Class(EStreamError);
-
-TIDEAEncryptStream = Class(TStream)
-  private
-    FDest : TStream;
-    FKey : IDEAKey;
-    FData : IDEACryptData;
-    FBufpos : Byte;
-    FPos : Longint;
-  public
-    constructor Create(AKey : ideakey; Dest: TStream);
-    destructor Destroy; override;
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    procedure Flush;
-    Property Key : IDEAKey Read FKey;
-  end;
-
-TIDEADeCryptStream = Class(TStream)
-  private
-    FSRC : TStream;
-    FKey : IDEAKey;
-    FData : IDEACryptData;
-    FBufpos : Byte;
-    FPos : Longint;
-  public
-    constructor Create(AKey : ideakey; Src: TStream);
-    destructor Destroy; override;
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    Property Key : IDEAKey Read FKey;
-  end;
-
-IMPLEMENTATION
-
-Const 
-  SNoSeekAllowed = 'Seek not allowed on encryption streams';
-  SNoReadAllowed = 'Reading from encryption stream not allowed';
-  SNoWriteAllowed = 'Writing to decryption stream not allowed';
-
-Type 
-  PByte = ^Byte;
-
-PROCEDURE mul(VAR a:Word; b: Word);
-VAR p: LongInt;
-BEGIN
-  IF (a <> 0) THEN BEGIN
-    IF (b <> 0) THEN BEGIN
-      p := LongInt(a)*b;
-      b := p;
-      a := p SHR 16;
-      IF (b < a) THEN a := b - a + 1
-                 ELSE a := b - a;
-    END ELSE a := 1 - a;
-  END ELSE a := 1-b;
-END;
-
-FUNCTION inv(x: word): Word;
-VAR t0,t1,q,y: Word;
-BEGIN
-  IF x <= 1 THEN BEGIN
-    inv := x;
-    exit;
-  END;
-  t1 := 65537 DIV x;
-  y := 65537 MOD x;
-  IF y = 1 THEN BEGIN
-    inv := Word(1-t1);
-    exit;
-  END;
-  t0 := 1;
-  REPEAT
-    q := x DIV y;
-    x := x MOD y;
-    t0 := t0 + q * t1;
-    IF x = 1 THEN BEGIN
-      inv := t0;
-      exit;
-    END;
-    q := y DIV x;
-    y := y MOD x;
-    t1 := t1 + q*t0;
-  UNTIL y = 1;
-  inv := word(1-t1);
-END;
-
-PROCEDURE EnKeyIdea(userkey: ideacryptkey; VAR z: ideakey);
-VAR zi,i,j: integer;
-BEGIN
-  FOR j := 0 TO 7 DO z[j] := userkey[j];
-  i := 0;
-  zi := 0;
-  i := 0;
-  FOR j := 8 TO keylen-1 DO BEGIN
-    Inc(i);
-    z[zi+i+7] := (z[zi+(i AND 7)] SHL 9) OR (z[zi+((i+1) AND 7)] SHR 7);
-    zi := zi + (i AND 8);
-    i := i AND 7;
-  END;
-  FOR i := 0 TO 7 DO userkey[i] := 0;
-  zi := 0;
-END;
-
-PROCEDURE DeKeyIdea(z: IDEAKey; VAR dk: ideakey);
-VAR j: Integer;
-    t1,t2,t3: Word;
-    p: IDEAKey;
-    ip,it,idk: Integer;
-    iz: Integer;
-BEGIN
-  iz := 0;
-  ip := keylen;
-  FOR j := 0 TO keylen - 1 DO p[j] := 0;
-  idk := 0;
-  t1 := inv(z[iz]);   Inc(iz);
-  t2 := not(z[iz])+1; Inc(iz);
-  t3 := not(z[iz])+1; Inc(iz);
-  Dec(ip); p[ip] := inv(z[iz]); Inc(iz);
-  Dec(ip); p[ip] := t3;
-  Dec(ip); p[ip] := t2;
-  Dec(ip); p[ip] := t1;
-  FOR j := 1 TO rounds-1 DO BEGIN
-    t1 := z[iz]; Inc(iz);
-    Dec(ip); p[ip] := z[iz]; Inc(iz);
-    Dec(ip); p[ip] := t1;
-    t1 := inv(z[iz]);   Inc(iz);
-    t2 := Not(z[iz])+1; Inc(iz);
-    t3 := Not(z[iz])+1; Inc(iz);
-    Dec(ip); p[ip] := inv(z[iz]); Inc(iz);
-    Dec(ip); p[ip] := t2;
-    Dec(ip); p[ip] := t3;
-    Dec(ip); p[ip] := t1;
-  END;
-  t1 := z[iz]; Inc(iz);
-  Dec(ip); p[ip] := z[iz]; Inc(iz);
-  Dec(ip); p[ip] := t1;
-  t1 := inv(z[iz]);   Inc(iz);
-  t2 := Not(z[iz])+1; Inc(iz);
-  t3 := Not(z[iz])+1; Inc(iz);
-  Dec(ip); p[ip] := inv(z[iz]); Inc(iz);
-  Dec(ip); p[ip] := t3;
-  Dec(ip); p[ip] := t2;
-  Dec(ip); p[ip] := t1;
-  FOR j := 0 TO KeyLen-1 DO BEGIN
-    dk[j] := p[j];
-    p[j] := 0;
-  END;
-  FOR j := 0 TO 51 DO z[j] := 0;
-  t1 := 0;
-  t2 := 0;
-  t3 := 0;
-  ip := 0;
-  it := 0;
-  idk := 0;
-  iz := 0;
-END;
-
-PROCEDURE CipherIdea(input: ideacryptdata; VAR out: ideacryptdata; z:
-IDEAkey);
-VAR x1, x2, x3, x4, t1, t2: Word;
-    r: Integer;
-    zi: Integer;
-BEGIN
-  zi := 0;
-  x1 := input[0];
-  x2 := input[1];
-  x3 := input[2];
-  x4 := input[3];
-  FOR r := 1 TO ROUNDS DO BEGIN
-    mul(x1,z[zi]);    Inc(zi);
-    x2 := x2 + z[zi]; Inc(zi);
-    x3 := x3 + z[zi]; Inc(zi);
-    mul(x4, z[zi]);   Inc(zi);
-    t2 := x1 XOR x3;
-    mul(t2, z[zi]);   Inc(zi);
-    t1 := t2 + (x2 XOR x4);
-    mul(t1, z[zi]);   Inc(zi);
-    t2 := t1+t2;
-    x1 := x1 XOR t1;
-    x4 := x4 XOR t2;
-    t2 := t2 XOR x2;
-    x2 := x3 XOR t1;
-    x3 := t2;
-  END;
-  mul(x1, z[zi]);       Inc(zi);
-  out[0] := x1;
-  out[1] := x3 + z[zi]; Inc(zi);
-  out[2] := x2 + z[zi]; Inc(zi);
-  Mul(x4,z[zi]);
-  out[3] := x4;
-  FOR r := 0 TO 3 DO input[r] := 0;
-  FOR r := 0 TO 51 DO z[r] := 0;
-  x1 := 0;
-  x2 := 0;
-  x3 := 0;
-  x4 := 0;
-  t1 := 0;
-  t2 := 0;
-  zi := 0;
-END;
-
-constructor TIDEAEncryptStream.Create(AKey : ideakey; Dest: TStream);
-
-begin
-  FKey:=Key;
-  FDest:=Dest;
-  FBufPos:=0;
-  Fpos:=0;
-end;
-
-Destructor TIDEAEncryptStream.Destroy; 
-
-
-begin
-  Flush;
-  Inherited Destroy;
-end;
-
-Procedure TIDEAEncryptStream.Flush;
-
-Var
-  OutData : IdeaCryptData;
-  
-begin
-  If FBufPos>0 then
-    begin 
-    // Fill with spaces.
-    FillChar(PByte(@FData)[FBufPos],SizeOf(FData)-FBufPos,' ');
-    CipherIdea(Fdata,OutData,FKey);
-    FDest.Write(OutData,SizeOf(OutData));
-    end;
-end;
-
-function TIDEAEncryptStream.Read(var Buffer; Count: Longint): Longint; 
-
-begin
-  Raise EIDEAError.Create(SNoReadAllowed);
-end;
-
-function TIDEAEncryptStream.Write(const Buffer; Count: Longint): Longint; 
-
-Var 
-  mvsize : Longint;
-  OutData : IDEAcryptdata;
-
-begin
-  Result:=0;
-  While Count>0 do
-    begin
-    MVsize:=Count;
-    If Mvsize>SizeOf(Fdata)-FBufPos then
-      mvsize:=SizeOf(FData)-FBufPos;
-    Move(Pbyte(@Buffer)[Result],PByte(@FData)[FBufPos],MVSize);
-    If FBufPos+mvSize=Sizeof(FData) then
-      begin
-      // Empty buffer.
-      CipherIdea(Fdata,OutData,FKey);
-      // this will raise an exception if needed.
-      FDest.Writebuffer(OutData,SizeOf(OutData));
-      FBufPos:=0;
-      end
-    else
-      inc(FBufPos,mvsize);
-    Dec(Count,MvSize);
-    Inc(Result,mvSize);
-    end;
-  Inc(FPos,Result);
-end;
-
-
-function TIDEAEncryptStream.Seek(Offset: Longint; Origin: Word): Longint; 
-
-begin
-  if (Offset = 0) and (Origin = soFromCurrent) then
-    Result := FPos
-  else
-    Raise EIDEAError.Create(SNoSeekAllowed);
-end;
-
-constructor TIDEADeCryptStream.Create(AKey : ideakey; Src: TStream);
-
-begin
-  inherited Create;
-  FKey:=Key;
-  FPos:=0;
-  FBufPos:=SizeOf(Fdata);
-  FSrc:=Src;
-end;
-
-destructor TIDEADeCryptStream.Destroy; 
-begin
-  Inherited destroy;
-end;
-
-function TIDEADeCryptStream.Read(var Buffer; Count: Longint): Longint; 
-  
-Var 
-  mvsize : Longint;
-  InData : IDEAcryptdata;
-
-begin
-  Result:=0;
-  While Count>0 do
-    begin
-    // Empty existing buffer.
-    If FBufPos<SizeOf(FData) then
-      begin
-      mvSize:=Sizeof(FData)-FBufPos;
-      If MvSize>count then 
-        mvsize:=Count;
-      Move(PByte(@FData)[FBufPos],Pbyte(@Buffer)[Result],MVSize);
-      Dec(Count,mvsize);
-      Inc(Result,mvsize);
-      inc(fBufPos,mvsize);
-      end;
-    // Fill buffer again if needed.  
-    If (FBufPos=SizeOf(FData)) and (Count>0) then
-      begin
-      mvsize:=FSrc.Read(InData,SizeOf(InData));
-      If mvsize>0 then
-        begin
-        If MvSize<SizeOf(InData) Then
-          // Fill with spaces
-          FillChar(PByte(@InData)[mvsize],SizeOf(InData)-mvsize,' ');
-        CipherIdea(InData,FData,FKey);
-        FBufPos:=0;
-        end
-      else
-        Count:=0; // No more data available from stream; st
-      end;
-    end;
-  Inc(FPos,Result);
-end;
-
-function TIDEADeCryptStream.Write(const Buffer; Count: Longint): Longint; 
-begin
-  Raise EIDEAError.Create(SNoReadAllowed);
-end;
-
-function TIDEADeCryptStream.Seek(Offset: Longint; Origin: Word): Longint; 
-
-Var Buffer : Array[0..1023] of byte;
-    i : longint;
-    
-begin
-  // Fake seek if possible by reading and discarding bytes.
-  If ((Offset>=0) and (Origin = soFromCurrent)) or
-    ((Offset>FPos) and (Origin = soFromBeginning)) then
-      begin
-      For I:=1 to (Offset div SizeOf(Buffer)) do
-        ReadBuffer(Buffer,SizeOf(Buffer));
-      ReadBuffer(Buffer,Offset mod SizeOf(Buffer));
-      Result:=FPos;
-      end
-  else             
-    Raise EIDEAError.Create(SNoSeekAllowed);
-end;
-
-END.
-

fcl/inc/inifiles.pp

@@ -1,502 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by Michael A. Hess
-
-    adapted from code by Stephan Schneider
-
-    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.
-
- **********************************************************************}
-
-unit IniFiles;
-
-{$mode objfpc}
-{$H+}
-
-interface
-
-uses Classes;
-
-type
-
-{ TIniFile class }
-
-   TIniFile = class(TObject)
-   private
-     FFileName   : string;
-     FStream     : TStream;
-     FFileBuffer : TStringList;
-     function GetName(const line : string) : string;
-     function GetValue(const line, name : string) : string;
-     function IsComment(const line : string) : boolean;
-     function IsSection(const line : string) : boolean;
-     function GetSectionIndex(const section : string) : integer;
-   protected
-     procedure SetFileName(const fn:string);
-     procedure SetStream(s:TStream);
-     procedure LoadFromFile;
-     procedure SaveToFile;
-     procedure LoadFromStream;
-     procedure SaveToStream;
-   public
-     constructor Create(const theFileName : string);
-     constructor Create(s:TStream);
-     destructor Destroy; override;
-     procedure DeleteKey(const section, ident : string);
-     procedure EraseSection(const section : string);
-     function ReadBool(const section, ident : string; defaultValue : boolean) : boolean;
-     function ReadInteger(const section, ident : string; defaultValue : longint) : longint;
-     procedure ReadSection(const section : string; strings : TStrings);
-     procedure ReadSections(strings : TStrings);
-     procedure ReadSectionValues(const section : string; strings : TStrings);
-     procedure ReadSectionRaw(const section : string; strings : TStrings);
-     function ReadString(const section, ident, defaultValue : string) : string;
-     procedure WriteBool(const section, ident : string; value : boolean);
-     procedure WriteInteger(const section, ident : string; value : longint);
-     procedure WriteString(const section, ident, value : string);
-     property FileName : String read FFileName;
-   end;
-
-implementation
-
-uses SysUtils;
-
-const
-   brackets  : array[0..1] of Char = ('[', ']');
-   separator : Char = '=';
-   comment   : Char = ';';
-
-
-{ TIniFile }
-
-constructor TIniFile.Create(const theFileName : string);
-begin
-   FFileName := theFileName;
-   FStream:=nil;
-   FFileBuffer := TStringList.Create;
-
-   if FileExists(fileName) then
-      LoadFromFile;
-end;
-
-constructor TIniFile.Create(s:TStream);
-begin
-   FFileName := '';
-   FStream:=s;
-   FFileBuffer := TStringList.Create;
-
-   LoadFromStream;
-end;
-
-destructor TIniFile.Destroy;
-begin
-   FFileBuffer.Free;
-end;
-
-function TIniFile.GetName(const line : string) : string;
-var
-   index,index2 : integer;
-begin
-   Result := '';
-   index := Pos(separator, line);
-   if index <> 0 then
-    begin
-      index2:=Pos(comment, line);
-      if (index2=0) or (index2>index) then
-       result := Trim(Copy(line, 1, index - 1));
-    end;
-end;
-
-function TIniFile.GetValue(const line, name : string) : string;
-var
-   index1,index2,index3 : integer;
-begin
-   result := '';
-   if (line <> '') and (name <> '') then
-   begin
-      index1 := Pos(name, line);
-      index2 := Pos(separator, line);
-      index3 := Pos(comment, line);
-      if index3=0 then
-       index3:=MaxInt;
-      if (index1 <> 0) and (index2 <> 0) and (index2 > index1) then
-         result := Trim(Copy(line, index2 + 1, index3));
-   end;
-end;
-
-function TIniFile.IsSection(const line : string) : boolean;
-var
-   str : string;
-begin
-   result := False;
-   if line <> '' then
-   begin
-      str := Trim(line);
-      if (str[1] = brackets[0]) and (str[Length(str)] = brackets[1]) then
-         result := True;
-   end;
-end;
-
-function TIniFile.IsComment(const line : string) : boolean;
-var
-   str : string;
-begin
-   result := False;
-   if line <> '' then
-   begin
-      str := Trim(line);
-      result := (str[1]=comment);
-   end;
-end;
-
-function TIniFile.GetSectionIndex(const section : string) : integer;
-begin
-   result := FFileBuffer.IndexOf(brackets[0] + section + brackets[1]);
-end;
-
-{ Load/Save }
-
-procedure TIniFile.SetFileName(const fn:string);
-begin
-  FFileName:=fn;
-end;
-
-procedure TIniFile.SetStream(s:TStream);
-begin
-  FStream:=s;
-end;
-
-procedure TIniFile.LoadFromFile;
-begin
-  if FFileName<>'' then
-   FFileBuffer.LoadFromFile(FFileName);
-end;
-
-procedure TIniFile.SaveToFile;
-begin
-  if FFileName<>'' then
-   FFileBuffer.SaveToFile(FFileName);
-end;
-
-procedure TIniFile.LoadFromStream;
-begin
-  if assigned(FStream) then
-   FFileBuffer.LoadFromStream(FStream);
-end;
-
-procedure TIniFile.SaveToStream;
-begin
-  if assigned(FStream) then
-   FFileBuffer.SaveToStream(FStream);
-end;
-
-{ Read all Names of one Section }
-
-procedure TIniFile.ReadSection(const section : string; strings : TStrings);
-var
-   index : integer;
-   name : string;
-begin
-   strings.BeginUpdate;
-   try
-      strings.Clear;
-      if FFileBuffer.Count > 0 then
-      begin
-         index := GetSectionIndex(section);
-         if index <> -1 then
-         begin
-            Inc(index);
-            while (index < FFileBuffer.Count) and not IsSection(FFileBuffer[index]) do
-            begin
-               name := GetName(FFileBuffer[index]);
-               if name <> '' then
-                  strings.Add(name);
-               Inc(index);
-            end;
-         end;
-      end;
-   finally
-      strings.EndUpdate;
-   end;
-end;
-
-{ Read all Sections of the Ini-File }
-
-procedure TIniFile.ReadSections(strings : TStrings);
-var
-   index : integer;
-   section : string;
-begin
-   strings.BeginUpdate;
-   try
-      strings.Clear;
-      if FFileBuffer.Count > 0 then
-      begin
-         index := 0;
-         while (index < FFileBuffer.Count) do
-         begin
-            if IsSection(FFileBuffer[index]) then
-            begin
-               section := Trim(FFileBuffer[index]);
-               Delete(section, 1, 1);
-               Delete(section, Length(section), 1);
-               strings.Add(Trim(section));
-            end;
-            Inc(index);
-         end;
-      end;
-   finally
-      strings.EndUpdate;
-   end;
-end;
-
-{ Reads a String-Value of "ident" in one "section".
-  The result is "defaultValue" if
-  o section doesn't exists
-  o ident doesn't exists
-  o ident doesn't have any assigned value }
-
-function TIniFile.ReadString(const section, ident, defaultValue : string) : string;
-var
-   index : integer;
-   value : string;
-begin
-   result := defaultValue;
-   if FFileBuffer.Count > 0 then
-   begin
-      index := GetSectionIndex(section);
-      if index <> -1 then
-      begin
-         Inc(index);
-         while (index < FFileBuffer.Count) and not IsSection(FFileBuffer[index]) do
-         begin
-            if GetName(FFileBuffer[index]) = ident then
-            begin
-              value := GetValue(FFileBuffer[index], ident);
-              if value <> '' then
-               begin
-                 result := value;
-                 if (result[length(result)]='\') then
-                  begin
-                    inc(index);
-                    while (index < FFileBuffer.Count) and (result[length(result)]='\') do
-                     begin
-                       result:=Copy(result,1,length(result)-1)+Trim(FFileBuffer[index]);
-                       inc(index);
-                     end;
-                  end;
-               end;
-              break;
-            end;
-            Inc(index);
-         end;
-      end;
-   end;
-end;
-
-{ Reads an Integer-Value of Ident in one Section }
-
-function TIniFile.ReadInteger(const section, ident : string; defaultValue : longint) : longint;
-var
-   intStr : string;
-begin
-   intStr := ReadString(section, ident, '');
-   { convert a Hex-Value }
-   if (Length(intStr) > 2) and (intStr[1] = '0') and ((intStr[2] = 'X') or (intStr[2] = 'x')) then
-      intStr := '$' + Copy(intStr, 3, Maxint);
-   result := StrToIntDef(intStr, defaultValue);
-end;
-
-{ Reads a Bool-Value of Ident in one Section }
-
-function TIniFile.ReadBool(const section, ident : string; defaultValue : boolean) : boolean;
-begin
-   result := ReadInteger(section, ident, Ord(defaultValue)) <> 0;
-end;
-
-{ Reads all Names + Values of one Section }
-
-procedure TIniFile.ReadSectionValues(const section : string; strings : TStrings);
-var
-   name : string;
-   value : string;
-   index : integer;
-begin
-   strings.BeginUpdate;
-   try
-      strings.Clear;
-      if FFileBuffer.Count > 0 then
-      begin
-         index := GetSectionIndex(section);
-         if index <> -1 then
-         begin
-            Inc(index);
-            while (index < FFileBuffer.Count) and not IsSection(FFileBuffer[index]) do
-            begin
-               name := GetName(FFileBuffer[index]);
-               if name <> '' then
-               begin
-                  value := GetValue(FFileBuffer[index], name);
-                  strings.Add(name + separator + value);
-               end;
-               Inc(index);
-            end;
-         end;
-      end;
-   finally
-      strings.EndUpdate;
-   end;
-end;
-
-procedure TIniFile.ReadSectionRaw(const section : string; strings : TStrings);
-var
-   eols,index : integer;
-begin
-   strings.BeginUpdate;
-   try
-      eols:=0;
-      strings.Clear;
-      if FFileBuffer.Count > 0 then
-      begin
-         index := GetSectionIndex(section);
-         if index <> -1 then
-         begin
-            Inc(index);
-            while (index < FFileBuffer.Count) and not IsSection(FFileBuffer[index]) do
-             begin
-               { Skip empty lines at the end of the section }
-               if FFileBuffer[index]='' then
-                inc(eols)
-               else
-                begin
-                  while eols>0 do
-                   begin
-                     Strings.Add('');
-                     dec(eols);
-                   end;
-                  if not IsComment(FFileBuffer[index]) then
-                   strings.Add(FFileBuffer[index]);
-                end;
-               Inc(index);
-             end;
-         end;
-      end;
-   finally
-      strings.EndUpdate;
-   end;
-end;
-
-{ Writes a String-Value for Ident in one Section.
-  Note: If Section and/or Ident don't exist, they will be placed in the Ini-File }
-
-procedure TIniFile.WriteString(const section, ident, value : string);
-var
-   index : integer;
-begin
-   index := GetSectionIndex(section);
-   { Section exists }
-   if index <> -1 then
-   begin
-      Inc(index);
-      while (index < FFileBuffer.Count) and not IsSection(FFileBuffer[index]) and
-            (GetName(FFileBuffer[index]) <> ident) do
-         Inc(index);
-      if (index >= FFileBuffer.Count) or IsSection(FFileBuffer[index]) then
-      begin         { End of File or ident doesn't exists in the section }
-         if ident <> '' then
-            FFileBuffer.Insert(index, ident + separator + value);
-      end
-      else if ident <> '' then   { Ident does exists in the section }
-         FFileBuffer[index] := ident + separator + value;
-   end
-   else   { section doesn't exists, so add new [section] with ident=value }
-   begin
-      FFileBuffer.Add('');
-      FFileBuffer.Add(brackets[0] + section + brackets[1]);
-      if ident <> '' then
-         FFileBuffer.Add(ident + separator + value);
-   end;
-   SaveToFile;
-end;
-
-{ Writes an Integer-Value for Ident in one Section }
-
-procedure TIniFile.WriteInteger(const section, ident : string; value : longint);
-begin
-   WriteString(section, ident, IntToStr(value));
-end;
-
-{ Writes a Bool-Value for Ident in one Section }
-
-procedure TIniFile.WriteBool(const section, ident : string; value : boolean);
-const
-   values: array[boolean] of string = ('0', '1');
-begin
-   WriteString(section, ident, values[Value]);
-end;
-
-{ Deletes the value of ident in one section.
-  Note: Only if section and ident exist, the value of ident will be set to NULL }
-
-procedure TIniFile.DeleteKey(const section, ident : string);
-var
-   index : integer;
-begin
-   index := GetSectionIndex(section);
-   if index <> -1 then
-   begin
-      Inc(index);
-      while (index < FFileBuffer.Count) and not IsSection(FFileBuffer[index]) and
-            (GetName(FFileBuffer[index]) <> ident) do
-         Inc(index);
-      if not (index >= FFileBuffer.Count) and not IsSection(FFileBuffer[index]) then
-      begin         { Ident does exists }
-         FFileBuffer.Delete(index);
-         SaveToFile;
-      end;
-   end;
-end;
-
-{ Erases the whole Section from an Ini-File }
-
-procedure TIniFile.EraseSection(const section : string);
-var
-   index : integer;
-begin
-   index := GetSectionIndex(section);
-   if index <> -1 then
-   begin
-      FFileBuffer.Delete(index);           { Delete Section-Header }
-      while (index < FFileBuffer.Count) and not IsSection(FFileBuffer[index]) do
-         FFileBuffer.Delete(index);        { Delete Section-Items }
-      if index > 0 then FFileBuffer.Insert(index, '');
-    SaveToFile;
-  end;
-end;
-
-end.
-
-{
-  $Log$
-  Revision 1.5  1999-11-23 09:50:51  peter
-    * load/save stream support
-
-  Revision 1.4  1999/11/08 15:01:38  peter
-    * fpcmake support
-
-  Revision 1.3  1999/11/02 23:58:37  peter
-    * comment support
-    * readsectionraw method
-
-  Revision 1.2  1999/04/29 16:21:54  michael
-  + Default mode Hugestrings
-
-  Revision 1.1  1999/04/08 15:44:10  michael
-  + Donated by Michael A. Hess
-
-  Initial Release 1999/04/07 MAH
-
-}

fcl/inc/iostream.pp

@@ -1,96 +0,0 @@
-unit iostream;
-
-Interface
-
-Uses Classes;
-
-Type
-
-  TiosType = (iosInput,iosOutPut,iosError); 
-  EIOStreamError = Class(EStreamError);
-  
-  TIOStream = Class(THandleStream)
-    Private
-      FType,
-      FPos : Longint;
-    Public
-      Constructor Create(IOSType : TiosType);
-      Function Read(var Buffer; Count: Longint): Longint;override;
-      Function Write(const Buffer; Count: Longint): Longint;override;
-      Procedure SetSize(NewSize: Longint); override;
-      Function Seek(Offset: Longint; Origin: Word): Longint; override;
-   end;
-
-Implementation
-
-Const
-  SReadOnlyStream = 'Cannot write to an input stream.';
-  SWriteOnlyStream = 'Cannot read from an output stream.';
-  SInvalidOperation = 'Cannot perform this operation on a IOStream.';
-  
-Constructor TIOStream.Create(IOSType : TiosType);
-
-begin
-  FType:=Ord(IOSType);
-  Inherited Create(Ftype);
-end;
-
-
-Function TIOStream.Read(var Buffer; Count: Longint): Longint;
-
-begin
-  If Ftype>0 then
-    Raise EIOStreamError.Create(SWriteOnlyStream)
-  else
-    begin
-    Result:=Inherited Read(Buffer,Count);
-    Inc(FPos,Result);
-    end;
-end;
-
-
-Function TIOStream.Write(const Buffer; Count: Longint): Longint;
-
-begin
-  If Ftype=0 then
-    Raise EIOStreamError.Create(SReadOnlyStream)
-  else
-    begin
-    Result:=Inherited Write(Buffer,Count);
-    Inc(FPos,Result);
-    end;
-end;
-
-
-Procedure TIOStream.SetSize(NewSize: Longint); 
-
-begin
-  Raise EIOStreamError.Create(SInvalidOperation);
-end;
-
-
-Function TIOStream.Seek(Offset: Longint; Origin: Word): Longint; 
-
-Const BufSize = 100;
-
-Var Buf : array[1..BufSize] of Byte;
-
-begin
-  If (Origin=soFromCurrent) and (Offset=0) then
-     result:=FPos;
-  { Try to fake seek by reading and discarding }
-  if (Ftype>0) or
-     Not((Origin=soFromCurrent) and (Offset>=0) or  
-         ((Origin=soFrombeginning) and (OffSet>=FPos))) then 
-     Raise EIOStreamError.Create(SInvalidOperation);
-  if Origin=soFromBeginning then
-    Dec(Offset,FPos);
-  While ((Offset Div BufSize)>0) 
-        and (Read(Buf,SizeOf(Buf))=BufSize) do
-     Dec(Offset,BufSize);
-  If (Offset>0) then
-    Read(Buf,BufSize);
-  Result:=FPos;   
-end;
-
-end.

fcl/inc/lists.inc

@@ -1,404 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{****************************************************************************}
-{*                             TList                                        *}
-{****************************************************************************}
-
-{  TList = class(TObject)
-  private
-    FList: PPointerList;
-    FCount: Integer;
-    FCapacity: Integer;
-}
-Const
-  // Ratio of Pointer and Word Size.
-  WordRatio = SizeOf(Pointer) Div SizeOf(Word);
-
-function TList.Get(Index: Integer): Pointer;
-
-begin
-  If (Index<0) or (Index>FCount) then
-    Error(SListIndexError,Index);
-  Result:=FList^[Index];
-end;
-
-
-
-procedure TList.Grow;
-
-begin
-  // Only for compatibility with Delphi. Not needed.
-end;
-
-
-
-procedure TList.Put(Index: Integer; Item: Pointer);
-
-begin
-  if (Index<0) or (Index>=FCount) then
-    Error(SListIndexError,Index);
-  Flist^[Index]:=Item;
-end;
-
-
-
-procedure TList.SetCapacity(NewCapacity: Integer);
-
-Var NewList,ToFree : PPointerList;
-
-begin
-  If (NewCapacity<0) or (NewCapacity>MaxListSize) then
-     Error (SListCapacityError,NewCapacity);
-  If NewCapacity>FCapacity then
-    begin
-    GetMem (NewList,NewCapacity*SizeOf(Pointer));
-    If NewList=Nil then
-      //!! Find another one here !!
-      Error (SListCapacityError,NewCapacity);
-    If Assigned(FList) then
-      begin
-      System.Move (FList^,NewList^,FCapacity*Sizeof(Pointer));
-      FillWord (NewList^[FCapacity],(NewCapacity-FCapacity)*WordRatio, 0);
-      FreeMem (Flist,FCapacity*SizeOf(Pointer));
-      end;
-    Flist:=NewList;
-    FCapacity:=NewCapacity;
-    end
-  else if NewCapacity<FCapacity then
-    begin
-    If NewCapacity<0 then
-      Error (SListCapacityError,NEwCapacity);
-    ToFree:=Flist+NewCapacity*SizeOf(Pointer);
-    FreeMem (ToFree, (FCapacity-NewCapacity)*SizeOf(Pointer));
-    FCapacity:=NewCapacity;
-    end;
-end;
-
-
-
-procedure TList.SetCount(NewCount: Integer);
-
-begin
-  If (NewCount<0) or (NewCount>MaxListSize)then
-    Error(SListCountError,NewCount);
-  If NewCount<FCount then
-    FCount:=NewCount
-  else If NewCount>FCount then
-    begin
-    If NewCount>FCapacity then
-      SetCapacity (NewCount);
-    If FCount<NewCount then
-      FillWord (Flist^[FCount],(NewCount-FCount)* WordRatio ,0);
-    FCount:=Newcount;
-    end;
-end;
-
-
-
-destructor TList.Destroy;
-
-begin
-  Self.Clear;
-  inherited Destroy;
-end;
-
-
-Function TList.Add(Item: Pointer): Integer;
-
-begin
-  Self.Insert (Count,Item);
-  Result:=Count-1;
-end;
-
-
-
-Procedure TList.Clear;
-
-begin
-  If Assigned(FList) then
-    begin
-    FreeMem (Flist,FCapacity*SizeOf(Pointer));
-    FList:=Nil;
-    FCapacity:=0;
-    FCount:=0;
-    end;
-end;
-
-
-
-Procedure TList.Delete(Index: Integer);
-
-begin
-  If (Index<0) or (Index>=FCount) then
-    Error (SListIndexError,Index);
-  FCount:=FCount-1;
-  System.Move (FList^[Index+1],FList^[Index],(FCount-Index)*SizeOf(Pointer));
-end;
-
-
-class procedure TList.Error(const Msg: string; Data: Integer);
-
-begin
-  //!! Find a way to get call  address
-  Raise EListError.CreateFmt(Msg,[Data]);
-end;
-
-procedure TList.Exchange(Index1, Index2: Integer);
-
-var Temp : Pointer;
-
-begin
-  If ((Index1>=FCount) or (Index1<0)) then
-    Error(SListIndexError,Index1);
-  If ((Index2>=FCount) or (Index2<0)) then
-    Error(SListIndexError,Index2);
-  Temp:=FList^[Index1];
-  FList^[Index1]:=FList^[Index2];
-  FList^[Index2]:=Temp;
-end;
-
-
-
-function TList.Expand: TList;
-
-Var IncSize : Longint;
-
-begin
-  if FCount<FCapacity then exit;
-  IncSize:=4;
-  if FCapacity>3 then IncSize:=IncSize+4;
-  if FCapacity>8 then IncSize:=IncSize+8;
-  SetCapacity(FCapacity+IncSize);
-  Result:=Self;
-end;
-
-
-function TList.First: Pointer;
-
-begin
-  If FCount=0 then 
-    Result:=Nil
-  else
-    Result:=Items[0];
-end;
-
-
-
-function TList.IndexOf(Item: Pointer): Integer;
-
-begin
-  Result:=0;
-  While (Result<FCount) and (Flist^[Result]<>Item) do Result:=Result+1;
-  If Result=FCount  then Result:=-1;
-end;
-
-
-
-procedure TList.Insert(Index: Integer; Item: Pointer);
-
-begin
-  If (Index<0) or (Index>FCount )then
-    Error(SlistIndexError,Index);
-  IF FCount=FCapacity Then Self.Expand;
-  If Index<FCount then
-    System.Move (Flist^[Index],Flist^[Index+1],(FCount-Index)*SizeOf(Pointer));
-  FList^[Index]:=Item;
-  FCount:=FCount+1;
-end;
-
-
-
-function TList.Last: Pointer;
-
-begin
-  // Wouldn't it be better to return nil if the count is zero ?
-  If FCount=0 then 
-    Result:=Nil
-  else
-    Result:=Items[FCount-1];
-end;
-
-
-procedure TList.Move(CurIndex, NewIndex: Integer);
-
-Var Temp : Pointer;
-
-begin
-  If ((CurIndex<0) or (CurIndex>Count-1)) then
-    Error(SListIndexError,CurIndex);
-  If (NewINdex<0) then
-    Error(SlistIndexError,NewIndex);
-  Temp:=FList^[CurIndex];
-  Self.Delete(CurIndex);
-  // ?? If NewIndex>CurIndex then NewIndex:=NewIndex-1;
-  // Newindex changes when deleting ??
-  Self.Insert (NewIndex,Temp);
-end;
-
-
-function TList.Remove(Item: Pointer): Integer;
-
-begin
-  Result:=IndexOf(Item);
-  If Result<>-1 then
-    Self.Delete (Result);
-end;
-
-
-
-Procedure TList.Pack;
-
-Var  {Last,I,J,}Runner : Longint;
-
-begin
-  // Not the fastest; but surely correct
-  For Runner:=Fcount-1 downto 0 do
-    if Items[Runner]=Nil then Self.Delete(Runner);
-{ The following may be faster in case of large and defragmented lists
-  If count=0 then exit;
-  Runner:=0;I:=0;
-  TheLast:=Count;
-  while runner<count do
-    begin
-    // Find first Nil
-    While (FList^[Runner]<>Nil) and (Runner<Count) do Runner:=Runner+1;
-    if Runner<Count do
-      begin
-      // Start searching for non-nil from last known nil+1
-      if i<Runner then I:=Runner+1;
-      While (Flist[I]^=Nil) and (I<Count) do I:=I+1;
-      // Start looking for last non-nil of block.
-      J:=I+1;
-      While (Flist^[J]<>Nil) and (J<Count) do J:=J+1;
-      // Move block and zero out
-      Move (Flist^[I],Flist^[Runner],J*SizeOf(Pointer));
-      FillWord (Flist^[I],(J-I)*WordRatio,0);
-      // Update Runner and Last to point behind last block
-      TheLast:=Runner+(J-I);
-      If J=Count then
-         begin
-         // Shortcut, when J=Count we checked all pointers
-         Runner:=Count
-      else
-         begin
-         Runner:=TheLast;
-         I:=j;
-      end;
-    end;
-  Count:=TheLast;
-}
-end;
-
-// Needed by Sort method.
-
-Procedure QuickSort (Flist : PPointerList; L,R : Longint;
-                     Compare : TListSortCompare);
-
-Var I,J : Longint;
-    P,Q : Pointer;
-
-begin
- Repeat
-   I:=L;
-   J:=R;
-   P:=FList^[ (L+R) div 2 ];
-   repeat
-     While Compare(P,FList^[i])>0 Do I:=I+1;
-     While Compare(P,FList^[J])<0 Do J:=J-1;
-     If I<=J then
-       begin
-       Q:=Flist^[I];
-       Flist^[I]:=FList^[J];
-       FList^[J]:=Q;
-       I:=I+1;
-       J:=j-1;
-       end;
-   Until I>J;
-   If L<J then QuickSort (FList,L,J,Compare);
-   L:=I;
- Until I>=R;
-end;
-
-procedure TList.Sort(Compare: TListSortCompare);
-
-begin
-  If Not Assigned(FList) or (FCount<2) then exit;
-  QuickSort (Flist, 0, FCount-1,Compare);
-end;
-
-{****************************************************************************}
-{*                             TThreadList                                  *}
-{****************************************************************************}
-
-
-constructor TThreadList.Create;
-
-begin
-end;
-
-
-
-destructor TThreadList.Destroy;
-
-begin
-end;
-
-
-
-procedure TThreadList.Add(Item: Pointer);
-
-begin
-end;
-
-
-procedure TThreadList.Clear;
-
-begin
-end;
-
-
-
-function TThreadList.LockList: TList;
-
-
-begin
-  LockList:=nil;
-end;
-
-
-
-procedure TThreadList.Remove(Item: Pointer);
-
-
-begin
-end;
-
-
-
-procedure TThreadList.UnlockList;
-
-begin
-end;
-
-
-{
-  $Log$
-  Revision 1.7  1999-04-13 12:46:16  michael
-  + Some bug fixes by Romio
-
-  Revision 1.6  1999/04/08 10:18:52  peter
-    * makefile updates
-
-}

fcl/inc/parser.inc

@@ -1,319 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{****************************************************************************}
-{*                             TParser                                      *}
-{****************************************************************************}
-
-const
-  ParseBufSize     = 4096;
-
-procedure TParser.ReadBuffer;
-var
-  Count            : Integer;
-begin
-  Inc(FOrigin, FSourcePtr - FBuffer);
-
-  FSourceEnd[0] := FSaveChar;
-  Count         := FBufPtr - FSourcePtr;
-  if Count <> 0 then
-  begin
-    Move(FSourcePtr[0], FBuffer[0], Count);
-  end;
-
-  FBufPtr := FBuffer + Count;
-  Inc(FBufPtr, FStream.Read(FBufPtr[0], FBufEnd - FBufPtr));
-
-  FSourcePtr := FBuffer;
-  FSourceEnd := FBufPtr;
-  if (FSourceEnd = FBufEnd) then
-  begin
-    FSourceEnd := LineStart(FBuffer, FSourceEnd - 1);
-    if FSourceEnd = FBuffer then
-    begin
-      Error(SLineTooLong);
-    end;
-  end;
-  FSaveChar := FSourceEnd[0];
-  FSourceEnd[0] := #0;
-end;
-
-procedure TParser.SkipBlanks;
-begin
-  while FSourcePtr^ < #33 do begin
-    if FSourcePtr^ = #0 then begin
-      ReadBuffer;
-      if FSourcePtr^ = #0 then exit;
-      continue;
-    end else if FSourcePtr^ = #10 then Inc(FSourceLine);
-    Inc(FSourcePtr);
-  end;
-end;
-
-constructor TParser.Create(Stream: TStream);
-begin
-  inherited Create;
-
-  FStream := Stream;
-  GetMem(FBuffer, ParseBufSize);
-
-  FBuffer[0]  := #0;
-  FBufPtr     := FBuffer;
-  FBufEnd     := FBuffer + ParseBufSize;
-  FSourcePtr  := FBuffer;
-  FSourceEnd  := FBuffer;
-  FTokenPtr   := FBuffer;
-  FSourceLine := 1;
-
-  NextToken;
-end;
-
-
-destructor TParser.Destroy;
-begin
-  if Assigned(FBuffer) then
-  begin
-    FStream.Seek(Longint(FTokenPtr) - Longint(FBufPtr), 1);
-    FreeMem(FBuffer, ParseBufSize);
-  end;
-
-  inherited Destroy;
-end;
-
-procedure TParser.CheckToken(T : Char);
-begin
-  if Token <> T then
-  begin
-    case T of
-      toSymbol:
-        Error(SIdentifierExpected);
-      toString:
-        Error(SStringExpected);
-      toInteger, toFloat:
-        Error(SNumberExpected);
-    else
-      ErrorFmt(SCharExpected, [T]);
-    end;
-  end;
-end;
-
-procedure TParser.CheckTokenSymbol(const S: string);
-begin
-  if not TokenSymbolIs(S) then
-    ErrorFmt(SSymbolExpected, [S]);
-end;
-
-Procedure TParser.Error(const Ident: string);
-begin
-  ErrorStr(Ident);
-end;
-
-Procedure TParser.ErrorFmt(const Ident: string; const Args: array of const);
-begin
-  ErrorStr(Format(Ident, Args));
-end;
-
-Procedure TParser.ErrorStr(const Message: string);
-begin
-  raise EParserError.CreateFmt(SParseError, [Message, FSourceLine]);
-end;
-
-
-procedure TParser.HexToBinary(Stream: TStream);
-
-  function HexDigitToInt(c: Char): Integer;
-  begin
-    if (c >= '0') and (c <= '9') then Result := Ord(c) - Ord('0')
-    else if (c >= 'A') and (c <= 'F') then Result := Ord(c) - Ord('A') + 10
-    else if (c >= 'a') and (c <= 'f') then Result := Ord(c) - Ord('a') + 10
-    else Result := -1;
-  end;
-
-var
-  buf: array[0..255] of Byte;
-  digit1: Integer;
-  bytes: Integer;
-begin
-  SkipBlanks;
-  while FSourcePtr^ <> '}' do begin
-    bytes := 0;
-    while True do begin
-      digit1 := HexDigitToInt(FSourcePtr[0]);
-      if digit1 < 0 then break;
-      buf[bytes] := digit1 shl 4 or HexDigitToInt(FSourcePtr[1]);
-      Inc(FSourcePtr, 2);
-      Inc(bytes);
-    end;
-    if bytes = 0 then Error(SInvalidBinary);
-    Stream.Write(buf, bytes);
-    SkipBlanks;
-  end;
-  NextToken;
-end;
-
-
-Function TParser.NextToken: Char;
-var
-  I                : Integer;
-  P, S             : PChar;
-begin
-  SkipBlanks;
-  P := FSourcePtr;
-  FTokenPtr := P;
-  case P^ of
-    'A'..'Z', 'a'..'z', '_':
-      begin
-        Inc(P);
-        while P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_'] do Inc(P);
-        Result := toSymbol;
-      end;
-    '#', '''':
-      begin
-        S := P;
-        while True do
-          case P^ of
-            '#':
-              begin
-                Inc(P);
-                I := 0;
-                while P^ in ['0'..'9'] do
-                begin
-                  I := I * 10 + (Ord(P^) - Ord('0'));
-                  Inc(P);
-                end;
-                S^ := Chr(I);
-                Inc(S);
-              end;
-            '''':
-              begin
-                Inc(P);
-                while True do
-                begin
-                  case P^ of
-                    #0, #10, #13:
-                      Error(SInvalidString);
-                    '''':
-                      begin
-                        Inc(P);
-                        if P^ <> '''' then Break;
-                      end;
-                  end;
-                  S^ := P^;
-                  Inc(S);
-                  Inc(P);
-                end;
-              end;
-          else
-            Break;
-          end;
-        FStringPtr := S;
-        Result := toString;
-      end;
-    '$':
-      begin
-        Inc(P);
-        while P^ in ['0'..'9', 'A'..'F', 'a'..'f'] do Inc(P);
-        Result := toInteger;
-      end;
-    '-', '0'..'9':
-      begin
-        Inc(P);
-        while P^ in ['0'..'9'] do Inc(P);
-        Result := toInteger;
-        while P^ in ['0'..'9', '.', 'e', 'E', '+', '-'] do
-        begin
-          Inc(P);
-          Result := toFloat;
-        end;
-      end;
-  else
-    Result := P^;
-    if Result <> toEOF then Inc(P);
-  end;
-  FSourcePtr := P;
-  FToken := Result;
-end;
-
-Function TParser.SourcePos: Longint;
-begin
-  Result := FOrigin + (FTokenPtr - FBuffer);
-end;
-
-
-Function TParser.TokenComponentIdent: String;
-var
-  P                : PChar;
-begin
-  CheckToken(toSymbol);
-
-  P := FSourcePtr;
-  while P^ = '.' do
-  begin
-    Inc(P);
-    if not (P^ in ['A'..'Z', 'a'..'z', '_']) then
-      Error(SIdentifierExpected);
-    repeat
-      Inc(P)
-    until not (P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
-  end;
-  FSourcePtr := P;
-  Result := TokenString;
-end;
-
-Function TParser.TokenFloat: Extended;
-var
-  FloatError       : Integer;
-  Back             : Real;
-begin
-  Result   := 0;
-  Val(TokenString, Back, FloatError);
-  Result := Back;
-end;
-
-Function TParser.TokenInt: Longint;
-begin
-  Result := StrToInt(TokenString);
-end;
-
-Function TParser.TokenString: string;
-var
-  L                : Integer;
-  StrBuf           : array[0..1023] of Char;
-begin
-  if FToken = toString then begin
-    L := FStringPtr - FTokenPtr
-  end else begin
-    L := FSourcePtr - FTokenPtr;
-  end;
-
-  StrLCopy(StrBuf, FTokenPtr, L);
-  Result := StrPas(StrBuf);
-end;
-
-Function TParser.TokenSymbolIs(const S: string): Boolean;
-begin
-  Result := (Token = toSymbol) and (CompareText(S, TokenString) = 0);
-end;
-{
-  $Log$
-  Revision 1.8  1999-09-30 19:32:08  fcl
-  * Implemented TParser.HexToBinary  (sg)
-
-  Revision 1.7  1999/09/28 10:28:21  fcl
-  * Fixed some severe bugs  (sg)
-
-  Revision 1.6  1999/04/08 10:18:53  peter
-    * makefile updates
-
-}

fcl/inc/persist.inc

@@ -1,93 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TPersistent                                  *}
-{****************************************************************************}
-
-
-procedure TPersistent.AssignError(Source: TPersistent);
-
-Var SourceName : String;
-
-begin
-  If Source<>Nil then 
-    SourceName:=Source.ClassName
-  else
-    SourceName:='Nil';
-  Writeln ('Error assigning to ',ClassName,' from : ',SourceName);
-  raise EConvertError.CreateFmt (SAssignError,[SourceName,ClassName]);
-end;
-
-
-
-procedure TPersistent.AssignTo(Dest: TPersistent);
-
-
-begin
-  Dest.AssignError(Self);
-end;
-
-
-procedure TPersistent.DefineProperties(Filer: TFiler);
-
-begin
-end;
-
-
-function  TPersistent.GetOwner: TPersistent;
-
-begin
-  Result:=Nil;
-end;
-
-destructor TPersistent.Destroy; 
-
-begin
-  Inherited Destroy;
-end;
-
-
-procedure TPersistent.Assign(Source: TPersistent);
-
-begin
-  If Source<>Nil then 
-    Source.AssignTo(Self)
-  else
-    AssignError(Nil);
-end;
-
-function  TPersistent.GetNamePath: string;
-
-Var OwnerName :String;
-
-begin
- Result:=ClassNAme;
- If GetOwner<>Nil then 
-   begin
-   OwnerName:=GetOwner.GetNamePath;
-   If OwnerName<>'' then Result:=OwnerName+'.'+Result;
-   end;
-end;
-{
-  $Log$
-  Revision 1.3  1998-10-02 22:41:29  michael
-  + Added exceptions for error handling
-
-  Revision 1.2  1998/05/27 12:22:14  michael
-  + Implemented TPersistent
-
-  Revision 1.1  1998/05/04 14:30:12  michael
-  * Split file according to Class; implemented dummys for all methods, so unit compiles.
-
-}

fcl/inc/pipes.pp

@@ -1,121 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1998 by Michael Van Canneyt
-
-    Implementation of pipe stream.
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-Unit Pipes;
-
-Interface
-
-Uses sysutils,Classes;
-
-Type
-  EPipeError = Class(EStreamError);
-  ENoReadPipe = Class(EPipeError);
-  ENoWritePipe = Class (EPipeError);
-  EPipeSeek = Class (EPipeError);
-  EPipeCreation = Class (EPipeError);
-
-  TInputPipeStream = Class(THandleStream)
-    Private 
-      FPos : longint;
-    public
-      Function Write (Const Buffer; Count : Longint) :Longint; Override;
-      Function Seek (Offset : Longint;Origin : Word) : longint;override;
-      Function Read (Var Buffer; Count : Longint) : longint; Override;
-    end;
-
-  TOutputPipeStream = Class(THandleStream)
-    Public
-      Function Seek (Offset : Longint;Origin : Word) : longint;override;
-      Function Read (Var Buffer; Count : Longint) : longint; Override;
-    end;
-
-Procedure CreatePipeStreams (Var InPipe : TInputPipeStream;
-                             Var OutPipe : TOutputPipeStream);
-
-Const EPipeMsg = 'Failed to create pipe.';
-      ENoReadMSg = 'Cannot read from OuputPipeStream.';
-      ENoWriteMsg = 'Cannot write to InputPipeStream.';
-      ENoSeekMsg = 'Cannot seek on pipes';
-
-
-Implementation
-
-{$i pipes.inc}
-
-Procedure CreatePipeStreams (Var InPipe : TInputPipeStream;
-                             Var OutPipe : TOutputPipeStream);
-
-Var InHandle,OutHandle : Longint;
-
-begin
-  if CreatePipeHandles (InHandle, OutHandle) then
-    begin
-    Inpipe:=TinputPipeStream.Create (InHandle);
-    OutPipe:=ToutputPipeStream.Create (OutHandle);
-    end
-  Else
-    Raise EPipeCreation.Create (EPipeMsg)
-end;
-
-Function TInputPipeStream.Write (Const Buffer; Count : Longint) : longint;
-
-begin
-  Raise ENoWritePipe.Create (ENoWriteMsg);
-end;
-
-Function TInputPipeStream.Read (Var Buffer; Count : Longint) : longint;
-
-begin
-  Result:=Inherited Read(Buffer,Count);
-  Inc(FPos,Result);
-end;
-
-Function TInputPipeStream.Seek (Offset : Longint;Origin : Word) : longint;
-
-Const BufSize = 100;
-
-Var Buf : array[1..BufSize] of Byte;
-
-begin
-  If (Origin=soFromCurrent) and (Offset=0) then
-     result:=FPos;
-  { Try to fake seek by reading and discarding }
-  if Not((Origin=soFromCurrent) and (Offset>=0) or  
-         ((Origin=soFrombeginning) and (OffSet>=FPos))) then 
-     Raise EPipeSeek.Create(ENoSeekMSg);
-  if Origin=soFromBeginning then
-    Dec(Offset,FPos);
-  While ((Offset Div BufSize)>0) 
-        and (Read(Buf,SizeOf(Buf))=BufSize) do
-     Dec(Offset,BufSize);
-  If (Offset>0) then
-    Read(Buf,BufSize);
-  Result:=FPos;   
-end;
-
-Function TOutputPipeStream.Read(Var Buffer; Count : Longint) : longint;
-
-begin
-  Raise ENoReadPipe.Create (ENoReadMsg);
-end;
-
-Function TOutputPipeStream.Seek (Offset : Longint;Origin : Word) : longint;
-
-begin
-  Raise EPipeSeek.Create (ENoSeekMsg);
-end;
-
-end.

fcl/inc/reader.inc

@@ -1,383 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TREADER                                      *}
-{****************************************************************************}
-
-Procedure TReader.CheckValue(Value: TValueType);
-
-begin
-end;
-
-
-
-Procedure TReader.DoFixupReferences;
-
-begin
-end;
-
-
-
-Procedure TReader.FreeFixups;
-
-begin
-end;
-
-
-
-Function TReader.GetPosition: Longint;
-
-begin
-  GetPosition:=0;
-end;
-
-
-
-Procedure TReader.PropertyError;
-
-begin
-end;
-
-
-
-Procedure TReader.ReadBuffer;
-
-begin
-end;
-
-
-
-Procedure TReader.ReadData(Instance: TComponent);
-
-begin
-end;
-
-
-
-Procedure TReader.ReadDataInner(Instance: TComponent);
-
-begin
-end;
-
-
-
-Procedure TReader.ReadProperty(AInstance: TPersistent);
-
-begin
-end;
-
-
-
-Procedure TReader.ReadPropValue(Instance: TPersistent; PropInfo: Pointer);
-
-begin
-end;
-
-
-
-Function TReader.ReadSet(SetType: Pointer): Integer;
-
-begin
-  ReadSet:=0;
-end;
-
-
-
-Procedure TReader.SetPosition(Value: Longint);
-
-begin
-end;
-
-
-
-Procedure TReader.SkipSetBody;
-
-begin
-end;
-
-
-
-Procedure TReader.SkipValue;
-
-begin
-end;
-
-
-
-Procedure TReader.SkipProperty;
-
-begin
-end;
-
-
-
-Procedure TReader.SkipComponent(SkipHeader: Boolean);
-
-begin
-end;
-
-
-
-Function TReader.Error(const Message: string): Boolean;
-
-begin
-  Error:=false;
-end;
-
-
-
-Function TReader.FindMethod(ARoot: TComponent; const AMethodName: string): Pointer;
-
-begin
-  FindMethod:=nil;
-end;
-
-
-
-Procedure TReader.SetName(Component: TComponent; var Name: string);
-
-begin
-end;
-
-
-
-Procedure TReader.ReferenceName(var Name: string);
-
-begin
-end;
-
-
-
-Function TReader.FindAncestorComponent(const Name: string;
-  ComponentClass: TPersistentClass): TComponent;
-
-begin
-  FindAncestorComponent:=nil;
-end;
-
-
-
-destructor TReader.Destroy;
-
-begin
-end;
-
-
-
-Procedure TReader.BeginReferences;
-
-begin
-end;
-
-
-
-Procedure TReader.DefineProperty(const Name: string;
-  rd : TReaderProc; wd : TWriterProc;
-  HasData: Boolean);
-
-begin
-end;
-
-
-
-Procedure TReader.DefineBinaryProperty(const Name: string;
-  rd, wd: TStreamProc;
-  HasData: Boolean);
-
-begin
-end;
-
-
-
-Function TReader.EndOfList: Boolean;
-
-begin
-  EndOfList:=false;
-end;
-
-
-
-Procedure TReader.EndReferences;
-
-begin
-end;
-
-
-
-Procedure TReader.FixupReferences;
-
-begin
-end;
-
-
-
-Procedure TReader.FlushBuffer;
-
-begin
-end;
-
-
-
-Function TReader.NextValue: TValueType;
-
-begin
-  NextValue:=vaNull;
-end;
-
-
-
-Procedure TReader.Read(var Buf; Count: Longint);
-
-begin
-end;
-
-
-
-Function TReader.ReadBoolean: Boolean;
-
-begin
-  ReadBoolean:=false;
-end;
-
-
-
-Function TReader.ReadChar: Char;
-
-begin
-  ReadChar:=#0;
-end;
-
-
-
-Procedure TReader.ReadCollection(Collection: TCollection);
-
-begin
-end;
-
-
-
-Function TReader.ReadComponent(Component: TComponent): TComponent;
-
-begin
-  ReadComponent:=nil;
-end;
-
-
-
-Procedure TReader.ReadComponents(AOwner, AParent: TComponent;
-  Proc: TReadComponentsProc);
-
-begin
-end;
-
-
-
-Function TReader.ReadFloat: Extended;
-
-begin
-  ReadFloat:=0.0;
-end;
-
-
-
-Function TReader.ReadIdent: string;
-
-begin
-  ReadIdent:='';
-end;
-
-
-
-Function TReader.ReadInteger: Longint;
-
-begin
-  ReadInteger:=0;
-end;
-
-
-
-Procedure TReader.ReadListBegin;
-
-begin
-end;
-
-
-
-Procedure TReader.ReadListEnd;
-
-begin
-end;
-
-
-
-Procedure TReader.ReadPrefix(var Flags: TFilerFlags; var AChildPos: Integer);
-
-begin
-end;
-
-
-
-Function TReader.ReadRootComponent(ARoot: TComponent): TComponent;
-
-begin
-  ReadRootComponent:=nil;
-end;
-
-
-
-Procedure TReader.ReadSignature;
-
-begin
-end;
-
-
-
-Function TReader.ReadStr: string;
-
-begin
-  ReadStr:='';
-end;
-
-
-
-Function TReader.ReadString: string;
-
-begin
-  ReadString:='';
-end;
-
-
-
-Function TReader.ReadValue: TValueType;
-
-begin
-  ReadValue:=vaNull;
-end;
-
-
-
-Procedure TReader.CopyValue(Writer: TWriter); {!!!}
-
-begin
-end;
-{
-  $Log$
-  Revision 1.3  1999-09-13 08:35:16  fcl
-  * Changed some argument names (Root->ARoot etc.) because the new compiler
-    now performs more ambiguity checks  (sg)
-
-  Revision 1.2  1999/04/08 10:18:54  peter
-    * makefile updates
-
-}

fcl/inc/rtfdata.inc

@@ -1,768 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1998 by Michael Van Canneyt, member of the
-    Free Pascal development team
-
-    All major and minor RTF class definitions.
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{ ---------------------------------------------------------------------
-  Twentieths of a point (twips) per inch (Many RTF measurements
-  are in twips per inch (tpi) units).  Assumes 72 points/inch. 
-  ---------------------------------------------------------------------}
-
-Const
- rtfTpi		= 1440;
- rtfBufSiz	= 255; { buffer size}
-
-{ ---------------------------------------------------------------------
-	Tokens are associated with up to three classification numbers:
-
-	Class number: Broadest (least detailed) breakdown.  For programs
-		that only care about gross token distinctions.
-	Major/minor numbers: Within their class, tokens have a major
-		number, and may also have a minor number to further
-		distinquish tokens with the same major number.
-
-	*** Class, major and minor token numbers are all >= 0 ***
-
-	Tokens that can't be classified are put in the "unknown" class.
-	For such, the major and minor numbers are meaningless, although
-	rtfTextBuf may be of interest then.
-
-	Text tokens are a single character, and the major number indicates
-	the character value (note: can be non-ascii, i.e., greater than 127).
-	There is no minor number.
-
-	Control symbols may have a parameter value, which will be found in
-	rtfParam.  If no parameter was given, rtfParam = rtfNoParam.
-
-	RTFGetToken() return value is the class number, but it sets all the
-	global token vars.
-
-	rtfEOF is a fake token used by the reader; the writer never sees
-	it (except in the token reader hook, if it installs one).
-
-	Information pertaining to last token read by RTFToken.  The
-	text is exactly as it occurs in the input file, e.g., 
-	will be found in rtfTextBuf as, even though it means .
-	
-	These variables are also set when styles are reprocessed.
- ----------------------------------------------------------------------}
-	rtfNoParam = (-1000000);
-	
-{	Token classes (zero-based and sequential) }
-	rtfUnknown	= 0;
-	rtfGroup	= 1;
-	rtfText		= 2;
-	rtfControl	= 3;
-	rtfEOF		= 4;
-	rtfMaxClass	= 5	{ highest class + 1 };
-
-{	Group class major numbers }
-	rtfBeginGroup	= 0;
-	rtfEndGroup	= 1;
-{	Control class major and minor numbers.}
-	rtfVersion	= 0;
-
-	rtfDefFont	= 1;
-
-	rtfCharSet	= 2;
-		rtfAnsiCharSet		= 0;
-		rtfMacCharSet		= 1;
-		rtfPcCharSet		= 2;
-		rtfPcaCharSet		= 3;
-{	destination minor numbers should be zero-based, sequential }
-	rtfDestination	= 3;
-		rtfPict			= 0;
-		rtfNeXTGraphic		= 1;
-		rtfFootnote		= 2;
-		rtfHeader		= 3;
-		rtfHeaderLeft		= 4;
-		rtfHeaderRight		= 5;
-		rtfHeaderFirst		= 6;
-		rtfFooter		= 7;
-		rtfFooterLeft		= 8;
-		rtfFooterRight		= 9;
-		rtfFooterFirst		= 10;
-		rtfFNSep		= 11;
-		rtfFNContSep		= 12;
-		rtfFNContNotice		= 13;
-		rtfInfo			= 14;
-		rtfStyleSheet		= 15;
-		rtfFontTbl		= 16;
-		rtfColorTbl		= 17;
-		rtfField		= 18;
-		rtfFieldInst		= 19;
-		rtfFieldResult		= 20;
-		rtfIndex		= 21;
-		rtfIndexBold		= 22;
-		rtfIndexItalic		= 23;
-		rtfIndexText		= 24;
-		rtfIndexRange		= 25;
-		rtfTOC			= 26;
-		rtfBookmarkStart	= 27;
-		rtfBookmarkEnd		= 28;
-		rtfITitle		= 29;
-		rtfISubject		= 30;
-		rtfIAuthor		= 31;
-		rtfIOperator		= 32;
-		rtfIKeywords		= 33;
-		rtfIComment		= 34;
-		rtfIVersion		= 35;
-		rtfIDoccomm		= 36;
-		rtfMaxDestination	= 37	{ highest dest + 1 };
-
-	rtfFontFamily	= 4;
-		rtfFFNil		= 0;
-		rtfFFRoman		= 1;
-		rtfFFSwiss		= 2;
-		rtfFFModern		= 3;
-		rtfFFScript		= 4;
-		rtfFFDecor		= 5;
-		rtfFFTech		= 6;
-
-	rtfColorName	= 5;
-		rtfRed			= 0;
-		rtfGreen		= 1;
-		rtfBlue			= 2;
-
-        rtfSpecialChar = 6;
-		rtfCurHeadPage		= 0;
-		rtfCurFNote		= 1;
-		rtfCurHeadPict		= 2	{ valid? };
-		rtfCurHeadDate		= 3;
-		rtfCurHeadTime		= 4;
-		rtfFormula		= 5;
-		rtfNoBrkSpace		= 6;
-		rtfNoReqHyphen		= 7;
-		rtfNoBrkHyphen		= 8;
-		rtfPage			= 9;
-		rtfLine			= 10;
-		rtfPar			= 11;
-		rtfSect			= 12;
-		rtfTab			= 13;
-		rtfCell			= 14;
-		rtfRow			= 15;
-		rtfCurAnnot		= 16;
-		rtfAnnotation		= 17;
-		rtfAnnotID		= 18;
-		rtfCurAnnotRef		= 19;
-		rtfFNoteSep		= 20;
-		rtfFNoteCont		= 21;
-		rtfColumn		= 22;
-		rtfOptDest		= 23;
-		rtfIIntVersion		= 24;
-		rtfICreateTime		= 25;
-		rtfIRevisionTime	= 26;
-		rtfIPrintTime		= 27;
-		rtfIBackupTime		= 28;
-		rtfIEditTime		= 29;
-		rtfIYear		= 30;
-		rtfIMonth		= 31;
-		rtfIDay			= 32;
-		rtfIHour		= 33;
-		rtfIMinute		= 34;
-		rtfINPages		= 35;
-		rtfINWords		= 36;
-		rtfINChars		= 37;
-		rtfIIntID		= 38;
-
-	rtfStyleAttr	= 7;
-		rtfBasedOn		= 0;
-		rtfNext			= 1;
-
-	rtfDocAttr	= 8;
-		rtfPaperWidth		= 0;
-		rtfPaperHeight		= 1;
-		rtfLeftMargin		= 2;
-		rtfRightMargin		= 3;
-		rtfTopMargin		= 4;
-		rtfBottomMargin		= 5;
-		rtfFacingPage		= 6;
-		rtfGutterWid		= 7;
-		rtfDefTab		= 8;
-		rtfWidowCtrl		= 9;
-		rtfHyphHotZone		= 10;
-		rtfFNoteEndSect		= 11;
-		rtfFNoteEndDoc		= 12;
-		rtfFNoteText		= 13;
-		rtfFNoteBottom		= 14;
-		rtfFNoteStart		= 15;
-		rtfFNoteRestart		= 16;
-		rtfPageStart		= 17;
-		rtfLineStart		= 18;
-		rtfLandscape		= 19;
-		rtfFracWidth		= 20;
-		rtfNextFile		= 21;
-		rtfTemplate		= 22;
-		rtfMakeBackup		= 23;
-		rtfRTFDefault		= 24;
-		rtfRevisions		= 25;
-		rtfMirrorMargin		= 26;
-		rtfRevDisplay		= 27;
-		rtfRevBar		= 28;
-
-	rtfSectAttr	= 9;
-		rtfSectDef		= 0;
-		rtfNoBreak		= 1;
-		rtfColBreak		= 2;
-		rtfPageBreak		= 3;
-		rtfEvenBreak		= 4;
-		rtfOddBreak		= 5;
-		rtfPageStarts		= 6;
-		rtfPageCont		= 7;
-		rtfPageRestart		= 8;
-		rtfPageDecimal		= 9;
-		rtfPageURoman		= 10;
-		rtfPageLRoman		= 11;
-		rtfPageULetter		= 12;
-		rtfPageLLetter		= 13;
-		rtfPageNumLeft		= 14;
-		rtfPageNumTop		= 15;
-		rtfHeaderY		= 16;
-		rtfFooterY		= 17;
-		rtfLineModulus		= 18;
-		rtfLineDist		= 19;
-		rtfLineStarts		= 20;
-		rtfLineRestart		= 21;
-		rtfLineRestartPg	= 22;
-		rtfLineCont		= 23;
-		rtfTopVAlign		= 24;
-		rtfBottomVAlign		= 25;
-		rtfCenterVAlign		= 26;
-		rtfJustVAlign		= 27;
-		rtfColumns		= 28;
-		rtfColumnSpace		= 29;
-		rtfColumnLine		= 30;
-		rtfENoteHere		= 31;
-		rtfTitleSpecial		= 32;
-
-	rtfTblAttr	= 10;
-		rtfCellBordBottom	= 0;
-		rtfCellBordTop		= 1;
-		rtfCellBordLeft		= 2;
-		rtfCellBordRight	= 3;
-		rtfRowDef		= 4;
-		rtfRowLeft		= 5;
-		rtfRowRight		= 6;
-		rtfRowCenter		= 7;
-		rtfRowGapH		= 8;
-		rtfRowHt		= 9;
-		rtfRowLeftEdge		= 10;
-		rtfCellPos		= 11;
-		rtfMergeRngFirst	= 12;
-		rtfMergePrevious	= 13;
-
-	rtfParAttr	= 11;
-		rtfParDef		= 0;
-		rtfStyleNum		= 1;
-		rtfQuadLeft		= 2;
-		rtfQuadRight		= 3;
-		rtfQuadJust		= 4;
-		rtfQuadCenter		= 5;
-		rtfFirstIndent		= 6;
-		rtfLeftIndent		= 7;
-		rtfRightIndent		= 8;
-		rtfSpaceBefore		= 9;
-		rtfSpaceAfter		= 10;
-		rtfSpaceBetween		= 11;
-		rtfInTable		= 12;
-		rtfKeep			= 13;
-		rtfKeepNext		= 14;
-		rtfSideBySide		= 15;
-		rtfPBBefore		= 16;
-		rtfNoLineNum		= 17;
-		rtfTabPos		= 18;
-		rtfTabRight		= 19;
-		rtfTabCenter		= 20;
-		rtfTabDecimal		= 21;
-		rtfTabBar		= 22;
-		rtfBorderTop		= 23;
-		rtfBorderBottom		= 24;
-		rtfBorderLeft		= 25;
-		rtfBorderRight		= 26;
-		rtfBorderBox		= 27;
-		rtfBorderBar		= 28;
-		rtfBorderBetween	= 29;
-		rtfBorderSingle		= 30;
-		rtfBorderThick		= 31;
-		rtfBorderShadow		= 32;
-		rtfBorderDouble		= 33;
-		rtfBorderDot		= 34;
-		rtfBorderHair		= 35;
-		rtfBorderSpace		= 36;
-		rtfLeaderDot		= 37;
-		rtfLeaderHyphen		= 38;
-		rtfLeaderUnder		= 39;
-		rtfLeaderThick		= 40;
-
-	rtfCharAttr	= 12;
-		rtfPlain		= 0;
-		rtfBold			= 1;
-		rtfItalic		= 2;
-		rtfStrikeThru		= 3;
-		rtfOutline		= 4;
-		rtfShadow		= 5;
-		rtfSmallCaps		= 6;
-		rtfAllCaps		= 7;
-		rtfInvisible		= 8;
-		rtfFontNum		= 9;
-		rtfFontSize		= 10;
-		rtfExpand		= 11;
-		rtfUnderline		= 12;
-		rtfWUnderline		= 13;
-		rtfDUnderline		= 14;
-		rtfDbUnderline		= 15;
-		rtfNoUnderline		= 16;
-		rtfSuperScript		= 17;
-		rtfSubScript		= 18;
-		rtfRevised		= 19;
-		rtfForeColor		= 20;
-		rtfBackColor		= 21;
-		rtfGray			= 22;
-
-	rtfPictAttr	= 13;
-		rtfMacQD		= 0;
-		rtfWinMetafile		= 1;
-		rtfWinBitmap		= 2;
-		rtfPicWid		= 3;
-		rtfPicHt		= 4;
-		rtfPicGoalWid		= 5;
-		rtfPicGoalHt		= 6;
-		rtfPicScaleX		= 7;
-		rtfPicScaleY		= 8;
-		rtfPicScaled		= 9;
-		rtfPicCropTop		= 10;
-		rtfPicCropBottom	= 11;
-		rtfPicCropLeft		= 12;
-		rtfPicCropRight		= 13;
-		rtfPixelBits		= 14;
-		rtfBitmapPlanes		= 15;
-		rtfBitmapWid		= 16;
-		rtfPicBinary		= 17;
-
-	rtfNeXTGrAttr	= 14;
-		rtfNeXTGWidth		= 0;
-		rtfNeXTGHeight		= 1;
-
-	rtfFieldAttr	= 15;
-		rtfFieldDirty		= 0;
-		rtfFieldEdited		= 1;
-		rtfFieldLocked		= 2;
-		rtfFieldPrivate		= 3;
-
-		rtfTOCAttr	= 16;
-		rtfTOCType		= 0;
-		rtfTOCLevel		= 1;
-
-	rtfPosAttr	= 17;
-		rtfPosX			= 0;
-		rtfPosXCenter		= 1;
-		rtfPosXInside		= 2;
-		rtfPosXLeft		= 3;
-		rtfPosXOutSide		= 4;
-		rtfPosXRight		= 5;
-		rtfPosY			= 6;
-		rtfPosYInline		= 7;
-		rtfPosYTop		= 8;
-		rtfPosYCenter		= 9;
-		rtfPosYBottom		= 10;
-		rtfAbsWid		= 11;
-		rtfTextDist		= 12;
-		rtfRPosMargV		= 13;
-		rtfRPosPageV		= 14;
-		rtfRPosMargH		= 15;
-		rtfRPosPageH		= 16;
-		rtfRPosColH		= 17;
-
-	rtfBasedOnNone	= 222;	{ "no based-on style" }
-
-
-Type
-
-{ ---------------------------------------------------------------------
-     Callback Types 
-  ---------------------------------------------------------------------}
-  
-TRTFFunc = Procedure of object;
-TRTFFuncPtr = procedure of object;
-
-{ ---------------------------------------------------------------------
-    RTF font, color and style structures.  Used for font table,
-    color table, and stylesheet processing. 
-  ---------------------------------------------------------------------}
-  
-PRTFFONT = ^TRTFFONT;
-TRTFFont = Record
-	rtfFName    : string;		{ font name }
-	rtfFNum     : integer;		{ font number }
-	rtfFFamily  : integer;		{ font family }
-	rtfNextFont : PRTFFONT;		{ next font in list }
-end;
-
-
-{ ----------------------------------------------------------------------
-	Color values are -1 if the default color for the the color
-	number should be used.  The default color is writer-dependent.
-  ----------------------------------------------------------------------}
- 
-PRTFColor = ^TRTFColor;
-TRTFColor = Record
-	rtfCNum : integer;	{ color number }
-	rtfCRed : INteger;	{ red value }
-	rtfCGreen : INteger;	{ green value }
-	rtfCBlue : integer;	{ blue value }
-	rtfNextColor : PRTFColor;	{ next color in list }
-end;
-
-PRTFStyleElt = ^TRTFStyleElt;
-TRTFStyleElt = record
-	rtfSEClass,			{ token class }
-	rtfSEMajor,			{ token major number }
-	rtfSEMinor,			{ token minor number }
-	rtfSEParam : Integer;		{ control symbol parameter }
-	rtfSEText : String;		{ text of symbol }
-	rtfNextSE : PRTFStyleElt;	{ next element in style }
-end;
-
-PRTFSTyle = ^TRTFStyle;
-TRTFStyle = record
-	rtfSName : string;		{ style name }
-	rtfSNum,			{ style number }
-	rtfSBasedOn,			{ style this one's based on }
-	rtfSNextPar : integer;		{ style next paragraph style }
-	rtfSSEList : PRTFStyleElt;	{ list of style words }
-	rtfExpanding : Integer;		{ non-zero = being expanded }
-	rtfNextStyle : PRTFStyle;	{ next style in style list }
-end;
-
-{ ---------------------------------------------------------------------
-       Control symbol lookup routines
-  ---------------------------------------------------------------------}
-
-
-Type
-  TRTFKey = record
-    rtfKMajor : Integer;	{ major number }
-    rtfKMinor : Integer;	{ minor number }
-    rtfKStr   : string[20];	{ symbol name }
-    rtfKHash  : Integer;	{ symbol name hash value }
-    End;
-
-{ ---------------------------------------------------------------------
-    A minor number of -1 means the token has no minor number
-   (all valid minor numbers are >= 0).
-  ---------------------------------------------------------------------}
-
-Const rtfKey : Array [0..281] of TRTFKey =
-(
-( rtfKMajor: RTFSPECIALCHAR; rtfKMinor : rtfCURHEADPICT; rtfKStr  : 'chpict'; rtfKhash :	0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfCurHeadDate; rtfKstr : 'chdate'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfCurHeadTime; rtfKstr : 'chtime'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfCurHeadPage; rtfKstr : 'chpgn'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfCurFNote; rtfKstr : 'chftn'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfCurAnnotRef; rtfKstr : 'chatn'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfFNoteSep; rtfKstr : 'chftnsep'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfFNoteCont; rtfKstr : 'chftnsepc'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfFormula; rtfKstr : '|'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfNoBrkSpace; rtfKstr : '~'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfNoReqHyphen; rtfKstr : '-'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfNoBrkHyphen; rtfKstr : '_'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfCell; rtfKstr : 'cell'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfRow; rtfKstr : 'row'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfPar; rtfKstr : 'par'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfPar; rtfKstr : #10; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfPar; rtfKstr : #13; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfSect; rtfKstr : 'sect'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfPage; rtfKstr : 'page'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfColumn; rtfKstr : 'column'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfLine; rtfKstr : 'line'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfTab; rtfKstr : 'tab'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfOptDest; rtfKstr : '*'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfIIntVersion; rtfKstr : 'vern'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfICreateTime; rtfKstr : 'creatim'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfIRevisionTime; rtfKstr : 'revtim'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfIPrintTime; rtfKstr : 'printim'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfIBackupTime; rtfKstr : 'buptim'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfIEditTime; rtfKstr : 'edmins'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfIYear; rtfKstr : 'yr'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfIMonth; rtfKstr : 'mo'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfIDay; rtfKstr : 'dy'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfIHour; rtfKstr : 'hr'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfIMinute; rtfKstr : 'min'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfINPages; rtfKstr : 'nofpages'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfINWords; rtfKstr : 'nofwords'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfINChars; rtfKstr : 'nofchars'; rtfkHash : 0),
-( rtfKMajor: rtfSpecialChar; rtfKMinor: 	rtfIIntID; rtfKstr : 'id'; rtfkHash : 0),
-
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfPlain; rtfKstr : 'plain'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfBold; rtfKstr : 'b'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfItalic; rtfKstr : 'i'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfStrikeThru; rtfKstr : 'strike'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfOutline; rtfKstr : 'outl'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfShadow; rtfKstr : 'shad'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfSmallCaps; rtfKstr : 'scaps'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfAllCaps; rtfKstr : 'caps'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfInvisible; rtfKstr : 'v'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfFontNum; rtfKstr : 'f'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfFontSize; rtfKstr : 'fs'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfExpand; rtfKstr : 'expnd'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfUnderline; rtfKstr : 'ul'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfWUnderline; rtfKstr : 'ulw'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfDUnderline; rtfKstr : 'uld'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfDbUnderline; rtfKstr : 'uldb'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfNoUnderline; rtfKstr : 'ulnone'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfSuperScript; rtfKstr : 'up'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfSubScript; rtfKstr : 'dn'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfRevised; rtfKstr : 'revised'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfForeColor; rtfKstr : 'cf'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfBackColor; rtfKstr : 'cb'; rtfkHash : 0),
-( rtfKMajor: rtfCharAttr; rtfKMinor: 	rtfGray; rtfKstr : 'gray'; rtfkHash : 0),
-
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfParDef; rtfKstr : 'pard'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfStyleNum; rtfKstr : 's'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfQuadLeft; rtfKstr : 'ql'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfQuadRight; rtfKstr : 'qr'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfQuadJust; rtfKstr : 'qj'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfQuadCenter; rtfKstr : 'qc'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfFirstIndent; rtfKstr : 'fi'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfLeftIndent; rtfKstr : 'li'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfRightIndent; rtfKstr : 'ri'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfSpaceBefore; rtfKstr : 'sb'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfSpaceAfter; rtfKstr : 'sa'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfSpaceBetween; rtfKstr : 'sl'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfInTable; rtfKstr : 'intbl'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfKeep; rtfKstr : 'keep'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfKeepNext; rtfKstr : 'keepn'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfSideBySide; rtfKstr : 'sbys'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfPBBefore; rtfKstr : 'pagebb'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfNoLineNum; rtfKstr : 'noline'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfTabPos; rtfKstr : 'tx'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfTabRight; rtfKstr : 'tqr'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfTabCenter; rtfKstr : 'tqc'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfTabDecimal; rtfKstr : 'tqdec'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfTabBar; rtfKstr : 'tb'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderTop; rtfKstr : 'brdrt'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderBottom; rtfKstr : 'brdrb'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderLeft; rtfKstr : 'brdrl'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderRight; rtfKstr : 'brdrr'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderBar; rtfKstr : 'bar'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderBox; rtfKstr : 'box'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderBetween; rtfKstr : 'brdrbtw'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderSingle; rtfKstr : 'brdrs'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderThick; rtfKstr : 'brdrth'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderShadow; rtfKstr : 'brdrsh'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderDouble; rtfKstr : 'brdrdb'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderDot; rtfKstr : 'brdrdot'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderHair; rtfKstr : 'brdrhair'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfLeaderDot; rtfKstr : 'tldot'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfLeaderHyphen; rtfKstr : 'tlhyph'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfLeaderUnder; rtfKstr : 'tlul'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfLeaderThick; rtfKstr : 'tlth'; rtfkHash : 0),
-( rtfKMajor: rtfParAttr; rtfKMinor: 	rtfBorderSpace; rtfKstr : 'brsp'; rtfkHash : 0),
-
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfSectDef; rtfKstr : 'sectd'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfNoBreak; rtfKstr : 'sbknone'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfColBreak; rtfKstr : 'sbkcol'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfPageBreak; rtfKstr : 'sbkpage'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfEvenBreak; rtfKstr : 'sbkeven'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfOddBreak; rtfKstr : 'sbkodd'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfPageCont; rtfKstr : 'pgncont'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfPageStarts; rtfKstr : 'pgnstarts'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfPageRestart; rtfKstr : 'pgnrestart'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfPageDecimal; rtfKstr : 'pgndec'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfPageURoman; rtfKstr : 'pgnucrm'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfPageLRoman; rtfKstr : 'pgnlcrm'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfPageULetter; rtfKstr : 'pgnucltr'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfPageLLetter; rtfKstr : 'pgnlcltr'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfPageNumLeft; rtfKstr : 'pgnx'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfPageNumTop; rtfKstr : 'pgny'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfHeaderY; rtfKstr : 'headery'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfFooterY; rtfKstr : 'footery'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfLineModulus; rtfKstr : 'linemod'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfLineDist; rtfKstr : 'linex'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfLineStarts; rtfKstr : 'linestarts'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfLineRestart; rtfKstr : 'linerestart'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfLineRestartPg; rtfKstr : 'lineppage'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfLineCont; rtfKstr : 'linecont'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfTopVAlign; rtfKstr : 'vertalt'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfBottomVAlign; rtfKstr : 'vertal'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfCenterVAlign; rtfKstr : 'vertalc'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfJustVAlign; rtfKstr : 'vertalj'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfColumns; rtfKstr : 'cols'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfColumnSpace; rtfKstr : 'colsx'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfColumnLine; rtfKstr : 'linebetcol'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfENoteHere; rtfKstr : 'endnhere'; rtfkHash : 0),
-( rtfKMajor: rtfSectAttr; rtfKMinor: 	rtfTitleSpecial; rtfKstr : 'titlepg'; rtfkHash : 0),
-
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfPaperWidth; rtfKstr : 'paperw'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfPaperHeight; rtfKstr : 'paperh'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfLeftMargin; rtfKstr : 'margl'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfRightMargin; rtfKstr : 'margr'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfTopMargin; rtfKstr : 'margt'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfBottomMargin; rtfKstr : 'margb'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfFacingPage; rtfKstr : 'facingp'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfGutterWid; rtfKstr : 'gutter'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfDefTab; rtfKstr : 'deftab'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfWidowCtrl; rtfKstr : 'widowctrl'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfHyphHotZone; rtfKstr : 'hyphhotz'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfFNoteEndSect; rtfKstr : 'endnotes'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfFNoteEndDoc; rtfKstr : 'enddoc'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfFNoteBottom; rtfKstr : 'ftnbj'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfFNoteText; rtfKstr : 'ftntj'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfFNoteStart; rtfKstr : 'ftnstart'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfFNoteRestart; rtfKstr : 'ftnrestart'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfPageStart; rtfKstr : 'pgnstart'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfLineStart; rtfKstr : 'linestart'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfLandscape; rtfKstr : 'landscape'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfFracWidth; rtfKstr : 'fracwidth'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfNextFile; rtfKstr : 'nextfile'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfTemplate; rtfKstr : 'template'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfMakeBackup; rtfKstr : 'makeback'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfRTFDefault; rtfKstr : 'defformat'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfRevisions; rtfKstr : 'revisions'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfMirrorMargin; rtfKstr : 'margmirror'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfRevDisplay; rtfKstr : 'revprop'; rtfkHash : 0),
-( rtfKMajor: rtfDocAttr; rtfKMinor: 	rtfRevBar; rtfKstr : 'revbar'; rtfkHash : 0),
-
-( rtfKMajor: rtfStyleAttr; rtfKMinor: 	rtfBasedOn; rtfKstr : 'sbasedon'; rtfkHash : 0),
-( rtfKMajor: rtfStyleAttr; rtfKMinor: 	rtfNext; rtfKstr : 'snext'; rtfkHash : 0),
-
-( rtfKMajor: rtfPictAttr; rtfKstr : 'macpict'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfWinMetafile; rtfKstr : 'wmetafile'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfWinBitmap; rtfKstr : 'wbitmap'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicWid; rtfKstr : 'picw'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicHt; rtfKstr : 'pich'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicGoalWid; rtfKstr : 'picwgoal'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicGoalWid; rtfKstr : 'picwGoal'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicGoalHt; rtfKstr : 'pichgoal'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicGoalHt; rtfKstr : 'pichGoal'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicScaleX; rtfKstr : 'picscalex'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicScaleY; rtfKstr : 'picscaley'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicScaled; rtfKstr : 'picscaled'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicCropTop; rtfKstr : 'piccropt'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicCropBottom; rtfKstr : 'piccropb'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicCropLeft; rtfKstr : 'piccropl'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPicCropRight; rtfKstr : 'piccropr'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfPixelBits; rtfKstr : 'wbmbitspixel'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfBitmapPlanes; rtfKstr : 'wbmplanes'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor: 	rtfBitmapWid; rtfKstr : 'wbmwidthbytes'; rtfkHash : 0),
-( rtfKMajor: rtfPictAttr; rtfKMinor:	rtfPicBinary; rtfKstr : 'bin'; rtfkHash : 0),
-
-( rtfKMajor: rtfNeXTGrAttr; rtfKMinor:	rtfNeXTGWidth; rtfKstr : 'width'; rtfkHash : 0),
-( rtfKMajor: rtfNeXTGrAttr; rtfKMinor:	rtfNeXTGHeight; rtfKstr : 'height'; rtfkHash : 0),
-
-( rtfKMajor: rtfDestination; rtfKMinor:         rtfPict; rtfKstr : 'pict'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor:         rtfNeXTGraphic; rtfKstr : 'NeXTGraphic'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfFootnote; rtfKstr : 'footnote'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfHeader; rtfKstr : 'header'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfHeaderLeft; rtfKstr : 'headerl'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfHeaderRight; rtfKstr : 'headerr'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfHeaderFirst; rtfKstr : 'headerf'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfFooter; rtfKstr : 'footer'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfFooterLeft; rtfKstr : 'footerl'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfFooterRight; rtfKstr : 'footerr'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfFooterFirst; rtfKstr : 'footerf'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfFNSep; rtfKstr : 'ftnsep'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfFNContSep; rtfKstr : 'ftnsepc'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfFNContNotice; rtfKstr : 'ftncn'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfInfo; rtfKstr : 'info'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfStyleSheet; rtfKstr : 'stylesheet'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfFontTbl; rtfKstr : 'fonttbl'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfColorTbl; rtfKstr : 'colortbl'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfAnnotation; rtfKstr : 'annotation'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfAnnotID; rtfKstr : 'atnid'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfField; rtfKstr : 'field'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfFieldInst; rtfKstr : 'fldinst'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfFieldResult; rtfKstr : 'fldrslt'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfIndex; rtfKstr : 'xe'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfIndexBold; rtfKstr : 'bxe'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfIndexItalic; rtfKstr : 'ixe'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfIndexText; rtfKstr : 'txe'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfIndexRange; rtfKstr : 'rxe'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfTOC; rtfKstr : 'tc'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfBookmarkStart; rtfKstr : 'bkmkstart'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfBookmarkEnd; rtfKstr : 'bkmkend'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfITitle; rtfKstr : 'title'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfISubject; rtfKstr : 'subject'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfIAuthor; rtfKstr : 'author'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfIOperator; rtfKstr : 'operator'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfIKeywords; rtfKstr : 'keywords'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfIComment; rtfKstr : 'comment'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfIVersion; rtfKstr : 'version'; rtfkHash : 0),
-( rtfKMajor: rtfDestination; rtfKMinor: 	rtfIDoccomm; rtfKstr : 'doccomm'; rtfkHash : 0),
-
-( rtfKMajor: rtfTOCAttr; rtfKMinor: 	rtfTOCType; rtfKstr : 'tcf'; rtfkHash : 0),
-( rtfKMajor: rtfTOCAttr; rtfKMinor: 	rtfTOCLevel; rtfKstr : 'tcl'; rtfkHash : 0),
-
-( rtfKMajor: rtfFontFamily; rtfKMinor: 	rtfFFNil; rtfKstr : 'fnil'; rtfkHash : 0),
-( rtfKMajor: rtfFontFamily; rtfKMinor: 	rtfFFRoman; rtfKstr : 'froman'; rtfkHash : 0),
-( rtfKMajor: rtfFontFamily; rtfKMinor: 	rtfFFSwiss; rtfKstr : 'fswiss'; rtfkHash : 0),
-( rtfKMajor: rtfFontFamily; rtfKMinor: 	rtfFFModern; rtfKstr : 'fmodern'; rtfkHash : 0),
-( rtfKMajor: rtfFontFamily; rtfKMinor: 	rtfFFScript; rtfKstr : 'fscript'; rtfkHash : 0),
-( rtfKMajor: rtfFontFamily; rtfKMinor: 	rtfFFDecor; rtfKstr : 'fdecor'; rtfkHash : 0),
-( rtfKMajor: rtfFontFamily; rtfKMinor: 	rtfFFTech; rtfKstr : 'ftech'; rtfkHash : 0),
-
-( rtfKMajor: rtfColorName; rtfKMinor: 	rtfRed; rtfKstr : 'red'; rtfkHash : 0),
-( rtfKMajor: rtfColorName; rtfKMinor: 	rtfGreen; rtfKstr : 'green'; rtfkHash : 0),
-( rtfKMajor: rtfColorName; rtfKMinor: 	rtfBlue; rtfKstr : 'blue'; rtfkHash : 0),
-
-( rtfKMajor: rtfCharSet; rtfKMinor: 	rtfMacCharSet; rtfKstr : 'mac'; rtfkHash : 0),
-( rtfKMajor: rtfCharSet; rtfKMinor: 	rtfAnsiCharSet; rtfKstr : 'ansi'; rtfkHash : 0),
-( rtfKMajor: rtfCharSet; rtfKMinor: 	rtfPcCharSet; rtfKstr : 'pc'; rtfkHash : 0),
-( rtfKMajor: rtfCharSet; rtfKMinor: 	rtfPcaCharSet; rtfKstr : 'pca'; rtfkHash : 0),
-
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfCellBordBottom; rtfKstr : 'clbrdrb'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfCellBordTop; rtfKstr : 'clbrdrt'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfCellBordLeft; rtfKstr : 'clbrdrl'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfCellBordRight; rtfKstr : 'clbrdrr'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfRowDef; rtfKstr : 'trowd'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfRowLeft; rtfKstr : 'trql'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfRowRight; rtfKstr : 'trqr'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfRowCenter; rtfKstr : 'trqc'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfRowGapH; rtfKstr : 'trgaph'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfRowHt; rtfKstr : 'trrh'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfRowLeftEdge; rtfKstr : 'trleft'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfCellPos; rtfKstr : 'cellx'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfMergeRngFirst; rtfKstr : 'clmgf'; rtfkHash : 0),
-( rtfKMajor: rtfTblAttr; rtfKMinor: 	rtfMergePrevious; rtfKstr : 'clmrg'; rtfkHash : 0),
-
-( rtfKMajor: rtfFieldAttr; rtfKMinor: 	rtfFieldDirty; rtfKstr : 'flddirty'; rtfkHash : 0),
-( rtfKMajor: rtfFieldAttr; rtfKMinor: 	rtfFieldEdited; rtfKstr : 'fldedit'; rtfkHash : 0),
-( rtfKMajor: rtfFieldAttr; rtfKMinor: 	rtfFieldLocked; rtfKstr : 'fldlock'; rtfkHash : 0),
-( rtfKMajor: rtfFieldAttr; rtfKMinor: 	rtfFieldPrivate; rtfKstr : 'fldpriv'; rtfkHash : 0),
-
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfPosX; rtfKstr : 'posx'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfPosXCenter; rtfKstr : 'posxc'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfPosXInside; rtfKstr : 'posxi'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfPosXLeft; rtfKstr : 'posxl'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfPosXOutSide; rtfKstr : 'posxo'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfPosXRight; rtfKstr : 'posxr'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfPosY; rtfKstr : 'posy'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfPosYInline; rtfKstr : 'posyil'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfPosYTop; rtfKstr : 'posyt'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfPosYCenter; rtfKstr : 'posyc'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfPosYBottom; rtfKstr : 'posyb'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfAbsWid; rtfKstr : 'absw'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfTextDist; rtfKstr : 'dxfrtext'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfRPosMargV; rtfKstr : 'pvmrg'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfRPosPageV; rtfKstr : 'pvpg'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfRPosMargH; rtfKstr : 'phmrg'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfRPosPageH; rtfKstr : 'phpg'; rtfkHash : 0),
-( rtfKMajor: rtfPosAttr; rtfKMinor: 	rtfRPosColH; rtfKstr : 'phcol'; rtfkHash : 0),
-
-( rtfKMajor: rtfVersion; rtfKMinor: 	-1; rtfKstr : 'rtf'; rtfkHash : 0),
-( rtfKMajor: rtfDefFont; rtfKMinor: 	-1; rtfKstr : 'deff'; rtfkHash : 0),
-
-( rtfKMajor: 0; rtfKMinor: 		-1; rtfKstr : ''; rtfkHash : 0)
-);

fcl/inc/rtfpars.pp

@@ -1,1072 +0,0 @@
-Unit RTFPars;
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1998 by Michael Van Canneyt, Member of the 
-    Free Pascal development team
-
-    This unit implements a RTF Parser.
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-interface
-
-Uses classes,sysutils;
-
-{$i rtfdata.inc}
-
-type Trtferrorhandler = Procedure (s : string) of object;
-
-TRTFParser = class(TObject)
-  private
-    FOnRTFError : TRTFerrorHandler;
-    FfontList : PRTFFont;
-    FcolorList : PRTFColor;
-    FstyleList : PRTFStyle;
-    FrtfClass,
-    FrtfMajor,
-    FrtfMinor,
-    FrtfParam : Integer;
-    rtfTextBuf : string [rtfBufSiz];
-    rtfTextLen : Integer;
-    pushedChar : Integer;	        { pushback char if read too far }
-    pushedClass : Integer;	{ pushed token info for RTFUngetToken() }
-    pushedMajor,
-    pushedMinor,
-    pushedParam : Integer;
-    pushedTextBuf : String[rtfBufSiz];
-    FStream : TStream;
-    ccb : array [0..rtfMaxClass] of TRTFFuncPtr;		{ class callbacks }
-    dcb : array [0..rtfMaxDestination] of TRTFFuncPtr;	{ destination callbacks }
-    readHook : TRTFFUNCPTR;
-    Procedure Error (msg : String);
-    Procedure LookupInit ;
-    Procedure ReadFontTbl ;
-    Procedure ReadColorTbl;
-    Procedure ReadStyleSheet ;
-    Procedure ReadInfoGroup ;
-    Procedure ReadPictGroup ;
-    Function  CheckCM (Aclass, major: Integer) : Boolean;
-    Function  CheckCMM (Aclass, major, minor : Integer) : Boolean;
-    Function  CheckMM (major, minor : Integer) : Boolean;
-    Procedure Real_RTFGetToken;
-    Function  GetChar : Integer;
-    Procedure Lookup (S : String);
-    Function  GetFont (num : Integer) : PRTFFont;
-    Function  GetColor (num : Integer) : PRTFColor;
-    Function  GetStyle (num : Integer) : PRTFStyle;
-    Procedure setClassCallback (Aclass : Integer; Acallback : TRTFFuncPtr);
-    Function  GetClassCallback (Aclass : Integer) : TRTFFuncPtr;
-    Procedure SetDestinationCallback (ADestination : Integer; Acallback : TRTFFuncPtr);
-    Function  GetDestinationCallback (Adestination : Integer) : TRTFFuncPtr ;
-    Procedure SetStream (Astream : TStream);
-  public
-    Constructor Create (AStream : TStream);
-    Destructor  Destroy; override;
-    Procedure GetReadHook (Var q : TRTFFuncPtr);
-    Function  GetToken : Integer;
-    Function  PeekToken : Integer;
-    Procedure ResetParser;
-    Procedure RouteToken;
-    Procedure SkipGroup;
-    Procedure StartReading;
-    Procedure SetReadHook (Hook : TRTFFuncPtr);
-    Procedure UngetToken;
-    Procedure SetToken (Aclass, major, minor, param : Integer; text : string);
-    Procedure ExpandStyle (n : Integer);
-    { Properties }
-    Property Colors [Index : Integer]: PRTFColor Read GetColor;
-    Property ClassCallBacks [AClass : Integer]: TRTFFuncptr
-       Read GetClassCallBack
-       Write SetClassCallback;
-    Property DestinationCallBacks [Adestination : Integer]: TRTFFuncptr
-       Read GetdestinationCallBack
-       Write SetdestinationCallback;
-    Property Fonts [Index : Integer]: PRTFFont Read GetFont;
-    Property OnRTFError : TRTFerrorHandler Read FOnRTFError Write FOnRTFError;
-    Property rtfClass : Integer Read FrtfClass;
-    Property rtfMajor : Integer Read FrtfMajor;
-    Property rtfMinor : Integer Read FrtfMinor;
-    Property rtfParam : Integer Read FrtfParam;
-    Property Stream : TStream Read FStream Write SetStream;
-    Property Styles [index : Integer] : PRTFStyle Read GetStyle;
-  end;
-
-Implementation
-
-Const EOF = -255;
-
-{ ---------------------------------------------------------------------
-         Utility functions
-  ---------------------------------------------------------------------}
-
-Function Hash (s : String) : Integer;
-
-var
-  val,i : integer;
-
-Begin
-val:=0;
-for i:=1 to length(s) do
-  val:=val+ord(s[i]);
-Hash:=val;
-End;
-
-Function isalpha (s : integer) : Boolean;
-
-begin
-  result:= ( (s>=ord('A')) and (s<=ord('Z')))
-             or (((s>=ord('a')) and ((s<=ord('z')) ))
-            );
-end;
-
-Function isdigit (s : integer) : Boolean;
-
-begin
-  result:= ( (s>=ord('0')) and (s<=ord('9')) )
-end;
-
-Function HexVal (c : Integer) : Integer;
-
-Begin
-  if (c>=ord('A')) and (C<=ord('Z')) then inc (c,32);
-  if c<ord ('A') then
-    result:=(c - ord('0'))	{ '0'..'9' }
-  else
-    result:= (c - ord('a') + 10);		{ 'a'..'f' }
-End;
-
-{ ---------------------------------------------------------------------
-       Initialize the reader.  This may be called multiple times,
-       to read multiple files.  The only thing not reset is the input
-       stream; that must be done with RTFSetStream().
-  ---------------------------------------------------------------------}
-  
-Constructor TRTFParser.Create (Astream : TStream);
-
-Begin
-inherited create;
-{ initialize lookup table }
-LookupInit ;
-Fstream := Astream;
-FfontList  :=nil;
-FcolorList :=nil;
-FstyleList :=nil;
-onrtferror:=nil;
-ResetParser;
-end;
-
-Procedure TRTFParser.ResetParser;
-
-var
-  cp : PRTFColor;
-  fp : PRTFFont;
-  sp : PRTFStyle;
-  ep,eltlist : PRTFStyleElt;
-  i : integer;
-
-begin
-
-for i:=0 to rtfMaxClass-1 do
-  setClassCallback (i, Nil);
-for i:=0 to rtfMaxDestination-1 do
-  SetDestinationCallback (i,nil);
-
-{ install built-in destination readers }
-SetDestinationCallback (rtfFontTbl, @ReadFontTbl);
-SetDestinationCallback (rtfColorTbl, @ReadColorTbl);
-SetDestinationCallback (rtfStyleSheet, @ReadStyleSheet);
-SetDestinationCallback (rtfInfo, @ReadInfoGroup);
-SetDestinationCallback (rtfPict, @ReadPictGroup);
-
-SetReadHook (Nil);
-
-{ dump old lists if necessary }
-
-while FfontList<>nil do
-  Begin
-  fp := FfontList^.rtfNextFont;
-  dispose (FfontList);
-  FfontList := fp;
-  End;
-while FcolorList<>nil do
-  Begin
-  cp := FcolorList^.rtfNextColor;
-  dispose (FcolorList);
-  FcolorList := cp;
-  End;
-while FstyleList<>nil do
-  Begin
-  sp := FstyleList^.rtfNextStyle;
-  eltList := FstyleList^.rtfSSEList;
-  while eltList<>nil do
-    Begin
-    ep:=eltList^.rtfNextSE;
-    dispose(eltList);
-    eltList:= ep;
-    End;
-  Dispose (FstyleList);
-  FstyleList := sp;
-  End;
-FrtfClass := -1;
-pushedClass := -1;
-pushedChar := EOF;
-{ Reset the stream if it is assigned }
-if assigned (FStream) then
-  FStream.seek(0,soFromBeginning);
-End;
-
-
-Destructor TRTFParser.Destroy;
-
-var
-  cp : PRTFColor;
-  fp : PRTFFont;
-  sp : PRTFStyle;
-  ep,eltlist : PRTFStyleElt;
-
-begin
-  { Dump the lists. }
-  while FfontList<>nil do
-    Begin
-    fp := FfontList^.rtfNextFont;
-    dispose (FfontList);
-    FfontList := fp;
-    End;
-  while FcolorList<>nil do
-    Begin
-  cp := FcolorList^.rtfNextColor;
-  dispose (FcolorList);
-    FcolorList := cp;
-    End;
-  while FstyleList<>nil do
-    Begin
-    sp := FstyleList^.rtfNextStyle;
-    eltList := FstyleList^.rtfSSEList;
-    while eltList<>nil do
-      Begin
-      ep:=eltList^.rtfNextSE;
-      dispose(eltList);
-      eltList:= ep;
-      End;
-    Dispose (FstyleList);
-    FstyleList := sp;
-    End;
-  { Dump rest }
-  inherited destroy;
-end;
-
-
-{ ---------------------------------------------------------------------
-       Callback table manipulation routines
-  ---------------------------------------------------------------------}
-
-Procedure TRTFParser.SetClassCallback (Aclass : Integer; Acallback : TRTFFuncPtr);
-
-Begin
-  if (aclass>=0) and (Aclass<rtfMaxClass) then
-    ccb[Aclass]:= Acallback;
-End;
-
-
-Function TRTFParser.GetClassCallback (Aclass : Integer) : TRTFFuncPtr;
-
-Begin
-  if (Aclass>=0) and (Aclass<rtfMaxClass) then
-    GetClassCallback :=ccb[Aclass]
-  else
-    GetClassCallback:=nil;
-End;
-
-{ ---------------------------------------------------------------------
-   Install or return a writer callback for a destination type
-  ---------------------------------------------------------------------}
-  
-Procedure TRTFParser.SetDestinationCallback (ADestination : Integer; Acallback : TRTFFuncPtr);
-
-Begin
-  if (Adestination>=0) and (Adestination<rtfMaxDestination) then
-    dcb[ADestination] := Acallback;
-End;
-
-
-Function TRTFParser.GetDestinationCallback (Adestination : Integer) : TRTFFuncPtr ;
-
-Begin
-  if (Adestination>=0) and (ADestination<rtfMaxDestination) then
-    Result:=dcb[Adestination]
-  Else
-    Result:=nil;
-End;
-
-
-{ ---------------------------------------------------------------------
-       Token reading routines
-  ---------------------------------------------------------------------}
-
-{ Read the input stream, invoking the writer's callbacks where appropriate. }
-Procedure TRTFParser.StartReading;
-
-Begin
-  { Reset stream. }
-  FStream.Seek (0,soFromBeginning);
-  { Start reading. }
-  while (GetToken<>rtfEOF) do
-    RouteToken;
-End;
-
-
-{ Route a token.  If it's a destination for which a reader is
-  installed, process the destination internally, otherwise
-  pass the token to the writer's class callback. }
-Procedure TRTFParser.RouteToken;
-
-Var
-  p : TRTFFuncPtr;
-
-Begin
-  if (rtfClass < 0) or (rtfClass>=rtfMaxClass) then
-    Error ('No such class : '+rtfTextBuf)
-  else
-    begin
-    if (CheckCM (rtfControl, rtfDestination)) then
-      Begin
-      { invoke destination-specific callback if there is one }
-      p:=GetDestinationCallback (rtfMinor);
-      if assigned(p) then
-        Begin
-        p;
-        exit
-        End;
-      End;
-    { invoke class callback if there is one }
-    p:= GetClassCallback (rtfClass);
-    if assigned(p) then
-      p;
-    end;
-End;
-
-
-{ Skip to the end of the current group.  When this returns,
-  writers that maintain a state stack may want to call their
-  state unstacker; global vars will still be set to the group's
-  closing brace. }
-Procedure TRTFParser.SkipGroup;
-
-Var
-  level : Integer;
-Begin
-  level:= 1;
-  while (GetToken<>rtfEOF) do
-    if (rtfClass=rtfGroup) then
-       Begin
-       if (rtfMajor=rtfBeginGroup) then
-         inc(level)
-       else if (rtfMajor=rtfEndGroup) then
-          Begin
-          dec(level);
-          if (level < 1) then
-            exit;	{ end of initial group }
-          End;
-       End;
-End;
-
-{ Read one token.  Call the read hook if there is one.  The
-  token class is the return value.  Returns rtfEOF when there
-  are no more tokens. }
-Function TRTFParser.GetToken : Integer;
-
-var p : TRTFFuncPTR;
-
-Begin
-GetReadHook (p);
-while true do
-  Begin
-  Real_RTFGetToken;
-  if (assigned(p)) then
-    p;	{ give read hook a look at token }
-  { Silently discard newlines and carriage returns.  }
-  if not ((rtfClass=rtfText) and ((rtfMajor=13) or (rtfmajor=10))) then
-    break;
-  End;
-result:=rtfClass;
-End;
-
-
-{ ---------------------------------------------------------------------
-   Install or return a token reader hook.
-  ---------------------------------------------------------------------}
-
-Procedure TRTFParser.SetReadHook (Hook : TRTFFuncPtr);
-
-Begin
- readHook := Hook;
-End;
-
-Procedure TRTFParser.GetReadHook (Var q : TRTFFuncPtr);
-
-Begin
-  Q:=readHook;
-End;
-
-
-Procedure TRTFParser.UngetToken;
-
-Begin
-if (pushedClass >= 0) then	{ there's already an ungotten token }
-        Error ('cannot unget two tokens');
-if (rtfClass < 0) then
-        Error ('no token to unget');
-pushedClass := rtfClass;
-pushedMajor := rtfMajor;
-pushedMinor := rtfMinor;
-pushedParam := rtfParam;
-rtfTextBuf  := pushedTextBuf;
-End;
-
-
-Function TRTFParser.PeekToken : Integer;
-
-Begin
-  Real_RTFGetToken;
-  UngetToken;
-  Result:=rtfClass;
-End;
-
-
-
-Procedure TRTFParser.Real_RTFGetToken;
-
-var sign,c,c2 : Integer;
-
-Begin
-{ check for pushed token from RTFUngetToken() }
-if (pushedClass >= 0) then
-  Begin
-  FrtfClass    := pushedClass;
-  FrtfMajor    := pushedMajor;
-  FrtfMinor    := pushedMinor;
-  FrtfParam    := pushedParam;
-  rtfTextBuf  := pushedTextBuf;
-  rtfTextLen  := length (rtfTextBuf);
-  pushedClass := -1;
-  exit;
-  End;
-{ initialize token vars }
-FrtfClass   := rtfUnknown;
-FrtfParam   := rtfNoParam;
-rtfTextBuf := '';
-rtfTextLen := 0;
-
-{ get first character, which may be a pushback from previous token }
-
-if (pushedChar <> EOF) then
-  Begin
-  c := pushedChar;
-  rtfTextBuf:=rtfTextBuf+chr(c);
-  inc(rtftextlen);
-  pushedChar := EOF;
-  End
-else
- begin
- c:=GetChar;
- if C=EOF then
-   Begin
-   FrtfClass := rtfEOF;
-   exit;
-   End;
- end;
-if c=ord('{') then
-  Begin
-  FrtfClass := rtfGroup;
-  FrtfMajor := rtfBeginGroup;
-  exit;
-  End;
-if c=ord('}') then
-  Begin
-  FrtfClass := RTFGROUP;
-  FrtfMajor := rtfEndGroup;
-  exit;
-  End;
-if c<>ord('\') then
-  Begin
-  { Two possibilities here:
-    1) ASCII 9, effectively like \tab control symbol
-    2) literal text char }
-  if c=ord(#8) then			{ ASCII 9 }
-    Begin
-    FrtfClass := rtfControl;
-    FrtfMajor := rtfSpecialChar;
-    FrtfMinor := rtfTab;
-    End
-  else
-    Begin
-    FrtfClass := rtfText;
-    FrtfMajor := c;
-    End;
-  exit;
-End;
-c:=getchar;
-if (c=EOF) then
-  { early eof, whoops (class is rtfUnknown) }
-  exit;
-if ( not isalpha (c)) then
-  Begin
-  { Three possibilities here:
-   1) hex encoded text char, e.g., \'d5, \'d3
-   2) special escaped text char, e.g., \, \;
-   3) control symbol, e.g., \_, \-, \|, \<10> }
-  if c=ord('''') then { hex char }
-     Begin
-     c:=getchar;
-     if (c<>EOF) then
-       begin
-       c2:=getchar;
-       if (c2<>EOF) then
-         Begin
-         { should do isxdigit check! }
-         FrtfClass := rtfText;
-         FrtfMajor := HexVal (c) * 16 + HexVal (c2);
-         exit;
-         End;
-       end;
-       { early eof, whoops (class is rtfUnknown) }
-       exit;
-       End;
-  if pos (chr(c),':{};\')<>0 then { escaped char }
-    Begin
-    FrtfClass := rtfText;
-    FrtfMajor := c;
-    exit;
-    End;
-   { control symbol }
-   Lookup (rtfTextBuf);	{ sets class, major, minor }
-   exit;
-  End;
-{ control word }
-while (isalpha (c)) do
-  Begin
-  c:=GetChar;
-  if (c=EOF) then
-    break;
-  End;
-{ At this point, the control word is all collected, so the
-  major/minor numbers are determined before the parameter
-  (if any) is scanned.  There will be one too many characters
-  in the buffer, though, so fix up before and restore after
-  looking up. }
-if (c<>EOF) then
-  delete(rtfTextBuf,length(rtfTextbuf),1);
-Lookup (rtfTextBuf);	{ sets class, major, minor }
-if (c <>EOF) then
-  rtfTextBuf:=rtfTextBuf+chr(c);
-{ Should be looking at first digit of parameter if there
-  is one, unless it's negative.  In that case, next char
-  is '-', so need to gobble next char, and remember sign. }
-sign := 1;
-if c = ord('-') then
-  Begin
-  sign := -1;
-  c := GetChar;
-  End;
-if (c<>EOF) then
-  if isdigit (c) then
-  Begin
-  FrtfParam := 0;
-  while (isdigit (c)) do	{ gobble parameter }
-    Begin
-    FrtfParam := FrtfParam * 10 + c - ord('0');
-    c:=GetChar;
-    if (c=EOF) then
-      break;
-    End;
-  FrtfParam:= sign*FrtfParam;
-  End;
-{ If control symbol delimiter was a blank, gobble it.
- Otherwise the character is first char of next token, so
- push it back for next call.  In either case, delete the
- delimiter from the token buffer. }
-if (c<>EOF) then
-  Begin
-  if c<>ord (' ') then
-     pushedChar := c;
-  Delete (rtfTextBuf,rtfTextLen,1);
-  Dec (rtfTextLen);
-  End;
-End;
-
-Function TRTFParser.GetChar : Integer;
-
-var c : byte;
-
-Begin
-  if FStream.read(c,1)<>0 then
-    begin
-    if (c and 128)=128 then c:=ord('?');
-    Result:=c;
-    rtfTextBuf:=rtfTextBuf+chr(c);
-    inc(rtfTextLen);
-    end
-  else
-    Result:=EOF;
-End;
-
-{ Synthesize a token by setting the global variables to the
-  values supplied.  Typically this is followed with a call
-  to RTFRouteToken().
-  If param is non-negative, it becomes part of the token text. }
-Procedure TRTFParser.SetToken (Aclass, major, minor, param : Integer; text : string);
-
-Begin
-  FrtfClass := Aclass;
-  FrtfMajor := major;
-  FrtfMinor := minor;
-  FrtfParam := param;
-  if (param=rtfNoParam) then
-     rtfTextBuf:=text
-  else
-     rtfTextBuf:=text+IntTostr(param);
-  rtfTextLen:=length(rtfTextBuf);
-End;
-
-{ ---------------------------------------------------------------------
-       Special destination readers.  They gobble the destination so the
-       writer doesn't have to deal with them.  That's wrong for any
-       translator that wants to process any of these itself.  In that
-       case, these readers should be overridden by installing a different
-       destination callback.
-
-       NOTE: The last token read by each of these reader will be the
-       destination's terminating '', which will then be the current token.
-       That 'End;' token is passed to RTFRouteToken() - the writer has already
-       seen the 'Begin' that began the destination group, and may have pushed a
-       state; it also needs to know at the end of the group that a state
-       should be popped.
-
-       It's important that rtfdata.inc and the control token lookup table list
-       as many symbols as possible, because these readers unfortunately
-       make strict assumptions about the input they expect, and a token
-       of class rtfUnknown will throw them off easily.
- ----------------------------------------------------------------------}
-
-
-{ Read Begin \fonttbl ... End; destination.  Old font tables don't have
-  braces around each table entry; try to adjust for that.}
-Procedure TRTFParser.ReadFontTbl;
-
-var
-  fp : PRTFFont;
-  bp : string[rtfbufsiz];
-  old : Integer;
-
-Begin
-old := -1;
-While true do
-  Begin
-  GetToken;
-  if CheckCM (rtfGroup, rtfEndGroup) then
-      break;
-  if (old < 0) then		{ first entry - determine tbl type }
-    Begin
-    if CheckCMM (rtfControl, rtfCharAttr, rtfFontNum) then
-      old:=1	{ no brace }
-    else if CheckCM (rtfGroup, rtfBeginGroup) then
-      old:= 0	{ brace }
-    else			{ can't tell! }
-      Error ('FTErr - Cannot determine format')
-    End;
-  if (old=0) then	{ need to find "Begin" here }
-    Begin
-    if not CheckCM (rtfGroup, rtfBeginGroup) then
-      Error ('FTErr - missing {');
-    GetToken;	{ yes, skip to next token }
-    End;
-  new(fp);
-  if (fp=nil) then
-     Error ('FTErr - cannot allocate font entry');
-  fp^.rtfNextFont:= FfontList;
-  FfontList:=fp;
-  if not CheckCMM (rtfControl, rtfCharAttr, rtfFontNum) then
-     Error ('FTErr - missing font number');
-  fp^.rtfFNum := rtfParam;
-  { Read optionalcommands. Recognize only fontfamily}
-  GetToken;
-  if not CheckCM (rtfControl, rtfFontFamily) then
-    error ('FTErr - missing font family ');
-  fp^.rtfFFamily := rtfMinor;
-  { Read optional commands/groups. Recognize none at this point..}
-  GetToken;
-  while (rtfclass=rtfcontrol) or ((rtfclass=rtfgroup) or (rtfclass=rtfunknown)) do
-    begin
-    if rtfclass=rtfgroup then SkipGroup;
-    GetToken
-    end;
-  { Read font name }
-  bp:='';
-  while (rtfclass=rtfText) do
-    Begin
-    if rtfMajor=ord(';') then
-       break;
-    bp:=bp+chr(rtfMajor);
-    GetToken
-    End;
-  if bp='' then
-     Error ('FTErr - missing font name');
-  fp^.rtffname:=bp;
-  { Read alternate font}
-  if (old=0) then	{ need to see "End;" here }
-    Begin
-    GetToken;
-    if not CheckCM (rtfGroup, rtfEndGroup) then
-       Error ('FTErr - missing }');
-    End;
-  End;
-RouteToken;	{ feed "End;" back to router }
-End;
-
-
-{ The color table entries have color values of -1 if
-  the default color should be used for the entry (only
-  a semi-colon is given in the definition, no color values).
-  There will be a problem if a partial entry (1 or 2 but
-  not 3 color values) is given.  The possibility is ignored
-  here. }
-Procedure TRTFParser.ReadColorTbl;
-
-var
-  cp   : PRTFColor;
-  cnum : Integer;
-
-Begin
-cnum:=0;
-While true do
-  Begin
-  GetToken;
-  if CheckCM (rtfGroup, rtfEndGroup) then
-    break;
-  new(cp);
-  if (cp=nil) then
-    Error ('CTErr - cannot allocate color entry');
-  cp^.rtfCNum  :=cnum;
-  cp^.rtfCRed  :=-1;
-  cp^.rtfCGreen:=-1;
-  cp^.rtfCBlue :=-1;
-  cp^.rtfNextColor := FColorList;
-  inc(cnum);
-  FcolorList:=cp;
-  while true do
-    Begin
-    if not CheckCM (rtfControl, rtfColorName) then
-       break;
-    case rtfMinor of
-      rtfRed:	cp^.rtfCRed   :=rtfParam;
-      rtfGreen:	cp^.rtfCGreen :=rtfParam;
-      rtfBlue:	cp^.rtfCBlue  :=rtfParam;
-    End;
-    GetToken;
-    End;
-  if not CheckCM (rtfText, ord(';')) then
-     Error ('CTErr - malformed entry');
-  End;
-RouteToken;	{ feed "End;" back to router }
-End;
-
-
-{ The "Normal" style definition doesn't contain any style number
- (why?), all others do.  Normal style is given style 0. }
-
-Procedure TRTFParser.ReadStyleSheet;
-
-var
-  sp          : PRTFStyle;
-  sep,sepLast : PRTFStyleElt;
-  bp          : string[rtfBufSiz];
-
-Begin
-While true do
-  Begin
-  GetToken;
-  if CheckCM (rtfGroup, rtfEndGroup) then
-      break;
-  new (sp);
-  if sp=nil then
-     Error ('SSErr - cannot allocate stylesheet entry');
-  sp^.rtfSNum := -1;
-  sp^.rtfSBasedOn := rtfBasedOnNone;
-  sp^.rtfSNextPar := -1;
-  sp^.rtfSSEList := nil;
-  sepLast:=nil;
-  sp^.rtfNextStyle := FstyleList;
-  sp^.rtfExpanding := 0;
-  FstyleList := sp;
-  if not CheckCM (rtfGroup, rtfBeginGroup) then
-     Error ('SSErr - missing {');
-  while GetToken=rtfControl do
-    Begin
-    if (CheckMM (rtfParAttr, rtfStyleNum)) then
-      Begin
-      sp^.rtfSNum:=rtfParam;
-      break;
-      End;
-    if (CheckMM (rtfStyleAttr, rtfBasedOn)) then
-      Begin
-      sp^.rtfSBasedOn:=rtfParam;
-      break;
-      End;
-    if (CheckMM (rtfStyleAttr, rtfNext)) then
-      Begin
-      sp^.rtfSNextPar:=rtfParam;
-      break;
-      End;
-    new(sep);
-    if sep=nil then
-      Error ('SSErr - cannot allocate style element');
-    sep^.rtfSEClass:=rtfClass;
-    sep^.rtfSEMajor:=rtfMajor;
-    sep^.rtfSEMinor:=rtfMinor;
-    sep^.rtfSEParam:=rtfParam;
-    sep^.rtfSEText:=rtfTextBuf;
-    if sepLast=nil then
-       sp^.rtfSSEList:=sep	{ first element }
-    else				{ add to end }
-       sepLast^.rtfNextSE:=sep;
-    sep^.rtfNextSE:=nil;
-    sepLast:=sep;
-    End;
-  if sp^.rtfSNextPar=-1 then		{ \snext not given }
-    sp^.rtfSNextPar:=sp^.rtfSNum;	{ next is itself }
-  if rtfClass<>rtfText then
-     Error ('SSErr - missing style name');
-  while rtfClass=rtfText do
-    Begin
-    if rtfMajor=ord(';') then
-      Begin
-      GetToken;
-      break;
-      End;
-    bp:=bp+chr(rtfMajor);
-    GetToken;
-    End;
-  if (sp^.rtfSNum < 0) then	{ no style number was specified }
-    Begin			{ (only legal for Normal style) }
-    if bp<>'Normal' then
-       Error ('SSErr - missing style number');
-    sp^.rtfSNum:=0;
-    End;
-  sp^.rtfSName:=bp;
-  if not CheckCM (rtfGroup, rtfEndGroup) then
-      Error ('SSErr - missing }');
-  End;
-RouteToken;	{ feed "End;" back to router }
-End;
-
-
-Procedure TRTFParser.ReadInfoGroup;
-
-Begin
-  SkipGroup ;
-  RouteToken ;	{ feed "End;" back to router }
-End;
-
-
-Procedure TRTFParser.ReadPictGroup;
-
-Begin
-  SkipGroup ;
-  RouteToken ;	{ feed "End;" back to router }
-End;
-
-
-{ ----------------------------------------------------------------------
-    Routines to return pieces of stylesheet, or font or color tables
-  ----------------------------------------------------------------------}
-
-
-Function TRTFParser.GetStyle (num : Integer) : PRTFStyle;
-
-var
-  s : PRTFSTyle;
-
-Begin
-s:=Fstylelist;
-if num<>1 then
-  while s<>nil do
-    Begin
-    if (s^.rtfSNum=num) then break;
-    s:=s^.rtfNextStyle;
-    End;
-result:=s;		{ NULL if not found }
-End;
-
-
-Function TRTFParser.GetFont (num : Integer) : PRTFFont;
-
-Var
-  f :PRTFFont;
-
-Begin
-f:=FfontList;
-if num<>-1 then
-  while f<>nil do
-    Begin
-    if f^.rtfFNum=num then break;
-    f:=f^.rtfNextFont;
-    End;
-result:=f;		{ NULL if not found }
-End;
-
-Function TRTFParser.GetColor (num : Integer) : PRTFColor;
-
-var
-  c : PRTFColor;
-
-Begin
-c:=Fcolorlist;
-if (num<>-1) then
-  while c<>nil do
-    Begin
-    if c^.rtfCNum=num then break;
-    c:=c^.rtfNextColor;
-    End;
-Result:=c;		{ NULL if not found }
-End;
-
-{ ---------------------------------------------------------------------
-       Expand style n, if there is such a style.
-  ---------------------------------------------------------------------}
-
-Procedure TRTFParser.ExpandStyle (n : Integer);
-
-var
-  s  : PRTFStyle;
-  se : PRTFStyleElt;
-
-Begin
-if n=-1 then exit;
-s:=GetStyle (n);
-if s=nil then exit;
-
-if (s^.rtfExpanding<>0) then
-  Error ('Style expansion loop, style '+inttostr(n));
-s^.rtfExpanding:=1;	{ set expansion flag for loop detection }
-{
-        Expand "based-on" style.  This is done by synthesizing
-        the token that the writer needs to see in order to trigger
-        another style expansion, and feeding to token back through
-        the router so the writer sees it.
-}
-SetToken (rtfControl, rtfParAttr, rtfStyleNum, s^.rtfSBasedOn, '\s');
-RouteToken;
-{
-        Now route the tokens unique to this style.  RTFSetToken()
-        isn't used because it would add the param value to the end
-        of the token text, which already has it in.
-}
-se:=s^.rtfSSEList;
-while se<>nil do
-  Begin
-  FrtfClass:=se^.rtfSEClass;
-  FrtfMajor:=se^.rtfSEMajor;
-  FrtfMinor:=se^.rtfSEMinor;
-  FrtfParam:=se^.rtfSEParam;
-  rtfTextBuf:=se^.rtfSEText;
-  rtfTextLen:=length (rtfTextBuf);
-  RouteToken;
-  se:=se^.rtfNextSE
-  End;
-s^.rtfExpanding:=0;	{ done - clear expansion flag }
-End;
-
-{ ---------------------------------------------------------------------
-       Initialize lookup table hash values.
-       Only need to do this the first time it's called.
-  ---------------------------------------------------------------------}
-
-Procedure TRTFParser.LookupInit;
-
-var count : Integer;
-
-Begin
-count:=0;
-while rtfkey[count].rtfKStr<>'' do
-  begin
-  rtfkey[count].rtfKHash:=Hash (rtfkey[count].rtfKStr);
-  inc(count)
-  End;
-End;
-
-
-{ ---------------------------------------------------------------------
-       Determine major and minor number of control token.  If it's
-       not found, the class turns into rtfUnknown.
-  ---------------------------------------------------------------------}
-
-Procedure TRTFParser.Lookup (S : String);
-
-var
- thehash,rp : Integer;
-
-Begin
-delete(s,1,1);			{ skip over the leading \ character }
-thehash:=Hash (s);
-rp:=0;
-while rtfkey[rp].rtfKstr<>'' do
-  Begin
-  if (thehash=rtfkey[rp].rtfKHash) and (s=rtfkey[rp].rtfKStr) then
-     Begin
-     FrtfClass:=rtfControl;
-     FrtfMajor:=rtfkey[rp].rtfKMajor;
-     FrtfMinor:=rtfkey[rp].rtfKMinor;
-     exit;
-     End;
-  inc(rp);
-  End;
-FrtfClass:=rtfUnknown;
-End;
-
-
-Procedure TRTFParser.Error (msg : String);
-
-{ Call errorhandler }
-
-begin
-  if assigned(onrtferror) then onrtferror(msg);
-end;
-
-{ ---------------------------------------------------------------------
-       Token comparison routines
-  ---------------------------------------------------------------------}
-
-Function TRTFParser.CheckCM (Aclass, major: Integer) : Boolean;
-Begin
-  Result:=(rtfClass=Aclass) and (rtfMajor=major);
-End;
-
-
-Function TRTFParser.CheckCMM (Aclass, major, minor : Integer) : Boolean;
-
-Begin
-  Result:=(rtfClass=Aclass) and ((rtfMajor=major) and (rtfMinor=minor));
-End;
-
-
-Function TRTFParser.CheckMM (major, minor : Integer) : Boolean;
-
-Begin
-  Result:=(rtfMajor=major) and (rtfMinor=minor);
-End;
-
-Procedure TRTFParser.SetStream (Astream : TStream);
-
-begin
-  FStream:=Astream;
-end;
-
-end.

fcl/inc/streams.inc

@@ -1,641 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TStream                                      *}
-{****************************************************************************}
-
-  function TStream.GetPosition: Longint;
-
-    begin
-       Result:=Seek(0,soFromCurrent);
-    end;
-
-  procedure TStream.SetPosition(Pos: Longint);
-
-    begin
-       Seek(pos,soFromBeginning);
-    end;
-
-  function TStream.GetSize: Longint;
-
-    var
-       p : longint;
-
-    begin
-       p:=GetPosition;
-       GetSize:=Seek(0,soFromEnd);
-       Seek(p,soFromBeginning);
-    end;
-
-  procedure TStream.SetSize(NewSize: Longint);
-
-    begin
-    // We do nothing. Pipe streams don't support this
-    // As wel as possible read-ony streams !!
-    end;
-
-  procedure TStream.ReadBuffer(var Buffer; Count: Longint);
-
-    begin
-       if Read(Buffer,Count)<Count then
-         Raise EReadError.Create(SReadError);
-    end;
-
-  procedure TStream.WriteBuffer(const Buffer; Count: Longint);
-
-    begin
-       if Write(Buffer,Count)<Count then
-         Raise EWriteError.Create(SWriteError);
-    end;
-
-  function TStream.CopyFrom(Source: TStream; Count: Longint): Longint;
-
-    var
-       i : longint;
-       buffer : array[0..1023] of byte;
-
-    begin
-       CopyFrom:=0;
-       while Count>0 do
-         begin
-            if (Count>sizeof(buffer)) then
-              i:=sizeof(Buffer)
-            else
-              i:=Count;
-            i:=Source.Read(buffer,i);
-            i:=Write(buffer,i);
-            dec(count,i);
-            CopyFrom:=CopyFrom+i;
-            if i=0 then
-              exit;
-         end;
-    end;
-
-  function TStream.ReadComponent(Instance: TComponent): TComponent;
-
-    var
-       Reader : TReader;
-
-    begin
-       Reader.Create(Self,1024);
-       if assigned(Instance) then
-         ReadComponent:=Reader.ReadRootComponent(Instance)
-       else
-         begin
-            {!!!!!}
-         end;
-       Reader.Destroy;
-    end;
-
-  function TStream.ReadComponentRes(Instance: TComponent): TComponent;
-
-    begin
-       {!!!!!}
-       ReadComponentRes:=nil;
-    end;
-
-  procedure TStream.WriteComponent(Instance: TComponent);
-
-    var
-       Writer : TWriter;
-
-    begin
-       Try
-         Writer.Create(Self,1024);
-         Writer.WriteRootComponent(Instance);
-       Finally
-         Writer.Destroy;
-       end;
-    end;
-
-  procedure TStream.WriteComponentRes(const ResName: string; Instance: TComponent);
-
-    var
-       startpos,s : longint;
-
-    begin
-{$ifdef Win16Res}
-       { Numeric resource type }
-       WriteByte($ff);
-       { Application defined data }
-       WriteWord($0a);
-       { write the name as asciiz }
-//       WriteBuffer(ResName[1],length(ResName));
-       WriteByte(0);
-       { Movable, Pure and Discardable }
-       WriteWord($1030);
-       { size isn't known yet }
-       WriteDWord(0);
-       startpos:=GetPosition;
-       WriteComponent(Instance);
-       { calculate size }
-       s:=GetPosition-startpos;
-       { back patch size }
-       SetPosition(startpos-4);
-       WriteDWord(s);
-{$endif Win16Res}
-    end;
-
-  procedure TStream.WriteDescendent(Instance, Ancestor: TComponent);
-
-    begin
-       {!!!!!}
-    end;
-
-  procedure TStream.WriteDescendentRes(const ResName: string; Instance, Ancestor: TComponent);
-
-    begin
-       {!!!!!}
-    end;
-
-  procedure TStream.ReadResHeader;
-
-    begin
-{$ifdef Win16Res}
-       try
-         { application specific resource ? }
-         if ReadByte<>$ff then
-           raise EInvalidImage.Create('');
-         if ReadWord<>$000a then
-           raise EInvalidImage.Create('');
-         { read name }
-         while ReadByte<>0 do
-           ;
-         { check the access specifier }
-         if ReadWord<>$1030 then
-           raise EInvalidImage.Create('');
-         { ignore the size }
-         ReadDWord;
-       except
-{/////
-         on EInvalidImage do
-           raise;
-         else
-           raise EInvalidImage.create(SInvalidImage);
-}
-       end;
-{$endif Win16Res}
-    end;
-
-  function TStream.ReadByte : Byte;
-
-    var
-       b : Byte;
-
-    begin
-       ReadBuffer(b,1);
-       ReadByte:=b;
-    end;
-
-  function TStream.ReadWord : Word;
-
-    var
-       w : Word;
-
-    begin
-       ReadBuffer(w,2);
-       ReadWord:=w;
-    end;
-
-  function TStream.ReadDWord : Cardinal;
-
-    var
-       d : Cardinal;
-
-    begin
-       ReadBuffer(d,4);
-       ReadDWord:=d;
-    end;
-
-  Function TStream.ReadAnsiString : String;
-  Type
-    PByte = ^Byte;
-  Var
-    TheSize : Longint;
-    P : PByte ;
-  begin
-    ReadBuffer (TheSize,SizeOf(TheSize));
-    SetLength(Result,TheSize);
-    // Illegal typecast if no AnsiStrings defined.
-    if TheSize>0 then
-     begin
-       ReadBuffer (Pointer(Result)^,TheSize);
-       P:=Pointer(Result)+TheSize;
-       p^:=0;
-     end;
-   end;
-
-  Procedure TStream.WriteAnsiString (S : String);
-
-  Var L : Longint;
-
-  begin
-    L:=Length(S);
-    WriteBuffer (L,SizeOf(L));
-    WriteBuffer (Pointer(S)^,L);
-  end;
-
-  procedure TStream.WriteByte(b : Byte);
-
-    begin
-       WriteBuffer(b,1);
-    end;
-
-  procedure TStream.WriteWord(w : Word);
-
-    begin
-       WriteBuffer(w,2);
-    end;
-
-  procedure TStream.WriteDWord(d : Cardinal);
-
-    begin
-       WriteBuffer(d,4);
-    end;
-
-
-{****************************************************************************}
-{*                             THandleStream                                *}
-{****************************************************************************}
-
-Constructor THandleStream.Create(AHandle: Integer);
-
-begin
-  FHandle:=AHandle;
-end;
-
-
-function THandleStream.Read(var Buffer; Count: Longint): Longint;
-
-begin
-  Result:=FileRead(FHandle,Buffer,Count);
-  If Result=-1 then Result:=0;
-end;
-
-
-function THandleStream.Write(const Buffer; Count: Longint): Longint;
-
-begin
-  Result:=FileWrite (FHandle,Buffer,Count);
-  If Result=-1 then Result:=0;
-end;
-
-
-
-
-{****************************************************************************}
-{*                             TFileStream                                  *}
-{****************************************************************************}
-
-constructor TFileStream.Create(const AFileName: string; Mode: Word);
-
-begin
-  FFileName:=AFileName;
-  If Mode=fmcreate then
-    FHandle:=FileCreate(AFileName)
-  else
-    FHAndle:=FileOpen(AFileName,Mode);
-  If FHandle<0 then
-    If Mode=fmcreate then
-      raise EFCreateError.createfmt(SFCreateError,[AFileName])
-    else
-      raise EFOpenError.Createfmt(SFOpenError,[AFilename]);
-end;
-
-
-destructor TFileStream.Destroy;
-
-begin
-  FileClose(FHandle);
-end;
-
-Procedure TFileStream.SetSize(NewSize: Longint);
-
-begin
-  FileTruncate(FHandle,NewSize);
-end;
-
-
-function TFileStream.Seek(Offset: Longint; Origin: Word): Longint;
-
-begin
-  Result:=FileSeek(FHandle,Offset,Origin);
-end;
-
-
-{****************************************************************************}
-{*                             TCustomMemoryStream                          *}
-{****************************************************************************}
-
-procedure TCustomMemoryStream.SetPointer(Ptr: Pointer; ASize: Longint);
-
-begin
-  FMemory:=Ptr;
-  FSize:=ASize;
-end;
-
-
-function TCustomMemoryStream.Read(var Buffer; Count: Longint): Longint;
-
-begin
-  Result:=0;
-  If (FSize>0) and (FPosition<Fsize) then
-    begin
-    Result:=FSize-FPosition;
-    If Result>Count then Result:=Count;
-    Move ((FMemory+FPosition)^,Buffer,Result);
-    FPosition:=Fposition+Result;
-    end;
-end;
-
-
-function TCustomMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
-
-begin
-  Case Origin of
-    soFromBeginning : FPosition:=Offset;
-    soFromEnd       : FPosition:=FSize+Offset;
-    soFromCurrent   : FpoSition:=FPosition+Offset;
-  end;
-  Result:=FPosition;
-end;
-
-
-procedure TCustomMemoryStream.SaveToStream(Stream: TStream);
-
-begin
-  if FSize>0 then Stream.WriteBuffer (FMemory^,FSize);
-end;
-
-
-procedure TCustomMemoryStream.SaveToFile(const FileName: string);
-
-Var S : TFileStream;
-
-begin
-  Try
-    S:=TFileStream.Create (FileName,fmCreate);
-    SaveToStream(S);
-  finally
-    S.free;
-  end;
-end;
-
-
-{****************************************************************************}
-{*                             TMemoryStream                                *}
-{****************************************************************************}
-
-
-Const TMSGrow = 4096; { Use 4k blocks. }
-
-procedure TMemoryStream.SetCapacity(NewCapacity: Longint);
-
-begin
-  SetPointer (Realloc(NewCapacity),Fsize);
-  FCapacity:=NewCapacity;
-end;
-
-
-function TMemoryStream.Realloc(var NewCapacity: Longint): Pointer;
-
-Var MoveSize : Longint;
-
-begin
-  If NewCapacity>0 Then // round off to block size.
-    NewCapacity := (NewCapacity + (TMSGrow-1)) and not (TMSGROW-1);
-  // Only now check !
-  If NewCapacity=FCapacity then
-    Result:=FMemory
-  else
-    If NewCapacity=0 then
-      FreeMem (FMemory,Fcapacity)
-    else
-      begin
-      GetMem (Result,NewCapacity);
-      If Result=Nil then
-        Raise EStreamError.Create(SMemoryStreamError);
-      If FCapacity>0 then
-        begin
-        MoveSize:=FSize;
-        If MoveSize>NewCapacity then MoveSize:=NewCapacity;
-        Move (Fmemory^,Result^,MoveSize);
-        FreeMem (FMemory,FCapacity);
-        end;
-      end;
-end;
-
-
-destructor TMemoryStream.Destroy;
-
-begin
-  Clear;
-  Inherited Destroy;
-end;
-
-
-procedure TMemoryStream.Clear;
-
-begin
-  FSize:=0;
-  FPosition:=0;
-  SetCapacity (0);
-end;
-
-
-procedure TMemoryStream.LoadFromStream(Stream: TStream);
-
-begin
-  Stream.Position:=0;
-  SetSize(Stream.Size);
-  If FSize>0 then Stream.ReadBuffer(FMemory^,FSize);
-end;
-
-
-procedure TMemoryStream.LoadFromFile(const FileName: string);
-
-Var S : TFileStream;
-
-begin
-  Try
-    S:=TFileStream.Create (FileName,fmOpenRead);
-    LoadFromStream(S);
-  finally
-    S.free;
-  end;
-end;
-
-
-procedure TMemoryStream.SetSize(NewSize: Longint);
-
-begin
-  SetCapacity (NewSize);
-  FSize:=NewSize;
-  IF FPosition>FSize then
-    FPosition:=FSize;
-end;
-
-
-function TMemoryStream.Write(const Buffer; Count: Longint): Longint;
-
-Var NewPos : Longint;
-
-begin
-  If Count=0 then
-    exit(0);
-  NewPos:=FPosition+Count;
-  If NewPos>Fsize then
-    begin
-    IF NewPos>FCapacity then
-      SetCapacity (NewPos);
-    FSize:=Newpos;
-    end;
-  System.Move (Buffer,(FMemory+FPosition)^,Count);
-  FPosition:=NewPos;
-  Result:=Count;
-end;
-
-
-{****************************************************************************}
-{*                             TStringStream                                *}
-{****************************************************************************}
-
-procedure TStringStream.SetSize(NewSize: Longint);
-
-begin
- //!! Setlength(FDataString,NewSize);
- If FPosition>NewSize then FPosition:=NewSize;
-end;
-
-
-constructor TStringStream.Create(const AString: string);
-
-begin
-  Inherited create;
-  FDataString:=AString;
-end;
-
-
-function TStringStream.Read(var Buffer; Count: Longint): Longint;
-
-begin
-  Result:=Length(FDataString)-FPosition;
-  If Result>Count then Result:=Count;
-  // This supposes FDataString to be of type AnsiString !
-  //!! Move (Pchar(FDataString)[FPosition],Buffer,Count);
-  FPosition:=FPosition+Count;
-end;
-
-
-function TStringStream.ReadString(Count: Longint): string;
-
-Var NewLen : Longint;
-
-begin
-  NewLen:=Length(FDataString)-FPosition;
-  If NewLen>Count then NewLen:=Count;
-  //!! SetLength(Result,NewLen);
-  //!! Read (Pointer(Result)^,NewLen);
-  ReadString:='';
-end;
-
-
-function TStringStream.Seek(Offset: Longint; Origin: Word): Longint;
-
-begin
-  Case Origin of
-    soFromBeginning : FPosition:=Offset;
-    soFromEnd       : FPosition:=Length(FDataString)+Offset;
-    soFromCurrent   : FpoSition:=FPosition+Offset;
-  end;
-  If FPosition>Length(FDataString) then FPosition:=Length(FDataString);
-  If FPosition<0 then FPosition:=0;
-  Result:=FPosition;
-end;
-
-
-function TStringStream.Write(const Buffer; Count: Longint): Longint;
-
-begin
-  Result:=Count;
-  SetSize(FPosition+Count);
-  // This supposes that FDataString is of type AnsiString)
-  //!! Move (Buffer,PCHar(FDataString)[Fposition],Count);
-  FPosition:=FPosition+Count;
-end;
-
-
-procedure TStringStream.WriteString(const AString: string);
-
-begin
-  //!! Write (PChar(Astring)[0],Length(AString));
-end;
-
-
-
-{****************************************************************************}
-{*                             TResourceStream                              *}
-{****************************************************************************}
-
-procedure TResourceStream.Initialize(Instance: THandle; Name, ResType: PChar);
-
-begin
-end;
-
-
-constructor TResourceStream.Create(Instance: THandle; const ResName: string; ResType: PChar);
-
-begin
-end;
-
-
-constructor TResourceStream.CreateFromID(Instance: THandle; ResID: Integer; ResType: PChar);
-
-begin
-end;
-
-
-destructor TResourceStream.Destroy;
-
-begin
-end;
-
-
-function TResourceStream.Write(const Buffer; Count: Longint): Longint;
-
-begin
-  Write:=0;
-end;
-
-
-{
-  $Log$
-  Revision 1.17  1999-11-30 15:28:38  michael
-  + Added FileNAme property for filestreams
-
-  Revision 1.16  1999/10/03 19:38:06  peter
-    * fixed readansistring
-    * fixed constants
-
-  Revision 1.15  1999/09/13 08:35:16  fcl
-  * Changed some argument names (Root->ARoot etc.) because the new compiler
-    now performs more ambiguity checks  (sg)
-
-  Revision 1.14  1999/07/18 20:58:47  michael
-  * fixed bug in realloc and setcapacity of tmemorystream
-
-  Revision 1.13  1999/04/08 10:18:55  peter
-    * makefile updates
-
-}

fcl/inc/stringl.inc

@@ -1,953 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TStrings                                     *}
-{****************************************************************************}
-
-// Function to quote text. Should move maybe to sysutils !!
-// Also, it is not clear at this point what exactly should be done.
-
-{ //!! is used to mark unsupported things. }
-
-Function QuoteString (Const S : String; Quote : String) : String;
-
-Var I,J : Longint;
-
-begin
-  I:=0;
-  J:=0;
-  Result:=S;
-  While I<Length(S) do
-   begin
-   I:=I+1;
-   J:=J+1;
-   if S[i]=Quote then
-     begin
-     System.Insert(Result,Quote,J);
-     J:=J+1;
-     end;
-   end;
-  Result:=Quote+Result+Quote;
-end;
-
-function TStrings.GetCommaText: string;
-
-Var I : Longint;
-
-begin
-  result:='';
-  For i:=0 to count-1 do
-    begin
-    Result:=Result+QuoteString (Strings[I],'"');
-    if I<Count-1 then Result:=Result+',';
-    end;
-  If Length(Result)=0 then Result:='""';
-end;
-
-
-
-function TStrings.GetName(Index: Integer): string;
-
-Var L : longint;
-
-begin
-  Result:=Strings[Index];
-  L:=Pos('=',Result);
-  If L<>0 then
-    Result:=Copy(Result,1,L-1)
-  else
-    Result:='';
-end;
-
-
-
-Function TStrings.GetValue(const Name: string): string;
-
-Var L : longint;
-
-begin
-  Result:='';
-  L:=IndexOfName(Name);
-  If L<>-1 then
-    begin
-    Result:=Strings[L];
-    L:=Pos('=',Result);
-    System.Delete (Result,1,L);
-    end;
-end;
-
-
-
-Procedure TStrings.ReadData(Reader: TReader);
-
-begin
-end;
-
-Function GetQuotedString (Var P : Pchar) : AnsiString;
-
-Var P1,L : Pchar;
-
-begin
-  Result:='';
-  P1:=P+1;
-  While P1^<>#0 do
-    begin
-    If (P1^='"') and (P1[1]<>'"') then
-      break;
-    P1:=P1+1;
-    If P1^='"' then P1:=P1+1;
-    end;
-  // P1 points to last quote, or to #0;
-  P:=P+1;
-  If P1-P>0 then
-    begin
-    SetLength(Result,(P1-P));
-    L:=Pointer(Result);
-    Move (P^,L^,P1-P);
-    P:=P1+1;
-    end;
-end;
-
-
-Function GetNextQuotedChar (P : PChar; Var S : String): Boolean;
-
-Var PS,L : PChar;
-
-begin
-  Result:=False;
-  If P^=#0 then exit;
-  S:='';
-  While (p^<>#0) and (byte(p^)<=byte(' ')) do P:=P+1;
-  PS:=P;
-  If P^='"' then
-    S:=GetQuotedString(P)
-  else
-    begin
-    While (p^>' ') and (P^<>',') do P:=P+1;
-    Setlength (S,P-PS);
-    L:=Pointer(S);
-    Move (PS^,L,P-PS);
-    end;
-  Result:=True;
-end;
-
-
-Procedure TStrings.SetCommaText(const Value: string);
-
-Var P : Pointer;
-    S : String;
-
-begin
-  Self.Clear;
-  P:=Pointer(Value);
-  While GetNextQuotedChar (P,S) do Add (S);
-end;
-
-
-
-Procedure TStrings.SetStringsAdapter(const Value: IStringsAdapter);
-
-begin
-end;
-
-
-
-Procedure TStrings.SetValue(const Name, Value: string);
-
-Var L : longint;
-
-begin
-  L:=IndexOfName(Name);
-  if L=-1 then
-   Add (Name+'='+Value)
-  else
-   Strings[L]:=Name+'='+value;
-end;
-
-
-
-Procedure TStrings.WriteData(Writer: TWriter);
-
-begin
-end;
-
-
-
-Procedure TStrings.DefineProperties(Filer: TFiler);
-
-begin
-end;
-
-
-
-Procedure TStrings.Error(const Msg: string; Data: Integer);
-
-begin
-  //!! Need to get correct address !!
-  Raise EStringListError.CreateFmt(Msg,[Data]);
-end;
-
-
-
-Function TStrings.GetCapacity: Integer;
-
-begin
-  Result:=Count;
-end;
-
-
-
-Function TStrings.GetObject(Index: Integer): TObject;
-
-begin
-  Result:=Nil;
-end;
-
-
-
-Function TStrings.GetTextStr: string;
-
-Const
-{$ifdef linux}
-  NewLineSize=1;
-{$else}
-  NewLineSize=2;
-{$endif}
-
-Var P : Pchar;
-    I,L : Longint;
-    S : String;
-
-begin
-  // Determine needed place
-  L:=0;
-  For I:=0 to count-1 do
-    L:=L+Length(Strings[I])+NewLineSize;
-  Setlength(Result,L);
-  P:=Pointer(Result);
-  For i:=0 To count-1 do
-    begin
-    S:=Strings[I];
-    L:=Length(S);
-    if L<>0 then
-      System.Move(Pointer(S)^,P^,L);
-    P:=P+L;
-{$ifndef linux}
-    p[0]:=#13;
-    p[1]:=#10;
-{$else}
-    p[0]:=#10;
-{$endif}
-    P:=P+NewLineSize;
-    end;
-end;
-
-
-
-Procedure TStrings.Put(Index: Integer; const S: string);
-
-Var Obj : TObject;
-
-begin
-  Obj:=Objects[Index];
-  Delete(Index);
-  InsertObject(Index,S,Obj);
-end;
-
-
-
-Procedure TStrings.PutObject(Index: Integer; AObject: TObject);
-
-begin
-  // Empty.
-end;
-
-
-
-Procedure TStrings.SetCapacity(NewCapacity: Integer);
-
-begin
-  // Empty.
-end;
-
-
-Procedure TStrings.SetTextStr(const Value: string);
-
-begin
-  SetText(PChar(Value));
-end;
-
-
-
-Procedure TStrings.SetUpdateState(Updating: Boolean);
-
-begin
-end;
-
-
-
-destructor TSTrings.Destroy;
-
-begin
-  inherited destroy;
-end;
-
-
-
-Function TStrings.Add(const S: string): Integer;
-
-begin
-  Result:=Count;
-  Insert (Count,S);
-end;
-
-
-
-Function TStrings.AddObject(const S: string; AObject: TObject): Integer;
-
-begin
-  Result:=Add(S);
-  Objects[result]:=AObject;
-end;
-
-
-
-Procedure TStrings.Append(const S: string);
-
-begin
-  Add (S);
-end;
-
-
-
-Procedure TStrings.AddStrings(TheStrings: TStrings);
-
-Var Runner : longint;
-
-begin
-  For Runner:=0 to TheStrings.Count-1 do
-    self.AddObject (Thestrings[Runner],TheStrings.Objects[Runner]);
-end;
-
-
-
-Procedure TStrings.Assign(Source: TPersistent);
-
-begin
-  If Source is TStrings then
-    begin
-    clear;
-    AddStrings(TStrings(Source));
-    exit;
-    end;
-  Inherited Assign(Source);
-end;
-
-
-
-Procedure TStrings.BeginUpdate;
-
-begin
-end;
-
-
-
-Procedure TStrings.EndUpdate;
-
-begin
-end;
-
-
-
-Function TStrings.Equals(TheStrings: TStrings): Boolean;
-
-Var Runner,Nr : Longint;
-
-begin
-  Result:=False;
-  Nr:=Self.Count;
-  if Nr<>TheStrings.Count then exit;
-  For Runner:=0 to Nr-1 do
-    If Strings[Runner]<>TheStrings[Runner] then exit;
-  Result:=True;
-end;
-
-
-
-Procedure TStrings.Exchange(Index1, Index2: Integer);
-
-Var
-  Obj : TObject;
-  Str : String;
-
-begin
-  Obj:=Objects[Index1];
-  Str:=Strings[Index1];
-  Objects[Index1]:=Objects[Index2];
-  Strings[Index1]:=Strings[Index2];
-  Objects[Index2]:=Obj;
-  Strings[Index2]:=Str;
-end;
-
-
-
-Function TStrings.GetText: PChar;
-
-begin
-  Result:=StrNew(Pchar(Self.Text));
-end;
-
-
-
-Function TStrings.IndexOf(const S: string): Integer;
-
-
-begin
-  Result:=0;
-  While (Result<Count) and (Strings[Result]<>S) do Result:=Result+1;
-  if Result=Count then Result:=-1;
-end;
-
-
-
-Function TStrings.IndexOfName(const Name: string): Integer;
-
-Var len : longint;
-
-begin
-  Result:=0;
-  while (Result<Count) do
-    begin
-    len:=pos('=',Strings[Result])-1;
-    if (len>0) and (Name=Copy(Strings[Result],1,Len)) then exit;
-    inc(result);
-    end;
-  result:=-1;
-end;
-
-
-
-Function TStrings.IndexOfObject(AObject: TObject): Integer;
-
-begin
-  Result:=0;
-  While (Result<count) and (Objects[Result]<>AObject) do Result:=Result+1;
-  If Result=Count then Result:=-1;
-end;
-
-
-
-Procedure TStrings.InsertObject(Index: Integer; const S: string;
-  AObject: TObject);
-
-begin
-  Insert (Index,S);
-  Objects[Index]:=AObject;
-end;
-
-
-
-Procedure TStrings.LoadFromFile(const FileName: string);
-
-Var TheStream : TFileStream;
-
-begin
-  TheStream:=TFileStream.Create(FileName,fmOpenRead);
-  LoadFromStream(TheStream);
-  TheStream.Free;
-end;
-
-
-
-Procedure TStrings.LoadFromStream(Stream: TStream);
-{
-   Borlands method is no goed, since a pipe for
-   Instance doesn't have a size.
-   So we must do it the hard way.
-}
-Const
-  BufSize = 1024;
-Var
-  Buffer     : Pointer;
-  BytesRead,
-  BufLen     : Longint;
-begin
-  // reread into a buffer
-  Buffer:=Nil;
-  BufLen:=0;
-  Repeat
-    ReAllocMem(Buffer,BufLen+BufSize);
-    BytesRead:=Stream.Read((Buffer+BufLen)^,BufSize);
-    inc(BufLen,BufSize);
-  Until BytesRead<>BufSize;
-  // Null-terminate !!
-  Pchar(Buffer)[BufLen-BufSize+BytesRead]:=#0;
-  Text:=PChar(Buffer);
-  FreeMem(Buffer);
-end;
-
-
-Procedure TStrings.Move(CurIndex, NewIndex: Integer);
-Var
-  Obj : TObject;
-  Str : String;
-begin
-  Obj:=Objects[CurIndex];
-  Str:=Strings[CurIndex];
-  Delete(Curindex);
-  InsertObject(NewIndex,Str,Obj);
-end;
-
-
-
-Procedure TStrings.SaveToFile(const FileName: string);
-
-Var TheStream : TFileStream;
-
-begin
-  TheStream:=TFileStream.Create(FileName,fmCreate);
-  SaveToStream(TheStream);
-  TheStream.Free;
-end;
-
-
-
-Procedure TStrings.SaveToStream(Stream: TStream);
-Var
-  S : String;
-begin
-  S:=Text;
-  Stream.Write(Pointer(S)^,Length(S));
-end;
-
-
-Function GetNextLine (Var P : Pchar; Var S : String) : Boolean;
-
-Var PS : PChar;
-
-begin
-  S:='';
-  Result:=False;
-  If P^=#0 then exit;
-  PS:=P;
-  While not (P^ in [#0,#10,#13]) do P:=P+1;
-  SetLength (S,P-PS);
-  System.Move (PS^,Pointer(S)^,P-PS);
-  If P^=#13 then P:=P+1;
-  If P^=#10 then
-    P:=P+1; // Point to character after #10(#13)
-  Result:=True;
-end;
-
-
-Procedure TStrings.SetText(TheText: PChar);
-
-Var S : String;
-
-begin
-  Clear;
-  While GetNextLine (TheText,S) do
-    Add(S);
-end;
-
-
-{****************************************************************************}
-{*                             TStringList                                  *}
-{****************************************************************************}
-
-
-
-Procedure TStringList.ExchangeItems(Index1, Index2: Integer);
-
-Var P1,P2 : Pointer;
-
-begin
-  P1:=Pointer(Flist^[Index1].FString);
-  P2:=Pointer(Flist^[Index1].FObject);
-  Pointer(Flist^[Index1].Fstring):=Pointer(Flist^[Index2].Fstring);
-  Pointer(Flist^[Index1].FObject):=Pointer(Flist^[Index2].FObject);
-  Pointer(Flist^[Index2].Fstring):=P1;
-  Pointer(Flist^[Index2].FObject):=P2;
-end;
-
-
-
-Procedure TStringList.Grow;
-
-Var Extra : Longint;
-
-begin
-  If FCapacity>64 then
-    Extra:=FCapacity Div 4
-  Else If FCapacity>8 Then
-    Extra:=16
-  Else
-    Extra:=4;
-  SetCapacity(FCapacity+Extra);
-end;
-
-
-
-Procedure TStringList.QuickSort(L, R: Integer);
-
-Var I,J : Longint;
-    Pivot : String;
-
-begin
-  Repeat;
-    I:=L;
-    J:=R;
-    Pivot:=Flist^[(L+R) div 2].FString;
-    Repeat
-      While AnsiCompareText(Flist^[I].Fstring,Pivot)<0 do Inc(I);
-      While AnsiCompareText(Flist^[J].Fstring,Pivot)>0 do Dec(J);
-      If I<=J then
-        begin
-        ExchangeItems(I,J); // No check, indices are correct.
-        Inc(I);
-        Dec(j);
-        end;
-    until I>J;
-    If L<J then QuickSort(L,J);
-    L:=I;
-  Until I>=R;
-end;
-
-
-
-Procedure TStringList.InsertItem(Index: Integer; const S: string);
-
-begin
-  Changing;
-  If FCount=Fcapacity then Grow;
-  If Index<FCount then
-    System.Move (FList^[Index],FList^[Index+1],
-                 (FCount-Index)*SizeOf(TStringItem));
-  Pointer(Flist^[Index].Fstring):=Nil;  // Needed to initialize...
-  Flist^[Index].FString:=S;
-  Flist^[Index].Fobject:=Nil;
-  Inc(FCount);
-  Changed;
-end;
-
-
-
-Procedure TStringList.SetSorted(Value: Boolean);
-
-begin
-  If FSorted<>Value then
-    begin
-    If Value then sort;
-    FSorted:=VAlue
-    end;
-end;
-
-
-
-Procedure TStringList.Changed;
-
-begin
-  If (FUpdateCount=0) Then
-   If Assigned(FOnChange) then
-     FOnchange(Self);
-end;
-
-
-
-Procedure TStringList.Changing;
-
-begin
-  If FUpdateCount=0 then
-    if Assigned(FOnChanging) then
-      FOnchanging(Self);
-end;
-
-
-
-Function TStringList.Get(Index: Integer): string;
-
-begin
-  If (Index<0) or (INdex>=Fcount)  then
-    Error (SListIndexError,Index);
-  Result:=Flist^[Index].FString;
-end;
-
-
-
-Function TStringList.GetCapacity: Integer;
-
-begin
-  Result:=FCapacity;
-end;
-
-
-
-Function TStringList.GetCount: Integer;
-
-begin
-  Result:=FCount;
-end;
-
-
-
-Function TStringList.GetObject(Index: Integer): TObject;
-
-begin
-  If (Index<0) or (INdex>=Fcount)  then
-    Error (SListIndexError,Index);
-  Result:=Flist^[Index].FObject;
-end;
-
-
-
-Procedure TStringList.Put(Index: Integer; const S: string);
-
-begin
-  If Sorted then
-    Error(SSortedListError,0);
-  If (Index<0) or (INdex>=Fcount)  then
-    Error (SListIndexError,Index);
-  Changing;
-  Flist^[Index].FString:=S;
-  Changed;
-end;
-
-
-
-Procedure TStringList.PutObject(Index: Integer; AObject: TObject);
-
-begin
-  If (Index<0) or (INdex>=Fcount)  then
-    Error (SListIndexError,Index);
-  Changing;
-  Flist^[Index].FObject:=AObject;
-  Changed;
-end;
-
-
-
-Procedure TStringList.SetCapacity(NewCapacity: Integer);
-
-Var NewList : Pointer;
-    MSize : Longint;
-
-begin
-  If (NewCapacity<0) then
-     Error (SListCapacityError,NewCapacity);
-  If NewCapacity>FCapacity then
-    begin
-    GetMem (NewList,NewCapacity*SizeOf(TStringItem));
-    If NewList=Nil then
-      Error (SListCapacityError,NewCapacity);
-    If Assigned(FList) then
-      begin
-      MSize:=FCapacity*Sizeof(TStringItem);
-      System.Move (FList^,NewList^,MSize);
-      FillWord (Pchar(NewList)[MSize],(NewCapacity-FCapacity)*WordRatio, 0);
-      FreeMem (Flist,MSize);
-      end;
-    Flist:=NewList;
-    FCapacity:=NewCapacity;
-    end
-  else if NewCapacity<FCapacity then
-    begin
-    NewList:=Flist+NewCapacity*SizeOf(TStringItem);
-    FreeMem (NewList, (FCapacity-NewCapacity)*SizeOf(TStringItem));
-    FCapacity:=NewCapacity;
-    end;
-end;
-
-
-
-Procedure TStringList.SetUpdateState(Updating: Boolean);
-
-begin
-  If Updating then
-    Changing
-  else
-    Changed
-end;
-
-
-
-destructor TStringList.Destroy;
-
-Var I : Longint;
-
-begin
-  FOnChange:=Nil;
-  FOnChanging:=Nil;
-  // This will force a dereference. Can be done better...
-  For I:=0 to FCount-1 do
-    FList^[I].FString:='';
-  FCount:=0;
-  SetCapacity(0);
-  Inherited destroy;
-end;
-
-
-
-Function TStringList.Add(const S: string): Integer;
-
-begin
-  If Not Sorted then
-    Result:=FCount
-  else
-    If Find (S,Result) then
-      Case DUplicates of
-        DupIgnore : Exit;
-        DupError : Error(SDuplicateString,0)
-      end;
-   InsertItem (Result,S);
-end;
-
-
-
-Procedure TStringList.Clear;
-
-Var I : longint;
-
-begin
-  For I:=0 to FCount-1 do
-    Flist^[I].FString:='';
-  FCount:=0;
-  SetCapacity(0);
-end;
-
-
-
-Procedure TStringList.Delete(Index: Integer);
-
-begin
-  If (Index<0) or (Index>=FCount) then
-    Error(SlistINdexError,Index);
-  Flist^[Index].FString:='';
-  Dec(FCount);
-  If Index<FCount then
-    System.Move(Flist^[Index+1],
-                Flist^[Index],
-                (Fcount-Index)*SizeOf(TStringItem));
-end;
-
-
-
-Procedure TStringList.Exchange(Index1, Index2: Integer);
-
-begin
-  If (Index1<0) or (Index1>=FCount) then
-    Error(SListIndexError,Index1);
-  If (Index2<0) or (Index2>=FCount) then
-    Error(SListIndexError,Index1);
-  Changing;
-  ExchangeItems(Index1,Index2);
-  changed;
-end;
-
-Function TStringList.Find(const S: string; var Index: Integer): Boolean;
-
-{ Searches for the first string <= S, returns True if exact match,
-  sets index to the index f the found string. }
-
-Var I,L,R,Temp : Longint;
-
-begin
-  Result:=False;
-  // Use binary search.
-  L:=0;
-  R:=FCount-1;
-  While L<=R do
-    begin
-    I:=(L+R) div 2;
-    Temp:=AnsiCompareText(FList^ [I].FString,S);
-    If Temp<0 then
-      L:=I+1
-    else
-      begin
-      R:=I-1;
-      If Temp=0 then
-        begin
-        Result:=True;
-        If Duplicates<>DupAccept then L:=I;
-        end;
-      end;
-    end;
-  Index:=L;
-end;
-
-
-
-Function TStringList.IndexOf(const S: string): Integer;
-
-begin
-  If Not Sorted then
-    Result:=Inherited indexOf(S)
-  else
-    // faster using binary search...
-    If Not Find (S,Result) then
-      Result:=-1;
-end;
-
-
-
-Procedure TStringList.Insert(Index: Integer; const S: string);
-
-begin
-  If Sorted then
-    Error (SSortedListError,0)
-  else
-    If (Index<0) or (Index>FCount) then
-      Error (SListIndexError,Index)
-    else
-      InsertItem (Index,S);
-end;
-
-
-Procedure TStringList.Sort;
-
-begin
-  If Not Sorted and (FCount>1) then
-    begin
-    Changing;
-    QuickSOrt(0,FCount-1);
-    Changed;
-    end;
-end;
-
-{
-  $Log$
-  Revision 1.7  1999-12-22 01:08:18  peter
-    * use reallocmem/freemem/getmem from the heapmanager
-
-  Revision 1.6  1999/11/25 13:28:13  michael
-  + Fixed bug in settext
-
-  Revision 1.5  1999/07/07 12:34:01  peter
-    * removed debug writeln
-
-  Revision 1.4  1999/05/26 13:22:23  michael
-  + Fixed insertitem
-
-  Revision 1.3  1999/04/27 07:46:18  michael
-  * Fixed bug that caused error in loadfromstream when last line in stream has not CRLF pair
-
-  Revision 1.2  1999/04/15 07:51:45  michael
-  + Bugfix in strings.Loadfromstream
-
-  Revision 1.1  1999/04/13 08:52:28  michael
-  + Moved strings.inc to stringl.inc, to avoid conflict with strings unit
-
-  Revision 1.15  1999/04/08 10:18:56  peter
-    * makefile updates
-
-}

fcl/inc/syncob.inc

@@ -1,39 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by Florian Klaempfl
-    member of the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-procedure TCriticalSection.Enter;
-
-  begin
-     Acquire;
-  end;
-
-procedure TCriticalSection.Leave;
-
-  begin
-     Release;
-  end;
-
-{
-  $Log$
-  Revision 1.1  1999-06-07 15:51:51  michael
-  + Renamed to syncob
-
-  Revision 1.2  1998/09/30 13:41:04  florian
-    * fixes to make it compilable
-
-  Revision 1.1  1998/09/29 11:14:25  florian
-    + initial revision
-
-}

fcl/inc/syncobh.inc

@@ -1,70 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by Florian Klaempfl
-    member of the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-type
-   TSyncroObject = class(TObject)
-      procedure Acquire;virtual;abstract;
-      procedure Release;virtual;abstract;
-   end;
-
-   TCriticalSection = class(TSyncroObject)
-{$ifdef win32}
-   private
-      CriticalSection : TRTLCriticalSection;
-{$endif win32}
-   public
-      procedure Acquire;override;
-      procedure Release;override;
-      procedure Enter;
-      procedure Leave;
-      constructor Create;
-      destructor Destroy;override;
-   end;
-
-   THandleObject = class(TSyncroObject)
-   protected
-      FHandle : TEventHandle;
-      FLastError : Integer;
-   public
-      destructor destroy;override;
-      property Handle : TEventHandle read FHandle;
-      property LastError : Integer read FLastError;
-   end;
-
-   TEventObject = class(THandleObject)
-   public
-      constructor Create(EventAttributes : PSecurityAttributes;
-        ManualReset,InitialState : Boolean;const Name : string);
-      procedure ResetEvent;
-      procedure SetEvent;
-      function WaitFor(Timeout : Cardinal) : TWaitResult;
-   end;
-
-   TSimpleEvent = class(TEventObject)
-      constructor Create;
-   end;
-
-{
-  $Log$
-  Revision 1.1  1999-06-07 15:52:46  michael
-  + Renamed to syncobh
-
-  Revision 1.2  1998/09/30 13:41:05  florian
-    * fixes to make it compilable
-
-  Revision 1.1  1998/09/29 11:14:25  florian
-    + initial revision
-
-}

fcl/inc/util.inc

@@ -1,11 +0,0 @@
-Function IntToStr (I : Longint) : String;
-
-begin
-  Str(I,Result);
-end;
-
-function IsValidIdent(const Ident: string): Boolean;
-
-begin
-  Result:=True;
-end;

fcl/inc/writer.inc

@@ -1,210 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TWriter                                      *}
-{****************************************************************************}
-
-Procedure TWriter.AddAncestor(Component: TComponent);
-
-begin
-end;
-
-
-function  TWriter.GetPosition: Longint;
-
-begin
-  GetPosition:=0;
-end;
-
-
-Procedure TWriter.SetPosition(Value: Longint);
-
-begin
-end;
-
-
-Procedure TWriter.WriteBuffer;
-
-begin
-end;
-
-
-Procedure TWriter.WriteData(Instance: TComponent);
-
-begin
-end;
-
-
-Procedure TWriter.WriteProperty(Instance: TPersistent; PropInfo: Pointer);
-
-begin
-end;
-
-
-Procedure TWriter.WriteProperties(Instance: TPersistent);
-
-begin
-end;
-
-
-Procedure TWriter.WritePropName(const PropName: string);
-
-begin
-end;
-
-
-Procedure TWriter.WriteBinary(wd : TStreamProc);
-
-begin
-end;
-
-
-Procedure TWriter.WritePrefix(Flags: TFilerFlags; AChildPos: Integer);
-
-begin
-end;
-
-
-Procedure TWriter.WriteValue(Value: TValueType);
-
-begin
-end;
-
-
-Destructor TWriter.Destroy;
-
-begin
-end;
-
-
-Procedure TWriter.DefineProperty(const Name: string;
-  rd : TReaderProc; wd : TWriterProc;
-  HasData: Boolean);
-
-begin
-end;
-
-
-Procedure TWriter.DefineBinaryProperty(const Name: string;
-  rd, wd: TStreamProc;
-  HasData: Boolean);
-
-begin
-end;
-
-
-Procedure TWriter.FlushBuffer;
-
-begin
-end;
-
-
-Procedure TWriter.Write(const Buf; Count: Longint);
-
-begin
-end;
-
-
-Procedure TWriter.WriteBoolean(Value: Boolean);
-
-begin
-end;
-
-
-Procedure TWriter.WriteCollection(Value: TCollection);
-
-begin
-end;
-
-
-Procedure TWriter.WriteComponent(Component: TComponent);
-
-begin
-end;
-
-
-Procedure TWriter.WriteChar(Value: Char);
-
-begin
-end;
-
-
-Procedure TWriter.WriteDescendent(ARoot: TComponent; AAncestor: TComponent);
-
-begin
-end;
-
-
-Procedure TWriter.WriteFloat(Value: Extended);
-
-begin
-end;
-
-
-Procedure TWriter.WriteIdent(const Ident: string);
-
-begin
-end;
-
-
-Procedure TWriter.WriteInteger(Value: Longint);
-
-begin
-end;
-
-
-Procedure TWriter.WriteListBegin;
-
-begin
-end;
-
-
-Procedure TWriter.WriteListEnd;
-
-begin
-end;
-
-
-Procedure TWriter.WriteRootComponent(ARoot: TComponent);
-
-begin
-end;
-
-
-Procedure TWriter.WriteSignature;
-
-begin
-end;
-
-
-Procedure TWriter.WriteStr(const Value: string);
-
-begin
-end;
-
-
-Procedure TWriter.WriteString(const Value: string);
-
-begin
-end;
-{
-  $Log$
-  Revision 1.3  1999-09-13 08:35:16  fcl
-  * Changed some argument names (Root->ARoot etc.) because the new compiler
-    now performs more ambiguity checks  (sg)
-
-  Revision 1.2  1999/04/08 10:18:58  peter
-    * makefile updates
-
-}

fcl/inc/zstream.pp

@@ -1,505 +0,0 @@
-unit zstream;
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1998 by the Free Pascal development team
-
-    Implementation of compression streams.
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{ ---------------------------------------------------------------------
-  On linux, the default is to use the zlib libraries.
-  On all other platforms we use paszlib. If you want to use
-  paszlib in all cases, just define -dUsePasZlib
-  ---------------------------------------------------------------------}
-
-{$ifndef linux}
-{$define usepaszlib}
-{$endif}
-
-interface
-
-uses Sysutils, Classes,zlib
-{$ifdef usepaszlib}
-     ,gzio,ZUtil,ZInflate,ZDeflate
-{$endif}
-     ;
-
-{$H+}
-
-type
-  // Error reporting.
-{$ifdef usepaszlib}
-  TZStream=Z_Stream;
-  PZStream=Z_StreamP;
-{$endif}
-
-  EZlibError = class(EStreamError);
-  ECompressionError = class(EZlibError);
-  EDecompressionError = class(EZlibError);
-
-  TCustomZlibStream = class(TStream)
-  private
-    FStrm: TStream;
-    FStrmPos: Integer;
-    FOnProgress: TNotifyEvent;
-    FZRec: TZStream;
-    FBuffer: array [Word] of Char;
-  protected
-    procedure Progress(Sender: TObject); dynamic;
-    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
-    constructor Create(Strm: TStream);
-  end;
-
-  TCompressionLevel = (clNone, clFastest, clDefault, clMax);
-
-  TCompressionStream = class(TCustomZlibStream)
-  private
-    function GetCompressionRate: extended;
-    function CompressionCheck(code: Integer): Integer;
-    procedure CompressBuf(const InBuf: Pointer; InBytes: Integer;
-                          var OutBuf: Pointer; var OutBytes: Integer);
-  public
-    constructor Create(CompressionLevel: TCompressionLevel; Dest: TStream);
-    destructor Destroy; override;
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    property CompressionRate: extended read GetCompressionRate;
-    property OnProgress;
-  end;
-
-  TDecompressionStream = class(TCustomZlibStream)
-  private
-    function DecompressionCheck(code: Integer): Integer;
-    procedure DecompressBuf(const InBuf: Pointer; InBytes: Integer;
-    OutEstimate: Integer; var OutBuf: Pointer; var OutBytes: Integer);
-  public
-    constructor Create(Source: TStream);
-    destructor Destroy; override;
-    function Read(var Buffer; Count: Longint): Longint; override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    property OnProgress;
-  end;
-
-  TGZOpenMode = (gzOpenRead,gzOpenWrite);
-
-  TGZFileStream = Class(TStream)
-    Private
-    FOpenMode : TGZOpenmode;
-    FFIle : gzfile;
-    Public
-    Constructor Create(FileName: String;FileMode: TGZOpenMode);
-    Destructor Destroy;override;
-    Function Read(Var Buffer; Count : longint): longint;override;
-    function Write(const Buffer; Count: Longint): Longint; override;
-    function Seek(Offset: Longint; Origin: Word): Longint; override;
-    end;
-
-
-implementation
-
-Const
-  ErrorStrings : array [0..6] of string =
-    ('Unknown error %d','Z_ERRNO','Z_STREAM_ERROR',
-     'Z_DATA_ERROR','Z_MEM_ERROR','Z_BUF_ERROR','Z_VERSION_ERROR');
-  SCouldntOpenFile = 'Couldn''t open file : %s';
-  SReadOnlyStream = 'Decompression streams are read-only';
-  SWriteOnlyStream = 'Compression streams are write-only';
-  SSeekError = 'Compression stream seek error';
-  SInvalidSeek = 'Invalid Compression seek operation';
-
-function zlibAllocMem(opaque:pointer; items:uInt; size:uInt):pointer;cdecl;
-begin
-  Result:=GetMem(Items*Size);
-end;
-
-procedure zlibFreeMem(opaque:pointer; address:pointer);cdecl;
-begin
-  FreeMem(address);
-end;
-
-
-procedure TCompressionStream.CompressBuf(const InBuf: Pointer; InBytes: Integer;
-                      var OutBuf: Pointer; var OutBytes: Integer);
-var
-  strm: TZStream;
-  P: Pointer;
-  oldout : longint;
-begin
-  FillChar(strm, sizeof(strm), 0);
-{$ifndef usepaszlib}
-  strm.zalloc := @zlibAllocMem;
-  strm.zfree := @zlibFreeMem;
-{$else}
-  strm.zalloc :=  @zcalloc;
-  strm.zfree :=  @zcfree;
-{$endif}
-  OutBytes := ((InBytes + (InBytes div 10) + 12) + 255) and not 255;
-  OutBuf:=GetMem(OutBytes);
-  try
-    strm.next_in := InBuf;
-    strm.avail_in := InBytes;
-    strm.next_out := OutBuf;
-    strm.avail_out := OutBytes;
-{$ifndef usepaszlib}
-    CompressionCheck(deflateInit_(strm, Z_BEST_COMPRESSION, zlibversion, sizeof(strm)));
-{$else}
-    CompressionCheck(deflateInit_(@strm, Z_BEST_COMPRESSION, zlibversion, sizeof(strm)));
-{$endif}
-    try
-      while CompressionCheck(deflate(strm, Z_FINISH)) <> Z_STREAM_END do
-      begin
-        P := OutBuf;
-        Inc(OutBytes, 256);
-        ReallocMem(OutBuf,OutBytes);
-{$ifndef usepaszlib}
-        strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
-{$else}
-        strm.next_out := PByteF(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
-{$endif}
-        strm.avail_out := 256;
-      end;
-    finally
-      CompressionCheck(deflateEnd(strm));
-    end;
-    ReallocMem(OutBuf,strm.total_out);
-    OutBytes := strm.total_out;
-  except
-    FreeMem(OutBuf);
-    raise;
-  end;
-end;
-
-
-procedure TDecompressionStream.DecompressBuf(const InBuf: Pointer; InBytes: Integer;
-       OutEstimate: Integer; var OutBuf: Pointer; var OutBytes: Integer);
-var
-  strm: TZStream;
-  P: Pointer;
-  BufInc: Integer;
-begin
-  FillChar(strm, sizeof(strm), 0);
-{$ifndef usepaszlib}
-  strm.zalloc := @zlibAllocMem;
-  strm.zfree := @zlibFreeMem;
-{$else}
-  strm.zalloc := @zcalloc;
-  strm.zfree := @zcfree;
-{$endif}
-  BufInc := (InBytes + 255) and not 255;
-  if OutEstimate = 0 then
-    OutBytes := BufInc
-  else
-    OutBytes := OutEstimate;
-  OutBuf:=GetMem(OutBytes);
-  try
-    strm.next_in := InBuf;
-    strm.avail_in := InBytes;
-    strm.next_out := OutBuf;
-    strm.avail_out := OutBytes;
-{$ifndef usepaszlib}
-    DecompressionCheck(inflateInit_(strm, zlibversion, sizeof(strm)));
-{$else}
-    DecompressionCheck(inflateInit_(@strm, zlibversion, sizeof(strm)));
-{$endif}
-    try
-      while DecompressionCheck(inflate(strm, Z_FINISH)) <> Z_STREAM_END do
-      begin
-        P := OutBuf;
-        Inc(OutBytes, BufInc);
-        ReallocMem(OutBuf, OutBytes);
-{$ifndef usepaszlib}
-        strm.next_out := PChar(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
-{$else}
-        strm.next_out := Pbytef(Integer(OutBuf) + (Integer(strm.next_out) - Integer(P)));
-{$endif}
-        strm.avail_out := BufInc;
-      end;
-    finally
-      DecompressionCheck(inflateEnd(strm));
-    end;
-    ReallocMem(OutBuf, strm.total_out);
-    OutBytes := strm.total_out;
-  except
-    FreeMem(OutBuf);
-    raise;
-  end;
-end;
-
-
-// TCustomZlibStream
-
-constructor TCustomZLibStream.Create(Strm: TStream);
-begin
-  inherited Create;
-  FStrm := Strm;
-  FStrmPos := Strm.Position;
-{$ifndef usepaszlib}
-  FZRec.zalloc := @zlibAllocMem;
-  FZRec.zfree := @zlibFreeMem;
-{$else}
-  FZRec.zalloc :=  @zcalloc;
-  FZRec.zfree :=  @zcfree;
-{$endif}
-end;
-
-procedure TCustomZLibStream.Progress(Sender: TObject);
-begin
-  if Assigned(FOnProgress) then FOnProgress(Sender);
-end;
-
-
-// TCompressionStream
-
-constructor TCompressionStream.Create(CompressionLevel: TCompressionLevel;
-  Dest: TStream);
-const
-  Levels: array [TCompressionLevel] of ShortInt =
-    (Z_NO_COMPRESSION, Z_BEST_SPEED, Z_DEFAULT_COMPRESSION, Z_BEST_COMPRESSION);
-begin
-  inherited Create(Dest);
-{$ifndef usepaszlib}
-  FZRec.next_out := FBuffer;
-  FZRec.avail_out := sizeof(FBuffer);
-  CompressionCheck(deflateInit_(FZRec, Levels[CompressionLevel], zlibversion, sizeof(FZRec)));
-{$else}
-  FZRec.next_out :=@FBuffer;
-  FZRec.avail_out := sizeof(FBuffer);
-  CompressionCheck(deflateInit_(@FZRec, Levels[CompressionLevel], zlibversion, sizeof(FZRec)));
-{$endif}
-end;
-
-destructor TCompressionStream.Destroy;
-begin
-  FZRec.next_in := nil;
-  FZRec.avail_in := 0;
-  try
-    if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
-    while (CompressionCheck(deflate(FZRec, Z_FINISH)) <> Z_STREAM_END)
-      and (FZRec.avail_out = 0) do
-    begin
-      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
-{$ifndef usepaszlib}
-      FZRec.next_out := FBuffer;
-{$else}
-      FZRec.next_out := @FBuffer;
-{$endif}
-      FZRec.avail_out := sizeof(FBuffer);
-    end;
-    if FZRec.avail_out < sizeof(FBuffer) then
-      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer) - FZRec.avail_out);
-  finally
-    deflateEnd(FZRec);
-  end;
-  inherited Destroy;
-end;
-
-function TCompressionStream.CompressionCheck(code: Integer): Integer;
-begin
-  Result := code;
-  if (code < 0) then
-    if code < -6 then
-      raise ECompressionError.CreateFmt(Errorstrings[0],[Code])
-    else
-      raise ECompressionError.Create(ErrorStrings[Abs(Code)]);
-end;
-
-
-function TCompressionStream.Read(var Buffer; Count: Longint): Longint;
-begin
-  raise ECompressionError.Create('Invalid stream operation');
-end;
-
-function TCompressionStream.Write(const Buffer; Count: Longint): Longint;
-begin
-  FZRec.next_in := @Buffer;
-  FZRec.avail_in := Count;
-  if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
-  while (FZRec.avail_in > 0) do
-  begin
-    CompressionCheck(deflate(FZRec, 0));
-    if FZRec.avail_out = 0 then
-    begin
-      FStrm.WriteBuffer(FBuffer, sizeof(FBuffer));
-{$ifndef usepaszlib}
-      FZRec.next_out := FBuffer;
-{$else}
-      FZRec.next_out := @FBuffer;
-{$endif}
-      FZRec.avail_out := sizeof(FBuffer);
-      FStrmPos := FStrm.Position;
-      Progress(Self);
-    end;
-  end;
-  Result := Count;
-end;
-
-function TCompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
-begin
-  if (Offset = 0) and (Origin = soFromCurrent) then
-    Result := FZRec.total_in
-  else
-    raise ECompressionError.Create(SInvalidSeek);
-end;
-
-function TCompressionStream.GetCompressionRate: extended;
-begin
-  Result:=0.0;
-{  With FZrec do
-    if total_in = 0 then
-      GetCompressionRate:=0.0
-    else
-      GetCompressionRate:=1.0E2*(1.0E0-(total_out/total_in));
-}
-end;
-
-
-// TDecompressionStream
-
-constructor TDecompressionStream.Create(Source: TStream);
-begin
-  inherited Create(Source);
-{$ifndef usepaszlib}
-  FZRec.next_in := FBuffer;
-  FZRec.avail_in := 0;
-  DecompressionCheck(inflateInit_(FZRec, zlibversion, sizeof(FZRec)));
-{$else}
-  FZRec.next_in := @FBuffer;
-  FZRec.avail_in := 0;
-  DecompressionCheck(inflateInit_(@FZRec, zlibversion, sizeof(FZRec)));
-{$endif}
-end;
-
-destructor TDecompressionStream.Destroy;
-begin
-  inflateEnd(FZRec);
-  inherited Destroy;
-end;
-
-function TDecompressionStream.DecompressionCheck(code: Integer): Integer;
-begin
-  Result := code;
-  If Code<0 then
-    if code < -6 then
-      raise EDecompressionError.CreateFmt(Errorstrings[0],[Code])
-    else
-      raise EDecompressionError.Create(ErrorStrings[Abs(Code)]);
-end;
-
-function TDecompressionStream.Read(var Buffer; Count: Longint): Longint;
-begin
-  FZRec.next_out := @Buffer;
-  FZRec.avail_out := Count;
-  if FStrm.Position <> FStrmPos then FStrm.Position := FStrmPos;
-  while (FZRec.avail_out > 0) do
-  begin
-    if FZRec.avail_in = 0 then
-    begin
-      FZRec.avail_in := FStrm.Read(FBuffer, sizeof(FBuffer));
-      if FZRec.avail_in = 0 then
-        begin
-          Result := Count - FZRec.avail_out;
-          Exit;
-        end;
-{$ifndef usepaszlib}
-      FZRec.next_in := FBuffer;
-{$else}
-      FZRec.next_in := @FBuffer;
-{$endif}
-      FStrmPos := FStrm.Position;
-      Progress(Self);
-    end;
-    DeCompressionCheck(inflate(FZRec, 0));
-  end;
-  Result := Count;
-end;
-
-function TDecompressionStream.Write(const Buffer; Count: Longint): Longint;
-begin
-  raise EDecompressionError.Create('Invalid stream operation');
-end;
-
-function TDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
-var
-  I: Integer;
-  Buf: array [0..4095] of Char;
-begin
-  if (Offset = 0) and (Origin = soFromBeginning) then
-  begin
-    DecompressionCheck(inflateReset(FZRec));
-{$ifndef usepaszlib}
-    FZRec.next_in := FBuffer;
-{$else}
-    FZRec.next_in := @FBuffer;
-{$endif}
-    FZRec.avail_in := 0;
-    FStrm.Position := 0;
-    FStrmPos := 0;
-  end
-  else if ( (Offset >= 0) and (Origin = soFromCurrent)) or
-          ( ((Offset - FZRec.total_out) > 0) and (Origin = soFromBeginning)) then
-  begin
-    if Origin = soFromBeginning then Dec(Offset, FZRec.total_out);
-    if Offset > 0 then
-    begin
-      for I := 1 to Offset div sizeof(Buf) do
-        ReadBuffer(Buf, sizeof(Buf));
-      ReadBuffer(Buf, Offset mod sizeof(Buf));
-    end;
-  end
-  else
-    raise EDecompressionError.Create(SInvalidSeek);
-  Result := FZRec.total_out;
-end;
-
-// TGZFileStream
-
-Constructor TGZFileStream.Create(FileName: String;FileMode: TGZOpenMode);
-
-Const OpenStrings : array[TGZOpenMode] of pchar = ('rb','wb');
-
-begin
-   FOpenMode:=FileMode;
-   FFile:=gzopen (Pchar(FileName),Openstrings[FileMode]);
-   If FFile=Nil then
-     Raise ezlibError.CreateFmt (SCouldntOpenFIle,[FileName]);
-end;
-
-Destructor TGZFileStream.Destroy;
-begin
-  gzclose(FFile);
-  Inherited Destroy;
-end;
-
-Function TGZFileStream.Read(Var Buffer; Count : longint): longint;
-begin
-  If FOpenMode=gzOpenWrite then
-    Raise ezliberror.create(SWriteOnlyStream);
-  Result:=gzRead(FFile,@Buffer,Count);
-end;
-
-function TGZFileStream.Write(const Buffer; Count: Longint): Longint;
-begin
-  If FOpenMode=gzOpenRead then
-    Raise EzlibError.Create(SReadonlyStream);
-  Result:=gzWrite(FFile,@Buffer,Count);
-end;
-
-function TGZFileStream.Seek(Offset: Longint; Origin: Word): Longint;
-begin
-  Result:=gzseek(FFile,Offset,Origin);
-  If Result=-1 then
-    Raise eZlibError.Create(SSeekError);
-end;
-
-end.

fcl/linux/Makefile

@@ -1,1047 +0,0 @@
-#
-# Makefile generated by fpcmake v0.99.13 on 1999-12-24 16:08
-#
-
-defaultrule: all
-
-#####################################################################
-# Autodetect OS (Linux or Dos or Windows NT)
-# define inlinux when running under linux
-# define inWinNT when running under WinNT
-#####################################################################
-
-# We need only / in the path
-override PATH:=$(subst \,/,$(PATH))
-
-# Search for PWD and determine also if we are under linux
-PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
-ifeq ($(PWD),)
-PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
-ifeq ($(PWD),)
-nopwd:
-	@echo You need the GNU utils package to use this Makefile!
-	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
-	@exit
-else
-inlinux=1
-endif
-else
-PWD:=$(firstword $(PWD))
-endif
-
-# Detect NT - NT sets OS to Windows_NT
-ifndef inlinux
-ifeq ($(OS),Windows_NT)
-inWinNT=1
-endif
-endif
-
-# Detect OS/2 - OS/2 has OS2_SHELL defined
-ifndef inlinux
-ifndef inWinNT
-ifdef OS2_SHELL
-inOS2=1
-endif
-endif
-endif
-
-# The extension of executables
-ifdef inlinux
-EXEEXT=
-else
-EXEEXT=.exe
-endif
-
-# The path which is search separated by spaces
-ifdef inlinux
-SEARCHPATH=$(subst :, ,$(PATH))
-else
-SEARCHPATH=$(subst ;, ,$(PATH))
-endif
-
-#####################################################################
-# Default target
-#####################################################################
-
-override OS_TARGET:=linux
-
-#####################################################################
-# FPC version/target Detection
-#####################################################################
-
-# What compiler to use ?
-ifndef FPC
-# Compatibility with old makefiles
-ifdef PP
-FPC=$(PP)
-else
-ifdef inOS2
-FPC=ppos2$(EXEEXT)
-else
-FPC=ppc386$(EXEEXT)
-endif
-endif
-endif
-
-# Target OS
-ifndef OS_TARGET
-OS_TARGET:=$(shell $(FPC) -iTO)
-endif
-
-# Source OS
-ifndef OS_SOURCE
-OS_SOURCE:=$(shell $(FPC) -iSO)
-endif
-
-# Target CPU
-ifndef CPU_TARGET
-CPU_TARGET:=$(shell $(FPC) -iTP)
-endif
-
-# Source CPU
-ifndef CPU_SOURCE
-CPU_SOURCE:=$(shell $(FPC) -iSP)
-endif
-
-# FPC version
-ifndef FPC_VERSION
-FPC_VERSION:=$(shell $(FPC) -iV)
-endif
-
-export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
-
-#####################################################################
-# Default Settings
-#####################################################################
-
-# Release ? Then force OPT and don't use extra opts via commandline
-ifndef REDIRFILE
-REDIRFILE=log
-endif
-
-ifdef RELEASE
-override OPT:=-Xs -OG2p3 -n
-endif
-
-# Verbose settings (warning,note,info)
-ifdef VERBOSE
-override OPT+=-vwni
-endif
-
-ifdef REDIR
-ifndef inlinux
-override FPC=redir -eo $(FPC)
-endif
-# set the verbosity to max
-override OPT+=-va
-override REDIR:= >> $(REDIRFILE)
-endif
-
-#####################################################################
-# User Settings
-#####################################################################
-
-
-# Pre Settings
-
-# Include files
-INC=../inc
-XML=../xml
-
-# INCUNITS,XMLUNITS is defined in makefile.inc
-# They are default units for all platforms.
-include $(INC)/Makefile.inc
-include $(XML)/Makefile.inc
-
-# Targets
-
-override UNITOBJECTS+=classes $(INCUNITS) $(XMLUNITS) zstream
-
-# Clean
-
-
-# Install
-
-ZIPTARGET=install
-
-# Defaults
-
-override NEEDOPT=-S2
-
-# Directories
-
-vpath %$(PASEXT) $(INC) $(XML)
-ifndef FPCDIR
-FPCDIR=../..
-endif
-ifndef PACKAGEDIR
-PACKAGEDIR=$(FPCDIR)/packages
-endif
-ifndef COMPONENTDIR
-COMPONENTDIR=$(FPCDIR)/components
-endif
-override NEEDINCDIR=$(INC)
-ifndef TARGETDIR
-TARGETDIR=.
-endif
-
-# Packages
-
-override PACKAGES+=zlib
-ifneq ($(wildcard $(PACKAGEDIR)/zlib/$(OS_TARGET)),)
-override NEEDUNITDIR+=$(PACKAGEDIR)/zlib/$(OS_TARGET)
-else
-override NEEDUNITDIR+=$(PACKAGEDIR)/zlib
-endif
-
-# Libraries
-
-
-# Info
-
-INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall 
-
-#####################################################################
-# Default Directories
-#####################################################################
-
-# Base dir
-ifdef PWD
-BASEDIR:=$(shell $(PWD))
-else
-BASEDIR=.
-endif
-
-# this can be set to 'rtl' when the RTL units are installed
-ifndef UNITPREFIX
-UNITPREFIX=units
-endif
-
-# set the prefix directory where to install everything
-ifndef PREFIXINSTALLDIR
-ifdef inlinux
-PREFIXINSTALLDIR=/usr
-else
-PREFIXINSTALLDIR=/pp
-endif
-endif
-export PREFIXINSTALLDIR
-
-# create fcldir,rtldir,unitdir
-ifdef FPCDIR
-override FPCDIR:=$(subst \,/,$(FPCDIR))
-ifneq ($(FPCDIR),.)
-override RTLDIR=$(FPCDIR)/rtl/$(OS_TARGET)
-override FCLDIR=$(FPCDIR)/fcl/$(OS_TARGET)
-override UNITSDIR=$(FPCDIR)/units/$(OS_TARGET)
-endif
-endif
-
-#####################################################################
-# Install Directories
-#####################################################################
-
-# set the base directory where to install everything
-ifndef BASEINSTALLDIR
-ifdef inlinux
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION)
-else
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)
-endif
-endif
-
-# set the directory where to install the binaries
-ifndef BININSTALLDIR
-ifdef inlinux
-BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
-else
-BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
-endif
-endif
-
-# set the directory where to install the units.
-ifndef UNITINSTALLDIR
-UNITINSTALLDIR=$(BASEINSTALLDIR)/$(UNITPREFIX)/$(OS_TARGET)
-endif
-
-# Where to install shared libraries
-ifndef LIBINSTALLDIR
-ifdef inlinux
-LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
-else
-LIBINSTALLDIR=$(UNITINSTALLDIR)
-endif
-endif
-
-# Where the source files will be stored
-ifndef SOURCEINSTALLDIR
-ifdef inlinux
-SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION)
-else
-SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source
-endif
-endif
-
-# Where the doc files will be stored
-ifndef DOCINSTALLDIR
-ifdef inlinux
-DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc/$(FPC_VERSION)
-else
-DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
-endif
-endif
-
-# Where the some extra (data)files will be stored
-ifndef EXTRAINSTALLDIR
-EXTRAINSTALLDIR=$(BASEINSTALLDIR)
-endif
-
-
-#####################################################################
-# Compiler Command Line
-#####################################################################
-
-# Load commandline OPTDEF and add FPC_CPU define
-override FPCOPTDEF:=-d$(CPU_TARGET)
-
-# Load commandline OPT and add target and unit dir to be sure
-ifneq ($(OS_TARGET),$(OS_SOURCE))
-override FPCOPT+=-T$(OS_TARGET)
-endif
-
-ifdef NEEDOPT
-override FPCOPT+=$(NEEDOPT)
-endif
-
-ifdef RTLDIR
-override FPCOPT+=-Fu$(RTLDIR)
-endif
-
-ifdef UNITSDIR
-override FPCOPT+=-Fu$(UNITSDIR)
-endif
-
-ifdef NEEDUNITDIR
-override FPCOPT+=$(addprefix -Fu,$(NEEDUNITDIR))
-endif
-
-ifdef NEEDINCDIR
-override FPCOPT+=$(addprefix -Fi,$(NEEDINCDIR))
-endif
-
-
-# Target dirs
-ifdef TARGETDIR
-override FPCOPT+=-FE$(TARGETDIR)
-endif
-
-# Smartlinking
-ifdef SMARTLINK
-override FPCOPT+=-CX
-endif
-
-# Debug
-ifdef DEBUG
-override FPCOPT+=-g
-endif
-
-# Add commandline options
-ifdef OPT
-override FPCOPT+=$(OPT)
-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
-
-# Add defines from FPCOPTDEF to FPCOPT
-ifdef FPCOPTDEF
-override FPCOPT+=$(FPCOPTDEF)
-endif
-
-# Error file ?
-ifdef ERRORFILE
-override FPCOPT+=-Fr$(ERRORFILE)
-endif
-
-# Was a config file specified ?
-ifdef CFGFILE
-override FPCOPT+=@$(CFGFILE)
-endif
-
-# For win32 the options are passed using the environment variable FPCEXTCMD
-ifeq ($(OS_SOURCE),win32)
-override FPCEXTCMD:=$(FPCOPT)
-override FPCOPT:=!FPCEXTCMD
-export FPCEXTCMD
-endif
-
-# Compiler commandline
-override COMPILER:=$(FPC) $(FPCOPT)
-
-#####################################################################
-# Shell tools
-#####################################################################
-
-# To copy pograms
-ifndef COPY
-COPY:=cp -fp
-endif
-
-# Copy a whole tree
-ifndef COPYTREE
-COPYTREE:=cp -rfp
-endif
-
-# To move pograms
-ifndef MOVE
-MOVE:=mv -f
-endif
-
-# Check delete program
-ifndef DEL
-DEL:=rm -f
-endif
-
-# Check deltree program
-ifndef DELTREE
-DELTREE:=rm -rf
-endif
-
-# To install files
-ifndef INSTALL
-ifdef inlinux
-INSTALL:=install -m 644
-else
-INSTALL:=$(COPY)
-endif
-endif
-
-# To install programs
-ifndef INSTALLEXE
-ifdef inlinux
-INSTALLEXE:=install -m 755
-else
-INSTALLEXE:=$(COPY)
-endif
-endif
-
-# To make a directory.
-ifndef MKDIR
-ifdef inlinux
-MKDIR:=install -m 755 -d
-else
-MKDIR:=ginstall -m 755 -d
-endif
-endif
-
-export COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
-
-#####################################################################
-# Default Tools
-#####################################################################
-
-# assembler, redefine it if cross compiling
-ifndef AS
-AS=as
-endif
-
-# linker, but probably not used
-ifndef LD
-LD=ld
-endif
-
-# ppas.bat / ppas.sh
-ifdef inlinux
-PPAS=ppas.sh
-else
-ifdef inOS2
-PPAS=ppas.cmd
-else
-PPAS=ppas.bat
-endif
-endif
-
-# also call ppas if with command option -s
-ifeq (,$(findstring -s ,$(COMPILER)))
-EXECPPAS=
-else
-EXECPPAS:=@$(PPAS)
-endif
-
-# ldconfig to rebuild .so cache
-ifdef inlinux
-LDCONFIG=ldconfig
-else
-LDCONFIG=
-endif
-
-# echo
-ifndef ECHO
-ECHO:=$(strip $(wildcard $(addsuffix /echo$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO:=echo
-else
-ECHO:=$(firstword $(ECHO))
-endif
-endif
-export ECHO
-
-# ppdep
-ifndef PPDEP
-PPDEP:=$(strip $(wildcard $(addsuffix /ppdep$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPDEP),)
-PPDEP=
-else
-PPDEP:=$(firstword $(PPDEP))
-endif
-endif
-export PPDEP
-
-# ppumove
-ifndef PPUMOVE
-PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUMOVE),)
-PPUMOVE=
-else
-PPUMOVE:=$(firstword $(PPUMOVE))
-endif
-endif
-export PPUMOVE
-
-# ppufiles
-ifndef PPUFILES
-PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUFILES),)
-PPUFILES=
-else
-PPUFILES:=$(firstword $(PPUFILES))
-endif
-endif
-export PPUFILES
-
-# Look if UPX is found for go32v2 and win32. We can't use $UPX becuase
-# upx uses that one itself (PFV)
-ifndef UPXPROG
-ifeq ($(OS_TARGET),go32v2)
-UPXPROG:=1
-endif
-ifeq ($(OS_TARGET),win32)
-UPXPROG:=1
-endif
-ifdef UPXPROG
-UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(UPXPROG),)
-UPXPROG=
-else
-UPXPROG:=$(firstword $(UPXPROG))
-endif
-else
-UPXPROG=
-endif
-endif
-export UPXPROG
-
-# gdate/date
-ifndef DATE
-DATE:=$(strip $(wildcard $(addsuffix /date$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(DATE),)
-DATE:=$(strip $(wildcard $(addsuffix /gdate$(EXEEXT),$(SEACHPATH))))
-ifeq ($(DATE),)
-DATE=
-else
-DATE:=$(firstword $(DATE))
-endif
-else
-DATE:=$(firstword $(DATE))
-endif
-endif
-export DATE
-
-ifdef DATE
-DATESTR:=$(shell $(DATE) +%Y%m%d)
-else
-DATESTR=
-endif
-
-# ZipProg, you can't use Zip as the var name (PFV)
-ifndef ZIPPROG
-ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ZIPPROG),)
-ZIPPROG=
-else
-ZIPPROG:=$(firstword $(ZIPPROG)) -D9 -r
-endif
-endif
-export ZIPPROG
-
-ifndef ZIPEXT
-ZIPEXT=.zip
-endif
-
-#####################################################################
-# Default extensions
-#####################################################################
-
-# Default needed extensions (Go32v2,Linux)
-LOADEREXT=.as
-PPLEXT=.ppl
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.so
-PACKAGESUFFIX=
-FPCMADE=fpcmade
-
-# Go32v1
-ifeq ($(OS_TARGET),go32v1)
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-STATICLIBEXT=.a1
-SHAREDLIBEXT=.so1
-PACKAGESUFFIX=v1
-FPCMADE=fpcmade.v1
-endif
-
-# Go32v2
-ifeq ($(OS_TARGET),go32v2)
-PACKAGESUFFIX=go32
-FPCMADE=fpcmade.dos
-endif
-
-# Linux
-ifeq ($(OS_TARGET),linux)
-PACKAGESUFFIX=linux
-FPCMADE=fpcmade.lnx
-endif
-
-# Win32
-ifeq ($(OS_TARGET),win32)
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=win32
-FPCMADE=fpcmade.w32
-endif
-
-# OS/2
-ifeq ($(OS_TARGET),os2)
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-SMARTEXT=.so
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=os2
-FPCMADE=fpcmade.os2
-endif
-
-# library prefix
-LIBPREFIX=lib
-ifeq ($(OS_TARGET),go32v2)
-LIBPREFIX=
-endif
-ifeq ($(OS_TARGET),go32v1)
-LIBPREFIX=
-endif
-
-# determine which .pas extension is used
-ifndef PASEXT
-ifdef EXEOBJECTS
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
-else
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
-endif
-ifeq ($(TESTPAS),)
-PASEXT=.pp
-else
-PASEXT=.pas
-endif
-endif
-
-#####################################################################
-# Standard rules
-#####################################################################
-
-all: fpc_all
-
-debug: fpc_debug
-
-smart: fpc_smart
-
-shared: fpc_shared
-
-showinstall: fpc_showinstall
-
-install: fpc_install
-
-sourceinstall: fpc_sourceinstall
-
-zipinstall: fpc_zipinstall
-
-zipinstalladd: fpc_zipinstalladd
-
-clean: fpc_clean
-
-cleanall: fpc_cleanall
-
-info: fpc_info
-
-.PHONY:  all debug smart shared showinstall install sourceinstall zipinstall zipinstalladd clean cleanall info
-
-#####################################################################
-# Package depends
-#####################################################################
-
-ifneq ($(wildcard $(RTLDIR)),)
-ifeq ($(wildcard $(RTLDIR)/$(FPCMADE)),)
-override COMPILEPACKAGES+=rtl
-rtl_package:
-	$(MAKE) -C $(RTLDIR) all
-endif
-endif
-
-PACKAGEZLIB=1
-ifdef PACKAGEZLIB
-ifneq ($(wildcard $(PACKAGEDIR)/zlib),)
-ifeq ($(wildcard $(PACKAGEDIR)/zlib/$(FPCMADE)),)
-override COMPILEPACKAGES+=zlib
-zlib_package:
-	$(MAKE) -C $(PACKAGEDIR)/zlib all
-endif
-endif
-endif
-
-.PHONY:  rtl_package zlib_package
-
-#####################################################################
-# Units
-#####################################################################
-
-.PHONY: fpc_units
-
-override ALLTARGET+=fpc_units
-
-override UNITPPUFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS))
-override INSTALLPPUFILES+=$(UNITPPUFILES)
-override CLEANPPUFILES+=$(UNITPPUFILES)
-
-fpc_units: $(UNITPPUFILES)
-
-#####################################################################
-# General compile rules
-#####################################################################
-
-.PHONY: fpc_all fpc_debug
-
-$(FPCMADE):
-	@$(ECHO) Compiled > $(FPCMADE)
-
-fpc_all: $(addsuffix _package,$(COMPILEPACKAGES)) \
-	 $(addsuffix _component,$(COMPILECOMPONENTS)) \
-	 $(ALLTARGET) $(FPCMADE)
-
-fpc_debug:
-	$(MAKE) all DEBUG=1
-
-# General compile rules, available for both possible PASEXT
-
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
-
-%$(PPUEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(PPUEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-#####################################################################
-# Library
-#####################################################################
-
-.PHONY: fpc_smart fpc_shared
-
-# Default sharedlib units are all unit objects
-ifndef SHAREDLIBUNITOBJECTS
-SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
-endif
-
-fpc_smart:
-	$(MAKE) all SMARTLINK=1
-
-fpc_shared: all
-ifdef inlinux
-ifndef LIBNAME
-	@$(ECHO) "LIBNAME not set"
-else
-	$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
-endif
-else
-	@$(ECHO) "Shared Libraries not supported"
-endif
-
-#####################################################################
-# Install rules
-#####################################################################
-
-.PHONY: fpc_showinstall fpc_install
-
-ifdef EXTRAINSTALLUNITS
-override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))
-endif
-
-ifdef INSTALLPPUFILES
-ifdef PPUFILES
-ifdef inlinux
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
-INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
-else
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
-endif
-else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
-endif
-endif
-
-fpc_showinstall: $(SHOWINSTALLTARGET)
-ifdef INSTALLEXEFILES
-	@$(ECHO) -e $(addprefix "\n"$(BININSTALLDIR)/,$(INSTALLEXEFILES))
-endif
-ifdef INSTALLPPUFILES
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPUFILES))
-ifneq ($(INSTALLPPULINKFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	@$(ECHO) -e $(addprefix "\n"$(EXTRAINSTALLDIR)/,$(EXTRAINSTALLFILES))
-endif
-
-fpc_install: $(INSTALLTARGET)
-# Create UnitInstallFiles
-ifdef INSTALLEXEFILES
-	$(MKDIR) $(BININSTALLDIR)
-# Compress the exes if upx is defined
-ifdef UPXPROG
-	-$(UPXPROG) $(INSTALLEXEFILES)
-endif
-	$(INSTALLEXE) $(INSTALLEXEFILES) $(BININSTALLDIR)
-endif
-ifdef INSTALLPPUFILES
-	$(MKDIR) $(UNITINSTALLDIR)
-	$(INSTALL) $(INSTALLPPUFILES) $(UNITINSTALLDIR)
-ifneq ($(INSTALLPPULINKFILES),)
-	$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	$(MKDIR) $(LIBINSTALLDIR)
-	$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	$(MKDIR) $(EXTRAINSTALLDIR)
-	$(INSTALL) $(EXTRAINSTALLFILES) $(EXTRAINSTALLDIR)
-endif
-
-#####################################################################
-# Source install rules
-#####################################################################
-
-.PHONY: fpc_sourceinstall
-
-fpc_sourceinstall: clean
-	$(MKDIR) $(SOURCEINSTALLDIR)
-	$(COPYTREE) $(BASEDIR) $(SOURCEINSTALLDIR)
-
-#####################################################################
-# Zip
-#####################################################################
-
-.PHONY: fpc_zipinstall fpc_zipinstalladd
-
-# Temporary path to pack a file
-ifndef PACKDIR
-ifndef inlinux
-PACKDIR=pack_tmp
-else
-PACKDIR=/tmp/fpc-pack
-endif
-endif
-
-# Test dir if none specified
-ifndef DESTZIPDIR
-DESTZIPDIR:=$(BASEDIR)
-endif
-
-# Add .zip/.tar.gz extension
-ifdef ZIPNAME
-ifndef inlinux
-override ZIPNAME:=$(ZIPNAME)$(ZIPEXT)
-endif
-endif
-
-# Note: This will not remove the zipfile first
-fpc_zipinstalladd:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	gzip -d $(DESTZIPDIR)/$(ZIPNAME).tar.gz
-	cd $(PACKDIR) ; tar rv --file $(DESTZIPDIR)/$(ZIPNAME).tar * ; cd $(BASEDIR)
-	gzip $(DESTZIPDIR)/$(ZIPNAME).tar
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-# First remove the zip and then install
-fpc_zipinstall:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	cd $(PACKDIR) ; tar cvz --file $(DESTZIPDIR)/$(ZIPNAME).tar.gz * ; cd $(BASEDIR)
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-#####################################################################
-# Clean rules
-#####################################################################
-
-.PHONY: fpc_clean fpc_cleanall
-
-ifdef EXTRACLEANUNITS
-override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS))
-endif
-
-ifdef CLEANPPUFILES
-ifdef PPUFILES
-CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
-else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
-endif
-endif
-
-fpc_clean: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-ifdef CLEANPPUFILES
-	-$(DEL) $(CLEANPPUFILES)
-endif
-ifneq ($(CLEANPPULINKFILES),)
-	-$(DEL) $(CLEANPPULINKFILES)
-endif
-ifdef EXTRACLEANFILES
-	-$(DEL) $(EXTRACLEANFILES)
-endif
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-fpc_cleanall: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-	-$(DELTREE) *$(SMARTEXT)
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-#####################################################################
-# Info rules
-#####################################################################
-
-.PHONY: fpc_info fpc_cfginfo fpc_objectinfo fpc_toolsinfo fpc_installinfo \
-	fpc_dirinfo
-
-fpc_info: $(INFOTARGET)
-
-fpc_infocfg:
-	@$(ECHO)
-	@$(ECHO)  == Configuration info ==
-	@$(ECHO)
-	@$(ECHO)  FPC....... $(FPC)
-	@$(ECHO)  Version... $(FPC_VERSION)
-	@$(ECHO)  CPU....... $(CPU_TARGET)
-	@$(ECHO)  Source.... $(OS_SOURCE)
-	@$(ECHO)  Target.... $(OS_TARGET)
-	@$(ECHO)
-
-fpc_infoobjects:
-	@$(ECHO)
-	@$(ECHO)  == Object info ==
-	@$(ECHO)
-	@$(ECHO)  LoaderObjects..... $(LOADEROBJECTS)
-	@$(ECHO)  UnitObjects....... $(UNITOBJECTS)
-	@$(ECHO)  ExeObjects........ $(EXEOBJECTS)
-	@$(ECHO)
-	@$(ECHO)  ExtraCleanUnits... $(EXTRACLEANUNITS)
-	@$(ECHO)  ExtraCleanFiles... $(EXTRACLEANFILES)
-	@$(ECHO)
-	@$(ECHO)  ExtraInstallUnits. $(EXTRAINSTALLUNITS)
-	@$(ECHO)  ExtraInstallFiles. $(EXTRAINSTALLFILES)
-	@$(ECHO)
-
-fpc_infoinstall:
-	@$(ECHO)
-	@$(ECHO)  == Install info ==
-	@$(ECHO)
-ifdef DATE
-	@$(ECHO)  DateStr.............. $(DATESTR)
-endif
-	@$(ECHO)  PackageSuffix........ $(PACKAGESUFFIX)
-	@$(ECHO)
-	@$(ECHO)  BaseInstallDir....... $(BASEINSTALLDIR)
-	@$(ECHO)  BinInstallDir........ $(BININSTALLDIR)
-	@$(ECHO)  LibInstallDir........ $(LIBINSTALLDIR)
-	@$(ECHO)  UnitInstallDir....... $(UNITINSTALLDIR)
-	@$(ECHO)  SourceInstallDir..... $(SOURCEINSTALLDIR)
-	@$(ECHO)  DocInstallDir........ $(DOCINSTALLDIR)
-	@$(ECHO)  ExtraInstallDir...... $(EXTRAINSTALLDIR)
-	@$(ECHO)
-
-#####################################################################
-# Users rules
-#####################################################################
-
-INCFILES=$(addprefix $(INC)/,$(INCNAMES))
-
-classes$(PPUEXT): $(INCFILES) classes$(PASEXT)
-
-inifiles$(PPUEXT): classes$(PPUEXT) $(INC)/inifiles$(PASEXT)
-
-ezcgi$(PPUEXT): $(INC)/ezcgi$(PASEXT)

fcl/linux/Makefile.fpc

@@ -1,39 +0,0 @@
-#
-#   Makefile.fpc for Free Component Library for Linux
-#
-
-[defaults]
-defaulttarget=linux
-defaultoptions=-S2
-
-[packages]
-packages=zlib
-
-[dirs]
-fpcdir=../..
-targetdir=.
-incdir=$(INC)
-sourcesdir=$(INC) $(XML)
-
-[targets]
-units=classes $(INCUNITS) $(XMLUNITS) zstream
-
-[presettings]
-# Include files
-INC=../inc
-XML=../xml
-
-# INCUNITS,XMLUNITS is defined in makefile.inc
-# They are default units for all platforms.
-include $(INC)/Makefile.inc
-include $(XML)/Makefile.inc
-
-
-[rules]
-INCFILES=$(addprefix $(INC)/,$(INCNAMES))
-
-classes$(PPUEXT): $(INCFILES) classes$(PASEXT)
-
-inifiles$(PPUEXT): classes$(PPUEXT) $(INC)/inifiles$(PASEXT)
-
-ezcgi$(PPUEXT): $(INC)/ezcgi$(PASEXT)

fcl/linux/classes.pp

@@ -1,53 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
-
-    Classes unit for linux
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{$mode objfpc}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  strings,
-  sysutils;
-
-{$i classesh.inc}
-
-implementation
-
-uses
-  linux;
-  
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-
-initialization
-
-finalization
-  if ThreadsInited then
-   DoneThreads;
-
-end.
-{
-  $Log$
-  Revision 1.11  1999-05-30 10:46:41  peter
-    * start of tthread for linux,win32
-
-}

fcl/linux/ezcgi.inc

@@ -1,16 +0,0 @@
-Uses Linux;
-
-{ Declared EXPLICITLY with Ansistring, so NO mistaking is possible }
-
-Function Getenv (Var EnvVar  : AnsiString): AnsiString;
-
-Var P : Pchar;
-
-begin
-   // Linux version returns pchar.
-   p:=linux.getenv(EnvVar);
-   if P<>nil then
-     getenv:=strpas(p)
-   else
-     getenv:='';
-end;

fcl/linux/pipes.inc

@@ -1,23 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Pascal run time library.
-    Copyright (c) 1998 by Michael Van Canneyt
-
-    Linux specific part of pipe stream.
-    
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-uses linux;
-
-Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
-
-begin
-  Result := AssignPipe (Inhandle,OutHandle);
-end;

fcl/linux/thread.inc

@@ -1,288 +0,0 @@
-{
-  $Id$
-
-  Linux TThread implementation
-}
-
-type
-  PThreadRec=^TThreadRec;
-  TThreadRec=record
-    thread : TThread;
-    next   : PThreadRec;
-  end;
-
-var
-  ThreadRoot : PThreadRec;
-  ThreadsInited : boolean;
-//  MainThreadID: longint;
-
-Const
-  ThreadCount: longint = 0;
-
-function ThreadSelf:TThread;
-var
-  hp : PThreadRec;
-  sp : longint;
-begin
-  sp:=SPtr;
-  hp:=ThreadRoot;
-  while assigned(hp) do
-   begin
-     if (sp<=hp^.Thread.FStackPointer) and
-        (sp>(hp^.Thread.FStackPointer-hp^.Thread.FStackSize)) then
-      begin
-        Result:=hp^.Thread;
-        exit;
-      end;
-     hp:=hp^.next;
-   end;
-  Result:=nil;
-end;
-
-
-//function SIGCHLDHandler(Sig: longint): longint; cdecl;//this is std linux C declaration as function
-procedure SIGCHLDHandler(Sig: longint); cdecl;
-begin
-  waitpid(-1, nil, WNOHANG);
-end;
-
-procedure InitThreads;
-var
-  Act, OldAct: PSigActionRec;
-begin
-  ThreadRoot:=nil;
-  ThreadsInited:=true;
-
-
-// This will install SIGCHLD signal handler
-// signal() installs "one-shot" handler,
-// so it is better to install and set up handler with sigaction()
-
-  GetMem(Act, SizeOf(SigActionRec));
-  GetMem(OldAct, SizeOf(SigActionRec));
-
-  Act^.sa_handler := @SIGCHLDHandler;
-  Act^.sa_flags := SA_NOCLDSTOP {or SA_NOMASK or SA_RESTART};
-  Act^.sa_mask := 0; //Do not block all signals ??. Don't need if SA_NOMASK in flags
-
-  SigAction(SIGCHLD, Act, OldAct);
-
-  FreeMem(Act, SizeOf(SigActionRec));
-  FreeMem(OldAct, SizeOf(SigActionRec));
-end;
-
-
-procedure DoneThreads;
-var
-  hp : PThreadRec;
-begin
-  while assigned(ThreadRoot) do
-   begin
-     ThreadRoot^.Thread.Destroy;
-     hp:=ThreadRoot;
-     ThreadRoot:=ThreadRoot^.Next;
-     dispose(hp);
-   end;
-  ThreadsInited:=false;
-end;
-
-
-procedure AddThread(t:TThread);
-var
-  hp : PThreadRec;
-begin
-  { Need to initialize threads ? }
-  if not ThreadsInited then
-   InitThreads;
-
-  { Put thread in the linked list }
-  new(hp);
-  hp^.Thread:=t;
-  hp^.next:=ThreadRoot;
-  ThreadRoot:=hp;
-
-  inc(ThreadCount, 1);
-end;
-
-
-procedure RemoveThread(t:TThread);
-var
-  lasthp,hp : PThreadRec;
-begin
-  hp:=ThreadRoot;
-  lasthp:=nil;
-  while assigned(hp) do
-   begin
-     if hp^.Thread=t then
-      begin
-        if assigned(lasthp) then
-         lasthp^.next:=hp^.next
-        else
-         ThreadRoot:=hp^.next;
-        dispose(hp);
-        exit;
-      end;
-     lasthp:=hp;
-     hp:=hp^.next;
-   end;
-
-  Dec(ThreadCount, 1);
-  if ThreadCount = 0 then DoneThreads;
-end;
-
-
-{ TThread }
-function ThreadProc(args:pointer): Integer;cdecl;
-var
-  FreeThread: Boolean;
-  Thread : TThread absolute args;
-begin
-  Thread.Execute;
-  FreeThread := Thread.FFreeOnTerminate;
-  Result := Thread.FReturnValue;
-  Thread.FFinished := True;
-  Thread.DoTerminate;
-  if FreeThread then
-    Thread.Free;
-  ExitProcess(Result);
-end;
-
-
-constructor TThread.Create(CreateSuspended: Boolean);
-var
-  Flags: Integer;
-begin
-  inherited Create;
-  AddThread(self);
-  FSuspended := CreateSuspended;
-  Flags := CLONE_VM + CLONE_FS + CLONE_FILES + CLONE_SIGHAND + SIGCHLD;
-  { Setup 16k of stack }
-  FStackSize:=16384;
-  Getmem(pointer(FStackPointer),FStackSize);
-  inc(FStackPointer,FStackSize);
-  FCallExitProcess:=false;
-  { Clone }
-  FHandle:= Clone(@ThreadProc,pointer(FStackPointer),Flags,self);
-  if FSuspended then Suspend;
-  FThreadID := FHandle;
-end;
-
-
-destructor TThread.Destroy;
-begin
-  if not FFinished and not Suspended then
-   begin
-     Terminate;
-     WaitFor;
-   end;
-  if FHandle <> -1 then
-    Kill(FHandle, SIGKILL);
-  dec(FStackPointer,FStackSize);
-  Freemem(pointer(FStackPointer),FStackSize);
-  inherited Destroy;
-  RemoveThread(self);
-end;
-
-
-procedure TThread.CallOnTerminate;
-begin
-  FOnTerminate(Self);
-end;
-
-procedure TThread.DoTerminate;
-begin
-  if Assigned(FOnTerminate) then
-    Synchronize(@CallOnTerminate);
-end;
-
-
-const
-{ I Don't know idle or timecritical, value is also 20, so the largest other
-  possibility is 19 (PFV) }
-  Priorities: array [TThreadPriority] of Integer =
-   (-20,-19,-10,9,10,19,20);
-
-function TThread.GetPriority: TThreadPriority;
-var
-  P: Integer;
-  I: TThreadPriority;
-begin
-  P := Linux.GetPriority(Prio_Process,FHandle);
-  Result := tpNormal;
-  for I := Low(TThreadPriority) to High(TThreadPriority) do
-    if Priorities[I] = P then
-      Result := I;
-end;
-
-
-procedure TThread.SetPriority(Value: TThreadPriority);
-begin
-  Linux.SetPriority(Prio_Process,FHandle, Priorities[Value]);
-end;
-
-
-procedure TThread.Synchronize(Method: TThreadMethod);
-begin
-  FSynchronizeException := nil;
-  FMethod := Method;
-{  SendMessage(ThreadWindow, CM_EXECPROC, 0, Longint(Self)); }
-  if Assigned(FSynchronizeException) then
-    raise FSynchronizeException;
-end;
-
-
-procedure TThread.SetSuspended(Value: Boolean);
-begin
-  if Value <> FSuspended then
-    if Value then
-      Suspend
-    else
-      Resume;
-end;
-
-
-procedure TThread.Suspend;
-begin
-  Kill(FHandle, SIGSTOP);
-  FSuspended := true;
-end;
-
-
-procedure TThread.Resume;
-begin
-  Kill(FHandle, SIGCONT);
-  FSuspended := False;
-end;
-
-
-procedure TThread.Terminate;
-begin
-  FTerminated := True;
-end;
-
-function TThread.WaitFor: Integer;
-var
-  status : longint;
-begin
-  if FThreadID = MainThreadID then
-   WaitPid(0,@status,0)
-  else
-   WaitPid(FHandle,@status,0);
-  Result:=status;
-end;
-
-{
-  $Log$
-  Revision 1.5  1999-10-27 10:40:30  peter
-    * fixed threadproc decl
-
-  Revision 1.4  1999/08/28 09:32:26  peter
-    * readded header/log
-
-  Revision 1.2  1999/05/31 12:47:59  peter
-    * classes unit to unitobjects
-
-  Revision 1.1  1999/05/30 10:46:42  peter
-    * start of tthread for linux,win32
-
-}

fcl/os2/Makefile

@@ -1,1026 +0,0 @@
-#
-# Makefile generated by fpcmake v0.99.13 on 1999-12-24 16:08
-#
-
-defaultrule: all
-
-#####################################################################
-# Autodetect OS (Linux or Dos or Windows NT)
-# define inlinux when running under linux
-# define inWinNT when running under WinNT
-#####################################################################
-
-# We need only / in the path
-override PATH:=$(subst \,/,$(PATH))
-
-# Search for PWD and determine also if we are under linux
-PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
-ifeq ($(PWD),)
-PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
-ifeq ($(PWD),)
-nopwd:
-	@echo You need the GNU utils package to use this Makefile!
-	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
-	@exit
-else
-inlinux=1
-endif
-else
-PWD:=$(firstword $(PWD))
-endif
-
-# Detect NT - NT sets OS to Windows_NT
-ifndef inlinux
-ifeq ($(OS),Windows_NT)
-inWinNT=1
-endif
-endif
-
-# Detect OS/2 - OS/2 has OS2_SHELL defined
-ifndef inlinux
-ifndef inWinNT
-ifdef OS2_SHELL
-inOS2=1
-endif
-endif
-endif
-
-# The extension of executables
-ifdef inlinux
-EXEEXT=
-else
-EXEEXT=.exe
-endif
-
-# The path which is search separated by spaces
-ifdef inlinux
-SEARCHPATH=$(subst :, ,$(PATH))
-else
-SEARCHPATH=$(subst ;, ,$(PATH))
-endif
-
-#####################################################################
-# Default target
-#####################################################################
-
-override OS_TARGET:=os2
-
-#####################################################################
-# FPC version/target Detection
-#####################################################################
-
-# What compiler to use ?
-ifndef FPC
-# Compatibility with old makefiles
-ifdef PP
-FPC=$(PP)
-else
-ifdef inOS2
-FPC=ppos2$(EXEEXT)
-else
-FPC=ppc386$(EXEEXT)
-endif
-endif
-endif
-
-# Target OS
-ifndef OS_TARGET
-OS_TARGET:=$(shell $(FPC) -iTO)
-endif
-
-# Source OS
-ifndef OS_SOURCE
-OS_SOURCE:=$(shell $(FPC) -iSO)
-endif
-
-# Target CPU
-ifndef CPU_TARGET
-CPU_TARGET:=$(shell $(FPC) -iTP)
-endif
-
-# Source CPU
-ifndef CPU_SOURCE
-CPU_SOURCE:=$(shell $(FPC) -iSP)
-endif
-
-# FPC version
-ifndef FPC_VERSION
-FPC_VERSION:=$(shell $(FPC) -iV)
-endif
-
-export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
-
-#####################################################################
-# Default Settings
-#####################################################################
-
-# Release ? Then force OPT and don't use extra opts via commandline
-ifndef REDIRFILE
-REDIRFILE=log
-endif
-
-ifdef RELEASE
-override OPT:=-Xs -OG2p3 -n
-endif
-
-# Verbose settings (warning,note,info)
-ifdef VERBOSE
-override OPT+=-vwni
-endif
-
-ifdef REDIR
-ifndef inlinux
-override FPC=redir -eo $(FPC)
-endif
-# set the verbosity to max
-override OPT+=-va
-override REDIR:= >> $(REDIRFILE)
-endif
-
-#####################################################################
-# User Settings
-#####################################################################
-
-
-# Pre Settings
-
-# Include files
-INC=../inc
-XML=../xml
-
-# INCUNITS,XMLUNITS is defined in makefile.inc
-# They are default units for all platforms.
-include $(INC)/Makefile.inc
-include $(XML)/Makefile.inc
-
-# Targets
-
-override UNITOBJECTS+=classes $(INCUNITS) $(XMLUNITS)
-
-# Clean
-
-
-# Install
-
-ZIPTARGET=install
-
-# Defaults
-
-override NEEDOPT=-S2
-
-# Directories
-
-vpath %$(PASEXT) $(INC) $(XML)
-ifndef FPCDIR
-FPCDIR=../..
-endif
-ifndef PACKAGEDIR
-PACKAGEDIR=$(FPCDIR)/packages
-endif
-ifndef COMPONENTDIR
-COMPONENTDIR=$(FPCDIR)/components
-endif
-override NEEDINCDIR=$(INC)
-ifndef TARGETDIR
-TARGETDIR=.
-endif
-
-# Packages
-
-
-# Libraries
-
-
-# Info
-
-INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall 
-
-#####################################################################
-# Default Directories
-#####################################################################
-
-# Base dir
-ifdef PWD
-BASEDIR:=$(shell $(PWD))
-else
-BASEDIR=.
-endif
-
-# this can be set to 'rtl' when the RTL units are installed
-ifndef UNITPREFIX
-UNITPREFIX=units
-endif
-
-# set the prefix directory where to install everything
-ifndef PREFIXINSTALLDIR
-ifdef inlinux
-PREFIXINSTALLDIR=/usr
-else
-PREFIXINSTALLDIR=/pp
-endif
-endif
-export PREFIXINSTALLDIR
-
-# create fcldir,rtldir,unitdir
-ifdef FPCDIR
-override FPCDIR:=$(subst \,/,$(FPCDIR))
-ifneq ($(FPCDIR),.)
-override RTLDIR=$(FPCDIR)/rtl/$(OS_TARGET)
-override FCLDIR=$(FPCDIR)/fcl/$(OS_TARGET)
-override UNITSDIR=$(FPCDIR)/units/$(OS_TARGET)
-endif
-endif
-
-#####################################################################
-# Install Directories
-#####################################################################
-
-# set the base directory where to install everything
-ifndef BASEINSTALLDIR
-ifdef inlinux
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION)
-else
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)
-endif
-endif
-
-# set the directory where to install the binaries
-ifndef BININSTALLDIR
-ifdef inlinux
-BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
-else
-BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
-endif
-endif
-
-# set the directory where to install the units.
-ifndef UNITINSTALLDIR
-UNITINSTALLDIR=$(BASEINSTALLDIR)/$(UNITPREFIX)/$(OS_TARGET)
-endif
-
-# Where to install shared libraries
-ifndef LIBINSTALLDIR
-ifdef inlinux
-LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
-else
-LIBINSTALLDIR=$(UNITINSTALLDIR)
-endif
-endif
-
-# Where the source files will be stored
-ifndef SOURCEINSTALLDIR
-ifdef inlinux
-SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION)
-else
-SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source
-endif
-endif
-
-# Where the doc files will be stored
-ifndef DOCINSTALLDIR
-ifdef inlinux
-DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc/$(FPC_VERSION)
-else
-DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
-endif
-endif
-
-# Where the some extra (data)files will be stored
-ifndef EXTRAINSTALLDIR
-EXTRAINSTALLDIR=$(BASEINSTALLDIR)
-endif
-
-
-#####################################################################
-# Compiler Command Line
-#####################################################################
-
-# Load commandline OPTDEF and add FPC_CPU define
-override FPCOPTDEF:=-d$(CPU_TARGET)
-
-# Load commandline OPT and add target and unit dir to be sure
-ifneq ($(OS_TARGET),$(OS_SOURCE))
-override FPCOPT+=-T$(OS_TARGET)
-endif
-
-ifdef NEEDOPT
-override FPCOPT+=$(NEEDOPT)
-endif
-
-ifdef RTLDIR
-override FPCOPT+=-Fu$(RTLDIR)
-endif
-
-ifdef UNITSDIR
-override FPCOPT+=-Fu$(UNITSDIR)
-endif
-
-ifdef NEEDINCDIR
-override FPCOPT+=$(addprefix -Fi,$(NEEDINCDIR))
-endif
-
-
-# Target dirs
-ifdef TARGETDIR
-override FPCOPT+=-FE$(TARGETDIR)
-endif
-
-# Smartlinking
-ifdef SMARTLINK
-override FPCOPT+=-CX
-endif
-
-# Debug
-ifdef DEBUG
-override FPCOPT+=-g
-endif
-
-# Add commandline options
-ifdef OPT
-override FPCOPT+=$(OPT)
-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
-
-# Add defines from FPCOPTDEF to FPCOPT
-ifdef FPCOPTDEF
-override FPCOPT+=$(FPCOPTDEF)
-endif
-
-# Error file ?
-ifdef ERRORFILE
-override FPCOPT+=-Fr$(ERRORFILE)
-endif
-
-# Was a config file specified ?
-ifdef CFGFILE
-override FPCOPT+=@$(CFGFILE)
-endif
-
-# For win32 the options are passed using the environment variable FPCEXTCMD
-ifeq ($(OS_SOURCE),win32)
-override FPCEXTCMD:=$(FPCOPT)
-override FPCOPT:=!FPCEXTCMD
-export FPCEXTCMD
-endif
-
-# Compiler commandline
-override COMPILER:=$(FPC) $(FPCOPT)
-
-#####################################################################
-# Shell tools
-#####################################################################
-
-# To copy pograms
-ifndef COPY
-COPY:=cp -fp
-endif
-
-# Copy a whole tree
-ifndef COPYTREE
-COPYTREE:=cp -rfp
-endif
-
-# To move pograms
-ifndef MOVE
-MOVE:=mv -f
-endif
-
-# Check delete program
-ifndef DEL
-DEL:=rm -f
-endif
-
-# Check deltree program
-ifndef DELTREE
-DELTREE:=rm -rf
-endif
-
-# To install files
-ifndef INSTALL
-ifdef inlinux
-INSTALL:=install -m 644
-else
-INSTALL:=$(COPY)
-endif
-endif
-
-# To install programs
-ifndef INSTALLEXE
-ifdef inlinux
-INSTALLEXE:=install -m 755
-else
-INSTALLEXE:=$(COPY)
-endif
-endif
-
-# To make a directory.
-ifndef MKDIR
-ifdef inlinux
-MKDIR:=install -m 755 -d
-else
-MKDIR:=ginstall -m 755 -d
-endif
-endif
-
-export COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
-
-#####################################################################
-# Default Tools
-#####################################################################
-
-# assembler, redefine it if cross compiling
-ifndef AS
-AS=as
-endif
-
-# linker, but probably not used
-ifndef LD
-LD=ld
-endif
-
-# ppas.bat / ppas.sh
-ifdef inlinux
-PPAS=ppas.sh
-else
-ifdef inOS2
-PPAS=ppas.cmd
-else
-PPAS=ppas.bat
-endif
-endif
-
-# also call ppas if with command option -s
-ifeq (,$(findstring -s ,$(COMPILER)))
-EXECPPAS=
-else
-EXECPPAS:=@$(PPAS)
-endif
-
-# ldconfig to rebuild .so cache
-ifdef inlinux
-LDCONFIG=ldconfig
-else
-LDCONFIG=
-endif
-
-# echo
-ifndef ECHO
-ECHO:=$(strip $(wildcard $(addsuffix /echo$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO:=echo
-else
-ECHO:=$(firstword $(ECHO))
-endif
-endif
-export ECHO
-
-# ppdep
-ifndef PPDEP
-PPDEP:=$(strip $(wildcard $(addsuffix /ppdep$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPDEP),)
-PPDEP=
-else
-PPDEP:=$(firstword $(PPDEP))
-endif
-endif
-export PPDEP
-
-# ppumove
-ifndef PPUMOVE
-PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUMOVE),)
-PPUMOVE=
-else
-PPUMOVE:=$(firstword $(PPUMOVE))
-endif
-endif
-export PPUMOVE
-
-# ppufiles
-ifndef PPUFILES
-PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUFILES),)
-PPUFILES=
-else
-PPUFILES:=$(firstword $(PPUFILES))
-endif
-endif
-export PPUFILES
-
-# Look if UPX is found for go32v2 and win32. We can't use $UPX becuase
-# upx uses that one itself (PFV)
-ifndef UPXPROG
-ifeq ($(OS_TARGET),go32v2)
-UPXPROG:=1
-endif
-ifeq ($(OS_TARGET),win32)
-UPXPROG:=1
-endif
-ifdef UPXPROG
-UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(UPXPROG),)
-UPXPROG=
-else
-UPXPROG:=$(firstword $(UPXPROG))
-endif
-else
-UPXPROG=
-endif
-endif
-export UPXPROG
-
-# gdate/date
-ifndef DATE
-DATE:=$(strip $(wildcard $(addsuffix /date$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(DATE),)
-DATE:=$(strip $(wildcard $(addsuffix /gdate$(EXEEXT),$(SEACHPATH))))
-ifeq ($(DATE),)
-DATE=
-else
-DATE:=$(firstword $(DATE))
-endif
-else
-DATE:=$(firstword $(DATE))
-endif
-endif
-export DATE
-
-ifdef DATE
-DATESTR:=$(shell $(DATE) +%Y%m%d)
-else
-DATESTR=
-endif
-
-# ZipProg, you can't use Zip as the var name (PFV)
-ifndef ZIPPROG
-ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ZIPPROG),)
-ZIPPROG=
-else
-ZIPPROG:=$(firstword $(ZIPPROG)) -D9 -r
-endif
-endif
-export ZIPPROG
-
-ifndef ZIPEXT
-ZIPEXT=.zip
-endif
-
-#####################################################################
-# Default extensions
-#####################################################################
-
-# Default needed extensions (Go32v2,Linux)
-LOADEREXT=.as
-PPLEXT=.ppl
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.so
-PACKAGESUFFIX=
-FPCMADE=fpcmade
-
-# Go32v1
-ifeq ($(OS_TARGET),go32v1)
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-STATICLIBEXT=.a1
-SHAREDLIBEXT=.so1
-PACKAGESUFFIX=v1
-FPCMADE=fpcmade.v1
-endif
-
-# Go32v2
-ifeq ($(OS_TARGET),go32v2)
-PACKAGESUFFIX=go32
-FPCMADE=fpcmade.dos
-endif
-
-# Linux
-ifeq ($(OS_TARGET),linux)
-PACKAGESUFFIX=linux
-FPCMADE=fpcmade.lnx
-endif
-
-# Win32
-ifeq ($(OS_TARGET),win32)
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=win32
-FPCMADE=fpcmade.w32
-endif
-
-# OS/2
-ifeq ($(OS_TARGET),os2)
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-SMARTEXT=.so
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=os2
-FPCMADE=fpcmade.os2
-endif
-
-# library prefix
-LIBPREFIX=lib
-ifeq ($(OS_TARGET),go32v2)
-LIBPREFIX=
-endif
-ifeq ($(OS_TARGET),go32v1)
-LIBPREFIX=
-endif
-
-# determine which .pas extension is used
-ifndef PASEXT
-ifdef EXEOBJECTS
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
-else
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
-endif
-ifeq ($(TESTPAS),)
-PASEXT=.pp
-else
-PASEXT=.pas
-endif
-endif
-
-#####################################################################
-# Standard rules
-#####################################################################
-
-all: fpc_all
-
-debug: fpc_debug
-
-smart: fpc_smart
-
-shared: fpc_shared
-
-showinstall: fpc_showinstall
-
-install: fpc_install
-
-sourceinstall: fpc_sourceinstall
-
-zipinstall: fpc_zipinstall
-
-zipinstalladd: fpc_zipinstalladd
-
-clean: fpc_clean
-
-cleanall: fpc_cleanall
-
-info: fpc_info
-
-.PHONY:  all debug smart shared showinstall install sourceinstall zipinstall zipinstalladd clean cleanall info
-
-#####################################################################
-# Package depends
-#####################################################################
-
-ifneq ($(wildcard $(RTLDIR)),)
-ifeq ($(wildcard $(RTLDIR)/$(FPCMADE)),)
-override COMPILEPACKAGES+=rtl
-rtl_package:
-	$(MAKE) -C $(RTLDIR) all
-endif
-endif
-
-.PHONY:  rtl_package
-
-#####################################################################
-# Units
-#####################################################################
-
-.PHONY: fpc_units
-
-override ALLTARGET+=fpc_units
-
-override UNITPPUFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS))
-override INSTALLPPUFILES+=$(UNITPPUFILES)
-override CLEANPPUFILES+=$(UNITPPUFILES)
-
-fpc_units: $(UNITPPUFILES)
-
-#####################################################################
-# General compile rules
-#####################################################################
-
-.PHONY: fpc_all fpc_debug
-
-$(FPCMADE):
-	@$(ECHO) Compiled > $(FPCMADE)
-
-fpc_all: $(addsuffix _package,$(COMPILEPACKAGES)) \
-	 $(addsuffix _component,$(COMPILECOMPONENTS)) \
-	 $(ALLTARGET) $(FPCMADE)
-
-fpc_debug:
-	$(MAKE) all DEBUG=1
-
-# General compile rules, available for both possible PASEXT
-
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
-
-%$(PPUEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(PPUEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-#####################################################################
-# Library
-#####################################################################
-
-.PHONY: fpc_smart fpc_shared
-
-# Default sharedlib units are all unit objects
-ifndef SHAREDLIBUNITOBJECTS
-SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
-endif
-
-fpc_smart:
-	$(MAKE) all SMARTLINK=1
-
-fpc_shared: all
-ifdef inlinux
-ifndef LIBNAME
-	@$(ECHO) "LIBNAME not set"
-else
-	$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
-endif
-else
-	@$(ECHO) "Shared Libraries not supported"
-endif
-
-#####################################################################
-# Install rules
-#####################################################################
-
-.PHONY: fpc_showinstall fpc_install
-
-ifdef EXTRAINSTALLUNITS
-override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))
-endif
-
-ifdef INSTALLPPUFILES
-ifdef PPUFILES
-ifdef inlinux
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
-INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
-else
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
-endif
-else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
-endif
-endif
-
-fpc_showinstall: $(SHOWINSTALLTARGET)
-ifdef INSTALLEXEFILES
-	@$(ECHO) -e $(addprefix "\n"$(BININSTALLDIR)/,$(INSTALLEXEFILES))
-endif
-ifdef INSTALLPPUFILES
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPUFILES))
-ifneq ($(INSTALLPPULINKFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	@$(ECHO) -e $(addprefix "\n"$(EXTRAINSTALLDIR)/,$(EXTRAINSTALLFILES))
-endif
-
-fpc_install: $(INSTALLTARGET)
-# Create UnitInstallFiles
-ifdef INSTALLEXEFILES
-	$(MKDIR) $(BININSTALLDIR)
-# Compress the exes if upx is defined
-ifdef UPXPROG
-	-$(UPXPROG) $(INSTALLEXEFILES)
-endif
-	$(INSTALLEXE) $(INSTALLEXEFILES) $(BININSTALLDIR)
-endif
-ifdef INSTALLPPUFILES
-	$(MKDIR) $(UNITINSTALLDIR)
-	$(INSTALL) $(INSTALLPPUFILES) $(UNITINSTALLDIR)
-ifneq ($(INSTALLPPULINKFILES),)
-	$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	$(MKDIR) $(LIBINSTALLDIR)
-	$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	$(MKDIR) $(EXTRAINSTALLDIR)
-	$(INSTALL) $(EXTRAINSTALLFILES) $(EXTRAINSTALLDIR)
-endif
-
-#####################################################################
-# Source install rules
-#####################################################################
-
-.PHONY: fpc_sourceinstall
-
-fpc_sourceinstall: clean
-	$(MKDIR) $(SOURCEINSTALLDIR)
-	$(COPYTREE) $(BASEDIR) $(SOURCEINSTALLDIR)
-
-#####################################################################
-# Zip
-#####################################################################
-
-.PHONY: fpc_zipinstall fpc_zipinstalladd
-
-# Temporary path to pack a file
-ifndef PACKDIR
-ifndef inlinux
-PACKDIR=pack_tmp
-else
-PACKDIR=/tmp/fpc-pack
-endif
-endif
-
-# Test dir if none specified
-ifndef DESTZIPDIR
-DESTZIPDIR:=$(BASEDIR)
-endif
-
-# Add .zip/.tar.gz extension
-ifdef ZIPNAME
-ifndef inlinux
-override ZIPNAME:=$(ZIPNAME)$(ZIPEXT)
-endif
-endif
-
-# Note: This will not remove the zipfile first
-fpc_zipinstalladd:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	gzip -d $(DESTZIPDIR)/$(ZIPNAME).tar.gz
-	cd $(PACKDIR) ; tar rv --file $(DESTZIPDIR)/$(ZIPNAME).tar * ; cd $(BASEDIR)
-	gzip $(DESTZIPDIR)/$(ZIPNAME).tar
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-# First remove the zip and then install
-fpc_zipinstall:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	cd $(PACKDIR) ; tar cvz --file $(DESTZIPDIR)/$(ZIPNAME).tar.gz * ; cd $(BASEDIR)
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-#####################################################################
-# Clean rules
-#####################################################################
-
-.PHONY: fpc_clean fpc_cleanall
-
-ifdef EXTRACLEANUNITS
-override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS))
-endif
-
-ifdef CLEANPPUFILES
-ifdef PPUFILES
-CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
-else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
-endif
-endif
-
-fpc_clean: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-ifdef CLEANPPUFILES
-	-$(DEL) $(CLEANPPUFILES)
-endif
-ifneq ($(CLEANPPULINKFILES),)
-	-$(DEL) $(CLEANPPULINKFILES)
-endif
-ifdef EXTRACLEANFILES
-	-$(DEL) $(EXTRACLEANFILES)
-endif
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-fpc_cleanall: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-	-$(DELTREE) *$(SMARTEXT)
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-#####################################################################
-# Info rules
-#####################################################################
-
-.PHONY: fpc_info fpc_cfginfo fpc_objectinfo fpc_toolsinfo fpc_installinfo \
-	fpc_dirinfo
-
-fpc_info: $(INFOTARGET)
-
-fpc_infocfg:
-	@$(ECHO)
-	@$(ECHO)  == Configuration info ==
-	@$(ECHO)
-	@$(ECHO)  FPC....... $(FPC)
-	@$(ECHO)  Version... $(FPC_VERSION)
-	@$(ECHO)  CPU....... $(CPU_TARGET)
-	@$(ECHO)  Source.... $(OS_SOURCE)
-	@$(ECHO)  Target.... $(OS_TARGET)
-	@$(ECHO)
-
-fpc_infoobjects:
-	@$(ECHO)
-	@$(ECHO)  == Object info ==
-	@$(ECHO)
-	@$(ECHO)  LoaderObjects..... $(LOADEROBJECTS)
-	@$(ECHO)  UnitObjects....... $(UNITOBJECTS)
-	@$(ECHO)  ExeObjects........ $(EXEOBJECTS)
-	@$(ECHO)
-	@$(ECHO)  ExtraCleanUnits... $(EXTRACLEANUNITS)
-	@$(ECHO)  ExtraCleanFiles... $(EXTRACLEANFILES)
-	@$(ECHO)
-	@$(ECHO)  ExtraInstallUnits. $(EXTRAINSTALLUNITS)
-	@$(ECHO)  ExtraInstallFiles. $(EXTRAINSTALLFILES)
-	@$(ECHO)
-
-fpc_infoinstall:
-	@$(ECHO)
-	@$(ECHO)  == Install info ==
-	@$(ECHO)
-ifdef DATE
-	@$(ECHO)  DateStr.............. $(DATESTR)
-endif
-	@$(ECHO)  PackageSuffix........ $(PACKAGESUFFIX)
-	@$(ECHO)
-	@$(ECHO)  BaseInstallDir....... $(BASEINSTALLDIR)
-	@$(ECHO)  BinInstallDir........ $(BININSTALLDIR)
-	@$(ECHO)  LibInstallDir........ $(LIBINSTALLDIR)
-	@$(ECHO)  UnitInstallDir....... $(UNITINSTALLDIR)
-	@$(ECHO)  SourceInstallDir..... $(SOURCEINSTALLDIR)
-	@$(ECHO)  DocInstallDir........ $(DOCINSTALLDIR)
-	@$(ECHO)  ExtraInstallDir...... $(EXTRAINSTALLDIR)
-	@$(ECHO)
-
-#####################################################################
-# Users rules
-#####################################################################
-
-INCFILES=$(addprefix $(INC)/,$(INCNAMES))
-
-classes$(PPUEXT): $(INCFILES) classes$(PASEXT)
-
-inifiles$(PPUEXT): classes$(PPUEXT) inifiles$(PASEXT)
-
-ezcgi$(PPUEXT): ezcgi$(PASEXT) ezcgi.inc

fcl/os2/Makefile.fpc

@@ -1,38 +0,0 @@
-#
-#   Makefile.fpc for Free Component Library for OS/2
-#
-
-[defaults]
-defaulttarget=os2
-defaultoptions=-S2
-
-[dirs]
-fpcdir=../..
-targetdir=.
-incdir=$(INC)
-sourcesdir=$(INC) $(XML)
-
-[targets]
-units=classes $(INCUNITS) $(XMLUNITS)
-
-
-[presettings]
-# Include files
-INC=../inc
-XML=../xml
-
-# INCUNITS,XMLUNITS is defined in makefile.inc
-# They are default units for all platforms.
-include $(INC)/Makefile.inc
-include $(XML)/Makefile.inc
-
-
-[rules]
-INCFILES=$(addprefix $(INC)/,$(INCNAMES))
-
-classes$(PPUEXT): $(INCFILES) classes$(PASEXT)
-
-inifiles$(PPUEXT): classes$(PPUEXT) inifiles$(PASEXT)
-
-ezcgi$(PPUEXT): ezcgi$(PASEXT) ezcgi.inc
-

fcl/os2/classes.pp

@@ -1,43 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
-
-    Classes unit for win32
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{$mode objfpc}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  strings,
-  sysutils;
-
-{$i classesh.inc}
-
-implementation
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-end.
-{
-  $Log$
-  Revision 1.5  1999-05-30 10:46:42  peter
-    * start of tthread for linux,win32
-
-}

fcl/os2/ezcgi.inc

@@ -1,9 +0,0 @@
-Uses Dos;
-
-{ Declared EXPLICITLY with Ansistring, so NO mistaking is possible }
-
-Function Getenv (Var EnvVar  : AnsiString): AnsiString;
-
-begin
-  Result:=Dos.Getenv(EnvVar); 
-end;

fcl/os2/thread.inc

@@ -1,101 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TThread                                      *}
-{****************************************************************************}
-
-
-procedure TThread.CallOnTerminate;
-
-begin
-end;
-
-
-function TThread.GetPriority: TThreadPriority;
-
-begin
-  GetPriority:=tpNormal;
-end;
-
-
-procedure TThread.SetPriority(Value: TThreadPriority);
-
-begin
-end;
-
-
-procedure TThread.SetSuspended(Value: Boolean);
-
-begin
-end;
-
-
-procedure TThread.DoTerminate;
-
-begin
-end;
-
-
-procedure TThread.Synchronize(Method: TThreadMethod);
-
-begin
-end;
-
-
-constructor TThread.Create(CreateSuspended: Boolean);
-
-begin
-end;
-
-
-destructor TThread.Destroy;
-
-begin
-end;
-
-
-procedure TThread.Resume;
-
-begin
-end;
-
-
-procedure TThread.Suspend;
-
-begin
-end;
-
-
-procedure TThread.Terminate;
-
-begin
-end;
-
-
-function TThread.WaitFor: Integer;
-
-begin
-  WaitFor:=0;
-end;
-
-
-{
-  $Log$
-  Revision 1.1  1999-05-30 10:46:43  peter
-    * start of tthread for linux,win32
-
-  Revision 1.2  1999/04/08 10:18:57  peter
-    * makefile updates
-
-}

fcl/shedit/Makefile

@@ -1,1054 +0,0 @@
-#
-# Makefile generated by fpcmake v0.99.13 on 1999-12-24 16:08
-#
-
-defaultrule: all
-
-#####################################################################
-# Autodetect OS (Linux or Dos or Windows NT)
-# define inlinux when running under linux
-# define inWinNT when running under WinNT
-#####################################################################
-
-# We need only / in the path
-override PATH:=$(subst \,/,$(PATH))
-
-# Search for PWD and determine also if we are under linux
-PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
-ifeq ($(PWD),)
-PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
-ifeq ($(PWD),)
-nopwd:
-	@echo You need the GNU utils package to use this Makefile!
-	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
-	@exit
-else
-inlinux=1
-endif
-else
-PWD:=$(firstword $(PWD))
-endif
-
-# Detect NT - NT sets OS to Windows_NT
-ifndef inlinux
-ifeq ($(OS),Windows_NT)
-inWinNT=1
-endif
-endif
-
-# Detect OS/2 - OS/2 has OS2_SHELL defined
-ifndef inlinux
-ifndef inWinNT
-ifdef OS2_SHELL
-inOS2=1
-endif
-endif
-endif
-
-# The extension of executables
-ifdef inlinux
-EXEEXT=
-else
-EXEEXT=.exe
-endif
-
-# The path which is search separated by spaces
-ifdef inlinux
-SEARCHPATH=$(subst :, ,$(PATH))
-else
-SEARCHPATH=$(subst ;, ,$(PATH))
-endif
-
-#####################################################################
-# FPC version/target Detection
-#####################################################################
-
-# What compiler to use ?
-ifndef FPC
-# Compatibility with old makefiles
-ifdef PP
-FPC=$(PP)
-else
-ifdef inOS2
-FPC=ppos2$(EXEEXT)
-else
-FPC=ppc386$(EXEEXT)
-endif
-endif
-endif
-
-# Target OS
-ifndef OS_TARGET
-OS_TARGET:=$(shell $(FPC) -iTO)
-endif
-
-# Source OS
-ifndef OS_SOURCE
-OS_SOURCE:=$(shell $(FPC) -iSO)
-endif
-
-# Target CPU
-ifndef CPU_TARGET
-CPU_TARGET:=$(shell $(FPC) -iTP)
-endif
-
-# Source CPU
-ifndef CPU_SOURCE
-CPU_SOURCE:=$(shell $(FPC) -iSP)
-endif
-
-# FPC version
-ifndef FPC_VERSION
-FPC_VERSION:=$(shell $(FPC) -iV)
-endif
-
-export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
-
-#####################################################################
-# Default Settings
-#####################################################################
-
-# Release ? Then force OPT and don't use extra opts via commandline
-ifndef REDIRFILE
-REDIRFILE=log
-endif
-
-ifdef RELEASE
-override OPT:=-Xs -OG2p3 -n
-endif
-
-# Verbose settings (warning,note,info)
-ifdef VERBOSE
-override OPT+=-vwni
-endif
-
-ifdef REDIR
-ifndef inlinux
-override FPC=redir -eo $(FPC)
-endif
-# set the verbosity to max
-override OPT+=-va
-override REDIR:= >> $(REDIRFILE)
-endif
-
-#####################################################################
-# User Settings
-#####################################################################
-
-
-# Targets
-
-override UNITOBJECTS+=doc_text shedit sh_pas sh_xml
-ifeq ($(OS_TARGET),linux)
-override UNITOBJECTS+=gtkshedit
-endif
-ifeq ($(OS_TARGET),linux)
-override EXEOBJECTS+=gtkdemo
-endif
-ifeq ($(OS_TARGET),win32)
-override EXEOBJECTS+=gtkdemo
-endif
-
-# Clean
-
-
-# Install
-
-ZIPTARGET=install
-
-# Defaults
-
-
-# Directories
-
-ifndef FPCDIR
-FPCDIR=../..
-endif
-ifndef PACKAGEDIR
-PACKAGEDIR=$(FPCDIR)/packages
-endif
-ifndef COMPONENTDIR
-COMPONENTDIR=$(FPCDIR)/components
-endif
-ifndef TARGETDIR
-TARGETDIR=.
-endif
-
-# Packages
-
-ifeq ($(OS_TARGET),linux)
-override PACKAGES+=gtk
-endif
-ifeq ($(OS_TARGET),win32)
-override PACKAGES+=gtk
-endif
-override NEEDUNITDIR+=$(FPCDIR)/fcl/$(OS_TARGET)
-ifneq ($(wildcard $(PACKAGEDIR)/gtk/$(OS_TARGET)),)
-override NEEDUNITDIR+=$(PACKAGEDIR)/gtk/$(OS_TARGET)
-else
-override NEEDUNITDIR+=$(PACKAGEDIR)/gtk
-endif
-ifneq ($(wildcard $(PACKAGEDIR)/gtk/$(OS_TARGET)),)
-override NEEDUNITDIR+=$(PACKAGEDIR)/gtk/$(OS_TARGET)
-else
-override NEEDUNITDIR+=$(PACKAGEDIR)/gtk
-endif
-
-# Libraries
-
-
-# Info
-
-INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall 
-
-#####################################################################
-# Default Directories
-#####################################################################
-
-# Base dir
-ifdef PWD
-BASEDIR:=$(shell $(PWD))
-else
-BASEDIR=.
-endif
-
-# this can be set to 'rtl' when the RTL units are installed
-ifndef UNITPREFIX
-UNITPREFIX=units
-endif
-
-# set the prefix directory where to install everything
-ifndef PREFIXINSTALLDIR
-ifdef inlinux
-PREFIXINSTALLDIR=/usr
-else
-PREFIXINSTALLDIR=/pp
-endif
-endif
-export PREFIXINSTALLDIR
-
-# create fcldir,rtldir,unitdir
-ifdef FPCDIR
-override FPCDIR:=$(subst \,/,$(FPCDIR))
-ifneq ($(FPCDIR),.)
-override RTLDIR=$(FPCDIR)/rtl/$(OS_TARGET)
-override FCLDIR=$(FPCDIR)/fcl/$(OS_TARGET)
-override UNITSDIR=$(FPCDIR)/units/$(OS_TARGET)
-endif
-endif
-
-#####################################################################
-# Install Directories
-#####################################################################
-
-# set the base directory where to install everything
-ifndef BASEINSTALLDIR
-ifdef inlinux
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION)
-else
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)
-endif
-endif
-
-# set the directory where to install the binaries
-ifndef BININSTALLDIR
-ifdef inlinux
-BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
-else
-BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
-endif
-endif
-
-# set the directory where to install the units.
-ifndef UNITINSTALLDIR
-UNITINSTALLDIR=$(BASEINSTALLDIR)/$(UNITPREFIX)/$(OS_TARGET)
-endif
-
-# Where to install shared libraries
-ifndef LIBINSTALLDIR
-ifdef inlinux
-LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
-else
-LIBINSTALLDIR=$(UNITINSTALLDIR)
-endif
-endif
-
-# Where the source files will be stored
-ifndef SOURCEINSTALLDIR
-ifdef inlinux
-SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION)
-else
-SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source
-endif
-endif
-
-# Where the doc files will be stored
-ifndef DOCINSTALLDIR
-ifdef inlinux
-DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc/$(FPC_VERSION)
-else
-DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
-endif
-endif
-
-# Where the some extra (data)files will be stored
-ifndef EXTRAINSTALLDIR
-EXTRAINSTALLDIR=$(BASEINSTALLDIR)
-endif
-
-
-#####################################################################
-# Compiler Command Line
-#####################################################################
-
-# Load commandline OPTDEF and add FPC_CPU define
-override FPCOPTDEF:=-d$(CPU_TARGET)
-
-# Load commandline OPT and add target and unit dir to be sure
-ifneq ($(OS_TARGET),$(OS_SOURCE))
-override FPCOPT+=-T$(OS_TARGET)
-endif
-
-ifdef RTLDIR
-override FPCOPT+=-Fu$(RTLDIR)
-endif
-
-ifdef UNITSDIR
-override FPCOPT+=-Fu$(UNITSDIR)
-endif
-
-ifdef NEEDUNITDIR
-override FPCOPT+=$(addprefix -Fu,$(NEEDUNITDIR))
-endif
-
-# Target dirs
-ifdef TARGETDIR
-override FPCOPT+=-FE$(TARGETDIR)
-endif
-
-# Smartlinking
-ifdef SMARTLINK
-override FPCOPT+=-CX
-endif
-
-# Debug
-ifdef DEBUG
-override FPCOPT+=-g
-endif
-
-# Add commandline options
-ifdef OPT
-override FPCOPT+=$(OPT)
-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
-
-# Add defines from FPCOPTDEF to FPCOPT
-ifdef FPCOPTDEF
-override FPCOPT+=$(FPCOPTDEF)
-endif
-
-# Error file ?
-ifdef ERRORFILE
-override FPCOPT+=-Fr$(ERRORFILE)
-endif
-
-# Was a config file specified ?
-ifdef CFGFILE
-override FPCOPT+=@$(CFGFILE)
-endif
-
-# For win32 the options are passed using the environment variable FPCEXTCMD
-ifeq ($(OS_SOURCE),win32)
-override FPCEXTCMD:=$(FPCOPT)
-override FPCOPT:=!FPCEXTCMD
-export FPCEXTCMD
-endif
-
-# Compiler commandline
-override COMPILER:=$(FPC) $(FPCOPT)
-
-#####################################################################
-# Shell tools
-#####################################################################
-
-# To copy pograms
-ifndef COPY
-COPY:=cp -fp
-endif
-
-# Copy a whole tree
-ifndef COPYTREE
-COPYTREE:=cp -rfp
-endif
-
-# To move pograms
-ifndef MOVE
-MOVE:=mv -f
-endif
-
-# Check delete program
-ifndef DEL
-DEL:=rm -f
-endif
-
-# Check deltree program
-ifndef DELTREE
-DELTREE:=rm -rf
-endif
-
-# To install files
-ifndef INSTALL
-ifdef inlinux
-INSTALL:=install -m 644
-else
-INSTALL:=$(COPY)
-endif
-endif
-
-# To install programs
-ifndef INSTALLEXE
-ifdef inlinux
-INSTALLEXE:=install -m 755
-else
-INSTALLEXE:=$(COPY)
-endif
-endif
-
-# To make a directory.
-ifndef MKDIR
-ifdef inlinux
-MKDIR:=install -m 755 -d
-else
-MKDIR:=ginstall -m 755 -d
-endif
-endif
-
-export COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
-
-#####################################################################
-# Default Tools
-#####################################################################
-
-# assembler, redefine it if cross compiling
-ifndef AS
-AS=as
-endif
-
-# linker, but probably not used
-ifndef LD
-LD=ld
-endif
-
-# ppas.bat / ppas.sh
-ifdef inlinux
-PPAS=ppas.sh
-else
-ifdef inOS2
-PPAS=ppas.cmd
-else
-PPAS=ppas.bat
-endif
-endif
-
-# also call ppas if with command option -s
-ifeq (,$(findstring -s ,$(COMPILER)))
-EXECPPAS=
-else
-EXECPPAS:=@$(PPAS)
-endif
-
-# ldconfig to rebuild .so cache
-ifdef inlinux
-LDCONFIG=ldconfig
-else
-LDCONFIG=
-endif
-
-# echo
-ifndef ECHO
-ECHO:=$(strip $(wildcard $(addsuffix /echo$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO:=echo
-else
-ECHO:=$(firstword $(ECHO))
-endif
-endif
-export ECHO
-
-# ppdep
-ifndef PPDEP
-PPDEP:=$(strip $(wildcard $(addsuffix /ppdep$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPDEP),)
-PPDEP=
-else
-PPDEP:=$(firstword $(PPDEP))
-endif
-endif
-export PPDEP
-
-# ppumove
-ifndef PPUMOVE
-PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUMOVE),)
-PPUMOVE=
-else
-PPUMOVE:=$(firstword $(PPUMOVE))
-endif
-endif
-export PPUMOVE
-
-# ppufiles
-ifndef PPUFILES
-PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUFILES),)
-PPUFILES=
-else
-PPUFILES:=$(firstword $(PPUFILES))
-endif
-endif
-export PPUFILES
-
-# Look if UPX is found for go32v2 and win32. We can't use $UPX becuase
-# upx uses that one itself (PFV)
-ifndef UPXPROG
-ifeq ($(OS_TARGET),go32v2)
-UPXPROG:=1
-endif
-ifeq ($(OS_TARGET),win32)
-UPXPROG:=1
-endif
-ifdef UPXPROG
-UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(UPXPROG),)
-UPXPROG=
-else
-UPXPROG:=$(firstword $(UPXPROG))
-endif
-else
-UPXPROG=
-endif
-endif
-export UPXPROG
-
-# gdate/date
-ifndef DATE
-DATE:=$(strip $(wildcard $(addsuffix /date$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(DATE),)
-DATE:=$(strip $(wildcard $(addsuffix /gdate$(EXEEXT),$(SEACHPATH))))
-ifeq ($(DATE),)
-DATE=
-else
-DATE:=$(firstword $(DATE))
-endif
-else
-DATE:=$(firstword $(DATE))
-endif
-endif
-export DATE
-
-ifdef DATE
-DATESTR:=$(shell $(DATE) +%Y%m%d)
-else
-DATESTR=
-endif
-
-# ZipProg, you can't use Zip as the var name (PFV)
-ifndef ZIPPROG
-ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ZIPPROG),)
-ZIPPROG=
-else
-ZIPPROG:=$(firstword $(ZIPPROG)) -D9 -r
-endif
-endif
-export ZIPPROG
-
-ifndef ZIPEXT
-ZIPEXT=.zip
-endif
-
-#####################################################################
-# Default extensions
-#####################################################################
-
-# Default needed extensions (Go32v2,Linux)
-LOADEREXT=.as
-PPLEXT=.ppl
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.so
-PACKAGESUFFIX=
-FPCMADE=fpcmade
-
-# Go32v1
-ifeq ($(OS_TARGET),go32v1)
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-STATICLIBEXT=.a1
-SHAREDLIBEXT=.so1
-PACKAGESUFFIX=v1
-FPCMADE=fpcmade.v1
-endif
-
-# Go32v2
-ifeq ($(OS_TARGET),go32v2)
-PACKAGESUFFIX=go32
-FPCMADE=fpcmade.dos
-endif
-
-# Linux
-ifeq ($(OS_TARGET),linux)
-PACKAGESUFFIX=linux
-FPCMADE=fpcmade.lnx
-endif
-
-# Win32
-ifeq ($(OS_TARGET),win32)
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=win32
-FPCMADE=fpcmade.w32
-endif
-
-# OS/2
-ifeq ($(OS_TARGET),os2)
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-SMARTEXT=.so
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=os2
-FPCMADE=fpcmade.os2
-endif
-
-# library prefix
-LIBPREFIX=lib
-ifeq ($(OS_TARGET),go32v2)
-LIBPREFIX=
-endif
-ifeq ($(OS_TARGET),go32v1)
-LIBPREFIX=
-endif
-
-# determine which .pas extension is used
-ifndef PASEXT
-ifdef EXEOBJECTS
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
-else
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
-endif
-ifeq ($(TESTPAS),)
-PASEXT=.pp
-else
-PASEXT=.pas
-endif
-endif
-
-#####################################################################
-# Standard rules
-#####################################################################
-
-all: fpc_all
-
-debug: fpc_debug
-
-smart: fpc_smart
-
-shared: fpc_shared
-
-showinstall: fpc_showinstall
-
-install: fpc_install
-
-sourceinstall: fpc_sourceinstall
-
-zipinstall: fpc_zipinstall
-
-zipinstalladd: fpc_zipinstalladd
-
-clean: fpc_clean
-
-cleanall: fpc_cleanall
-
-info: fpc_info
-
-.PHONY:  all debug smart shared showinstall install sourceinstall zipinstall zipinstalladd clean cleanall info
-
-#####################################################################
-# Package depends
-#####################################################################
-
-ifneq ($(wildcard $(RTLDIR)),)
-ifeq ($(wildcard $(RTLDIR)/$(FPCMADE)),)
-override COMPILEPACKAGES+=rtl
-rtl_package:
-	$(MAKE) -C $(RTLDIR) all
-endif
-endif
-ifneq ($(wildcard $(FCLDIR)),)
-ifeq ($(wildcard $(FCLDIR)/$(FPCMADE)),)
-override COMPILEPACKAGES+=fcl
-fcl_package:
-	$(MAKE) -C $(FCLDIR) all
-endif
-endif
-
-ifeq ($(OS_TARGET),linux)
-PACKAGEGTK=1
-endif
-ifeq ($(OS_TARGET),win32)
-PACKAGEGTK=1
-endif
-ifdef PACKAGEGTK
-ifneq ($(wildcard $(PACKAGEDIR)/gtk),)
-ifeq ($(wildcard $(PACKAGEDIR)/gtk/$(FPCMADE)),)
-override COMPILEPACKAGES+=gtk
-gtk_package:
-	$(MAKE) -C $(PACKAGEDIR)/gtk all
-endif
-endif
-endif
-
-.PHONY:  rtl_package fcl_package gtk_package
-
-#####################################################################
-# Units
-#####################################################################
-
-.PHONY: fpc_units
-
-override ALLTARGET+=fpc_units
-
-override UNITPPUFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS))
-override INSTALLPPUFILES+=$(UNITPPUFILES)
-override CLEANPPUFILES+=$(UNITPPUFILES)
-
-fpc_units: $(UNITPPUFILES)
-
-#####################################################################
-# Exes
-#####################################################################
-
-.PHONY: fpc_exes
-
-override EXEFILES=$(addsuffix $(EXEEXT),$(EXEOBJECTS))
-override EXEOFILES=$(addsuffix $(OEXT),$(EXEOBJECTS))
-
-override ALLTARGET+=fpc_exes
-override INSTALLEXEFILES+=$(EXEFILES)
-override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
-
-fpc_exes: $(EXEFILES)
-
-#####################################################################
-# General compile rules
-#####################################################################
-
-.PHONY: fpc_all fpc_debug
-
-$(FPCMADE):
-	@$(ECHO) Compiled > $(FPCMADE)
-
-fpc_all: $(addsuffix _package,$(COMPILEPACKAGES)) \
-	 $(addsuffix _component,$(COMPILECOMPONENTS)) \
-	 $(ALLTARGET) $(FPCMADE)
-
-fpc_debug:
-	$(MAKE) all DEBUG=1
-
-# General compile rules, available for both possible PASEXT
-
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
-
-%$(PPUEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(PPUEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-#####################################################################
-# Library
-#####################################################################
-
-.PHONY: fpc_smart fpc_shared
-
-# Default sharedlib units are all unit objects
-ifndef SHAREDLIBUNITOBJECTS
-SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
-endif
-
-fpc_smart:
-	$(MAKE) all SMARTLINK=1
-
-fpc_shared: all
-ifdef inlinux
-ifndef LIBNAME
-	@$(ECHO) "LIBNAME not set"
-else
-	$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
-endif
-else
-	@$(ECHO) "Shared Libraries not supported"
-endif
-
-#####################################################################
-# Install rules
-#####################################################################
-
-.PHONY: fpc_showinstall fpc_install
-
-ifdef EXTRAINSTALLUNITS
-override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))
-endif
-
-ifdef INSTALLPPUFILES
-ifdef PPUFILES
-ifdef inlinux
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
-INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
-else
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
-endif
-else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
-endif
-endif
-
-fpc_showinstall: $(SHOWINSTALLTARGET)
-ifdef INSTALLEXEFILES
-	@$(ECHO) -e $(addprefix "\n"$(BININSTALLDIR)/,$(INSTALLEXEFILES))
-endif
-ifdef INSTALLPPUFILES
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPUFILES))
-ifneq ($(INSTALLPPULINKFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	@$(ECHO) -e $(addprefix "\n"$(EXTRAINSTALLDIR)/,$(EXTRAINSTALLFILES))
-endif
-
-fpc_install: $(INSTALLTARGET)
-# Create UnitInstallFiles
-ifdef INSTALLEXEFILES
-	$(MKDIR) $(BININSTALLDIR)
-# Compress the exes if upx is defined
-ifdef UPXPROG
-	-$(UPXPROG) $(INSTALLEXEFILES)
-endif
-	$(INSTALLEXE) $(INSTALLEXEFILES) $(BININSTALLDIR)
-endif
-ifdef INSTALLPPUFILES
-	$(MKDIR) $(UNITINSTALLDIR)
-	$(INSTALL) $(INSTALLPPUFILES) $(UNITINSTALLDIR)
-ifneq ($(INSTALLPPULINKFILES),)
-	$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	$(MKDIR) $(LIBINSTALLDIR)
-	$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	$(MKDIR) $(EXTRAINSTALLDIR)
-	$(INSTALL) $(EXTRAINSTALLFILES) $(EXTRAINSTALLDIR)
-endif
-
-#####################################################################
-# Source install rules
-#####################################################################
-
-.PHONY: fpc_sourceinstall
-
-fpc_sourceinstall: clean
-	$(MKDIR) $(SOURCEINSTALLDIR)
-	$(COPYTREE) $(BASEDIR) $(SOURCEINSTALLDIR)
-
-#####################################################################
-# Zip
-#####################################################################
-
-.PHONY: fpc_zipinstall fpc_zipinstalladd
-
-# Temporary path to pack a file
-ifndef PACKDIR
-ifndef inlinux
-PACKDIR=pack_tmp
-else
-PACKDIR=/tmp/fpc-pack
-endif
-endif
-
-# Test dir if none specified
-ifndef DESTZIPDIR
-DESTZIPDIR:=$(BASEDIR)
-endif
-
-# Add .zip/.tar.gz extension
-ifdef ZIPNAME
-ifndef inlinux
-override ZIPNAME:=$(ZIPNAME)$(ZIPEXT)
-endif
-endif
-
-# Note: This will not remove the zipfile first
-fpc_zipinstalladd:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	gzip -d $(DESTZIPDIR)/$(ZIPNAME).tar.gz
-	cd $(PACKDIR) ; tar rv --file $(DESTZIPDIR)/$(ZIPNAME).tar * ; cd $(BASEDIR)
-	gzip $(DESTZIPDIR)/$(ZIPNAME).tar
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-# First remove the zip and then install
-fpc_zipinstall:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	cd $(PACKDIR) ; tar cvz --file $(DESTZIPDIR)/$(ZIPNAME).tar.gz * ; cd $(BASEDIR)
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-#####################################################################
-# Clean rules
-#####################################################################
-
-.PHONY: fpc_clean fpc_cleanall
-
-ifdef EXTRACLEANUNITS
-override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS))
-endif
-
-ifdef CLEANPPUFILES
-ifdef PPUFILES
-CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
-else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
-endif
-endif
-
-fpc_clean: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-ifdef CLEANPPUFILES
-	-$(DEL) $(CLEANPPUFILES)
-endif
-ifneq ($(CLEANPPULINKFILES),)
-	-$(DEL) $(CLEANPPULINKFILES)
-endif
-ifdef EXTRACLEANFILES
-	-$(DEL) $(EXTRACLEANFILES)
-endif
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-fpc_cleanall: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-	-$(DELTREE) *$(SMARTEXT)
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-#####################################################################
-# Info rules
-#####################################################################
-
-.PHONY: fpc_info fpc_cfginfo fpc_objectinfo fpc_toolsinfo fpc_installinfo \
-	fpc_dirinfo
-
-fpc_info: $(INFOTARGET)
-
-fpc_infocfg:
-	@$(ECHO)
-	@$(ECHO)  == Configuration info ==
-	@$(ECHO)
-	@$(ECHO)  FPC....... $(FPC)
-	@$(ECHO)  Version... $(FPC_VERSION)
-	@$(ECHO)  CPU....... $(CPU_TARGET)
-	@$(ECHO)  Source.... $(OS_SOURCE)
-	@$(ECHO)  Target.... $(OS_TARGET)
-	@$(ECHO)
-
-fpc_infoobjects:
-	@$(ECHO)
-	@$(ECHO)  == Object info ==
-	@$(ECHO)
-	@$(ECHO)  LoaderObjects..... $(LOADEROBJECTS)
-	@$(ECHO)  UnitObjects....... $(UNITOBJECTS)
-	@$(ECHO)  ExeObjects........ $(EXEOBJECTS)
-	@$(ECHO)
-	@$(ECHO)  ExtraCleanUnits... $(EXTRACLEANUNITS)
-	@$(ECHO)  ExtraCleanFiles... $(EXTRACLEANFILES)
-	@$(ECHO)
-	@$(ECHO)  ExtraInstallUnits. $(EXTRAINSTALLUNITS)
-	@$(ECHO)  ExtraInstallFiles. $(EXTRAINSTALLFILES)
-	@$(ECHO)
-
-fpc_infoinstall:
-	@$(ECHO)
-	@$(ECHO)  == Install info ==
-	@$(ECHO)
-ifdef DATE
-	@$(ECHO)  DateStr.............. $(DATESTR)
-endif
-	@$(ECHO)  PackageSuffix........ $(PACKAGESUFFIX)
-	@$(ECHO)
-	@$(ECHO)  BaseInstallDir....... $(BASEINSTALLDIR)
-	@$(ECHO)  BinInstallDir........ $(BININSTALLDIR)
-	@$(ECHO)  LibInstallDir........ $(LIBINSTALLDIR)
-	@$(ECHO)  UnitInstallDir....... $(UNITINSTALLDIR)
-	@$(ECHO)  SourceInstallDir..... $(SOURCEINSTALLDIR)
-	@$(ECHO)  DocInstallDir........ $(DOCINSTALLDIR)
-	@$(ECHO)  ExtraInstallDir...... $(EXTRAINSTALLDIR)
-	@$(ECHO)
-

fcl/shedit/Makefile.fpc

@@ -1,19 +0,0 @@
-#
-#   Makefile.fpc for shedit
-#
-
-[targets]
-units=doc_text shedit sh_pas sh_xml
-units_linux=gtkshedit
-programs_win32=gtkdemo
-programs_linux=gtkdemo
-
-[packages]
-fcl=1
-packages_win32=gtk
-packages_linux=gtk
-
-[dirs]
-fpcdir=../..
-targetdir=.
-

fcl/shedit/README

@@ -1,130 +0,0 @@
-# $Id$
-
-! Note: This version is not completed yet !
-
-
-This is SHEdit for Free Pascal, an object-oriented text editor engine with
-support for:
-- syntax highlighting
-- clipboard (cut, copy & paste)
-- undo/redo buffers
-- fully customizable behaviour
-- multiple views (editors) for a single document at a time
-- completely independent of any toolkit; it even can be used both in text and
-  in graphics modes
-
-
-Architecture
-------------
-
-There are three basic classes in SHEdit:
-- Document
-- Editor
-- Renderer
-
-The document class (TTextDoc) in doc_text.pp is quite simple, it just
-stores a text (ASCII) document as a collection of strings.
-What you have to know about TTextDoc is that it stores a 32-bit value for
-each line, which it doesn't modify on its own. The lower 8 bits of these
-LineFlags are reserved for syntax highlighting (SH): The first bit determines
-if the other SH flags are valid; and the remaining 7 bits can be used to
-indicate SH states which do not end at the end of the line.
-
-
-The editor itself is encapsulated in the class TSHTextEdit (in unit shedit.pp).
-It can only work in conjunction with a renderer, which is responsible for
-displaying the document. When you create a TSHTextEdit, the constructor expects
-two arguments: The document to use, and the renderer to use.
-
-The renderer itself is declared as an abstract interface class (i.e. all
-methods are 'virtual abstract'), this interface is called ISHRenderer.
-When you want to use SHEdit in your own programs, you will have to provide
-an implementation of the methods declared in ISHRenderer. There is a reference
-implementation for GTK, gtkdemo.
-
-
-Renderer interface
-------------------
-
-This interface is quite simple; just note that SHEdit expects all corrdinates
-relative to the upper left corner of the document (0/0), and it uses the
-cell size (width and height) of the characters as base unit. For example,
-the coordinate X=3/Y=2 references the fourth character in the third line.
-
-
-procedure InvalidateLines(y1, y2: Integer);
-  The renderer should initiate the redrawing of the lines between y1 and y2.
-  It is recommended to use the Invalidate commands of the underlying graphics
-  or windowing toolkit; but an implementation may choose to simply call
-  TSHTextEdit.DrawContent.
-
-procedure ClearRect(x1, y1, x2, y2: Integer);
-  The renderer must clear the given rectangle in the background (whitespace)
-  color.
-
-procedure DrawTextLine(x1, x2, y: Integer; s: PChar);
-  This is the most complex method: The renderer has to draw a complete line of
-  text, which is given in "s". The vertical position is line "y", x1 and x2
-  specify a horizontal clipping span.
-  "s" has a very special format, as it contains highlighting tags:
-  You can process "s" character by character, as usual. BUT when you encounter
-  a special escape character (LF_Escape, defined in doc_text.pp) the renderer
-  has to switch to the font style/color given in the following character. This
-  character is just a index in the range ASCII #1..#255, the renderer must know
-  himself what to do with this index. These highlighting tags are generated by
-  a special highlighting function, see below.
-
-procedure ShowCursor(x, y: Integer);
-procedure HideCursor(x, y: Integer);
-  The cursor should be drawn or be hidden, its position is given in "x" and
-  "y". SHEdit does its own reference counting, i.e. it won't call HideCursor
-  for an already invisible cursor, and it won't call ShowCursor for a visible
-  cursor. If the cursor position changes, SHEdit will call HideCursor with
-  the old position and then ShowCursor with the new position as arguments.
-
-function GetVertPos: Integer;
-  This function shall return the vertical scrolling position of the window
-  which is managed by the renderer.
-
-procedure SetVertPos(y: Integer);
-  Sets the vertical scrolling position.
-
-function GetPageHeight: Integer;
-  Gets the height of the visible part of the document.
-
-procedure SetLineCount(count: Integer);
-  SHEdit calls this method if the number of lines in the document has changed.
-
-function GetClipboard: String;
-  GetClipboard is called by SHEdit if the user wants to paste the contents of
-  the clipboard into the document. GetClipboard must check if the system's
-  clipboard contains valid text data and return it; if not, it has to return
-  an empty string.
-
-procedure SetClipboard(Content: String);
-  This method is used to set the content of the clipboard after a
-  "ClipboardCut" or "ClipboardCopy" action occured.
-
-
-
-Highlighters and document type specific features
-------------------------------------------------
-
-TSHTextEdit does not perform any syntax highlighting, and it always acts as a
-normal text editor without any fancy extra feature.
-This can easily be changed by deriving your own class from TSHTextEdit.
-Currently there are two special editor classes: TSHPasEdit (unit sh_pas.pp) and
-TSHXMLEdit (unit sh_xml.pp).
-
-TSHPasEdit supports syntax highlighting for Pascal sources, and it adds auto
-indent facilities to SHEdit (currently, when you press the Enter key, it will
-add as many spaces as the previous line to the new created line).
-
-TSHXMLEdit just adds syntax highlighting for XML and DTD documents.
-
-Please note that currently there is no framework for handling with different
-kinds of documents. It is up to the program which wants to use SHEdit to
-determine which editor class to use.
-
-
-- Sebastian Guenther, [email protected]

fcl/shedit/classes.txt

@@ -1,18 +0,0 @@
-TObject
-  TCollectionItem
-     TKeyboardActionDescr		Assigns names to keyboard actions
-     TShortcut				Connects a keyboard shortcut with an action description
-  TUndoInfo				Generic undo information
-    TUndoEdit				Undo informations for inserted characters
-    TUndoDelLeft			Undo informations for left deleted characters
-    TUndoDelRight			Undo informations for right deleted characters
-  TSelection				Holds a selection (start and end coordinates)
-  ISHWidget				Generic SH widget interface
-    TGtkSHWidget			SHWidget implementation for GTK+
-    <other platform dependent
-     implementations>
-  TSHTextEdit				Generic editor engine
-    TSHPasEdit				Editor engine for Pascal source files
-    TSHXMLEdit				Editor engine for XML files
-    <other classes and highlighters for
-     additional languages>

fcl/shedit/doc_text.pp

@@ -1,280 +0,0 @@
-{
-    $Id$
-
-    "SHEdit" - Text editor with syntax highlighting
-    Copyright (C) 1999  Sebastian Guenther ([email protected])
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-}
-
-// Generic text document class
-
-{$MODE objfpc}
-{$M+,H+}
-
-unit doc_text;
-
-interface
-
-uses Classes;
-
-type
-  PLine = ^TLine;
-  TLine = packed record
-    info: Pointer;
-    flags: LongWord;
-    len: LongInt;                       // Length of string in characters
-    s: PChar;
-  end;
-
-  PLineArray = ^TLineArray;
-  TLineArray = array[0..0] of TLine;
-
-const
-
-  {TLine.flags Syntax Highlighting Flags}
-  LF_SH_Valid      = $01;
-  LF_SH_Multiline1 = $02;
-  LF_SH_Multiline2 = $04;
-  LF_SH_Multiline3 = $08;
-  LF_SH_Multiline4 = $10;
-  LF_SH_Multiline5 = $20;
-  LF_SH_Multiline6 = $40;
-  LF_SH_Multiline7 = $80;
-
-  {Escape character for syntax highlighting (marks start of sh sequence,
-   next character is color/sh element number, beginning at #1}
-  LF_Escape = #10;
-
-type
-
-  TTextDoc = class;
-
-  TDocLineEvent = procedure(Sender: TTextDoc; Line: Integer) of object;
-
-  TViewInfo = class(TCollectionItem)
-  public
-    OnLineInsert, OnLineRemove: TDocLineEvent;
-    OnModifiedChange: TNotifyEvent;
-  end;
-
-  TTextDoc = class
-  protected
-    FModified: Boolean;
-    FLineWidth,
-    FLineCount: LongInt;
-    FLines: PLineArray;
-    FViewInfos: TCollection;
-    procedure SetModified(AModified: Boolean);
-    function  GetLineText(LineNumber: Integer): String;
-    procedure SetLineText(LineNumber: Integer; const NewText: String);
-    function  GetLineLen(LineNumber: Integer): Integer;
-    function  GetLineFlags(LineNumber: Integer): Byte;
-    procedure SetLineFlags(LineNumber: Integer; NewFlags: Byte);
-  public
-    constructor Create;
-    destructor Destroy; override;
-    procedure Clear;
-    procedure LoadFromFile(const filename: String);
-
-    procedure InsertLine(BeforeLine: Integer; const s: String);
-    procedure AddLine(const s: String);
-    procedure RemoveLine(LineNumber: Integer);
-
-    property Modified: Boolean read FModified write SetModified;
-    property LineWidth: Integer read FLineWidth;
-    property LineCount: Integer read FLineCount;
-    property LineText[LineNumber: Integer]: String
-      read GetLineText write SetLineText;
-    property LineLen[LineNumber: Integer]: Integer read GetLineLen;
-    property LineFlags[LineNumber: Integer]: Byte
-      read GetLineFlags write SetLineFlags;
-
-    property ViewInfos: TCollection read FViewInfos;
-  end;
-
-
-implementation
-uses Strings;
-
-
-constructor TTextDoc.Create;
-begin
-  FModified := false;
-  FLines := nil;
-  FLineCount := 0;
-  FLineWidth := 0;
-  FViewInfos := TCollection.Create(TViewInfo);
-end;
-
-destructor TTextDoc.Destroy;
-begin
-  Clear;
-end;
-
-procedure TTextDoc.Clear;
-var
-  i: Integer;
-begin
-  for i := 0 to FLineCount - 1 do
-    StrDispose(FLines^[i].s);
-  if assigned(FLines) then
-   FreeMem(FLines);
-
-  FLineCount:=0;
-  FLineWidth:=0;
-
-  for i := 0 to FViewInfos.Count - 1 do
-    if Assigned(TViewInfo(FViewInfos.Items[i]).OnLineRemove) then
-      TViewInfo(FViewInfos.Items[i]).OnLineRemove(Self, 0);
-end;
-
-procedure TTextDoc.InsertLine(BeforeLine: Integer; const s: String);
-var
-  l: PLine;
-  i: Integer;
-begin
-  if BeforeLine > FLineCount then
-   exit;  // *** throw an intelligent exception
-  ReAllocMem(FLines, (FLineCount + 1) * SizeOf(TLine));
-  Move(FLines^[BeforeLine], FLines^[BeforeLine + 1],(FLineCount - BeforeLine) * SizeOf(TLine));
-  l := @(FLines^[BeforeLine]);
-  FillChar(l^, SizeOf(TLine), 0);
-  l^.len := Length(s);
-  l^.s := StrNew(PChar(s));
-
-  Inc(FLineCount);
-  if l^.Len>FLineWidth then
-   FLineWidth:=l^.len;
-
-  for i := 0 to FViewInfos.Count - 1 do
-    if Assigned(TViewInfo(FViewInfos.Items[i]).OnLineInsert) then
-      TViewInfo(FViewInfos.Items[i]).OnLineInsert(Self, BeforeLine);
-end;
-
-procedure TTextDoc.AddLine(const s: String);
-begin
-  InsertLine(FLineCount, s);
-end;
-
-procedure TTextDoc.RemoveLine(LineNumber: Integer);
-var
-  i: Integer;
-begin
-  StrDispose(FLines^[LineNumber].s);
-  ReAllocMem(FLines, (FLineCount - 1) * SizeOf(TLine));
-  if LineNumber < FLineCount - 1 then
-    Move(FLines^[LineNumber + 1], FLines^[LineNumber],(FLineCount - LineNumber - 1) * SizeOf(TLine));
-  Dec(FLineCount);
-
-  for i := 0 to FViewInfos.Count - 1 do
-    if Assigned(TViewInfo(FViewInfos.Items[i]).OnLineRemove) then
-      TViewInfo(FViewInfos.Items[i]).OnLineRemove(Self, LineNumber);
-  Modified := True;
-end;
-
-procedure TTextDoc.LoadFromFile(const filename: String);
-var
-  f: Text;
-  s, s2: String;
-  i: Integer;
-begin
-  Clear;
-  Assign(f, filename);
-  Reset(f);
-  while not eof(f) do begin
-    ReadLn(f, s);
-    // Expand tabs to spaces
-    s2 := '';
-    for i := 1 to Length(s) do
-      if s[i] = #9 then begin
-        repeat s2 := s2 + ' ' until (Length(s2) mod 8) = 0;
-      end else
-        s2 := s2 + s[i];
-    AddLine(s2);
-  end;
-  Close(f);
-end;
-
-procedure TTextDoc.SetModified(AModified: Boolean);
-var
-  i: Integer;
-begin
-  if AModified = FModified then exit;
-  FModified := AModified;
-
-  for i := 0 to FViewInfos.Count - 1 do
-    if Assigned(TViewInfo(FViewInfos.Items[i]).OnModifiedChange) then
-      TViewInfo(FViewInfos.Items[i]).OnModifiedChange(Self);
-end;
-
-function TTextDoc.GetLineText(LineNumber: Integer): String;
-begin
-  if (LineNumber < 0) or (LineNumber >= FLineCount) then
-    Result := ''
-  else
-    Result := FLines^[LineNumber].s;
-end;
-
-procedure TTextDoc.SetLineText(LineNumber: Integer; const NewText: String);
-begin
-  if (FLines^[LineNumber].s = nil) or
-    (StrComp(FLines^[LineNumber].s, PChar(NewText)) <> 0) then begin
-    StrDispose(FLines^[LineNumber].s);
-    FLines^[LineNumber].len := Length(NewText);
-    FLines^[LineNumber].s := StrNew(PChar(NewText));
-    if Length(NewText)>FLineWidth then
-     FLineWidth:=Length(NewText);
-    Modified := True;
-  end;
-end;
-
-function TTextDoc.GetLineLen(LineNumber: Integer): Integer;
-begin
-  if (LineNumber < 0) or (LineNumber >= FLineCount) then
-    Result := 0
-  else
-    Result := FLines^[LineNumber].len;
-end;
-
-function TTextDoc.GetLineFlags(LineNumber: Integer): Byte;
-begin
-  if (LineNumber < 0) or (LineNumber >= FLineCount) then
-    Result := 0
-  else
-    Result := FLines^[LineNumber].flags;
-end;
-
-procedure TTextDoc.SetLineFlags(LineNumber: Integer; NewFlags: Byte);
-begin
-  FLines^[LineNumber].flags := NewFlags;
-end;
-
-
-end.
-
-
-{
-  $Log$
-  Revision 1.4  1999-12-30 21:02:14  sg
-  * Shortened copyright notice
-
-  Revision 1.3  1999/12/09 23:16:41  peter
-    * cursor walking is now possible, both horz and vert ranges are now
-      adapted
-    * filter key modifiers
-    * selection move routines added, but still no correct output to the
-      screen
-
-  Revision 1.2  1999/11/14 21:32:55  peter
-    * fixes to get it working without crashes
-
-  Revision 1.1  1999/10/29 15:59:03  peter
-    * inserted in fcl
-
-}

fcl/shedit/drawing.inc

@@ -1,250 +0,0 @@
-{
-    $Id$
-
-    "SHEdit" - Text editor with syntax highlighting
-    Copyright (C) 1999  Sebastian Guenther ([email protected])
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-}
-
-
-// Drawing code of TSHTextEdit (renderer for syntax highlighting engine);
-// also handles cursor drawing
-
-
-procedure TSHTextEdit.DoHighlighting(var flags: Byte; source, dest: PChar);
-begin
-  StrCopy(dest, source);
-end;
-
-function TSHTextEdit.CalcSHFlags(FlagsIn: Byte; source: String): Byte;
-var
-  s: PChar;
-  flags: Byte;
-begin
-  GetMem(s, Length(source) * 3 + 4);
-  flags := FlagsIn;
-  DoHighlighting(flags, PChar(source), s);
-  FreeMem(s, Length(source) * 3 + 4);
-  Result := flags;
-end;
-
-procedure TSHTextEdit.HideCursor;
-begin
-  Dec(CursorVisible);
-  if CursorVisible >= 0 then
-    FWidget.HideCursor(CursorX, CursorY);
-end;
-
-procedure TSHTextEdit.ShowCursor;
-begin
-  Inc(CursorVisible);
-  if CursorVisible = 1 then
-    FWidget.ShowCursor(CursorX, CursorY);
-end;
-
-
-procedure TSHTextEdit.ChangeInLine(line: Integer);
-var
-  CurLine: Integer;
-  OldFlags, NewFlags: Byte;
-begin
-  // Determine how many lines must be redrawn
-
-  CurLine := line;
-  if CurLine = 0 then
-    NewFlags := 0
-  else
-    NewFlags := FDoc.LineFlags[CurLine - 1];
-
-  while CurLine < FDoc.LineCount - 1 do begin
-    NewFlags := CalcSHFlags(NewFlags, FDoc.LineText[CurLine]);
-    OldFlags := FDoc.LineFlags[CurLine + 1] and not LF_SH_Valid;
-    FDoc.LineFlags[CurLine + 1] := NewFlags or LF_SH_Valid;
-    if OldFlags = (NewFlags and not LF_SH_Valid) then break;
-    Inc(CurLine);
-  end;
-
-  // Redraw all lines with changed SH flags
-  FWidget.InvalidateLines(line, CurLine);
-end;
-
-
-procedure TSHTextEdit.DrawContent(x1, y1, x2, y2: Integer);
-
-  procedure PostprocessOutput(py: Integer);
-  begin
-    // Erase free space below the text area
-    if py < y2 then
-      FWidget.ClearRect(0, py, x2, y2);
-
-    if (FCursorX >= x1) and (FCursorY >= y1) and
-      (FCursorX <= x2) and (FCursorY <= y2) then
-      ShowCursor;
-  end;
-
-  // If Lenght(s) < x, add as many spaces to s so that x will be at
-  // the end of s.
-  procedure ProvideSpace(var s: String; x: Integer);
-  begin
-    while Length(s) < x do
-      s := s + ' ';
-  end;
-
-var
-  i, LineNumber, CheckLine: Integer;
-  OrigStr, sh, s, s2: PChar;
-  spos, x: Integer;
-  flags: Byte;
-  InSel: Boolean;
-  LastCol: Char;
-  LineWithSpace: String;	// used for virtual whitespace expanding
-
-begin
-
-  if (FCursorX >= x1) and (FCursorY >= y1) and
-    (FCursorX <= x2) and (FCursorY <= y2) then
-    HideCursor;
-
-  if (FDoc = nil) or (FDoc.LineCount <= y1) then begin
-    PostprocessOutput(y1);
-    exit;
-  end;
-
-  LineNumber := y1;
-
-  // Check if syntax highlighting flags are valid:
-  if (FDoc.LineFlags[LineNumber] and LF_SH_Valid) <> 0 then
-    flags := FDoc.LineFlags[LineNumber] and not LF_SH_Valid
-  else begin
-    // search for last valid line before the first line to be drawn
-    CheckLine := LineNumber;
-    while (CheckLine >= 0) and
-      ((FDoc.LineFlags[CheckLine] and LF_SH_Valid) = 0) do Dec(CheckLine);
-    if CheckLine >= 0 then begin
-      flags := FDoc.LineFlags[CheckLine] and not LF_SH_Valid;
-      // Recalc SH flags for all lines between last valid and first visible line
-      while (CheckLine < LineNumber) do begin
-        flags := CalcSHFlags(flags, FDoc.LineText[CheckLine]);
-        FDoc.LineFlags[CheckLine] := flags or LF_SH_Valid;
-        Inc(CheckLine);
-      end;
-    end else
-      flags := 0;
-  end;
-
-
-  // if FSel.IsValid then writeln('Selection: ',FSel.OStartX,',',FSel.OStartY,'-',FSel.OEndX,',',FSel.OEndY);
-
-  while (LineNumber < FDoc.LineCount) and (LineNumber <= y2) do begin
-    i := 0;
-
-    // Do virtual whitespace expanding
-    LineWithSpace := FDoc.LineText[LineNumber];
-    if LineNumber = FSel.OStartY then
-      ProvideSpace(LineWithSpace, FSel.OStartX);
-    if LineNumber = FSel.OEndY then
-      ProvideSpace(LineWithSpace, FSel.OEndX);
-    if LineNumber = FCursorY then
-      ProvideSpace(LineWithSpace, FCursorX);
-
-    // Call syntax highlighter for this line
-
-    GetMem(sh, Length(LineWithSpace) * 3 + 8);
-    s := sh;
-    FDoc.LineFlags[LineNumber] := flags or LF_SH_Valid;
-    OrigStr := PChar(LineWithSpace);
-    DoHighlighting(flags, OrigStr, s);
-
-    // Handle current selection
-    if FSel.IsValid then
-      if (LineNumber > FSel.OStartY) and (LineNumber < FSel.OEndY) then begin
-        s[0] := LF_Escape;
-        s[1] := Chr(shSelected);
-        StrCopy(@s[2], OrigStr);
-      end else if OrigStr[0] = #0 then begin
-        if LineNumber = FSel.OStartY then begin
-          s[0] := LF_Escape;
-          s[1] := Chr(shSelected);
-          s[2] := #0;
-        end;
-      end else if (LineNumber = FSel.OStartY) or
-        (LineNumber = FSel.OEndY) then begin
-        s2 := StrNew(s);
-        spos := 0;
-        i := 0;
-        x := 0;
-        if LineNumber > FSel.OStartY then begin
-          s[0] := LF_Escape;
-          s[1] := Chr(shSelected);
-          InSel := True;
-          spos := 2;
-        end else
-          InSel := False;
-        LastCol := Chr(shDefault);
-        while True do begin
-          if s2[i] = LF_Escape then begin
-            LastCol := s2[i + 1];
-            if not InSel then begin
-              s[spos] := LF_Escape;
-              s[spos + 1] := LastCol;
-              Inc(spos, 2);
-            end;
-            Inc(i, 2);
-          end else begin
-            if InSel then begin
-              if (LineNumber = FSel.OEndY) and (x = FSel.OEndX) then begin
-                s[spos] := LF_Escape;
-                s[spos + 1] := LastCol;
-                Inc(spos, 2);
-                InSel := False;
-              end;
-            end else
-              if (LineNumber = FSel.OStartY) and (x = FSel.OStartX) then begin
-                s[spos] := LF_Escape;
-                s[spos + 1] := Chr(shSelected);
-                Inc(spos, 2);
-                InSel := True;
-              end;
-            if s2[i] = #0 then break;    // only exit of 'while' loop!
-            s[spos] := s2[i];
-            Inc(spos);
-            Inc(i);
-            Inc(x);
-          end;
-        end;
-        s[spos] := #0;
-        StrDispose(s2);
-      end;
-
-    FWidget.DrawTextLine(x1, x2, LineNumber, s);
-
-    FreeMem(sh);
-    Inc(LineNumber);
-  end;
-
-  PostprocessOutput(LineNumber);
-end;
-
-
-{
-  $Log$
-  Revision 1.5  1999-12-30 21:02:49  sg
-  * Name change: Renderer -> FWidget
-
-  Revision 1.3  1999/12/10 15:01:02  peter
-    * first things for selection
-    * Better Adjusting of range/cursor
-
-  Revision 1.2  1999/12/08 00:42:54  sg
-  * The cursor should be displayed correctly now
-
-  Revision 1.1  1999/10/29 15:59:04  peter
-    * inserted in fcl
-
-}

fcl/shedit/gtkdemo.pp

@@ -1,128 +0,0 @@
-{
-    $Id$
-
-    GTK (demo) implementation for shedit
-    Copyright (C) 1999  Sebastian Guenther ([email protected])
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-}
-
-{$MODE objfpc}
-{$H+}
-
-program GTKDemo;
-uses
-  SysUtils, Classes,
-  Doc_text, shedit, sh_pas, sh_xml,
-  GDK, GTK, GtkSHEdit;
-
-
-function CreateTextEditWidget(ADoc: TTextDoc): TGtkSHWidget;
-begin
-  Result := TGtkSHWidget.Create(ADoc, TSHTextEdit);
-end;
-
-function CreatePasEditWidget(ADoc: TTextDoc): TGtkSHWidget;
-var
-  e: TSHPasEdit;
-begin
-  Result := TGtkSHWidget.Create(ADoc, TSHPasEdit);
-  e := Result.Edit as TSHPasEdit;
-
-  e.shSymbol     := Result.AddSHStyle('Symbol',        colBrown,       colDefault, fsNormal);
-  e.shKeyword    := Result.AddSHStyle('Keyword',       colBlack,       colDefault, fsBold);
-  e.shComment    := Result.AddSHStyle('Comment',       colDarkCyan,    colDefault, fsItalics);
-  e.shDirective  := Result.AddSHStyle('Directive',     colRed,         colDefault, fsItalics);
-  e.shNumbers    := Result.AddSHStyle('Numbers',       colDarkMagenta, colDefault, fsNormal);
-  e.shCharacters := Result.AddSHStyle('Characters',    colDarkBlue,    colDefault, fsNormal);
-  e.shStrings    := Result.AddSHStyle('Strings',       colBlue,        colDefault, fsNormal);
-  e.shAssembler  := Result.AddSHStyle('Assembler',     colDarkGreen,   colDefault, fsNormal);
-end;
-
-function CreateXMLEditWidget(ADoc: TTextDoc): TGtkSHWidget;
-var
-  e: TSHXMLEdit;
-begin
-  Result := TGtkSHWidget.Create(ADoc, TSHXMLEdit);
-  e := Result.Edit as TSHXMLEdit;
-
-  e.shTag        := Result.AddSHStyle('Tag',           colBlack,       colDefault, fsBold);
-  e.shTagName    := Result.AddSHStyle('Tag Name',      colBlack,       colDefault, fsBold);
-  e.shDefTagName := Result.AddSHStyle('Definition Tag Name', colDarkGreen, colDefault, fsBold);
-  e.shArgName    := Result.AddSHStyle('Argument Name', colBrown,       colDefault, fsNormal);
-  e.shString     := Result.AddSHStyle('String',        colBlue,        colDefault, fsNormal);
-  e.shReference  := Result.AddSHStyle('Reference',     colDarkMagenta, colDefault, fsNormal);
-  e.shInvalid    := Result.AddSHStyle('Invalid',       colRed,         colDefault, fsNormal);
-  e.shComment    := Result.AddSHStyle('Comment',       colDarkCyan,    colDefault, fsItalics);
-  e.shCDATA      := Result.AddSHStyle('CDATA',         colDarkGreen,   colDefault, fsNormal);
-end;
-
-
-var
-  MainWindow, Notebook: PGtkWidget;
-  Pages: array[0..2] of TGtkSHWidget;
-  PasDoc, XMLDoc, TxtDoc: TTextDoc;
-
-procedure OnMainWindowDestroyed; cdecl;
-begin
-  gtk_main_quit;
-end;
-
-begin
-
-  gtk_init(@argc, @argv);
-
-  // Create main window
-  MainWindow := gtk_window_new(GTK_WINDOW_TOPLEVEL);
-  gtk_widget_set_usize(MainWindow, 600, 400);
-  gtk_window_set_title(PGtkWindow(MainWindow), 'FPC SHEdit GTK Demo');
-  gtk_signal_connect(PGtkObject(MainWindow), 'destroy', GTK_SIGNAL_FUNC(@OnMainWindowDestroyed), nil);
-
-  // Set up documents
-  PasDoc := TTextDoc.Create; PasDoc.LoadFromFile('gtkdemo.pp');
-  XMLDoc := TTextDoc.Create; XMLDoc.LoadFromFile('simple.xml');
-  TxtDoc := TTextDoc.Create; TxtDoc.LoadFromFile('README');
-
-  // Create notebook pages (editor widgets)
-  Pages[0] := CreatePasEditWidget (PasDoc);
-  Pages[1] := CreateXMLEditWidget (XMLDoc);
-  Pages[2] := CreateTextEditWidget(TxtDoc);
-
-  // Create notebook
-  Notebook := gtk_notebook_new;
-  gtk_notebook_append_page(PGtkNotebook(Notebook), Pages[0].Widget, gtk_label_new('Pascal'));
-  gtk_notebook_append_page(PGtkNotebook(Notebook), Pages[1].Widget, gtk_label_new('XML'));
-  gtk_notebook_append_page(PGtkNotebook(Notebook), Pages[2].Widget, gtk_label_new('Text'));
-  gtk_container_add(PGtkContainer(MainWindow), Notebook);
-  gtk_widget_show(Notebook);
-  gtk_widget_show(MainWindow);
-  Pages[0].SetFocus;
-  gtk_main;
-end.
-
-
-{
-  $Log$
-  Revision 1.7  1999-12-30 21:03:25  sg
-  * Major restructuring and simplifications
-
-  Revision 1.6  1999/12/22 22:28:08  peter
-    * updates for cursor setting
-    * button press event works
-
-  Revision 1.5  1999/12/08 01:03:15  peter
-    * changes so redrawing and walking with the cursor finally works
-      correct
-
-  Revision 1.4  1999/11/15 21:47:36  peter
-    * first working keypress things
-
-  Revision 1.3  1999/11/14 21:32:55  peter
-    * fixes to get it working without crashes
-
-}

fcl/shedit/gtkshedit.pp

@@ -1,624 +0,0 @@
-{
-    $Id$
-
-    GTK implementation for SHEdit
-    Copyright (C) 1999  Sebastian Guenther ([email protected])
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-}
-
-unit GtkSHEdit;
-interface
-
-{$MODE objfpc}
-{$H+}
-
-uses
-  SysUtils, Classes,
-  GDK, GTK,
-  doc_text, SHEdit;
-
-const
-  colBlack       = $000000;
-  colDarkBlue    = $000080;
-  colBlue        = $0000ff;
-  colDarkGreen   = $008000;
-  colGreen       = $00ff00;
-  colDarkCyan    = $008080;
-  colCyan        = $00ffff;
-  colBrown       = $800000;
-  colRed         = $ff0000;
-  colDarkMagenta = $800080;
-  colMagenta     = $ff00ff;
-  colDarkYellow  = $808000;
-  colYellow      = $ffff00;
-  colGray        = $808080;
-  colGrey        = colGray;
-  colLightGray   = $c0c0c0;
-  colLightGrey   = colLightGray;
-  colWhite       = $ffffff;
-  colInvalid     = $ff000000;
-  colDefault     = $ffffffff;
-
-type
-
-  TSHFontStyle = (fsNormal, fsBold, fsItalics, fsBoldItalics);
-
-  TSHStyle = record
-    Name: String[32];
-    Color, Background: LongWord;
-    FontStyle: TSHFontStyle;
-  end;
-
-  TSHStyleArray = array[1..1] of TSHStyle;  // Notice the 1!
-  PSHStyleArray = ^TSHStyleArray;
-
-
-  {This class is a kind of widget class which implements the ISHWidget
-   interface for drawing syntax highlighted text}
-  TGtkSHWidget = class(ISHWidget)
-  protected
-    SHStyles: PSHStyleArray;
-    SHStyleCount: Integer;              // # of currently registered styles
-    shWhitespace: Integer;
-    CurGCColor: LongWord;
-
-    hadj, vadj: PGtkAdjustment;
-    PaintBox: PGtkWidget;
-    FEdit: TSHTextEdit;
-    LeftIndent: Integer;
-    CharW, CharH: Integer;
-    Font: array[TSHFontStyle] of PGdkFont; // Fonts for content drawing
-    gc: PGdkGC;
-    GdkWnd: PGdkWindow;
-
-    procedure SetGCColor(AColor: LongWord);
-
-    // ISHWidget Implemenation:
-
-    procedure InvalidateRect(x1, y1, x2, y2: Integer); override;
-    procedure InvalidateLines(y1, y2: Integer); override;
-
-    // Drawing
-    procedure ClearRect(x1, y1, x2, y2: Integer); override;
-    procedure DrawTextLine(x1, x2, y: Integer; s: PChar); override;
-
-    // Cursor
-    procedure ShowCursor(x, y: Integer); override;
-    procedure HideCursor(x, y: Integer); override;
-
-    // Scrolling support
-    function  GetHorzPos: Integer; override;
-    procedure SetHorzPos(x: Integer); override;
-    function  GetVertPos: Integer; override;
-    procedure SetVertPos(y: Integer); override;
-    function  GetPageWidth: Integer; override;
-    function  GetPageHeight: Integer; override;
-    function  GetLineWidth: Integer; override;
-    procedure SetLineWidth(count: Integer); override;
-    function  GetLineCount: Integer; override;
-    procedure SetLineCount(count: Integer); override;
-
-    // Clipboard support
-    //function  GetClipboard: String; override;
-    //procedure SetClipboard(Content: String); override;
-
-  public
-    Widget: PGtkWidget;  // this is the outer editor widget
-
-    constructor Create(ADoc: TTextDoc; AEditClass: TSHTextEditClass);
-
-    procedure SetFocus;
-
-    function  AddSHStyle(AName: String; AColor, ABackground: LongWord;
-      AStyle: TSHFontStyle): Integer;
-    property Edit: TSHTextEdit read FEdit;
-  end;
-
-
-implementation
-
-
-{*****************************************************************************
-                              GTK/GDK Callbacks
-*****************************************************************************}
-
-procedure TGtkSHWidget_Expose(GtkWidget: PGtkWidget; event: PGdkEventExpose;
-  widget: TGtkSHWidget); cdecl;
-var
-  x1, y1, x2, y2: Integer;
-begin
-  x1 := event^.area.x;
-  if x1 > 0 then
-    Dec(x1, widget.LeftIndent);
-  x2 := x1 + event^.area.width - 1;
-  x1 := x1 div widget.CharW;
-  x2 := (x2 + widget.CharW - 1) div widget.CharW;
-  y1 := event^.area.y div widget.CharH;
-  y2 := (event^.area.y + event^.area.height - 1) div widget.CharH;
-//  WriteLn(Format('Expose(%d/%d - %d/%d) for %s', [x1, y1, x2, y2, FEdit.ClassName]));
-
-  widget.GdkWnd := widget.PaintBox^.window;
-  widget.GC := gdk_gc_new(widget.GdkWnd);
-  widget.CurGCColor := 0;         // Reset color, because we have a new GC!
-  gdk_gc_copy(widget.GC, PGtkStyle(widget.PaintBox^.thestyle)^.
-    fg_gc[widget.PaintBox^.state]);
-
-  widget.FEdit.AdjustCursorToRange;
-  widget.FEdit.DrawContent(x1, y1, x2, y2);
-end;
-
-
-function TGtkSHWidget_KeyPressed(GtkWidget: PGtkWidget; Event: PGdkEventKey;
-  widget: TGtkSHWidget): Integer; cdecl;
-var
-  KeyState,
-  KeyCode: LongWord;
-  KeyMods: TShiftState;
-begin
-  Result := 1;
-
-  case Event^.KeyVal of
-    GDK_KP_Insert    : KeyCode:=GDK_Insert;
-    GDK_KP_Home      : KeyCode:=GDK_Home;
-    GDK_KP_Left      : KeyCode:=GDK_Left;
-    GDK_KP_Up        : KeyCode:=GDK_Up;
-    GDK_KP_Right     : KeyCode:=GDK_Right;
-    GDK_KP_Down      : KeyCode:=GDK_Down;
-    GDK_KP_Page_Up   : KeyCode:=GDK_Page_Up;
-    GDK_KP_Page_Down : KeyCode:=GDK_Page_Down;
-    GDK_KP_End       : KeyCode:=GDK_End;
-    GDK_Scroll_Lock,
-    GDK_Num_Lock,
-    GDK_Shift_L..GDK_Hyper_R :
-      begin
-        // Don't let modifier keys trough as normal keys
-        // *** This doesn't work reliably! (sg)
-        exit;
-      end;
-  else
-    KeyCode:=Event^.KeyVal;
-  end;
-  KeyState:=Event^.State;
-
-  // WriteLn('KeyCode ', KeyCode,'   keystate ',KeyState);
-
-  // Calculate the Key modifiers (shiftstate)
-  KeyMods := [];
-  if (KeyState and 1) <> 0 then KeyMods := KeyMods + [ssShift];
-  if (KeyState and 2) <> 0 then KeyMods := KeyMods + [ssCaps];
-  if (KeyState and 4) <> 0 then KeyMods := KeyMods + [ssCtrl];
-  if (KeyState and 8) <> 0 then KeyMods := KeyMods + [ssAlt];
-  if (KeyState and $10) <> 0 then KeyMods := KeyMods + [ssNum];
-  if (KeyState and $40) <> 0 then KeyMods := KeyMods + [ssSuper];
-  if (KeyState and $80) <> 0 then KeyMods := KeyMods + [ssScroll];
-  if (KeyState and $100) <> 0 then KeyMods := KeyMods + [ssLeft];
-  if (KeyState and $200) <> 0 then KeyMods := KeyMods + [ssMiddle];
-  if (KeyState and $400) <> 0 then KeyMods := KeyMods + [ssRight];
-  if (KeyState and $2000) <> 0 then KeyMods := KeyMods + [ssAltGr];
-
-  widget.FEdit.KeyPressed(KeyCode,KeyMods);
-end;
-
-
-function TGtkSHWidget_ButtonPressEvent(GtkWidget: PGtkWidget;
-  event: PGdkEventButton; widget: TGtkSHWidget): Integer; cdecl;
-begin
-  widget.FEdit.CursorX := Round((event^.x - widget.LeftIndent) / widget.CharW);
-  widget.FEdit.CursorY := Trunc(event^.y) div widget.CharH;
-  widget.SetFocus;
-  Result := 1;
-end;
-
-
-function TGtkSHWidget_FocusInEvent(GtkWidget: PGtkWidget;
-  event: PGdkEventFocus; widget: TGtkSHWidget): Integer; cdecl;
-begin
-//  Writeln('focus in');
-  widget.FEdit.FocusIn;
-  result:=1;
-end;
-
-
-function TGtkSHWidget_FocusOutEvent(GtkWidget: PGtkWidget; event: PGdkEventFocus; widget: TGtkSHWidget): Integer; cdecl;
-begin
-//  Writeln('focus out');
-  widget.FEdit.FocusOut;
-  result:=1;
-end;
-
-
-{*****************************************************************************
-                                 TGtkSHWidget
-*****************************************************************************}
-
-constructor TGtkSHWidget.Create(ADoc: TTextDoc; AEditClass: TSHTextEditClass);
-var
-  lfd: String;    // Logical font descriptor
-  i: Integer;
-begin
-  inherited Create;
-
-  // Create fonts
-  for i := 0 to 3 do begin
-    lfd := '-*-courier-';
-    if (i and 1) <> 0 then lfd := lfd + 'bold'
-    else lfd := lfd + 'medium';
-    lfd := lfd + '-';
-    if (i and 2) <> 0 then lfd := lfd + 'i'
-    else lfd := lfd + 'r';
-    lfd := lfd + '-normal--14-*-*-*-*-*-iso8859-1';
-    Font[TSHFontStyle(i)] := gdk_font_load(PChar(lfd));
-  end;
-
-  CharW := gdk_char_width(Font[fsBold], ' ');
-  CharH := 14 {=FontHeight} + 3;   // *** find better way to determine max. cell height
-
-  LeftIndent := CharW;
-
-  // Create scrolled window and drawing area
-
-  hadj := PGtkAdjustment(gtk_adjustment_new(0, 0, 200, 1, 10, 100));
-  vadj := PGtkAdjustment(gtk_adjustment_new(0, 0, 200, 1, 10, 100));
-  Widget := gtk_scrolled_window_new(hadj, vadj);
-
-  PaintBox := gtk_drawing_area_new;
-
-  gtk_scrolled_window_add_with_viewport(PGtkScrolledWindow(Widget), PaintBox);
-  gtk_widget_show(PaintBox);
-
-  gtk_widget_set_flags(PGtkWidget(PaintBox),GTK_CAN_FOCUS);
-
-  gtk_signal_connect(PGtkObject(PaintBox), 'expose-event',
-    GTK_SIGNAL_FUNC(@TGtkSHWidget_Expose), self);
-  gtk_signal_connect_after(PGtkObject(PaintBox), 'key-press-event',
-    GTK_SIGNAL_FUNC(@TGtkSHWidget_Keypressed), self);
-  gtk_signal_connect(PGtkObject(PaintBox), 'button-press-event',
-    GTK_SIGNAL_FUNC(@TGtkSHWidget_ButtonPressEvent), self);
-  gtk_signal_connect_after(PGtkObject(PaintBox), 'focus-in-event',
-    GTK_SIGNAL_FUNC(@TGtkSHWidget_FocusInEvent), self);
-  gtk_signal_connect_after(PGtkObject(PaintBox), 'focus-out-event',
-    GTK_SIGNAL_FUNC(@TGtkSHWidget_FocusOutEvent), self);
-
-  gtk_widget_set_events(PGtkWidget(Paintbox),
-    GDK_EXPOSURE_MASK or GDK_KEY_PRESS_MASK or GDK_KEY_RELEASE_MASK or
-    GDK_BUTTON_PRESS_MASK or GDK_ENTER_NOTIFY_MASK or GDK_LEAVE_NOTIFY_MASK);
-
-  gtk_widget_show(Widget);
-
-
-  FEdit := AEditClass.Create(ADoc, Self);
-  shWhitespace      := AddSHStyle('Whitespace', colBlack, colWhite,    fsNormal);
-  FEdit.shDefault    := AddSHStyle('Default',    colBlack, colWhite,    fsNormal);
-  FEdit.shSelected   := AddSHStyle('Selected',   colWhite, colDarkBlue, fsNormal);
-{ Install keys }
-  FEdit.AddKeyDef(@FEdit.CursorUp, selClear, 'Cursor up', GDK_Up, []);
-  FEdit.AddKeyDef(@FEdit.CursorDown, selClear, 'Cursor down', GDK_Down, []);
-  FEdit.AddKeyDef(@FEdit.CursorLeft, selClear, 'Cursor left', GDK_Left, []);
-  FEdit.AddKeyDef(@FEdit.CursorRight, selClear, 'Cursor right', GDK_Right, []);
-  FEdit.AddKeyDef(@FEdit.CursorHome, selClear, 'Cursor Home', GDK_Home, []);
-  FEdit.AddKeyDef(@FEdit.CursorEnd, selClear, 'Cursor Home', GDK_End, []);
-  FEdit.AddKeyDef(@FEdit.CursorPageUp, selClear, 'Cursor PageUp', GDK_Page_Up, []);
-  FEdit.AddKeyDef(@FEdit.CursorPageDown, selClear, 'Cursor PageDown', GDK_Page_Down, []);
-  FEdit.AddKeyDef(@FEdit.CursorDocBegin, selClear, 'Cursor Document Start', GDK_Page_Up, [ssCtrl]);
-  FEdit.AddKeyDef(@FEdit.CursorDocEnd, selClear, 'Cursor Document End', GDK_Page_Down, [ssCtrl]);
-
-  FEdit.AddKeyDef(@FEdit.CursorUp, selExtend, 'Selection up', GDK_Up, [ssShift]);
-  FEdit.AddKeyDef(@FEdit.CursorDown, selExtend, 'Selection down', GDK_Down, [ssShift]);
-  FEdit.AddKeyDef(@FEdit.CursorLeft, selExtend, 'Selection left', GDK_Left, [ssShift]);
-  FEdit.AddKeyDef(@FEdit.CursorRight, selExtend, 'Selection right', GDK_Right, [ssShift]);
-  FEdit.AddKeyDef(@FEdit.CursorHome, selExtend, 'Selection Home', GDK_Home, [ssShift]);
-  FEdit.AddKeyDef(@FEdit.CursorEnd, selExtend, 'Selection Home', GDK_End, [ssShift]);
-  FEdit.AddKeyDef(@FEdit.CursorPageUp, selExtend, 'Selection PageUp', GDK_Page_Up, [ssShift]);
-  FEdit.AddKeyDef(@FEdit.CursorPageDown, selExtend, 'Selection PageDown', GDK_Page_Down, [ssShift]);
-  FEdit.AddKeyDef(@FEdit.CursorDocBegin, selExtend, 'Selection Document Start', GDK_Page_Up, [ssCtrl,ssShift]);
-  FEdit.AddKeyDef(@FEdit.CursorDocEnd, selExtend, 'Selection Document End', GDK_Page_Down, [ssCtrl,ssShift]);
-
-  FEdit.AddKeyDef(@FEdit.ToggleOverwriteMode, selNothing, 'Toggle overwrite mode', GDK_Insert, []);
-  FEdit.AddKeyDef(@FEdit.EditDelLeft, selClear, 'Delete char left of cursor', GDK_Backspace, []);
-  FEdit.AddKeyDef(@FEdit.EditDelRight, selClear, 'Delete char right of cursor', GDK_Delete_Key, []);
-  FEdit.AddKeyDef(@FEdit.EditDelLine, selClear, 'Delete current line', Ord('Y'), [ssCtrl]);
-  FEdit.AddKeyDef(@FEdit.EditDelLine, selClear, 'Delete current line', Ord('y'), [ssCtrl]);
-  FEdit.AddKeyDef(@FEdit.EditUndo, selClear, 'Undo last action', GDK_Backspace, [ssAlt]);
-  FEdit.AddKeyDef(@FEdit.EditRedo, selClear, 'Redo last undone action', GDK_Backspace, [ssShift, ssAlt]);
-end;
-
-
-function TGtkSHWidget.AddSHStyle(AName: String; AColor, ABackground: LongWord; AStyle: TSHFontStyle): Integer;
-begin
-  ReAllocMem(SHStyles, SizeOf(TSHStyle) * (SHStyleCount + 1));
-  Inc(SHStyleCount);
-  SHStyles^[SHStyleCount].Name       := AName;
-  SHStyles^[SHStyleCount].Color      := AColor;
-  SHStyles^[SHStyleCount].Background := ABackground;
-  SHStyles^[SHStyleCount].FontStyle  := AStyle;
-  Result := SHStyleCount;
-end;
-
-
-procedure TGtkSHWidget.SetGCColor(AColor: LongWord);
-var
-  c: TGdkColor;
-begin
-  if AColor <> CurGCColor then begin
-    c.pixel := 0;
-    c.red   := (((AColor shr 16) and 255) * 65535) div 255;
-    c.green := (((AColor shr 8) and 255) * 65535) div 255;
-    c.blue  := ((AColor and 255) * 65535) div 255;
-    gdk_colormap_alloc_color(gdk_colormap_get_system, @c, False, True);
-    gdk_gc_set_foreground(gc, @c);
-    CurGCColor := AColor;
-  end;
-end;
-
-
-procedure TGtkSHWidget.ClearRect(x1, y1, x2, y2: Integer);
-begin
-  SetGCColor(SHStyles^[shWhitespace].Background);
-  gdk_draw_rectangle(PGdkDrawable(GdkWnd), GC, 1,
-    x1 * CharW + LeftIndent, y1 * CharH,
-    (x2 - x1 + 1) * CharW, (y2 - y1 + 1) * CharH);
-end;
-
-
-procedure TGtkSHWidget.InvalidateRect(x1, y1, x2, y2: Integer);
-var
-  r : TGdkRectangle;
-begin
-  r.x := x1 * CharW + LeftIndent;
-  r.y := y1 * CharH;
-  r.Width := (x2 - x1 + 1) * CharW;
-  r.Height := (y2 - y1 + 1) * CharH;
-  gtk_widget_draw(PGtkWidget(PaintBox), @r);
-end;
-
-
-procedure TGtkSHWidget.InvalidateLines(y1, y2: Integer);
-var
-  r : TGdkRectangle;
-  w,h : integer;
-begin
-  gdk_window_get_size(PGdkDrawable(GdkWnd), @w, @h);
-  r.x := 0;
-  r.y := y1 * CharH;
-  r.Width := w;
-  r.Height := (y2 - y1 + 1) * CharH;
-  gtk_widget_draw(PGtkWidget(PaintBox), @r);
-end;
-
-
-procedure TGtkSHWidget.DrawTextLine(x1, x2, y: Integer; s: PChar);
-var
-  CurColor: LongWord;
-  CurX1, CurX2: Integer;
-
-  procedure DoErase;
-  begin
-    SetGCColor(CurColor);
-    if CurX1 < x1 then
-      CurX1 := x1;
-    if CurX2 > CurX1 then begin
-      gdk_draw_rectangle(PGdkDrawable(GdkWnd), GC, 1,
-        CurX1 * CharW + LeftIndent, y * CharH, (CurX2 - CurX1) * CharW, CharH);
-    end;
-    CurX1 := CurX2;
-  end;
-
-var
-  RequestedColor: Integer;
-  NewColor: LongWord;
-  hs : PChar;
-begin
-
-  // Erase the (potentially multi-coloured) background
-
-  hs := s;
-  CurColor := SHStyles^[shWhitespace].Background;
-
-  CurX1 := 0;
-  CurX2 := 0;
-  while (hs[0] <> #0) and (CurX2 <= x2) do begin
-    case hs[0] of
-      LF_Escape: begin
-          NewColor := SHStyles^[Ord(hs[1])].Background;
-          if NewColor = colDefault then
-            NewColor := SHStyles^[shWhitespace].Background;
-          if NewColor <> CurColor then begin
-            DoErase;
-            CurColor := NewColor;
-          end;
-          Inc(hs, 2);
-        end;
-      #9: begin
-          repeat
-            Inc(CurX2);
-          until (CurX2 and 7) = 0;
-          Inc(hs);
-        end;
-      else begin
-        Inc(hs);
-        Inc(CurX2);
-      end;
-    end;
-  end;
-  CurX2 := x2;
-  DoErase;
-
-
-  // Draw text line
-
-  RequestedColor := shWhitespace;
-  CurX1 := 0;
-  while s[0] <> #0 do
-    case s[0] of
-      LF_Escape: begin
-          RequestedColor := Ord(s[1]);
-          Inc(s, 2);
-        end;
-      #9: begin
-          repeat
-            Inc(CurX1);
-          until (CurX1 and 7) = 0;
-          Inc(s);
-        end;
-      ' ': begin
-          Inc(s);
-          Inc(CurX1);
-        end;
-      else begin
-        if (CurX1 >= x1) and (CurX1 <= x2) then begin
-          SetGCColor(SHStyles^[RequestedColor].Color);
-          gdk_draw_text(PGdkDrawable(GdkWnd),
-            Font[SHStyles^[RequestedColor].FontStyle], GC,
-            CurX1 * CharW + LeftIndent, (y + 1) * CharH - 3, s, 1);
-        end;
-        Inc(s);
-        Inc(CurX1);
-      end;
-    end;
-end;
-
-
-procedure TGtkSHWidget.SetFocus;
-begin
-  gtk_window_set_focus(PGtkWindow(gtk_widget_get_toplevel(Paintbox)),Paintbox);
-end;
-
-
-procedure TGtkSHWidget.ShowCursor(x, y: Integer);
-begin
-//  writeln('Showcursor ',x,',',y);
-  if assigned(GdkWnd) then
-   begin
-     SetGCColor(colBlack);
-     gdk_draw_rectangle(PGdkDrawable(GdkWnd), GC, 1, x*CharW + LeftIndent, y*CharH, 2, CharH);
-   end;
-end;
-
-
-procedure TGtkSHWidget.HideCursor(x, y: Integer);
-var
-  r : TGdkRectangle;
-begin
-//  writeln('Hidecursor ',x,',',y);
-  r.x := x * CharW + LeftIndent;
-  r.y := y * CharH;
-  r.Width := 2;
-  r.Height := CharH;
-  gtk_widget_draw(PGtkWidget(PaintBox), @r);
-end;
-
-
-function TGtkSHWidget.GetLineWidth: Integer;
-begin
-  Result := (Trunc(hadj^.upper)-LeftIndent) div CharW;
-end;
-
-
-procedure TGtkSHWidget.SetLineWidth(count: Integer);
-begin
-  hadj^.upper := count * CharW + LeftIndent;
-  gtk_adjustment_changed(hadj);
-  gtk_widget_set_usize(PaintBox, Trunc(hadj^.upper), Trunc(vadj^.upper));
-end;
-
-
-function TGtkSHWidget.GetLineCount: Integer;
-begin
-  Result := Trunc(vadj^.upper) div CharH;
-end;
-
-
-procedure TGtkSHWidget.SetLineCount(count: Integer);
-begin
-  vadj^.upper := (count+1) * CharH;
-  gtk_adjustment_changed(vadj);
-  gtk_widget_set_usize(PaintBox, Trunc(hadj^.upper), Trunc(vadj^.upper));
-end;
-
-
-function TGtkSHWidget.GetHorzPos: Integer;
-begin
-  Result := Trunc(hadj^.value);
-  if Result>0 then
-   Result:=(Result-LeftIndent) div CharW;
-end;
-
-
-procedure TGtkSHWidget.SetHorzPos(x: Integer);
-begin
-  if x>0 then
-   x:=x*CharW+LeftIndent;
-  gtk_adjustment_set_value(hadj, x);
-end;
-
-
-function TGtkSHWidget.GetVertPos: Integer;
-begin
-  Result := (Trunc(vadj^.value)+CharH-1) div CharH;
-end;
-
-
-procedure TGtkSHWidget.SetVertPos(y: Integer);
-begin
-  gtk_adjustment_set_value(vadj, y*CharH);
-end;
-
-
-function TGtkSHWidget.GetPageWidth: Integer;
-begin
-  Result := Trunc(hadj^.page_size) div CharW;
-end;
-
-
-function TGtkSHWidget.GetPageHeight: Integer;
-begin
-  Result := Trunc(vadj^.page_size) div CharH;
-end;
-
-end.
-
-{
-  $Log$
-  Revision 1.10  1999-12-30 21:05:08  sg
-  * Lot of renamings
-
-  Revision 1.8  1999/12/22 22:28:08  peter
-    * updates for cursor setting
-    * button press event works
-
-  Revision 1.7  1999/12/12 17:50:50  sg
-  * Fixed drawing of selection
-  * Several small corrections (removed superfluous local variables etc.)
-
-  Revision 1.6  1999/12/10 15:01:02  peter
-    * first things for selection
-    * Better Adjusting of range/cursor
-
-  Revision 1.5  1999/12/09 23:16:41  peter
-    * cursor walking is now possible, both horz and vert ranges are now
-      adapted
-    * filter key modifiers
-    * selection move routines added, but still no correct output to the
-      screen
-
-  Revision 1.4  1999/12/08 01:03:15  peter
-    * changes so redrawing and walking with the cursor finally works
-      correct
-
-  Revision 1.3  1999/12/08 00:42:54  sg
-  * The cursor should be displayed correctly now
-
-  Revision 1.2  1999/12/06 21:27:27  peter
-    * gtk updates, redrawing works now much better and clears only between
-      x1 and x2
-
-  Revision 1.1  1999/11/15 21:47:36  peter
-    * first working keypress things
-
-}

fcl/shedit/keys.inc

@@ -1,589 +0,0 @@
-{
-    $Id$
-
-    "SHEdit" - Text editor with syntax highlighting
-    Copyright (C) 1999  Sebastian Guenther ([email protected])
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-}
-
-
-// TSHTextEdit: Implementation of keyboard handling methods
-
-
-function TSHTextEdit.AddKeyboardAction(AMethod: TKeyboardActionProc;ASelectionAction:TSelectionAction;ADescr: String): TKeyboardActionDescr;
-begin
-  Result := TKeyboardActionDescr(KeyboardActions.Add);
-  Result.Descr := ADescr;
-  Result.Method := AMethod;
-  Result.SelectionAction := ASelectionAction;
-end;
-
-
-function TSHTextEdit.AddKeyboardAssignment(AKeyCode: Integer; AShiftState: TShiftState; AAction: TKeyboardActionDescr): TShortcut;
-begin
-  Result := TShortcut(Shortcuts.Add);
-  Result.KeyCode := AKeyCode;
-  Result.ShiftState := AShiftState;
-  Result.Action := AAction;
-end;
-
-
-procedure TSHTextEdit.AddKeyDef(AMethod: TKeyboardActionProc; ASelectionAction:TSelectionAction; ADescr: String; AKeyCode: Integer; AShiftState: TShiftState);
-begin
-  AddKeyboardAssignment(AKeyCode, AShiftState,AddKeyboardAction(AMethod, ASelectionAction, ADescr));
-end;
-
-
-procedure TSHTextEdit.ToggleOverwriteMode;
-begin
-  OverwriteMode := not OverwriteMode;  // *** specify signal for change
-end;
-
-
-procedure TSHTextEdit.AdjustCursorToRange;
-begin
-  if FCursorY < FWidget.VertPos then begin
-    HideCursor;
-    FCursorY := FWidget.VertPos;
-    ShowCursor;
-  end else if FCursorY > FWidget.VertPos + FWidget.PageHeight then begin
-    HideCursor;
-    FCursorY := FWidget.VertPos + FWidget.PageHeight - 1;
-    ShowCursor;
-  end;
-
-  if FCursorX < FWidget.HorzPos then begin
-    HideCursor;
-    FCursorX := FWidget.HorzPos;
-    ShowCursor;
-  end else if FCursorX > FWidget.HorzPos + FWidget.PageWidth then begin
-    HideCursor;
-    FCursorX := FWidget.HorzPos + FWidget.PageWidth - 1;
-    ShowCursor;
-  end;
-end;
-
-
-procedure TSHTextEdit.AdjustRangeToCursor;
-var
-  py : integer;
-begin
-  if FCursorY < FWidget.VertPos then
-    FWidget.VertPos := FCursorY
-  else if FCursorY >= FWidget.VertPos + FWidget.PageHeight then begin
-    py := FCursorY - FWidget.PageHeight + 1;
-    if py < 0 then
-      FWidget.VertPos:=0
-    else
-      FWidget.VertPos:=py;
-  end;
-  if FCursorX < FWidget.HorzPos then
-    FWidget.HorzPos := FCursorX
-  else if FCursorX >= FWidget.HorzPos + FWidget.PageWidth then begin
-    py := FCursorX - FWidget.PageWidth + 1;
-    if py < 0 then
-      FWidget.HorzPos := 0
-    else
-      FWidget.HorzPos := py;
-  end;
-end;
-
-
-procedure TSHTextEdit.CursorUp;
-begin
-  if FCursorY>0 then
-   dec(FCursorY);
-  AdjustRangeToCursor;
-end;
-
-
-procedure TSHTextEdit.CursorDown;
-begin
-  if FCursorY<FDoc.LineCount-1 then
-   inc(FCursorY);
-  AdjustRangeToCursor;
-end;
-
-
-procedure TSHTextEdit.CursorLeft;
-begin
-  dec(FCursorX);
-  if FCursorX < 0 then
-   begin
-     if FCursorY>0 then
-      begin
-        dec(FCursorY);
-        FCursorX:=FDoc.LineLen[FCursorY];
-      end
-     else
-      FCursorX:=0;
-   end;
-  AdjustRangeToCursor;
-end;
-
-
-procedure TSHTextEdit.CursorRight;
-begin
-  inc(FCursorX);
-  AdjustRangeToCursor;
-end;
-
-
-procedure TSHTextEdit.CursorDocBegin;
-begin
-  FCursorX:=0;
-  FCursorY:=0;
-  AdjustRangeToCursor;
-end;
-
-
-procedure TSHTextEdit.CursorDocEnd;
-begin
-  FCursorY:=FDoc.LineCount-1;
-  FCursorX:=FDoc.LineLen[FCursorY];
-  AdjustRangeToCursor;
-end;
-
-
-procedure TSHTextEdit.CursorHome;
-begin
-  FCursorX:=0;
-  AdjustRangeToCursor;
-end;
-
-
-procedure TSHTextEdit.CursorEnd;
-begin
-  FCursorX:=FDoc.LineLen[FCursorY];
-  AdjustRangeToCursor;
-end;
-
-
-procedure TSHTextEdit.CursorPageUp;
-begin
-  Dec(FCursorY, FWidget.PageHeight);
-  if FCursorY<0 then
-    FCursorY:=0;
-  AdjustRangeToCursor;
-end;
-
-
-procedure TSHTextEdit.CursorPageDown;
-begin
-  Inc(FCursorY, FWidget.PageHeight);
-  if FCursorY > FDoc.LineCount-1 then
-    FCursorY:=FDoc.LineCount-1;
-  AdjustRangeToCursor;
-end;
-
-
-procedure TSHTextEdit.EditDelLeft;
-var
-  s: String;
-begin
-  if FCursorX > 0 then begin
-    s := FDoc.LineText[FCursorY];
-    Dec(FCursorX);
-    AddUndoInfo(TUndoDelLeft.Create(s[FCursorX + 1]), True);
-    s := Copy(s, 1, FCursorX) + Copy(s, FCursorX + 2, Length(s));
-    FDoc.LineText[FCursorY] := s;
-    ChangeInLine(FCursorY);
-  end else if FCursorY > 0 then begin
-    FCursorX := FDoc.LineLen[FCursorY - 1];
-    FDoc.LineText[FCursorY - 1] := FDoc.LineText[FCursorY - 1] +
-      FDoc.LineText[FCursorY];
-    Dec(FCursorY);
-    FDoc.RemoveLine(FCursorY + 1);
-    AddUndoInfo(TUndoDelLeft.Create(#13), True);
-  end;
-end;
-
-procedure TSHTextEdit.EditDelRight;
-var
-  s: String;
-begin
-  if FCursorX < FDoc.LineLen[FCursorY] then begin
-    s := FDoc.LineText[FCursorY];
-    AddUndoInfo(TUndoDelRight.Create(s[FCursorX + 1]), True);
-    s := Copy(s, 1, FCursorX) + Copy(s, FCursorX + 2, Length(s));
-    FDoc.LineText[FCursorY] := s;
-    ChangeInLine(FCursorY);
-  end else if FCursorY < FDoc.LineCount - 1 then begin
-    FDoc.LineText[FCursorY] := FDoc.LineText[FCursorY] +
-      FDoc.LineText[FCursorY + 1];
-    FDoc.RemoveLine(FCursorY + 1);
-    AddUndoInfo(TUndoDelRight.Create(#13), True);
-  end;
-end;
-
-procedure TSHTextEdit.EditDelLine;
-var
-  DeletedText: String;
-begin
-  DeletedText := FDoc.LineText[FCursorY];
-  if FDoc.LineCount = 1 then
-    FDoc.LineText[FCursorY] := ''
-  else
-    FDoc.RemoveLine(FCursorY);
-
-  if FCursorY >= FDoc.LineCount then
-    FCursorY := FDoc.LineCount - 1;
-  FCursorX := 0;
-
-  AddUndoInfo(TUndoDelRight.Create(DeletedText + #13), True);
-
-  ChangeInLine(FCursorY);
-end;
-
-procedure TSHTextEdit.EditUndo;
-var
-  info: TUndoInfo;
-begin
-  if LastUndoInfo = nil then exit;
-
-  info := LastUndoInfo;
-  LastUndoInfo := LastRedoInfo;
-  info.DoUndo(Self);
-  LastRedoInfo := LastUndoInfo;
-  LastUndoInfo := info;
-
-  // Free undo info
-  if info.Prev <> nil then
-    info.Prev.Next := info.Next
-  else
-    FDoc.Modified := False;
-  LastUndoInfo := info.Prev;
-  info.Free;
-end;
-
-procedure TSHTextEdit.EditRedo;
-var
-  info: TUndoInfo;
-begin
-  if LastRedoInfo = nil then exit;
-
-  info := LastRedoInfo;
-  info.DoUndo(Self);
-
-  // Free redo info
-  if info.Prev <> nil then
-    info.Prev.Next := info.Next;
-  LastRedoInfo := info.Prev;
-  info.Free;
-end;
-
-procedure TSHTextEdit.ClipboardCut;
-begin
-  WriteLn('ClipboardCut: Not implemented yet');
-  ClipboardCopy;
-end;
-
-procedure TSHTextEdit.ClipboardCopy;
-var
-  cbtext: String;
-  y: Integer;
-begin
-  if FSel.OStartY = FSel.OEndY then
-    cbtext := Copy(FDoc.LineText[FSel.OStartY], FSel.OStartX + 1, FSel.OEndX - FSel.OStartX)
-  else begin
-    cbtext := Copy(FDoc.LineText[FSel.OStartY], FSel.OStartX + 1,
-      FDoc.LineLen[FSel.OStartY]) + #10;
-    for y := FSel.OStartY + 1 to FSel.OEndY - 1 do
-      cbtext := cbtext + FDoc.LineText[y] + #10;
-    cbtext := cbtext + Copy(FDoc.LineText[FSel.OEndY], 1, FSel.OEndX);
-  end;
-
-  FWidget.SetClipboard(cbtext);
-end;
-
-procedure TSHTextEdit.ClipboardPaste;
-var
-  cbtext: String;
-begin
-  cbtext := FWidget.GetClipboard;
-  ExecKeys(cbtext, True);
-end;
-
-procedure TSHTextEdit.KeyReturn; begin end;
-
-function TSHTextEdit.ExecKey(Key: Char; BlockMode: Boolean): Boolean;
-var
-  s, s2: String;
-  i: Integer;
-begin
-  Result := True;
-  case Key of
-    #9: begin
-        s := FDoc.LineText[FCursorY];
-        s2 := ' ';
-        i := 1;
-        while ((FCursorX + i) mod 4) <> 0 do begin
-          s2 := s2 + ' ';
-          Inc(i);
-        end;
-        s := Copy(s, 1, FCursorX) + s2 + Copy(s, FCursorX + 1, Length(s));
-        FDoc.LineText[FCursorY] := s;
-        Inc(FCursorX, i);
-        AddUndoInfo(TUndoEdit.Create(i), True);
-        ChangeInLine(FCursorY);
-      end;
-    #13: begin
-        s := FDoc.LineText[FCursorY];
-        FDoc.LineText[FCursorY] := Copy(s, 1, FCursorX);
-        FDoc.InsertLine(FCursorY + 1, Copy(s, FCursorX + 1, Length(s)));
-        CursorX := 0;
-        Inc(FCursorY);
-        AddUndoInfo(TUndoEdit.Create, True);
-        if not BlockMode then KeyReturn;
-      end;
-    #32..#255:
-      begin
-        s := FDoc.LineText[FCursorY];
-        if FCursorX>=Length(s) then
-          s := s + Space(FCursorX-length(s)) + Key
-        else
-          if OverwriteMode then
-            s := Copy(s, 1, FCursorX) + Key + Copy(s, FCursorX + 2, Length(s))
-          else
-            s := Copy(s, 1, FCursorX) + Key + Copy(s, FCursorX + 1, Length(s));
-        FDoc.LineText[FCursorY] := s;
-        Inc(FCursorX);
-        AddUndoInfo(TUndoEdit.Create, True);
-        ChangeInLine(FCursorY);
-      end;
-    else Result := False;
-  end;
-end;
-
-procedure TSHTextEdit.ExecKeys(Keys: String; BlockMode: Boolean);
-var
-  s, s2: String;
-  KeysPos, i: Integer;
-  Key: Char;
-begin
-  if BlockMode then
-    AddUndoInfo(TUndoEdit.Create(0), False);  // Initialize new undo block
-
-  KeysPos := 1;
-  while KeysPos <= Length(Keys) do begin
-    case Keys[KeysPos] of
-      #9: begin
-          s := FDoc.LineText[FCursorY];
-          s2 := ' ';
-          i := 1;
-          while ((FCursorX + i) mod 4) <> 0 do begin
-            s2 := s2 + ' ';
-            Inc(i);
-          end;
-          s := Copy(s, 1, FCursorX) + s2 + Copy(s, FCursorX + 1, Length(s));
-          FDoc.LineText[FCursorY] := s;
-          Inc(FCursorX, i);
-          AddUndoInfo(TUndoEdit.Create(i), True);
-          ChangeInLine(FCursorY);
-          Inc(KeysPos);
-        end;
-      #13, #10: begin
-          s := FDoc.LineText[FCursorY];
-          FDoc.LineText[FCursorY] := Copy(s, 1, FCursorX);
-          FDoc.InsertLine(FCursorY + 1, Copy(s, FCursorX + 1, Length(s)));
-          CursorX := 0;
-          Inc(FCursorY);
-          AddUndoInfo(TUndoEdit.Create, True);
-          if not BlockMode then KeyReturn;
-          Inc(KeysPos);
-        end;
-      #32..#255: begin
-          i := 0;
-          while (KeysPos <= Length(Keys)) and (Keys[KeysPos] >= #32) do begin
-            Key := Keys[KeysPos];
-            s := FDoc.LineText[FCursorY];
-            if FCursorX>=Length(s) then
-             s := s + Space(FCursorX-length(s)) + Key
-            else
-             s := Copy(s, 1, FCursorX) + Key + Copy(s, FCursorX + 1 + Ord(OverwriteMode), Length(s));
-            FDoc.LineText[FCursorY] := s;
-            Inc(FCursorX);
-            Inc(i);
-            Inc(KeysPos);
-          end;
-          AddUndoInfo(TUndoEdit.Create(i), True);
-
-          ChangeInLine(FCursorY);
-        end;
-      else Inc(KeysPos);
-    end;
-  end;
-end;
-
-procedure TSHTextEdit.MultiDelLeft(count: Integer);
-var
-  s: String;
-begin
-  while count > 0 do begin
-    if FCursorX > 0 then begin
-      while (FCursorX > 0) and (count > 0) do begin
-        s := FDoc.LineText[FCursorY];
-        Dec(FCursorX);
-        AddUndoInfo(TUndoDelLeft.Create(s[FCursorX + 1]), True);
-        s := Copy(s, 1, FCursorX) + Copy(s, FCursorX + 2, Length(s));
-        FDoc.LineText[FCursorY] := s;
-        Dec(count);
-      end;
-      ChangeInLine(FCursorY);
-    end else if FCursorY > 0 then begin
-      FCursorX := FDoc.LineLen[FCursorY - 1];
-      FDoc.LineText[FCursorY - 1] := FDoc.LineText[FCursorY - 1] +
-        FDoc.LineText[FCursorY];
-      Dec(FCursorY);
-      FDoc.RemoveLine(FCursorY + 1);
-      AddUndoInfo(TUndoDelLeft.Create(#13), True);
-      Dec(count);
-    end else break;
-  end;
-end;
-
-procedure TSHTextEdit.KeyPressed(KeyCode: LongWord; ShiftState: TShiftState);
-
-  procedure RedrawArea(x1, y1, x2, y2: Integer);
-  begin
-    // WriteLn('Redraw: ', x1, '/', y1, ' - ', x2, '/', y2);
-    if y1 = y2 then
-      FWidget.InvalidateRect(x1, y1, x2, y2)
-    else begin
-      FWidget.InvalidateRect(x1, y1, x1 + FWidget.PageWidth, y1);
-      if y1 < y2 - 1 then
-        FWidget.InvalidateRect(0, y1+1, FWidget.PageWidth, y2 - 1);
-      FWidget.InvalidateRect(0, y2, x2, y2+1);
-    end;
-  end;
-
-var
-  i: Integer;
-  shortcut: TShortcut;
-  ShortcutFound, OldSelValid: Boolean;
-  OldSelStartX, OldSelStartY, OldSelEndX, OldSelEndY: Integer;
-begin
-  //  WriteLn('TSHTextEdit: Key pressed: ', KeyCode);
-  HideCursor;
-
-  LastCursorX := FCursorX;
-  LastCursorY := FCursorY;
-  OldSelValid := FSel.IsValid;
-  if OldSelValid then begin
-    OldSelStartX := FSel.OStartX;
-    OldSelStartY := FSel.OStartY;
-    OldSelEndX := FSel.OEndX;
-    OldSelEndY := FSel.OEndY;
-  end;
-
-  // Check for keyboard shortcuts
-  ShortcutFound := False;
-  for i := 0 to Shortcuts.Count - 1 do begin
-    shortcut := TShortcut(Shortcuts.Items[i]);
-    if (KeyCode = shortcut.KeyCode) and
-       (ShiftState * [ssShift, ssCtrl, ssAlt] = shortcut.ShiftState) then begin
-      ShortcutFound := True;
-      break;
-    end;
-  end;
-
-  if ShortcutFound then begin
-    // WriteLn(shortcut.Action.Descr);
-    shortcut.Action.Method;	// Execute associated action
-    // Handle the selection extending
-    case shortcut.Action.SelectionAction of
-      selNothing: ;
-      selExtend: begin
-          if not FSel.IsValid then begin
-            FSel.StartX:=LastCursorX;
-            FSel.StartY:=LastCursorY;
-          end;
-          FSel.EndX:=FCursorX;
-          FSel.EndY:=FCursorY;
-        end;
-      selClear:
-        FSel.Clear;
-    end;
-  end else
-    if (KeyCode <= 255) and (ShiftState * [ssCtrl, ssAlt] = []) then
-      ExecKey(Chr(KeyCode), False);
-
-  // Check selection
-  if FSel.IsValid and (FSel.StartX = FSel.EndX) and (FSel.StartY = FSel.EndY) then
-    FSel.Clear;
-
-  {Write('Sel = ', FSel.StartX, '/', FSel.StartY, ' - ', FSel.EndX, '/', FSel.EndY);
-  if OldSelValid then WriteLn('  Old = ', OldSelStartX, '/', OldSelStartY, ' - ', OldSelEndX, '/', OldSelEndY)
-  else WriteLn;}
-
-  // Handle the rewriting of selections
-  if not OldSelValid then begin
-    if FSel.IsValid then
-      RedrawArea(FSel.OStartX, FSel.OStartY, FSel.OEndX, FSel.OEndY);
-  end else begin
-    if not FSel.IsValid then
-      RedrawArea(OldSelStartX, OldSelStartY, OldSelEndX, OldSelEndY)
-    else begin
-      // Do OldSel and FSel intersect?
-      if (OldSelEndY < FSel.OStartY) or (OldSelStartY > FSel.OEndY) or
-         ((OldSelEndY = FSel.OStartY) and (OldSelEndX <= FSel.OStartX)) or
-         ((OldSelStartY = FSel.OEndY) and (OldSelStartX >= FSel.OEndX)) then
-      begin
-        RedrawArea(OldSelStartX, OldSelStartY, OldSelEndX, OldSelEndY);
-        RedrawArea(FSel.OStartX, FSel.OStartY, FSel.OEndX, FSel.OEndY);
-      end else begin
-        // Intersection => determine smallest possible area(s) to redraw
-        // 1. Check if the start position has changed
-        if (OldSelStartX <> FSel.OStartX) or (OldSelStartY <> FSel.OStartY) then
-          if (OldSelStartY < FSel.OStartY) or ((OldSelStartY = FSel.OStartY) and
-             (OldSelStartX < FSel.OStartX)) then
-            RedrawArea(OldSelStartX, OldSelStartY, FSel.OStartX, FSel.OStartY)
-          else
-            RedrawArea(FSel.OStartX, FSel.OStartY, OldSelStartX, OldSelStartY);
-          // 2. Check if end position has changed
-          if (OldSelEndX <> FSel.OEndX) or (OldSelEndY <> FSel.OEndY) then
-            if (OldSelEndY < FSel.OEndY) or ((OldSelEndY = FSel.OEndY) and
-               (OldSelEndX < FSel.OEndX)) then
-              RedrawArea(OldSelEndX, OldSelEndY, FSel.OEndX, FSel.OEndY)
-            else
-              RedrawArea(FSel.OEndX, FSel.OEndY, OldSelEndX, OldSelEndY);
-      end;
-    end;
-  end;
-  ShowCursor;
-end;
-
-
-{
-  $Log$
-  Revision 1.7  1999-12-30 21:10:24  sg
-  * Fixed some keyboard issues
-
-  Revision 1.5  1999/12/10 15:01:02  peter
-    * first things for selection
-    * Better Adjusting of range/cursor
-
-  Revision 1.4  1999/12/09 23:16:41  peter
-    * cursor walking is now possible, both horz and vert ranges are now
-      adapted
-    * filter key modifiers
-    * selection move routines added, but still no correct output to the
-      screen
-
-  Revision 1.3  1999/12/08 01:03:15  peter
-    * changes so redrawing and walking with the cursor finally works
-      correct
-
-  Revision 1.2  1999/11/15 21:47:36  peter
-    * first working keypress things
-
-  Revision 1.1  1999/10/29 15:59:04  peter
-    * inserted in fcl
-
-}

fcl/shedit/sh_pas.pp

@@ -1,322 +0,0 @@
-{
-    $Id$
-
-    "SHEdit" - Text editor with syntax highlighting
-    Copyright (C) 1999  Sebastian Guenther ([email protected])
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-}
-
-
-// viewer class for Pascal source
-
-{$MODE objfpc}
-{$H+}
-
-unit sh_pas;
-
-interface
-uses doc_text, shedit;
-
-type
-
-  TSHPasEdit = class(TSHTextEdit)
-  protected
-    procedure DoHighlighting(var flags: Byte; source, dest: PChar); override;
-    procedure KeyReturn; override;
-  public
-    // Syntax highlighter style indices
-    shSymbol, shKeyword, shComment, shDirective, shNumbers, shCharacters,
-      shStrings, shAssembler: Integer;
-  end;
-
-
-implementation
-
-uses Strings;
-
-const
-
-  LF_SH_Comment1 = LF_SH_Multiline1;
-  LF_SH_Comment2 = LF_SH_Multiline2;    { (* Comments}
-  LF_SH_Asm      = LF_SH_Multiline3;
-
-  MaxKeywordLength = 15;
-  MaxKeyword = 61;
-
-  KeywordTable: array[0..MaxKeyword] of PChar =
-    ('AND', 'ARRAY', 'ASM', 'ASSEMBLER',
-     'BEGIN', 'BREAK',
-     'CASE', 'CONST', 'CONSTRUCTOR', 'CLASS',
-     'DEFAULT', 'DESTRUCTOR', 'DIV', 'DO', 'DOWNTO',
-     'ELSE', 'END', 'EXCEPT', 'EXIT',
-     'FINALIZATION', 'FINALLY', 'FOR', 'FUNCTION',
-     'GOTO',
-     'IF', 'IMPLEMENTATION', 'IN', 'INHERITED', 'INITIALIZATION', 'INTERFACE',
-     'NOT',
-     'OBJECT', 'OF', 'ON', 'OR', 'OVERRIDE',
-     'PACKED', 'PRIVATE', 'PROCEDURE', 'PROGRAM', 'PROPERTY', 'PROTECTED',
-       'PUBLIC', 'PUBLISHED',
-     'RAISE', 'READ', 'RECORD', 'REPEAT', 'RESOURCESTRING',
-     'SET',
-     'THEN', 'TRY', 'TYPE',
-     'UNIT', 'UNTIL', 'USES',
-     'VAR', 'VIRTUAL',
-     'WHILE', 'WITH', 'WRITE',
-     'XOR');
-
-  KeywordAsmIndex = 2;
-
-
-procedure TSHPasEdit.KeyReturn;
-var
-  s: String;
-  i, count: Integer;
-begin
-  // Get # of spaces in front of previous line
-  s := FDoc.LineText[CursorY - 1];
-  i := 1; count := 0;
-  while (i <= Length(s)) and (s[i] = ' ') do begin
-    Inc(i);
-    Inc(count);
-  end;
-
-  FDoc.LineText[CursorY] := Copy(s, 1, count) + FDoc.LineText[CursorY];
-  Inc(FCursorX, count);
-  AddUndoInfo(TUndoEdit.Create(count), True);
-  ChangeInLine(CursorY);
-end;
-
-
-procedure TSHPasEdit.DoHighlighting(var flags: Byte; source, dest: PChar);
-var
-  dp: Integer;    {Destination postion - current offset in dest}
-  LastSHPos: Integer; {Position of last highlighting character, or 0}
-
-  procedure AddSH(sh: Byte);
-  begin
-    if (LastSHPos > 0) and (dp = LastSHPos + 1) then Dec(dp, 2);
-    dest[dp] := LF_Escape; Inc(dp);
-    LastSHPos := dp;
-    dest[dp] := Chr(sh); Inc(dp);
-  end;
-
-  procedure PutChar;
-  begin
-    dest[dp] := source[0]; Inc(dp); Inc(source);
-  end;
-
-  procedure ProcessComment1;
-  begin
-    while source[0] <> #0 do begin
-      if source[0] = '}' then begin
-        PutChar;
-        flags := flags and not LF_SH_Comment1;
-        AddSH(shDefault);
-        break;
-      end;
-      PutChar;
-    end;
-  end;
-
-  procedure ProcessComment2;
-  begin
-    while source[0] <> #0 do begin
-      if (source[0] = '*') and (source[1] = ')') then begin
-        PutChar; PutChar;
-        flags := flags and not LF_SH_Comment2;
-        AddSH(shDefault);
-        break;
-      end;
-      PutChar;
-    end;
-  end;
-
-
-  { Checks if we are at the beginning of a comment (or directive) and processes
-    all types of comments and directives, or returns False }
-
-  function CheckForComment: Boolean;
-  begin
-    Result := True;
-    if source[0] = '{' then begin
-      if source[1] = '$' then
-        AddSH(shDirective)
-      else
-        AddSH(shComment);
-      PutChar;
-      flags := flags or LF_SH_Comment1;
-      ProcessComment1;
-    end else if (source[0] = '(') and (source[1] = '*') then begin
-      AddSH(shComment);
-      PutChar; PutChar;
-      flags := flags or LF_SH_Comment2;
-      ProcessComment2;
-    end else if (source[0] = '/') and (source[1] = '/') then begin
-      AddSH(shComment);
-      repeat PutChar until source[0] = #0;
-      AddSH(shDefault);
-    end else
-      Result := False;
-  end;
-
-  procedure ProcessAsm;
-  var
-    LastChar: Char;
-  begin
-    LastChar := ' ';
-    while source[0] <> #0 do begin
-      if (LastChar in [' ', #9, #10, #13]) and
-        (UpCase(source[0]) = 'E') and (UpCase(source[1]) = 'N') and
-        (UpCase(source[2]) = 'D') then begin
-        AddSH(shKeyword);
-        PutChar; PutChar; PutChar;
-        flags := flags and not LF_SH_Asm;
-        AddSH(shDefault);
-        break;
-      end else
-  if CheckForComment then LastChar := ' '
-        else begin
-          LastChar := source[0];
-          PutChar;
-        end;
-    end;
-  end;
-
-  procedure ProcessSymbol;
-  begin
-    AddSH(shSymbol);
-    if (source[0] = ':') and (source[1] = '=') then
-      PutChar;
-    PutChar;
-    AddSH(shDefault);
-  end;
-
-  function CheckForKeyword: Boolean;
-  var
-    keyword, ukeyword: array[0..MaxKeywordLength] of Char;
-    i, j: Integer;
-  begin
-    i := 0;
-    while (source[i] <> #0) and (i < MaxKeywordLength) and
-      (source[i] in ['0'..'9', 'A'..'Z', 'a'..'z']) do begin
-      keyword[i] := source[i];
-      ukeyword[i] := UpCase(source[i]);
-      Inc(i);
-    end;
-    keyword[i] := #0; ukeyword[i] := #0;
-    Result := False;
-    if i < MaxKeywordLength then
-      for j := 0 to MaxKeyword do
-        if StrIComp(KeywordTable[j], ukeyword) = 0 then begin
-          Result := True; break;
-        end;
-    if not Result then exit;
-    Inc(source, i);
-    AddSH(shKeyword);
-    StrCopy(dest + dp, keyword);
-    Inc(dp, i);
-    if j <> KeywordAsmIndex then
-      AddSH(shDefault)
-    else begin
-      AddSH(shAssembler);
-      flags := flags or LF_SH_Asm;
-      ProcessAsm;
-    end;
-  end;
-
-var
-  StringLength: Integer;
-begin
-  dp := 0;
-  LastSHPos := 0;
-
-  if (flags and LF_SH_Comment1) <> 0 then begin
-    AddSH(shComment);
-    ProcessComment1;
-  end;
-
-  if (flags and LF_SH_Comment2) <> 0 then begin
-    AddSH(shComment);
-    ProcessComment2;
-  end;
-
-  if (flags and LF_SH_Asm) <> 0 then begin
-    AddSH(shAssembler);
-    ProcessAsm;
-  end;
-
-  while source[0] <> #0 do begin
-
-    if CheckForComment then continue;
-
-    case source[0] of
-      ',', ';', ':', '.', '(', ')', '[', ']', '<', '>', '=',
-      '*', '/', '+', '-', '^', '&', '@': ProcessSymbol;
-      '#': begin
-          AddSH(shCharacters);
-          PutChar;
-          if source[0] = '$' then PutChar;
-          while (source[0] >= '0') and (source[0] <= '9') do PutChar;
-          AddSH(shDefault);
-        end;
-      '$': begin
-          AddSH(shNumbers);
-          PutChar;
-          while source[0] in ['0'..'9', 'A'..'F', 'a'..'f'] do PutChar;
-          AddSH(shDefault);
-        end;
-      '0'..'9': begin
-          AddSH(shNumbers);
-          PutChar;
-          while (source[0] >= '0') and (source[0] <= '9') do PutChar;
-          AddSH(shDefault);
-        end;
-      '''': begin
-          AddSH(shStrings);
-          PutChar;
-          StringLength := 0;
-          while source[0] <> #0  do begin
-            if source[0] = '''' then
-              if source[1] = '''' then PutChar
-              else begin
-                PutChar; break;
-              end;
-            Inc(StringLength);
-            PutChar;
-          end;
-          if StringLength = 1 then
-            dest[LastSHPos] := Chr(shCharacters);
-          AddSH(shDefault);
-        end;
-      '_', 'A'..'Z', 'a'..'z':
-        if not CheckForKeyword then
-          repeat
-            PutChar
-          until not (source[0] in ['0'..'9', '_', 'A'..'Z', 'a'..'z']);
-      else
-        PutChar;  // = found an invalid char!
-    end;
-  end;
-
-  dest[dp] := #0;
-end;
-
-
-end.
-
-
-{
-  $Log$
-  Revision 1.2  1999-12-30 21:11:34  sg
-  * Shortened copyright notice
-
-  Revision 1.1  1999/10/29 15:59:04  peter
-    * inserted in fcl
-
-}

fcl/shedit/sh_xml.pp

@@ -1,252 +0,0 @@
-{
-    $Id$
-
-    "SHEdit" - Text editor with syntax highlighting
-    Copyright (C) 1999  Sebastian Guenther ([email protected])
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-}
-
-
-// viewer class for XML files
-
-{$MODE objfpc}
-{$H+}
-
-unit sh_xml;
-
-interface
-uses doc_text, shedit;
-
-type
-
-  TSHXMLEdit = class(TSHTextEdit)
-  protected
-    procedure DoHighlighting(var flags: Byte; source, dest: PChar); override;
-  public
-    // Syntax highlighter style indices
-    shTag, shTagName, shDefTagName, shArgName, shString, shReference,
-      shInvalid, shComment, shCDATA: Integer;
-  end;
-
-
-implementation
-
-uses Strings;
-
-const
-
-  LF_SH_Tag     = LF_SH_Multiline1;
-  LF_SH_Comment = LF_SH_Multiline2;
-  LF_SH_String1 = LF_SH_Multiline3;     // Single quotation mark
-  LF_SH_String2 = LF_SH_Multiline4;     // Double quotation mark
-  LF_SH_CDATA   = LF_SH_Multiline5;
-
-
-procedure TSHXMLEdit.DoHighlighting(var flags: Byte; source, dest: PChar);
-var
-  dp: Integer;    {Destination postion - current offset in dest}
-  LastSHPos: Integer; {Position of last highlighting character, or 0}
-
-  procedure AddSH(sh: Byte);
-  begin
-    if (LastSHPos > 0) and (dp = LastSHPos + 1) then Dec(dp, 2);
-    dest[dp] := LF_Escape; Inc(dp);
-    LastSHPos := dp;
-    dest[dp] := Chr(sh); Inc(dp);
-  end;
-
-  procedure PutChar;
-  begin
-    dest[dp] := source[0]; Inc(dp); Inc(source);
-  end;
-
-  procedure ProcessComment;
-  begin
-    flags := flags or LF_SH_Comment;
-    AddSH(shComment);
-    while source[0] <> #0 do begin
-      if (source[0] = '-') and (source[1] = '-') and (source[2] = '>') then begin
-        PutChar; PutChar; PutChar;
-        flags := flags and not LF_SH_Comment;
-        AddSH(shDefault);
-        break;
-      end;
-      PutChar;
-    end;
-  end;
-
-  procedure ProcessReference;
-  begin
-    AddSH(shReference);
-    while source[0] <> #0 do begin
-      if source[0] = ';' then begin
-        PutChar;
-        AddSH(shDefault);
-        break;
-      end else if (source[0] = '''') or (source[0] = '"') then begin
-        AddSH(shString);
-        break;
-      end else
-        PutChar;
-    end;
-  end;
-
-  procedure ProcessString(EndChar: Char);
-  begin
-    while source[0] <> #0 do begin
-      if source[0] = EndChar then begin
-        PutChar;
-        AddSH(shDefault);
-        flags := flags and not (LF_SH_String1 or LF_SH_String2);
-        break;
-      end else if source[0] = '&' then
-        ProcessReference
-      else
-        PutChar;
-    end;
-  end;
-
-  procedure ProcessTagContd;
-  var
-    c: Char;
-  begin
-    while source[0] <> #0 do begin
-      if (source[0] in ['/', '?']) and (source[1] = '>') then begin
-        AddSH(shTag);
-        PutChar;
-        PutChar;
-        AddSH(shDefault);
-        flags := flags and not LF_SH_Tag;
-        break;
-      end else if (source[0] = '>') then begin
-        AddSH(shTag);
-        PutChar;
-        AddSH(shDefault);
-        flags := flags and not LF_SH_Tag;
-        break;
-      end else if (source[0] = '''') or (source[0] = '"') then begin
-        c := source[0];
-        if source[0] = '''' then
-          flags := flags or LF_SH_String1
-        else
-          flags := flags or LF_SH_String2;
-        AddSH(shString);
-        PutChar;
-        ProcessString(c);
-      end else if source[0] in [#9, ' ', '=', '(', ')', '+', '*', '?', ','] then begin
-        AddSH(shDefault);
-        PutChar;
-      end else begin
-        AddSH(shArgName);
-        PutChar;
-      end;
-    end;
-  end;
-
-  procedure ProcessTag;
-  begin
-    flags := flags or LF_SH_Tag;
-    AddSH(shTag);
-    PutChar;
-    if source[0] = '/' then PutChar;
-    if (source[0] = '!') or (source[0] = '?') then
-      AddSH(shDefTagName)
-    else
-      AddSH(shTagName);
-    while not (source[0] in [#0, ' ', '/', '>']) do
-      PutChar;
-    AddSH(shDefault);
-    ProcessTagContd;
-  end;
-
-  procedure ProcessCDATAContd;
-  begin
-    AddSH(shCDATA);
-    while source[0] <> #0 do begin
-      if (source[0] = ']') and (source[1] = ']') and
-         (source[2] = '>') then begin
-        AddSH(shTag);
-        PutChar; PutChar; PutChar;
-        AddSH(shDefault);
-        flags := flags and not LF_SH_CDATA;
-        break;
-      end;
-      PutChar;
-    end;
-  end;
-
-  procedure ProcessCDATA;
-  var
-    i: Integer;
-  begin
-    flags := flags or LF_SH_CDATA;
-    AddSH(shTag);
-    for i := 1 to 9 do PutChar;
-    ProcessCDATAContd;
-  end;
-
-begin
-  dp := 0;
-  LastSHPos := 0;
-
-  if (flags and LF_SH_Comment) <> 0 then begin
-    AddSH(shComment);
-    ProcessComment;
-  end;
-
-  if (flags and LF_SH_String1) <> 0 then begin
-    AddSH(shString);
-    ProcessString('''');
-  end;
-  if (flags and LF_SH_String2) <> 0 then begin
-    AddSH(shString);
-    ProcessString('"');
-  end;
-
-  if (flags and LF_SH_Tag) <> 0 then
-    ProcessTagContd;
-
-  if (flags and LF_SH_CDATA) <> 0 then
-    ProcessCDATAContd;
-
-
-  while source[0] <> #0 do begin
-
-    case source[0] of
-      '<':
-          if (source[1] = '!') and (source[2] = '-') and (source[3] = '-') then
-            ProcessComment
-          else if (source[1] = '!') and (source[2] = '[') and (source[3] = 'C')
-            and (source[4] = 'D') and (source[5] = 'A') and (source[6] = 'T')
-            and (source[7] = 'A') and (source[8] = '[') then
-            ProcessCDATA
-          else
-            ProcessTag;
-      '&': ProcessReference;
-      else
-        PutChar;
-    end;
-  end;
-
-  dest[dp] := #0;
-end;
-
-
-end.
-
-
-{
-  $Log$
-  Revision 1.2  1999-12-30 21:11:34  sg
-  * Shortened copyright notice
-
-  Revision 1.1  1999/10/29 15:59:04  peter
-    * inserted in fcl
-
-}

fcl/shedit/shedit.pp

@@ -1,434 +0,0 @@
-{
-    $Id$
-
-    "SHEdit" - Text editor with syntax highlighting
-    Copyright (C) 1999  Sebastian Guenther ([email protected])
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-}
-
-// ===================================================================
-//   Generic text editor widget with syntax highlighting capabilities
-// ===================================================================
-
-{$MODE objfpc}
-{$H+}
-
-unit shedit;
-
-interface
-
-uses
-  Classes, doc_text;
-
-type
-
-  TSHTextEdit = class;
-  TSHTextEditClass = class of TSHTextEdit;
-
-
-// -------------------------------------------------------------------
-//   Keyboard/action assignment handling
-// -------------------------------------------------------------------
-
-  TKeyboardActionProc = procedure of object;
-
-  TSelectionAction = (selNothing,selExtend,selClear);
-
-  TKeyboardActionDescr = class(TCollectionItem)
-  public
-    Descr: String;                      // Human readable description
-    Method: TKeyboardActionProc;
-    SelectionAction : TSelectionAction;
-  end;
-
-  TShortcut = class(TCollectionItem)
-  public
-    KeyCode: Integer;
-    ShiftState: TShiftState;
-    Action: TKeyboardActionDescr;
-  end;
-
-
-// -------------------------------------------------------------------
-//   Undo/redo buffer stuff
-// -------------------------------------------------------------------
-
-  TUndoInfo = class;
-  TUndoInfo = class
-    Prev, Next: TUndoInfo;
-    CursorX, CursorY: Integer;
-    function Merge(AEdit: TSHTextEdit; AInfo: TUndoInfo): Boolean; virtual;
-    procedure DoUndo(AEdit: TSHTextEdit); virtual; abstract;
-  end;
-
-  TUndoEdit = class(TUndoInfo)
-    NumOfChars: Integer;
-    constructor Create;
-    constructor Create(ANumOfChars: Integer);
-    function Merge(AEdit: TSHTextEdit; AInfo: TUndoInfo): Boolean; override;
-    procedure DoUndo(AEdit: TSHTextEdit); override;
-  end;
-
-  TUndoDelLeft = class(TUndoInfo)
-    DeletedString: String;
-    constructor Create(const ADeletedString: String);
-    function Merge(AEdit: TSHTextEdit; AInfo: TUndoInfo): Boolean; override;
-    procedure DoUndo(AEdit: TSHTextEdit); override;
-  end;
-
-  TUndoDelRight = class(TUndoDelLeft)
-    procedure DoUndo(AEdit: TSHTextEdit); override;
-  end;
-
-
-// -------------------------------------------------------------------
-//   Selection support
-// -------------------------------------------------------------------
-
-  TSelection = class
-  public
-    constructor Create;
-    procedure Clear;
-
-    StartX, StartY, EndX, EndY: Integer;
-
-    function IsValid: Boolean;
-    // Ordered coordinates: swaps start and end if necessary
-    function OStartX: Integer;
-    function OStartY: Integer;
-    function OEndX: Integer;
-    function OEndY: Integer;
-  end;
-
-
-// -------------------------------------------------------------------
-//   SHWidget interface
-// -------------------------------------------------------------------
-
-  ISHWidget = class
-    // Drawing
-    procedure InvalidateRect(x1, y1, x2, y2: Integer); virtual; abstract;
-    procedure InvalidateLines(y1, y2: Integer); virtual; abstract;
-    procedure ClearRect(x1, y1, x2, y2: Integer); virtual; abstract;
-    procedure DrawTextLine(x1, x2, y: Integer; s: PChar); virtual; abstract;
-
-    // Cursor placement
-    procedure ShowCursor(x, y: Integer); virtual; abstract;
-    procedure HideCursor(x, y: Integer); virtual; abstract;
-
-    // Scrolling support
-    function  GetHorzPos: Integer; virtual; abstract;
-    procedure SetHorzPos(x: Integer); virtual; abstract;
-    function  GetVertPos: Integer; virtual; abstract;
-    procedure SetVertPos(y: Integer); virtual; abstract;
-    function  GetPageWidth: Integer; virtual; abstract;
-    function  GetPageHeight: Integer; virtual; abstract;
-    function  GetLineWidth: Integer; virtual; abstract;
-    procedure SetLineWidth(count: Integer); virtual; abstract;
-    function  GetLineCount: Integer; virtual; abstract;
-    procedure SetLineCount(count: Integer); virtual; abstract;
-
-    // Clipboard support
-    function  GetClipboard: String; virtual; abstract;
-    procedure SetClipboard(Content: String); virtual; abstract;
-
-
-    property  HorzPos: Integer read GetHorzPos write SetHorzPos;
-    property  VertPos: Integer read GetVertPos write SetVertPos;
-    property  PageWidth: Integer read GetPageWidth;
-    property  PageHeight: Integer read GetPageHeight;
-    property  LineWidth: Integer read GetLineWidth write SetLineWidth;
-    property  LineCount: Integer read GetLineCount write SetLineCount;
-    property  Clipboard: String read GetClipboard write SetClipboard;
-  end;
-
-
-// -------------------------------------------------------------------
-//   SHTextEdit: The main editor class
-// -------------------------------------------------------------------
-
-  TShortcutEvent = procedure of object;
-
-
-  TSHTextEdit = class
-  protected
-    // ===== Internally used stuff
-    ViewInfo: TViewInfo;                // Connection to document
-    CursorVisible: Integer;
-    OverwriteMode: Boolean;
-    LastUndoInfo, LastRedoInfo: TUndoInfo;      // tails of double linked lists
-
-    FSel: TSelection;
-
-    // OnKeyPressed saves the cursor position before calling key handlers
-    LastCursorX, LastCursorY: Integer;
-
-
-    function  CalcSHFlags(FlagsIn: Byte; source: String): Byte;
-    procedure HideCursor;
-    procedure ShowCursor;
-    procedure ChangeInLine(line: Integer);  // Redraws screen where necessary
-    procedure AddUndoInfo(AInfo: TUndoInfo; CanMerge: Boolean);
-
-    // The default implementation does not perform any syntax highlighting:
-    procedure DoHighlighting(var flags: Byte; source, dest: PChar); virtual;
-
-    // ===== Properties
-
-    FDoc: TTextDoc;                     // Document object for text
-    FCursorX, FCursorY: Integer;        // 0/0 = upper left corner
-    FOnModifiedChange: TNotifyEvent;
-    FWidget: ISHWidget;
-
-    procedure SetCursorX(NewCursorX: Integer);
-    procedure SetCursorY(NewCursorY: Integer);
-
-    procedure ModifiedChanged(Sender: TObject);
-    procedure LineInserted(Sender: TTextDoc; Line: Integer); virtual;
-    procedure LineRemoved(Sender: TTextDoc; Line: Integer); virtual;
-
-    function  ExecKey(Key: Char; BlockMode: Boolean): Boolean;
-    procedure ExecKeys(Keys: String; BlockMode: Boolean);
-    procedure MultiDelLeft(Count: Integer);
-
-  public
-    // Keyboard command handlers
-    // Cursor movement
-    procedure AdjustCursorToRange;
-    procedure AdjustRangeToCursor;
-    procedure CursorUp;
-    procedure CursorDown;
-    procedure CursorLeft;
-    procedure CursorRight;
-    procedure CursorHome;
-    procedure CursorEnd;
-    procedure CursorDocBegin;
-    procedure CursorDocEnd;
-    procedure CursorPageUp;
-    procedure CursorPageDown;
-
-    // Misc
-    procedure ToggleOverwriteMode;
-    procedure EditDelLeft;
-    procedure EditDelRight;
-    procedure EditDelLine;
-    procedure EditUndo;
-    procedure EditRedo;
-    procedure ClipboardCut;
-    procedure ClipboardCopy;
-    procedure ClipboardPaste;
-
-    // Customizable keyboard handlers
-    procedure KeyReturn; virtual;
-
-  public
-    constructor Create(ADoc: TTextDoc; AWidget: ISHWidget); virtual;
-    function  AddKeyboardAction(AMethod: TKeyboardActionProc;ASelectionAction:TSelectionAction;ADescr: String): TKeyboardActionDescr;
-    function AddKeyboardAssignment(AKeyCode: Integer; AShiftState: TShiftState;
-      AAction: TKeyboardActionDescr): TShortcut;
-    procedure AddKeyDef(AMethod: TKeyboardActionProc; ASelectionAction:TSelectionAction; ADescr: String; AKeyCode: Integer; AShiftState: TShiftState);
-
-    procedure FocusIn;
-    procedure FocusOut;
-    procedure DrawContent(x1, y1, x2, y2: Integer);
-    procedure KeyPressed(KeyCode: LongWord; ShiftState: TShiftState); virtual;
-
-    KeyboardActions: TCollection;
-    Shortcuts: TCollection;
-
-    shDefault, shSelected: Integer;
-
-    property Doc: TTextDoc read FDoc;
-    property CursorX: Integer read FCursorX write SetCursorX;
-    property CursorY: Integer read FCursorY write SetCursorY;
-    property Selection: TSelection read FSel write FSel;
-    property OnModifiedChange: TNotifyEvent
-      read FOnModifiedChange write FOnModifiedChange;
-    property Widget: ISHWidget read FWidget;
-  end;
-
-
-
-implementation
-
-uses
-  Sysutils;
-
-
-{$INCLUDE undo.inc}
-{$INCLUDE keys.inc}
-{$INCLUDE drawing.inc}
-
-
-constructor TSelection.Create;
-begin
-  inherited Create;
-  Clear;
-end;
-
-function TSelection.IsValid: Boolean;
-begin
-  Result := StartX <> -1;
-end;
-
-function TSelection.OStartX: Integer;
-begin
-  if (StartY > EndY) or ((StartY = EndY) and (StartX > EndX)) then
-    Result := EndX
-  else
-    Result := StartX;
-end;
-
-function TSelection.OStartY: Integer;
-begin
-  if (StartY > EndY) or ((StartY = EndY) and (StartX > EndX)) then
-    Result := EndY
-  else
-    Result := StartY;
-end;
-
-function TSelection.OEndX: Integer;
-begin
-  if (StartY > EndY) or ((StartY = EndY) and (StartX > EndX)) then
-    Result := StartX
-  else
-    Result := EndX;
-end;
-
-function TSelection.OEndY: Integer;
-begin
-  if (StartY > EndY) or ((StartY = EndY) and (StartX > EndX)) then
-    Result := StartY
-  else
-    Result := EndY;
-end;
-
-
-
-procedure TSelection.Clear;
-begin
-  StartX := -1;
-  StartY := -1;
-  EndX := -1;
-  EndY := -1;
-end;
-
-
-constructor TSHTextEdit.Create(ADoc: TTextDoc; AWidget: ISHWidget);
-var
-  i: Integer;
-begin
-  ASSERT(Assigned(ADoc) and Assigned(AWidget));
-
-  FDoc := ADoc;
-
-  ViewInfo := TViewInfo(FDoc.ViewInfos.Add);
-  ViewInfo.OnLineInsert := @LineInserted;
-  ViewInfo.OnLineRemove := @LineRemoved;
-  ViewInfo.OnModifiedChange := @ModifiedChanged;
-
-  FWidget := AWidget;
-
-  FSel := TSelection.Create;
-
-  KeyboardActions := TCollection.Create(TKeyboardActionDescr);
-  Shortcuts := TCollection.Create(TShortcut);
-
-  Widget.LineCount := FDoc.LineCount;
-  Widget.LineWidth := FDoc.LineWidth;
-  CursorX:=0;
-  CursorY:=0;
-end;
-
-procedure TSHTextEdit.ModifiedChanged(Sender: TObject);
-begin
-  if Assigned(OnModifiedChange) then
-    OnModifiedChange(Self);
-end;
-
-procedure TSHTextEdit.FocusIn;
-begin
-  CursorVisible := 0;
-  ShowCursor;
-end;
-
-procedure TSHTextEdit.FocusOut;
-begin
-  HideCursor;
-end;
-
-
-procedure TSHTextEdit.SetCursorX(NewCursorX: Integer);
-begin
-  HideCursor;
-  if NewCursorX >= 0 then
-    FCursorX := NewCursorX
-  else
-    FCursorX := 0;
-  ShowCursor;
-end;
-
-procedure TSHTextEdit.SetCursorY(NewCursorY: Integer);
-begin
-  HideCursor;
-  if NewCursorY >= 0 then
-    FCursorY := NewCursorY
-  else
-    FCursorY := 0;
-  ShowCursor;
-end;
-
-procedure TSHTextEdit.LineInserted(Sender: TTextDoc; Line: Integer);
-begin
-  Widget.LineCount := FDoc.LineCount;
-  Widget.LineWidth := FDoc.LineWidth;
-  ChangeInLine(Line);
-end;
-
-procedure TSHTextEdit.LineRemoved(Sender: TTextDoc; Line: Integer);
-begin
-  LineInserted(Sender, Line);
-end;
-
-
-end.
-
-
-{
-  $Log$
-  Revision 1.8  1999-12-30 21:12:43  sg
-  * Support for empty documents (0 lines)
-  * Renaming of *Renderer to *Widget
-
-  Revision 1.6  1999/12/22 22:28:09  peter
-    * updates for cursor setting
-    * button press event works
-
-  Revision 1.5  1999/12/10 15:01:03  peter
-    * first things for selection
-    * Better Adjusting of range/cursor
-
-  Revision 1.4  1999/12/09 23:16:41  peter
-    * cursor walking is now possible, both horz and vert ranges are now
-      adapted
-    * filter key modifiers
-    * selection move routines added, but still no correct output to the
-      screen
-
-  Revision 1.3  1999/12/06 21:27:27  peter
-    * gtk updates, redrawing works now much better and clears only between
-      x1 and x2
-
-  Revision 1.2  1999/11/15 21:47:36  peter
-    * first working keypress things
-
-  Revision 1.1  1999/10/29 15:59:04  peter
-    * inserted in fcl
-
-}

fcl/shedit/undo.inc

@@ -1,145 +0,0 @@
-{
-    $Id$
-
-    "SHEdit" - Text editor with syntax highlighting
-    Copyright (C) 1999  Sebastian Guenther ([email protected])
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-}
-
-
-// TSHTextEdit: Undo/Redo support
-
-
-function TUndoInfo.Merge(AEdit: TSHTextEdit; AInfo: TUndoInfo): Boolean;
-begin
-  Result := False;
-end;
-
-
-constructor TUndoEdit.Create;
-begin
-  inherited Create;
-  NumOfChars := 1;
-end;
-
-constructor TUndoEdit.Create(ANumOfChars: Integer);
-begin
-  inherited Create;
-  NumOfChars := ANumOfChars;
-end;
-
-function TUndoEdit.Merge(AEdit: TSHTextEdit; AInfo: TUndoInfo): Boolean;
-begin
-//  if (CursorX <> AEdit.CursorX - TUndoEdit(AInfo).NumOfChars) or
-//     (CursorY <> AEdit.CursorY) then exit(False);
-  Inc(NumOfChars, TUndoEdit(AInfo).NumOfChars);
-  if AEdit.CursorY = CursorY + 1 then begin
-    CursorX := 0;
-    Inc(CursorY);
-  end else
-    Inc(CursorX, TUndoEdit(AInfo).NumOfChars);
-  Result := True;
-end;
-
-procedure TUndoEdit.DoUndo(AEdit: TSHTextEdit);
-begin
-  AEdit.FCursorX := CursorX;
-  AEdit.FCursorY := CursorY;
-  AEdit.MultiDelLeft(NumOfChars);
-end;
-
-
-constructor TUndoDelLeft.Create(const ADeletedString: String);
-begin
-  inherited Create;
-  DeletedString := ADeletedString;
-end;
-
-function TUndoDelLeft.Merge(AEdit: TSHTextEdit; AInfo: TUndoInfo): Boolean;
-var
-  l: Integer;
-begin
-  if TUndoDelLeft(AInfo).
-    DeletedString[Length(TUndoDelLeft(AInfo).DeletedString)] = #13 then
-    exit(False);
-
-  l := Length(TUndoDelLeft(AInfo).DeletedString);
-  if CursorY <> AEdit.CursorY then exit(False);
-  if CursorX = AEdit.CursorX + l then begin
-    DeletedString := TUndoDelLeft(AInfo).DeletedString + DeletedString;
-    Dec(CursorX, l);
-  end else if CursorX = AEdit.CursorX then
-    DeletedString := DeletedString + TUndoDelLeft(AInfo).DeletedString
-  else
-    exit(False);
-  Result := True;
-end;
-
-procedure TUndoDelLeft.DoUndo(AEdit: TSHTextEdit);
-begin
-  AEdit.FCursorX := CursorX;
-  AEdit.FCursorY := CursorY;
-  AEdit.ExecKeys(DeletedString, False);
-end;
-
-
-procedure TUndoDelRight.DoUndo(AEdit: TSHTextEdit);
-var
-  OldX, OldY: Integer;
-begin
-  OldX := CursorX;
-  OldY := CursorY;
-  AEdit.FCursorX := CursorX;
-  AEdit.FCursorY := CursorY;
-  AEdit.ExecKeys(DeletedString, False);
-  AEdit.FCursorX := OldX;
-  AEdit.FCursorY := OldY;
-end;
-
-
-
-procedure TSHTextEdit.AddUndoInfo(AInfo: TUndoInfo; CanMerge: Boolean);
-var
-  ok: Boolean;
-  info: TUndoInfo;
-begin
-  ok := False;
-  info := LastUndoInfo;
-  if CanMerge and Assigned(info) and (info.ClassType = AInfo.ClassType) then begin
-    if info.Merge(Self, AInfo) then begin
-      AInfo.Free;
-      AInfo := info;
-      ok := True;
-    end;
-  end;
-
-  if not ok then begin
-    if LastUndoInfo = nil then
-      LastUndoInfo := AInfo
-    else begin
-      AInfo.Prev := LastUndoInfo;
-      LastUndoInfo.Next := AInfo;
-      LastUndoInfo := AInfo;
-    end;
-
-    AInfo.CursorX := FCursorX;
-    AInfo.CursorY := FCursorY;
-  end;
-end;
-
-
-{
-  $Log$
-  Revision 1.2  1999-12-30 21:13:22  sg
-  * Shortened copyright notice
-
-  Revision 1.1  1999/10/29 15:59:04  peter
-    * inserted in fcl
-
-}

fcl/template/Makefile

@@ -1,1028 +0,0 @@
-#
-# Makefile generated by fpcmake v0.99.13 on 1999-12-24 16:08
-#
-
-defaultrule: all
-
-#####################################################################
-# Autodetect OS (Linux or Dos or Windows NT)
-# define inlinux when running under linux
-# define inWinNT when running under WinNT
-#####################################################################
-
-# We need only / in the path
-override PATH:=$(subst \,/,$(PATH))
-
-# Search for PWD and determine also if we are under linux
-PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
-ifeq ($(PWD),)
-PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
-ifeq ($(PWD),)
-nopwd:
-	@echo You need the GNU utils package to use this Makefile!
-	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
-	@exit
-else
-inlinux=1
-endif
-else
-PWD:=$(firstword $(PWD))
-endif
-
-# Detect NT - NT sets OS to Windows_NT
-ifndef inlinux
-ifeq ($(OS),Windows_NT)
-inWinNT=1
-endif
-endif
-
-# Detect OS/2 - OS/2 has OS2_SHELL defined
-ifndef inlinux
-ifndef inWinNT
-ifdef OS2_SHELL
-inOS2=1
-endif
-endif
-endif
-
-# The extension of executables
-ifdef inlinux
-EXEEXT=
-else
-EXEEXT=.exe
-endif
-
-# The path which is search separated by spaces
-ifdef inlinux
-SEARCHPATH=$(subst :, ,$(PATH))
-else
-SEARCHPATH=$(subst ;, ,$(PATH))
-endif
-
-#####################################################################
-# Default target
-#####################################################################
-
-override OS_TARGET:=<template>
-override CPU_TARGET:=i386
-
-#####################################################################
-# FPC version/target Detection
-#####################################################################
-
-# What compiler to use ?
-ifndef FPC
-# Compatibility with old makefiles
-ifdef PP
-FPC=$(PP)
-else
-ifdef inOS2
-FPC=ppos2$(EXEEXT)
-else
-FPC=ppc386$(EXEEXT)
-endif
-endif
-endif
-
-# Target OS
-ifndef OS_TARGET
-OS_TARGET:=$(shell $(FPC) -iTO)
-endif
-
-# Source OS
-ifndef OS_SOURCE
-OS_SOURCE:=$(shell $(FPC) -iSO)
-endif
-
-# Target CPU
-ifndef CPU_TARGET
-CPU_TARGET:=$(shell $(FPC) -iTP)
-endif
-
-# Source CPU
-ifndef CPU_SOURCE
-CPU_SOURCE:=$(shell $(FPC) -iSP)
-endif
-
-# FPC version
-ifndef FPC_VERSION
-FPC_VERSION:=$(shell $(FPC) -iV)
-endif
-
-export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
-
-#####################################################################
-# Default Settings
-#####################################################################
-
-# Release ? Then force OPT and don't use extra opts via commandline
-ifndef REDIRFILE
-REDIRFILE=log
-endif
-
-ifdef RELEASE
-override OPT:=-Xs -OG2p3 -n
-endif
-
-# Verbose settings (warning,note,info)
-ifdef VERBOSE
-override OPT+=-vwni
-endif
-
-ifdef REDIR
-ifndef inlinux
-override FPC=redir -eo $(FPC)
-endif
-# set the verbosity to max
-override OPT+=-va
-override REDIR:= >> $(REDIRFILE)
-endif
-
-#####################################################################
-# User Settings
-#####################################################################
-
-
-# Pre Settings
-
-# Include files
-INC=../inc
-XML=../xml
-
-# INCUNITS,XMLUNITS is defined in makefile.inc
-# They are default units for all platforms.
-include $(INC)/Makefile.inc
-include $(XML)/Makefile.inc
-
-# Targets
-
-override UNITOBJECTS+=classes $(INCUNITS) $(XMLUNITS)
-
-# Clean
-
-
-# Install
-
-ZIPTARGET=install
-
-# Defaults
-
-override NEEDOPT=-S2
-
-# Directories
-
-ifndef FPCDIR
-FPCDIR=../..
-endif
-ifndef PACKAGEDIR
-PACKAGEDIR=$(FPCDIR)/packages
-endif
-ifndef COMPONENTDIR
-COMPONENTDIR=$(FPCDIR)/components
-endif
-override NEEDINCDIR=$(INC)
-ifndef TARGETDIR
-TARGETDIR=.
-endif
-
-# Packages
-
-
-# Libraries
-
-
-# Info
-
-INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall 
-
-#####################################################################
-# Default Directories
-#####################################################################
-
-# Base dir
-ifdef PWD
-BASEDIR:=$(shell $(PWD))
-else
-BASEDIR=.
-endif
-
-# this can be set to 'rtl' when the RTL units are installed
-ifndef UNITPREFIX
-UNITPREFIX=units
-endif
-
-# set the prefix directory where to install everything
-ifndef PREFIXINSTALLDIR
-ifdef inlinux
-PREFIXINSTALLDIR=/usr
-else
-PREFIXINSTALLDIR=/pp
-endif
-endif
-export PREFIXINSTALLDIR
-
-# create fcldir,rtldir,unitdir
-ifdef FPCDIR
-override FPCDIR:=$(subst \,/,$(FPCDIR))
-ifneq ($(FPCDIR),.)
-override RTLDIR=$(FPCDIR)/rtl/$(OS_TARGET)
-override FCLDIR=$(FPCDIR)/fcl/$(OS_TARGET)
-override UNITSDIR=$(FPCDIR)/units/$(OS_TARGET)
-endif
-endif
-
-#####################################################################
-# Install Directories
-#####################################################################
-
-# set the base directory where to install everything
-ifndef BASEINSTALLDIR
-ifdef inlinux
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION)
-else
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)
-endif
-endif
-
-# set the directory where to install the binaries
-ifndef BININSTALLDIR
-ifdef inlinux
-BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
-else
-BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
-endif
-endif
-
-# set the directory where to install the units.
-ifndef UNITINSTALLDIR
-UNITINSTALLDIR=$(BASEINSTALLDIR)/$(UNITPREFIX)/$(OS_TARGET)
-endif
-
-# Where to install shared libraries
-ifndef LIBINSTALLDIR
-ifdef inlinux
-LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
-else
-LIBINSTALLDIR=$(UNITINSTALLDIR)
-endif
-endif
-
-# Where the source files will be stored
-ifndef SOURCEINSTALLDIR
-ifdef inlinux
-SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION)
-else
-SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source
-endif
-endif
-
-# Where the doc files will be stored
-ifndef DOCINSTALLDIR
-ifdef inlinux
-DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc/$(FPC_VERSION)
-else
-DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
-endif
-endif
-
-# Where the some extra (data)files will be stored
-ifndef EXTRAINSTALLDIR
-EXTRAINSTALLDIR=$(BASEINSTALLDIR)
-endif
-
-
-#####################################################################
-# Compiler Command Line
-#####################################################################
-
-# Load commandline OPTDEF and add FPC_CPU define
-override FPCOPTDEF:=-d$(CPU_TARGET)
-
-# Load commandline OPT and add target and unit dir to be sure
-ifneq ($(OS_TARGET),$(OS_SOURCE))
-override FPCOPT+=-T$(OS_TARGET)
-endif
-
-ifdef NEEDOPT
-override FPCOPT+=$(NEEDOPT)
-endif
-
-ifdef RTLDIR
-override FPCOPT+=-Fu$(RTLDIR)
-endif
-
-ifdef UNITSDIR
-override FPCOPT+=-Fu$(UNITSDIR)
-endif
-
-ifdef NEEDINCDIR
-override FPCOPT+=$(addprefix -Fi,$(NEEDINCDIR))
-endif
-
-
-# Target dirs
-ifdef TARGETDIR
-override FPCOPT+=-FE$(TARGETDIR)
-endif
-
-# Smartlinking
-ifdef SMARTLINK
-override FPCOPT+=-CX
-endif
-
-# Debug
-ifdef DEBUG
-override FPCOPT+=-g
-endif
-
-# Add commandline options
-ifdef OPT
-override FPCOPT+=$(OPT)
-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
-
-# Add defines from FPCOPTDEF to FPCOPT
-ifdef FPCOPTDEF
-override FPCOPT+=$(FPCOPTDEF)
-endif
-
-# Error file ?
-ifdef ERRORFILE
-override FPCOPT+=-Fr$(ERRORFILE)
-endif
-
-# Was a config file specified ?
-ifdef CFGFILE
-override FPCOPT+=@$(CFGFILE)
-endif
-
-# For win32 the options are passed using the environment variable FPCEXTCMD
-ifeq ($(OS_SOURCE),win32)
-override FPCEXTCMD:=$(FPCOPT)
-override FPCOPT:=!FPCEXTCMD
-export FPCEXTCMD
-endif
-
-# Compiler commandline
-override COMPILER:=$(FPC) $(FPCOPT)
-
-#####################################################################
-# Shell tools
-#####################################################################
-
-# To copy pograms
-ifndef COPY
-COPY:=cp -fp
-endif
-
-# Copy a whole tree
-ifndef COPYTREE
-COPYTREE:=cp -rfp
-endif
-
-# To move pograms
-ifndef MOVE
-MOVE:=mv -f
-endif
-
-# Check delete program
-ifndef DEL
-DEL:=rm -f
-endif
-
-# Check deltree program
-ifndef DELTREE
-DELTREE:=rm -rf
-endif
-
-# To install files
-ifndef INSTALL
-ifdef inlinux
-INSTALL:=install -m 644
-else
-INSTALL:=$(COPY)
-endif
-endif
-
-# To install programs
-ifndef INSTALLEXE
-ifdef inlinux
-INSTALLEXE:=install -m 755
-else
-INSTALLEXE:=$(COPY)
-endif
-endif
-
-# To make a directory.
-ifndef MKDIR
-ifdef inlinux
-MKDIR:=install -m 755 -d
-else
-MKDIR:=ginstall -m 755 -d
-endif
-endif
-
-export COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
-
-#####################################################################
-# Default Tools
-#####################################################################
-
-# assembler, redefine it if cross compiling
-ifndef AS
-AS=as
-endif
-
-# linker, but probably not used
-ifndef LD
-LD=ld
-endif
-
-# ppas.bat / ppas.sh
-ifdef inlinux
-PPAS=ppas.sh
-else
-ifdef inOS2
-PPAS=ppas.cmd
-else
-PPAS=ppas.bat
-endif
-endif
-
-# also call ppas if with command option -s
-ifeq (,$(findstring -s ,$(COMPILER)))
-EXECPPAS=
-else
-EXECPPAS:=@$(PPAS)
-endif
-
-# ldconfig to rebuild .so cache
-ifdef inlinux
-LDCONFIG=ldconfig
-else
-LDCONFIG=
-endif
-
-# echo
-ifndef ECHO
-ECHO:=$(strip $(wildcard $(addsuffix /echo$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO:=echo
-else
-ECHO:=$(firstword $(ECHO))
-endif
-endif
-export ECHO
-
-# ppdep
-ifndef PPDEP
-PPDEP:=$(strip $(wildcard $(addsuffix /ppdep$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPDEP),)
-PPDEP=
-else
-PPDEP:=$(firstword $(PPDEP))
-endif
-endif
-export PPDEP
-
-# ppumove
-ifndef PPUMOVE
-PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUMOVE),)
-PPUMOVE=
-else
-PPUMOVE:=$(firstword $(PPUMOVE))
-endif
-endif
-export PPUMOVE
-
-# ppufiles
-ifndef PPUFILES
-PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUFILES),)
-PPUFILES=
-else
-PPUFILES:=$(firstword $(PPUFILES))
-endif
-endif
-export PPUFILES
-
-# Look if UPX is found for go32v2 and win32. We can't use $UPX becuase
-# upx uses that one itself (PFV)
-ifndef UPXPROG
-ifeq ($(OS_TARGET),go32v2)
-UPXPROG:=1
-endif
-ifeq ($(OS_TARGET),win32)
-UPXPROG:=1
-endif
-ifdef UPXPROG
-UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(UPXPROG),)
-UPXPROG=
-else
-UPXPROG:=$(firstword $(UPXPROG))
-endif
-else
-UPXPROG=
-endif
-endif
-export UPXPROG
-
-# gdate/date
-ifndef DATE
-DATE:=$(strip $(wildcard $(addsuffix /date$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(DATE),)
-DATE:=$(strip $(wildcard $(addsuffix /gdate$(EXEEXT),$(SEACHPATH))))
-ifeq ($(DATE),)
-DATE=
-else
-DATE:=$(firstword $(DATE))
-endif
-else
-DATE:=$(firstword $(DATE))
-endif
-endif
-export DATE
-
-ifdef DATE
-DATESTR:=$(shell $(DATE) +%Y%m%d)
-else
-DATESTR=
-endif
-
-# ZipProg, you can't use Zip as the var name (PFV)
-ifndef ZIPPROG
-ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ZIPPROG),)
-ZIPPROG=
-else
-ZIPPROG:=$(firstword $(ZIPPROG)) -D9 -r
-endif
-endif
-export ZIPPROG
-
-ifndef ZIPEXT
-ZIPEXT=.zip
-endif
-
-#####################################################################
-# Default extensions
-#####################################################################
-
-# Default needed extensions (Go32v2,Linux)
-LOADEREXT=.as
-PPLEXT=.ppl
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.so
-PACKAGESUFFIX=
-FPCMADE=fpcmade
-
-# Go32v1
-ifeq ($(OS_TARGET),go32v1)
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-STATICLIBEXT=.a1
-SHAREDLIBEXT=.so1
-PACKAGESUFFIX=v1
-FPCMADE=fpcmade.v1
-endif
-
-# Go32v2
-ifeq ($(OS_TARGET),go32v2)
-PACKAGESUFFIX=go32
-FPCMADE=fpcmade.dos
-endif
-
-# Linux
-ifeq ($(OS_TARGET),linux)
-PACKAGESUFFIX=linux
-FPCMADE=fpcmade.lnx
-endif
-
-# Win32
-ifeq ($(OS_TARGET),win32)
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=win32
-FPCMADE=fpcmade.w32
-endif
-
-# OS/2
-ifeq ($(OS_TARGET),os2)
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-SMARTEXT=.so
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=os2
-FPCMADE=fpcmade.os2
-endif
-
-# library prefix
-LIBPREFIX=lib
-ifeq ($(OS_TARGET),go32v2)
-LIBPREFIX=
-endif
-ifeq ($(OS_TARGET),go32v1)
-LIBPREFIX=
-endif
-
-# determine which .pas extension is used
-ifndef PASEXT
-ifdef EXEOBJECTS
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
-else
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
-endif
-ifeq ($(TESTPAS),)
-PASEXT=.pp
-else
-PASEXT=.pas
-endif
-endif
-
-#####################################################################
-# Standard rules
-#####################################################################
-
-all: fpc_all
-
-debug: fpc_debug
-
-smart: fpc_smart
-
-shared: fpc_shared
-
-showinstall: fpc_showinstall
-
-install: fpc_install
-
-sourceinstall: fpc_sourceinstall
-
-zipinstall: fpc_zipinstall
-
-zipinstalladd: fpc_zipinstalladd
-
-clean: fpc_clean
-
-cleanall: fpc_cleanall
-
-info: fpc_info
-
-.PHONY:  all debug smart shared showinstall install sourceinstall zipinstall zipinstalladd clean cleanall info
-
-#####################################################################
-# Package depends
-#####################################################################
-
-ifneq ($(wildcard $(RTLDIR)),)
-ifeq ($(wildcard $(RTLDIR)/$(FPCMADE)),)
-override COMPILEPACKAGES+=rtl
-rtl_package:
-	$(MAKE) -C $(RTLDIR) all
-endif
-endif
-
-.PHONY:  rtl_package
-
-#####################################################################
-# Units
-#####################################################################
-
-.PHONY: fpc_units
-
-override ALLTARGET+=fpc_units
-
-override UNITPPUFILES=$(addsuffix $(PPUEXT),$(UNITOBJECTS))
-override INSTALLPPUFILES+=$(UNITPPUFILES)
-override CLEANPPUFILES+=$(UNITPPUFILES)
-
-fpc_units: $(UNITPPUFILES)
-
-#####################################################################
-# General compile rules
-#####################################################################
-
-.PHONY: fpc_all fpc_debug
-
-$(FPCMADE):
-	@$(ECHO) Compiled > $(FPCMADE)
-
-fpc_all: $(addsuffix _package,$(COMPILEPACKAGES)) \
-	 $(addsuffix _component,$(COMPILECOMPONENTS)) \
-	 $(ALLTARGET) $(FPCMADE)
-
-fpc_debug:
-	$(MAKE) all DEBUG=1
-
-# General compile rules, available for both possible PASEXT
-
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
-
-%$(PPUEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(PPUEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-#####################################################################
-# Library
-#####################################################################
-
-.PHONY: fpc_smart fpc_shared
-
-# Default sharedlib units are all unit objects
-ifndef SHAREDLIBUNITOBJECTS
-SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
-endif
-
-fpc_smart:
-	$(MAKE) all SMARTLINK=1
-
-fpc_shared: all
-ifdef inlinux
-ifndef LIBNAME
-	@$(ECHO) "LIBNAME not set"
-else
-	$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
-endif
-else
-	@$(ECHO) "Shared Libraries not supported"
-endif
-
-#####################################################################
-# Install rules
-#####################################################################
-
-.PHONY: fpc_showinstall fpc_install
-
-ifdef EXTRAINSTALLUNITS
-override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))
-endif
-
-ifdef INSTALLPPUFILES
-ifdef PPUFILES
-ifdef inlinux
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
-INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
-else
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
-endif
-else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
-endif
-endif
-
-fpc_showinstall: $(SHOWINSTALLTARGET)
-ifdef INSTALLEXEFILES
-	@$(ECHO) -e $(addprefix "\n"$(BININSTALLDIR)/,$(INSTALLEXEFILES))
-endif
-ifdef INSTALLPPUFILES
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPUFILES))
-ifneq ($(INSTALLPPULINKFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	@$(ECHO) -e $(addprefix "\n"$(EXTRAINSTALLDIR)/,$(EXTRAINSTALLFILES))
-endif
-
-fpc_install: $(INSTALLTARGET)
-# Create UnitInstallFiles
-ifdef INSTALLEXEFILES
-	$(MKDIR) $(BININSTALLDIR)
-# Compress the exes if upx is defined
-ifdef UPXPROG
-	-$(UPXPROG) $(INSTALLEXEFILES)
-endif
-	$(INSTALLEXE) $(INSTALLEXEFILES) $(BININSTALLDIR)
-endif
-ifdef INSTALLPPUFILES
-	$(MKDIR) $(UNITINSTALLDIR)
-	$(INSTALL) $(INSTALLPPUFILES) $(UNITINSTALLDIR)
-ifneq ($(INSTALLPPULINKFILES),)
-	$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	$(MKDIR) $(LIBINSTALLDIR)
-	$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	$(MKDIR) $(EXTRAINSTALLDIR)
-	$(INSTALL) $(EXTRAINSTALLFILES) $(EXTRAINSTALLDIR)
-endif
-
-#####################################################################
-# Source install rules
-#####################################################################
-
-.PHONY: fpc_sourceinstall
-
-fpc_sourceinstall: clean
-	$(MKDIR) $(SOURCEINSTALLDIR)
-	$(COPYTREE) $(BASEDIR) $(SOURCEINSTALLDIR)
-
-#####################################################################
-# Zip
-#####################################################################
-
-.PHONY: fpc_zipinstall fpc_zipinstalladd
-
-# Temporary path to pack a file
-ifndef PACKDIR
-ifndef inlinux
-PACKDIR=pack_tmp
-else
-PACKDIR=/tmp/fpc-pack
-endif
-endif
-
-# Test dir if none specified
-ifndef DESTZIPDIR
-DESTZIPDIR:=$(BASEDIR)
-endif
-
-# Add .zip/.tar.gz extension
-ifdef ZIPNAME
-ifndef inlinux
-override ZIPNAME:=$(ZIPNAME)$(ZIPEXT)
-endif
-endif
-
-# Note: This will not remove the zipfile first
-fpc_zipinstalladd:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	gzip -d $(DESTZIPDIR)/$(ZIPNAME).tar.gz
-	cd $(PACKDIR) ; tar rv --file $(DESTZIPDIR)/$(ZIPNAME).tar * ; cd $(BASEDIR)
-	gzip $(DESTZIPDIR)/$(ZIPNAME).tar
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-# First remove the zip and then install
-fpc_zipinstall:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	cd $(PACKDIR) ; tar cvz --file $(DESTZIPDIR)/$(ZIPNAME).tar.gz * ; cd $(BASEDIR)
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-#####################################################################
-# Clean rules
-#####################################################################
-
-.PHONY: fpc_clean fpc_cleanall
-
-ifdef EXTRACLEANUNITS
-override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS))
-endif
-
-ifdef CLEANPPUFILES
-ifdef PPUFILES
-CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
-else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
-endif
-endif
-
-fpc_clean: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-ifdef CLEANPPUFILES
-	-$(DEL) $(CLEANPPUFILES)
-endif
-ifneq ($(CLEANPPULINKFILES),)
-	-$(DEL) $(CLEANPPULINKFILES)
-endif
-ifdef EXTRACLEANFILES
-	-$(DEL) $(EXTRACLEANFILES)
-endif
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-fpc_cleanall: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-	-$(DELTREE) *$(SMARTEXT)
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-#####################################################################
-# Info rules
-#####################################################################
-
-.PHONY: fpc_info fpc_cfginfo fpc_objectinfo fpc_toolsinfo fpc_installinfo \
-	fpc_dirinfo
-
-fpc_info: $(INFOTARGET)
-
-fpc_infocfg:
-	@$(ECHO)
-	@$(ECHO)  == Configuration info ==
-	@$(ECHO)
-	@$(ECHO)  FPC....... $(FPC)
-	@$(ECHO)  Version... $(FPC_VERSION)
-	@$(ECHO)  CPU....... $(CPU_TARGET)
-	@$(ECHO)  Source.... $(OS_SOURCE)
-	@$(ECHO)  Target.... $(OS_TARGET)
-	@$(ECHO)
-
-fpc_infoobjects:
-	@$(ECHO)
-	@$(ECHO)  == Object info ==
-	@$(ECHO)
-	@$(ECHO)  LoaderObjects..... $(LOADEROBJECTS)
-	@$(ECHO)  UnitObjects....... $(UNITOBJECTS)
-	@$(ECHO)  ExeObjects........ $(EXEOBJECTS)
-	@$(ECHO)
-	@$(ECHO)  ExtraCleanUnits... $(EXTRACLEANUNITS)
-	@$(ECHO)  ExtraCleanFiles... $(EXTRACLEANFILES)
-	@$(ECHO)
-	@$(ECHO)  ExtraInstallUnits. $(EXTRAINSTALLUNITS)
-	@$(ECHO)  ExtraInstallFiles. $(EXTRAINSTALLFILES)
-	@$(ECHO)
-
-fpc_infoinstall:
-	@$(ECHO)
-	@$(ECHO)  == Install info ==
-	@$(ECHO)
-ifdef DATE
-	@$(ECHO)  DateStr.............. $(DATESTR)
-endif
-	@$(ECHO)  PackageSuffix........ $(PACKAGESUFFIX)
-	@$(ECHO)
-	@$(ECHO)  BaseInstallDir....... $(BASEINSTALLDIR)
-	@$(ECHO)  BinInstallDir........ $(BININSTALLDIR)
-	@$(ECHO)  LibInstallDir........ $(LIBINSTALLDIR)
-	@$(ECHO)  UnitInstallDir....... $(UNITINSTALLDIR)
-	@$(ECHO)  SourceInstallDir..... $(SOURCEINSTALLDIR)
-	@$(ECHO)  DocInstallDir........ $(DOCINSTALLDIR)
-	@$(ECHO)  ExtraInstallDir...... $(EXTRAINSTALLDIR)
-	@$(ECHO)
-
-#####################################################################
-# Users rules
-#####################################################################
-
-vpath %$(PASEXT) $(INC) $(XML)
-
-INCFILES=$(addprefix $(INC)/,$(INCNAMES))
-
-classes$(PPUEXT): $(INCFILES) classes$(PASEXT)
-
-inifiles$(PPUEXT): classes$(PPUEXT) inifiles$(PASEXT)
-
-ezcgi$(PPUEXT): ezcgi$(PASEXT) ezcgi.inc

fcl/template/Makefile.fpc

@@ -1,41 +0,0 @@
-#
-#   Makefile.fpc for Free Component Library for Go32v2
-#
-
-[defaults]
-defaultunits=1
-defaulttarget=<template>
-defaultcpu=i386
-defaultoptions=-S2
-
-[dirs]
-fpcdir=../..
-targetdir=.
-incdir=$(INC)
-
-[targets]
-units=classes $(INCUNITS) $(XMLUNITS)
-
-
-[presettings]
-# Include files
-INC=../inc
-XML=../xml
-
-# INCUNITS,XMLUNITS is defined in makefile.inc
-# They are default units for all platforms.
-include $(INC)/Makefile.inc
-include $(XML)/Makefile.inc
-
-
-[rules]
-vpath %$(PASEXT) $(INC) $(XML)
-
-INCFILES=$(addprefix $(INC)/,$(INCNAMES))
-
-classes$(PPUEXT): $(INCFILES) classes$(PASEXT)
-
-inifiles$(PPUEXT): classes$(PPUEXT) inifiles$(PASEXT)
-
-ezcgi$(PPUEXT): ezcgi$(PASEXT) ezcgi.inc
-

fcl/template/classes.pp

@@ -1,43 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl
-
-    Classes unit for win32
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-{$mode objfpc}
-
-{ determine the type of the resource/form file }
-{$define Win16Res}
-
-unit Classes;
-
-interface
-
-uses
-  strings,
-  sysutils;
-
-{$i classesh.inc}
-
-implementation
-
-{ OS - independent class implementations are in /inc directory. }
-{$i classes.inc}
-
-end.
-{
-  $Log$
-  Revision 1.1  1999-05-30 10:46:43  peter
-    * start of tthread for linux,win32
-
-}

fcl/template/footer

@@ -1,6 +0,0 @@
-{
-  $Log$
-  Revision 1.1  1998-05-04 14:30:33  michael
-  Initial implementation
-
-}

fcl/template/header

@@ -1,13 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}

fcl/template/template.pp

@@ -1,29 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by xxxx
-    member of the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-
-unit template;
-
-  interface
-
-  implementation
-
-end.
-
-{
-  $Log$
-  Revision 1.1  1998-05-04 12:18:57  florian
-    + Initial revision of template files
-
-}

fcl/template/thread.inc

@@ -1,101 +0,0 @@
-{
-    $Id$
-    This file is part of the Free Component Library (FCL)
-    Copyright (c) 1998 by the Free Pascal development team
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    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.
-
- **********************************************************************}
-{****************************************************************************}
-{*                             TThread                                      *}
-{****************************************************************************}
-
-
-procedure TThread.CallOnTerminate;
-
-begin
-end;
-
-
-function TThread.GetPriority: TThreadPriority;
-
-begin
-  GetPriority:=tpNormal;
-end;
-
-
-procedure TThread.SetPriority(Value: TThreadPriority);
-
-begin
-end;
-
-
-procedure TThread.SetSuspended(Value: Boolean);
-
-begin
-end;
-
-
-procedure TThread.DoTerminate;
-
-begin
-end;
-
-
-procedure TThread.Synchronize(Method: TThreadMethod);
-
-begin
-end;
-
-
-constructor TThread.Create(CreateSuspended: Boolean);
-
-begin
-end;
-
-
-destructor TThread.Destroy;
-
-begin
-end;
-
-
-procedure TThread.Resume;
-
-begin
-end;
-
-
-procedure TThread.Suspend;
-
-begin
-end;
-
-
-procedure TThread.Terminate;
-
-begin
-end;
-
-
-function TThread.WaitFor: Integer;
-
-begin
-  WaitFor:=0;
-end;
-
-
-{
-  $Log$
-  Revision 1.1  1999-05-30 10:46:43  peter
-    * start of tthread for linux,win32
-
-  Revision 1.2  1999/04/08 10:18:57  peter
-    * makefile updates
-
-}

fcl/tests/Makefile

@@ -1,1008 +0,0 @@
-#
-# Makefile generated by fpcmake v0.99.13 on 1999-12-24 16:08
-#
-
-defaultrule: all
-
-#####################################################################
-# Autodetect OS (Linux or Dos or Windows NT)
-# define inlinux when running under linux
-# define inWinNT when running under WinNT
-#####################################################################
-
-# We need only / in the path
-override PATH:=$(subst \,/,$(PATH))
-
-# Search for PWD and determine also if we are under linux
-PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(subst ;, ,$(PATH)))))
-ifeq ($(PWD),)
-PWD:=$(strip $(wildcard $(addsuffix /pwd,$(subst :, ,$(PATH)))))
-ifeq ($(PWD),)
-nopwd:
-	@echo You need the GNU utils package to use this Makefile!
-	@echo Get ftp://ftp.freepascal.org/pub/fpc/dist/go32v2/utilgo32.zip
-	@exit
-else
-inlinux=1
-endif
-else
-PWD:=$(firstword $(PWD))
-endif
-
-# Detect NT - NT sets OS to Windows_NT
-ifndef inlinux
-ifeq ($(OS),Windows_NT)
-inWinNT=1
-endif
-endif
-
-# Detect OS/2 - OS/2 has OS2_SHELL defined
-ifndef inlinux
-ifndef inWinNT
-ifdef OS2_SHELL
-inOS2=1
-endif
-endif
-endif
-
-# The extension of executables
-ifdef inlinux
-EXEEXT=
-else
-EXEEXT=.exe
-endif
-
-# The path which is search separated by spaces
-ifdef inlinux
-SEARCHPATH=$(subst :, ,$(PATH))
-else
-SEARCHPATH=$(subst ;, ,$(PATH))
-endif
-
-#####################################################################
-# FPC version/target Detection
-#####################################################################
-
-# What compiler to use ?
-ifndef FPC
-# Compatibility with old makefiles
-ifdef PP
-FPC=$(PP)
-else
-ifdef inOS2
-FPC=ppos2$(EXEEXT)
-else
-FPC=ppc386$(EXEEXT)
-endif
-endif
-endif
-
-# Target OS
-ifndef OS_TARGET
-OS_TARGET:=$(shell $(FPC) -iTO)
-endif
-
-# Source OS
-ifndef OS_SOURCE
-OS_SOURCE:=$(shell $(FPC) -iSO)
-endif
-
-# Target CPU
-ifndef CPU_TARGET
-CPU_TARGET:=$(shell $(FPC) -iTP)
-endif
-
-# Source CPU
-ifndef CPU_SOURCE
-CPU_SOURCE:=$(shell $(FPC) -iSP)
-endif
-
-# FPC version
-ifndef FPC_VERSION
-FPC_VERSION:=$(shell $(FPC) -iV)
-endif
-
-export FPC OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FPC_VERSION
-
-#####################################################################
-# Default Settings
-#####################################################################
-
-# Release ? Then force OPT and don't use extra opts via commandline
-ifndef REDIRFILE
-REDIRFILE=log
-endif
-
-ifdef RELEASE
-override OPT:=-Xs -OG2p3 -n
-endif
-
-# Verbose settings (warning,note,info)
-ifdef VERBOSE
-override OPT+=-vwni
-endif
-
-ifdef REDIR
-ifndef inlinux
-override FPC=redir -eo $(FPC)
-endif
-# set the verbosity to max
-override OPT+=-va
-override REDIR:= >> $(REDIRFILE)
-endif
-
-#####################################################################
-# User Settings
-#####################################################################
-
-
-# Targets
-
-override EXEOBJECTS+=stringl dparser fstream mstream list threads testrtf cfgtest xmldump htdump testcgi tidea b64test b64test2 b64enc b64dec restest
-ifeq ($(OS_TARGET),win32)
-override EXEOBJECTS+=testz testz2
-endif
-
-# Clean
-
-override EXTRACLEANFILES+=restest.rst
-
-# Install
-
-ZIPTARGET=install
-
-# Defaults
-
-override NEEDOPT=-S2
-
-# Directories
-
-ifndef FPCDIR
-FPCDIR=../..
-endif
-ifndef PACKAGEDIR
-PACKAGEDIR=$(FPCDIR)/packages
-endif
-ifndef COMPONENTDIR
-COMPONENTDIR=$(FPCDIR)/components
-endif
-ifndef TARGETDIR
-TARGETDIR=.
-endif
-
-# Packages
-
-override NEEDUNITDIR+=$(FPCDIR)/fcl/$(OS_TARGET)
-
-# Libraries
-
-
-# Info
-
-INFOTARGET=fpc_infocfg fpc_infoobjects fpc_infoinstall 
-
-#####################################################################
-# Default Directories
-#####################################################################
-
-# Base dir
-ifdef PWD
-BASEDIR:=$(shell $(PWD))
-else
-BASEDIR=.
-endif
-
-# this can be set to 'rtl' when the RTL units are installed
-ifndef UNITPREFIX
-UNITPREFIX=units
-endif
-
-# set the prefix directory where to install everything
-ifndef PREFIXINSTALLDIR
-ifdef inlinux
-PREFIXINSTALLDIR=/usr
-else
-PREFIXINSTALLDIR=/pp
-endif
-endif
-export PREFIXINSTALLDIR
-
-# create fcldir,rtldir,unitdir
-ifdef FPCDIR
-override FPCDIR:=$(subst \,/,$(FPCDIR))
-ifneq ($(FPCDIR),.)
-override RTLDIR=$(FPCDIR)/rtl/$(OS_TARGET)
-override FCLDIR=$(FPCDIR)/fcl/$(OS_TARGET)
-override UNITSDIR=$(FPCDIR)/units/$(OS_TARGET)
-endif
-endif
-
-#####################################################################
-# Install Directories
-#####################################################################
-
-# set the base directory where to install everything
-ifndef BASEINSTALLDIR
-ifdef inlinux
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)/lib/fpc/$(FPC_VERSION)
-else
-BASEINSTALLDIR=$(PREFIXINSTALLDIR)
-endif
-endif
-
-# set the directory where to install the binaries
-ifndef BININSTALLDIR
-ifdef inlinux
-BININSTALLDIR=$(PREFIXINSTALLDIR)/bin
-else
-BININSTALLDIR=$(BASEINSTALLDIR)/bin/$(OS_TARGET)
-endif
-endif
-
-# set the directory where to install the units.
-ifndef UNITINSTALLDIR
-UNITINSTALLDIR=$(BASEINSTALLDIR)/$(UNITPREFIX)/$(OS_TARGET)
-endif
-
-# Where to install shared libraries
-ifndef LIBINSTALLDIR
-ifdef inlinux
-LIBINSTALLDIR=$(PREFIXINSTALLDIR)/lib
-else
-LIBINSTALLDIR=$(UNITINSTALLDIR)
-endif
-endif
-
-# Where the source files will be stored
-ifndef SOURCEINSTALLDIR
-ifdef inlinux
-SOURCEINSTALLDIR=$(PREFIXINSTALLDIR)/src/fpc-$(FPC_VERSION)
-else
-SOURCEINSTALLDIR=$(BASEINSTALLDIR)/source
-endif
-endif
-
-# Where the doc files will be stored
-ifndef DOCINSTALLDIR
-ifdef inlinux
-DOCINSTALLDIR=$(PREFIXINSTALLDIR)/doc/fpc/$(FPC_VERSION)
-else
-DOCINSTALLDIR=$(BASEINSTALLDIR)/doc
-endif
-endif
-
-# Where the some extra (data)files will be stored
-ifndef EXTRAINSTALLDIR
-EXTRAINSTALLDIR=$(BASEINSTALLDIR)
-endif
-
-
-#####################################################################
-# Compiler Command Line
-#####################################################################
-
-# Load commandline OPTDEF and add FPC_CPU define
-override FPCOPTDEF:=-d$(CPU_TARGET)
-
-# Load commandline OPT and add target and unit dir to be sure
-ifneq ($(OS_TARGET),$(OS_SOURCE))
-override FPCOPT+=-T$(OS_TARGET)
-endif
-
-ifdef NEEDOPT
-override FPCOPT+=$(NEEDOPT)
-endif
-
-ifdef RTLDIR
-override FPCOPT+=-Fu$(RTLDIR)
-endif
-
-ifdef UNITSDIR
-override FPCOPT+=-Fu$(UNITSDIR)
-endif
-
-ifdef NEEDUNITDIR
-override FPCOPT+=$(addprefix -Fu,$(NEEDUNITDIR))
-endif
-
-# Target dirs
-ifdef TARGETDIR
-override FPCOPT+=-FE$(TARGETDIR)
-endif
-
-# Smartlinking
-ifdef SMARTLINK
-override FPCOPT+=-CX
-endif
-
-# Debug
-ifdef DEBUG
-override FPCOPT+=-g
-endif
-
-# Add commandline options
-ifdef OPT
-override FPCOPT+=$(OPT)
-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
-
-# Add defines from FPCOPTDEF to FPCOPT
-ifdef FPCOPTDEF
-override FPCOPT+=$(FPCOPTDEF)
-endif
-
-# Error file ?
-ifdef ERRORFILE
-override FPCOPT+=-Fr$(ERRORFILE)
-endif
-
-# Was a config file specified ?
-ifdef CFGFILE
-override FPCOPT+=@$(CFGFILE)
-endif
-
-# For win32 the options are passed using the environment variable FPCEXTCMD
-ifeq ($(OS_SOURCE),win32)
-override FPCEXTCMD:=$(FPCOPT)
-override FPCOPT:=!FPCEXTCMD
-export FPCEXTCMD
-endif
-
-# Compiler commandline
-override COMPILER:=$(FPC) $(FPCOPT)
-
-#####################################################################
-# Shell tools
-#####################################################################
-
-# To copy pograms
-ifndef COPY
-COPY:=cp -fp
-endif
-
-# Copy a whole tree
-ifndef COPYTREE
-COPYTREE:=cp -rfp
-endif
-
-# To move pograms
-ifndef MOVE
-MOVE:=mv -f
-endif
-
-# Check delete program
-ifndef DEL
-DEL:=rm -f
-endif
-
-# Check deltree program
-ifndef DELTREE
-DELTREE:=rm -rf
-endif
-
-# To install files
-ifndef INSTALL
-ifdef inlinux
-INSTALL:=install -m 644
-else
-INSTALL:=$(COPY)
-endif
-endif
-
-# To install programs
-ifndef INSTALLEXE
-ifdef inlinux
-INSTALLEXE:=install -m 755
-else
-INSTALLEXE:=$(COPY)
-endif
-endif
-
-# To make a directory.
-ifndef MKDIR
-ifdef inlinux
-MKDIR:=install -m 755 -d
-else
-MKDIR:=ginstall -m 755 -d
-endif
-endif
-
-export COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR
-
-#####################################################################
-# Default Tools
-#####################################################################
-
-# assembler, redefine it if cross compiling
-ifndef AS
-AS=as
-endif
-
-# linker, but probably not used
-ifndef LD
-LD=ld
-endif
-
-# ppas.bat / ppas.sh
-ifdef inlinux
-PPAS=ppas.sh
-else
-ifdef inOS2
-PPAS=ppas.cmd
-else
-PPAS=ppas.bat
-endif
-endif
-
-# also call ppas if with command option -s
-ifeq (,$(findstring -s ,$(COMPILER)))
-EXECPPAS=
-else
-EXECPPAS:=@$(PPAS)
-endif
-
-# ldconfig to rebuild .so cache
-ifdef inlinux
-LDCONFIG=ldconfig
-else
-LDCONFIG=
-endif
-
-# echo
-ifndef ECHO
-ECHO:=$(strip $(wildcard $(addsuffix /echo$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ECHO),)
-ECHO:=echo
-else
-ECHO:=$(firstword $(ECHO))
-endif
-endif
-export ECHO
-
-# ppdep
-ifndef PPDEP
-PPDEP:=$(strip $(wildcard $(addsuffix /ppdep$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPDEP),)
-PPDEP=
-else
-PPDEP:=$(firstword $(PPDEP))
-endif
-endif
-export PPDEP
-
-# ppumove
-ifndef PPUMOVE
-PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUMOVE),)
-PPUMOVE=
-else
-PPUMOVE:=$(firstword $(PPUMOVE))
-endif
-endif
-export PPUMOVE
-
-# ppufiles
-ifndef PPUFILES
-PPUFILES:=$(strip $(wildcard $(addsuffix /ppufiles$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(PPUFILES),)
-PPUFILES=
-else
-PPUFILES:=$(firstword $(PPUFILES))
-endif
-endif
-export PPUFILES
-
-# Look if UPX is found for go32v2 and win32. We can't use $UPX becuase
-# upx uses that one itself (PFV)
-ifndef UPXPROG
-ifeq ($(OS_TARGET),go32v2)
-UPXPROG:=1
-endif
-ifeq ($(OS_TARGET),win32)
-UPXPROG:=1
-endif
-ifdef UPXPROG
-UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(UPXPROG),)
-UPXPROG=
-else
-UPXPROG:=$(firstword $(UPXPROG))
-endif
-else
-UPXPROG=
-endif
-endif
-export UPXPROG
-
-# gdate/date
-ifndef DATE
-DATE:=$(strip $(wildcard $(addsuffix /date$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(DATE),)
-DATE:=$(strip $(wildcard $(addsuffix /gdate$(EXEEXT),$(SEACHPATH))))
-ifeq ($(DATE),)
-DATE=
-else
-DATE:=$(firstword $(DATE))
-endif
-else
-DATE:=$(firstword $(DATE))
-endif
-endif
-export DATE
-
-ifdef DATE
-DATESTR:=$(shell $(DATE) +%Y%m%d)
-else
-DATESTR=
-endif
-
-# ZipProg, you can't use Zip as the var name (PFV)
-ifndef ZIPPROG
-ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(EXEEXT),$(SEARCHPATH))))
-ifeq ($(ZIPPROG),)
-ZIPPROG=
-else
-ZIPPROG:=$(firstword $(ZIPPROG)) -D9 -r
-endif
-endif
-export ZIPPROG
-
-ifndef ZIPEXT
-ZIPEXT=.zip
-endif
-
-#####################################################################
-# Default extensions
-#####################################################################
-
-# Default needed extensions (Go32v2,Linux)
-LOADEREXT=.as
-PPLEXT=.ppl
-PPUEXT=.ppu
-OEXT=.o
-ASMEXT=.s
-SMARTEXT=.sl
-STATICLIBEXT=.a
-SHAREDLIBEXT=.so
-PACKAGESUFFIX=
-FPCMADE=fpcmade
-
-# Go32v1
-ifeq ($(OS_TARGET),go32v1)
-PPUEXT=.pp1
-OEXT=.o1
-ASMEXT=.s1
-SMARTEXT=.sl1
-STATICLIBEXT=.a1
-SHAREDLIBEXT=.so1
-PACKAGESUFFIX=v1
-FPCMADE=fpcmade.v1
-endif
-
-# Go32v2
-ifeq ($(OS_TARGET),go32v2)
-PACKAGESUFFIX=go32
-FPCMADE=fpcmade.dos
-endif
-
-# Linux
-ifeq ($(OS_TARGET),linux)
-PACKAGESUFFIX=linux
-FPCMADE=fpcmade.lnx
-endif
-
-# Win32
-ifeq ($(OS_TARGET),win32)
-PPUEXT=.ppw
-OEXT=.ow
-ASMEXT=.sw
-SMARTEXT=.slw
-STATICLIBEXT=.aw
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=win32
-FPCMADE=fpcmade.w32
-endif
-
-# OS/2
-ifeq ($(OS_TARGET),os2)
-PPUEXT=.ppo
-ASMEXT=.so2
-OEXT=.oo2
-SMARTEXT=.so
-STATICLIBEXT=.ao2
-SHAREDLIBEXT=.dll
-PACKAGESUFFIX=os2
-FPCMADE=fpcmade.os2
-endif
-
-# library prefix
-LIBPREFIX=lib
-ifeq ($(OS_TARGET),go32v2)
-LIBPREFIX=
-endif
-ifeq ($(OS_TARGET),go32v1)
-LIBPREFIX=
-endif
-
-# determine which .pas extension is used
-ifndef PASEXT
-ifdef EXEOBJECTS
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(EXEOBJECTS)))))
-else
-override TESTPAS:=$(strip $(wildcard $(addsuffix .pas,$(firstword $(UNITOBJECTS)))))
-endif
-ifeq ($(TESTPAS),)
-PASEXT=.pp
-else
-PASEXT=.pas
-endif
-endif
-
-#####################################################################
-# Standard rules
-#####################################################################
-
-all: fpc_all
-
-debug: fpc_debug
-
-smart: fpc_smart
-
-shared: fpc_shared
-
-showinstall: fpc_showinstall
-
-install: fpc_install
-
-sourceinstall: fpc_sourceinstall
-
-zipinstall: fpc_zipinstall
-
-zipinstalladd: fpc_zipinstalladd
-
-clean: fpc_clean
-
-cleanall: fpc_cleanall
-
-info: fpc_info
-
-.PHONY:  all debug smart shared showinstall install sourceinstall zipinstall zipinstalladd clean cleanall info
-
-#####################################################################
-# Package depends
-#####################################################################
-
-ifneq ($(wildcard $(RTLDIR)),)
-ifeq ($(wildcard $(RTLDIR)/$(FPCMADE)),)
-override COMPILEPACKAGES+=rtl
-rtl_package:
-	$(MAKE) -C $(RTLDIR) all
-endif
-endif
-ifneq ($(wildcard $(FCLDIR)),)
-ifeq ($(wildcard $(FCLDIR)/$(FPCMADE)),)
-override COMPILEPACKAGES+=fcl
-fcl_package:
-	$(MAKE) -C $(FCLDIR) all
-endif
-endif
-
-.PHONY:  rtl_package fcl_package
-
-#####################################################################
-# Exes
-#####################################################################
-
-.PHONY: fpc_exes
-
-override EXEFILES=$(addsuffix $(EXEEXT),$(EXEOBJECTS))
-override EXEOFILES=$(addsuffix $(OEXT),$(EXEOBJECTS))
-
-override ALLTARGET+=fpc_exes
-override INSTALLEXEFILES+=$(EXEFILES)
-override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES)
-
-fpc_exes: $(EXEFILES)
-
-#####################################################################
-# General compile rules
-#####################################################################
-
-.PHONY: fpc_all fpc_debug
-
-$(FPCMADE):
-	@$(ECHO) Compiled > $(FPCMADE)
-
-fpc_all: $(addsuffix _package,$(COMPILEPACKAGES)) \
-	 $(addsuffix _component,$(COMPILECOMPONENTS)) \
-	 $(ALLTARGET) $(FPCMADE)
-
-fpc_debug:
-	$(MAKE) all DEBUG=1
-
-# General compile rules, available for both possible PASEXT
-
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp
-
-%$(PPUEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(PPUEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pp
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-%$(EXEEXT): %.pas
-	$(COMPILER) $< $(REDIR)
-	$(EXECPASS)
-
-#####################################################################
-# Library
-#####################################################################
-
-.PHONY: fpc_smart fpc_shared
-
-# Default sharedlib units are all unit objects
-ifndef SHAREDLIBUNITOBJECTS
-SHAREDLIBUNITOBJECTS:=$(UNITOBJECTS)
-endif
-
-fpc_smart:
-	$(MAKE) all SMARTLINK=1
-
-fpc_shared: all
-ifdef inlinux
-ifndef LIBNAME
-	@$(ECHO) "LIBNAME not set"
-else
-	$(PPUMOVE) $(SHAREDLIBUNITOBJECTS) -o$(LIBNAME)
-endif
-else
-	@$(ECHO) "Shared Libraries not supported"
-endif
-
-#####################################################################
-# Install rules
-#####################################################################
-
-.PHONY: fpc_showinstall fpc_install
-
-ifdef EXTRAINSTALLUNITS
-override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRAINSTALLUNITS))
-endif
-
-ifdef INSTALLPPUFILES
-ifdef PPUFILES
-ifdef inlinux
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) -S -O $(INSTALLPPUFILES))
-INSTALLPPULIBFILES:=$(shell $(PPUFILES) -L $(INSTALLPPUFILES))
-else
-INSTALLPPULINKFILES:=$(shell $(PPUFILES) $(INSTALLPPUFILES))
-endif
-else
-INSTALLPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)))
-endif
-endif
-
-fpc_showinstall: $(SHOWINSTALLTARGET)
-ifdef INSTALLEXEFILES
-	@$(ECHO) -e $(addprefix "\n"$(BININSTALLDIR)/,$(INSTALLEXEFILES))
-endif
-ifdef INSTALLPPUFILES
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPUFILES))
-ifneq ($(INSTALLPPULINKFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(UNITINSTALLDIR)/,$(INSTALLPPULINKFILES))
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	@$(ECHO) -e $(addprefix "\n"$(LIBINSTALLDIR)/,$(INSTALLPPULIBFILES))
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	@$(ECHO) -e $(addprefix "\n"$(EXTRAINSTALLDIR)/,$(EXTRAINSTALLFILES))
-endif
-
-fpc_install: $(INSTALLTARGET)
-# Create UnitInstallFiles
-ifdef INSTALLEXEFILES
-	$(MKDIR) $(BININSTALLDIR)
-# Compress the exes if upx is defined
-ifdef UPXPROG
-	-$(UPXPROG) $(INSTALLEXEFILES)
-endif
-	$(INSTALLEXE) $(INSTALLEXEFILES) $(BININSTALLDIR)
-endif
-ifdef INSTALLPPUFILES
-	$(MKDIR) $(UNITINSTALLDIR)
-	$(INSTALL) $(INSTALLPPUFILES) $(UNITINSTALLDIR)
-ifneq ($(INSTALLPPULINKFILES),)
-	$(INSTALL) $(INSTALLPPULINKFILES) $(UNITINSTALLDIR)
-endif
-ifneq ($(INSTALLPPULIBFILES),)
-	$(MKDIR) $(LIBINSTALLDIR)
-	$(INSTALL) $(INSTALLPPULIBFILES) $(LIBINSTALLDIR)
-endif
-endif
-ifdef EXTRAINSTALLFILES
-	$(MKDIR) $(EXTRAINSTALLDIR)
-	$(INSTALL) $(EXTRAINSTALLFILES) $(EXTRAINSTALLDIR)
-endif
-
-#####################################################################
-# Source install rules
-#####################################################################
-
-.PHONY: fpc_sourceinstall
-
-fpc_sourceinstall: clean
-	$(MKDIR) $(SOURCEINSTALLDIR)
-	$(COPYTREE) $(BASEDIR) $(SOURCEINSTALLDIR)
-
-#####################################################################
-# Zip
-#####################################################################
-
-.PHONY: fpc_zipinstall fpc_zipinstalladd
-
-# Temporary path to pack a file
-ifndef PACKDIR
-ifndef inlinux
-PACKDIR=pack_tmp
-else
-PACKDIR=/tmp/fpc-pack
-endif
-endif
-
-# Test dir if none specified
-ifndef DESTZIPDIR
-DESTZIPDIR:=$(BASEDIR)
-endif
-
-# Add .zip/.tar.gz extension
-ifdef ZIPNAME
-ifndef inlinux
-override ZIPNAME:=$(ZIPNAME)$(ZIPEXT)
-endif
-endif
-
-# Note: This will not remove the zipfile first
-fpc_zipinstalladd:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	gzip -d $(DESTZIPDIR)/$(ZIPNAME).tar.gz
-	cd $(PACKDIR) ; tar rv --file $(DESTZIPDIR)/$(ZIPNAME).tar * ; cd $(BASEDIR)
-	gzip $(DESTZIPDIR)/$(ZIPNAME).tar
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-# First remove the zip and then install
-fpc_zipinstall:
-ifndef ZIPNAME
-	@$(ECHO) "Please specify ZIPNAME!"
-	@exit 1
-else
-	$(DEL) $(DESTZIPDIR)/$(ZIPNAME)
-	$(MAKE) $(ZIPTARGET) PREFIXINSTALLDIR=$(PACKDIR)
-ifdef inlinux
-	cd $(PACKDIR) ; tar cvz --file $(DESTZIPDIR)/$(ZIPNAME).tar.gz * ; cd $(BASEDIR)
-else
-	cd $(PACKDIR) ; $(ZIPPROG) $(DESTZIPDIR)/$(ZIPNAME) * ; cd $(BASEDIR)
-endif
-	$(DELTREE) $(PACKDIR)
-endif
-
-#####################################################################
-# Clean rules
-#####################################################################
-
-.PHONY: fpc_clean fpc_cleanall
-
-ifdef EXTRACLEANUNITS
-override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(EXTRACLEANUNITS))
-endif
-
-ifdef CLEANPPUFILES
-ifdef PPUFILES
-CLEANPPULINKFILES:=$(shell $(PPUFILES) $(CLEANPPUFILES))
-else
-CLEANPPULINKFILES:=$(wildcard $(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)))
-endif
-endif
-
-fpc_clean: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-ifdef CLEANPPUFILES
-	-$(DEL) $(CLEANPPUFILES)
-endif
-ifneq ($(CLEANPPULINKFILES),)
-	-$(DEL) $(CLEANPPULINKFILES)
-endif
-ifdef EXTRACLEANFILES
-	-$(DEL) $(EXTRACLEANFILES)
-endif
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-fpc_cleanall: $(CLEANTARGET)
-ifdef CLEANEXEFILES
-	-$(DEL) $(CLEANEXEFILES)
-endif
-	-$(DEL) *$(OEXT) *$(PPUEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT)
-	-$(DELTREE) *$(SMARTEXT)
-	-$(DEL) $(FPCMADE) $(PPAS) link.res $(REDIRFILE)
-
-#####################################################################
-# Info rules
-#####################################################################
-
-.PHONY: fpc_info fpc_cfginfo fpc_objectinfo fpc_toolsinfo fpc_installinfo \
-	fpc_dirinfo
-
-fpc_info: $(INFOTARGET)
-
-fpc_infocfg:
-	@$(ECHO)
-	@$(ECHO)  == Configuration info ==
-	@$(ECHO)
-	@$(ECHO)  FPC....... $(FPC)
-	@$(ECHO)  Version... $(FPC_VERSION)
-	@$(ECHO)  CPU....... $(CPU_TARGET)
-	@$(ECHO)  Source.... $(OS_SOURCE)
-	@$(ECHO)  Target.... $(OS_TARGET)
-	@$(ECHO)
-
-fpc_infoobjects:
-	@$(ECHO)
-	@$(ECHO)  == Object info ==
-	@$(ECHO)
-	@$(ECHO)  LoaderObjects..... $(LOADEROBJECTS)
-	@$(ECHO)  UnitObjects....... $(UNITOBJECTS)
-	@$(ECHO)  ExeObjects........ $(EXEOBJECTS)
-	@$(ECHO)
-	@$(ECHO)  ExtraCleanUnits... $(EXTRACLEANUNITS)
-	@$(ECHO)  ExtraCleanFiles... $(EXTRACLEANFILES)
-	@$(ECHO)
-	@$(ECHO)  ExtraInstallUnits. $(EXTRAINSTALLUNITS)
-	@$(ECHO)  ExtraInstallFiles. $(EXTRAINSTALLFILES)
-	@$(ECHO)
-
-fpc_infoinstall:
-	@$(ECHO)
-	@$(ECHO)  == Install info ==
-	@$(ECHO)
-ifdef DATE
-	@$(ECHO)  DateStr.............. $(DATESTR)
-endif
-	@$(ECHO)  PackageSuffix........ $(PACKAGESUFFIX)
-	@$(ECHO)
-	@$(ECHO)  BaseInstallDir....... $(BASEINSTALLDIR)
-	@$(ECHO)  BinInstallDir........ $(BININSTALLDIR)
-	@$(ECHO)  LibInstallDir........ $(LIBINSTALLDIR)
-	@$(ECHO)  UnitInstallDir....... $(UNITINSTALLDIR)
-	@$(ECHO)  SourceInstallDir..... $(SOURCEINSTALLDIR)
-	@$(ECHO)  DocInstallDir........ $(DOCINSTALLDIR)
-	@$(ECHO)  ExtraInstallDir...... $(EXTRAINSTALLDIR)
-	@$(ECHO)
-

fcl/tests/Makefile.fpc

@@ -1,22 +0,0 @@
-#
-#   Makefile.fpc for Free Component Library Examples/Tests
-#
-
-[targets]
-programs=stringl dparser fstream mstream list threads testrtf \
-         cfgtest xmldump htdump testcgi tidea \
-         b64test b64test2 b64enc b64dec restest
-programs_win32=testz testz2
-
-[clean]
-files=restest.rst
-
-[packages]
-fcl=1
-
-[dirs]
-fpcdir=../..
-targetdir=.
-
-[defaults]
-defaultoptions=-S2

fcl/tests/README

@@ -1,36 +0,0 @@
-This directory contains test programs for different elements/classes in
-the FCL. 
-
-If you add a test give in this file a short description of what 
-class/function it tests, and your initials..
-
-Names
------
-MVC : Michael Van Canneyt
-SG  : Sebastian Guenther
-MH  : Michael Hess
-
-
-File         Tests what ?
-----         ------------
-
-list.pp      TList object from unit 'classes'.  (MVC)
-mstream.pp   TMemorySteam object from unit 'classes' (MVC)
-fstream.pp   TFileStream object from unit 'classes' (MVC)
-dparser.pp   TParser object from unit 'classes' (MVC)
-stringl.pp   TStringList object from unit classes' (MVC) 
-thread.pp    TTHread object from unit classes (PFV)
-testz.pp     T(De)Compressionstream objects from Zstream (MVC)
-testz2.pp    TGZFilestream object from Zstream (MVC)
-testrtf.pp   TRTFParser object from rtfpars (MVC)
-cfgtest.pp   Example for using XML read/write as cfg file (SG)
-xmldump.pp   xml dump program (SG)
-htdump.pp    htdump dumps XL IDL definition as ObjectPascal classes (MVC)
-testcgi.pp   test program for ezcgi class (MH)
-tidea.pp     test program for IDEA encryption/decryption streams (MVC)
-b64test.pp   test program for base64 encoding streams (SG)
-b64test2.pp  test program for base64 encoding streams (SG)
-b64enc.pp    base64-encodes StdIn to StdOut (SG)
-b64dec.pp    base64-decodes StdIn to StdOut (SG)
-restest.pp   test program for resourcestrings with GNU gettext. (MVC)
-             (see also intl subdirectory)

fcl/tests/b64dec.pp

@@ -1,41 +0,0 @@
-// $Id$
-
-// base64-decodes data from StdIn and writes the output to StdOut
-// (c) 1999 Sebastian Guenther
-
-{$MODE objfpc}
-
-program b64dec;
-uses classes, base64, sysutils;
-var
-  b64decoder: TBase64DecodingStream;
-  InputStream: TStream;
-  IsEnd: Boolean;
-begin
-
-  InputStream := THandleStream.Create(StdInputHandle);
-
-  b64decoder := TBase64DecodingStream.Create(InputStream);
-
-  IsEnd := False;
-  while not IsEnd do
-    try
-      Write(Chr(b64decoder.ReadByte));
-    except
-      on e: EStreamError do IsEnd := True;
-    end;
-
-  b64decoder.Free;
-  InputStream.Free;
-end.
-
-
-{
-  $Log$
-  Revision 1.2  1999-08-13 16:31:43  michael
-  + Patch to support sizeless streams by Sebastian Guenter
-
-  Revision 1.1  1999/08/09 16:12:26  michael
-  * Fixes and new examples from Sebastian Guenther
-
-}

fcl/tests/b64enc.pp

@@ -1,39 +0,0 @@
-// $Id$
-
-// base64-encodes data from StdIn and writes the output to StdOut
-// (c) 1999 Sebastian Guenther
-
-{$MODE objfpc}
-
-program b64enc;
-uses classes, base64, sysutils;
-var
-  b64encoder: TBase64EncodingStream;
-  InputStream, OutputStream: TStream;
-  IsEnd: Boolean;
-begin
-
-  InputStream := THandleStream.Create(StdInputHandle);
-  OutputStream := THandleStream.Create(StdOutputHandle);
-
-  b64encoder := TBase64EncodingStream.Create(OutputStream);
-
-  while not IsEnd do
-    try
-      b64encoder.WriteByte(InputStream.ReadByte);
-    except
-      on e: EStreamError do IsEnd := True;
-    end;
-
-  b64encoder.Free;
-  InputStream.Free;
-  OutputStream.Free;
-end.
-
-
-{
-  $Log$
-  Revision 1.1  1999-08-09 16:12:26  michael
-  * Fixes and new examples from Sebastian Guenther
-
-}

fcl/tests/b64test.pp

@@ -1,35 +0,0 @@
-{$MODE objfpc}
-
-program b64test;
-uses classes, base64, sysutils;
-var
-  b64encoder: TBase64EncodingStream;
-  b64decoder: TBase64DecodingStream;
-  BaseStream: TStream;
-  i, j: Integer;
-begin
-  BaseStream := TMemoryStream.Create;
-
-  WriteLn('Encoded Size / Decoded Size / Data:');
-
-  for i := 1 to 22 do begin
-    BaseStream.Position := 0;
-
-    b64encoder := TBase64EncodingStream.Create(BaseStream);
-    for j := 1 to i do
-      b64encoder.WriteByte(i - j + 65);
-    Write(b64encoder.Size: 2, ' ');
-    b64encoder.Free;
-
-    BaseStream.Position := 0;
-
-    b64decoder := TBase64DecodingStream.Create(BaseStream);
-    Write(b64decoder.Size: 2, ' ');
-    for j := 1 to i do
-      Write(Chr(b64decoder.ReadByte));
-    WriteLn;
-    b64decoder.Free;
-  end;
-
-  BaseStream.Free;
-end.

fcl/tests/b64test2.pp

@@ -1,37 +0,0 @@
-{$MODE objfpc}
-
-program b64test;
-uses classes, base64, sysutils;
-var
-  b64encoder: TBase64EncodingStream;
-  b64decoder: TBase64DecodingStream;
-  BaseStream: TStream;
-  i, j: Integer;
-  buf: array[1..23] of Char;
-begin
-  BaseStream := TMemoryStream.Create;
-
-  WriteLn('Encoded Size / Decoded Size / Data:');
-
-  for i := 1 to 22 do begin
-    BaseStream.Position := 0;
-
-    b64encoder := TBase64EncodingStream.Create(BaseStream);
-    for j := 1 to i do
-      buf[j] := Chr(i - j + 65);
-    b64encoder.Write(buf, i);
-    Write(b64encoder.Size: 2, ' ');
-    b64encoder.Free;
-
-    BaseStream.Position := 0;
-
-    b64decoder := TBase64DecodingStream.Create(BaseStream);
-    Write(b64decoder.Size: 2, ' ');
-    b64decoder.Read(buf, i);
-    buf[i + 1] := #0;
-    WriteLn(buf);
-    b64decoder.Free;
-  end;
-
-  BaseStream.Free;
-end.

fcl/tests/cfgtest.pp

@@ -1,63 +0,0 @@
-// $Id$
-
-{$MODE objfpc}
-{$H+}
-
-program cfgtest;
-uses xmlcfg;
-var
-  cfg: TXMLConfig;
-  i: Integer;
-  s: String;
-  b: Boolean;
-begin
-
-  WriteLn('Writing a sample XML configuration to "testcfg.xml"...');
-
-  cfg := TXMLConfig.Create('testcfg.xml');
-  cfg.SetValue('cfgtest/MainWindow/Constraints/Width', 600);
-  cfg.SetValue('cfgtest/MainWindow/Constraints/Height', 400);
-  cfg.SetValue('cfgtest/MainWindow/Caption', 'TXMLConfig Test');
-  cfg.SetValue('cfgtest/SomeForm/Presets/Preset1/Name', 'Example');
-  cfg.SetValue('TipOfTheDay/Disabled', True);
-  cfg.Free;
-
-  WriteLn('Ok; now I''ll try to read back all values...');
-
-  cfg := TXMLConfig.Create('testcfg.xml');
-
-  i := cfg.GetValue('cfgtest/MainWindow/Constraints/Width', 0);
-  if i <> 600 then
-    WriteLn('Invalid value: cfgtest/MainWindow/Constraints/Width, got ', i);
-
-  i := cfg.GetValue('cfgtest/MainWindow/Constraints/Height', 400);
-  if i <> 400 then
-    WriteLn('Invalid value: cfgtest/MainWindow/Constraints/Height, got ', i);
-
-  s := cfg.GetValue('cfgtest/MainWindow/Caption', '');
-  if s <> 'TXMLConfig Test' then
-    WriteLn('Invalid value: cfgtest/MainWindow/Caption, got "', s, '"');
-
-  s := cfg.GetValue('cfgtest/SomeForm/Presets/Preset1/Name', '');
-  if s <> 'Example' then
-    WriteLn('Invalid value: cfgtest/SomeForm/Presets/Preset1/Name, got "', s, '"');
-
-  b := cfg.GetValue('TipOfTheDay/Disabled', False);
-  if b <> True then
-    WriteLn('Invalid value: TipOfTheDay/Disabled, got ', b);
-  cfg.Free;
-
-  WriteLn('Done!');
-end.
-
-
-{
-  $Log$
-  Revision 1.2  1999-12-22 13:43:14  sg
-  * Improved messages in the case of failure: Now the test prints the results
-    it got from the XMLCfg unit
-
-  Revision 1.1  1999/07/09 21:06:59  michael
-  + Initial implementation by sebastian Guenther
-
-}

fcl/tests/dparser.pp

@@ -1,37 +0,0 @@
-Program DParser;
-
-uses Classes;
-
-var
-  InFile           : TFileStream;
-  Parser           : TParser;
-begin
-  InFile := TFileStream.Create('parser.dat', fmOpenRead);
-  if Assigned(InFile) then begin
-    try
-      Parser := TParser.Create(InFile);
-      if Assigned(Parser) then begin
-        try
-          while Parser.Token <> toEOF do begin
-            case Parser.Token of
-              toInteger : WriteLn('Found integer: "', Parser.TokenInt, '"');
-              toFloat   : WriteLn('Found float:   "', Parser.TokenFloat, '"');
-              toString  : WriteLn('Found string:  "', Parser.TokenString, '"');
-              toSymbol  : WriteLn('Found symbol:  "', Parser.TokenString, '"');
-            else
-              // Skip all other characters
-              ;             
-            end;
-            Parser.NextToken;
-          end;
-        finally
-          WriteLn('Freeing parser object');
-          Parser.Free;
-        end;
-      end;
-    finally
-      WriteLn('Freeing infile object');
-      InFile.Free;
-    end;
-  end;
-end.

fcl/tests/fpdoc.dtd

@@ -1,54 +0,0 @@
-<!-- $Id$
-  XML Document Type Definition (DTD) for FreePascal/KCL fpdoc documents.
-  This DTD is not finished yet!!! Currently it is mainly used as a demo/test
-  for the new FCL XML units.
-
-  (c) 1999 Sebastian Guenther, [email protected]
--->
-
-
-<!-- Elements used for descriptions -->
-
-<!ELEMENT DESCR (#PCDATA|REF)*>
-
-<!ELEMENT REF (DESCR)>
-<!ATTLIST REF dest CDATA #IMPLIED>
-
-
-<!-- Elements used for building up the logical structure -->
-
-<!ELEMENT DOC (LIBRARY|UNIT|PROGRAM)>
-<!ATTLIST DOC name CDATA #REQUIRED version CDATA #IMPLIED xml:lang NMTOKEN "en">
-
-<!ELEMENT LIBRARY ((DESCR)?, (UNIT)*)>
-
-<!ELEMENT UNIT ((DESCR)?, (CONST|VAR|PROCEDURE|FUNCTION|CLASS)+)>
-
-
-<!ELEMENT CONST (DESCR)?>
-<!ATTLIST CONST name CDATA #REQUIRED  type CDATA #REQUIRED>
-
-<!ELEMENT VAR (DESCR)?>
-<!ATTLIST VAR name CDATA #REQUIRED  type CDATA #REQUIRED>
-
-<!ELEMENT PROCEDURE ((DESCR)?,(ARG)*)>
-<!ATTLIST PROCEDURE name CDATA #REQUIRED>
-
-<!ELEMENT FUNCTION ((DESCR)?,(ARG)*,(RESULT))>
-<!ATTLIST FUNCTION name CDATA #REQUIRED>
-
-<!ELEMENT ARG (DESCR)?>
-<!ATTLIST ARG name CDATA #REQUIRED  type CDATA #IMPLIED  ref (const|var) #IMPLIED>
-
-<!ELEMENT CLASS ((DESCR)?, (PUBLIC|PROTECTED|PRIVATE|PUBLISHED|CONSTRUCTOR|DESTRUCTOR|PROCEDURE|FUNCTION|VAR)*)>
-<!ATTLIST CLASS name CDATA #REQUIRED  ancestor CDATA #IMPLIED>
-<!ELEMENT PUBLIC EMPTY>
-<!ELEMENT PROTECTED EMPTY>
-<!ELEMENT PRIVATE EMPTY>
-<!ELEMENT PUBLISHED EMPTY>
-
-<!ELEMENT CONSTRUCTOR ((DESCR)?,(ARG)*)>
-<!ATTLIST CONSTRUCTOR name CDATA "Create">
-
-<!ELEMENT DESTRUCTOR ((DESCR)?,(ARG)*)>
-<!ATTLIST DESTRUCTOR name CDATA "Destroy">

fcl/tests/fstream.pp

@@ -1,52 +0,0 @@
-Program TestStream;
-
-uses classes;
-
-Var Stream : TFileStream;
-    S,T : String;
-   
-begin
-  S:='ABCDEFGHIJKLMNOPQRSTUVWXYZ';
-  T:=S;
-  Writeln ('Creating stream.');
-  Stream:=TFileStream.Create('Test2.dat',fmcreate);
-  Writeln ('Initial Size : ',Stream.Size);
-  Writeln ('Initial Position : ',Stream.Position);
-  Stream.WriteByte  (1);
-  Stream.WriteWord  (2);
-  Stream.WriteDWord (3);
-  Stream.WriteBuffer (S[1],Length(S));
-  Writeln ('Stream Size is : ',Stream.Size);
-  Stream.Seek(0,soFromBeginning);
-  If Stream.ReadByte<>1 then  Writeln ('First byte not 1');
-  If Stream.ReadWord<>2 then  Writeln ('First word not 2');
-  If Stream.ReadDWord<>3 then Writeln ('First DWord not 3');
-  If Stream.Read(T[1],Length(S))<>Length(S) then 
-    Writeln ('Couldn''t read string.');
-  Writeln ('Second pass.');
-  Stream.WriteByte  (1);
-  Stream.WriteWord  (2);
-  Stream.WriteDWord (3);
-  Stream.WriteBuffer (S[1],Length(S));
-  Writeln ('Stream Size is : ',Stream.Size);
-  Writeln ('Stream Position is : ',Stream.Position);
-  Writeln ('Freeing stream.');
-  Stream.Free;
-  Writeln ('Creating stream Read-Only');
-  Stream:=TFileStream.Create('Test2.dat',fmOpenRead);
-  Writeln ('Stream Size is : ',Stream.Size);
-  Stream.Seek(0,soFromBeginning);
-  If Stream.ReadByte<>1 then  Writeln ('First byte not 1');
-  If Stream.ReadWord<>2 then  Writeln ('First word not 2');
-  If Stream.ReadDWord<>3 then Writeln ('First DWord not 3');
-  If Stream.Read(T[1],Length(S))<>Length(S) then 
-    Writeln ('Couldn''t read string.');
-  If Stream.ReadByte<>1 then  Writeln ('Second byte not 1');
-  If Stream.ReadWord<>2 then  Writeln ('Second word not 2');
-  If Stream.ReadDWord<>3 then Writeln ('Second DWord not 3');
-  If Stream.Read(T[1],Length(S))<>Length(S) then 
-    Writeln ('Couldn''t read string.');
-  Writeln ('Stream Size is : ',Stream.Size);
-  Writeln ('Stream Position is : ',Stream.Position);
-  Stream.Free;
-end.

fcl/tests/htdump.pp

@@ -1,191 +0,0 @@
-// $Id$
-
-{
-  This program takes an W3 IDL XML file with interface definitions and
-  dumps a interface definition.
-}
-
-{$MODE objfpc}
-{$H+}
-
-program htdump;
-
-uses sysutils, DOM, xmlread;
-
-Var DoImplementation : Boolean;
-
-procedure DumpNode(node: TDOMNode; spc: String);forward;
-
-procedure DumpMethodNode(node: TDOMElement; spc: String);
-
-var N,NN : TDOMNode;
-    rettype : DOMString;
-    firstparam : boolean;
-    i : longint;
-
-begin
-
-   N:=Node.FindNode('returns');
-   If N<>Nil then
-      rettype:=TDomElement(N).GetAttribute('type');
-   If Not DoImplementation then
-     Write (spc);
-   If RetType='void' then
-     Write ('Procedure ')
-   else
-     Write ('Function ');
-   If DoImplementation then
-     Write(TDomElement(Node.ParentNode).GetAttribute('name'),'.');
-   Write (Node.GetAttribute('name'));
-   N:=Node.FindNode('params');
-   If N<>Nil then
-     begin
-     FirstParam:=True;
-     for I:=1 to N.ChildNodes.Count-1 do
-       begin
-       NN:=N.ChildNodes.Item[i];
-       If NN.NodeName<>'param' then
-         begin
-         If Firstparam then
-           begin
-           Write('(');
-           FirstParam:=False
-           end
-         else
-           Write(';');
-         writeln (spc,NN.NodeName,' : ',TDOMElement(NN).GetAttribute('type'));
-         end;
-       end;
-     If Not FirstParam then
-     Write (')');
-     end;
-   If RetType <>'void' then
-     Write (' : ',Rettype);
-   Writeln(';');
-   If DoImplementation then
-     begin
-     Writeln;
-     Writeln('Begin');
-     Writeln('End;');
-     Writeln;
-     Writeln;
-     end;
-end;
-
-procedure DumpAttributeNode(Doprivate: Boolean;node: TDOMElement; spc: String);
-
-Var PropName : DOMString;
-
-begin
-  PropName:=Node.GetAttribute('name');
-  If DOPrivate then
-    Write (spc,'F')
-  else
-    Write (spc,'Property ');
-  Write (PropName,' : ',Node.getAttribute('type'));
-  If Not DoPrivate then
-    begin
-    Write (' Read F',PropName);
-    If not(Node.getAttribute('readonly')='yes') then
-      Write (' Write F',PropName)
-    end;
-  Writeln(';');
-end;
-
-Procedure DumpInterfaceNode (node : TDomElement; spc : String);
-
-Var N : TDOMNode;
-    C : TDOMNodeList;
-    I : longint;
-
-begin
-  If not DoImplementation then
-    begin
-    Write(spc,Node.GetAttribute('name'),' = Class');
-    N:=Node.Attributes.GetNamedItem('inherits');
-    If N<>Nil then
-      Write('(',N.NodeValue,')');
-    Writeln;
-    // Dump Property fields
-    Writeln (Spc+'  Private');
-    N:=Node.FirstChild;
-    While N<>Nil do
-      begin
-      If N.NodeName='attribute' then
-          DumpAttributeNode(True,TDOMElement(N), spc + '    ');
-      N:=N.NextSibling;
-      end;
-    Writeln (Spc,'  Public');
-    end;
-  N:=Node.FirstChild;
-  While N<>Nil do
-    begin
-    If N.NodeName='method' then
-       DumpMethodNode(TDomElement(N), spc + '    ');
-    N:=N.NextSibling;
-    end;
-  If Not DoImplementation then
-    begin
-    N:=Node.FirstChild;
-    While N<>Nil do
-      begin
-      If N.NodeName='attribute' then
-         DumpAttributeNode(False,TDomElement(N), spc + '    ');
-      N:=N.NextSibling;
-      end;
-    writeln (spc,'End;')
-    end;
-end;
-
-procedure DumpNode(node: TDOMNode; spc: String);
-
-var
-  i: Integer;
-  attr: TDOMNode;
-begin
-  If Node.NodeName='interface' then
-    DumpInterfaceNode(TDOMElement(Node),Spc)
-  else if Node.NodeName='method' then
-    DumpMethodNode(TDOMELEMENt(Node),Spc)
-  else if Node.NodeName='attribute' then
-    DumpAttributeNode(True,TDomelement(node),spc)
-  else
-    if node.FirstChild <> nil then
-      DumpNode(node.FirstChild, spc + '  ');
-  if node.NextSibling <> nil then
-    DumpNode(node.NextSibling, spc);
-end;
-
-var
-  i : longint;
-  xml: TXMLDocument;
-
-begin
-  if (ParamCount <1) or (paramcount>2) then begin
-    WriteLn('htdump -m <xml>');
-    exit;
-  end;
-  I:=1;
-  If paramstr(1)='-m' then
-    begin
-    I:=2;
-    DoImplementation:=True;
-    end;
-  ReadXMLFile(xml, ParamStr(i));
-  WriteLn ('// Created From file ',paramstr(I));
-  DumpNode(xml, '');
-end.
-
-
-{
-  $Log$
-  Revision 1.2  1999-11-09 14:39:56  peter
-    * fpcmake updates
-
-  Revision 1.1  1999/07/11 22:43:22  michael
-  + Added htdump
-
-  Revision 1.1  1999/07/09 21:06:59  michael
-  + Initial implementation by sebastian Guenther
-
-}

fcl/tests/intl/Makefile

@@ -1,20 +0,0 @@
-#
-# Makefile to make the internationalization files for the resstr example
-# Add a 2 letter code when adding a language to DEMOLANGUAGES
-#
-
-DEMOLANGUAGES=fr nl de
-
-#
-# No need to add after this line.
-#
-
-OBJECTS=$(addprefix restest.,$(DEMOLANGUAGES))
-MOOBJECTS=$(addsuffix .mo,$(OBJECTS))
-
-.SUFFIXES: .mo .po
-
-%.mo: %.po
-	msgfmt -o $@ $?
-
-all: $(MOOBJECTS)