diff --git a/.gitattributes b/.gitattributes index 29690921e4..cd90fda85f 100644 --- a/.gitattributes +++ b/.gitattributes @@ -4106,6 +4106,13 @@ packages/fcl-db/src/base/dsparams.inc svneol=native#text/plain packages/fcl-db/src/base/fields.inc svneol=native#text/plain packages/fcl-db/src/base/fpmake.inc svneol=native#text/plain packages/fcl-db/src/base/fpmake.pp svneol=native#text/plain +packages/fcl-db/src/codegen/Makefile svneol=native#text/plain +packages/fcl-db/src/codegen/Makefile.fpc svneol=native#text/plain +packages/fcl-db/src/codegen/fpcgcreatedbf.pp svneol=native#text/plain +packages/fcl-db/src/codegen/fpcgdbcoll.pp svneol=native#text/plain +packages/fcl-db/src/codegen/fpcgsqlconst.pp svneol=native#text/plain +packages/fcl-db/src/codegen/fpcgtiopf.pp svneol=native#text/plain +packages/fcl-db/src/codegen/fpddcodegen.pp svneol=native#text/plain packages/fcl-db/src/datadict/Makefile svneol=native#text/plain packages/fcl-db/src/datadict/Makefile.fpc svneol=native#text/plain packages/fcl-db/src/datadict/buildd.lpi svneol=native#text/plain diff --git a/packages/fcl-db/src/codegen/Makefile b/packages/fcl-db/src/codegen/Makefile new file mode 100644 index 0000000000..6467743360 --- /dev/null +++ b/packages/fcl-db/src/codegen/Makefile @@ -0,0 +1,2111 @@ +# +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2007/11/14] +# +default: all +MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded +BSDs = freebsd netbsd openbsd darwin +UNIXs = linux $(BSDs) solaris qnx +LIMIT83fs = go32v2 os2 emx watcom +OSNeedsComspecToRunBatch = go32v2 watcom +FORCE: +.PHONY: FORCE +override PATH:=$(patsubst %/,%,$(subst \,/,$(PATH))) +ifneq ($(findstring darwin,$(OSTYPE)),) +inUnix=1 #darwin +SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) +else +ifeq ($(findstring ;,$(PATH)),) +inUnix=1 +SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH))) +else +SEARCHPATH:=$(subst ;, ,$(PATH)) +endif +endif +SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE)))) +PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH)))) +ifeq ($(PWD),) +PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH)))) +ifeq ($(PWD),) +$(error You need the GNU utils package to use this Makefile) +else +PWD:=$(firstword $(PWD)) +SRCEXEEXT= +endif +else +PWD:=$(firstword $(PWD)) +SRCEXEEXT=.exe +endif +ifndef inUnix +ifeq ($(OS),Windows_NT) +inWinNT=1 +else +ifdef OS2_SHELL +inOS2=1 +endif +endif +else +ifneq ($(findstring cygdrive,$(PATH)),) +inCygWin=1 +endif +endif +ifdef inUnix +SRCBATCHEXT=.sh +else +ifdef inOS2 +SRCBATCHEXT=.cmd +else +SRCBATCHEXT=.bat +endif +endif +ifdef COMSPEC +ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),) +RUNBATCH=$(COMSPEC) /C +endif +endif +ifdef inUnix +PATHSEP=/ +else +PATHSEP:=$(subst /,\,/) +ifdef inCygWin +PATHSEP=/ +endif +endif +ifdef PWD +BASEDIR:=$(subst \,/,$(shell $(PWD))) +ifdef inCygWin +ifneq ($(findstring /cygdrive/,$(BASEDIR)),) +BASENODIR:=$(patsubst /cygdrive%,%,$(BASEDIR)) +BASEDRIVE:=$(firstword $(subst /, ,$(BASENODIR))) +BASEDIR:=$(subst /cygdrive/$(BASEDRIVE)/,$(BASEDRIVE):/,$(BASEDIR)) +endif +endif +else +BASEDIR=. +endif +ifdef inOS2 +ifndef ECHO +ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO=echo +else +ECHO:=$(firstword $(ECHO)) +endif +else +ECHO:=$(firstword $(ECHO)) +endif +endif +export ECHO +endif +override DEFAULT_FPCDIR=../../../.. +ifndef FPC +ifdef PP +FPC=$(PP) +endif +endif +ifndef FPC +FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH)))) +ifneq ($(FPCPROG),) +FPCPROG:=$(firstword $(FPCPROG)) +ifneq ($(CPU_TARGET),) +FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB) +else +FPC:=$(shell $(FPCPROG) -PB) +endif +ifneq ($(findstring Error,$(FPC)),) +override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +endif +else +override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +endif +endif +override FPC:=$(subst $(SRCEXEEXT),,$(FPC)) +override FPC:=$(subst \,/,$(FPC))$(SRCEXEEXT) +FOUNDFPC:=$(strip $(wildcard $(FPC))) +ifeq ($(FOUNDFPC),) +FOUNDFPC=$(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))) +ifeq ($(FOUNDFPC),) +$(error Compiler $(FPC) not found) +endif +endif +ifndef FPC_COMPILERINFO +FPC_COMPILERINFO:=$(shell $(FPC) -iVSPTPSOTO) +endif +ifndef FPC_VERSION +FPC_VERSION:=$(word 1,$(FPC_COMPILERINFO)) +endif +export FPC FPC_VERSION FPC_COMPILERINFO +unexport CHECKDEPEND ALLDEPENDENCIES +ifndef CPU_TARGET +ifdef CPU_TARGET_DEFAULT +CPU_TARGET=$(CPU_TARGET_DEFAULT) +endif +endif +ifndef OS_TARGET +ifdef OS_TARGET_DEFAULT +OS_TARGET=$(OS_TARGET_DEFAULT) +endif +endif +ifneq ($(words $(FPC_COMPILERINFO)),5) +FPC_COMPILERINFO+=$(shell $(FPC) -iSP) +FPC_COMPILERINFO+=$(shell $(FPC) -iTP) +FPC_COMPILERINFO+=$(shell $(FPC) -iSO) +FPC_COMPILERINFO+=$(shell $(FPC) -iTO) +endif +ifndef CPU_SOURCE +CPU_SOURCE:=$(word 2,$(FPC_COMPILERINFO)) +endif +ifndef CPU_TARGET +CPU_TARGET:=$(word 3,$(FPC_COMPILERINFO)) +endif +ifndef OS_SOURCE +OS_SOURCE:=$(word 4,$(FPC_COMPILERINFO)) +endif +ifndef OS_TARGET +OS_TARGET:=$(word 5,$(FPC_COMPILERINFO)) +endif +FULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) +FULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) +ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) +TARGETSUFFIX=$(OS_TARGET) +SOURCESUFFIX=$(OS_SOURCE) +else +TARGETSUFFIX=$(FULL_TARGET) +SOURCESUFFIX=$(FULL_SOURCE) +endif +ifneq ($(FULL_TARGET),$(FULL_SOURCE)) +CROSSCOMPILE=1 +endif +ifeq ($(findstring makefile,$(MAKECMDGOALS)),) +ifeq ($(findstring $(FULL_TARGET),$(MAKEFILETARGETS)),) +$(error The Makefile doesn't support target $(FULL_TARGET), please run fpcmake first) +endif +endif +ifneq ($(findstring $(OS_TARGET),$(BSDs)),) +BSDhier=1 +endif +ifeq ($(OS_TARGET),linux) +linuxHier=1 +endif +export OS_TARGET OS_SOURCE CPU_TARGET CPU_SOURCE FULL_TARGET FULL_SOURCE TARGETSUFFIX SOURCESUFFIX CROSSCOMPILE +ifdef FPCDIR +override FPCDIR:=$(subst \,/,$(FPCDIR)) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=wrong +endif +else +override FPCDIR=wrong +endif +ifdef DEFAULT_FPCDIR +ifeq ($(FPCDIR),wrong) +override FPCDIR:=$(subst \,/,$(DEFAULT_FPCDIR)) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=wrong +endif +endif +endif +ifeq ($(FPCDIR),wrong) +ifdef inUnix +override FPCDIR=/usr/local/lib/fpc/$(FPC_VERSION) +ifeq ($(wildcard $(FPCDIR)/units),) +override FPCDIR=/usr/lib/fpc/$(FPC_VERSION) +endif +else +override FPCDIR:=$(subst /$(FPC),,$(firstword $(strip $(wildcard $(addsuffix /$(FPC),$(SEARCHPATH)))))) +override FPCDIR:=$(FPCDIR)/.. +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR:=$(FPCDIR)/.. +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR:=$(BASEDIR) +ifeq ($(wildcard $(addprefix $(FPCDIR)/,rtl units)),) +override FPCDIR=c:/pp +endif +endif +endif +endif +endif +ifndef CROSSBINDIR +CROSSBINDIR:=$(wildcard $(FPCDIR)/bin/$(TARGETSUFFIX)) +endif +ifndef BINUTILSPREFIX +ifndef CROSSBINDIR +ifdef CROSSCOMPILE +BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)- +endif +endif +endif +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX)) +ifeq ($(UNITSDIR),) +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) +endif +PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) +override PACKAGE_NAME=fcl-db +PACKAGEDIR_MAIN:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-db/Makefile.fpc,$(PACKAGESDIR)))))) +ifeq ($(FULL_TARGET),i386-linux) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-win32) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-os2) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-beos) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-solaris) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-qnx) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-netware) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-darwin) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-emx) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-watcom) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-wince) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-embedded) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),i386-symbian) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),m68k-linux) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),m68k-atari) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),sparc-linux) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),arm-linux) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),arm-palmos) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),arm-wince) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),arm-gba) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),arm-nds) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),arm-embedded) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),arm-symbian) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override TARGET_UNITS+=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf +endif +override INSTALL_FPCPACKAGE=y +ifeq ($(FULL_TARGET),i386-linux) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-win32) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-os2) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-beos) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-solaris) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-qnx) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-netware) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-darwin) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-emx) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-watcom) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-wince) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-embedded) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),i386-symbian) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),m68k-linux) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),m68k-atari) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),sparc-linux) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),arm-linux) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),arm-palmos) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),arm-wince) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),arm-gba) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),arm-nds) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),arm-embedded) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),arm-symbian) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override COMPILER_OPTIONS+=-S2h +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override COMPILER_OPTIONS+=-S2h +endif +ifdef REQUIRE_UNITSDIR +override UNITSDIR+=$(REQUIRE_UNITSDIR) +endif +ifdef REQUIRE_PACKAGESDIR +override PACKAGESDIR+=$(REQUIRE_PACKAGESDIR) +endif +ifdef ZIPINSTALL +ifneq ($(findstring $(OS_TARGET),$(UNIXs)),) +UNIXHier=1 +endif +else +ifneq ($(findstring $(OS_SOURCE),$(UNIXs)),) +UNIXHier=1 +endif +endif +ifndef INSTALL_PREFIX +ifdef PREFIX +INSTALL_PREFIX=$(PREFIX) +endif +endif +ifndef INSTALL_PREFIX +ifdef UNIXHier +INSTALL_PREFIX=/usr/local +else +ifdef INSTALL_FPCPACKAGE +INSTALL_BASEDIR:=/pp +else +INSTALL_BASEDIR:=/$(PACKAGE_NAME) +endif +endif +endif +export INSTALL_PREFIX +ifdef INSTALL_FPCSUBDIR +export INSTALL_FPCSUBDIR +endif +ifndef DIST_DESTDIR +DIST_DESTDIR:=$(BASEDIR) +endif +export DIST_DESTDIR +ifndef COMPILER_UNITTARGETDIR +ifdef PACKAGEDIR_MAIN +COMPILER_UNITTARGETDIR=$(PACKAGEDIR_MAIN)/units/$(TARGETSUFFIX) +else +COMPILER_UNITTARGETDIR=units/$(TARGETSUFFIX) +endif +endif +ifndef COMPILER_TARGETDIR +COMPILER_TARGETDIR=. +endif +ifndef INSTALL_BASEDIR +ifdef UNIXHier +ifdef INSTALL_FPCPACKAGE +INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/fpc/$(FPC_VERSION) +else +INSTALL_BASEDIR:=$(INSTALL_PREFIX)/lib/$(PACKAGE_NAME) +endif +else +INSTALL_BASEDIR:=$(INSTALL_PREFIX) +endif +endif +ifndef INSTALL_BINDIR +ifdef UNIXHier +INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin +else +INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin +ifdef INSTALL_FPCPACKAGE +ifdef CROSSCOMPILE +ifdef CROSSINSTALL +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(SOURCESUFFIX) +else +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) +endif +else +INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(TARGETSUFFIX) +endif +endif +endif +endif +ifndef INSTALL_UNITDIR +INSTALL_UNITDIR:=$(INSTALL_BASEDIR)/units/$(TARGETSUFFIX) +ifdef INSTALL_FPCPACKAGE +ifdef PACKAGE_NAME +INSTALL_UNITDIR:=$(INSTALL_UNITDIR)/$(PACKAGE_NAME) +endif +endif +endif +ifndef INSTALL_LIBDIR +ifdef UNIXHier +INSTALL_LIBDIR:=$(INSTALL_PREFIX)/lib +else +INSTALL_LIBDIR:=$(INSTALL_UNITDIR) +endif +endif +ifndef INSTALL_SOURCEDIR +ifdef UNIXHier +ifdef BSDhier +SRCPREFIXDIR=share/src +else +ifdef linuxHier +SRCPREFIXDIR=share/src +else +SRCPREFIXDIR=src +endif +endif +ifdef INSTALL_FPCPACKAGE +ifdef INSTALL_FPCSUBDIR +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) +else +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +endif +else +INSTALL_SOURCEDIR:=$(INSTALL_PREFIX)/$(SRCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +else +ifdef INSTALL_FPCPACKAGE +ifdef INSTALL_FPCSUBDIR +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(INSTALL_FPCSUBDIR)/$(PACKAGE_NAME) +else +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source/$(PACKAGE_NAME) +endif +else +INSTALL_SOURCEDIR:=$(INSTALL_BASEDIR)/source +endif +endif +endif +ifndef INSTALL_DOCDIR +ifdef UNIXHier +ifdef BSDhier +DOCPREFIXDIR=share/doc +else +ifdef linuxHier +DOCPREFIXDIR=share/doc +else +DOCPREFIXDIR=doc +endif +endif +ifdef INSTALL_FPCPACKAGE +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +else +INSTALL_DOCDIR:=$(INSTALL_PREFIX)/$(DOCPREFIXDIR)/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +else +ifdef INSTALL_FPCPACKAGE +INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc/$(PACKAGE_NAME) +else +INSTALL_DOCDIR:=$(INSTALL_BASEDIR)/doc +endif +endif +endif +ifndef INSTALL_EXAMPLEDIR +ifdef UNIXHier +ifdef INSTALL_FPCPACKAGE +ifdef BSDhier +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/fpc-$(FPC_VERSION)/$(PACKAGE_NAME) +else +ifdef linuxHier +INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples +else +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/fpc-$(FPC_VERSION)/examples/$(PACKAGE_NAME) +endif +endif +else +ifdef BSDhier +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/share/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +else +ifdef linuxHier +INSTALL_EXAMPLEDIR:=$(INSTALL_DOCDIR)/examples/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +else +INSTALL_EXAMPLEDIR:=$(INSTALL_PREFIX)/doc/$(PACKAGE_NAME)-$(PACKAGE_VERSION) +endif +endif +endif +else +ifdef INSTALL_FPCPACKAGE +INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples/$(PACKAGE_NAME) +else +INSTALL_EXAMPLEDIR:=$(INSTALL_BASEDIR)/examples +endif +endif +endif +ifndef INSTALL_DATADIR +INSTALL_DATADIR=$(INSTALL_BASEDIR) +endif +ifndef INSTALL_SHAREDDIR +INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib +endif +ifdef CROSSCOMPILE +ifndef CROSSBINDIR +CROSSBINDIR:=$(wildcard $(CROSSTARGETDIR)/bin/$(SOURCESUFFIX)) +ifeq ($(CROSSBINDIR),) +CROSSBINDIR:=$(wildcard $(INSTALL_BASEDIR)/cross/$(TARGETSUFFIX)/bin/$(FULL_SOURCE)) +endif +endif +else +CROSSBINDIR= +endif +BATCHEXT=.bat +LOADEREXT=.as +EXEEXT=.exe +PPLEXT=.ppl +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.so +SHAREDLIBPREFIX=libfp +STATICLIBPREFIX=libp +IMPORTLIBPREFIX=libimp +RSTEXT=.rst +ifeq ($(findstring 1.0.,$(FPC_VERSION)),) +ifeq ($(OS_TARGET),go32v1) +STATICLIBPREFIX= +SHORTSUFFIX=v1 +endif +ifeq ($(OS_TARGET),go32v2) +STATICLIBPREFIX= +SHORTSUFFIX=dos +endif +ifeq ($(OS_TARGET),watcom) +STATICLIBPREFIX= +OEXT=.obj +ASMEXT=.asm +SHAREDLIBEXT=.dll +SHORTSUFFIX=wat +endif +ifeq ($(OS_TARGET),linux) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=lnx +endif +ifeq ($(OS_TARGET),freebsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=fbs +endif +ifeq ($(OS_TARGET),netbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=nbs +endif +ifeq ($(OS_TARGET),openbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=obs +endif +ifeq ($(OS_TARGET),win32) +SHAREDLIBEXT=.dll +SHORTSUFFIX=w32 +endif +ifeq ($(OS_TARGET),os2) +BATCHEXT=.cmd +AOUTEXT=.out +STATICLIBPREFIX= +SHAREDLIBEXT=.dll +SHORTSUFFIX=os2 +ECHO=echo +endif +ifeq ($(OS_TARGET),emx) +BATCHEXT=.cmd +AOUTEXT=.out +STATICLIBPREFIX= +SHAREDLIBEXT=.dll +SHORTSUFFIX=emx +ECHO=echo +endif +ifeq ($(OS_TARGET),amiga) +EXEEXT= +SHAREDLIBEXT=.library +SHORTSUFFIX=amg +endif +ifeq ($(OS_TARGET),morphos) +EXEEXT= +SHAREDLIBEXT=.library +SHORTSUFFIX=mos +endif +ifeq ($(OS_TARGET),atari) +EXEEXT=.ttp +SHORTSUFFIX=ata +endif +ifeq ($(OS_TARGET),beos) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=be +endif +ifeq ($(OS_TARGET),solaris) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=sun +endif +ifeq ($(OS_TARGET),qnx) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=qnx +endif +ifeq ($(OS_TARGET),netware) +EXEEXT=.nlm +STATICLIBPREFIX= +SHORTSUFFIX=nw +endif +ifeq ($(OS_TARGET),netwlibc) +EXEEXT=.nlm +STATICLIBPREFIX= +SHORTSUFFIX=nwl +endif +ifeq ($(OS_TARGET),macos) +BATCHEXT= +EXEEXT= +DEBUGSYMEXT=.xcoff +SHORTSUFFIX=mac +endif +ifeq ($(OS_TARGET),darwin) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=dwn +endif +ifeq ($(OS_TARGET),gba) +EXEEXT=.gba +SHAREDLIBEXT=.so +SHORTSUFFIX=gba +endif +ifeq ($(OS_TARGET),symbian) +SHAREDLIBEXT=.dll +SHORTSUFFIX=symbian +endif +else +ifeq ($(OS_TARGET),go32v1) +PPUEXT=.pp1 +OEXT=.o1 +ASMEXT=.s1 +SMARTEXT=.sl1 +STATICLIBEXT=.a1 +SHAREDLIBEXT=.so1 +STATICLIBPREFIX= +SHORTSUFFIX=v1 +endif +ifeq ($(OS_TARGET),go32v2) +STATICLIBPREFIX= +SHORTSUFFIX=dos +endif +ifeq ($(OS_TARGET),watcom) +STATICLIBPREFIX= +SHORTSUFFIX=wat +endif +ifeq ($(OS_TARGET),linux) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=lnx +endif +ifeq ($(OS_TARGET),freebsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=fbs +endif +ifeq ($(OS_TARGET),netbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=nbs +endif +ifeq ($(OS_TARGET),openbsd) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=obs +endif +ifeq ($(OS_TARGET),win32) +PPUEXT=.ppw +OEXT=.ow +ASMEXT=.sw +SMARTEXT=.slw +STATICLIBEXT=.aw +SHAREDLIBEXT=.dll +SHORTSUFFIX=w32 +endif +ifeq ($(OS_TARGET),os2) +BATCHEXT=.cmd +PPUEXT=.ppo +ASMEXT=.so2 +OEXT=.oo2 +AOUTEXT=.out +SMARTEXT=.sl2 +STATICLIBPREFIX= +STATICLIBEXT=.ao2 +SHAREDLIBEXT=.dll +SHORTSUFFIX=os2 +ECHO=echo +endif +ifeq ($(OS_TARGET),amiga) +EXEEXT= +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.library +SHORTSUFFIX=amg +endif +ifeq ($(OS_TARGET),atari) +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT=.ttp +SHORTSUFFIX=ata +endif +ifeq ($(OS_TARGET),beos) +BATCHEXT=.sh +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +SHORTSUFFIX=be +endif +ifeq ($(OS_TARGET),solaris) +BATCHEXT=.sh +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +SHORTSUFFIX=sun +endif +ifeq ($(OS_TARGET),qnx) +BATCHEXT=.sh +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +SHORTSUFFIX=qnx +endif +ifeq ($(OS_TARGET),netware) +STATICLIBPREFIX= +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.nlm +EXEEXT=.nlm +SHORTSUFFIX=nw +endif +ifeq ($(OS_TARGET),netwlibc) +STATICLIBPREFIX= +PPUEXT=.ppu +OEXT=.o +ASMEXT=.s +SMARTEXT=.sl +STATICLIBEXT=.a +SHAREDLIBEXT=.nlm +EXEEXT=.nlm +SHORTSUFFIX=nwl +endif +ifeq ($(OS_TARGET),macos) +BATCHEXT= +PPUEXT=.ppu +ASMEXT=.s +OEXT=.o +SMARTEXT=.sl +STATICLIBEXT=.a +EXEEXT= +DEBUGSYMEXT=.xcoff +SHORTSUFFIX=mac +endif +endif +ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) +FPCMADE=fpcmade.$(SHORTSUFFIX) +ZIPSUFFIX=$(SHORTSUFFIX) +ZIPCROSSPREFIX= +ZIPSOURCESUFFIX=src +ZIPEXAMPLESUFFIX=exm +else +FPCMADE=fpcmade.$(TARGETSUFFIX) +ZIPSOURCESUFFIX=.source +ZIPEXAMPLESUFFIX=.examples +ifdef CROSSCOMPILE +ZIPSUFFIX=.$(SOURCESUFFIX) +ZIPCROSSPREFIX=$(TARGETSUFFIX)- +else +ZIPSUFFIX=.$(TARGETSUFFIX) +ZIPCROSSPREFIX= +endif +endif +ifndef ECHO +ECHO:=$(strip $(wildcard $(addsuffix /gecho$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO:=$(strip $(wildcard $(addsuffix /echo$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ECHO),) +ECHO= __missing_command_ECHO +else +ECHO:=$(firstword $(ECHO)) +endif +else +ECHO:=$(firstword $(ECHO)) +endif +endif +export ECHO +ifndef DATE +DATE:=$(strip $(wildcard $(addsuffix /gdate$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(DATE),) +DATE:=$(strip $(wildcard $(addsuffix /date$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(DATE),) +DATE= __missing_command_DATE +else +DATE:=$(firstword $(DATE)) +endif +else +DATE:=$(firstword $(DATE)) +endif +endif +export DATE +ifndef GINSTALL +GINSTALL:=$(strip $(wildcard $(addsuffix /ginstall$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(GINSTALL),) +GINSTALL:=$(strip $(wildcard $(addsuffix /install$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(GINSTALL),) +GINSTALL= __missing_command_GINSTALL +else +GINSTALL:=$(firstword $(GINSTALL)) +endif +else +GINSTALL:=$(firstword $(GINSTALL)) +endif +endif +export GINSTALL +ifndef CPPROG +CPPROG:=$(strip $(wildcard $(addsuffix /cp$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(CPPROG),) +CPPROG= __missing_command_CPPROG +else +CPPROG:=$(firstword $(CPPROG)) +endif +endif +export CPPROG +ifndef RMPROG +RMPROG:=$(strip $(wildcard $(addsuffix /rm$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(RMPROG),) +RMPROG= __missing_command_RMPROG +else +RMPROG:=$(firstword $(RMPROG)) +endif +endif +export RMPROG +ifndef MVPROG +MVPROG:=$(strip $(wildcard $(addsuffix /mv$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MVPROG),) +MVPROG= __missing_command_MVPROG +else +MVPROG:=$(firstword $(MVPROG)) +endif +endif +export MVPROG +ifndef MKDIRPROG +MKDIRPROG:=$(strip $(wildcard $(addsuffix /gmkdir$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MKDIRPROG),) +MKDIRPROG:=$(strip $(wildcard $(addsuffix /mkdir$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(MKDIRPROG),) +MKDIRPROG= __missing_command_MKDIRPROG +else +MKDIRPROG:=$(firstword $(MKDIRPROG)) +endif +else +MKDIRPROG:=$(firstword $(MKDIRPROG)) +endif +endif +export MKDIRPROG +ifndef ECHOREDIR +ifndef inUnix +ECHOREDIR=echo +else +ECHOREDIR=$(ECHO) +endif +endif +ifndef COPY +COPY:=$(CPPROG) -fp +endif +ifndef COPYTREE +COPYTREE:=$(CPPROG) -Rfp +endif +ifndef MKDIRTREE +MKDIRTREE:=$(MKDIRPROG) -p +endif +ifndef MOVE +MOVE:=$(MVPROG) -f +endif +ifndef DEL +DEL:=$(RMPROG) -f +endif +ifndef DELTREE +DELTREE:=$(RMPROG) -rf +endif +ifndef INSTALL +ifdef inUnix +INSTALL:=$(GINSTALL) -c -m 644 +else +INSTALL:=$(COPY) +endif +endif +ifndef INSTALLEXE +ifdef inUnix +INSTALLEXE:=$(GINSTALL) -c -m 755 +else +INSTALLEXE:=$(COPY) +endif +endif +ifndef MKDIR +MKDIR:=$(GINSTALL) -m 755 -d +endif +export ECHOREDIR COPY COPYTREE MOVE DEL DELTREE INSTALL INSTALLEXE MKDIR +ifndef PPUMOVE +PPUMOVE:=$(strip $(wildcard $(addsuffix /ppumove$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(PPUMOVE),) +PPUMOVE= __missing_command_PPUMOVE +else +PPUMOVE:=$(firstword $(PPUMOVE)) +endif +endif +export PPUMOVE +ifndef FPCMAKE +FPCMAKE:=$(strip $(wildcard $(addsuffix /fpcmake$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(FPCMAKE),) +FPCMAKE= __missing_command_FPCMAKE +else +FPCMAKE:=$(firstword $(FPCMAKE)) +endif +endif +export FPCMAKE +ifndef ZIPPROG +ZIPPROG:=$(strip $(wildcard $(addsuffix /zip$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(ZIPPROG),) +ZIPPROG= __missing_command_ZIPPROG +else +ZIPPROG:=$(firstword $(ZIPPROG)) +endif +endif +export ZIPPROG +ifndef TARPROG +TARPROG:=$(strip $(wildcard $(addsuffix /gtar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG= __missing_command_TARPROG +else +TARPROG:=$(firstword $(TARPROG)) +endif +else +TARPROG:=$(firstword $(TARPROG)) +endif +endif +export TARPROG +ASNAME=$(BINUTILSPREFIX)as +LDNAME=$(BINUTILSPREFIX)ld +ARNAME=$(BINUTILSPREFIX)ar +RCNAME=$(BINUTILSPREFIX)rc +ifneq ($(findstring 1.0.,$(FPC_VERSION)),) +ifeq ($(OS_TARGET),win32) +ifeq ($(CROSSBINDIR),) +ASNAME=asw +LDNAME=ldw +ARNAME=arw +endif +endif +endif +ifndef ASPROG +ifdef CROSSBINDIR +ASPROG=$(CROSSBINDIR)/$(ASNAME)$(SRCEXEEXT) +else +ASPROG=$(ASNAME) +endif +endif +ifndef LDPROG +ifdef CROSSBINDIR +LDPROG=$(CROSSBINDIR)/$(LDNAME)$(SRCEXEEXT) +else +LDPROG=$(LDNAME) +endif +endif +ifndef RCPROG +ifdef CROSSBINDIR +RCPROG=$(CROSSBINDIR)/$(RCNAME)$(SRCEXEEXT) +else +RCPROG=$(RCNAME) +endif +endif +ifndef ARPROG +ifdef CROSSBINDIR +ARPROG=$(CROSSBINDIR)/$(ARNAME)$(SRCEXEEXT) +else +ARPROG=$(ARNAME) +endif +endif +AS=$(ASPROG) +LD=$(LDPROG) +RC=$(RCPROG) +AR=$(ARPROG) +PPAS=ppas$(SRCBATCHEXT) +ifdef inUnix +LDCONFIG=ldconfig +else +LDCONFIG= +endif +ifdef DATE +DATESTR:=$(shell $(DATE) +%Y%m%d) +else +DATESTR= +endif +ifndef UPXPROG +ifeq ($(OS_TARGET),go32v2) +UPXPROG:=1 +endif +ifeq ($(OS_TARGET),win32) +UPXPROG:=1 +endif +ifdef UPXPROG +UPXPROG:=$(strip $(wildcard $(addsuffix /upx$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(UPXPROG),) +UPXPROG= +else +UPXPROG:=$(firstword $(UPXPROG)) +endif +else +UPXPROG= +endif +endif +export UPXPROG +ZIPOPT=-9 +ZIPEXT=.zip +ifeq ($(USETAR),bz2) +TAROPT=vj +TAREXT=.tar.bz2 +else +TAROPT=vz +TAREXT=.tar.gz +endif +override REQUIRE_PACKAGES=rtl fcl-base +ifeq ($(FULL_TARGET),i386-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-go32v2) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-win32) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_WINUNITS=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-os2) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-freebsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-beos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-netbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-solaris) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-qnx) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-netware) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-openbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-wdosx) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-darwin) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-emx) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-watcom) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-wince) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),i386-symbian) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),m68k-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),m68k-amiga) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),m68k-atari) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),m68k-palmos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),m68k-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),powerpc-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),powerpc-macos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),sparc-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),sparc-solaris) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),sparc-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),x86_64-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),x86_64-win64) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_WINUNITS=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),arm-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),arm-palmos) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),arm-wince) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),arm-gba) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),arm-nds) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),arm-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),arm-symbian) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +REQUIRE_PACKAGES_RTL=1 +REQUIRE_PACKAGES_FCL-BASE=1 +endif +ifdef REQUIRE_PACKAGES_RTL +PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_RTL),) +ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX)),) +UNITDIR_RTL=$(PACKAGEDIR_RTL)/units/$(TARGETSUFFIX) +else +UNITDIR_RTL=$(PACKAGEDIR_RTL) +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_RTL)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_RTL) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(FPCMADE) +endif +else +PACKAGEDIR_RTL= +UNITDIR_RTL:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /rtl/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_RTL),) +UNITDIR_RTL:=$(firstword $(UNITDIR_RTL)) +else +UNITDIR_RTL= +endif +endif +ifdef UNITDIR_RTL +override COMPILER_UNITDIR+=$(UNITDIR_RTL) +endif +endif +ifdef REQUIRE_PACKAGES_FCL-BASE +PACKAGEDIR_FCL-BASE:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-base/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_FCL-BASE),) +ifneq ($(wildcard $(PACKAGEDIR_FCL-BASE)/units/$(TARGETSUFFIX)),) +UNITDIR_FCL-BASE=$(PACKAGEDIR_FCL-BASE)/units/$(TARGETSUFFIX) +else +UNITDIR_FCL-BASE=$(PACKAGEDIR_FCL-BASE) +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_FCL-BASE)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_FCL-BASE) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_FCL-BASE)/$(FPCMADE) +endif +else +PACKAGEDIR_FCL-BASE= +UNITDIR_FCL-BASE:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fcl-base/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_FCL-BASE),) +UNITDIR_FCL-BASE:=$(firstword $(UNITDIR_FCL-BASE)) +else +UNITDIR_FCL-BASE= +endif +endif +ifdef UNITDIR_FCL-BASE +override COMPILER_UNITDIR+=$(UNITDIR_FCL-BASE) +endif +endif +ifdef REQUIRE_PACKAGES_WINUNITS +PACKAGEDIR_WINUNITS:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /winunits/Makefile.fpc,$(PACKAGESDIR)))))) +ifneq ($(PACKAGEDIR_WINUNITS),) +ifneq ($(wildcard $(PACKAGEDIR_WINUNITS)/units/$(TARGETSUFFIX)),) +UNITDIR_WINUNITS=$(PACKAGEDIR_WINUNITS)/units/$(TARGETSUFFIX) +else +UNITDIR_WINUNITS=$(PACKAGEDIR_WINUNITS) +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_WINUNITS)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_WINUNITS) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_WINUNITS)/$(FPCMADE) +endif +else +PACKAGEDIR_WINUNITS= +UNITDIR_WINUNITS:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /winunits/Package.fpc,$(UNITSDIR))))) +ifneq ($(UNITDIR_WINUNITS),) +UNITDIR_WINUNITS:=$(firstword $(UNITDIR_WINUNITS)) +else +UNITDIR_WINUNITS= +endif +endif +ifdef UNITDIR_WINUNITS +override COMPILER_UNITDIR+=$(UNITDIR_WINUNITS) +endif +endif +ifndef NOCPUDEF +override FPCOPTDEF=$(CPU_TARGET) +endif +ifneq ($(OS_TARGET),$(OS_SOURCE)) +override FPCOPT+=-T$(OS_TARGET) +endif +ifneq ($(CPU_TARGET),$(CPU_SOURCE)) +override FPCOPT+=-P$(CPU_TARGET) +endif +ifeq ($(OS_SOURCE),openbsd) +override FPCOPT+=-FD$(NEW_BINUTILS_PATH) +endif +ifndef CROSSBOOTSTRAP +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-XP$(BINUTILSPREFIX) +endif +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-Xr$(RLINKPATH) +endif +endif +ifdef UNITDIR +override FPCOPT+=$(addprefix -Fu,$(UNITDIR)) +endif +ifdef LIBDIR +override FPCOPT+=$(addprefix -Fl,$(LIBDIR)) +endif +ifdef OBJDIR +override FPCOPT+=$(addprefix -Fo,$(OBJDIR)) +endif +ifdef INCDIR +override FPCOPT+=$(addprefix -Fi,$(INCDIR)) +endif +ifdef LINKSMART +override FPCOPT+=-XX +endif +ifdef CREATESMART +override FPCOPT+=-CX +endif +ifdef DEBUG +override FPCOPT+=-gl +override FPCOPTDEF+=DEBUG +endif +ifdef RELEASE +ifneq ($(findstring 2.0.,$(FPC_VERSION)),) +ifeq ($(CPU_TARGET),i386) +FPCCPUOPT:=-OG2p3 +endif +ifeq ($(CPU_TARGET),powerpc) +FPCCPUOPT:=-O1r +endif +else +FPCCPUOPT:=-O2 +endif +override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n +override FPCOPTDEF+=RELEASE +endif +ifdef STRIP +override FPCOPT+=-Xs +endif +ifdef OPTIMIZE +override FPCOPT+=-O2 +endif +ifdef VERBOSE +override FPCOPT+=-vwni +endif +ifdef COMPILER_OPTIONS +override FPCOPT+=$(COMPILER_OPTIONS) +endif +ifdef COMPILER_UNITDIR +override FPCOPT+=$(addprefix -Fu,$(COMPILER_UNITDIR)) +endif +ifdef COMPILER_LIBRARYDIR +override FPCOPT+=$(addprefix -Fl,$(COMPILER_LIBRARYDIR)) +endif +ifdef COMPILER_OBJECTDIR +override FPCOPT+=$(addprefix -Fo,$(COMPILER_OBJECTDIR)) +endif +ifdef COMPILER_INCLUDEDIR +override FPCOPT+=$(addprefix -Fi,$(COMPILER_INCLUDEDIR)) +endif +ifdef CROSSBINDIR +override FPCOPT+=-FD$(CROSSBINDIR) +endif +ifdef COMPILER_TARGETDIR +override FPCOPT+=-FE$(COMPILER_TARGETDIR) +ifeq ($(COMPILER_TARGETDIR),.) +override TARGETDIRPREFIX= +else +override TARGETDIRPREFIX=$(COMPILER_TARGETDIR)/ +endif +endif +ifdef COMPILER_UNITTARGETDIR +override FPCOPT+=-FU$(COMPILER_UNITTARGETDIR) +ifeq ($(COMPILER_UNITTARGETDIR),.) +override UNITTARGETDIRPREFIX= +else +override UNITTARGETDIRPREFIX=$(COMPILER_UNITTARGETDIR)/ +endif +else +ifdef COMPILER_TARGETDIR +override COMPILER_UNITTARGETDIR=$(COMPILER_TARGETDIR) +override UNITTARGETDIRPREFIX=$(TARGETDIRPREFIX) +endif +endif +ifdef CREATESHARED +override FPCOPT+=-Cg +ifeq ($(CPU_TARGET),i386) +override FPCOPT+=-Aas +endif +endif +ifeq ($(findstring 2.0.,$(FPC_VERSION)),) +ifeq ($(OS_TARGET),linux) +ifeq ($(CPU_TARGET),x86_64) +override FPCOPT+=-Cg +endif +endif +endif +ifdef LINKSHARED +endif +ifdef OPT +override FPCOPT+=$(OPT) +endif +ifdef FPCOPTDEF +override FPCOPT+=$(addprefix -d,$(FPCOPTDEF)) +endif +ifdef CFGFILE +override FPCOPT+=@$(CFGFILE) +endif +ifdef USEENV +override FPCEXTCMD:=$(FPCOPT) +override FPCOPT:=!FPCEXTCMD +export FPCEXTCMD +endif +override AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) +override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) +ifneq ($(AFULL_TARGET),$(AFULL_SOURCE)) +override ACROSSCOMPILE=1 +endif +ifdef ACROSSCOMPILE +override FPCOPT+=$(CROSSOPT) +endif +override COMPILER:=$(FPC) $(FPCOPT) +ifeq (,$(findstring -s ,$(COMPILER))) +EXECPPAS= +else +ifeq ($(FULL_SOURCE),$(FULL_TARGET)) +ifdef RUNBATCH +EXECPPAS:=@$(RUNBATCH) $(PPAS) +else +EXECPPAS:=@$(PPAS) +endif +endif +endif +.PHONY: fpc_units +ifneq ($(TARGET_UNITS),) +override ALLTARGET+=fpc_units +override UNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_UNITS)) +override IMPLICITUNITPPUFILES=$(addsuffix $(PPUEXT),$(TARGET_IMPLICITUNITS)) +override INSTALLPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES) +override CLEANPPUFILES+=$(UNITPPUFILES) $(IMPLICITUNITPPUFILES) +endif +fpc_units: $(COMPILER_UNITTARGETDIR) $(UNITPPUFILES) +ifdef TARGET_RSTS +override RSTFILES=$(addsuffix $(RSTEXT),$(TARGET_RSTS)) +override CLEANRSTFILES+=$(RSTFILES) +endif +.PHONY: fpc_all fpc_smart fpc_debug fpc_release fpc_shared +$(FPCMADE): $(ALLDEPENDENCIES) $(ALLTARGET) + @$(ECHOREDIR) Compiled > $(FPCMADE) +fpc_all: $(FPCMADE) +fpc_smart: + $(MAKE) all LINKSMART=1 CREATESMART=1 +fpc_debug: + $(MAKE) all DEBUG=1 +fpc_release: + $(MAKE) all RELEASE=1 +.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .lpr .dpr .pp .rc .res +$(COMPILER_UNITTARGETDIR): + $(MKDIRTREE) $(COMPILER_UNITTARGETDIR) +$(COMPILER_TARGETDIR): + $(MKDIRTREE) $(COMPILER_TARGETDIR) +%$(PPUEXT): %.pp + $(COMPILER) $< + $(EXECPPAS) +%$(PPUEXT): %.pas + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.pp + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.pas + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.lpr + $(COMPILER) $< + $(EXECPPAS) +%$(EXEEXT): %.dpr + $(COMPILER) $< + $(EXECPPAS) +%.res: %.rc + windres -i $< -o $@ +vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.lpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR) +vpath %.inc $(COMPILER_INCLUDEDIR) +vpath %$(OEXT) $(COMPILER_UNITTARGETDIR) +vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR) +.PHONY: fpc_shared +override INSTALLTARGET+=fpc_shared_install +ifndef SHARED_LIBVERSION +SHARED_LIBVERSION=$(FPC_VERSION) +endif +ifndef SHARED_LIBNAME +SHARED_LIBNAME=$(PACKAGE_NAME) +endif +ifndef SHARED_FULLNAME +SHARED_FULLNAME=$(SHAREDLIBPREFIX)$(SHARED_LIBNAME)-$(SHARED_LIBVERSION)$(SHAREDLIBEXT) +endif +ifndef SHARED_LIBUNITS +SHARED_LIBUNITS:=$(TARGET_UNITS) $(TARGET_IMPLICITUNITS) +override SHARED_LIBUNITS:=$(filter-out $(INSTALL_BUILDUNIT),$(SHARED_LIBUNITS)) +endif +fpc_shared: +ifdef HASSHAREDLIB + $(MAKE) all CREATESHARED=1 LINKSHARED=1 CREATESMART=1 +ifneq ($(SHARED_BUILD),n) + $(PPUMOVE) -q $(SHARED_LIBUNITS) -i$(COMPILER_UNITTARGETDIR) -o$(SHARED_FULLNAME) -d$(COMPILER_UNITTARGETDIR) +endif +else + @$(ECHO) Shared Libraries not supported +endif +fpc_shared_install: +ifneq ($(SHARED_BUILD),n) +ifneq ($(SHARED_LIBUNITS),) +ifneq ($(wildcard $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME)),) + $(INSTALL) $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME) $(INSTALL_SHAREDDIR) +endif +endif +endif +.PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall +ifdef INSTALL_UNITS +override INSTALLPPUFILES+=$(addsuffix $(PPUEXT),$(INSTALL_UNITS)) +endif +ifdef INSTALL_BUILDUNIT +override INSTALLPPUFILES:=$(filter-out $(INSTALL_BUILDUNIT)$(PPUEXT),$(INSTALLPPUFILES)) +endif +ifdef INSTALLPPUFILES +override INSTALLPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(INSTALLPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(INSTALLPPUFILES))) +ifneq ($(UNITTARGETDIRPREFIX),) +override INSTALLPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPUFILES))) +override INSTALLPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(notdir $(INSTALLPPULINKFILES)))) +endif +override INSTALL_CREATEPACKAGEFPC=1 +endif +ifdef INSTALLEXEFILES +ifneq ($(TARGETDIRPREFIX),) +override INSTALLEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(notdir $(INSTALLEXEFILES))) +endif +endif +fpc_install: all $(INSTALLTARGET) +ifdef INSTALLEXEFILES + $(MKDIR) $(INSTALL_BINDIR) +ifdef UPXPROG + -$(UPXPROG) $(INSTALLEXEFILES) +endif + $(INSTALLEXE) $(INSTALLEXEFILES) $(INSTALL_BINDIR) +endif +ifdef INSTALL_CREATEPACKAGEFPC +ifdef FPCMAKE +ifdef PACKAGE_VERSION +ifneq ($(wildcard Makefile.fpc),) + $(FPCMAKE) -p -T$(CPU_TARGET)-$(OS_TARGET) Makefile.fpc + $(MKDIR) $(INSTALL_UNITDIR) + $(INSTALL) Package.fpc $(INSTALL_UNITDIR) +endif +endif +endif +endif +ifdef INSTALLPPUFILES + $(MKDIR) $(INSTALL_UNITDIR) + $(INSTALL) $(INSTALLPPUFILES) $(INSTALL_UNITDIR) +ifneq ($(INSTALLPPULINKFILES),) + $(INSTALL) $(INSTALLPPULINKFILES) $(INSTALL_UNITDIR) +endif +ifneq ($(wildcard $(LIB_FULLNAME)),) + $(MKDIR) $(INSTALL_LIBDIR) + $(INSTALL) $(LIB_FULLNAME) $(INSTALL_LIBDIR) +ifdef inUnix + ln -sf $(LIB_FULLNAME) $(INSTALL_LIBDIR)/$(LIB_NAME) +endif +endif +endif +ifdef INSTALL_FILES + $(MKDIR) $(INSTALL_DATADIR) + $(INSTALL) $(INSTALL_FILES) $(INSTALL_DATADIR) +endif +fpc_sourceinstall: distclean + $(MKDIR) $(INSTALL_SOURCEDIR) + $(COPYTREE) $(BASEDIR)/* $(INSTALL_SOURCEDIR) +fpc_exampleinstall: $(addsuffix _distclean,$(TARGET_EXAMPLEDIRS)) +ifdef HASEXAMPLES + $(MKDIR) $(INSTALL_EXAMPLEDIR) +endif +ifdef EXAMPLESOURCEFILES + $(COPY) $(EXAMPLESOURCEFILES) $(INSTALL_EXAMPLEDIR) +endif +ifdef TARGET_EXAMPLEDIRS + $(COPYTREE) $(addsuffix /*,$(TARGET_EXAMPLEDIRS)) $(INSTALL_EXAMPLEDIR) +endif +.PHONY: fpc_clean fpc_cleanall fpc_distclean +ifdef EXEFILES +override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES)) +endif +ifdef CLEAN_UNITS +override CLEANPPUFILES+=$(addsuffix $(PPUEXT),$(CLEAN_UNITS)) +endif +ifdef CLEANPPUFILES +override CLEANPPULINKFILES:=$(subst $(PPUEXT),$(OEXT),$(CLEANPPUFILES)) $(addprefix $(STATICLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) $(addprefix $(IMPORTLIBPREFIX),$(subst $(PPUEXT),$(STATICLIBEXT),$(CLEANPPUFILES))) +ifdef DEBUGSYMEXT +override CLEANPPULINKFILES+=$(subst $(PPUEXT),$(DEBUGSYMEXT),$(CLEANPPUFILES)) +endif +override CLEANPPUFILES:=$(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPUFILES)) +override CLEANPPULINKFILES:=$(wildcard $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANPPULINKFILES))) +endif +fpc_clean: $(CLEANTARGET) +ifdef CLEANEXEFILES + -$(DEL) $(CLEANEXEFILES) +endif +ifdef CLEANPPUFILES + -$(DEL) $(CLEANPPUFILES) +endif +ifneq ($(CLEANPPULINKFILES),) + -$(DEL) $(CLEANPPULINKFILES) +endif +ifdef CLEANRSTFILES + -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) +endif +ifdef CLEAN_FILES + -$(DEL) $(CLEAN_FILES) +endif +ifdef LIB_NAME + -$(DEL) $(LIB_NAME) $(LIB_FULLNAME) +endif + -$(DEL) $(FPCMADE) Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) + -$(DEL) *$(ASMEXT) *_ppas$(BATCHEXT) +fpc_cleanall: $(CLEANTARGET) +ifdef CLEANEXEFILES + -$(DEL) $(CLEANEXEFILES) +endif +ifdef COMPILER_UNITTARGETDIR +ifdef CLEANPPUFILES + -$(DEL) $(CLEANPPUFILES) +endif +ifneq ($(CLEANPPULINKFILES),) + -$(DEL) $(CLEANPPULINKFILES) +endif +ifdef CLEANRSTFILES + -$(DEL) $(addprefix $(UNITTARGETDIRPREFIX),$(CLEANRSTFILES)) +endif +endif + -$(DELTREE) units + -$(DEL) *$(OEXT) *$(PPUEXT) *$(RSTEXT) *$(ASMEXT) *$(STATICLIBEXT) *$(SHAREDLIBEXT) *$(PPLEXT) +ifneq ($(PPUEXT),.ppu) + -$(DEL) *.o *.ppu *.a +endif + -$(DELTREE) *$(SMARTEXT) + -$(DEL) fpcmade.* Package.fpc $(PPAS) script.res link.res $(FPCEXTFILE) $(REDIRFILE) + -$(DEL) *_ppas$(BATCHEXT) +ifdef AOUTEXT + -$(DEL) *$(AOUTEXT) +endif +ifdef DEBUGSYMEXT + -$(DEL) *$(DEBUGSYMEXT) +endif +fpc_distclean: cleanall +.PHONY: fpc_baseinfo +override INFORULES+=fpc_baseinfo +fpc_baseinfo: + @$(ECHO) + @$(ECHO) == Package info == + @$(ECHO) Package Name..... $(PACKAGE_NAME) + @$(ECHO) Package Version.. $(PACKAGE_VERSION) + @$(ECHO) + @$(ECHO) == Configuration info == + @$(ECHO) + @$(ECHO) FPC.......... $(FPC) + @$(ECHO) FPC Version.. $(FPC_VERSION) + @$(ECHO) Source CPU... $(CPU_SOURCE) + @$(ECHO) Target CPU... $(CPU_TARGET) + @$(ECHO) Source OS.... $(OS_SOURCE) + @$(ECHO) Target OS.... $(OS_TARGET) + @$(ECHO) Full Source.. $(FULL_SOURCE) + @$(ECHO) Full Target.. $(FULL_TARGET) + @$(ECHO) SourceSuffix. $(SOURCESUFFIX) + @$(ECHO) TargetSuffix. $(TARGETSUFFIX) + @$(ECHO) + @$(ECHO) == Directory info == + @$(ECHO) + @$(ECHO) Required pkgs... $(REQUIRE_PACKAGES) + @$(ECHO) + @$(ECHO) Basedir......... $(BASEDIR) + @$(ECHO) FPCDir.......... $(FPCDIR) + @$(ECHO) CrossBinDir..... $(CROSSBINDIR) + @$(ECHO) UnitsDir........ $(UNITSDIR) + @$(ECHO) PackagesDir..... $(PACKAGESDIR) + @$(ECHO) + @$(ECHO) GCC library..... $(GCCLIBDIR) + @$(ECHO) Other library... $(OTHERLIBDIR) + @$(ECHO) + @$(ECHO) == Tools info == + @$(ECHO) + @$(ECHO) As........ $(AS) + @$(ECHO) Ld........ $(LD) + @$(ECHO) Ar........ $(AR) + @$(ECHO) Rc........ $(RC) + @$(ECHO) + @$(ECHO) Mv........ $(MVPROG) + @$(ECHO) Cp........ $(CPPROG) + @$(ECHO) Rm........ $(RMPROG) + @$(ECHO) GInstall.. $(GINSTALL) + @$(ECHO) Echo...... $(ECHO) + @$(ECHO) Shell..... $(SHELL) + @$(ECHO) Date...... $(DATE) + @$(ECHO) FPCMake... $(FPCMAKE) + @$(ECHO) PPUMove... $(PPUMOVE) + @$(ECHO) Upx....... $(UPXPROG) + @$(ECHO) Zip....... $(ZIPPROG) + @$(ECHO) + @$(ECHO) == Object info == + @$(ECHO) + @$(ECHO) Target Loaders........ $(TARGET_LOADERS) + @$(ECHO) Target Units.......... $(TARGET_UNITS) + @$(ECHO) Target Implicit Units. $(TARGET_IMPLICITUNITS) + @$(ECHO) Target Programs....... $(TARGET_PROGRAMS) + @$(ECHO) Target Dirs........... $(TARGET_DIRS) + @$(ECHO) Target Examples....... $(TARGET_EXAMPLES) + @$(ECHO) Target ExampleDirs.... $(TARGET_EXAMPLEDIRS) + @$(ECHO) + @$(ECHO) Clean Units......... $(CLEAN_UNITS) + @$(ECHO) Clean Files......... $(CLEAN_FILES) + @$(ECHO) + @$(ECHO) Install Units....... $(INSTALL_UNITS) + @$(ECHO) Install Files....... $(INSTALL_FILES) + @$(ECHO) + @$(ECHO) == Install info == + @$(ECHO) + @$(ECHO) DateStr.............. $(DATESTR) + @$(ECHO) ZipName.............. $(ZIPNAME) + @$(ECHO) ZipPrefix............ $(ZIPPREFIX) + @$(ECHO) ZipCrossPrefix....... $(ZIPCROSSPREFIX) + @$(ECHO) ZipSuffix............ $(ZIPSUFFIX) + @$(ECHO) FullZipName.......... $(FULLZIPNAME) + @$(ECHO) Install FPC Package.. $(INSTALL_FPCPACKAGE) + @$(ECHO) + @$(ECHO) Install base dir..... $(INSTALL_BASEDIR) + @$(ECHO) Install binary dir... $(INSTALL_BINDIR) + @$(ECHO) Install library dir.. $(INSTALL_LIBDIR) + @$(ECHO) Install units dir.... $(INSTALL_UNITDIR) + @$(ECHO) Install source dir... $(INSTALL_SOURCEDIR) + @$(ECHO) Install doc dir...... $(INSTALL_DOCDIR) + @$(ECHO) Install example dir.. $(INSTALL_EXAMPLEDIR) + @$(ECHO) Install data dir..... $(INSTALL_DATADIR) + @$(ECHO) + @$(ECHO) Dist destination dir. $(DIST_DESTDIR) + @$(ECHO) Dist zip name........ $(DIST_ZIPNAME) + @$(ECHO) +.PHONY: fpc_info +fpc_info: $(INFORULES) +.PHONY: fpc_makefile fpc_makefiles fpc_makefile_sub1 fpc_makefile_sub2 \ + fpc_makefile_dirs +fpc_makefile: + $(FPCMAKE) -w -T$(OS_TARGET) Makefile.fpc +fpc_makefile_sub1: +ifdef TARGET_DIRS + $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_DIRS)) +endif +ifdef TARGET_EXAMPLEDIRS + $(FPCMAKE) -w -T$(OS_TARGET) $(addsuffix /Makefile.fpc,$(TARGET_EXAMPLEDIRS)) +endif +fpc_makefile_sub2: $(addsuffix _makefile_dirs,$(TARGET_DIRS) $(TARGET_EXAMPLEDIRS)) +fpc_makefile_dirs: fpc_makefile_sub1 fpc_makefile_sub2 +fpc_makefiles: fpc_makefile fpc_makefile_dirs +all: fpc_all +debug: fpc_debug +smart: fpc_smart +release: fpc_release +units: fpc_units +examples: +shared: fpc_shared +install: fpc_install +sourceinstall: fpc_sourceinstall +exampleinstall: fpc_exampleinstall +distinstall: +zipinstall: +zipsourceinstall: +zipexampleinstall: +zipdistinstall: +clean: fpc_clean +distclean: fpc_distclean +cleanall: fpc_cleanall +info: fpc_info +makefiles: fpc_makefiles +.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles +ifneq ($(wildcard fpcmake.loc),) +include fpcmake.loc +endif +.NOTPARALLEL: diff --git a/packages/fcl-db/src/codegen/Makefile.fpc b/packages/fcl-db/src/codegen/Makefile.fpc new file mode 100644 index 0000000000..30ac40fbb3 --- /dev/null +++ b/packages/fcl-db/src/codegen/Makefile.fpc @@ -0,0 +1,24 @@ +# +# Makefile.fpc for SQL FCL db units +# + +[package] +main=fcl-db + +[require] +packages=fcl-base + +[target] +units=fpddcodegen fpcgcreatedbf fpcgdbcoll fpcgsqlconst fpcgtiopf + +[compiler] +options=-S2h + +[install] +fpcpackage=y + +[default] +fpcdir=../../../.. + +[rules] +.NOTPARALLEL: diff --git a/packages/fcl-db/src/codegen/fpcgcreatedbf.pp b/packages/fcl-db/src/codegen/fpcgcreatedbf.pp new file mode 100644 index 0000000000..531e4eb0c6 --- /dev/null +++ b/packages/fcl-db/src/codegen/fpcgcreatedbf.pp @@ -0,0 +1,258 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2007 by Michael Van Canneyt, member of the + Free Pascal development team + + Data Dictionary Code Generator 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. + + **********************************************************************} +unit fpcgcreatedbf; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpddCodeGen; + +Type + + { TDDCreateDBFOptions } + + TDDCreateDBFOptions = Class(TCodeGeneratorOptions) + private + FIDent: String; + FProcName: String; + FCreateInstance: Boolean; + FTableName: String; + procedure SetIdent(const AValue: String); + procedure SetProcName(const AValue: String); + Public + Constructor Create; override; + Procedure Assign(ASource : TPersistent); override; + Published + Property Identifier : String Read FIDent Write SetIdent; + Property CreateInstance : Boolean Read FCreateInstance Write FCreateInstance default True; + Property ProcedureName : String Read FProcName Write SetProcName; + Property TableName : String Read FTableName Write FTableName; + end; + + { TDDCreateDBFGenerator } + + TDDCreateDBFGenerator = Class(TDDCustomCodeGenerator) + Private + FFields: TFieldPropDefs; + Protected + Function ProcedureDecl : String; virtual; + Function CreateOptions : TCodeGeneratorOptions; override; + Procedure DoGenerateImplementation(Strings: TStrings); override; + Procedure DoGenerateInterface(Strings: TStrings); override; + function GetFieldDefs: TFieldPropDefs; override; + procedure SetFieldDefs(const AValue: TFieldPropDefs); override; + Function DBFOptions : TDDCreateDBFOptions; + Function GetImplementationUsesClause : string; override; + Function GetInterfaceUsesClause : string; override; + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + Class Function NeedsFieldDefs : Boolean; override; + end; + +implementation + +uses db,typinfo; + +{ TDDCreateDBFOptions } + +procedure TDDCreateDBFOptions.SetIdent(const AValue: String); +begin + if FIDent=AValue then exit; + If Not IsValidIdent(AValue) then + Raise ECodeGenerator.CreateFmt(SErrInvalidIdentifier,[AValue]); + FIDent:=AValue; +end; + +procedure TDDCreateDBFOptions.SetProcName(const AValue: String); +begin + if FProcName=AValue then exit; + If Not IsValidIdent(AValue) then + Raise ECodeGenerator.CreateFmt(SErrInvalidIdentifier,[AValue]); + FProcName:=AValue; +end; + +constructor TDDCreateDBFOptions.Create; +begin + inherited Create; + FCreateInstance:=True; + FIdent:='DBF'; + FTableName:='MyTable'; + FProcName:='CreateDBF'; +end; + +procedure TDDCreateDBFOptions.Assign(ASource: TPersistent); + +Var + DOP : TDDCreateDBFOptions; + +begin + if ASource is TDDCreateDBFOptions then + begin + DOP:=ASource as TDDCreateDBFOptions; + FCreateInstance:=DOP.FCreateInstance; + Fident:=DOP.FIdent; + FProcName:=DOP.FProcName; + FTableName:=DOP.FTableName; + end; + inherited Assign(ASource); +end; + +{ TDDCreateDBFGenerator } + +function TDDCreateDBFGenerator.ProcedureDecl: String; +begin + If not DBFOptions.CreateInstance then + Result:=Format('%s (%s : TDBF)',[DBFoptions.ProcedureName,DBFOptions.Identifier]) + else + Result:=DBFoptions.ProcedureName; + Result:=Format('procedure %s;',[Result]); +end; + +function TDDCreateDBFGenerator.CreateOptions: TCodeGeneratorOptions; +begin + Result:=TDDCreateDBFOptions.Create; +end; + +procedure TDDCreateDBFGenerator.DoGenerateImplementation(Strings: TStrings); + +Var + i : integer; + F : TFieldPropDef; + S : String; + N : String; + +begin + N:=DBFOptions.Identifier; + If (DBFoptions.ProcedureName<>'') then + begin + BeginMethod(Strings,ProcedureDecl); + If DBFOptions.CreateInstance then + begin + Addln(Strings); + Addln(Strings,'Var'); + IncIndent; + Try + Addln(Strings,'%s : TDBF;',[N]); + Finally + DecIndent; + end; + end; + AddLn(Strings,'begin'); + IncIndent; + end; + Try + If DBFOptions.CreateInstance then + Addln(Strings,'%s:=TDBF.Create(Nil);',[N]); + Addln(Strings,'With %s do',[N]); + IncIndent; + try + AddLn(Strings,'begin'); + If Not DBFOptions.CreateInstance then + AddLn(Strings,'Close;'); + AddLn(Strings,'With FieldDefs do'); + IncIndent; + try + AddLn(Strings,'begin'); + For I:=0 to Fields.Count-1 do + begin + F:=Fields[i]; + If F.Enabled then + begin + S:=GetEnumName(TypeInfo(TFieldType),Ord(F.FieldType)); + AddLn(Strings,'Add(''%s'',%s,%d);',[F.FieldName,S,F.PropertySize]); + end; + end; + AddLn(Strings,'end;'); + Finally + DecIndent; + end; + AddLn(Strings,'TableName:=%s;',[CreateString(DBFOptions.TableName)]); + AddLn(Strings,'CreateTable;'); + AddLn(Strings,'Exclusive:=true;'); + AddLn(Strings,'Open;'); + AddLn(Strings,'end;'); + finally + DecIndent; + end; + Finally + If (DBFoptions.ProcedureName<>'') then + begin + DecIndent; + EndMethod(Strings,DBFoptions.ProcedureName); + end; + end; +end; + +procedure TDDCreateDBFGenerator.DoGenerateInterface(Strings: TStrings); +begin + If (DBFoptions.ProcedureName<>'') then + BeginMethod(Strings,ProcedureDecl); +end; + +function TDDCreateDBFGenerator.GetFieldDefs: TFieldPropDefs; +begin + Result:=FFields; +end; + +procedure TDDCreateDBFGenerator.SetFieldDefs(const AValue: TFieldPropDefs); +begin + FFields.Assign(AValue); +end; + + +function TDDCreateDBFGenerator.DBFOptions: TDDCreateDBFOptions; +begin + Result:=TDDCreateDBFOptions(CodeOptions); +end; + +function TDDCreateDBFGenerator.GetImplementationUsesClause: String; +begin + If DBFOptions.CreateInstance then + Result:='db, dbf'; +end; + +function TDDCreateDBFGenerator.GetInterfaceUsesClause: string; +begin + If Not DBFOptions.CreateInstance then + Result:='db, dbf'; +end; + +constructor TDDCreateDBFGenerator.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FFields:=TFieldPropDefs.Create(TFieldPropDef); +end; + +destructor TDDCreateDBFGenerator.Destroy; +begin + FreeAndNil(FFields); + inherited Destroy; +end; + +class function TDDCreateDBFGenerator.NeedsFieldDefs: Boolean; +begin + Result:=True; +end; + +initialization + RegisterCodeGenerator('DBFCreate','Create DBF file for data',TDDCreateDBFGenerator); +Finalization + UnRegisterCodeGenerator(TDDCreateDBFGenerator); +end. + diff --git a/packages/fcl-db/src/codegen/fpcgdbcoll.pp b/packages/fcl-db/src/codegen/fpcgdbcoll.pp new file mode 100644 index 0000000000..ad7b093703 --- /dev/null +++ b/packages/fcl-db/src/codegen/fpcgdbcoll.pp @@ -0,0 +1,991 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2007 by Michael Van Canneyt, member of the + Free Pascal development team + + Data Dictionary Code Generator 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. + + **********************************************************************} +unit fpcgdbcoll; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, db, fpddcodegen; + +Type + TListMode = (lmNone,lmList,lmObjectList,lmCollection,lmDBCollection); + TClassOption = (coCreateLoader,coUseFieldMap,coCreateArrayProperty,coCreateAssign); + TClassOptions = Set of TClassOption; + + { TDBCollOptions } + + TDBCollOptions = Class(TClassCodeGeneratorOptions) + private + FClassOptions: TClassOptions; + FListMode: TListMode; + FListAncestorName: String; + FListClassName: String; + FArrayPropName: String; + FMapAncestorName: String; + FMapClassName: String; + function GetArrayPropName: String; + function GetListClassName: String; + function GetMapName: String; + procedure SetArrayPropName(const AValue: String); + procedure SetListAncestorName(const AValue: String); + procedure SetListClassName(const AValue: String); + procedure SetListMode(const AValue: TListMode); + procedure SetMapAncestorName(const AValue: String); + procedure SetMapClassName(const AValue: String); + Public + Constructor Create; override; + Procedure Assign(ASource : TPersistent); override; + Function CreateLoader : Boolean; + Function UseFieldMap : Boolean; + Function CreateArrayProperty : Boolean; + Function CreateAssign : Boolean; + Published + Property ClassOptions : TClassOptions Read FClassOptions Write FClassOptions; + Property ListMode : TListMode Read FListMode Write SetListMode; + Property ListAncestorName : String Read FListAncestorName Write SetListAncestorName; + Property ListClassName : String Read GetListClassName Write SetListClassName; + Property MapAncestorName : String Read FMapAncestorName Write SetMapAncestorName; + Property MapClassName : String Read GetMapName Write SetMapClassName; + Property ArrayPropName : String Read GetArrayPropName Write SetArrayPropName; + Property AncestorClass; + end; + + { TDDDBCollCodeGenerator } + + TDDDBCollCodeGenerator = Class(TDDClassCodeGenerator) + procedure CreateObjectAssign(Strings: TStrings; + const ObjectClassName: String); + private + function GetOpt: TDBColLOptions; + Protected + // Not to be overridden. + procedure CreateFieldMapImplementation(Strings: TStrings; const ObjectClassName, MapClassName: String); + procedure CreateListImplementation(Strings: TStrings; ListMode: TListMode; const ObjectClassName, ListClassName: String); + procedure WriteFieldMapAssign(Strings: TStrings; F: TFieldPropDef); + procedure WriteMapInitFields(Strings: TStrings; const ObjectClassName, MapClassName: String); + procedure WriteListLoad(Strings: TStrings; ListMode: TListMode; const ObjectClassName, ListClassName: String; FromMap: Boolean); + procedure WriteListAddObject(Strings: TStrings; ListMode: TListMode; const InstanceName, ObjectClassName: String); + // Overrides of parent objects + Function GetInterfaceUsesClause : string; override; + Procedure DoGenerateInterface(Strings: TStrings); override; + Procedure DoGenerateImplementation(Strings: TStrings); override; + procedure WriteVisibilityStart(V: TVisibility; Strings: TStrings); override; + procedure CreateImplementation(Strings: TStrings); override; + Class Function NeedsFieldDefs : Boolean; override; + Function CreateOptions : TCodeGeneratorOptions; override; + // + // New methods + // + // Override to add declarations to list declaration + procedure DoCreateListDeclaration(Strings: TStrings; ListMode: TListMode; const ObjectClassName, ListClassName, ListAncestorName: String); virtual; + // Override to add declarations to fieldmap declaration + procedure DoCreateFieldMapDeclaration(Strings: TStrings; const ObjectClassName,MapClassName, MapAncestorName: String); virtual; + // Override to add statements to the FieldMap Load implementation + procedure DoWriteMapLoad(Strings: TStrings; const ObjectClassName, MapClassName: String); virtual; + // Override to add statements to the FieldMap LoadObject implementation + procedure DoWriteMapLoadObject(Strings: TStrings; const ObjectClassName, MapClassName: String);virtual; + // Create an object that should be added to the list. + procedure WriteListCreateObject(Strings: TStrings; ListMode: TListMode; const InstanceName, ObjectClassName: String); + // Write LoadFromDataset implementation for List object + procedure WriteListLoadFromDataset(Strings: TStrings; ListMode: TListMode; const ObjectClassName, ListClassName: String); + // Write LoadFromMap implementation for List object + procedure WriteListLoadFromMap(Strings: TStrings; ListMode: TListMode; const ObjectClassName, ListClassName: String); + // Object load from map; + procedure CreateObjectLoadFromMap(Strings: TStrings; const ObjectClassName: String); virtual; + // Create assign statement for a property from a dataset field, in object itself (not in map). + procedure WriteFieldDatasetAssign(Strings: TStrings; F: TFieldPropDef); virtual; + // Copy a property from one instance to another in Assign() + procedure WriteFieldAssign(Strings: TStrings; F: TFieldPropDef); virtual; + // Code to Load object from fataset (should check usefieldmap) + procedure CreateObjectLoadFromDataset(Strings: TStrings; const ObjectClassName: String); virtual; + Public + procedure CreateFieldMapDeclaration(Strings: TStrings; const ObjectClassName,MapClassName, + MapAncestorName: String); + procedure CreateListDeclaration(Strings: TStrings; ListMode: TListMode; + const ObjectClassName, ListClassName, ListAncestorName: String); + Property DBCollOptions : TDBColLOptions Read GetOpt; + end; + +implementation + +{ TDBCollOptions } + +procedure TDBCollOptions.SetListMode(const AValue: TListMode); +begin + if FListMode=AValue then exit; + FListMode:=AValue; + Case ListMode of + lmNone : + begin + Exclude(FClassOptions,coCreateArrayProperty); + end; + lmList : + begin + AncestorClass:='TPersistent'; + ListAncestorName:='TList'; + end; + lmObjectList : + begin + AncestorClass:='TPersistent'; + ListAncestorName:='TObjectList'; + end; + lmCollection : + begin + AncestorClass:='TCollectionItem'; + ListAncestorName:='TCollection'; + end; + lmDBCollection : + begin + AncestorClass:='TDBCollectionItem'; + ListAncestorName:='TDBCollection'; + Include(FClassoptions,coUseFieldMap); + end; + end; +end; + +procedure TDBCollOptions.SetMapAncestorName(const AValue: String); +begin + CheckIdentifier(AValue,True); + FMapAncestorName:=AValue; +end; + +procedure TDBCollOptions.SetMapClassName(const AValue: String); +begin + CheckIdentifier(AValue,True); + FMapClassName:=AValue; +end; + +function TDBCollOptions.GetListClassName: String; +begin + Result:=FListClassName; + If (Result='') then + Result:=ObjectClassName+'List'; +end; + +function TDBCollOptions.GetArrayPropName: String; +begin + Result:=FArrayPropName; + If (Result='') then + begin + Result:=ObjectClassName; + If (Result<>'') and (Upcase(Result[1])='T') then + Delete(Result,1,1); + Result:=Result+'s'; + end; +end; + +function TDBCollOptions.GetMapName: String; +begin + Result:=FMapClassName; + If (Result='') then + Result:=ObjectClassName+'Map'; +end; + +procedure TDBCollOptions.SetArrayPropName(const AValue: String); +begin + CheckIdentifier(AValue,True); + FArrayPropName:=AValue; +end; + +procedure TDBCollOptions.SetListAncestorName(const AValue: String); +begin + CheckIdentifier(AValue,True); + FListAncestorName:=AValue; +end; + +procedure TDBCollOptions.SetListClassName(const AValue: String); +begin + CheckIdentifier(AValue,True); + FListClassName:=AValue; +end; + +constructor TDBCollOptions.Create; +begin + inherited Create; + FClassOptions:=[coCreateLoader,coUseFieldMap,coCreateAssign]; + AncestorClass:='TPersistent'; + FListAncestorName:='TList'; + ObjectClassName:='TMyObject'; + FMapAncestorName:='TFieldMap'; +end; + +procedure TDBCollOptions.Assign(ASource: TPersistent); + +Var + DC : TDBCollOptions; + +begin + If ASource is TDBCollOptions then + begin + DC:=ASource as TDBCollOptions; + ListMode:=DC.ListMode; + FClassOptions:=DC.FClassOptions; + FListAncestorName:=DC.FListAncestorName; + FListClassName:=DC.FListClassName; + FMapAncestorName:=DC.FMapAncestorName; + FMapClassName:=DC.FMapClassName; + FArrayPropName:=DC.FArrayPropName; + end; + inherited Assign(ASource); +end; + +function TDBCollOptions.CreateLoader: Boolean; +begin + Result:=coCreateLoader in ClassOptions; +end; + +function TDBCollOptions.UseFieldMap: Boolean; +begin + Result:=coUseFieldMap in ClassOptions; +end; + +function TDBCollOptions.CreateArrayProperty: Boolean; +begin + Result:=coCreateArrayProperty in ClassOptions; +end; + +function TDBCollOptions.CreateAssign: Boolean; +begin + Result:=coCreateAssign in ClassOptions; +end; + +{ TDDDBCollCodeGenerator } + +function TDDDBCollCodeGenerator.GetOpt: TDBColLOptions; +begin + Result:=CodeOptions as TDBColLOptions +end; + +procedure TDDDBCollCodeGenerator.DoGenerateInterface(Strings: TStrings); +begin + inherited DoGenerateInterface(Strings); + With DBCollOptions do + begin + If CreateLoader then + begin + if UseFieldMap then + CreateFieldMapDeclaration(Strings,ObjectClassName,MapClassName,MapAncestorName); + end; + if ListMode<>lmNone then + CreateListDeclaration(Strings,ListMode,ObjectClassName,ListClassName,ListAncestorName); + end; +end; + +procedure TDDDBCollCodeGenerator.DoGenerateImplementation(Strings: TStrings); +begin + inherited DoGenerateImplementation(Strings); + With DBCollOptions do + begin + If CreateLoader then + If UseFieldMap then + CreateFieldMapImplementation(Strings,ObjectClassName,MapClassName); + if ListMode<>lmNone then + CreateListImplementation(Strings,ListMode,ObjectClassName,ListClassName); + end; + +end; + +procedure TDDDBCollCodeGenerator.WriteVisibilityStart(V: TVisibility; + Strings: TStrings); +begin + inherited WriteVisibilityStart(V, Strings); + If (V=vPublic) then + With DBCollOptions do + begin + If CreateLoader and (ListMode in [lmList,lmObjectList,lmCollection]) then + begin + If UseFieldMap Then + AddLn(Strings,'Procedure LoadFromMap(Map : TFieldMap);'); + AddLn(Strings,'Procedure LoadFromDataset(ADataset : TDataset);'); + end; + If CreateAssign then + AddLn(Strings,'Procedure Assign(ASource : TPersistent); override;'); + end; +end; + +procedure TDDDBCollCodeGenerator.CreateImplementation(Strings: TStrings); + +Var + S : String; + +begin + inherited CreateImplementation(Strings); + With DBCOlloptions do + begin + If CreateLoader and (ListMode in [lmList,lmObjectList,lmCollection]) then + begin + if UseFieldMap then + begin + S:=Format('Procedure %s.LoadFromMap(Map : TFieldMap);',[ObjectClassName]); + BeginMethod(Strings,S); + CreateObjectLoadFromMap(Strings,ObjectClassName); + EndMethod(Strings,S); + end; + S:=Format('Procedure %s.LoadFromDataset(ADataset : TDataset);',[ObjectClassName]); + BeginMethod(Strings,S); + CreateObjectLoadFromDataset(Strings,ObjectClassName); + EndMethod(Strings,S); + end; + If CreateAssign then + begin + S:=Format('Procedure %s.Assign(ASource : TPersistent);',[ObjectClassName]); + BeginMethod(Strings,S); + CreateObjectAssign(Strings,ObjectClassName); + EndMethod(Strings,S); + end; + end; +end; + +procedure TDDDBCollCodeGenerator.CreateObjectAssign(Strings : TStrings; Const ObjectClassName : String); + +Var + I : Integer; + F : TFieldPropDef; + +begin + AddLn(Strings,'var'); + IncIndent; + Try + AddLn(Strings,'O : %s ;',[ObjectClassName]); + Finally + DecIndent; + end; + Addln(Strings,'begin'); + IncIndent; + Try + AddLn(Strings,'If (ASource is %s) then',[ObjectClassName]); + IncIndent; + Try + Addln(Strings,'begin'); + Addln(Strings,'O:=(ASource as %s);',[ObjectClassName]); + For I:=0 to Fields.Count-1 do + begin + F:=Fields[i]; + If F.Enabled Then + WriteFieldAssign(Strings,F); + end; + Addln(Strings,'end'); + Finally + DecIndent; + end; + AddLn(Strings,'else'); + IncIndent; + Try + AddLn(Strings,'Inherited;'); + Finally + DecIndent; + end; + Finally + DecIndent; + end; +end; + +procedure TDDDBCollCodeGenerator.WriteFieldAssign(Strings : TStrings; F : TFieldPropDef); + +Var + S : String; + +begin + Case F.PropertyType of + ptStream: S:=Format('%s.CopyFrom(O.%s,0);',[F.ObjPasReadDef,F.ObjPasReadDef]); + ptTStrings: S:=Format('%s.Assign(O.%s,0);',[F.ObjPasReadDef,F.ObjPasReadDef]); + ptCustom: S:=Format('// Custom code to assign %s from O.%s',[F.ObjPasReadDef,F.ObjPasReadDef]); + else + S:=Format('%s:=O.%s;',[F.ObjPasReadDef,F.ObjPasReadDef]); + end; + AddLn(Strings,S); +end; + +procedure TDDDBCollCodeGenerator.CreateObjectLoadFromMap(Strings : TStrings; Const ObjectClassName : String); + +begin + Addln(Strings,'begin'); + IncIndent; + Try + AddLn(Strings,'Map.LoadObject(Self);'); + Finally + DecIndent; + end; +end; + +procedure TDDDBCollCodeGenerator.CreateObjectLoadFromDataset(Strings : TStrings; Const ObjectClassName : String); + +Var + I : Integer; + +begin + AddLn(Strings,'begin'); + Incindent; + try + If DBColloptions.UseFieldMap then + begin + AddLn(Strings,'With %s.Create(ADataset) do',[DBCollOptions.MapClassName]); + IncIndent; + Try + Addln(Strings,'try'); + IncIndent; + Try + Addln(Strings,'LoadObject(Self);'); + Finally + DecIndent; + end; + Addln(Strings,'Finally'); + IncIndent; + Try + Addln(Strings,'Free;'); + Finally + DecIndent; + end; + Addln(Strings,'end;'); + Finally + Decindent; + end; + end + else + begin + AddLn(Strings,'With ADataset do'); + IncIndent; + Try + AddLn(Strings,'begin'); + For I:=0 to Fields.Count-1 do + If Fields[i].Enabled then + WriteFieldDatasetAssign(Strings,Fields[i]); + AddLn(Strings,'end;'); + Finally + DecIndent; + end; + end; + Finally + Decindent; + end; +end; + +procedure TDDDBCollCodeGenerator.WriteFieldDatasetAssign(Strings : TStrings; F : TFieldPropDef); + +Var + FN,PN,S,R : String; + +begin + PN:=F.PropertyName; + FN:=F.FieldName; + Case F.PropertyType of + ptBoolean : + S:='AsBoolean'; + ptShortint, ptByte, + ptSmallInt, ptWord, + ptLongint, ptCardinal : + S:='AsInteger'; + ptInt64, ptQWord: + If F.FieldType=ftLargeInt then + R:=Format('%s:=(FieldByName(%s) as TLargeIntField).AsLargeInt;',[PN,CreateString(FN)]) + else + S:='AsInteger'; + ptShortString, ptAnsiString, ptWideString : + S:='AsString'; + ptSingle, ptDouble, ptExtended, ptComp : + S:='AsFloat'; + ptCurrency : + S:='AsCurrency'; + ptDateTime : + S:='AsDateTime'; + ptEnumerated : + R:=Format('Integer(%s):=FieldByName(%s).AsInteger;',[PN,CreateString(FN)]); + ptSet : + S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]); + ptStream : + R:=Format('FieldByName(%s).SaveToStream(%s);',[CreateString(FN),PN]); + ptTStrings : + R:=Format('%s.Text:=FieldByName(%s).AsString;',[PN,CreateString(FN),PN]); + ptCustom : + R:=Format('// Add custom loading code here for %s from %s',[PN,FN]); + end; + If (S<>'') then + R:=Format('%s:=FieldByName(%s).%s;',[PN,CreateString(FN),s]); + AddLn(Strings,R); +end; + + +{ FieldMap interface generation routines} + +procedure TDDDBCollCodeGenerator.CreateFieldMapDeclaration(Strings : TStrings; + Const ObjectClassName,MapClassName,MapAncestorName : String); + + +begin + Addln(Strings); + IncIndent; + try + Addln(Strings,'{ %s }',[MapClassName]); + Addln(Strings); + Addln(Strings,'%s = Class(%s)',[MapClassName,MapAncestorName]); + DoCreateFieldMapDeclaration(Strings,ObjectClassName,MapClassName,MapAncestorName); + AddLn(Strings,'end;'); + Finally + DecIndent; + end; +end; + +procedure TDDDBCollCodeGenerator.DoCreateFieldMapDeclaration(Strings : TStrings; + Const ObjectClassName,MapClassName,MapAncestorName : String); + +Var + I : Integer; + F : TFieldPropDef; + +begin + AddLn(Strings,'Private'); + IncIndent; + Try + For I:=0 to Fields.Count-1 do + begin + F:=Fields[I]; + If F.Enabled then + AddLn(Strings,'F%s : TField;',[F.FieldName]); + end; + AddLn(Strings,'Procedure DoLoad(AObject : %s);',[ObjectClassName]); + Finally + DecIndent; + end; + AddLn(Strings,'Public'); + IncIndent; + Try + AddLn(Strings,'Procedure InitFields; Override;'); + AddLn(Strings,'Procedure LoadObject(AObject : TObject); Override;'); + Finally + DecIndent; + end; +end; + +{ FieldMap implementation generation routines} + +procedure TDDDBCollCodeGenerator.CreateFieldMapImplementation(Strings : TStrings; + Const ObjectClassName,MapClassName : String); + +Var + S : String; + +begin + AddLn(Strings,' { %s }',[MapClassName]); + AddLn(Strings); + S:=Format('Procedure %s.DoLoad(AObject : %s);',[MapClassName,ObjectClassName]); + BeginMethod(Strings,S); + Try + DoWriteMapLoad(Strings,ObjectClassName,MapClassName); + Finally + EndMethod(Strings,S); + end; + S:=Format('Procedure %s.LoadObject(AObject : TObject);',[MapClassName]); + BeginMethod(Strings,S); + Try + DoWriteMapLoadObject(Strings,ObjectClassName,MapClassName); + Finally + EndMethod(Strings,S); + end; + S:=Format('Procedure %s.InitFields;',[MapClassName]); + BeginMethod(Strings,S); + Try + WriteMapInitFields(Strings,ObjectClassName,MapClassName); + Finally + EndMethod(Strings,S); + end; +end; + +procedure TDDDBCollCodeGenerator.DoWriteMapLoad(Strings : TStrings; COnst ObjectClassName,MapClassName : String); + +Var + I : Integer; + +begin + AddLn(Strings,'begin'); + IncIndent; + try + AddLn(Strings,'With AObject do'); + IncIndent; + try + AddLn(Strings,'begin'); + For I:=0 to Fields.Count-1 do + If Fields[i].Enabled then + WriteFieldMapAssign(Strings,Fields[i]); + AddLn(Strings,'end;'); + finally + DecIndent; + end; + finally + DecIndent; + end; +end; + +procedure TDDDBCollCodeGenerator.DoWriteMapLoadObject(Strings : TStrings; Const ObjectClassName,MapClassName : String); + +begin + Addln(Strings,'begin'); + IncIndent; + try + Addln(Strings,'DoLoad(AObject as %s);',[ObjectClassName]); + finally + DecIndent; + end; +end; + + +procedure TDDDBCollCodeGenerator.WriteFieldMapAssign(Strings : TStrings; F : TFieldPropDef); + +Var + FN,PN,S : String; + +begin + PN:=F.PropertyName; + FN:='Self.F'+F.FieldName; + Case F.PropertyType of + ptBoolean : + S:=Format('%s:=GetFromField(%s,%s);',[PN,FN,PN]); + ptShortint, ptByte, + ptSmallInt, ptWord, + ptLongint, ptCardinal : + S:=Format('%s:=GetFromField(%s,%s);',[PN,FN,PN]); + ptInt64, ptQWord, + ptShortString, ptAnsiString, ptWideString : + S:=Format('%s:=GetFromField(%s,%s);',[PN,FN,PN]); + ptSingle, ptDouble, ptExtended, ptComp, ptCurrency : + S:=Format('%s:=GetFromField(%s,%s);',[PN,FN,PN]); + ptDateTime : + S:=Format('%s:=GetFromField(%s,%s);',[PN,FN,PN]); + ptEnumerated : + S:=Format('Integer(%s):=GetFromField(%s,Ord(%s));',[PN,FN,PN]); + ptSet : + S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]); + ptStream : + S:=Format('%s.SaveToStream(%s);',[FN,PN]); + ptTStrings : + S:=Format('%s.Text:=GetFromField(%s,%s.Text)',[PN,FN,PN]); + ptCustom : + S:=Format('// Add custom loading code here for %s from %s',[PN,FN]); + end; + AddLn(Strings,S); +end; + +procedure TDDDBCollCodeGenerator.WriteMapInitFields(Strings : TStrings; COnst ObjectClassName,MapClassName : String); + +Var + I: Integer; + F : TFieldPropDef; + +begin + AddLn(Strings,'begin'); + IncIndent; + try + For I:=0 to Fields.Count-1 Do + begin + F:=Fields[i]; + If F.Enabled then + AddLn(Strings,'F%s:=FindField(%s);',[F.FieldName,CreateString(F.FieldName)]); + end; + Finally + DecIndent; + end; +end; + +function TDDDBCollCodeGenerator.GetInterfaceUsesClause: string; +begin + Result:=inherited GetInterfaceUsesClause; + With DBColloptions do + if CreateLoader or (ListMode=lmDBCollection) then + begin + If (Result<>'') then + Result:=Result+', '; + Result:=Result+'db'; + If (ListMode=lmObjectList) then + Result:=Result+', contnrs'; + If UseFieldMap or (ListMode=lmDBCollection) then + Result:=Result+', dbcoll'; + end; + +end; + + + +{ List class generation routines } + +procedure TDDDBCollCodeGenerator.CreateListDeclaration(Strings : TStrings; + ListMode : TListMode; Const ObjectClassName,ListClassName,ListAncestorName : String); + +begin + IncIndent; + try + Addln(Strings); + Addln(Strings,'{ %s }',[ListClassName]); + Addln(Strings); + Addln(Strings,'%s = Class(%s)',[ListClassName,ListAncestorName]); + DoCreateListDeclaration(Strings,ListMode,ObjectClassName,ListClassName,ListAncestorName); + AddLn(Strings,'end;'); + Finally + DecIndent; + end; +end; + + +procedure TDDDBCollCodeGenerator.DoCreateListDeclaration(Strings : TStrings; + ListMode : TListMode; Const ObjectClassName,ListClassName,ListAncestorName : String); + +Var + S : String; + +begin + If DBCollOptions.CreateArrayProperty then + begin + AddLn(Strings,'Private'); + IncIndent; + Try + AddLn(Strings,'Function GetObj(Index : Integer) : %s;',[ObjectClassname]); + AddLn(Strings,'Procedure SetObj(Index : Integer; AValue : %s);',[ObjectClassname]); + Finally + DecIndent; + end; + end; + AddLn(Strings,'Public'); + IncIndent; + Try + If (ListMode in [lmList,lmObjectList,lmCollection]) and DBCollOptions.CreateLoader then + begin + If DBColloptions.UseFieldMap then + AddLn(Strings,'Procedure LoadFromMap(Map : TFieldMap);'); + AddLn(Strings,'Procedure LoadFromDataset(Dataset : TDataset);'); + end + Finally + DecIndent; + end; + If DBCollOptions.CreateArrayProperty then + begin + IncIndent; + Try + S:=DBCollOptions.ArrayPropName; + AddLn(Strings,'Property %s[Index : Integer] : %s Read GetObj Write SetObj; Default;',[S,ObjectClassname]); + Finally + DecIndent; + end; + end; +end; + +procedure TDDDBCollCodeGenerator.CreateListImplementation(Strings : TStrings; + ListMode : TListMode; Const ObjectClassName,ListClassName : String); + +Var + S : String; + +begin + If (ListMode in [lmList,lmObjectList,lmCollection]) and DBCollOptions.CreateLoader then + begin + AddLn(Strings,'{ %s }',[ListClassName]); + If DBCollOptions.CreateArrayProperty then + begin + S:=Format('Function %s.GetObj(Index : Integer) : %s;',[ListClassName,ObjectClassname]); + BeginMethod(Strings,S); + AddLn(Strings,'begin'); + IncIndent; + try + AddLn(Strings,'Result:=%s(Items[Index]);',[ObjectClassname]); + finally + DecIndent; + end; + EndMethod(Strings,S); + S:=Format('Procedure %s.SetObj(Index : Integer; AValue : %s);',[ListClassName,ObjectClassname]); + BeginMethod(Strings,S); + AddLn(Strings,'begin'); + IncIndent; + try + AddLn(Strings,'Items[Index]:=AValue;'); + finally + DecIndent; + end; + EndMethod(Strings,S); + end; + If DBColloptions.UseFieldMap then + begin + AddLn(Strings); + S:=Format('Procedure %s.LoadFromMap(Map : TFieldMap);',[ListClassName]); + BeginMethod(Strings,S); + WriteListLoadFromMap(Strings,Listmode,ObjectClassName,ListClassName); + EndMethod(Strings,S); + end; + AddLn(Strings); + S:=Format('Procedure %s.LoadFromDataset(Dataset : TDataset);',[ListClassName]); + BeginMethod(Strings,S); + WriteListLoadFromDataset(Strings,Listmode,ObjectClassName,ListClassName); + EndMethod(Strings,S); + end; +end; + +procedure TDDDBCollCodeGenerator.WriteListLoadFromMap(Strings : TStrings; ListMode : TListMode; Const ObjectClassName,ListClassName : String); + +begin + WriteListLoad(Strings,ListMode,ObjectClassName,ListClassName,True); +end; + +procedure TDDDBCollCodeGenerator.WriteListLoadFromDataset(Strings : TStrings; ListMode : TListMode; Const ObjectClassName,ListClassName : String); + + +Var + M : String; + +begin + If Not DBCollOptions.UseFieldMap then + WriteListLoad(Strings,ListMode,ObjectClassName,ListClassName,False) + else + begin + M:=DBCollOptions.MapClassName; + AddLn(Strings); + AddLn(Strings,'Var'); + IncIndent; + try + AddLn(Strings,'Map : %s;',[M]); + Finally + DecIndent; + end; + AddLn(Strings); + AddLn(Strings,'begin'); + IncIndent; + try + AddLn(Strings,'Map:=%s.Create(Dataset);',[M]); + AddLn(Strings,'Try'); + IncIndent; + try + AddLn(Strings,'LoadFromMap(Map);'); + finally + DecIndent; + end; + AddLn(Strings,'Finally'); + IncIndent; + try + AddLn(Strings,'FreeAndNil(Map);'); + finally + DecIndent; + end; + AddLn(Strings,'end;'); + finally + DecIndent; + end; + end; +end; + +procedure TDDDBCollCodeGenerator.WriteListLoad(Strings : TStrings; ListMode : TListMode; Const ObjectClassName,ListClassName : String; FromMap : Boolean); + +begin + AddLn(Strings); + AddLn(Strings,'Var'); + IncIndent; + try + AddLn(Strings,'Obj : %s;',[ObjectClassName]); + Finally + DecIndent; + end; + AddLn(Strings); + AddLn(Strings,'begin'); + IncIndent; + try + If FromMap then + begin + AddLn(Strings,'With Map do'); + IncIndent; + end; + Try + AddLn(Strings,'While not Dataset.EOF do'); + IncIndent; + Try + AddLn(Strings,'begin'); + WriteListCreateObject(Strings,ListMode,'Obj',ObjectClassName); + AddLn(Strings,'Try'); + IncIndent; + Try + If FromMap then + AddLn(Strings,'LoadObject(Obj);') + else + AddLn(Strings,'Obj.LoadFromDataset(Dataset);'); + WriteListAddObject(Strings,ListMode,'Obj',ObjectClassName); + Finally + DecIndent; + end; + AddLn(Strings,'Except'); + IncIndent; + Try + AddLn(Strings,'FreeAndNil(Obj);'); + AddLn(Strings,'Raise;'); + Finally + DecIndent; + end; + AddLn(Strings,'end;'); + AddLn(Strings,'Dataset.Next;'); + AddLn(Strings,'end;'); + Finally + DecIndent; + end; + finally + If FromMap then + DecIndent; + end; + finally + DecIndent; + end; +end; + +procedure TDDDBCollCodeGenerator.WriteListCreateObject(Strings : TStrings; ListMode : TListMode; Const InstanceName,ObjectClassName : String); + +Var + S : String; + +begin + If ListMode in [lmList,lmObjectList] then + S:=Format('%s:=%s.Create;',[InstanceName,ObjectClassName]) + else + S:=Format('%s:=Self.Add as %s;',[InstanceName,ObjectClassName]); + AddLn(Strings,S); +end; + +procedure TDDDBCollCodeGenerator.WriteListAddObject(Strings : TStrings; ListMode : TListMode; Const InstanceName,ObjectClassName : String); + +Var + S : String; + +begin + If ListMode in [lmList,lmObjectList] then + begin + S:=Format('Add(%s);',[InstanceName]); + AddLn(Strings,S); + end; +end; + + + + +class function TDDDBCollCodeGenerator.NeedsFieldDefs: Boolean; +begin + Result:=True; +end; + +function TDDDBCollCodeGenerator.CreateOptions: TCodeGeneratorOptions; +begin + Result:=TDBCollOptions.Create; +end; + + +Initialization + RegisterCodeGenerator('DBColl','Simple object/collection for the data',TDDDBCollCodeGenerator); + +Finalization + UnRegisterCodeGenerator(TDDDBCollCodeGenerator); +end. + diff --git a/packages/fcl-db/src/codegen/fpcgsqlconst.pp b/packages/fcl-db/src/codegen/fpcgsqlconst.pp new file mode 100644 index 0000000000..7dc82ab0da --- /dev/null +++ b/packages/fcl-db/src/codegen/fpcgsqlconst.pp @@ -0,0 +1,208 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2007 by Michael Van Canneyt, member of the + Free Pascal development team + + Data Dictionary Code Generator 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. + + **********************************************************************} +unit fpcgsqlconst; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpddCodeGen; + +Type + + { TDDSQLConstOptions } + + TMode = (mConst,mTStrings); + TDDSQLConstOptions = Class(TCodeGeneratorOptions) + private + FIDent: String; + FMode: TMode; + procedure SetIdent(const AValue: String); + Public + Constructor Create; override; + Procedure Assign(ASource : TPersistent); override; + Published + Property Identifier : String Read FIDent Write SetIdent; + Property Mode : TMode Read FMode Write FMode; + end; + + + { TDDSQLConstGenerator } + + TDDSQLConstGenerator = Class(TDDCustomCodeGenerator) + Private + FSQL : TStrings; + Protected + Function CreateOptions : TCodeGeneratorOptions; override; + Procedure DoGenerateInterface(Strings: TStrings); override; + Procedure DoGenerateImplementation(Strings: TStrings); override; + function GetSQL: TStrings; override; + procedure SetSQL(const AValue: TStrings); override; + Function SQLOptions : TDDSQLConstOptions; + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + Class Function NeedsSQL : Boolean; override; + Class Function NeedsFieldDefs : Boolean; override; + end; + +Const + SSQLConst = 'SQLConst'; + +Resourcestring + SSQLConstDescr = 'Generate Pascal constant/Stringlist from SQL'; + +implementation + +{ TDDSQLConstOptions } + +procedure TDDSQLConstOptions.SetIdent(const AValue: String); +begin + if FIDent=AValue then exit; + If Not IsValidIdent(AValue) then + Raise ECodeGenerator.CreateFmt(SErrInvalidIdentifier,[AValue]); + FIDent:=AValue; +end; + +constructor TDDSQLConstOptions.Create; +begin + Inherited; + FIdent:='SQL'; // Do not localize +end; + +procedure TDDSQLConstOptions.Assign(ASource: TPersistent); + +Var + CO: TDDSQLConstOptions; + +begin + If ASource is TDDSQLConstOptions then + begin + CO:=ASource as TDDSQLConstOptions; + FIDent:=CO.FIdent; + FMode:=CO.FMode; + end; + inherited Assign(ASource); +end; + +{ TDDSQLConstGenerator } + +function TDDSQLConstGenerator.CreateOptions: TCodeGeneratorOptions; +begin + Result:=TDDSQLConstOptions.Create; +end; + +procedure TDDSQLConstGenerator.DoGenerateInterface(Strings: TStrings); + +Var + S : String; + I,L : Integer; + +begin + If (SQLOptions.Mode=mConst) then + begin + Addln(Strings,'Const'); + L:=Length(SQLOPtions.Identifier); + IncIndent; + try + For I:=0 to FSQL.Count-1 do + begin + If (I=0) then + S:=SQLOPtions.Identifier+' = ' + else + S:=StringOfChar(' ',L)+' +'; + S:=S+CreateString(FSQL[i]); + If (I=FSQL.Count-1) then + S:=S+';' + else + S:=S+'+sLineBreak'; + Addln(Strings,S); + end; + finally + DecIndent; + end; + end; +end; + +procedure TDDSQLConstGenerator.DoGenerateImplementation(Strings: TStrings); + +Var + S : String; + I,L : Integer; + +begin + If (SQLOptions.Mode=mTStrings) then + begin + Addln(Strings,'With %s do',[SQLOPtions.Identifier]); + IncIndent; + try + Addln(Strings,'begin'); + For I:=0 to FSQL.Count-1 do + Addln(Strings,'Add(%s);',[CreateString(FSQL[i])]); + Addln(Strings,'end;'); + finally + DecIndent; + end; + end; +end; + +function TDDSQLConstGenerator.GetSQL: TStrings; +begin + Result:=FSQL; +end; + +procedure TDDSQLConstGenerator.SetSQL(const AValue: TStrings); +begin + FSQL.Assign(AValue); +end; + +function TDDSQLConstGenerator.SQLOptions: TDDSQLConstOptions; +begin + Result:=CodeOptions as TDDSQLConstOptions; +end; + +constructor TDDSQLConstGenerator.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FSQL:=TSTringList.Create; +end; + +destructor TDDSQLConstGenerator.Destroy; +begin + FreeAndNil(FSQL); + inherited Destroy; +end; + +class function TDDSQLConstGenerator.NeedsSQL: Boolean; +begin + Result:=True; +end; + +class function TDDSQLConstGenerator.NeedsFieldDefs: Boolean; +begin + Result:=False; +end; + + +Initialization + RegisterCodeGenerator(SSQLConst, SSQLConstDescr, TDDSQLConstGenerator); + +Finalization + UnRegisterCodeGenerator(TDDSQLConstGenerator); + +end. + diff --git a/packages/fcl-db/src/codegen/fpcgtiopf.pp b/packages/fcl-db/src/codegen/fpcgtiopf.pp new file mode 100644 index 0000000000..53454e5e0d --- /dev/null +++ b/packages/fcl-db/src/codegen/fpcgtiopf.pp @@ -0,0 +1,732 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2007 by Michael Van Canneyt, member of the + Free Pascal development team + + Data Dictionary Code Generator 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. + + **********************************************************************} +unit fpcgtiopf; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, db, fpddcodegen; + +TYpe + TClassOption = (caConstructor,caDestructor,caCreateList,caListAddMethod,caListItemsProperty); + TClassOptions = Set of TClassOption; + TVisitorOption = (voRead,voReadList,voCreate,voDelete,voUpdate); + TVisitorOptions = set of TVisitorOption; + + { TTiOPFCodeOptions } + + TTiOPFCodeOptions = Class (TClassCodeGeneratorOptions) + Private + FClassOptions: TClassOptions; + FListAncestorName: String; + FListClassName : String; + FVisitorOptions: TVisitorOptions; + function GetListClassName: String; + procedure SetListAncestorName(const AValue: String); + procedure SetListClassName(const AValue: String); + Public + Constructor Create; override; + Procedure Assign(ASource : TPersistent); override; + Published + Property ClassOptions : TClassOptions Read FClassOptions Write FClassOptions; + Property VisitorOptions : TVisitorOptions Read FVisitorOptions Write FVisitorOptions; + Property ListAncestorName : String Read FListAncestorName Write SetListAncestorName; + Property ListClassName : String Read GetListClassName Write SetListClassName; + Property AncestorClass; + end; + + { TTiOPFCodeGenerator } + + TTiOPFCodeGenerator = Class(TDDClassCodeGenerator) + procedure CreateListImplementation(Strings: TStrings; const ObjectClassName, ListClassName: String); + function BeginInit(Strings: TStrings; const AClass: String): String; + function BeginAcceptVisitor(Strings: TStrings; const AClass, ObjectClassName: String): String; + function BeginSetupParams(Strings: TStrings; const AClass,ObjectClassName: String; DeclareObject : Boolean): String; + function BeginMapRowToObject(Strings: TStrings; const AClass, ObjectClassName : String): String; + procedure DeclareObjectvariable(Strings: TStrings; + const ObjectClassName: String); + private + function GetOpt: TTiOPFCodeOptions; + procedure WriteCreateVisitor(Strings: TStrings; const ObjectClassName: String); + procedure WriteDeleteVisitor(Strings: TStrings; const ObjectClassName: String); + procedure WriteFieldAssign(Strings: TStrings; F: TFieldPropDef); + procedure WriteParamAssign(Strings: TStrings; F: TFieldPropDef); + procedure WriteReadListVisitor(Strings: TStrings; const ObjectClassName: String); + procedure WriteReadVisitor(Strings: TStrings; const ObjectClassName: String ); + procedure WriteUpdateVisitor(Strings: TStrings; const ObjectClassName: String); + procedure WriteVisitorDeclaration(Strings: TStrings; V: TVisitorOption; const ObjectClassName: String); + procedure WriteVisitorImplementation(Strings: TStrings; V: TVisitorOption; const ObjectClassName: String); + Protected + // Not to be overridden. + procedure WriteListAddObject(Strings: TStrings; const ListClassName, ObjectClassName: String); + // Overrides of parent objects + Function GetInterfaceUsesClause : string; override; + Procedure DoGenerateInterface(Strings: TStrings); override; + Procedure DoGenerateImplementation(Strings: TStrings); override; + Function NeedsConstructor : Boolean; override; + Function NeedsDestructor : Boolean; override; + Class Function NeedsFieldDefs : Boolean; override; + Function CreateOptions : TCodeGeneratorOptions; override; + // + // New methods + // + // Override to add declarations to list declaration + procedure DoCreateListDeclaration(Strings: TStrings; const ObjectClassName, ListClassName, ListAncestorName: String); virtual; + Public + procedure CreateListDeclaration(Strings: TStrings; const ObjectClassName, ListClassName, ListAncestorName: String); + Property TiOPFOptions : TTiOPFCodeOptions Read GetOpt; + end; + +implementation + +{ TTiOPFCodeOptions } + +function TTiOPFCodeOptions.GetListClassName: String; +begin + Result:=FListClassName; + If (Result='') then + Result:=ObjectClassName+'List'; +end; + +procedure TTiOPFCodeOptions.SetListAncestorName(const AValue: String); +begin + CheckIdentifier(AValue,False); + FListAncestorName:=AValue; +end; + +procedure TTiOPFCodeOptions.SetListClassName(const AValue: String); +begin + CheckIdentifier(AValue,True); + FListClassName:=AValue; +end; + +constructor TTiOPFCodeOptions.Create; +begin + inherited Create; + FListAncestorName:='TObjectList'; + AncestorClass:='TTiObject'; + ObjectClassName:='MyObject'; + FVisitorOptions:=[voRead,voCreate,voDelete,voUpdate]; + FClassOptions:=[caCreateList,caListAddMethod,caListItemsProperty]; +end; + +procedure TTiOPFCodeOptions.Assign(ASource: TPersistent); + +Var + OC : TTiOPFCodeOptions; + +begin + If ASource is TTiOPFCodeOptions then + begin + OC:=ASource as TTiOPFCodeOptions; + FListAncestorName:=OC.FListAncestorName; + AncestorClass:=OC.AncestorClass; + FVisitorOptions:=OC.FVisitorOptions; + FClassOptions:=OC.FClassOptions; + end; + inherited Assign(ASource); +end; + +{ TTiOPFCodeGenerator } + +{ --------------------------------------------------------------------- + General overrides + ---------------------------------------------------------------------} + +function TTiOPFCodeGenerator.NeedsConstructor: Boolean; +begin + Result:=inherited NeedsConstructor; + Result:=Result or (caConstructor in TiOPFOptions.ClassOptions); +end; + +function TTiOPFCodeGenerator.NeedsDestructor: Boolean; +begin + Result:=inherited NeedsDestructor; + Result:=Result or (caDestructor in TiOPFOptions.ClassOptions); +end; + +class function TTiOPFCodeGenerator.NeedsFieldDefs: Boolean; +begin + Result:=True; +end; + +function TTiOPFCodeGenerator.CreateOptions: TCodeGeneratorOptions; +begin + Result:=TTiOPFCodeOptions.Create; +end; +function TTiOPFCodeGenerator.GetOpt: TTiOPFCodeOptions; +begin + Result:=CodeOptions as TTiOPFCodeOptions; +end; + +function TTiOPFCodeGenerator.GetInterfaceUsesClause: string; +begin + Result:=inherited GetInterfaceUsesClause; + If (Result<>'') then + Result:=Result+','; + Result:=Result+'tiVisitor, tiObject'; +end; + +procedure TTiOPFCodeGenerator.DoGenerateInterface(Strings: TStrings); + +Var + V : TVisitorOption; + +begin + inherited DoGenerateInterface(Strings); + With TiOPFOptions do + begin + IncIndent; + try + If caCreateList in ClassOptions then + CreateListDeclaration(Strings,ObjectClassName,ListClassName,ListAncestorName); + For V:=Low(TVisitorOption) to High(TVisitorOption) do + If V in VisitorOptions then + WriteVisitorDeclaration(Strings,V,ObjectClassName); + Finally + DecIndent; + end; + end; +end; + +Function StripType(S : String) : string; + +begin + Result:=S; + If (Result<>'') and (Result[1]='T') then + Delete(Result,1,1); +end; + +procedure TTiOPFCodeGenerator.WriteVisitorDeclaration(Strings : TStrings; V : TVisitorOption; Const ObjectClassName : String); + +Var + S,T,A : string; + +begin + Case V of + voRead : S:='Read'; + voReadList : S:='ReadList'; + voCreate : S:='Create'; + voDelete : S:='Delete'; + voUpdate : S:='Update'; + end; + If V in [voCreate,voDelete,voUpdate] then + A:='Update' + else + A:='Select'; + S:=Format('T%s%sVisitor',[S,StripType(ObjectClassName)]); + AddLn(Strings,'{ %s }',[S]); + AddlN(Strings,'%s = Class(TtiVisitor%s)',[S,A]); + AddlN(Strings,'Protected'); + IncIndent; + Try + AddLn(Strings,'Procedure Init; override;'); + AddLn(Strings,'Function AcceptVisitor : Boolean; override;'); + AddLn(Strings,'Procedure SetupParams; override;'); + If Not (V in [voCreate,voDelete,voUpdate]) then + AddLn(Strings,'Procedure MapRowToObject; override;'); + Finally + DecIndent; + end; + AddlN(Strings,'end;'); + AddlN(Strings); +end; + + +procedure TTiOPFCodeGenerator.DoGenerateImplementation(Strings: TStrings); + +Var + V : TVisitorOption; + +begin + inherited DoGenerateImplementation(Strings); + With TiOPFOptions do + begin + If caCreateList in ClassOptions then + CreateListImplementation(Strings,ObjectClassName,ListClassName); + For V:=Low(TVisitorOption) to High(TVisitorOption) do + If V in VisitorOptions then + WriteVisitorImplementation(Strings,V,ObjectClassName); + end; +end; + +{ --------------------------------------------------------------------- + Visitor helper routines + ---------------------------------------------------------------------} + +procedure TTiOPFCodeGenerator.WriteVisitorImplementation(Strings : TStrings; V : TVisitorOption; Const ObjectClassName : String); + +begin + Case V of + voRead : WriteReadVisitor(Strings,ObjectClassName); + voReadList : WriteReadListVisitor(Strings,ObjectClassName); + voCreate : WriteCreateVisitor(Strings,ObjectClassName); + voDelete : WriteDeleteVisitor(Strings,ObjectClassName); + voUpdate : WriteUpdateVisitor(Strings,ObjectClassName); + end; +end; + +Function TTiOPFCodeGenerator.BeginInit(Strings : TStrings; const AClass : String) : String; + +begin + Result:=Format('Procedure %s.Init;',[AClass]); + BeginMethod(Strings,Result); + AddLn(Strings,'begin'); + IncIndent; +end; + +Function TTiOPFCodeGenerator.BeginAcceptVisitor(Strings : TStrings; Const AClass, ObjectClassName: String) : String; + +begin + Result:=Format('Function %s.AcceptVisitor : Boolean;',[AClass]); + BeginMethod(Strings,Result); + AddLn(Strings,'begin'); + IncIndent; + AddLn(Strings,'Result:=Visited is %s;',[ObjectClassName]); +end; + +Function TTiOPFCodeGenerator.BeginSetupParams(Strings : TStrings; const AClass,ObjectClassName : String; DeclareObject : Boolean) : String; + +begin + Result:=Format('Procedure %s.SetupParams;',[AClass]); + BeginMethod(Strings,Result); + If DeclareObject Then + DeclareObjectVariable(Strings,ObjectClassName); + AddLn(Strings,'begin'); + If DeclareObject Then + Addln(Strings,'O:=%s(Visited);',[ObjectClassName]); + IncIndent; +end; + +Procedure TTiOPFCodeGenerator.DeclareObjectvariable(Strings : TStrings; Const ObjectClassName : String); + +begin + AddLn(Strings,'var'); + IncIndent; + try + AddLn(Strings,'O : %s;',[ObjectClassName]); + AddLn(Strings); + finally + DecIndent; + end; +end; + +Function TTiOPFCodeGenerator.BeginMapRowToObject(Strings : TStrings; Const AClass,ObjectClassName : String) : String; + +begin + Result:=Format('Procedure %s.MapRowToObject;',[AClass]); + BeginMethod(Strings,Result); + DeclareObjectVariable(Strings,ObjectClassName); + AddLn(Strings,'begin'); + IncIndent; +end; + +{ --------------------------------------------------------------------- + Read Visitor + ---------------------------------------------------------------------} + +procedure TTiOPFCodeGenerator.WriteReadVisitor(Strings : TStrings; Const ObjectClassName : String); + +Var + C,S : String; + I : Integer; + +begin + C:=Format('TRead%sVisitor',[StripType(ObjectClassName)]); + Addln(Strings,'{ %s }',[C]); + Addln(Strings); + // Init + S:=BeginInit(Strings,C); + Addln(Strings,'Query.SQL.Text:=SQLReadList;'); + DecIndent; + EndMethod(Strings,S); + // AcceptVisitor + S:=BeginAcceptVisitor(Strings,C,ObjectClassName); + DecIndent; + EndMethod(Strings,S); + // AcceptSetupParams + S:=BeginSetupParams(Strings,C,'',False); + AddLn(Strings,'// Set up as needed'); + DecIndent; + EndMethod(Strings,S); + // MapRowToObject + S:=BeginMapRowToObject(Strings,C,ObjectClassName); + Addln(Strings,'With Query do',[ObjectClassName]); + IncINdent; + try + Addln(Strings,'begin'); + For I:=0 to Fields.Count-1 do + If Fields[i].Enabled then + WriteFieldAssign(Strings,Fields[i]); + Addln(Strings,'end'); + finally + DecIndent; + end; + DecIndent; + EndMethod(Strings,S); +end; + +procedure TTiOPFCodeGenerator.WriteFieldAssign(Strings : TStrings; F : TFieldPropDef); + +Var + PN,FN,SFN,R,S : String; + +begin + PN:=F.PropertyName; + FN:=F.FieldName; + SFN:=CreateString(FN); + Case F.PropertyType of + ptBoolean : + S:='AsBoolean'; + ptShortint, ptByte, + ptSmallInt, ptWord, + ptLongint, ptCardinal : + S:='AsInteger'; + ptInt64, ptQWord: + If F.FieldType=ftLargeInt then + R:=Format('O.%s:=(FieldByName(%s) as TLargeIntField).AsLargeInt;',[PN,SFN]) + else + S:='AsInteger'; + ptShortString, ptAnsiString, ptWideString : + S:='AsString'; + ptSingle, ptDouble, ptExtended, ptComp : + S:='AsFloat'; + ptCurrency : + S:='AsCurrency'; + ptDateTime : + S:='AsDateTime'; + ptEnumerated : + R:=Format('Integer(O.%s):=FieldAsInteger[%s];',[PN,SFN]); + ptSet : + S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]); + ptStream : + R:=Format('FieldByName(%s).SaveToStream(O.%s);',[SFN,PN]); + ptTStrings : + R:=Format('O.%s.Text:=FieldAsString[%s];',[PN,SFN]); + ptCustom : + R:=Format('// Add custom loading code here for %s from %s',[PN,FN]); + end; + If (S<>'') then + R:=Format('O.%s:=Field%s[%s];',[PN,S,SFN]); + AddLn(Strings,R); +end; + +procedure TTiOPFCodeGenerator.WriteParamAssign(Strings : TStrings; F : TFieldPropDef); + +Var + PN,FN,SFN,R,S : String; + +begin + PN:=F.PropertyName; + FN:=F.FieldName; + SFN:=CreateString(FN); + Case F.PropertyType of + ptBoolean : + S:='AsBoolean'; + ptShortint, ptByte, + ptSmallInt, ptWord, + ptLongint, ptCardinal : + S:='AsInteger'; + ptInt64, ptQWord: + If F.FieldType=ftLargeInt then + R:=Format('O.%s:=(Name(%s) as TLargeIntField).AsLargeInt;',[PN,SFN]) + else + S:='AsInteger'; + ptShortString, ptAnsiString, ptWideString : + S:='AsString'; + ptSingle, ptDouble, ptExtended, ptComp : + S:='AsFloat'; + ptCurrency : + S:='AsCurrency'; + ptDateTime : + S:='AsDateTime'; + ptEnumerated : + R:=Format('ParamAsInteger[%s]:=Integer(O.%s);',[SFN,PN]); + ptSet : + S:=Format('// Add custom set loading code here for %s from %s',[PN,FN]); + ptStream : + R:=Format('AssignParamFromStream(%s,%s);',[SFN,PN]); + ptTStrings : + R:=Format('ParamAsString[%s]:=O.%s.Text;',[SFN,PN]); + ptCustom : + R:=Format('// Add custom loading code here for %s from %s',[PN,FN]); + end; + If (S<>'') then + R:=Format('O.%s:=Param%s[%s];',[PN,S,SFN]); + AddLn(Strings,R); +end; + +{ --------------------------------------------------------------------- + List Read Visitor + ---------------------------------------------------------------------} + +procedure TTiOPFCodeGenerator.WriteReadListVisitor(Strings : TStrings; Const ObjectClassName : String); + +Var + C,S,LN : String; + I : Integer; + +begin + LN:=tiOPFOptions.ListClassName; + C:=Format('TRead%sVisitor',[StripType(LN)]); + Addln(Strings,'{ %s }',[C]); + Addln(Strings); + // Init + S:=BeginInit(Strings,C); + Addln(Strings,'Query.SQL.Text:=SQLReadList;'); + DecIndent; + EndMethod(Strings,C); + // AcceptVisitor + S:=BeginAcceptVisitor(Strings,C,LN); + DecIndent; + EndMethod(Strings,S); + // AcceptSetupParams + S:=BeginSetupParams(Strings,C,'',False); + DecIndent; + EndMethod(Strings,S); + // MapRowToObject + S:=BeginMapRowToObject(Strings,S,ObjectClassName); + Addln(Strings,'O:=%s.Create;',[ObjectClassName]); + For I:=0 to Fields.Count-1 do + If Fields[i].Enabled then + WriteFieldAssign(Strings,Fields[i]); + Addln(Strings,'O.ObjectState:=posClean;'); + Addln(Strings,'%s(Visited).Add(O);',[LN]); + DecIndent; + EndMethod(Strings,S); +end; + +{ --------------------------------------------------------------------- + Create Visitor + ---------------------------------------------------------------------} + +procedure TTiOPFCodeGenerator.WriteCreateVisitor(Strings : TStrings; Const ObjectClassName : String); + + +Var + C,S : String; + I : Integer; + +begin + C:=Format('TCreate%sVisitor',[StripType(ObjectClassName)]); + Addln(Strings,'{ %s }',[C]); + Addln(Strings); + // Init + S:=BeginInit(Strings,C); + Addln(Strings,'Query.SQL.Text:=SQLCreateObject;'); + DecIndent; + EndMethod(Strings,S); + // AcceptVisitor + S:=BeginAcceptVisitor(Strings,C,ObjectClassName); + AddLn(Strings,'Result:=Result and (Visited.ObjectState=posCreate);'); + DecIndent; + EndMethod(Strings,S); + // SetupParams + S:=BeginSetupParams(Strings,C,ObjectClassName,True); + Addln(Strings,'With Query do',[ObjectClassName]); + IncINdent; + try + Addln(Strings,'begin'); + For I:=0 to Fields.Count-1 do + If Fields[i].Enabled then + WriteParamAssign(Strings,Fields[i]); + Addln(Strings,'end;'); + finally + DecIndent; + end; + DecIndent; + EndMethod(Strings,S); +end; + +procedure TTiOPFCodeGenerator.WriteDeleteVisitor(Strings : TStrings; Const ObjectClassName : String); + +Var + C,S : String; + +begin + C:=Format('TDelete%sVisitor',[StripType(ObjectClassName)]); + Addln(Strings,'{ %s }',[C]); + // Init + S:=BeginInit(Strings,C); + Addln(Strings,'Query.SQL.Text:=SQLDeleteObject;'); + DecIndent; + EndMethod(Strings,S); + // AcceptVisitor + S:=BeginAcceptVisitor(Strings,C,ObjectClassName); + AddLn(Strings,'Result:=Result and (Visited.ObjectState=posDelete);'); + DecIndent; + EndMethod(Strings,S); + // SetupParams + S:=BeginSetupParams(Strings,C,ObjectClassName,True); + AddLn(Strings,'// Add parameter setup code here '); + DecIndent; + EndMethod(Strings,S); +end; + +procedure TTiOPFCodeGenerator.WriteUpdateVisitor(Strings : TStrings; Const ObjectClassName : String); + +Var + C,S : String; + I : Integer; + +begin + C:=Format('TUpdate%sVisitor',[StripType(ObjectClassName)]); + Addln(Strings,'{ %s }',[C]); + Addln(Strings); + // Init + S:=BeginInit(Strings,C); + Addln(Strings,'Query.SQL.Text:=SQLUpdateObject;'); + DecIndent; + EndMethod(Strings,S); + // AcceptVisitor + S:=BeginAcceptVisitor(Strings,C,ObjectClassName); + AddLn(Strings,'Result:=Result and (Visited.ObjectState=posUpdate);'); + DecIndent; + EndMethod(Strings,S); + // SetupParams + S:=BeginSetupParams(Strings,C,ObjectClassName,True); + Addln(Strings,'With Query do',[ObjectClassName]); + IncINdent; + try + Addln(Strings,'begin'); + For I:=0 to Fields.Count-1 do + If Fields[i].Enabled then + WriteParamAssign(Strings,Fields[i]); + Addln(Strings,'end;'); + finally + DecIndent; + end; + DecIndent; + EndMethod(Strings,S); +end; + + + + +{ --------------------------------------------------------------------- + List object commands + ---------------------------------------------------------------------} + +procedure TTiOPFCodeGenerator.DoCreateListDeclaration(Strings: TStrings; + const ObjectClassName, ListClassName, ListAncestorName: String); +begin + If caListItemsProperty in tiOPFOptions.ClassOptions then + begin + AddLn(Strings,'Private'); + IncIndent; + Try + AddLn(Strings,'Function GetObj(Index : Integer) : %s;',[ObjectClassname]); + AddLn(Strings,'Procedure SetObj(Index : Integer; AValue : %s);',[ObjectClassname]); + Finally + DecIndent; + end; + end; + If (caListAddMethod in tiOPFOptions.ClassOptions) then + begin + AddLn(Strings,'Public'); + IncIndent; + Try + Addln(Strings,'Procedure Add(AnItem : %s); reintroduce;',[ObjectClassName]); + Finally + DecIndent; + end; + end; + If (caListItemsProperty in tiOPFOptions.ClassOptions) then + begin + If Not (caListAddMethod in tiOPFOptions.ClassOptions) then + AddLn(Strings,'Public'); + IncIndent; + Try + AddLn(Strings,'Property Items[Index : Integer] : %s Read GetObj Write SetObj; Default;',[ObjectClassname]); + Finally + DecIndent; + end; + end; +end; + +procedure TTiOPFCodeGenerator.CreateListDeclaration(Strings: TStrings; + const ObjectClassName, ListClassName, ListAncestorName: String); +begin + Addln(Strings); + Addln(Strings,'{ %s }',[ListClassName]); + Addln(Strings); + Addln(Strings,'%s = Class(%s)',[ListClassName,ListAncestorName]); + DoCreateListDeclaration(Strings,ObjectClassName,ListClassName,ListAncestorName); + AddLn(Strings,'end;'); +end; + +procedure TTiOPFCodeGenerator.WriteListAddObject(Strings: TStrings; + const ListClassName, ObjectClassName: String); + +Var + S : String; + +begin + S:=Format('Procedure %s.Add(AnItem : %s);',[ListClassName,ObjectClassName]); + BeginMethod(Strings,S); + Addln(Strings,'begin'); + IncIndent; + try + Addln(Strings,'inherited Add(AnItem);'); + finally + DecIndent; + end; + EndMethod(Strings,S); +end; + + +procedure TTiOPFCodeGenerator.CreateListImplementation(Strings: TStrings; const ObjectClassName, ListClassName: String); + +Var + S : String; + +begin + If caListItemsProperty in tiOPFOptions.ClassOptions then + begin + AddLn(Strings,'{ %s }',[ListClassName]); + AddLn(Strings); + S:=Format('Function %s.GetObj(Index : Integer) : %s;',[ListClassName,ObjectClassname]); + BeginMethod(Strings,S); + AddLn(Strings,'begin'); + IncIndent; + try + AddLn(Strings,'Result:=%s(Inherited Items[Index]);',[ObjectClassname]); + finally + DecIndent; + end; + EndMethod(Strings,S); + S:=Format('Procedure %s.SetObj(Index : Integer; AValue : %s);',[ListClassName,ObjectClassname]); + BeginMethod(Strings,S); + AddLn(Strings,'begin'); + IncIndent; + try + AddLn(Strings,'Inherited Items[Index]:=AValue;'); + finally + DecIndent; + end; + EndMethod(Strings,S); + end; +end; + +Initialization + RegisterCodeGenerator('tiOPF','tiOPF class and visitors for the data',TTiOPFCodeGenerator); + +Finalization + UnRegisterCodeGenerator(TTiOPFCodeGenerator); +end. + diff --git a/packages/fcl-db/src/codegen/fpddcodegen.pp b/packages/fcl-db/src/codegen/fpddcodegen.pp new file mode 100644 index 0000000000..2531e54cf7 --- /dev/null +++ b/packages/fcl-db/src/codegen/fpddcodegen.pp @@ -0,0 +1,1514 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2007 by Michael Van Canneyt, member of the + Free Pascal development team + + Data Dictionary Code Generator 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. + + **********************************************************************} +unit fpddcodegen; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, DB, fpDataDict; + +Type + TPropType = (ptAuto, + ptBoolean, + ptShortint, ptByte, + ptSmallInt, ptWord, + ptLongint, ptCardinal, + ptInt64, ptQWord, + ptShortString, ptAnsiString, ptWideString, + ptSingle, ptDouble, ptExtended, ptComp, ptCurrency, + ptDateTime, + ptEnumerated, ptSet, ptStream, ptTStrings, + ptCustom); + + TVisibility = (vPrivate,vProtected,vPublic,vPublished); + TPropAccess = (paReadWrite,paReadonly,paWriteonly); + + + TFieldPropDefs = Class; + + { TFieldPropDef } + + TFieldPropDef = Class (TCollectionItem) + private + FEnabled: Boolean; + FFieldName: String; + FFieldType: TFieldType; + FPropAccess: TPropAccess; + FPropDef: String; + FPropType : TPropType; + FPRopSize: Integer; + FPropName : String; + FPropVis: TVisibility; + function GetPropName: String; + function GetPropType: TPropType; + function GetPropTypeStored: boolean; + procedure SetPropName(const AValue: String); + Protected + Procedure InitFromField(F : TField); virtual; + Procedure InitFromDDFieldDef(F : TDDFieldDef);virtual; + Public + Constructor Create(ACollection : TCollection) ; override; + Procedure Assign(ASource : TPersistent); override; + Function FieldPropDefs : TFieldPropDefs; + Function HasGetter : Boolean; Virtual; // Always false. + Function HasSetter : Boolean; Virtual; // True for streams/strings + Function ObjPasTypeDef : String; virtual; // Object pascal definition of type + Function ObjPasReadDef : String; virtual; // Object pascal definition of getter + Function ObjPasWriteDef : String; virtual; // Object pascal definition of setter + Published + Property Enabled : Boolean Read FEnabled Write FEnabled; + Property FieldName : String Read FFieldName Write FFieldName; + Property FieldType : TFieldType Read FFieldType Write FFieldType; + Property PropertyName : String Read GetPropName Write SetPropName; + Property PropertyType : TPropType Read GetPropType Write FPropType Stored GetPropTypeStored; + Property PropertySize : Integer Read FPRopSize Write FPropSize; + Property PropertyDef : String Read FPropDef Write FPropDef; + Property PropertyVisibility : TVisibility Read FPropVis Write FPropVis; + Property PropertyAccess : TPropAccess Read FPropAccess Write FPropAccess; + end; + + { TFieldPropDefs } + + TFieldPropDefs = Class (TCollection) + private + function GetPropDef(Index : integer): TFieldPropDef; + procedure SetPropDef(Index : integer; const AValue: TFieldPropDef); + Public + Function AddDef(AName : String) : TFieldPropDef; + Procedure FromDataset(Dataset : TDataset; DoClear : Boolean = True); + Procedure FromDDFieldDefs(Defs : TDDFieldDefs; DoClear : Boolean = True); + Function IndexOfPropName(AName : String) : Integer; + Function IndexOfFieldName(AName : String) : Integer; + Function FindPropName(AName : String) : TFieldPropDef; + Function FindFieldName(AName : String) : TFieldPropDef; + Property PropDefs[Index : integer] : TFieldPropDef Read GetPropDef write SetPropDef; Default; + end; + + { TFieldPropDefs } + + TCodeOption = (coInterface,coImplementation,coUnit); + TCodeOptions = Set of TCodeOption; + + { TCodeGeneratorOptions } + + TCodeGeneratorOptions = Class(TPersistent) + private + FOptions: TCodeOptions; + FUnitName: String; + procedure SetUnitname(const AValue: String); + Protected + procedure SetOPtions(const AValue: TCodeOptions); virtual; + Public + Constructor create; virtual; + Procedure Assign(ASource : TPersistent); override; + Published + Property Options : TCodeOptions Read FOptions Write SetOPtions; + Property UnitName : String Read FUnitName Write SetUnitname; + end; + TCodeGeneratorOptionsClass = Class of TCodeGeneratorOptions; + + { TDDCustomCodeGenerator } + + TDDCustomCodeGenerator = Class(TComponent) + FCodeOptions: TCodeGeneratorOptions; + Private + FIndent: Integer; + FCurrentIndent :String; + Protected + // Utility routines to add lines to the code. Will prepend indent. + procedure AddLn(Strings: TStrings); overload; + procedure AddLn(Strings: TStrings; Line: String); overload; + procedure AddLn(Strings: TStrings; Fmt: String; Args: array of const); overload; + // Increase indent by defined amount + procedure IncIndent; + // Decrease indent by defined amount + procedure DecIndent; + // Start a method implementation. Writes the declaration. No Begin. + procedure BeginMethod(STrings: TStrings; const Decl: String); Virtual; + // End a method implementation. Writes the final end; + procedure EndMethod(STrings: TStrings; const Decl: String);Virtual; + // The following must be overridden by descendents + Procedure DoGenerateInterface(Strings: TStrings); virtual; + Procedure DoGenerateImplementation(Strings: TStrings); virtual; + // Override this to return an instance of the proper class. + Function CreateOptions : TCodeGeneratorOptions; virtual; + // Override to return minimal uses clause for interface section. + Function GetInterfaceUsesClause : String; virtual; + // Override to return minimal uses clause for implementation section. + Function GetImplementationUsesClause : String; virtual; + // Must override to return real fielddefs + function GetFieldDefs: TFieldPropDefs; virtual; + // Must override to return real fielddefs + procedure SetFieldDefs(const AValue: TFieldPropDefs); virtual; + // Must override to return real SQL + function GetSQL: TStrings; virtual; + // Must override to set real SQL + procedure SetSQL(const AValue: TStrings); virtual; + Public + Constructor Create(AOWner : TComponent); override; + Destructor Destroy; override; + Procedure GenerateCode(Stream : TStream); + Procedure GenerateCode(Strings: TStrings); + Class Function NeedsSQL : Boolean; virtual; + Class Function NeedsFieldDefs : Boolean; virtual; + Function ShowConfigDialog : Boolean; + Property Fields : TFieldPropDefs Read GetFieldDefs Write SetFieldDefs; + Property SQL : TStrings Read GetSQL Write SetSQL; + Published + Property CodeOptions : TCodeGeneratorOptions Read FCodeOptions Write FCodeOptions; + Property Indent : Integer Read FIndent Write FIndent Default 2; + end; + + { TClassCodeGeneratorOptions } + + TClassCodeGeneratorOptions = Class(TCodeGeneratorOptions) + private + FAncestorClass: String; + FClassName: String; + procedure SetAncestorClass(const AValue: String); + Protected + procedure SetClassName(const AValue: String); virtual; + // Set to default value. Publish if needed. + Property AncestorClass : String Read FAncestorClass Write SetAncestorClass; + Public + Procedure Assign(ASource : TPersistent); override; + Published + Property ObjectClassName : String Read FClassName Write SetClassName; + end; + + { TDDClassCodeGenerator } + + TDDClassCodeGenerator = Class(TDDCustomCodeGenerator) + private + FAncestorClass : String; + FClassName: String; + FFieldDefs: TFieldPropDefs; + FOptions: TCodeOptions; + FStreamClass: String; + FStringsClass: String; + FUnitName: String; + function GetOpts: TClassCodeGeneratorOptions; + procedure SetAncestorClass(const AValue: String); + procedure SetClassName(const AValue: String); + procedure SetUnitname(const AValue: String); + procedure WritePropertyGetterImpl(Strings: TStrings; F: TFieldPropDef); + procedure WritePropertySetterImpl(Strings: TStrings; F: TFieldPropDef); + Protected + // Overrides from base class + Function GetFieldDefs: TFieldPropDefs; override; + procedure SetFieldDefs(const AValue: TFieldPropDefs); override; + Function CreateOptions : TCodeGeneratorOptions; override; + Procedure DoGenerateInterface(Strings: TStrings); override; + Procedure DoGenerateImplementation(Strings: TStrings); override; + // General code things. + // Override to create TFieldpropdefs descendent instance. + Function CreateFieldPropDefs : TFieldPropDefs; virtual; + // Set to default value. Publish if needed. + // + // Interface routines + // + // Create class declaration. + procedure CreateDeclaration(Strings: TStrings); virtual; + // Create class head. Override to add after class start. + procedure CreateClassHead(Strings: TStrings); virtual; + // Create class end. Override to add before class end. + procedure CreateClassEnd(Strings : TStrings); virtual; + // Called right after section start is written. + procedure WriteVisibilityStart(V: TVisibility; Strings: TStrings); virtual; + // Writes a property declaration. + Function PropertyDeclaration(Strings: TStrings; Def: TFieldPropDef) : String; virtual; + // Writes private fields for class. + procedure WritePrivateFields(Strings: TStrings); virtual; + // + // Implementation routines + // + // Create class implementation + procedure CreateImplementation(Strings: TStrings); virtual; + // Write implementation of constructor + procedure WriteConstructorImplementation(Strings: TStrings); Virtual; + // Write implementation of Destructor + procedure WriteDestructorImplementation(Strings: TStrings); Virtual; + // Write initialization of property (in constructor) + procedure WriteFieldCreate(Strings: TStrings; F: TFieldPropDef); Virtual; + // Write Finalization of property (in destructor) + procedure WriteFieldDestroy(Strings: TStrings; F: TFieldPropDef); Virtual; + // + // Routines used in both Implementation/Interface + // + // Write property getter declaration + Function PropertyGetterDeclaration(Def: TFieldPropDef; Impl : Boolean) : String; virtual; + // Write property setter declaration + Function PropertySetterDeclaration(Def: TFieldPropDef; Impl : Boolean) : String; virtual; + // Determines whether a constructor/destructor pair is written. + // By default one is written if ptStream/ptStrings is detected. + Function NeedsConstructor : Boolean; virtual; + // By default, this calls NeedsConstructor. + Function NeedsDestructor : Boolean; virtual; + // Override this to return the constructor declaration. + Function ConstructorDeclaration(Impl : Boolean) : String; Virtual; + // Override this to return the destructor declaration + Function DestructorDeclaration(Impl : Boolean) : String; Virtual; + // + // Properties + // + // Class name used to instantiate TStrings instances. + Property StringsClass : String Read FStringsClass Write FStringsClass; + // Class name used to instantiate TStream instances. + Property StreamClass : String Read FStreamClass Write FStreamClass; + // Easy access to options + Property ClassOptions : TClassCodeGeneratorOptions Read GetOpts; + Public + Constructor Create(AOwner : TComponent); override; + Destructor Destroy; override; + Procedure GenerateClass(Strings : TStrings); virtual; + Procedure GenerateClass(Stream : TStream); + Published + Property Fields; + end; + + ECodeGenerator = Class(Exception); + + { TExportFormatItem } + + TDDCustomCodeGeneratorClass = Class of TDDCustomCodeGenerator; + TCodeGeneratorConfigureEvent = Function (Generator : TDDCustomCodeGenerator) : Boolean of object; + + { TCodeGeneratorItem } + + TCodeGeneratorItem = Class(TCollectionItem) + private + FClass: TDDCustomCodeGeneratorClass; + FDescription: String; + FName: String; + FOnConfigure: TCodeGeneratorConfigureEvent; + Procedure SetName(const AValue: String); + Public + Property GeneratorClass : TDDCustomCodeGeneratorClass Read FClass Write FClass; + Published + Property Name : String Read FName Write SetName; + Property Description : String Read FDescription Write FDescription; + Property OnConfigureDialog : TCodeGeneratorConfigureEvent Read FOnConfigure Write FOnConfigure; + end; + + { TCodeGenerators } + + TCodeGenerators = Class(TCollection) + private + function GetGen(Index : Integer): TCodeGeneratorItem; + procedure SetGen(Index : Integer; const AValue: TCodeGeneratorItem); + Public + // Registration/Unregistration + Function RegisterCodeGenerator(Const AName, ADescription : String; AClass : TDDCustomCodeGeneratorClass) : TCodeGeneratorItem; + Procedure UnRegisterCodeGenerator(AClass : TDDCustomCodeGeneratorClass); + Procedure UnRegisterCodeGenerator(Const AName : String); + // Searching + Function IndexOfCodeGenerator(Const AName : String): Integer; + Function IndexOfCodeGenerator(AClass : TDDCustomCodeGeneratorClass): Integer; + Function FindCodeGenerator(Const AName : String) : TCodeGeneratorItem; + Function FindCodeGenerator(AClass : TDDCustomCodeGeneratorClass) : TCodeGeneratorItem; + // Shows configuration dialog, if one was configured for this class + Function ConfigureCodeGenerator(AGenerator : TDDCustomCodeGenerator) : Boolean; + Function GeneratorByName(Const AName : String) : TCodeGeneratorItem; + Property Generators[Index : Integer] : TCodeGeneratorItem Read GetGen Write SetGen; default; + end; + +Function CodeGenerators : TCodeGenerators; + +// Easy access functions + +Function RegisterCodeGenerator(Const AName,ADescription : String; AClass : TDDCustomCodeGeneratorClass) : TCodeGeneratorItem; +Procedure UnRegisterCodeGenerator(AClass : TDDCustomCodeGeneratorClass); +Procedure UnRegisterCodeGenerator(Const AName : String); + +Type + TFieldPropTypeMap = Array[TFieldType] of TPropType; + TPropertyVisibilityMap = Array[TPropType] of TVisibility; + +Var + + FieldToPropTypeMap : TFieldPropTypeMap = ( + ptCustom, ptAnsiString, ptSmallInt, ptLongInt, ptWord, + ptBoolean, ptDouble, ptCurrency, ptCurrency, ptDateTime, ptDateTime, ptDateTime, + ptCustom, ptCustom, ptLongInt, ptStream, ptTStrings, ptStream, ptTStrings, + ptCustom, ptCustom, ptCustom, ptCustom, ptAnsiString, + ptWideString, ptInt64, ptCustom, ptCustom, ptCustom, + ptCustom, ptCustom, ptCustom, ptCustom, ptCustom, + ptCustom, ptAnsiString, ptDateTime, ptCurrency, ptWideString, ptWideString); + + PropTypeToVisibilityMap : TPropertyVisibilityMap = ( + vPrivate, + vPublished, + vPublished, vPublished, + vPublished, vPublished, + vPublished, vPublished, + vPublished, vPublished, + vPublished, vPublished, vPublished, + vPublished, vPublished, vPublished, vPublished, vPublished, + vPublished, + vPublished, vPublished, vPublic, vPublished, + vPrivate); + +Const + ptInteger = ptLongint; + ptString = ptAnsiString; +Const + PropTypeNames : Array[TPropType] of string + = ('', + 'Boolean', + 'ShortInt', 'Byte', + 'SmallInt', 'Word', + 'Longint', 'Cardinal', + 'Int64', 'QWord', + 'String', 'AnsiString', 'WideString', + 'Single', 'Double' , 'Extended', 'Comp', 'Currency', + 'TDateTime', + '','', 'TStream', 'TStrings', + ''); + +Resourcestring + SErrInvalidIdentifier = '"%s" is not a valid object pascal identifier.'; + SErrGeneratorExists = 'A code generator with name "%s" already exists'; + SUnknownGenerator = 'Unknown code generator name : "%s"'; + +Function MakeIdentifier (S : String) : String; +Function CreateString(S : String) : String; +Procedure CheckIdentifier(AValue : String; AllowEmpty : Boolean = True); + +implementation + +Function CreateString(S : String) : String; + +begin + Result:=StringReplace(S,'''','''''',[rfReplaceAll]); + Result:=''''+Result+''''; +end; + +Procedure CheckIdentifier(AValue : String; AllowEmpty : Boolean = True); + +begin + If ((AValue='') and Not AllowEmpty) or Not IsValidIdent(AValue) then + Raise ECodeGenerator.CreateFmt(SErrInvalidIdentifier,[AValue]); +end; + +Var + CodeGens : TCodeGenerators; + +function CodeGenerators: TCodeGenerators; +begin + If (CodeGens=Nil) then + CodeGens:=TCodeGenerators.Create(TCodeGeneratorItem); + Result:=CodeGens; +end; + +Procedure DoneCodeGenerators; + +begin + FreeAndNil(CodeGens); +end; + +function RegisterCodeGenerator(const AName, ADescription: String; + AClass: TDDCustomCodeGeneratorClass): TCodeGeneratorItem; +begin + CodeGenerators.RegisterCodeGenerator(AName,ADescription,AClass); +end; + +procedure UnRegisterCodeGenerator(AClass: TDDCustomCodeGeneratorClass); +begin + CodeGenerators.UnRegisterCodeGenerator(AClass); +end; + +procedure UnRegisterCodeGenerator(const AName: String); +begin + CodeGenerators.UnRegisterCodeGenerator(AName); +end; + +Function MakeIdentifier (S : String) : String; + +Var + I : Integer; + +begin + Result:=S; + For I:=Length(Result) downto 0 do + If Not ((Upcase(Result[i]) in ['_','A'..'Z']) + or ((I>0) and (Result[i] in (['0'..'9'])))) then + Delete(Result,i,1); +end; + +{ TFieldPropDef } + +function TFieldPropDef.GetPropName: String; +begin + Result:=FPropName; + If (Result='') then + Result:=MakeIdentifier(FFieldName); +end; + +function TFieldPropDef.GetPropType: TPropType; +begin + Result:=FPropType; + If (Result=ptAuto) then + Result:=FieldToPropTypeMap[FieldType]; +end; + +function TFieldPropDef.GetPropTypeStored: boolean; +begin + Result:=(FPropType<>ptAuto) +end; + + +procedure TFieldPropDef.SetPropName(const AValue: String); + +begin + If (AValue<>FPropName) then + begin + CheckIdentifier(AValue); + FPropName:=AValue; + end; +end; + +procedure TFieldPropDef.InitFromField(F: TField); +begin + FieldType:=F.DataType; + PropertySize:=F.Size; +end; + +procedure TFieldPropDef.InitFromDDFieldDef(F: TDDFieldDef); +begin + FieldType:=F.FieldType; + PropertySize:=F.Size; +end; + +constructor TFieldPropDef.Create(ACollection: TCollection); +begin + inherited Create(ACollection); + FPropVis:=vPublished +end; + +procedure TFieldPropDef.Assign(ASource: TPersistent); + +Var + PD : TFieldPropDef; + +begin + if (ASource is TFieldPropDef) then + begin + PD:=ASource as TFieldPropDef; + FEnabled:=PD.Enabled; + FFieldName:=PD.FFieldName; + FFieldType:=PD.FFIeldType; + FPropAccess:=PD.FPropAccess; + FPropDef:=PD.FPropDef; + FPropType:=PD.FPropType; + FPRopSize:=PD.FPropSize; + FPropName:=PD.FPropName; + FPropVis:=PD.FPropVis; + end + else + inherited Assign(ASource); +end; + +function TFieldPropDef.FieldPropDefs: TFieldPropDefs; +begin + Result:=Collection as TFieldPropDefs; +end; + +function TFieldPropDef.HasGetter: Boolean; +begin + Result:=False; +end; + +function TFieldPropDef.HasSetter: Boolean; +begin + Result:=(PropertyAccess in [paReadWrite,paWriteOnly]) + and (PropertyType in [ptStream,ptTStrings]); +end; + +function TFieldPropDef.ObjPasTypeDef: String; +begin + If PropertyType in [ptCustom,ptSet,ptEnumerated] then + Result:=PropertyDef + else + begin + Result:=PropTypeNames[PropertyType]; + If PropertyType=ptShortString then + Result:=Result+Format('String[%d]',[PropertySize]); + end; +end; + +function TFieldPropDef.ObjPasReadDef: String; +begin + If HasGetter then + Result:='Get'+PropertyName + else + Result:='F'+PropertyName; +end; + +function TFieldPropDef.ObjPasWriteDef: String; +begin + If HasSetter then + Result:='Set'+PropertyName + else + Result:='F'+PropertyName; +end; + +{ TFieldPropDefs } + +function TFieldPropDefs.GetPropDef(Index : integer): TFieldPropDef; +begin + Result:=TFieldPropDef(Items[index]); +end; + +procedure TFieldPropDefs.SetPropDef(Index : integer; const AValue: TFieldPropDef); +begin + Items[Index]:=AValue; +end; + +function TFieldPropDefs.AddDef(AName: String): TFieldPropDef; +begin + Result:=Add As TFieldPropDef; + Result.FieldName:=AName; +end; + +procedure TFieldPropDefs.FromDataset(Dataset: TDataset; DoClear: Boolean = True); + +Var + I : Integer; + D : TFieldPropDef; + F : TField; + +begin + If DoClear then + Clear; + For I:=0 to Dataset.Fields.Count-1 do + begin + F:=Dataset.Fields[I]; + D:=AddDef(F.FieldName); + D.Enabled:=True; + D.InitFromField(F); + end; +end; + +procedure TFieldPropDefs.FromDDFieldDefs(Defs: TDDFieldDefs; DoClear: Boolean = True); + +Var + I : Integer; + D : TFieldPropDef; + F : TDDFieldDef; + +begin + If DoClear then + Clear; + For I:=0 to Defs.Count-1 do + begin + F:=Defs[I]; + D:=AddDef(F.FieldName); + D.Enabled:=True; + D.InitFromDDFieldDef(F); + end; +end; + +function TFieldPropDefs.IndexOfPropName(AName: String): Integer; +begin + Result:=Count-1; + While (Result>=0) and (CompareText(GetPropDef(Result).PropertyName,AName)<>0) do + Dec(Result); +end; + +function TFieldPropDefs.IndexOfFieldName(AName: String): Integer; +begin + Result:=Count-1; + While (Result>=0) and (CompareText(GetPropDef(Result).FieldName,AName)<>0) do + Dec(Result); +end; + +function TFieldPropDefs.FindPropName(AName: String): TFieldPropDef; + +Var + I : Integer; + +begin + I:=IndexOfPropName(AName); + If (I<>-1) then + Result:=GetpropDef(I) + else + Result:=Nil; +end; + +function TFieldPropDefs.FindFieldName(AName: String): TFieldPropDef; + +Var + I : Integer; + +begin + I:=IndexOfFieldName(AName); + If (I<>-1) then + Result:=GetpropDef(I) + else + Result:=Nil; +end; + +{ TDDClassCodeGenerator } + +procedure TDDClassCodeGenerator.SetClassName(const AValue: String); +begin +end; + +procedure TDDClassCodeGenerator.SetAncestorClass(const AValue: String); +begin + FAncestorClass:=AValue; +end; + +function TDDClassCodeGenerator.GetOpts: TClassCodeGeneratorOptions; +begin + Result:=CodeOptions as TClassCodeGeneratorOptions; +end; + +procedure TDDClassCodeGenerator.SetFieldDefs(const AValue: TFieldPropDefs); +begin + if FFieldDefs=AValue then exit; + FFieldDefs:=AValue; +end; + + +procedure TDDClassCodeGenerator.SetUnitname(const AValue: String); +begin + FUnitName:=AValue; +end; + +function TDDClassCodeGenerator.CreateFieldPropDefs: TFieldPropDefs; +begin + Result:=TFieldPropDefs.Create(TFieldPropDef); +end; + +constructor TDDClassCodeGenerator.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FFieldDefs:=CreateFieldPropDefs; +end; + +destructor TDDClassCodeGenerator.Destroy; +begin + FreeAndNil(FFieldDefs); + inherited Destroy; +end; + + +procedure TDDClassCodeGenerator.GenerateClass(Strings: TStrings); + +begin + IncIndent; + Try + AddLn(Strings,'// Declaration'); + AddLn(Strings,'Type'); + AddLn(Strings); + CreateDeclaration(Strings); + AddLn(Strings); + AddLn(Strings,'// Implementation'); + AddLn(Strings); + CreateDeclaration(Strings); + Finally + DecIndent; + end; +end; + +Procedure TDDClassCodeGenerator.CreateDeclaration(Strings : TStrings); + +Const + VisibilityNames : Array [TVisibility] of string + = ('Private','Protected','Public','Published'); + +Var + V : TVisibility; + I : Integer; + F : TFieldPropDef; + +begin + CreateClassHead(Strings); + AddLn(Strings,VisibilityNames[vPrivate]); + WritePrivateFields(Strings); + For v:=Low(TVisibility) to High(TVisibility) do + begin + AddLn(Strings,VisibilityNames[v]); + IncIndent; + Try + WriteVisibilityStart(V,Strings); + For I:=0 to Fields.Count-1 do + begin + F:=Fields[i]; + if F.Enabled and (F.PropertyVisibility=v) then + AddLn(Strings,PropertyDeclaration(Strings,F)+';'); + end; + Finally + Decindent; + end; + end; + CreateClassEnd(Strings); +end; + +Procedure TDDClassCodeGenerator.WritePrivateFields(Strings : TStrings); + +Var + I : Integer; + F : TFieldPropDef; + +begin + IncIndent; + Try + For I:=0 to Fields.Count-1 do + begin + F:=Fields[i]; + if F.Enabled then + AddLn(Strings,'F%s : %s;',[F.PropertyName,F.ObjPasTypeDef]); + end; + Finally + DecIndent; + end; +end; + +Procedure TDDClassCodeGenerator.CreateImplementation(Strings : TStrings); + +Var + B : Boolean; + I : Integer; + F : TFieldPropDef; + +begin + AddLn(Strings,' { %s } ',[ClassOptions.ObjectClassName]); + AddLn(Strings); + If NeedsConstructor then + begin + Addln(Strings,' { Constructor and destructor }'); + Addln(Strings); + WriteConstructorImplementation(Strings); + WriteDestructorImplementation(Strings); + end; + B:=False; + For I:=0 to Fields.Count-1 do + begin + F:=Fields[i]; + if F.Enabled and F.HasGetter then + begin + If not B then + begin + B:=True; + Addln(Strings,' { Property Getters }'); + Addln(Strings); + end; + WritePropertyGetterImpl(Strings,F); + end; + end; + B:=False; + For I:=0 to Fields.Count-1 do + begin + F:=Fields[i]; + if F.Enabled and F.HasGetter then + begin + If not B then + begin + B:=True; + Addln(Strings,' { Property Setters }'); + Addln(Strings); + end; + WritePropertySetterImpl(Strings,F); + end; + end; +end; + +Procedure TDDClassCodeGenerator.WritePropertyGetterImpl(Strings : TStrings; F : TFieldPropDef); + +Var + S : String; + +begin + S:=PropertyGetterDeclaration(F,True); + BeginMethod(Strings,S); + AddLn(Strings,'begin'); + IncIndent; + Try + AddLn(Strings,Format('Result:=F%s',[F.PropertyName])); + Finally + DecIndent; + end; + EndMethod(Strings,S); +end; + +Procedure TDDClassCodeGenerator.WritePropertySetterImpl(Strings : TStrings; F : TFieldPropDef); + +Var + S : String; + +begin + S:=PropertyGetterDeclaration(F,True); + BeginMethod(Strings,S); + AddLn(Strings,'begin'); + IncIndent; + Try + Case F.PropertyType of + ptTStrings : + S:=Format('F%s.Assign(AValue);',[F.PropertyName]); + ptStream : + S:=Format('F%s.CopyFrom(AValue,0);',[F.PropertyName]); + else + S:=Format('F%s:=AValue',[F.PropertyName]); + end; + AddLn(Strings,S); + Finally + DecIndent; + end; + EndMethod(Strings,S); +end; + +function TDDClassCodeGenerator.GetFieldDefs: TFieldPropDefs; +begin + Result:=FFieldDefs; +end; + +function TDDClassCodeGenerator.CreateOptions: TCodeGeneratorOptions; +begin + Result:=TClassCodeGeneratorOptions.Create; +end; + +procedure TDDClassCodeGenerator.DoGenerateInterface(Strings: TStrings); +begin + AddLn(Strings,'Type'); + AddLn(Strings); + IncIndent; + Try + CreateDeclaration(Strings); + Finally + DecIndent; + end; +end; + +procedure TDDClassCodeGenerator.DoGenerateImplementation(Strings: TStrings); +begin + CreateImplementation(Strings); +end; + + +Procedure TDDClassCodeGenerator.WriteConstructorImplementation(Strings : TStrings); + +Var + I : Integer; + F : TFieldPropDef; + S : String; + +begin + S:=ConstructorDeclaration(True); + BeginMethod(Strings,S); + AddLn(Strings,'begin'); + IncIndent; + Try + For I:=0 to Fields.Count-1 do + begin + F:=Fields[i]; + if F.Enabled then + WriteFieldCreate(Strings,F); + end; + Finally + DecIndent; + end; + EndMethod(Strings,S); +end; + +Procedure TDDClassCodeGenerator.WriteDestructorImplementation(Strings : TStrings); + +Var + I : Integer; + F : TFieldPropDef; + S : String; + +begin + S:=DestructorDeclaration(True); + BeginMethod(Strings,S); + AddLn(Strings,'begin'); + IncIndent; + Try + For I:=0 to Fields.Count-1 do + begin + F:=Fields[i]; + if F.Enabled then + WriteFieldDestroy(Strings,F); + end; + AddLn(Strings,'Inherited;'); + Finally + DecIndent; + end; + EndMethod(Strings,S); +end; + + + +Procedure TDDClassCodeGenerator.WriteFieldCreate(Strings : TStrings;F : TFieldPropDef); + +Var + S : String; + +begin + Case F.PropertyType of + ptTStrings : + begin + S:=Format('F%s:=%s.Create;',[F.PropertyName,StringsClass]); + AddLn(Strings,S); + end; + ptStream : + begin + S:=Format('F%s:=%s.Create;',[F.PropertyName,StreamClass]); + AddLn(Strings,S); + end; + ptCustom : + begin + AddLn(Strings,'// Add Creation for '+F.PropertyName); + end; + end; +end; + +Procedure TDDClassCodeGenerator.WriteFieldDestroy(Strings : TStrings;F : TFieldPropDef); + +Var + S : String; + +begin + Case F.PropertyType of + ptTStrings, + ptStream : + begin + S:=Format('FreeAndNil(F%s);',[F.PropertyName]); + AddLn(Strings,S); + end; + ptCustom : + begin + AddLn(Strings,'// Add destroy for '+F.PropertyName); + end; + end; +end; + + +Procedure TDDClassCodeGenerator.CreateClassHead(Strings : TStrings); + +begin + Addln(Strings,'{ %s }',[ClassOptions.ObjectClassName]); + AddLn(Strings); + AddLn(Strings,'%s = Class(%s)',[ClassOptions.ObjectClassName,ClassOptions.AncestorClass]); +end; + +Procedure TDDClassCodeGenerator.CreateClassEnd(Strings : TStrings); + +begin + AddLn(Strings,'end;'); + AddLn(Strings); +end; + + +Procedure TDDClassCodeGenerator.WriteVisibilityStart(V : TVisibility; Strings : TStrings); + +Var + I : Integer; + F : TFieldPropDef; + +begin + If (v=vPrivate) then + begin + For I:=0 to Fields.Count-1 do + begin + F:=Fields[i]; + If F.Enabled then + begin + if (F.Hasgetter) then + AddLn(Strings,PropertyGetterDeclaration(F,False)); + if (Fields[i].HasSetter) then + AddLn(Strings,PropertySetterDeclaration(F,False)); + end; + end; + end + else if v=vPublic then + begin + If NeedsConstructor then + begin + AddLn(Strings,ConstructorDeclaration(False)); + Addln(Strings,DestructorDeclaration(False)); + end; + end + // Do nothing +end; + + +Function TDDClassCodeGenerator.PropertyDeclaration(Strings : TStrings; Def : TFieldPropDef) : String; + +begin + Result:='Property '+Def.PropertyName+' '; + Result:=Result+': '+Def.ObjPasTypeDef; + If Def.PropertyAccess in [paReadWrite,paReadOnly] then + Result:=Result+' Read '+Def.ObjPasReadDef; + If Def.PropertyAccess in [paReadWrite,paWriteOnly] then + Result:=Result+' Write '+Def.ObjPasWriteDef; +end; + +Function TDDClassCodeGenerator.PropertyGetterDeclaration(Def : TFieldPropDef; Impl : Boolean) : String; + + +begin + Result:='Function '; + If Impl then + Result:=Result+Classoptions.ObjectClassName+'.'; + If Impl then + Result:=Result+Def.ObjPasReadDef+' : '+Def.ObjPasTypeDef+';'; +end; + +Function TDDClassCodeGenerator.PropertySetterDeclaration(Def : TFieldPropDef; Impl : Boolean) : String; + + +begin + Result:='Procedure '; + If Impl then + Result:=Result+ClassOptions.ObjectClassName+'.'; + Result:=Result+Def.ObjPasReadDef+' (AValue : '+Def.ObjPasTypeDef+');'; +end; + +function TDDClassCodeGenerator.NeedsConstructor: Boolean; + +Var + I : Integer; + F : TFieldPropDef; + +begin + Result:=False; + I:=Fields.Count-1; + While (Not Result) and (I>=0) do + begin + F:=Fields[i]; + Result:=F.Enabled and (F.PropertyType in [ptStream,ptTStrings]); + Dec(I); + end; +end; + +function TDDClassCodeGenerator.NeedsDestructor: Boolean; +begin + Result:=NeedsConstructor; +end; + +Function TDDClassCodeGenerator.ConstructorDeclaration(Impl : Boolean) : String; +begin + Result:='Constructor '; + If Impl then + Result:=Result+ClassOptions.ObjectClassName+'.'; + Result:=Result+'Create;'; +end; + +Function TDDClassCodeGenerator.DestructorDeclaration(Impl : Boolean) : String; +begin + Result:='Destructor '; + If Impl then + Result:=Result+ClassOptions.ObjectClassName+'.'; + Result:=Result+'Destroy; Override;'; +end; + +procedure TDDClassCodeGenerator.GenerateClass(Stream: TStream); + +Var + L : TStringList; + +begin + L:=TStringList.Create; + try + GenerateClass(L); + L.SaveToStream(Stream); + finally + L.Free; + end; +end; + +{ TDDCustomCodeGenerator } + +procedure TDDCustomCodeGenerator.IncIndent; + +begin + FCurrentIndent:=FCurrentIndent+StringOfChar(' ',FIndent); +end; + +procedure TDDCustomCodeGenerator.DecIndent; + +begin + Delete(FCurrentIndent,1,FIndent); +end; + +procedure TDDCustomCodeGenerator.DoGenerateInterface(Strings: TStrings); +begin +end; + +procedure TDDCustomCodeGenerator.DoGenerateImplementation(Strings: TStrings); +begin + +end; + +function TDDCustomCodeGenerator.GetFieldDefs: TFieldPropDefs; +begin + +end; + +procedure TDDCustomCodeGenerator.SetFieldDefs(const AValue: TFieldPropDefs); +begin + +end; + +function TDDCustomCodeGenerator.GetSQL: TStrings; +begin + Result:=Nil; +end; + +procedure TDDCustomCodeGenerator.SetSQL(const AValue: TStrings); +begin + // Do nothing +end; + +constructor TDDCustomCodeGenerator.Create(AOWner: TComponent); +begin + inherited Create(AOWner); + FCodeOptions:=CreateOptions; + FIndent:=2; +end; + +destructor TDDCustomCodeGenerator.Destroy; +begin + FreeAndNil(FCodeOptions); + inherited Destroy; +end; + +procedure TDDCustomCodeGenerator.AddLn(Strings : TStrings); + +begin + Strings.Add(''); +end; + +procedure TDDCustomCodeGenerator.AddLn(Strings : TStrings; Line : String); + +begin + Strings.Add(FCurrentIndent+Line); +end; + +procedure TDDCustomCodeGenerator.AddLn(Strings : TStrings; Fmt : String; Args : Array Of Const); + +begin + Strings.Add(FCurrentIndent+Format(Fmt,Args)); +end; + + +function TDDCustomCodeGenerator.CreateOptions: TCodeGeneratorOptions; +begin + Result:=TCodeGeneratorOptions.Create; +end; + +function TDDCustomCodeGenerator.GetInterfaceUsesClause: String; +begin + Result:='Classes, SysUtils'; +end; + +function TDDCustomCodeGenerator.GetImplementationUsesClause: String; +begin + Result:=''; +end; + +procedure TDDCustomCodeGenerator.GenerateCode(Stream: TStream); + +Var + L : TStringList; + +begin + L:=TStringList.Create; + try + GenerateCode(L); + L.SaveToStream(Stream); + finally + L.Free; + end; +end; + +procedure TDDCustomCodeGenerator.GenerateCode(Strings: TStrings); + + Procedure MaybeAddUsesClause(S : String); + + begin + If (S<>'') then + begin + If S[Length(S)]<>';' then + S:=S+';'; + AddLn(Strings,'Uses '+S); + AddLn(Strings); + end; + end; + +Var + S : String; + +begin + FCurrentIndent:=''; + if (coUnit in CodeOptions.Options) then + begin + Addln(Strings,'Unit '+CodeOptions.UnitName+';'); + Addln(Strings); + Addln(Strings,'Interface'); + Addln(Strings); + S:=GetInterfaceUsesClause; + MaybeAddUsesClause(S); + end; + if coInterface in CodeOptions.Options then + begin + DoGenerateInterface(Strings); + Addln(Strings); + end; + FCurrentIndent:=''; + if coUnit in CodeOptions.options then + begin + if coImplementation in CodeOptions.Options then + begin + Addln(Strings,'Implementation'); + S:=GetImplementationUsesClause; + MaybeAddUsesClause(S); + end; + end; + if coImplementation in CodeOptions.Options then + begin + Addln(Strings); + DoGenerateImplementation(Strings); + end; + Addln(Strings); + if (coUnit in CodeOptions.options) then + Addln(Strings,'end.'); +end; + +class function TDDCustomCodeGenerator.NeedsSQL: Boolean; +begin + Result:=False; +end; + +class function TDDCustomCodeGenerator.NeedsFieldDefs: Boolean; +begin + Result:=False; +end; + +function TDDCustomCodeGenerator.ShowConfigDialog: Boolean; +begin + +end; + +Procedure TDDCustomCodeGenerator.BeginMethod(STrings : TStrings; Const Decl : String); + +begin + AddLn(Strings,Decl); + AddLn(Strings); +end; + +Procedure TDDCustomCodeGenerator.EndMethod(STrings : TStrings; Const Decl : String); + +begin + AddLn(Strings,'end;'); + Addln(Strings); + Addln(Strings); +end; + + +{ TCodeGeneratorItem } + +procedure TCodeGeneratorItem.SetName(const AValue: String); + +Var + G : TCodeGeneratorItem; + +begin + if (FName=AValue) then + exit; + If (AValue<>'') then + begin + G:=TCodeGenerators(Collection).FindCodeGenerator(AValue); + If (G<>Nil) and (G<>Self) then + Raise ECodeGenerator.CreateFmt(SErrGeneratorExists,[AValue]); + end; + FName:=AValue; + +end; + +{ TCodeGenerators } + +function TCodeGenerators.GetGen(Index: Integer): TCodeGeneratorItem; +begin + Result:=TCodeGeneratorItem(Items[Index]); +end; + +procedure TCodeGenerators.SetGen(Index: Integer; + const AValue: TCodeGeneratorItem); +begin + Items[Index]:=AValue; +end; + +function TCodeGenerators.RegisterCodeGenerator(const AName, ADescription : String; + AClass: TDDCustomCodeGeneratorClass): TCodeGeneratorItem; +begin + If (IndexOfCodeGenerator(AName)<>-1) then + Raise ECodeGenerator.CreateFmt(SErrGeneratorExists,[AName]); + Result:=Add as TCodeGeneratorItem; + Result.Name:=AName; + Result.Description:=ADescription; + Result.GeneratorClass:=AClass; +end; + +procedure TCodeGenerators.UnRegisterCodeGenerator(AClass: TDDCustomCodeGeneratorClass); +begin + FindCodeGenerator(AClass).Free; +end; + +procedure TCodeGenerators.UnRegisterCodeGenerator(const AName: String); +begin + FindCodeGenerator(AName).Free; +end; + +function TCodeGenerators.IndexOfCodeGenerator(const AName: String): Integer; +begin + Result:=Count-1; + While (Result>=0) and (CompareText(GetGen(Result).Name,AName)<>0) do + Dec(Result); +end; + +function TCodeGenerators.IndexOfCodeGenerator(AClass: TDDCustomCodeGeneratorClass): Integer; +begin + Result:=Count-1; + While (Result>=0) and (GetGen(Result).GeneratorClass<>AClass) do + Dec(Result); +end; + +function TCodeGenerators.FindCodeGenerator(const AName: String): TCodeGeneratorItem; + +Var + I : Integer; + +begin + I:=IndexOfCodeGenerator(AName); + If (I=-1) then + Result:=Nil + else + Result:=GetGen(I); +end; + +function TCodeGenerators.FindCodeGenerator(AClass: TDDCustomCodeGeneratorClass): TCodeGeneratorItem; + +Var + I : Integer; + +begin + I:=IndexOfCodeGenerator(AClass); + If (I=-1) then + Result:=Nil + else + Result:=GetGen(I); +end; + +function TCodeGenerators.ConfigureCodeGenerator( + AGenerator: TDDCustomCodeGenerator): Boolean; + +Var + G : TCodeGeneratorItem; + +begin + Result:=True; + G:=FindCodeGenerator(TDDCustomCodeGeneratorClass(AGenerator.ClassType)); + If Assigned(G) and Assigned(G.OnConfigureDialog) then + Result:=G.OnConfigureDialog(AGenerator); +end; + +function TCodeGenerators.GeneratorByName(const AName: String): TCodeGeneratorItem; +begin + Result:=FindCodeGenerator(AName); + If (Result=Nil) then + Raise ECodegenerator.CreateFmt(SUnknownGenerator,[AName]); +end; + +{ TCodeGeneratorOptions } + +procedure TCodeGeneratorOptions.SetOPtions(const AValue: TCodeOptions); +begin + FOptions:=AValue; +end; + +constructor TCodeGeneratorOptions.create; +begin + FOptions:=[coInterface,coImplementation,coUnit]; + UnitName:='Unit1'; +end; + +procedure TCodeGeneratorOptions.Assign(ASource: TPersistent); + +Var + CG : TCodeGeneratorOptions; + +begin + If ASource is TCodeGeneratorOptions then + begin + CG:=ASource as TCodeGeneratorOptions; + FOptions:=CG.FOptions; + FUnitName:=CG.UnitName; + end + else + inherited Assign(ASource); +end; + +procedure TCodeGeneratorOptions.SetUnitname(const AValue: String); +begin + if FUnitName=AValue then exit; + CheckIdentifier(AValue,False); + FUnitName:=AValue; +end; + +{ TClassCodeGeneratorOptions } + +procedure TClassCodeGeneratorOptions.SetClassName(const AValue: String); +begin + if FClassName=AValue then + exit; + CheckIdentifier(AValue,False); + FClassName:=AValue; +end; + +procedure TClassCodeGeneratorOptions.Assign(ASource: TPersistent); + +Var + CO : TClassCodeGeneratorOptions; + +begin + If ASource is TClassCodeGeneratorOptions then + begin + CO:=ASource as TClassCodeGeneratorOptions; + FClassName:=CO.FClassName; + FAncestorClass:=CO.FAncestorClass; + end; + inherited Assign(ASource); +end; + +procedure TClassCodeGeneratorOptions.SetAncestorClass(const AValue: String); +begin + if (FAncestorClass=AValue) then + Exit; + CheckIdentifier(AValue,False); + FAncestorClass:=AValue; +end; + + + +Finalization + DoneCodeGenerators; +end. +