diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 3417622dfb..63477d9709 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,78 @@ +20000317-18:00 GMT+1 Victor Szakats + * source/vm/maindll.c + ! __BORLAND__ -> __BORLANDC__ + * source/rtl/environ.c + ! GETENV() - Fixed handling of the second parameter. + * include/hbapi.h + source/rtl/strings.c + * HB_ISSPACE() macro moved to the central header. + * utils/hbtest/hbtest.prg + * DTOS() -> DTOC() in header. + + source/vm/arrayshb.c + source/vm/arrays.c + source/vm/Makefile + makefile.bc + makefile.vc + + Separated the Harbour and C array API level. + + source/rtl/abs.c + + source/rtl/accept.c + + source/rtl/ampm.c + + source/rtl/at.c + + source/rtl/chrasc.c + + source/rtl/colorind.c + + source/rtl/datec.c + + source/rtl/dateshb.c + + source/rtl/defpath.c + + source/rtl/eval.c + + source/rtl/fkmax.c + + source/rtl/fnsplit.c + + source/rtl/getenv.c + + source/rtl/gx.c + + source/rtl/left.c + + source/rtl/lennum.c + + source/rtl/maxrow.c + + source/rtl/minmax.c + + source/rtl/mod.c + + source/rtl/pad.c + + source/rtl/replic.c + + source/rtl/right.c + + source/rtl/round.c + + source/rtl/run.c + + source/rtl/saverest.c + + source/rtl/seconds.c + + source/rtl/setcurs.c + + source/rtl/setpos.c + + source/rtl/shadow.c + + source/rtl/space.c + + source/rtl/str.c + + source/rtl/strcase.c + + source/rtl/stris.c + + source/rtl/strmatch.c + + source/rtl/strtran.c + + source/rtl/strzero.c + + source/rtl/stuff.c + + source/rtl/substr.c + + source/rtl/trim.c + + source/rtl/val.c + + source/rtl/valtostr.c + source/rtl/strings.c + source/rtl/console.c + source/rtl/dates.c + source/rtl/math.c + source/rtl/inkey.c + source/rtl/samples.c + source/rtl/do.c + source/rtl/environ.c + source/rtl/set.c + source/rtl/setcolor.c + source/rtl/filesys.c + source/rtl/Makefile + makefile.bc + makefile.vc + + Separated almost all RTL source files into smaller pieces. + There are 41 new files now. The original CA-Cl*pper source filenames + were used where possible. + 20000317-10:53 GMT+1 Victor Szakats * include/hbclass.ch ! To avoid warning _CLASS_NAME_ is #undef-ed before #define-ed. diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 83849af6d7..2d2a771812 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -343,6 +343,11 @@ extern PHB_ITEM hb_arrayClone( PHB_ITEM pArray ); /* string management */ +#define HB_ISSPACE( c ) ( ( c ) == ' ' || \ + ( c ) == HB_CHAR_HT || \ + ( c ) == HB_CHAR_LF || \ + ( c ) == HB_CHAR_CR ) + extern int hb_stricmp( const char * s1, const char * s2 ); extern int hb_strnicmp( const char * s1, const char * s2, ULONG ulLen ); extern char * hb_strupr( char * pszText ); diff --git a/harbour/makefile.bc b/harbour/makefile.bc index e22a31b7d9..2135396592 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -96,28 +96,47 @@ HBDOC_EXE = $(BIN_DIR)\hbdoc.exe # RTL_LIB_OBJS = \ + $(OBJ_DIR)\abs.obj \ + $(OBJ_DIR)\accept.obj \ + $(OBJ_DIR)\ampm.obj \ + $(OBJ_DIR)\at.obj \ $(OBJ_DIR)\binnum.obj \ + $(OBJ_DIR)\chrasc.obj \ + $(OBJ_DIR)\colorind.obj \ $(OBJ_DIR)\console.obj \ $(OBJ_DIR)\copyfile.obj \ + $(OBJ_DIR)\datec.obj \ $(OBJ_DIR)\dates.obj \ + $(OBJ_DIR)\dateshb.obj \ + $(OBJ_DIR)\defpath.obj \ $(OBJ_DIR)\descend.obj \ $(OBJ_DIR)\dir.obj \ $(OBJ_DIR)\do.obj \ $(OBJ_DIR)\empty.obj \ $(OBJ_DIR)\environ.obj \ $(OBJ_DIR)\errorapi.obj \ + $(OBJ_DIR)\eval.obj \ $(OBJ_DIR)\filesys.obj \ + $(OBJ_DIR)\fkmax.obj \ + $(OBJ_DIR)\fnsplit.obj \ + $(OBJ_DIR)\getenv.obj \ $(OBJ_DIR)\gtapi.obj \ + $(OBJ_DIR)\gx.obj \ $(OBJ_DIR)\hardcr.obj \ $(OBJ_DIR)\inkey.obj \ $(OBJ_DIR)\isprint.obj \ $(OBJ_DIR)\langapi.obj \ + $(OBJ_DIR)\left.obj \ $(OBJ_DIR)\len.obj \ + $(OBJ_DIR)\lennum.obj \ $(OBJ_DIR)\math.obj \ + $(OBJ_DIR)\maxrow.obj \ $(OBJ_DIR)\memofile.obj \ $(OBJ_DIR)\memoline.obj \ + $(OBJ_DIR)\minmax.obj \ $(OBJ_DIR)\mlcount.obj \ $(OBJ_DIR)\mlpos.obj \ + $(OBJ_DIR)\mod.obj \ $(OBJ_DIR)\mouseapi.obj \ $(OBJ_DIR)\mtran.obj \ $(OBJ_DIR)\natmsg.obj \ @@ -125,15 +144,37 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\oemansi.obj \ $(OBJ_DIR)\oldbox.obj \ $(OBJ_DIR)\oldclear.obj \ + $(OBJ_DIR)\pad.obj \ + $(OBJ_DIR)\replic.obj \ + $(OBJ_DIR)\right.obj \ + $(OBJ_DIR)\round.obj \ + $(OBJ_DIR)\run.obj \ $(OBJ_DIR)\samples.obj \ + $(OBJ_DIR)\saverest.obj \ + $(OBJ_DIR)\seconds.obj \ $(OBJ_DIR)\set.obj \ $(OBJ_DIR)\setcolor.obj \ + $(OBJ_DIR)\setcurs.obj \ + $(OBJ_DIR)\setpos.obj \ + $(OBJ_DIR)\shadow.obj \ $(OBJ_DIR)\soundex.obj \ + $(OBJ_DIR)\space.obj \ + $(OBJ_DIR)\str.obj \ + $(OBJ_DIR)\strcase.obj \ $(OBJ_DIR)\strings.obj \ + $(OBJ_DIR)\stris.obj \ + $(OBJ_DIR)\strmatch.obj \ + $(OBJ_DIR)\strtran.obj \ + $(OBJ_DIR)\strzero.obj \ + $(OBJ_DIR)\stuff.obj \ + $(OBJ_DIR)\substr.obj \ $(OBJ_DIR)\tone.obj \ $(OBJ_DIR)\trace.obj \ $(OBJ_DIR)\transfrm.obj \ + $(OBJ_DIR)\trim.obj \ $(OBJ_DIR)\type.obj \ + $(OBJ_DIR)\val.obj \ + $(OBJ_DIR)\valtostr.obj \ $(OBJ_DIR)\valtype.obj \ $(OBJ_DIR)\word.obj \ $(OBJ_DIR)\xhelp.obj \ @@ -302,6 +343,7 @@ COMMON_LIB_OBJS = \ VM_LIB_OBJS = \ $(OBJ_DIR)\arrays.obj \ + $(OBJ_DIR)\arrayshb.obj \ $(OBJ_DIR)\break.obj \ $(OBJ_DIR)\classes.obj \ $(OBJ_DIR)\cmdarg.obj \ @@ -608,6 +650,10 @@ $(OBJ_DIR)\arrays.obj : $(VM_DIR)\arrays.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(VM_LIB) -+$@,, +$(OBJ_DIR)\arrayshb.obj : $(VM_DIR)\arrayshb.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(VM_LIB) -+$@,, + $(OBJ_DIR)\break.obj : $(VM_DIR)\break.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(VM_LIB) -+$@,, @@ -699,6 +745,14 @@ $(OBJ_DIR)\symbols.obj : $(VM_DIR)\symbols.asm # RTL.LIB dependencies # +$(OBJ_DIR)\abs.obj : $(RTL_DIR)\abs.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\accept.obj : $(RTL_DIR)\accept.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\achoice.c : $(RTL_DIR)\achoice.prg $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ @@ -720,6 +774,10 @@ $(OBJ_DIR)\alert.obj : $(OBJ_DIR)\alert.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\ampm.obj : $(RTL_DIR)\ampm.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\asort.c : $(RTL_DIR)\asort.prg $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ @@ -727,6 +785,10 @@ $(OBJ_DIR)\asort.obj : $(OBJ_DIR)\asort.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\at.obj : $(RTL_DIR)\at.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\binnum.obj : $(RTL_DIR)\binnum.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, @@ -745,6 +807,14 @@ $(OBJ_DIR)\browse.obj : $(OBJ_DIR)\browse.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\chrasc.obj : $(RTL_DIR)\chrasc.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\colorind.obj : $(RTL_DIR)\colorind.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\console.obj : $(RTL_DIR)\console.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, @@ -753,10 +823,22 @@ $(OBJ_DIR)\copyfile.obj : $(RTL_DIR)\copyfile.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\datec.obj : $(RTL_DIR)\datec.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\datehb.obj : $(RTL_DIR)\datehb.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\dates.obj : $(RTL_DIR)\dates.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\dateshb.obj : $(RTL_DIR)\dateshb.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\dbedit.c : $(RTL_DIR)\dbedit.prg $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ @@ -764,6 +846,10 @@ $(OBJ_DIR)\dbedit.obj : $(OBJ_DIR)\dbedit.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\defpath.obj : $(RTL_DIR)\defpath.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\descend.obj : $(RTL_DIR)\descend.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, @@ -816,6 +902,10 @@ $(OBJ_DIR)\errorsys.obj : $(OBJ_DIR)\errorsys.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\eval.obj : $(RTL_DIR)\eval.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\fieldbl.c : $(RTL_DIR)\fieldbl.prg $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ @@ -827,6 +917,18 @@ $(OBJ_DIR)\filesys.obj : $(RTL_DIR)\filesys.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\fkmax.obj : $(RTL_DIR)\fkmax.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\fnsplit.obj : $(RTL_DIR)\fnsplit.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\getenv.obj : $(RTL_DIR)\getenv.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\gtapi.obj : $(RTL_DIR)\gtapi.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, @@ -835,6 +937,10 @@ $(OBJ_DIR)\gtxxx.obj : $(RTL_DIR)\gtxxx.c $(CC) $(CLIBFLAGS) -I$(RTL_DIR) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\gx.obj : $(RTL_DIR)\gx.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\hardcr.obj : $(RTL_DIR)\hardcr.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, @@ -858,14 +964,30 @@ $(OBJ_DIR)\langapi.obj : $(RTL_DIR)\langapi.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\left.obj : $(RTL_DIR)\left.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\len.obj : $(RTL_DIR)\len.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\lennum.obj : $(RTL_DIR)\lennum.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\math.obj : $(RTL_DIR)\math.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\maxrow.obj : $(RTL_DIR)\maxrow.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\minmax.obj : $(RTL_DIR)\minmax.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\memofile.obj : $(RTL_DIR)\memofile.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, @@ -896,6 +1018,10 @@ $(OBJ_DIR)\mlpos.obj : $(RTL_DIR)\mlpos.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\mod.obj : $(RTL_DIR)\mod.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\mouseapi.obj : $(RTL_DIR)\mouseapi.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, @@ -939,6 +1065,10 @@ $(OBJ_DIR)\oldclear.obj : $(RTL_DIR)\oldclear.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\pad.obj : $(RTL_DIR)\pad.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\readkey.c : $(RTL_DIR)\readkey.prg $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ @@ -946,10 +1076,34 @@ $(OBJ_DIR)\readkey.obj : $(OBJ_DIR)\readkey.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\replic.obj : $(RTL_DIR)\replic.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\right.obj : $(RTL_DIR)\right.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\round.obj : $(RTL_DIR)\round.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\run.obj : $(RTL_DIR)\run.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\samples.obj : $(RTL_DIR)\samples.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\saverest.obj : $(RTL_DIR)\saverest.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\seconds.obj : $(RTL_DIR)\seconds.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\set.obj : $(RTL_DIR)\set.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, @@ -958,6 +1112,10 @@ $(OBJ_DIR)\setcolor.obj : $(RTL_DIR)\setcolor.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\setcurs.obj : $(RTL_DIR)\setcurs.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\setfunc.c : $(RTL_DIR)\setfunc.prg $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ @@ -972,6 +1130,10 @@ $(OBJ_DIR)\setkey.obj : $(OBJ_DIR)\setkey.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\setpos.obj : $(RTL_DIR)\setpos.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\setta.c : $(RTL_DIR)\setta.prg $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ @@ -979,14 +1141,54 @@ $(OBJ_DIR)\setta.obj : $(OBJ_DIR)\setta.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\shadow.obj : $(RTL_DIR)\shadow.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\soundex.obj : $(RTL_DIR)\soundex.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\space.obj : $(RTL_DIR)\space.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\str.obj : $(RTL_DIR)\str.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\strcase.obj : $(RTL_DIR)\strcase.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\strings.obj : $(RTL_DIR)\strings.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\stris.obj : $(RTL_DIR)\stris.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\strmatch.obj : $(RTL_DIR)\strmatch.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\strtran.obj : $(RTL_DIR)\strtran.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\strzero.obj : $(RTL_DIR)\strzero.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\stuff.obj : $(RTL_DIR)\stuff.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\substr.obj : $(RTL_DIR)\substr.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\tbcolumn.c : $(RTL_DIR)\tbcolumn.prg $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ @@ -1062,6 +1264,10 @@ $(OBJ_DIR)\treport.obj : $(OBJ_DIR)\treport.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\trim.obj : $(RTL_DIR)\trim.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\type.obj : $(RTL_DIR)\type.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, @@ -1073,6 +1279,14 @@ $(OBJ_DIR)\typefile.obj : $(OBJ_DIR)\typefile.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\val.obj : $(RTL_DIR)\val.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\valtostr.obj : $(RTL_DIR)\valtostr.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\valtype.obj : $(RTL_DIR)\valtype.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, diff --git a/harbour/makefile.vc b/harbour/makefile.vc index 3290d7aa00..63200f6001 100644 --- a/harbour/makefile.vc +++ b/harbour/makefile.vc @@ -160,28 +160,47 @@ LIBS2 = \ $(MAKE) -nologo /$(MK_FLAGS) /f$(MK_FILE) $(RTL_LIB)2 RTL_LIB_OBJS = \ + $(OBJ_DIR)\abs.obj \ + $(OBJ_DIR)\accept.obj \ + $(OBJ_DIR)\ampm.obj \ + $(OBJ_DIR)\at.obj \ $(OBJ_DIR)\binnum.obj \ + $(OBJ_DIR)\chrasc.obj \ + $(OBJ_DIR)\colorind.obj \ $(OBJ_DIR)\console.obj \ $(OBJ_DIR)\copyfile.obj \ + $(OBJ_DIR)\datec.obj \ $(OBJ_DIR)\dates.obj \ + $(OBJ_DIR)\dateshb.obj \ + $(OBJ_DIR)\defpath.obj \ $(OBJ_DIR)\descend.obj \ $(OBJ_DIR)\dir.obj \ $(OBJ_DIR)\do.obj \ $(OBJ_DIR)\empty.obj \ $(OBJ_DIR)\environ.obj \ $(OBJ_DIR)\errorapi.obj \ + $(OBJ_DIR)\eval.obj \ $(OBJ_DIR)\filesys.obj \ + $(OBJ_DIR)\fkmax.obj \ + $(OBJ_DIR)\fnsplit.obj \ + $(OBJ_DIR)\getenv.obj \ $(OBJ_DIR)\gtapi.obj \ + $(OBJ_DIR)\gx.obj \ $(OBJ_DIR)\hardcr.obj \ $(OBJ_DIR)\inkey.obj \ $(OBJ_DIR)\isprint.obj \ $(OBJ_DIR)\langapi.obj \ + $(OBJ_DIR)\left.obj \ $(OBJ_DIR)\len.obj \ + $(OBJ_DIR)\lennum.obj \ $(OBJ_DIR)\math.obj \ + $(OBJ_DIR)\maxrow.obj \ $(OBJ_DIR)\memofile.obj \ $(OBJ_DIR)\memoline.obj \ + $(OBJ_DIR)\minmax.obj \ $(OBJ_DIR)\mlcount.obj \ $(OBJ_DIR)\mlpos.obj \ + $(OBJ_DIR)\mod.obj \ $(OBJ_DIR)\mouseapi.obj \ $(OBJ_DIR)\mtran.obj \ $(OBJ_DIR)\natmsg.obj \ @@ -189,15 +208,37 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\oemansi.obj \ $(OBJ_DIR)\oldbox.obj \ $(OBJ_DIR)\oldclear.obj \ + $(OBJ_DIR)\pad.obj \ + $(OBJ_DIR)\replic.obj \ + $(OBJ_DIR)\right.obj \ + $(OBJ_DIR)\round.obj \ + $(OBJ_DIR)\run.obj \ $(OBJ_DIR)\samples.obj \ + $(OBJ_DIR)\saverest.obj \ + $(OBJ_DIR)\seconds.obj \ $(OBJ_DIR)\set.obj \ $(OBJ_DIR)\setcolor.obj \ + $(OBJ_DIR)\setcurs.obj \ + $(OBJ_DIR)\setpos.obj \ + $(OBJ_DIR)\shadow.obj \ $(OBJ_DIR)\soundex.obj \ + $(OBJ_DIR)\space.obj \ + $(OBJ_DIR)\str.obj \ + $(OBJ_DIR)\strcase.obj \ $(OBJ_DIR)\strings.obj \ + $(OBJ_DIR)\stris.obj \ + $(OBJ_DIR)\strmatch.obj \ + $(OBJ_DIR)\strtran.obj \ + $(OBJ_DIR)\strzero.obj \ + $(OBJ_DIR)\stuff.obj \ + $(OBJ_DIR)\substr.obj \ $(OBJ_DIR)\tone.obj \ $(OBJ_DIR)\trace.obj \ $(OBJ_DIR)\transfrm.obj \ + $(OBJ_DIR)\trim.obj \ $(OBJ_DIR)\type.obj \ + $(OBJ_DIR)\val.obj \ + $(OBJ_DIR)\valtostr.obj \ $(OBJ_DIR)\valtype.obj \ $(OBJ_DIR)\word.obj \ $(OBJ_DIR)\xhelp.obj \ @@ -448,6 +489,7 @@ COMMON_LIB_OBJS = \ VM_LIB_OBJS = \ $(OBJ_DIR)\arrays.obj \ + $(OBJ_DIR)\arrayshb.obj \ $(OBJ_DIR)\break.obj \ $(OBJ_DIR)\classes.obj \ $(OBJ_DIR)\cmdarg.obj \ diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index 0b4e0589b6..cc27826d75 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -5,44 +5,88 @@ ROOT = ../../ C_SOURCES=\ + abs.c \ + accept.c \ + ampm.c \ + at.c \ binnum.c \ + chrasc.c \ + colorind.c \ console.c \ copyfile.c \ + datec.c \ dates.c \ + dateshb.c \ + defpath.c \ descend.c \ dir.c \ do.c \ empty.c \ environ.c \ errorapi.c \ + eval.c \ filesys.c \ + fkmax.c \ + fnsplit.c \ + getenv.c \ gtapi.c \ + gtxxx.c \ + gx.c \ hardcr.c \ inkey.c \ isprint.c \ langapi.c \ + left.c \ len.c \ + lennum.c \ math.c \ + maxrow.c \ memofile.c \ memoline.c \ + minmax.c \ mlcount.c \ mlpos.c \ + mod.c \ mouseapi.c \ + mousexxx.c \ + msgxxx.c \ mtran.c \ natmsg.c \ net.c \ oemansi.c \ oldbox.c \ oldclear.c \ + pad.c \ + replic.c \ + right.c \ + round.c \ + run.c \ samples.c \ + saverest.c \ + seconds.c \ set.c \ setcolor.c \ + setcurs.c \ + setpos.c \ + shadow.c \ soundex.c \ + space.c \ + str.c \ + strcase.c \ strings.c \ + stris.c \ + strmatch.c \ + strtran.c \ + strzero.c \ + stuff.c \ + substr.c \ tone.c \ trace.c \ transfrm.c \ + trim.c \ type.c \ + val.c \ + valtostr.c \ valtype.c \ word.c \ xhelp.c \ diff --git a/harbour/source/rtl/abs.c b/harbour/source/rtl/abs.c new file mode 100644 index 0000000000..abf1da0e67 --- /dev/null +++ b/harbour/source/rtl/abs.c @@ -0,0 +1,87 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * ABS() function + * + * Copyright 1999 {list of individual authors and e-mail addresses} + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +HARBOUR HB_ABS( void ) +{ + PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); + + if( pNumber ) + { + int iWidth; + int iDec; + + hb_itemGetNLen( pNumber, &iWidth, &iDec ); + + if( IS_INTEGER( pNumber ) ) + { + int iNumber = hb_itemGetNI( pNumber ); + + if( iNumber >= 0 ) + hb_retnilen( iNumber, iWidth ); + else + hb_retni( -iNumber ); + } + else if( IS_LONG( pNumber ) ) + { + long lNumber = hb_itemGetNL( pNumber ); + + if( lNumber >= 0 ) + hb_retnllen( lNumber, iWidth ); + else + hb_retnl( -lNumber ); + } + else if( IS_DOUBLE( pNumber ) ) + { + double dNumber = hb_itemGetND( pNumber ); + + hb_retndlen( dNumber >= 0.0 ? dNumber : -dNumber, 0, iDec ); + } + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1089, NULL, "ABS" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + diff --git a/harbour/source/rtl/accept.c b/harbour/source/rtl/accept.c new file mode 100644 index 0000000000..7c6376b721 --- /dev/null +++ b/harbour/source/rtl/accept.c @@ -0,0 +1,103 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * ACCEPT command related functions + * + * Copyright 1999 Eddie Runia + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 1999 Victor Szakats + * HB___ACCEPTSTR() + * + * See doc/license.txt for licensing terms. + * + */ + +#include "hbapi.h" +#include "hbapigt.h" +#include "inkey.ch" + +extern HARBOUR HB_QOUT( void ); + +#define ACCEPT_BUFFER_LEN 256 /* length of input buffer for ACCEPT command */ + +static char s_szAcceptResult[ ACCEPT_BUFFER_LEN ] = { '\0' }; + +HARBOUR HB___ACCEPT( void ) +{ + int input; + ULONG ulLen; + + /* cPrompt(s) passed ? */ + if( hb_pcount() >= 1 ) + HB_QOUT(); + + ulLen = 0; + input = 0; + + while( input != K_ENTER ) + { + /* Wait forever, for keyboard events only */ + input = hb_inkey( 0.0, ( HB_inkey_enum ) INKEY_KEYBOARD, 1, 1 ); + switch( input ) + { + case K_BS: + case K_LEFT: + if( ulLen > 0 ) + { + hb_gtWriteCon( ( BYTE * ) "\x8 \x8", 3 ); /* Erase it from the screen. */ + ulLen--; /* Adjust input count to get rid of last character */ + } + break; + + default: + if( ulLen < ( ACCEPT_BUFFER_LEN - 1 ) && input >= 32 ) + { + s_szAcceptResult[ ulLen ] = input; /* Accept the input */ + hb_gtWriteCon( ( BYTE * ) &s_szAcceptResult[ ulLen ], sizeof( char ) ); /* Then display it */ + ulLen++; /* Then adjust the input count */ + } + } + } + + s_szAcceptResult[ ulLen ] = '\0'; + + hb_retc( s_szAcceptResult ); +} + +HARBOUR HB___ACCEPTSTR( void ) +{ + hb_retc( s_szAcceptResult ); +} + diff --git a/harbour/source/rtl/ampm.c b/harbour/source/rtl/ampm.c new file mode 100644 index 0000000000..464104342a --- /dev/null +++ b/harbour/source/rtl/ampm.c @@ -0,0 +1,80 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * AMPM() compatibility function from the SAMPLES directory of Clipper. + * + * Copyright 1999 Victor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" + +HARBOUR HB_AMPM( void ) +{ + char * pszTime = hb_parc( 1 ); + ULONG ulTimeLen = hb_parclen( 1 ); + char * pszResult = ( char * ) hb_xgrab( HB_MAX_( ulTimeLen, 2 ) + 3 + 1 ); + USHORT uiHour = ( USHORT ) hb_strVal( pszTime ); + BOOL bAM; + + memset( pszResult, '\0', 3 ); + memcpy( pszResult, pszTime, ulTimeLen ); + + if( uiHour == 0 || uiHour == 24 ) + { + if( ulTimeLen < 2 ) + ulTimeLen = 2; + + pszResult[ 0 ] = '1'; + pszResult[ 1 ] = '2'; + bAM = TRUE; + } + else if( uiHour > 12 ) + { + if( ulTimeLen < 2 ) + ulTimeLen = 2; + + uiHour -= 12; + pszResult[ 0 ] = ( char ) ( uiHour / 10 ) + '0'; + pszResult[ 1 ] = ( char ) ( uiHour % 10 ) + '0'; + + if( pszResult[ 0 ] == '0' ) + pszResult[ 0 ] = ' '; + + bAM = FALSE; + } + else + bAM = ( uiHour != 12 ); + + strcpy( pszResult + ulTimeLen, bAM ? " am" : " pm" ); + + hb_retclen( pszResult, ulTimeLen + 3 ); + hb_xfree( pszResult ); +} + diff --git a/harbour/source/rtl/at.c b/harbour/source/rtl/at.c new file mode 100644 index 0000000000..57ea88d2a9 --- /dev/null +++ b/harbour/source/rtl/at.c @@ -0,0 +1,99 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * AT(), RAT() functions + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* locates a substring in a string */ +/* TEST: QOUT( "at( 'cde', 'abcdefgfedcba' ) = '" + at( 'cde', 'abcsefgfedcba' ) + "'" ) */ + +HARBOUR HB_AT( void ) +{ + PHB_ITEM pSub = hb_param( 1, IT_STRING ); + PHB_ITEM pText = hb_param( 2, IT_STRING ); + + if( pText && pSub ) + { + hb_retnl( hb_strAt( hb_itemGetCPtr( pSub ), hb_itemGetCLen( pSub ), + hb_itemGetCPtr( pText ), hb_itemGetCLen( pText ) ) ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1108, NULL, "AT" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +/* locates a substring in a string starting at the end */ +/* TEST: QOUT( "rat( 'cde', 'abcdefgfedcba' ) = '" + rat( 'cde', 'abcdefgfedcba' ) + "'" ) */ +/* TOFIX: Will not work with a search string > 64 KB on some platforms */ + +HARBOUR HB_RAT( void ) +{ + ULONG ulSubLen = hb_parclen( 1 ); + + if( ulSubLen ) + { + long lPos = hb_parclen( 2 ) - ulSubLen; + + if( lPos >= 0 ) + { + char * szSub = hb_parc( 1 ); + char * szText = hb_parc( 2 ); + BOOL bFound = FALSE; + + while( lPos >= 0 && !bFound ) + { + if( *( szText + lPos ) == *szSub ) + bFound = ( memcmp( szSub, szText + lPos, ulSubLen ) == 0 ); + lPos--; + } + + hb_retnl( bFound ? lPos + 2 : 0 ); + } + else + hb_retni( 0 ); + } + else + /* This function never seems to raise an error */ + hb_retni( 0 ); +} + diff --git a/harbour/source/rtl/chrasc.c b/harbour/source/rtl/chrasc.c new file mode 100644 index 0000000000..3c11e9f0f2 --- /dev/null +++ b/harbour/source/rtl/chrasc.c @@ -0,0 +1,95 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CHR(), ASC() functions + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* converts an ASCII code to a character value */ +HARBOUR HB_CHR( void ) +{ + if( ISNUM( 1 ) ) + { + char szChar[ 2 ]; + + /* NOTE: CA-Cl*pper's compiler optimizer will be wrong for those + CHR() cases where the passed parameter is a constant which + can be divided by 256 but it's not zero, in this case it + will return an empty string instead of a Chr(0). [vszakats] */ + + /* Believe it or not, clipper does this! */ + szChar[ 0 ] = hb_parnl( 1 ) % 256; + szChar[ 1 ] = '\0'; + + hb_retclen( szChar, 1 ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1104, NULL, "CHR" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +/* converts a character value to an ASCII code */ +HARBOUR HB_ASC( void ) +{ + PHB_ITEM pText = hb_param( 1, IT_STRING ); + + if( pText ) + { + if( hb_itemGetCLen( pText ) > 0 ) + hb_retni( ( BYTE ) * ( hb_itemGetCPtr( pText ) ) ); + else + hb_retni( 0 ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1107, NULL, "ASC" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + diff --git a/harbour/source/rtl/colorind.c b/harbour/source/rtl/colorind.c new file mode 100644 index 0000000000..f9e02a9332 --- /dev/null +++ b/harbour/source/rtl/colorind.c @@ -0,0 +1,85 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * HB_COLORINDEX() function + * + * Copyright 1999 Victor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" + +HARBOUR HB_HB_COLORINDEX( void ) +{ + if( ISCHAR( 1 ) && ISNUM( 2 ) ) + { + char * pszColor = hb_parc( 1 ); + ULONG ulColorPos; + ULONG ulColorLen; + USHORT uiColorIndex = ( USHORT ) hb_parni( 2 ); + + /* Skip the given number of commas */ + + for( ulColorPos = 0 ; pszColor[ ulColorPos ] != '\0' && uiColorIndex > 0 ; ulColorPos++ ) + { + if( pszColor[ ulColorPos ] == ',' ) + uiColorIndex--; + } + + /* if found, continue */ + + if( uiColorIndex == 0 ) + { + /* Skip the spaces after the comma */ + + while( pszColor[ ulColorPos ] == ' ' ) ulColorPos++; + + /* Search for next comma or end of string */ + + ulColorLen = 0; + + while( pszColor[ ulColorPos + ulColorLen ] != '\0' && + pszColor[ ulColorPos + ulColorLen ] != ',' ) ulColorLen++; + + /* Skip the trailing spaces */ + + while( ulColorLen > 0 && + pszColor[ ulColorPos + ulColorLen - 1 ] == ' ' ) ulColorLen--; + + /* Return the string */ + + hb_retclen( pszColor + ulColorPos, ulColorLen ); + } + else + hb_retc( "" ); + } + else + hb_retc( "" ); +} + diff --git a/harbour/source/rtl/console.c b/harbour/source/rtl/console.c index a215a17eec..099ec2f807 100644 --- a/harbour/source/rtl/console.c +++ b/harbour/source/rtl/console.c @@ -37,28 +37,20 @@ * The following parts are Copyright of the individual authors. * www - http://www.harbour-project.org * - * Copyright 1999 Eddie Runia - * HB___ACCEPT() - * * Copyright 1999 David G. Holm * hb_altout(), hb_devout(), HB_DEVOUT(), hb_devpos(), - * HB_DEVPOS(), hb_dispout(), HB___EJECT(), HB_MAXCOL(), - * HB_MAXROW(), hb_out(), hb_outerr(), HB_OUTERR(), + * HB_DEVPOS(), hb_dispout(), HB___EJECT(), + * hb_out(), hb_outerr(), HB_OUTERR(), * hb_outstd(), HB_OUTSTD(), HB_PCOL(), HB_PROW(), - * HB_SETPOS(), HB_SETPRC(), HB_SCROLL(), and hb_consoleInitialize() + * HB_SETPRC(), HB_SCROLL(), and hb_consoleInitialize() * * Copyright 1999 Victor Szakats * hb_consoleGetNewLine() * HB_DISPOUTAT() - * HB_SETPOSBS() * HB_DISPBOX() (GT version) * HB_DISPBEGIN() * HB_DISPEND() * HB_DISPCOUNT() - * HB_ISCOLOR() - * HB_NOSNOW() - * HB___ACCEPTSTR() - * HB_HB_COLORINDEX() * * See doc/license.txt for licensing terms. * @@ -71,7 +63,6 @@ #include "hbapigt.h" #include "hbdate.h" #include "hbset.h" -#include "inkey.ch" #if defined(__GNUC__) && ! defined(__MINGW32__) #include @@ -87,8 +78,6 @@ #include #endif -#define ACCEPT_BUFFER_LEN 256 /* length of input buffer for ACCEPT command */ - #if defined(OS_UNIX_COMPATIBLE) #define CRLF_BUFFER_LEN 2 /*length of buffer for CR/LF characters */ #else @@ -99,7 +88,6 @@ static BOOL s_bInit = FALSE; static USHORT s_uiPRow; static USHORT s_uiPCol; static char s_szCrLf[ CRLF_BUFFER_LEN ]; -static char s_szAcceptResult[ ACCEPT_BUFFER_LEN ]; static int s_iFilenoStdin; static int s_iFilenoStdout; static int s_iFilenoStderr; @@ -119,8 +107,6 @@ void hb_consoleInitialize( void ) s_szCrLf[ 2 ] = '\0'; #endif - s_szAcceptResult[ 0 ] = '\0'; - s_uiPRow = s_uiPCol = 0; /* Some compilers open stdout and stderr in text mode, but @@ -348,12 +334,6 @@ HARBOUR HB_DEVPOS( void ) /* Sets the screen and/or printer position */ hb_devpos( hb_parni( 1 ), hb_parni( 2 ) ); } -HARBOUR HB_SETPOS( void ) /* Sets the screen position */ -{ - if( ISNUM( 1 ) && ISNUM( 2 ) ) - hb_gtSetPos( hb_parni( 1 ), hb_parni( 2 ) ); -} - HARBOUR HB_OUTSTD( void ) /* writes a list of values to the standard output device */ { USHORT uiPCount = hb_pcount(); @@ -413,17 +393,6 @@ HARBOUR HB_QOUT( void ) HB_QQOUT(); } -/* Move the screen position to the right by one column */ -HARBOUR HB_SETPOSBS( void ) -{ - SHORT iRow, iCol; - - /* NOTE: Clipper does no checks about reaching the border or anything. - [vszakats] */ - hb_gtGetPos( &iRow, &iCol ); - hb_gtSetPos( iRow, iCol + 1 ); -} - HARBOUR HB_DEVOUT( void ) /* writes a single value to the current device (screen or printer), but is not affected by SET ALTERNATE */ { if( hb_pcount() >= 1 ) @@ -444,51 +413,6 @@ HARBOUR HB_DEVOUT( void ) /* writes a single value to the current device (screen } } -HARBOUR HB_DISPOUT( void ) /* writes a single value to the screen, but is not affected by SET ALTERNATE */ -{ - if( hb_pcount() >= 1 ) - { - if( ISCHAR( 2 ) ) - { - char szOldColor[ CLR_STRLEN ]; - - hb_gtGetColorStr( szOldColor ); - hb_gtSetColorStr( hb_parc( 2 ) ); - - hb_out( 1, hb_dispout ); - - hb_gtSetColorStr( szOldColor ); - } - else - hb_out( 1, hb_dispout ); - } -} - -/* Undocumented Clipper function */ - -HARBOUR HB_DISPOUTAT( void ) /* writes a single value to the screen at speficic position, but is not affected by SET ALTERNATE */ -{ - if( hb_pcount() >= 3 ) - { - /* NOTE: Clipper does no checks here. [vszakats] */ - hb_gtSetPos( hb_parni( 1 ), hb_parni( 2 ) ); - - if( ISCHAR( 4 ) ) - { - char szOldColor[ CLR_STRLEN ]; - - hb_gtGetColorStr( szOldColor ); - hb_gtSetColorStr( hb_parc( 4 ) ); - - hb_out( 3, hb_dispout ); - - hb_gtSetColorStr( szOldColor ); - } - else - hb_out( 3, hb_dispout ); - } -} - /* TOFIX: CA-Cl*pper will print an eject even if SET DEVICE=SCREEN */ HARBOUR HB___EJECT( void ) /* Ejects the current page from the printer */ @@ -553,36 +477,6 @@ HARBOUR HB_SCROLL( void ) /* Scrolls a screen region */ hb_gtScroll( top, left, bottom, right, v_scroll, h_scroll ); } -HARBOUR HB_MAXROW( void ) /* Return the maximum screen row number (zero origin) */ -{ - hb_retni( hb_gtMaxRow() ); -} - -HARBOUR HB_MAXCOL( void ) /* Return the maximum screen column number (zero origin) */ -{ - hb_retni( hb_gtMaxCol() ); -} - -HARBOUR HB_ROW( void ) /* Return the current screen row position (zero origin) */ -{ - SHORT iRow; - SHORT iCol; - - hb_gtGetPos( &iRow, &iCol ); - - hb_retni( iRow ); -} - -HARBOUR HB_COL( void ) /* Return the current screen column position (zero origin) */ -{ - SHORT iRow; - SHORT iCol; - - hb_gtGetPos( &iRow, &iCol ); - - hb_retni( iCol ); -} - HARBOUR HB_DISPBOX( void ) { if( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISNUM( 4 ) ) @@ -735,190 +629,48 @@ HARBOUR HB_DISPCOUNT( void ) hb_retni( hb_gtDispCount() ); } -HARBOUR HB_ISCOLOR( void ) +HARBOUR HB_DISPOUT( void ) /* writes a single value to the screen, but is not affected by SET ALTERNATE */ { - hb_retl( hb_gtIsColor() ); -} - -HARBOUR HB_NOSNOW( void ) -{ - if( ISLOG( 1 ) ) - hb_gtSetSnowFlag( hb_parl( 1 ) ); -} - -HARBOUR HB_HB_SHADOW( void ) -{ - if( hb_pcount() >= 4 ) - hb_gtDrawShadow( hb_parni( 1 ), - hb_parni( 2 ), - hb_parni( 3 ), - hb_parni( 4 ), - ISNUM( 5 ) ? hb_parni( 5 ) : 7 ); -} - -HARBOUR HB_DBGSHADOW( void ) -{ - HB_HB_SHADOW(); -} - -HARBOUR HB_SAVESCREEN( void ) -{ - USHORT uiX; - USHORT uiCoords[ 4 ]; - void * pBuffer; - - uiCoords[ 0 ] = ISNUM( 1 ) ? hb_parni( 1 ) : 0; - uiCoords[ 1 ] = ISNUM( 2 ) ? hb_parni( 2 ) : 0; - uiCoords[ 2 ] = ISNUM( 3 ) ? hb_parni( 3 ) : hb_gtMaxRow(); - uiCoords[ 3 ] = ISNUM( 4 ) ? hb_parni( 4 ) : hb_gtMaxCol(); - - hb_gtRectSize( uiCoords[ 0 ], uiCoords[ 1 ], uiCoords[ 2 ], uiCoords[ 3 ], &uiX ); - pBuffer = hb_xgrab( uiX ); - hb_gtSave( uiCoords[ 0 ], uiCoords[ 1 ], uiCoords[ 2 ], uiCoords[ 3 ], pBuffer ); - hb_retclen( ( char * ) pBuffer, uiX ); - hb_xfree( ( char * ) pBuffer ); -} - -HARBOUR HB_RESTSCREEN( void ) -{ - if( ISCHAR( 5 ) ) - hb_gtRest( ISNUM( 1 ) ? hb_parni( 1 ) : 0, - ISNUM( 2 ) ? hb_parni( 2 ) : 0, - ISNUM( 3 ) ? hb_parni( 3 ) : hb_gtMaxRow(), - ISNUM( 4 ) ? hb_parni( 4 ) : hb_gtMaxCol(), - ( void * ) hb_parc( 5 ) ); -} - -USHORT hb_setCursor( BOOL bSetCursor, USHORT usNewCursor ) -{ - USHORT usPreviousCursor; - - HB_TRACE(HB_TR_DEBUG, ("hb_setCursor(%d, %hu)", (int) bSetCursor, usNewCursor)); - - hb_gtGetCursor( &usPreviousCursor ); - if( bSetCursor ) - hb_gtSetCursor( usNewCursor ); - - return usPreviousCursor; -} - -HARBOUR HB_SETCURSOR( void ) -{ - hb_retni( hb_setCursor( ISNUM( 1 ), hb_parni( 1 ) ) ); -} - -HARBOUR HB_SETBLINK( void ) -{ - BOOL bPreviousBlink; - - hb_gtGetBlink( &bPreviousBlink ); - if( ISLOG( 1 ) ) - hb_gtSetBlink( hb_parl( 1 ) ); - - hb_retl( bPreviousBlink ); -} - -HARBOUR HB_SETMODE( void ) -{ - hb_retl( hb_gtSetMode( ISNUM( 1 ) ? hb_parni( 1 ) : ( hb_gtMaxRow() + 1 ), - ISNUM( 2 ) ? hb_parni( 2 ) : ( hb_gtMaxCol() + 1 ) ) == 0 ); -} - -/* Internal Clipper function used in ACCEPT command */ -/* Basically the simplest Clipper function to */ -/* receive data. Parameter : cPrompt. Returns : cRet */ - -HARBOUR HB___ACCEPT( void ) -{ - int input; - ULONG ulLen; - - if( hb_pcount() >= 1 ) /* cPrompt passed */ - HB_QOUT(); - - ulLen = 0; - input = 0; - - while( input != K_ENTER ) + if( hb_pcount() >= 1 ) { - /* Wait forever, for keyboard events only */ - input = hb_inkey( 0.0, ( HB_inkey_enum ) INKEY_KEYBOARD, 1, 1 ); - switch( input ) + if( ISCHAR( 2 ) ) { - case K_BS: - case K_LEFT: - if( ulLen > 0 ) - { - hb_gtWriteCon( ( BYTE * ) "\x8 \x8", 3 ); /* Erase it from the screen. */ - ulLen--; /* Adjust input count to get rid of last character */ - } - break; + char szOldColor[ CLR_STRLEN ]; - default: - if( ulLen < ( ACCEPT_BUFFER_LEN - 1 ) && input >= 32 ) - { - s_szAcceptResult[ ulLen ] = input; /* Accept the input */ - hb_gtWriteCon( ( BYTE * ) &s_szAcceptResult[ ulLen ], sizeof( char ) ); /* Then display it */ - ulLen++; /* Then adjust the input count */ - } - } - } + hb_gtGetColorStr( szOldColor ); + hb_gtSetColorStr( hb_parc( 2 ) ); - s_szAcceptResult[ ulLen ] = '\0'; + hb_out( 1, hb_dispout ); - hb_retc( s_szAcceptResult ); -} - -HARBOUR HB___ACCEPTSTR( void ) -{ - hb_retc( s_szAcceptResult ); -} - -HARBOUR HB_HB_COLORINDEX( void ) -{ - if( ISCHAR( 1 ) && ISNUM( 2 ) ) - { - char * pszColor = hb_parc( 1 ); - ULONG ulColorPos; - ULONG ulColorLen; - USHORT uiColorIndex = ( USHORT ) hb_parni( 2 ); - - /* Skip the given number of commas */ - - for( ulColorPos = 0 ; pszColor[ ulColorPos ] != '\0' && uiColorIndex > 0 ; ulColorPos++ ) - { - if( pszColor[ ulColorPos ] == ',' ) - uiColorIndex--; - } - - /* if found, continue */ - - if( uiColorIndex == 0 ) - { - /* Skip the spaces after the comma */ - - while( pszColor[ ulColorPos ] == ' ' ) ulColorPos++; - - /* Search for next comma or end of string */ - - ulColorLen = 0; - - while( pszColor[ ulColorPos + ulColorLen ] != '\0' && - pszColor[ ulColorPos + ulColorLen ] != ',' ) ulColorLen++; - - /* Skip the trailing spaces */ - - while( ulColorLen > 0 && - pszColor[ ulColorPos + ulColorLen - 1 ] == ' ' ) ulColorLen--; - - /* Return the string */ - - hb_retclen( pszColor + ulColorPos, ulColorLen ); + hb_gtSetColorStr( szOldColor ); } else - hb_retc( "" ); + hb_out( 1, hb_dispout ); + } +} + +/* Undocumented Clipper function */ + +HARBOUR HB_DISPOUTAT( void ) /* writes a single value to the screen at speficic position, but is not affected by SET ALTERNATE */ +{ + if( hb_pcount() >= 3 ) + { + /* NOTE: Clipper does no checks here. [vszakats] */ + hb_gtSetPos( hb_parni( 1 ), hb_parni( 2 ) ); + + if( ISCHAR( 4 ) ) + { + char szOldColor[ CLR_STRLEN ]; + + hb_gtGetColorStr( szOldColor ); + hb_gtSetColorStr( hb_parc( 4 ) ); + + hb_out( 3, hb_dispout ); + + hb_gtSetColorStr( szOldColor ); + } + else + hb_out( 3, hb_dispout ); } - else - hb_retc( "" ); } diff --git a/harbour/source/rtl/datec.c b/harbour/source/rtl/datec.c new file mode 100644 index 0000000000..7c16713815 --- /dev/null +++ b/harbour/source/rtl/datec.c @@ -0,0 +1,107 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CMONTH(), CDOW() functions + * + * Copyright 1999 Jose Lalin + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapierr.h" +#include "hbapiitm.h" +#include "hbdate.h" + +char * hb_cmonth( int iMonth ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_cmonth(%d)", iMonth)); + + return ( iMonth >= 1 && iMonth <= 12 ) ? hb_monthsname[ iMonth - 1 ] : ""; +} + +HARBOUR HB_CMONTH( void ) +{ + PHB_ITEM pDate = hb_param( 1, IT_DATE ); + + if( pDate ) + { + long lDay, lMonth, lYear; + + hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear ); + hb_retc( hb_cmonth( lMonth ) ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1116, NULL, "CMONTH" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +char * hb_cdow( int iDay ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_cdow(%d)", iDay)); + + return ( iDay >= 1 && iDay <= 7 ) ? hb_daysname[ iDay - 1 ] : ""; +} + +HARBOUR HB_CDOW( void ) +{ + PHB_ITEM pDate = hb_param( 1, IT_DATE ); + + if( pDate ) + { + long lDate = hb_itemGetDL( pDate ); + + if( lDate ) + { + long lDay, lMonth, lYear; + + hb_dateDecode( lDate, &lDay, &lMonth, &lYear ); + hb_retc( hb_cdow( hb_dow( lDay, lMonth, lYear ) ) ); + } + else + hb_retc( "" ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1117, NULL, "CDOW" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + diff --git a/harbour/source/rtl/dates.c b/harbour/source/rtl/dates.c index 2ed1a9d6a0..f9615d5f6a 100644 --- a/harbour/source/rtl/dates.c +++ b/harbour/source/rtl/dates.c @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * The Date API + * The Date API (C level) * * Copyright 1999 Antonio Linares * www - http://www.harbour-project.org @@ -38,21 +38,9 @@ * www - http://www.harbour-project.org * * Copyright 1999 Jose Lalin - * hb_secondsToday() - * HB_SECONDS() - * hb_cmonth() - * HB_CMONTH() - * hb_cdow() - * HB_CDOW() - * HB_DAY() - * HB_MONTH() - * HB_YEAR() * hb_dow() - * HB_DOW() * * Copyright 1999 David G. Holm - * HB_CTOD() - * HB_DATE() * hb_dtoc() * * Copyright 1999 Victor Szakats @@ -60,66 +48,16 @@ * hb_dateDecStr() * hb_dateStrPut() * hb_dateStrGet() - * HB_STOD() - * HB_HB_STOD() * * See doc/license.txt for licensing terms. * */ -#define HB_OS_WIN_32_USED +#include #include "hbapi.h" -#include "hbapierr.h" -#include "hbapiitm.h" -#include "hbset.h" #include "hbdate.h" -#include -#include -#if defined( OS_UNIX_COMPATIBLE ) - #include -#else - #include -#endif -#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__DJGPP__) - #include -#endif - -double hb_secondsToday( void ) -{ -#if defined(_MSC_VER) - #define timeb _timeb - #define ftime _ftime -#endif - struct timeb tb; - struct tm * oTime; - - HB_TRACE(HB_TR_DEBUG, ("hb_secondsToday()")); - - ftime( &tb ); - oTime = localtime( &tb.time ); - - return ( oTime->tm_hour * 3600 ) + - ( oTime->tm_min * 60 ) + - oTime->tm_sec + - ( ( double ) tb.millitm / 1000 ); -} - -char * hb_cmonth( int iMonth ) -{ - HB_TRACE(HB_TR_DEBUG, ("hb_cmonth(%d)", iMonth)); - - return ( iMonth >= 1 && iMonth <= 12 ) ? hb_monthsname[ iMonth - 1 ] : ""; -} - -char * hb_cdow( int iDay ) -{ - HB_TRACE(HB_TR_DEBUG, ("hb_cdow(%d)", iDay)); - - return ( iDay >= 1 && iDay <= 7 ) ? hb_daysname[ iDay - 1 ] : ""; -} - long hb_dateEncode( long lDay, long lMonth, long lYear ) { HB_TRACE(HB_TR_DEBUG, ("hb_dateEncode(%ld, %ld, %ld)", lDay, lMonth, lYear)); @@ -247,102 +185,6 @@ long hb_dateEncStr( char * szDate ) return hb_dateEncode( lDay, lMonth, lYear ); } -HARBOUR HB_CTOD( void ) -{ - if( ISCHAR( 1 ) ) - { - char * szDate = hb_parc( 1 ); - int d_value = 0, m_value = 0, y_value = 0; - char szDateFormat[ 9 ]; - - if( szDate ) - { - int d_pos = 0, m_pos = 0, y_pos = 0; - int count, digit, size = strlen( hb_set.HB_SET_DATEFORMAT ); - - for( count = 0; count < size; count++ ) - { - switch( hb_set.HB_SET_DATEFORMAT[ count ] ) - { - case 'D': - case 'd': - if( d_pos == 0 ) - { - if( m_pos == 0 && y_pos == 0 ) d_pos = 1; - else if( m_pos == 0 || y_pos == 0 ) d_pos = 2; - else d_pos = 3; - } - break; - case 'M': - case 'm': - if( m_pos == 0 ) - { - if( d_pos == 0 && y_pos == 0 ) m_pos = 1; - else if( d_pos == 0 || y_pos == 0 ) m_pos = 2; - else m_pos = 3; - } - break; - case 'Y': - case 'y': - if( y_pos == 0 ) - { - if( m_pos == 0 && d_pos == 0 ) y_pos = 1; - else if( m_pos == 0 || d_pos == 0 ) y_pos = 2; - else y_pos = 3; - } - } - } - - size = strlen( szDate ); - - for( count = 0; count < size; count++ ) - { - digit = szDate[ count ]; - if( isdigit( digit ) ) - { - if( d_pos == 1 ) - d_value = ( d_value * 10 ) + digit - '0'; - else if( m_pos == 1 ) - m_value = ( m_value * 10 ) + digit - '0'; - else if( y_pos == 1 ) - y_value = ( y_value * 10 ) + digit - '0'; - } - else if( digit != ' ' ) - { - d_pos--; - m_pos--; - y_pos--; - } - } - - if( y_value >= 0 && y_value < 100 ) - { - count = hb_set.HB_SET_EPOCH % 100; - digit = hb_set.HB_SET_EPOCH / 100; - - if( y_value >= count ) - y_value += ( digit * 100 ); - else - y_value += ( ( digit * 100 ) + 100 ); - } - } - - sprintf( szDateFormat, "%04i%02i%02i", y_value, m_value, d_value ); - - hb_retds( szDateFormat ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1119, NULL, "CTOD" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - /* NOTE: szFormattedDate must be an at least 11 chars wide buffer */ char * hb_dtoc( const char * szDate, char * szFormattedDate, const char * szDateFormat ) @@ -513,178 +355,6 @@ char * hb_dtoc( const char * szDate, char * szFormattedDate, const char * szDate return szFormattedDate; } -HARBOUR HB_DTOC( void ) -{ - if( ISDATE( 1 ) ) - { - char szDate[ 9 ]; - char szFormatted[ 11 ]; - - hb_retc( hb_dtoc( hb_pardsbuff( szDate, 1 ), szFormatted, hb_set.HB_SET_DATEFORMAT ) ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1118, NULL, "DTOC" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -HARBOUR HB_DTOS( void ) -{ - if( ISDATE( 1 ) ) - { - char szDate[ 9 ]; - - hb_retc( hb_pardsbuff( szDate, 1 ) ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1120, NULL, "DTOS" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -#ifdef HB_COMPAT_XPP - -/* NOTE: XBase++ compatible function */ -/* NOTE: XBase++ checks for the parameter count at compile time */ - -HARBOUR HB_STOD( void ) -{ - hb_retds( hb_parc( 1 ) ); -} - -#endif - -/* NOTE: Harbour extension, exactly the same as STOD(). */ - -HARBOUR HB_HB_STOD( void ) -{ - hb_retds( hb_parc( 1 ) ); -} - -HARBOUR HB_YEAR( void ) -{ - PHB_ITEM pDate = hb_param( 1, IT_DATE ); - - if( pDate ) - { - long lDay, lMonth, lYear; - - hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear ); - - hb_retnllen( lYear, 5 ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1112, NULL, "YEAR" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -HARBOUR HB_MONTH( void ) -{ - PHB_ITEM pDate = hb_param( 1, IT_DATE ); - - if( pDate ) - { - long lDay, lMonth, lYear; - - hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear ); - - hb_retnllen( lMonth, 3 ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1113, NULL, "MONTH" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -HARBOUR HB_DAY( void ) -{ - PHB_ITEM pDate = hb_param( 1, IT_DATE ); - - if( pDate ) - { - long lDay, lMonth, lYear; - - hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear ); - - hb_retnllen( lDay, 3 ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1114, NULL, "DAY" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -HARBOUR HB_TIME( void ) -{ - char szResult[ 9 ]; - - #if defined(_Windows) || defined(WINNT) || defined(_WIN32) - SYSTEMTIME st; - GetLocalTime( &st ); - sprintf( szResult, "%02d:%02d:%02d", st.wHour, st.wMinute, st.wSecond ); - #else - time_t t; - struct tm * oTime; - - time( &t ); - oTime = localtime( &t ); - sprintf( szResult, "%02d:%02d:%02d", oTime->tm_hour, oTime->tm_min, oTime->tm_sec ); - #endif - - hb_retclen( szResult, 8 ); -} - -HARBOUR HB_DATE( void ) -{ - char szResult[ 9 ]; - - #if defined(_Windows) || defined(WINNT) || defined(_WIN32) - SYSTEMTIME st; - GetLocalTime( &st ); - sprintf( szResult, "%04d%02d%02d", st.wYear, st.wMonth, st.wDay ); - #else - time_t t; - struct tm * oTime; - - time( &t ); - oTime = localtime( &t ); - sprintf( szResult, "%04d%02d%02d", oTime->tm_year + 1900, oTime->tm_mon + 1, oTime->tm_mday ); - #endif - - hb_retds( szResult ); -} - long hb_dow( long lDay, long lMonth, long lYear ) { HB_TRACE(HB_TR_DEBUG, ("hb_dow(%ld, %ld, %ld)", lDay, lMonth, lYear)); @@ -701,92 +371,3 @@ long hb_dow( long lDay, long lMonth, long lYear ) lYear + lYear / 4 - lYear / 100 + lYear / 400 + 6 ) % 7 + 1; } -HARBOUR HB_DOW( void ) -{ - PHB_ITEM pDate = hb_param( 1, IT_DATE ); - - if( pDate ) - { - long lDate = hb_itemGetDL( pDate ); - - if( lDate ) - { - long lDay, lMonth, lYear; - - hb_dateDecode( lDate, &lDay, &lMonth, &lYear ); - - hb_retnllen( hb_dow( lDay, lMonth, lYear ), 3 ); - } - else - hb_retnllen( 0, 3 ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1115, NULL, "DOW" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -HARBOUR HB_CMONTH( void ) -{ - PHB_ITEM pDate = hb_param( 1, IT_DATE ); - - if( pDate ) - { - long lDay, lMonth, lYear; - - hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear ); - hb_retc( hb_cmonth( lMonth ) ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1116, NULL, "CMONTH" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -HARBOUR HB_CDOW( void ) -{ - PHB_ITEM pDate = hb_param( 1, IT_DATE ); - - if( pDate ) - { - long lDate = hb_itemGetDL( pDate ); - - if( lDate ) - { - long lDay, lMonth, lYear; - - hb_dateDecode( lDate, &lDay, &lMonth, &lYear ); - hb_retc( hb_cdow( hb_dow( lDay, lMonth, lYear ) ) ); - } - else - hb_retc( "" ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1117, NULL, "CDOW" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -HARBOUR HB_SECONDS( void ) -{ - hb_retnd( hb_secondsToday() ); -} - diff --git a/harbour/source/rtl/dateshb.c b/harbour/source/rtl/dateshb.c new file mode 100644 index 0000000000..f25b206b67 --- /dev/null +++ b/harbour/source/rtl/dateshb.c @@ -0,0 +1,375 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * The Date API (Harbour level) + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 1999 Jose Lalin + * HB_DAY() + * HB_MONTH() + * HB_YEAR() + * HB_DOW() + * + * Copyright 1999 David G. Holm + * HB_CTOD() + * HB_DATE() + * + * Copyright 1999 Victor Szakats + * HB_STOD() + * HB_HB_STOD() + * + * See doc/license.txt for licensing terms. + * + */ + +#define HB_OS_WIN_32_USED + +#include "hbapi.h" +#include "hbapierr.h" +#include "hbapiitm.h" +#include "hbset.h" +#include "hbdate.h" + +#include +#include +#if defined( OS_UNIX_COMPATIBLE ) + #include +#else + #include +#endif +#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__DJGPP__) + #include +#endif + +HARBOUR HB_CTOD( void ) +{ + if( ISCHAR( 1 ) ) + { + char * szDate = hb_parc( 1 ); + int d_value = 0, m_value = 0, y_value = 0; + char szDateFormat[ 9 ]; + + if( szDate ) + { + int d_pos = 0, m_pos = 0, y_pos = 0; + int count, digit, size = strlen( hb_set.HB_SET_DATEFORMAT ); + + for( count = 0; count < size; count++ ) + { + switch( hb_set.HB_SET_DATEFORMAT[ count ] ) + { + case 'D': + case 'd': + if( d_pos == 0 ) + { + if( m_pos == 0 && y_pos == 0 ) d_pos = 1; + else if( m_pos == 0 || y_pos == 0 ) d_pos = 2; + else d_pos = 3; + } + break; + case 'M': + case 'm': + if( m_pos == 0 ) + { + if( d_pos == 0 && y_pos == 0 ) m_pos = 1; + else if( d_pos == 0 || y_pos == 0 ) m_pos = 2; + else m_pos = 3; + } + break; + case 'Y': + case 'y': + if( y_pos == 0 ) + { + if( m_pos == 0 && d_pos == 0 ) y_pos = 1; + else if( m_pos == 0 || d_pos == 0 ) y_pos = 2; + else y_pos = 3; + } + } + } + + size = strlen( szDate ); + + for( count = 0; count < size; count++ ) + { + digit = szDate[ count ]; + if( isdigit( digit ) ) + { + if( d_pos == 1 ) + d_value = ( d_value * 10 ) + digit - '0'; + else if( m_pos == 1 ) + m_value = ( m_value * 10 ) + digit - '0'; + else if( y_pos == 1 ) + y_value = ( y_value * 10 ) + digit - '0'; + } + else if( digit != ' ' ) + { + d_pos--; + m_pos--; + y_pos--; + } + } + + if( y_value >= 0 && y_value < 100 ) + { + count = hb_set.HB_SET_EPOCH % 100; + digit = hb_set.HB_SET_EPOCH / 100; + + if( y_value >= count ) + y_value += ( digit * 100 ); + else + y_value += ( ( digit * 100 ) + 100 ); + } + } + + sprintf( szDateFormat, "%04i%02i%02i", y_value, m_value, d_value ); + + hb_retds( szDateFormat ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1119, NULL, "CTOD" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +HARBOUR HB_DTOC( void ) +{ + if( ISDATE( 1 ) ) + { + char szDate[ 9 ]; + char szFormatted[ 11 ]; + + hb_retc( hb_dtoc( hb_pardsbuff( szDate, 1 ), szFormatted, hb_set.HB_SET_DATEFORMAT ) ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1118, NULL, "DTOC" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +HARBOUR HB_DTOS( void ) +{ + if( ISDATE( 1 ) ) + { + char szDate[ 9 ]; + + hb_retc( hb_pardsbuff( szDate, 1 ) ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1120, NULL, "DTOS" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +#ifdef HB_COMPAT_XPP + +/* NOTE: XBase++ compatible function */ +/* NOTE: XBase++ checks for the parameter count at compile time */ + +HARBOUR HB_STOD( void ) +{ + hb_retds( hb_parc( 1 ) ); +} + +#endif + +/* NOTE: Harbour extension, exactly the same as STOD(). */ + +HARBOUR HB_HB_STOD( void ) +{ + hb_retds( hb_parc( 1 ) ); +} + +HARBOUR HB_YEAR( void ) +{ + PHB_ITEM pDate = hb_param( 1, IT_DATE ); + + if( pDate ) + { + long lDay, lMonth, lYear; + + hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear ); + + hb_retnllen( lYear, 5 ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1112, NULL, "YEAR" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +HARBOUR HB_MONTH( void ) +{ + PHB_ITEM pDate = hb_param( 1, IT_DATE ); + + if( pDate ) + { + long lDay, lMonth, lYear; + + hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear ); + + hb_retnllen( lMonth, 3 ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1113, NULL, "MONTH" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +HARBOUR HB_DAY( void ) +{ + PHB_ITEM pDate = hb_param( 1, IT_DATE ); + + if( pDate ) + { + long lDay, lMonth, lYear; + + hb_dateDecode( hb_itemGetDL( pDate ), &lDay, &lMonth, &lYear ); + + hb_retnllen( lDay, 3 ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1114, NULL, "DAY" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +HARBOUR HB_TIME( void ) +{ + char szResult[ 9 ]; + + #if defined(_Windows) || defined(WINNT) || defined(_WIN32) + SYSTEMTIME st; + GetLocalTime( &st ); + sprintf( szResult, "%02d:%02d:%02d", st.wHour, st.wMinute, st.wSecond ); + #else + time_t t; + struct tm * oTime; + + time( &t ); + oTime = localtime( &t ); + sprintf( szResult, "%02d:%02d:%02d", oTime->tm_hour, oTime->tm_min, oTime->tm_sec ); + #endif + + hb_retclen( szResult, 8 ); +} + +HARBOUR HB_DATE( void ) +{ + char szResult[ 9 ]; + + #if defined(_Windows) || defined(WINNT) || defined(_WIN32) + SYSTEMTIME st; + GetLocalTime( &st ); + sprintf( szResult, "%04d%02d%02d", st.wYear, st.wMonth, st.wDay ); + #else + time_t t; + struct tm * oTime; + + time( &t ); + oTime = localtime( &t ); + sprintf( szResult, "%04d%02d%02d", oTime->tm_year + 1900, oTime->tm_mon + 1, oTime->tm_mday ); + #endif + + hb_retds( szResult ); +} + +HARBOUR HB_DOW( void ) +{ + PHB_ITEM pDate = hb_param( 1, IT_DATE ); + + if( pDate ) + { + long lDate = hb_itemGetDL( pDate ); + + if( lDate ) + { + long lDay, lMonth, lYear; + + hb_dateDecode( lDate, &lDay, &lMonth, &lYear ); + + hb_retnllen( hb_dow( lDay, lMonth, lYear ), 3 ); + } + else + hb_retnllen( 0, 3 ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1115, NULL, "DOW" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + diff --git a/harbour/source/rtl/defpath.c b/harbour/source/rtl/defpath.c new file mode 100644 index 0000000000..40d7512635 --- /dev/null +++ b/harbour/source/rtl/defpath.c @@ -0,0 +1,77 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * DEFPATH(), __DEFPATH() functions + * + * Copyright 1999 Jose Lalin + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbset.h" + +HARBOUR HB_DEFPATH( void ) +{ + char buffer[ _POSIX_PATH_MAX ]; + char delimiter[ 2 ] = ":"; + int size; + + if( hb_set.HB_SET_DEFAULT ) + { + /* Leave enough space to append a path delimiter */ + strncpy( buffer, hb_set.HB_SET_DEFAULT, sizeof( buffer ) - 1 ); + size = sizeof( buffer ) - 2; + } + buffer[ size ] = '\0'; + size = strlen( buffer ); + + HB_TRACE(HB_TR_INFO, ("HB_DEFPATH: buffer is |%s|, size is %d, last char is |%c|", buffer, size, buffer[ size - 1])); + HB_TRACE(HB_TR_INFO, ("HB_DEFPATH: OS_PATH_DELIMITER is |%c| and OS_PATH_LIST_SEPARATOR is |%c|", OS_PATH_DELIMITER, OS_PATH_LIST_SEPARATOR)); + + /* If the path is not empty and it doesn't end with a drive or path + delimiter, then add the appropriate separator. Use ':' if the size + of the path is 1 and the list separator is not ':', otherwise use + the path delimiter. This allows the use of a drive letter delimiter + for DOS compatible operating systems while preventing it from being + with a Unix compatible OS. */ + if( size && buffer[ size - 1 ] != ':' && buffer[ size - 1 ] != OS_PATH_DELIMITER ) + { + if( size > 1 || OS_PATH_LIST_SEPARATOR == ':' ) + delimiter[ 0 ] = OS_PATH_DELIMITER; + strcat( buffer, delimiter ); + } + + hb_retc( buffer ); +} + +HARBOUR HB___DEFPATH( void ) +{ + HB_DEFPATH(); +} + diff --git a/harbour/source/rtl/do.c b/harbour/source/rtl/do.c index f6f8fc0e80..4335f47cca 100644 --- a/harbour/source/rtl/do.c +++ b/harbour/source/rtl/do.c @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * DO(), EVAL() functions and DO command + * EVAL() functions and DO command * * Copyright 1999 Ryszard Glab * www - http://www.harbour-project.org @@ -92,30 +92,3 @@ HARBOUR HB_DO( void ) } } -HARBOUR HB_EVAL( void ) -{ - USHORT uiPCount = hb_pcount(); - PHB_ITEM pItem = hb_param( 1, IT_BLOCK ); - - if( pItem ) - { - USHORT uiParam; - - hb_vmPushSymbol( &hb_symEval ); - hb_vmPush( pItem ); - for( uiParam = 2; uiParam <= uiPCount; uiParam++ ) - hb_vmPush( hb_param( uiParam, IT_ANY ) ); - hb_vmDo( uiPCount - 1 ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, "EVAL" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - diff --git a/harbour/source/rtl/environ.c b/harbour/source/rtl/environ.c index aa9b8dfcab..666ab35827 100644 --- a/harbour/source/rtl/environ.c +++ b/harbour/source/rtl/environ.c @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * Environment functions (OS(), VERSION(), __RUN(), GETENV(), etc.) + * OS(), VERSION() functions * * Copyright 1999 {list of individual authors and e-mail addresses} * www - http://www.harbour-project.org @@ -37,12 +37,6 @@ * The following parts are Copyright of the individual authors. * www - http://www.harbour-project.org * - * Copyright 1999 Eddie Runia - * HB___RUN() - * - * Copyright 1999 Victor Szakats - * HB_GETE() - * * Copyright 1999 Luiz Rafael Culik * Support for determining the window version by * @@ -502,48 +496,3 @@ HARBOUR HB_VERSION( void ) hb_xfree( pszVersion ); } -HARBOUR HB_GETENV( void ) -{ - if( hb_pcount() == 1 ) - { - char * szName = hb_parc( 1 ); - ULONG ulName = hb_parclen( 1 ); - - while( ulName && szName[ ulName - 1 ] == '=' ) - { - /* strip the '=' or else it will clear the variable! */ - szName[ ulName - 1 ] = '\0'; - ulName--; - } - - if( ulName ) - { - char * szValue = getenv( szName ); - char * szDefault = hb_parc( 2 ) ? hb_parc( 2 ) : ""; - - hb_retc( szValue ? szValue : szDefault ); - } - else - hb_retc( "" ); - } - else - hb_retc( "" ); -} - -/* NOTE: Undocumented Clipper function. [vszakats] */ - -HARBOUR HB_GETE( void ) -{ - HB_GETENV(); -} - -HARBOUR HB___RUN( void ) -{ -#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(_MSC_VER) || defined(__IBMCPP__) || defined(__GNUC__) - if( ISCHAR( 1 ) ) - system( hb_parc( 1 ) ); -#else - hb_errRT_BASE_Ext1( EG_UNSUPPORTED, 9999, NULL, "__RUN", 0, EF_CANDEFAULT ); -#endif -} - diff --git a/harbour/source/rtl/eval.c b/harbour/source/rtl/eval.c new file mode 100644 index 0000000000..92fc695e8b --- /dev/null +++ b/harbour/source/rtl/eval.c @@ -0,0 +1,67 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * EVAL() functions and DO command + * + * Copyright 1999 Ryszard Glab + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" +#include "hbvm.h" + +HARBOUR HB_EVAL( void ) +{ + USHORT uiPCount = hb_pcount(); + PHB_ITEM pItem = hb_param( 1, IT_BLOCK ); + + if( pItem ) + { + USHORT uiParam; + + hb_vmPushSymbol( &hb_symEval ); + hb_vmPush( pItem ); + for( uiParam = 2; uiParam <= uiPCount; uiParam++ ) + hb_vmPush( hb_param( uiParam, IT_ANY ) ); + hb_vmDo( uiPCount - 1 ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_NOMETHOD, 1004, NULL, "EVAL" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + diff --git a/harbour/source/rtl/filesys.c b/harbour/source/rtl/filesys.c index 6ce1f3a33d..b5d741d0c3 100644 --- a/harbour/source/rtl/filesys.c +++ b/harbour/source/rtl/filesys.c @@ -52,8 +52,6 @@ * HB_DISKCHANGE() * HB_DISKNAME() * HB_DISKSPACE() (parts by Luiz Rafael Culik ) - * HB_HB_FNAMESPLIT() - * HB_HB_FNAMEMERGE() * * Copyright 1999 Jose Lalin * hb_fsChDrv() @@ -1669,34 +1667,6 @@ HARBOUR HB_CURDRIVE( void ) #endif -HARBOUR HB_HB_FNAMESPLIT( void ) -{ - if( ISCHAR( 1 ) ) - { - PHB_FNAME pFileName = hb_fsFNameSplit( hb_parc( 1 ) ); - - hb_storc( pFileName->szPath, 2 ); - hb_storc( pFileName->szName, 3 ); - hb_storc( pFileName->szExtension, 4 ); - hb_storc( pFileName->szDrive, 5 ); - - hb_xfree( pFileName ); - } -} - -HARBOUR HB_HB_FNAMEMERGE( void ) -{ - HB_FNAME pFileName; - char szFileName[ _POSIX_PATH_MAX ]; - - pFileName.szPath = ISCHAR( 1 ) ? hb_parc( 1 ) : NULL; - pFileName.szName = ISCHAR( 2 ) ? hb_parc( 2 ) : NULL; - pFileName.szExtension = ISCHAR( 3 ) ? hb_parc( 3 ) : NULL; - pFileName.szDrive = ISCHAR( 4 ) ? hb_parc( 4 ) : NULL; - - hb_retc( hb_fsFNameMerge( szFileName, &pFileName ) ); -} - #ifdef HB_COMPAT_C53 /* NOTE: Clipper 5.3 undocumented */ diff --git a/harbour/source/rtl/fkmax.c b/harbour/source/rtl/fkmax.c new file mode 100644 index 0000000000..718c538233 --- /dev/null +++ b/harbour/source/rtl/fkmax.c @@ -0,0 +1,70 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * FKMAX(), FKLABEL() functions + * + * Copyright 1999 Victor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" + +/* Dumb function to maintain dBase III+ and CA-Cl*pper compatibility */ + +HARBOUR HB_FKMAX( void ) +{ + hb_retni( 40 ); /* IBM specific */ +} + +/* Dumb function to maintain dBase III+ and CA-Cl*pper compatibility */ + +HARBOUR HB_FKLABEL( void ) +{ + PHB_ITEM pPar1 = hb_param( 1, IT_NUMERIC ); + + if( pPar1 != NULL ) + { + USHORT uiFKey = hb_itemGetNI( pPar1 ); + + if( uiFKey > 0 && uiFKey <= 40 ) + { + char szName[ 4 ]; + + sprintf( szName, "F%i", uiFKey ); + + hb_retc( szName ); + } + else + hb_retc( "" ); + } + else + hb_retc( "" ); +} + diff --git a/harbour/source/rtl/fnsplit.c b/harbour/source/rtl/fnsplit.c new file mode 100644 index 0000000000..fb310951b2 --- /dev/null +++ b/harbour/source/rtl/fnsplit.c @@ -0,0 +1,66 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * HB_FNAMESPLIT(), HB_FNAMEMERGE() functions + * + * Copyright 1999 Victor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapifs.h" + +HARBOUR HB_HB_FNAMESPLIT( void ) +{ + if( ISCHAR( 1 ) ) + { + PHB_FNAME pFileName = hb_fsFNameSplit( hb_parc( 1 ) ); + + hb_storc( pFileName->szPath, 2 ); + hb_storc( pFileName->szName, 3 ); + hb_storc( pFileName->szExtension, 4 ); + hb_storc( pFileName->szDrive, 5 ); + + hb_xfree( pFileName ); + } +} + +HARBOUR HB_HB_FNAMEMERGE( void ) +{ + HB_FNAME pFileName; + char szFileName[ _POSIX_PATH_MAX ]; + + pFileName.szPath = ISCHAR( 1 ) ? hb_parc( 1 ) : NULL; + pFileName.szName = ISCHAR( 2 ) ? hb_parc( 2 ) : NULL; + pFileName.szExtension = ISCHAR( 3 ) ? hb_parc( 3 ) : NULL; + pFileName.szDrive = ISCHAR( 4 ) ? hb_parc( 4 ) : NULL; + + hb_retc( hb_fsFNameMerge( szFileName, &pFileName ) ); +} + diff --git a/harbour/source/rtl/getenv.c b/harbour/source/rtl/getenv.c new file mode 100644 index 0000000000..bccbd09344 --- /dev/null +++ b/harbour/source/rtl/getenv.c @@ -0,0 +1,86 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * GETENV(), GETE() functions + * + * Copyright 1999 {list of individual authors and e-mail addresses} + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 1999 Victor Szakats + * HB_GETE() + * + * See doc/license.txt for licensing terms. + * + */ + +#include "hbapi.h" + +/* NOTE: The second parameter is a Harbour extension. In CA-Cl*pper the + function will return an empty string if called with more than one + parameter. [vszakats] */ + +HARBOUR HB_GETENV( void ) +{ + if( ISCHAR( 1 ) ) + { + char * szName = hb_parc( 1 ); + ULONG ulName = hb_parclen( 1 ); + + while( ulName && szName[ ulName - 1 ] == '=' ) + { + /* strip the '=' or else it will clear the variable! */ + szName[ ulName - 1 ] = '\0'; + ulName--; + } + + if( ulName ) + { + char * szValue = getenv( szName ); + + hb_retc( szValue ? szValue : ( ( ISCHAR( 2 ) ? hb_parc( 2 ) : "" ) ) ); + } + else + hb_retc( "" ); + } + else + hb_retc( "" ); +} + +/* NOTE: Undocumented Clipper function. [vszakats] */ + +HARBOUR HB_GETE( void ) +{ + HB_GETENV(); +} + diff --git a/harbour/source/rtl/gx.c b/harbour/source/rtl/gx.c new file mode 100644 index 0000000000..12f8c2511e --- /dev/null +++ b/harbour/source/rtl/gx.c @@ -0,0 +1,66 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * NOSNOW(), SETMODE(), ISCOLOR() functions + * + * Copyright 1999 Victor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 1999 {list of individual authors and e-mail addresses} + * HB_SETMODE() + * + * See doc/license.txt for licensing terms. + * + */ + +#include "hbapi.h" +#include "hbapigt.h" + +HARBOUR HB_ISCOLOR( void ) +{ + hb_retl( hb_gtIsColor() ); +} + +HARBOUR HB_NOSNOW( void ) +{ + if( ISLOG( 1 ) ) + hb_gtSetSnowFlag( hb_parl( 1 ) ); +} + +HARBOUR HB_SETMODE( void ) +{ + hb_retl( hb_gtSetMode( ISNUM( 1 ) ? hb_parni( 1 ) : ( hb_gtMaxRow() + 1 ), + ISNUM( 2 ) ? hb_parni( 2 ) : ( hb_gtMaxCol() + 1 ) ) == 0 ); +} + diff --git a/harbour/source/rtl/inkey.c b/harbour/source/rtl/inkey.c index df52b72170..692e1e9ee8 100644 --- a/harbour/source/rtl/inkey.c +++ b/harbour/source/rtl/inkey.c @@ -1036,35 +1036,3 @@ HARBOUR HB_LASTKEY( void ) hb_retni( s_inkeyLast ); } -/* Dumb function to maintain dBase III+ and CA-Cl*pper compatibility */ - -HARBOUR HB_FKLABEL( void ) -{ - PHB_ITEM pPar1 = hb_param( 1, IT_NUMERIC ); - - if( pPar1 != NULL ) - { - USHORT uiFKey = hb_itemGetNI( pPar1 ); - - if( uiFKey > 0 && uiFKey <= 40 ) - { - char szName[ 4 ]; - - sprintf( szName, "F%i", uiFKey ); - - hb_retc( szName ); - } - else - hb_retc( "" ); - } - else - hb_retc( "" ); -} - -/* Dumb function to maintain dBase III+ and CA-Cl*pper compatibility */ - -HARBOUR HB_FKMAX( void ) -{ - hb_retni( 40 ); /* IBM specific */ -} - diff --git a/harbour/source/rtl/left.c b/harbour/source/rtl/left.c new file mode 100644 index 0000000000..8526765c6a --- /dev/null +++ b/harbour/source/rtl/left.c @@ -0,0 +1,69 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * LEFT() function + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* returns the left-most n characters in string */ + +HARBOUR HB_LEFT( void ) +{ + PHB_ITEM pText = hb_param( 1, IT_STRING ); + + if( pText && ISNUM( 2 ) ) + { + long lLen = hb_parnl( 2 ); + + if( lLen > ( long ) hb_itemGetCLen( pText ) ) + lLen = ( long ) hb_itemGetCLen( pText ); + + else if( lLen < 0 ) + lLen = 0; + + hb_retclen( hb_itemGetCPtr( pText ), lLen ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1124, NULL, "LEFT" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + diff --git a/harbour/source/rtl/lennum.c b/harbour/source/rtl/lennum.c new file mode 100644 index 0000000000..62e3c631e3 --- /dev/null +++ b/harbour/source/rtl/lennum.c @@ -0,0 +1,58 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * LENNUM() compatibility function from the SAMPLES directory of Clipper. + * + * Copyright 1999 Victor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" + +HARBOUR HB_LENNUM( void ) +{ + PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); + ULONG ulLen = 0; + + if( pNumber ) + { + char * pszString = hb_itemStr( pNumber, NULL, NULL ); + + if( pszString ) + { + ulLen = strlen( pszString ); + hb_strLTrim( pszString, &ulLen ); + hb_xfree( pszString ); + } + } + + hb_retnl( ulLen ); +} + diff --git a/harbour/source/rtl/math.c b/harbour/source/rtl/math.c index b3b5952f30..2e1212d7dd 100644 --- a/harbour/source/rtl/math.c +++ b/harbour/source/rtl/math.c @@ -33,18 +33,8 @@ * */ -/* - * The following parts are Copyright of the individual authors. - * www - http://www.harbour-project.org - * - * Copyright 1999 David G. Holm - * HB_ROUND() - * - * See doc/license.txt for licensing terms. - * - */ - #include + #include "hbapi.h" #include "hbapiitm.h" #include "hbapierr.h" @@ -107,54 +97,6 @@ int matherr( struct exception * err ) } #endif -HARBOUR HB_ABS( void ) -{ - PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); - - if( pNumber ) - { - int iWidth; - int iDec; - - hb_itemGetNLen( pNumber, &iWidth, &iDec ); - - if( IS_INTEGER( pNumber ) ) - { - int iNumber = hb_itemGetNI( pNumber ); - - if( iNumber >= 0 ) - hb_retnilen( iNumber, iWidth ); - else - hb_retni( -iNumber ); - } - else if( IS_LONG( pNumber ) ) - { - long lNumber = hb_itemGetNL( pNumber ); - - if( lNumber >= 0 ) - hb_retnllen( lNumber, iWidth ); - else - hb_retnl( -lNumber ); - } - else if( IS_DOUBLE( pNumber ) ) - { - double dNumber = hb_itemGetND( pNumber ); - - hb_retndlen( dNumber >= 0.0 ? dNumber : -dNumber, 0, iDec ); - } - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1089, NULL, "ABS" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - HARBOUR HB_EXP( void ) { if( ISNUM( 1 ) ) @@ -192,31 +134,6 @@ HARBOUR HB_EXP( void ) } } -HARBOUR HB_INT( void ) -{ - PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); - - if( pNumber ) - { - double dNumber = hb_itemGetND( pNumber ); - int iWidth; - - hb_itemGetNLen( pNumber, &iWidth, NULL ); - - hb_retndlen( dNumber >= 0 ? floor( dNumber ) : ceil( dNumber ), iWidth, 0 ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1090, NULL, "INT" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - HARBOUR HB_LOG( void ) { if( ISNUM( 1 ) ) @@ -260,250 +177,6 @@ HARBOUR HB_LOG( void ) } } -/* returns the maximum of two date or numerics */ -HARBOUR HB_MAX( void ) -{ - PHB_ITEM p1 = hb_param( 1, IT_ANY ); - PHB_ITEM p2 = hb_param( 2, IT_ANY ); - - if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) ) - { - /* NOTE: The order of these if() branches is significant, */ - /* please, don't change it. [vszakats] */ - - if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) ) - { - double d1 = hb_itemGetND( p1 ); - double d2 = hb_itemGetND( p2 ); - - int iDec1; - int iDec2; - - hb_itemGetNLen( p1, NULL, &iDec1 ); - hb_itemGetNLen( p2, NULL, &iDec2 ); - - if( d1 >= d2 ) - hb_retndlen( d1, 0, iDec1 ); - else - hb_retndlen( d2, 0, iDec2 ); - } - else if( IS_LONG( p1 ) || IS_LONG( p2 ) ) - { - long l1 = hb_itemGetNL( p1 ); - long l2 = hb_itemGetNL( p2 ); - - hb_retnl( l1 >= l2 ? l1 : l2 ); - } - else - { - int i1 = hb_itemGetNI( p1 ); - int i2 = hb_itemGetNI( p2 ); - - hb_retni( i1 >= i2 ? i1 : i2 ); - } - } - else if( IS_DATE( p1 ) && IS_DATE( p2 ) ) - { - char szDate[ 9 ]; - - hb_retds( hb_itemGetDL( p1 ) >= hb_itemGetDL( p2 ) ? hb_pardsbuff( szDate, 1 ) : hb_pardsbuff( szDate, 2 ) ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1093, NULL, "MAX" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* returns the minimum of two date or numerics */ -HARBOUR HB_MIN( void ) -{ - PHB_ITEM p1 = hb_param( 1, IT_ANY ); - PHB_ITEM p2 = hb_param( 2, IT_ANY ); - - if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) ) - { - /* NOTE: The order of these if() branches is significant, */ - /* please, don't change it. [vszakats] */ - - if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) ) - { - double d1 = hb_itemGetND( p1 ); - double d2 = hb_itemGetND( p2 ); - - int iDec1; - int iDec2; - - hb_itemGetNLen( p1, NULL, &iDec1 ); - hb_itemGetNLen( p2, NULL, &iDec2 ); - - if( d1 <= d2 ) - hb_retndlen( d1, 0, iDec1 ); - else - hb_retndlen( d2, 0, iDec2 ); - } - else if( IS_LONG( p1 ) || IS_LONG( p2 ) ) - { - long l1 = hb_itemGetNL( p1 ); - long l2 = hb_itemGetNL( p2 ); - - hb_retnl( l1 <= l2 ? l1 : l2 ); - } - else - { - int i1 = hb_itemGetNI( p1 ); - int i2 = hb_itemGetNI( p2 ); - - hb_retni( i1 <= i2 ? i1 : i2 ); - } - } - else if( IS_DATE( p1 ) && IS_DATE( p2 ) ) - { - char szDate[ 9 ]; - - hb_retds( hb_itemGetDL( p1 ) <= hb_itemGetDL( p2 ) ? hb_pardsbuff( szDate, 1 ) : hb_pardsbuff( szDate, 2 ) ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1092, NULL, "MIN" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* NOTE: In Clipper this is written in Clipper, see the source below, - and the error handling is NOT made here, but in the % operator. - [vszakats] */ - -/* NOTE: CA-Clipper is buggy since it relies on the fact that the errorhandler - will silently handle zero division errors. [vszakats] */ - -/* NOTE: This C version fully emulates the behaviour of the original - CA-Cl*pper version, including bugs/side-effects. [vszakats] */ - -HARBOUR HB_MOD( void ) -{ - -/* -FUNCTION MOD( cl_num, cl_base ) - LOCAL cl_result := cl_num % cl_base - - RETURN IF( cl_base = 0, cl_num, iif( cl_result * cl_base < 0, cl_result + cl_base, cl_result ) ) -*/ - - PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); - - if( pNumber && ISNUM( 2 ) ) - { - double dNumber = hb_itemGetND( pNumber ); - double dBase = hb_parnd( 2 ); /* dBase! Cool! */ - - if( dBase ) - { - double dResult = dNumber - ( ( long ) ( dNumber / dBase ) * dBase ); - - if( dResult * dBase < 0 ) - hb_retnd( dResult + dBase ); - else - hb_retnd( dResult ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ZERODIV, 1341, NULL, "%" ); - - if( pResult ) - { - int iDec; - - hb_itemRelease( pResult ); - - hb_itemGetNLen( pNumber, NULL, &iDec ); - - hb_retndlen( dNumber, 0, iDec ); - } - } - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1085, NULL, "%" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -double hb_numRound( double dResult, int iDec ) -{ - HB_TRACE(HB_TR_DEBUG, ("hb_numRound(%lf, %d)", dResult, iDec)); - - if( dResult != 0.0 ) - { - if( iDec == 0 ) - { - if( dResult < 0.0 ) - dResult = ceil( dResult - 0.5 ); - else - dResult = floor( dResult + 0.5 ); - } - else if( iDec < 0 ) - { - double dAdjust = pow( 10, -iDec ); - - if( dResult < 0.0 ) - dResult = ceil( ( dResult / dAdjust ) - 0.5 ); - else - dResult = floor( ( dResult / dAdjust ) + 0.5 ); - - dResult *= dAdjust; - } - else - { - double dAdjust = pow( 10, iDec ); - - if( dResult < 0.0 ) - dResult = ceil( ( dResult * dAdjust ) - 0.5 ); - else - dResult = floor( ( dResult * dAdjust ) + 0.5 ); - - dResult /= dAdjust; - } - } - - return dResult; -} - -HARBOUR HB_ROUND( void ) -{ - if( ISNUM( 1 ) && ISNUM( 2 ) ) - { - int iDec = hb_parni( 2 ); - - hb_retndlen( hb_numRound( hb_parnd( 1 ), iDec ), 0, HB_MAX_( iDec, 0 ) ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1094, NULL, "ROUND" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - HARBOUR HB_SQRT( void ) { if( ISNUM( 1 ) ) diff --git a/harbour/source/rtl/maxrow.c b/harbour/source/rtl/maxrow.c new file mode 100644 index 0000000000..6390f9f76d --- /dev/null +++ b/harbour/source/rtl/maxrow.c @@ -0,0 +1,47 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * MAXROW(), MAXCOL() functions + * + * Copyright 1999 David G. Holm + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapigt.h" + +HARBOUR HB_MAXROW( void ) /* Return the maximum screen row number (zero origin) */ +{ + hb_retni( hb_gtMaxRow() ); +} + +HARBOUR HB_MAXCOL( void ) /* Return the maximum screen column number (zero origin) */ +{ + hb_retni( hb_gtMaxCol() ); +} diff --git a/harbour/source/rtl/minmax.c b/harbour/source/rtl/minmax.c new file mode 100644 index 0000000000..bf32b7cbbb --- /dev/null +++ b/harbour/source/rtl/minmax.c @@ -0,0 +1,159 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * MIN(), MAX() functions + * + * Copyright 1999 {list of individual authors and e-mail addresses} + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* returns the maximum of two date or numerics */ +HARBOUR HB_MAX( void ) +{ + PHB_ITEM p1 = hb_param( 1, IT_ANY ); + PHB_ITEM p2 = hb_param( 2, IT_ANY ); + + if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) ) + { + /* NOTE: The order of these if() branches is significant, */ + /* please, don't change it. [vszakats] */ + + if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) ) + { + double d1 = hb_itemGetND( p1 ); + double d2 = hb_itemGetND( p2 ); + + int iDec1; + int iDec2; + + hb_itemGetNLen( p1, NULL, &iDec1 ); + hb_itemGetNLen( p2, NULL, &iDec2 ); + + if( d1 >= d2 ) + hb_retndlen( d1, 0, iDec1 ); + else + hb_retndlen( d2, 0, iDec2 ); + } + else if( IS_LONG( p1 ) || IS_LONG( p2 ) ) + { + long l1 = hb_itemGetNL( p1 ); + long l2 = hb_itemGetNL( p2 ); + + hb_retnl( l1 >= l2 ? l1 : l2 ); + } + else + { + int i1 = hb_itemGetNI( p1 ); + int i2 = hb_itemGetNI( p2 ); + + hb_retni( i1 >= i2 ? i1 : i2 ); + } + } + else if( IS_DATE( p1 ) && IS_DATE( p2 ) ) + { + char szDate[ 9 ]; + + hb_retds( hb_itemGetDL( p1 ) >= hb_itemGetDL( p2 ) ? hb_pardsbuff( szDate, 1 ) : hb_pardsbuff( szDate, 2 ) ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1093, NULL, "MAX" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +/* returns the minimum of two date or numerics */ +HARBOUR HB_MIN( void ) +{ + PHB_ITEM p1 = hb_param( 1, IT_ANY ); + PHB_ITEM p2 = hb_param( 2, IT_ANY ); + + if( IS_NUMERIC( p1 ) && IS_NUMERIC( p2 ) ) + { + /* NOTE: The order of these if() branches is significant, */ + /* please, don't change it. [vszakats] */ + + if( IS_DOUBLE( p1 ) || IS_DOUBLE( p2 ) ) + { + double d1 = hb_itemGetND( p1 ); + double d2 = hb_itemGetND( p2 ); + + int iDec1; + int iDec2; + + hb_itemGetNLen( p1, NULL, &iDec1 ); + hb_itemGetNLen( p2, NULL, &iDec2 ); + + if( d1 <= d2 ) + hb_retndlen( d1, 0, iDec1 ); + else + hb_retndlen( d2, 0, iDec2 ); + } + else if( IS_LONG( p1 ) || IS_LONG( p2 ) ) + { + long l1 = hb_itemGetNL( p1 ); + long l2 = hb_itemGetNL( p2 ); + + hb_retnl( l1 <= l2 ? l1 : l2 ); + } + else + { + int i1 = hb_itemGetNI( p1 ); + int i2 = hb_itemGetNI( p2 ); + + hb_retni( i1 <= i2 ? i1 : i2 ); + } + } + else if( IS_DATE( p1 ) && IS_DATE( p2 ) ) + { + char szDate[ 9 ]; + + hb_retds( hb_itemGetDL( p1 ) <= hb_itemGetDL( p2 ) ? hb_pardsbuff( szDate, 1 ) : hb_pardsbuff( szDate, 2 ) ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1092, NULL, "MIN" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + diff --git a/harbour/source/rtl/mod.c b/harbour/source/rtl/mod.c new file mode 100644 index 0000000000..d6d2615ea3 --- /dev/null +++ b/harbour/source/rtl/mod.c @@ -0,0 +1,101 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * MOD() function + * + * Copyright 1999 {list of individual authors and e-mail addresses} + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* NOTE: In Clipper this is written in Clipper, see the source below, + and the error handling is NOT made here, but in the % operator. + [vszakats] */ + +/* NOTE: CA-Clipper is buggy since it relies on the fact that the errorhandler + will silently handle zero division errors. [vszakats] */ + +/* NOTE: This C version fully emulates the behaviour of the original + CA-Cl*pper version, including bugs/side-effects. [vszakats] */ + +HARBOUR HB_MOD( void ) +{ + PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); + + if( pNumber && ISNUM( 2 ) ) + { + double dNumber = hb_itemGetND( pNumber ); + double dBase = hb_parnd( 2 ); /* dBase! Cool! */ + + if( dBase ) + { + double dResult = dNumber - ( ( long ) ( dNumber / dBase ) * dBase ); + + if( dResult * dBase < 0 ) + hb_retnd( dResult + dBase ); + else + hb_retnd( dResult ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ZERODIV, 1341, NULL, "%" ); + + if( pResult ) + { + int iDec; + + hb_itemRelease( pResult ); + + hb_itemGetNLen( pNumber, NULL, &iDec ); + + hb_retndlen( dNumber, 0, iDec ); + } + } + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1085, NULL, "%" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +/* +FUNCTION MOD( cl_num, cl_base ) + LOCAL cl_result := cl_num % cl_base + + RETURN IF( cl_base = 0, cl_num, iif( cl_result * cl_base < 0, cl_result + cl_base, cl_result ) ) +*/ diff --git a/harbour/source/rtl/pad.c b/harbour/source/rtl/pad.c new file mode 100644 index 0000000000..0b18d91ce0 --- /dev/null +++ b/harbour/source/rtl/pad.c @@ -0,0 +1,227 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * PAD*() functions + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" +#include "hbset.h" +#include "hbdate.h" + +/* This function is used by all of the PAD functions to prepare the argument + being padded. If date, convert to string using hb_dtoc(). If numeric, + convert to unpadded string. Return pointer to string and set string length */ + +static char * hb_itemPadConv( PHB_ITEM pItem, char * buffer, ULONG * pulSize ) +{ + char * szText; + + HB_TRACE(HB_TR_DEBUG, ("hb_itemPadCond(%p, %p, %p)", pItem, buffer, pulSize)); + + if( pItem ) + { + if( IS_STRING( pItem ) ) + { + szText = hb_itemGetCPtr( pItem ); + *pulSize = hb_itemGetCLen( pItem ); + } + else if( IS_DATE( pItem ) ) + { + char szDate[ 9 ]; + + szText = hb_dtoc( hb_pardsbuff( szDate, 1 ), buffer, hb_set.HB_SET_DATEFORMAT ); + *pulSize = strlen( szText ); + } + else if( IS_INTEGER( pItem ) ) + { + sprintf( buffer, "%d", hb_itemGetNI( pItem ) ); + szText = buffer; + *pulSize = strlen( szText ); + } + else if( IS_LONG( pItem ) ) + { + sprintf( buffer, "%ld", hb_itemGetNL( pItem ) ); + szText = buffer; + *pulSize = strlen( szText ); + } + else if( IS_DOUBLE( pItem ) ) + { + int iDecimal; + + hb_itemGetNLen( pItem, NULL, &iDecimal ); + sprintf( buffer, "%.*f", iDecimal, hb_itemGetND( pItem ) ); + szText = buffer; + *pulSize = strlen( szText ); + } + else + szText = NULL; + } + else + szText = NULL; + + return szText; +} + +/* right-pads a date, number, or string with spaces or supplied character */ +/* TEST: QOUT( "padr( 'hello', 10 ) = '" + padr( 'hello', 10 ) + "'" ) */ +HARBOUR HB_PADR( void ) +{ + ULONG ulSize; + char buffer[ 128 ]; + char * szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize ); + + if( szText && ISNUM( 2 ) ) + { + long lLen = hb_parnl( 2 ); + + if( lLen > ( long ) ulSize ) + { + char * szResult = ( char * ) hb_xgrab( lLen + 1 ); + long lPos; + char cPad; + + hb_xmemcpy( szResult, szText, ( long ) ulSize ); + + cPad = ( ISCHAR( 3 ) ? *( hb_parc( 3 ) ) : ' ' ); + + for( lPos = ( long ) ulSize; lPos < lLen; lPos++ ) + szResult[ lPos ] = cPad; + + hb_retclen( szResult, ( ULONG ) lLen ); + hb_xfree( szResult ); + } + else + { + if( lLen < 0 ) + lLen = 0; + + hb_retclen( szText, lLen ); + } + } + else + hb_retc( "" ); +} + +/* synonymn for PADR */ +HARBOUR HB_PAD( void ) +{ + HB_PADR(); +} + +/* left-pads a date, number, or string with spaces or supplied character */ +/* TEST: QOUT( "padl( 'hello', 10 ) = '" + padl( 'hello', 10 ) + "'" ) */ +HARBOUR HB_PADL( void ) +{ + ULONG ulSize; + char buffer[ 128 ]; + char * szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize ); + + if( szText && ISNUM( 2 ) ) + { + long lLen = hb_parnl( 2 ); + + if( lLen > ( long ) ulSize ) + { + char * szResult = ( char * ) hb_xgrab( lLen + 1 ); + long lPos = lLen - ( long ) ulSize; + char cPad; + + hb_xmemcpy( szResult + lPos, szText, ( long ) ulSize ); + + cPad = ( ISCHAR( 3 ) ? *( hb_parc( 3 ) ) : ' '); + + for(; lPos > 0; lPos-- ) + { + szResult[ lPos - 1 ] = cPad; + } + + hb_retclen( szResult, lLen ); + hb_xfree( szResult ); + } + else + { + if( lLen < 0 ) + lLen = 0; + + hb_retclen( szText, lLen ); + } + } + else + hb_retc( "" ); +} + +/* centre-pads a date, number, or string with spaces or supplied character */ +/* TEST: QOUT( "padc( 'hello', 10 ) = '" + padc( 'hello', 10 ) + "'" ) */ +HARBOUR HB_PADC( void ) +{ + ULONG ulSize; + char buffer[ 128 ]; + char * szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize ); + + if( szText && ISNUM( 2 ) ) + { + long lLen = hb_parnl( 2 ); + + if( lLen > ( long ) ulSize ) + { + char * szResult = ( char * ) hb_xgrab( lLen + 1 ); + char cPad; + long w, lPos = ( lLen - ( long ) ulSize ) / 2; + + hb_xmemcpy( szResult + lPos, szText, ( long ) ulSize + 1 ); + + cPad = ( ISCHAR( 3 ) ? *hb_parc( 3 ) : ' ' ); + + for( w = 0; w < lPos; w++ ) + szResult[ w ] = cPad; + + for( w = ( long ) ulSize + lPos; w < lLen; w++ ) + szResult[ w ] = cPad; + + szResult[ lLen ] = '\0'; + + hb_retclen( szResult, lLen ); + hb_xfree( szResult ); + } + else + { + if( lLen < 0 ) + lLen = 0; + + hb_retclen( szText, lLen ); + } + } + else + hb_retc( "" ); +} diff --git a/harbour/source/rtl/replic.c b/harbour/source/rtl/replic.c new file mode 100644 index 0000000000..32475928f8 --- /dev/null +++ b/harbour/source/rtl/replic.c @@ -0,0 +1,93 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * REPLICATE() function + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* returns n copies of given string */ +/* TEST: QOUT( "replicate( 'abc', 5 ) = " + replicate( 'abc', 5 ) ) */ +HARBOUR HB_REPLICATE( void ) +{ + if( ISCHAR( 1 ) && ISNUM( 2 ) ) + { + long lTimes = hb_parnl( 2 ); + + if( lTimes > 0 ) + { + ULONG ulLen = hb_parclen( 1 ); + + if( ( double ) ( ( double ) ulLen * ( double ) lTimes ) < ( double ) ULONG_MAX ) + { + char * szText = hb_parc( 1 ); + char * szResult = ( char * ) hb_xgrab( ( ulLen * lTimes ) + 1 ); + char * szPtr = szResult; + long i; + + for( i = 0; i < lTimes; i++ ) + { + hb_xmemcpy( szPtr, szText, ulLen ); + szPtr += ulLen; + } + + hb_retclen( szResult, ulLen * lTimes ); + hb_xfree( szResult ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_STROVERFLOW, 1234, NULL, "REPLICATE" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } + } + else + hb_retc( "" ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1106, NULL, "REPLICATE" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + diff --git a/harbour/source/rtl/right.c b/harbour/source/rtl/right.c new file mode 100644 index 0000000000..cb243845cd --- /dev/null +++ b/harbour/source/rtl/right.c @@ -0,0 +1,64 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * LEFT() function + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* returns the right-most n characters in string */ + +HARBOUR HB_RIGHT( void ) +{ + PHB_ITEM pText = hb_param( 1, IT_STRING ); + + if( pText && ISNUM( 2 ) ) + { + long lLen = hb_parnl( 2 ); + + if( lLen > ( long ) hb_itemGetCLen( pText ) ) + lLen = ( long ) hb_itemGetCLen( pText ); + + else if( lLen < 0 ) + lLen = 0; + + hb_retclen( hb_itemGetCPtr( pText ) + hb_itemGetCLen( pText ) - lLen, lLen ); + } + else + { + /* Clipper doesn't error */ + hb_retc( "" ); + } +} + diff --git a/harbour/source/rtl/round.c b/harbour/source/rtl/round.c new file mode 100644 index 0000000000..a34559091e --- /dev/null +++ b/harbour/source/rtl/round.c @@ -0,0 +1,136 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * ROUND(), INT() functions + * + * Copyright 1999 {list of individual authors and e-mail addresses} + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 1999 David G. Holm + * HB_ROUND() + * + * See doc/license.txt for licensing terms. + * + */ + +#include + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +HARBOUR HB_INT( void ) +{ + PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); + + if( pNumber ) + { + double dNumber = hb_itemGetND( pNumber ); + int iWidth; + + hb_itemGetNLen( pNumber, &iWidth, NULL ); + + hb_retndlen( dNumber >= 0 ? floor( dNumber ) : ceil( dNumber ), iWidth, 0 ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1090, NULL, "INT" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +double hb_numRound( double dResult, int iDec ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_numRound(%lf, %d)", dResult, iDec)); + + if( dResult != 0.0 ) + { + if( iDec == 0 ) + { + if( dResult < 0.0 ) + dResult = ceil( dResult - 0.5 ); + else + dResult = floor( dResult + 0.5 ); + } + else if( iDec < 0 ) + { + double dAdjust = pow( 10, -iDec ); + + if( dResult < 0.0 ) + dResult = ceil( ( dResult / dAdjust ) - 0.5 ); + else + dResult = floor( ( dResult / dAdjust ) + 0.5 ); + + dResult *= dAdjust; + } + else + { + double dAdjust = pow( 10, iDec ); + + if( dResult < 0.0 ) + dResult = ceil( ( dResult * dAdjust ) - 0.5 ); + else + dResult = floor( ( dResult * dAdjust ) + 0.5 ); + + dResult /= dAdjust; + } + } + + return dResult; +} + +HARBOUR HB_ROUND( void ) +{ + if( ISNUM( 1 ) && ISNUM( 2 ) ) + { + int iDec = hb_parni( 2 ); + + hb_retndlen( hb_numRound( hb_parnd( 1 ), iDec ), 0, HB_MAX_( iDec, 0 ) ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1094, NULL, "ROUND" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} diff --git a/harbour/source/rtl/run.c b/harbour/source/rtl/run.c new file mode 100644 index 0000000000..962ad8ca5a --- /dev/null +++ b/harbour/source/rtl/run.c @@ -0,0 +1,48 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * __RUN function + * + * Copyright 1999 Eddie Runia + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapierr.h" + +HARBOUR HB___RUN( void ) +{ +#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(_MSC_VER) || defined(__IBMCPP__) || defined(__GNUC__) + if( ISCHAR( 1 ) ) + system( hb_parc( 1 ) ); +#else + hb_errRT_BASE_Ext1( EG_UNSUPPORTED, 9999, NULL, "__RUN", 0, EF_CANDEFAULT ); +#endif +} + diff --git a/harbour/source/rtl/samples.c b/harbour/source/rtl/samples.c index c1c40efe39..89cc56beb9 100644 --- a/harbour/source/rtl/samples.c +++ b/harbour/source/rtl/samples.c @@ -34,7 +34,6 @@ */ #include "hbapi.h" -#include "hbapiitm.h" /* NOTE: szTime must be 9 chars large. */ @@ -81,49 +80,6 @@ static ULONG hb_TimeStrToSec( char * pszTime ) return ulTime; } -HARBOUR HB_AMPM( void ) -{ - char * pszTime = hb_parc( 1 ); - ULONG ulTimeLen = hb_parclen( 1 ); - char * pszResult = ( char * ) hb_xgrab( HB_MAX_( ulTimeLen, 2 ) + 3 + 1 ); - USHORT uiHour = ( USHORT ) hb_strVal( pszTime ); - BOOL bAM; - - memset( pszResult, '\0', 3 ); - memcpy( pszResult, pszTime, ulTimeLen ); - - if( uiHour == 0 || uiHour == 24 ) - { - if( ulTimeLen < 2 ) - ulTimeLen = 2; - - pszResult[ 0 ] = '1'; - pszResult[ 1 ] = '2'; - bAM = TRUE; - } - else if( uiHour > 12 ) - { - if( ulTimeLen < 2 ) - ulTimeLen = 2; - - uiHour -= 12; - pszResult[ 0 ] = ( char ) ( uiHour / 10 ) + '0'; - pszResult[ 1 ] = ( char ) ( uiHour % 10 ) + '0'; - - if( pszResult[ 0 ] == '0' ) - pszResult[ 0 ] = ' '; - - bAM = FALSE; - } - else - bAM = ( uiHour != 12 ); - - strcpy( pszResult + ulTimeLen, bAM ? " am" : " pm" ); - - hb_retclen( pszResult, ulTimeLen + 3 ); - hb_xfree( pszResult ); -} - HARBOUR HB_DAYS( void ) { hb_retnl( hb_parnl( 1 ) / 86400 ); @@ -138,26 +94,6 @@ HARBOUR HB_ELAPTIME( void ) hb_retc( hb_SecToTimeStr( szTime, ( ulEnd < ulStart ? 86400 : 0 ) + ulEnd - ulStart ) ); } -HARBOUR HB_LENNUM( void ) -{ - PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); - ULONG ulLen = 0; - - if( pNumber ) - { - char * pszString = hb_itemStr( pNumber, NULL, NULL ); - - if( pszString ) - { - ulLen = strlen( pszString ); - hb_strLTrim( pszString, &ulLen ); - hb_xfree( pszString ); - } - } - - hb_retnl( ulLen ); -} - HARBOUR HB_SECS( void ) { hb_retnl( hb_TimeStrToSec( hb_parc( 1 ) ) ); diff --git a/harbour/source/rtl/saverest.c b/harbour/source/rtl/saverest.c new file mode 100644 index 0000000000..2ba8cee4fe --- /dev/null +++ b/harbour/source/rtl/saverest.c @@ -0,0 +1,66 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * SAVESCREEN(), RESTSCREEN() functions + * + * Copyright 1999 {list of individual authors and e-mail addresses} + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapigt.h" + +HARBOUR HB_SAVESCREEN( void ) +{ + USHORT uiX; + USHORT uiCoords[ 4 ]; + void * pBuffer; + + uiCoords[ 0 ] = ISNUM( 1 ) ? hb_parni( 1 ) : 0; + uiCoords[ 1 ] = ISNUM( 2 ) ? hb_parni( 2 ) : 0; + uiCoords[ 2 ] = ISNUM( 3 ) ? hb_parni( 3 ) : hb_gtMaxRow(); + uiCoords[ 3 ] = ISNUM( 4 ) ? hb_parni( 4 ) : hb_gtMaxCol(); + + hb_gtRectSize( uiCoords[ 0 ], uiCoords[ 1 ], uiCoords[ 2 ], uiCoords[ 3 ], &uiX ); + pBuffer = hb_xgrab( uiX ); + hb_gtSave( uiCoords[ 0 ], uiCoords[ 1 ], uiCoords[ 2 ], uiCoords[ 3 ], pBuffer ); + hb_retclen( ( char * ) pBuffer, uiX ); + hb_xfree( ( char * ) pBuffer ); +} + +HARBOUR HB_RESTSCREEN( void ) +{ + if( ISCHAR( 5 ) ) + hb_gtRest( ISNUM( 1 ) ? hb_parni( 1 ) : 0, + ISNUM( 2 ) ? hb_parni( 2 ) : 0, + ISNUM( 3 ) ? hb_parni( 3 ) : hb_gtMaxRow(), + ISNUM( 4 ) ? hb_parni( 4 ) : hb_gtMaxCol(), + ( void * ) hb_parc( 5 ) ); +} + diff --git a/harbour/source/rtl/seconds.c b/harbour/source/rtl/seconds.c new file mode 100644 index 0000000000..8d9d6669a9 --- /dev/null +++ b/harbour/source/rtl/seconds.c @@ -0,0 +1,72 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * SECONDS() function + * + * Copyright 1999 Jose Lalin + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" + +#include +#if defined( OS_UNIX_COMPATIBLE ) + #include +#else + #include +#endif +#if defined(__TURBOC__) || defined(__BORLANDC__) || defined(__DJGPP__) + #include +#endif + +double hb_secondsToday( void ) +{ +#if defined(_MSC_VER) + #define timeb _timeb + #define ftime _ftime +#endif + struct timeb tb; + struct tm * oTime; + + HB_TRACE(HB_TR_DEBUG, ("hb_secondsToday()")); + + ftime( &tb ); + oTime = localtime( &tb.time ); + + return ( oTime->tm_hour * 3600 ) + + ( oTime->tm_min * 60 ) + + oTime->tm_sec + + ( ( double ) tb.millitm / 1000 ); +} + +HARBOUR HB_SECONDS( void ) +{ + hb_retnd( hb_secondsToday() ); +} + diff --git a/harbour/source/rtl/set.c b/harbour/source/rtl/set.c index c969b8bb97..29d011952a 100644 --- a/harbour/source/rtl/set.c +++ b/harbour/source/rtl/set.c @@ -33,17 +33,6 @@ * */ -/* - * The following parts are Copyright of the individual authors. - * www - http://www.harbour-project.org - * - * Copyright 1999 Jose Lalin - * HB_DEFPATH() and HB___DEFPATH() - * - * See doc/license.txt for licensing terms. - * - */ - /* * ChangeLog: * @@ -191,6 +180,7 @@ */ #include + #include "hbapi.h" #include "hbapiitm.h" #include "hbapierr.h" @@ -853,41 +843,3 @@ void hb_setRelease( void ) hb_set.HB_SET_TYPEAHEAD = -1; hb_inkeyReset( TRUE ); /* Free keyboard typeahead buffer */ } -HARBOUR HB_DEFPATH( void ) -{ - char buffer[ _POSIX_PATH_MAX ]; - char delimiter[ 2 ] = ":"; - int size = 0; - - if( hb_set.HB_SET_DEFAULT ) - { - /* Leave enough space to append a path delimiter */ - strncpy( buffer, hb_set.HB_SET_DEFAULT, sizeof( buffer ) - 1 ); - size = sizeof( buffer ) - 2; - } - buffer[ size ] = '\0'; - size = strlen( buffer ); - - HB_TRACE(HB_TR_INFO, ("HB_DEFPATH: buffer is |%s|, size is %d, last char is |%c|", buffer, size, buffer[ size - 1])); - HB_TRACE(HB_TR_INFO, ("HB_DEFPATH: OS_PATH_DELIMITER is |%c| and OS_PATH_LIST_SEPARATOR is |%c|", OS_PATH_DELIMITER, OS_PATH_LIST_SEPARATOR)); - - /* If the path is not empty and it doesn't end with a drive or path - delimiter, then add the appropriate separator. Use ':' if the size - of the path is 1 and the list separator is not ':', otherwise use - the path delimiter. This allows the use of a drive letter delimiter - for DOS compatible operating systems while preventing it from being - with a Unix compatible OS. */ - if( size && buffer[ size - 1 ] != ':' && buffer[ size - 1 ] != OS_PATH_DELIMITER ) - { - if( size > 1 || OS_PATH_LIST_SEPARATOR == ':' ) - delimiter[ 0 ] = OS_PATH_DELIMITER; - strcat( buffer, delimiter ); - } - hb_retc( buffer ); -} - -HARBOUR HB___DEFPATH( void ) -{ - HB_DEFPATH(); -} - diff --git a/harbour/source/rtl/setcolor.c b/harbour/source/rtl/setcolor.c index cf074eace8..c893cbd52c 100644 --- a/harbour/source/rtl/setcolor.c +++ b/harbour/source/rtl/setcolor.c @@ -59,3 +59,15 @@ HARBOUR HB_COLORSELECT( void ) if( ISNUM( 1 ) ) hb_gtColorSelect( hb_parni( 1 ) ); } + +HARBOUR HB_SETBLINK( void ) +{ + BOOL bPreviousBlink; + + hb_gtGetBlink( &bPreviousBlink ); + if( ISLOG( 1 ) ) + hb_gtSetBlink( hb_parl( 1 ) ); + + hb_retl( bPreviousBlink ); +} + diff --git a/harbour/source/rtl/setcurs.c b/harbour/source/rtl/setcurs.c new file mode 100644 index 0000000000..209d065283 --- /dev/null +++ b/harbour/source/rtl/setcurs.c @@ -0,0 +1,55 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * SETCURSOR() function + * + * Copyright 1999 {list of individual authors and e-mail addresses} + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapigt.h" + +USHORT hb_setCursor( BOOL bSetCursor, USHORT usNewCursor ) +{ + USHORT usPreviousCursor; + + HB_TRACE(HB_TR_DEBUG, ("hb_setCursor(%d, %hu)", (int) bSetCursor, usNewCursor)); + + hb_gtGetCursor( &usPreviousCursor ); + if( bSetCursor ) + hb_gtSetCursor( usNewCursor ); + + return usPreviousCursor; +} + +HARBOUR HB_SETCURSOR( void ) +{ + hb_retni( hb_setCursor( ISNUM( 1 ), hb_parni( 1 ) ) ); +} diff --git a/harbour/source/rtl/setpos.c b/harbour/source/rtl/setpos.c new file mode 100644 index 0000000000..01c6a9ab40 --- /dev/null +++ b/harbour/source/rtl/setpos.c @@ -0,0 +1,88 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * SETPOS(), SETPOSBS() functions + * + * Copyright 1999 {list of individual authors and e-mail addresses} + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 1999 David G. Holm + * HB_SETPOS() + * + * Copyright 1999 Victor Szakats + * HB_SETPOSBS() + * + * See doc/license.txt for licensing terms. + * + */ + +#include "hbapi.h" +#include "hbapigt.h" + +HARBOUR HB_SETPOS( void ) /* Sets the screen position */ +{ + if( ISNUM( 1 ) && ISNUM( 2 ) ) + hb_gtSetPos( hb_parni( 1 ), hb_parni( 2 ) ); +} + +/* Move the screen position to the right by one column */ +HARBOUR HB_SETPOSBS( void ) +{ + SHORT iRow, iCol; + + /* NOTE: Clipper does no checks about reaching the border or anything. + [vszakats] */ + hb_gtGetPos( &iRow, &iCol ); + hb_gtSetPos( iRow, iCol + 1 ); +} + +HARBOUR HB_ROW( void ) /* Return the current screen row position (zero origin) */ +{ + SHORT iRow; + SHORT iCol; + + hb_gtGetPos( &iRow, &iCol ); + + hb_retni( iRow ); +} + +HARBOUR HB_COL( void ) /* Return the current screen column position (zero origin) */ +{ + SHORT iRow; + SHORT iCol; + + hb_gtGetPos( &iRow, &iCol ); + + hb_retni( iCol ); +} diff --git a/harbour/source/rtl/shadow.c b/harbour/source/rtl/shadow.c new file mode 100644 index 0000000000..605ae8d92e --- /dev/null +++ b/harbour/source/rtl/shadow.c @@ -0,0 +1,53 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * HB_SHADOW(), DBGSHADOW() functions + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapigt.h" + +HARBOUR HB_HB_SHADOW( void ) +{ + if( hb_pcount() >= 4 ) + hb_gtDrawShadow( hb_parni( 1 ), + hb_parni( 2 ), + hb_parni( 3 ), + hb_parni( 4 ), + ISNUM( 5 ) ? hb_parni( 5 ) : 7 ); +} + +HARBOUR HB_DBGSHADOW( void ) +{ + HB_HB_SHADOW(); +} + diff --git a/harbour/source/rtl/space.c b/harbour/source/rtl/space.c new file mode 100644 index 0000000000..92c107749a --- /dev/null +++ b/harbour/source/rtl/space.c @@ -0,0 +1,74 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * SPACE() function + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* returns n copies of a single space */ +/* TEST: QOUT( "space( 5 ) = '" + space( 5 ) + "'" ) */ +HARBOUR HB_SPACE( void ) +{ + if( ISNUM( 1 ) ) + { + long lLen = hb_parnl( 1 ); + + if( lLen > 0 ) + { + char * szResult = ( char * ) hb_xgrab( lLen + 1 ); + + /* NOTE: String overflow could never occure since a string can + be as large as ULONG_MAX, and the maximum length that + can be specified is LONG_MAX here. [vszakats] */ + /* hb_errRT_BASE( EG_STROVERFLOW, 1233, NULL, "SPACE" ); */ + + hb_xmemset( szResult, ' ', lLen ); + hb_retclen( szResult, lLen ); + hb_xfree( szResult ); + } + else + hb_retc( "" ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1105, NULL, "SPACE" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} diff --git a/harbour/source/rtl/str.c b/harbour/source/rtl/str.c new file mode 100644 index 0000000000..3b0957ee98 --- /dev/null +++ b/harbour/source/rtl/str.c @@ -0,0 +1,99 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * STR() function + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* returns the numeric value of a character string representation of a number */ +double hb_strVal( const char * szText ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_strVal(%s)", szText)); + + return atof( szText ); +} + +HARBOUR HB_STR( void ) +{ + BOOL bValid; + PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); + PHB_ITEM pWidth = NULL; + PHB_ITEM pDec = NULL; + + if( pNumber ) + { + bValid = TRUE; + + if( hb_pcount() >= 2 ) + { + pWidth = hb_param( 2, IT_NUMERIC ); + if( !pWidth ) + bValid = FALSE; + } + + if( hb_pcount() >= 3 ) + { + pDec = hb_param( 3, IT_NUMERIC ); + if( !pDec ) + bValid = FALSE; + } + } + else + bValid = FALSE; + + if( bValid ) + { + char * szResult = hb_itemStr( pNumber, pWidth, pDec ); + + if( szResult ) + { + hb_retc( szResult ); + hb_xfree( szResult ); + } + else + hb_retc( "" ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1099, NULL, "STR" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + diff --git a/harbour/source/rtl/strcase.c b/harbour/source/rtl/strcase.c new file mode 100644 index 0000000000..9b125e6186 --- /dev/null +++ b/harbour/source/rtl/strcase.c @@ -0,0 +1,133 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Uppercase/lowercase string functions + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* converts szText to lower case. Does not create a new string! */ +char * hb_strLower( char * szText, ULONG ulLen ) +{ + ULONG i; + + HB_TRACE(HB_TR_DEBUG, ("hb_strLower(%s, %lu)", szText, ulLen)); + + for( i = 0; i < ulLen; i++ ) + szText[ i ] = tolower( szText[ i ] ); + + return szText; +} + +/* converts szText to upper case. Does not create a new string! */ +char * hb_strUpper( char * szText, ULONG ulLen ) +{ + ULONG i; + + HB_TRACE(HB_TR_DEBUG, ("hb_strUpper(%s, %lu)", szText, ulLen)); + + for( i = 0; i < ulLen; i++ ) + szText[ i ] = toupper( szText[ i ] ); + + return szText; +} + +/* This function copies and converts szText to upper case. + */ +char * hb_strncpyUpper( char * pDest, const char * pSource, ULONG ulLen ) +{ + char * pStart = pDest; + + HB_TRACE(HB_TR_DEBUG, ("hb_strncpyUpper(%p, %s, %lu)", pDest, pSource, ulLen)); + + pDest[ ulLen ] ='\0'; + while( ulLen-- ) + *pDest++ = toupper( *pSource++ ); + + return pStart; +} + +/* converts string to lower case */ +HARBOUR HB_LOWER( void ) +{ + PHB_ITEM pText = hb_param( 1, IT_STRING ); + + if( pText ) + { + char * pszBuffer = hb_itemGetC( pText ); + ULONG ulLen = hb_itemGetCLen( pText ); + + hb_retclen( hb_strLower( pszBuffer, ulLen ), ulLen ); + + hb_itemFreeC( pszBuffer ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1103, NULL, "LOWER" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +/* converts string to upper case */ +HARBOUR HB_UPPER( void ) +{ + PHB_ITEM pText = hb_param( 1, IT_STRING ); + + if( pText ) + { + char * pszBuffer = hb_itemGetC( pText ); + ULONG ulLen = hb_itemGetCLen( pText ); + + hb_retclen( hb_strUpper( pszBuffer, ulLen ), ulLen ); + + hb_itemFreeC( pszBuffer ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1102, NULL, "UPPER" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} diff --git a/harbour/source/rtl/strings.c b/harbour/source/rtl/strings.c index ba32a258c1..823a38f834 100644 --- a/harbour/source/rtl/strings.c +++ b/harbour/source/rtl/strings.c @@ -38,12 +38,10 @@ * www - http://www.harbour-project.org * * Copyright 1999 David G. Holm - * hb_stricmp() and HB_HB_VALTOSTR(). + * hb_stricmp() * * Copyright 1999 Victor Szakats * hb_strEmpty() - * hb_strMatchDOS() - * HB_STRZERO() * hb_strnicmp() * * See doc/license.txt for licensing terms. @@ -55,13 +53,6 @@ #include "hbapi.h" #include "hbapiitm.h" #include "hbapierr.h" -#include "hbset.h" -#include "hbdate.h" - -#define HB_ISSPACE( c ) ( ( c ) == ' ' || \ - ( c ) == HB_CHAR_HT || \ - ( c ) == HB_CHAR_LF || \ - ( c ) == HB_CHAR_CR ) BOOL hb_strEmpty( const char * szText, ULONG ulLen ) { @@ -139,1221 +130,3 @@ int hb_strnicmp( const char * s1, const char * s2, ULONG count ) return rc; } -static BOOL hb_strMatchDOS( const char * pszString, const char * pszMask ) -{ - HB_TRACE(HB_TR_DEBUG, ("hb_strMatchDOS(%s, %s)", pszString, pszMask)); - - while( *pszMask && *pszString ) - { - if( *pszMask == '*' ) - { - while( *pszMask == '*' ) - pszMask++; - - if( ! ( *pszMask ) ) - return TRUE; - else - if( *pszMask == '?' ) - pszString++; - else - { - while( toupper( *pszString ) != toupper( *pszMask ) ) - { - if( ! ( *( ++pszString ) ) ) - return FALSE; - } - while( toupper( *pszString ) == toupper( *pszMask ) ) - { - if( ! ( *( ++pszString ) ) ) - break; - } - pszMask++; - } - } - else - if( toupper( *pszMask ) != toupper( *pszString ) && *pszMask != '?' ) - return FALSE; - else - { - pszMask++; - pszString++; - } - } - - return ! ( ( ! ( *pszString ) && *pszMask && *pszMask != '*') || - ( ! ( *pszMask ) && *pszString ) ); -} - -/* TODO: Replace it with a code that supports real regular expressions - * - */ -BOOL hb_strMatchRegExp( const char * szString, const char * szMask ) -{ - HB_TRACE(HB_TR_DEBUG, ("hb_strMatchRegExp(%s, %s)", szString, szMask)); - - return hb_strMatchDOS( szString, szMask ); -} - -/* determines if first char of string is letter */ -/* TEST: QOUT( "isalpha( 'hello' ) = ", isalpha( 'hello' ) ) */ -/* TEST: QOUT( "isalpha( '12345' ) = ", isalpha( '12345' ) ) */ - -HARBOUR HB_ISALPHA( void ) -{ - hb_retl( isalpha( *hb_parc( 1 ) ) ); -} - -/* determines if first char of string is digit */ -/* TEST: QOUT( "isdigit( '12345' ) = ", isdigit( '12345' ) ) */ -/* TEST: QOUT( "isdigit( 'abcde' ) = ", isdigit( 'abcde' ) ) */ - -HARBOUR HB_ISDIGIT( void ) -{ - hb_retl( isdigit( *hb_parc( 1 ) ) ); -} - -/* determines if first char of string is upper-case */ -/* TEST: QOUT( "isupper( 'Abcde' ) = ", isupper( 'Abcde' ) ) */ -/* TEST: QOUT( "isupper( 'abcde' ) = ", isupper( 'abcde' ) ) */ - -HARBOUR HB_ISUPPER( void ) -{ - hb_retl( isupper( *hb_parc( 1 ) ) ); -} - -/* determines if first char of string is lower-case */ -/* TEST: QOUT( "islower( 'abcde' ) = ", islower( 'abcde' ) ) */ -/* TEST: QOUT( "islower( 'Abcde' ) = ", islower( 'Abcde' ) ) */ - -HARBOUR HB_ISLOWER( void ) -{ - hb_retl( islower( *hb_parc( 1 ) ) ); -} - -/* trims from the left, and returns a new pointer to szText */ -/* also returns the new length in lLen */ -char * hb_strLTrim( const char * szText, ULONG * ulLen ) -{ - HB_TRACE(HB_TR_DEBUG, ("hb_strLTrim(%s, %p)", szText, ulLen)); - - while( *ulLen && HB_ISSPACE( *szText ) ) - { - szText++; - ( *ulLen )--; - } - - return ( char * ) szText; -} - -/* trims leading spaces from a string */ -/* TEST: QOUT( "ltrim( ' hello world ' ) = '" + ltrim( ' hello world ' ) + "'" ) */ - -HARBOUR HB_LTRIM( void ) -{ - PHB_ITEM pText = hb_param( 1, IT_STRING ); - - if( pText ) - { - ULONG ulLen = hb_itemGetCLen( pText ); - char * szText = hb_strLTrim( hb_itemGetCPtr( pText ), &ulLen ); - - hb_retclen( szText, ulLen ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1101, NULL, "LTRIM" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* returns szText and the new length in lLen */ -ULONG hb_strRTrimLen( const char * szText, ULONG ulLen, BOOL bAnySpace ) -{ - HB_TRACE(HB_TR_DEBUG, ("hb_strRTrimLen(%s, %lu. %d)", szText, ulLen, (int) bAnySpace)); - - if( bAnySpace ) - { - while( ulLen && HB_ISSPACE( szText[ ulLen - 1 ] ) ) - ulLen--; - } - else - { - while( ulLen && szText[ ulLen - 1 ] == ' ' ) - ulLen--; - } - - return ulLen; -} - -/* NOTE: The second parameter is a Harbour extension [vszakats] */ - -/* trims trailing spaces from a string */ -/* TEST: QOUT( "rtrim( ' hello world ' ) = '" + rtrim( ' hello world ' ) + "'" ) */ -HARBOUR HB_RTRIM( void ) -{ - PHB_ITEM pText = hb_param( 1, IT_STRING ); - - if( pText ) - { - char * pszText = hb_itemGetCPtr( pText ); - BOOL bAnySpace = ( ISLOG( 2 ) ? hb_parl( 2 ) : FALSE ); - - hb_retclen( pszText, hb_strRTrimLen( pszText, hb_itemGetCLen( pText ), bAnySpace ) ); - } - else - { - /* NOTE: "TRIM" is right here [vszakats] */ - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1100, NULL, "TRIM" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* NOTE: The second parameter is a Harbour extension [vszakats] */ - -/* synonymn for RTRIM */ -HARBOUR HB_TRIM( void ) -{ - HB_RTRIM(); -} - -/* NOTE: The second parameter is a Harbour extension [vszakats] */ - -/* trims leading and trailing spaces from a string */ -/* TEST: QOUT( "alltrim( ' hello world ' ) = '" + alltrim( ' hello world ' ) + "'" ) */ -HARBOUR HB_ALLTRIM( void ) -{ - if( ISCHAR( 1 ) ) - { - char * szText = hb_parc( 1 ); - BOOL bAnySpace = ( ISLOG( 2 ) ? hb_parl( 2 ) : FALSE ); - ULONG ulLen = hb_strRTrimLen( szText, hb_parclen( 1 ), bAnySpace ); - - szText = hb_strLTrim( szText, &ulLen ); - - hb_retclen( szText, ulLen ); - } - else -#ifdef HB_COMPAT_C53 - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 2022, NULL, "ALLTRIM" ); /* NOTE: This appeared in CA-Cl*pper 5.3 [vszakats] */ - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -#else - hb_retc( "" ); -#endif -} - -/* This function is used by all of the PAD functions to prepare the argument - being padded. If date, convert to string using hb_dtoc(). If numeric, - convert to unpadded string. Return pointer to string and set string length */ - -static char * hb_itemPadConv( PHB_ITEM pItem, char * buffer, ULONG * pulSize ) -{ - char * szText; - - HB_TRACE(HB_TR_DEBUG, ("hb_itemPadCond(%p, %p, %p)", pItem, buffer, pulSize)); - - if( pItem ) - { - if( IS_STRING( pItem ) ) - { - szText = hb_itemGetCPtr( pItem ); - *pulSize = hb_itemGetCLen( pItem ); - } - else if( IS_DATE( pItem ) ) - { - char szDate[ 9 ]; - - szText = hb_dtoc( hb_pardsbuff( szDate, 1 ), buffer, hb_set.HB_SET_DATEFORMAT ); - *pulSize = strlen( szText ); - } - else if( IS_INTEGER( pItem ) ) - { - sprintf( buffer, "%d", hb_itemGetNI( pItem ) ); - szText = buffer; - *pulSize = strlen( szText ); - } - else if( IS_LONG( pItem ) ) - { - sprintf( buffer, "%ld", hb_itemGetNL( pItem ) ); - szText = buffer; - *pulSize = strlen( szText ); - } - else if( IS_DOUBLE( pItem ) ) - { - int iDecimal; - - hb_itemGetNLen( pItem, NULL, &iDecimal ); - sprintf( buffer, "%.*f", iDecimal, hb_itemGetND( pItem ) ); - szText = buffer; - *pulSize = strlen( szText ); - } - else - szText = NULL; - } - else - szText = NULL; - - return szText; -} - -/* right-pads a date, number, or string with spaces or supplied character */ -/* TEST: QOUT( "padr( 'hello', 10 ) = '" + padr( 'hello', 10 ) + "'" ) */ -HARBOUR HB_PADR( void ) -{ - ULONG ulSize; - char buffer[ 128 ]; - char * szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize ); - - if( szText && ISNUM( 2 ) ) - { - long lLen = hb_parnl( 2 ); - - if( lLen > ( long ) ulSize ) - { - char * szResult = ( char * ) hb_xgrab( lLen + 1 ); - long lPos; - char cPad; - - hb_xmemcpy( szResult, szText, ( long ) ulSize ); - - cPad = ( ISCHAR( 3 ) ? *( hb_parc( 3 ) ) : ' ' ); - - for( lPos = ( long ) ulSize; lPos < lLen; lPos++ ) - szResult[ lPos ] = cPad; - - hb_retclen( szResult, ( ULONG ) lLen ); - hb_xfree( szResult ); - } - else - { - if( lLen < 0 ) - lLen = 0; - - hb_retclen( szText, lLen ); - } - } - else - hb_retc( "" ); -} - -/* synonymn for PADR */ -HARBOUR HB_PAD( void ) -{ - HB_PADR(); -} - -/* left-pads a date, number, or string with spaces or supplied character */ -/* TEST: QOUT( "padl( 'hello', 10 ) = '" + padl( 'hello', 10 ) + "'" ) */ -HARBOUR HB_PADL( void ) -{ - ULONG ulSize; - char buffer[ 128 ]; - char * szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize ); - - if( szText && ISNUM( 2 ) ) - { - long lLen = hb_parnl( 2 ); - - if( lLen > ( long ) ulSize ) - { - char * szResult = ( char * ) hb_xgrab( lLen + 1 ); - long lPos = lLen - ( long ) ulSize; - char cPad; - - hb_xmemcpy( szResult + lPos, szText, ( long ) ulSize ); - - cPad = ( ISCHAR( 3 ) ? *( hb_parc( 3 ) ) : ' '); - - for(; lPos > 0; lPos-- ) - { - szResult[ lPos - 1 ] = cPad; - } - - hb_retclen( szResult, lLen ); - hb_xfree( szResult ); - } - else - { - if( lLen < 0 ) - lLen = 0; - - hb_retclen( szText, lLen ); - } - } - else - hb_retc( "" ); -} - -/* centre-pads a date, number, or string with spaces or supplied character */ -/* TEST: QOUT( "padc( 'hello', 10 ) = '" + padc( 'hello', 10 ) + "'" ) */ -HARBOUR HB_PADC( void ) -{ - ULONG ulSize; - char buffer[ 128 ]; - char * szText = hb_itemPadConv( hb_param( 1, IT_ANY ), buffer, &ulSize ); - - if( szText && ISNUM( 2 ) ) - { - long lLen = hb_parnl( 2 ); - - if( lLen > ( long ) ulSize ) - { - char * szResult = ( char * ) hb_xgrab( lLen + 1 ); - char cPad; - long w, lPos = ( lLen - ( long ) ulSize ) / 2; - - hb_xmemcpy( szResult + lPos, szText, ( long ) ulSize + 1 ); - - cPad = ( ISCHAR( 3 ) ? *hb_parc( 3 ) : ' ' ); - - for( w = 0; w < lPos; w++ ) - szResult[ w ] = cPad; - - for( w = ( long ) ulSize + lPos; w < lLen; w++ ) - szResult[ w ] = cPad; - - szResult[ lLen ] = '\0'; - - hb_retclen( szResult, lLen ); - hb_xfree( szResult ); - } - else - { - if( lLen < 0 ) - lLen = 0; - - hb_retclen( szText, lLen ); - } - } - else - hb_retc( "" ); -} - -/* locates a substring in a string */ -/* TEST: QOUT( "at( 'cde', 'abcdefgfedcba' ) = '" + at( 'cde', 'abcsefgfedcba' ) + "'" ) */ - -HARBOUR HB_AT( void ) -{ - PHB_ITEM pSub = hb_param( 1, IT_STRING ); - PHB_ITEM pText = hb_param( 2, IT_STRING ); - - if( pText && pSub ) - { - hb_retnl( hb_strAt( hb_itemGetCPtr( pSub ), hb_itemGetCLen( pSub ), - hb_itemGetCPtr( pText ), hb_itemGetCLen( pText ) ) ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1108, NULL, "AT" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* locates a substring in a string starting at the end */ -/* TEST: QOUT( "rat( 'cde', 'abcdefgfedcba' ) = '" + rat( 'cde', 'abcdefgfedcba' ) + "'" ) */ -/* TOFIX: Will not work with a search string > 64 KB on some platforms */ - -HARBOUR HB_RAT( void ) -{ - ULONG ulSubLen = hb_parclen( 1 ); - - if( ulSubLen ) - { - long lPos = hb_parclen( 2 ) - ulSubLen; - - if( lPos >= 0 ) - { - char * szSub = hb_parc( 1 ); - char * szText = hb_parc( 2 ); - BOOL bFound = FALSE; - - while( lPos >= 0 && !bFound ) - { - if( *( szText + lPos ) == *szSub ) - bFound = ( memcmp( szSub, szText + lPos, ulSubLen ) == 0 ); - lPos--; - } - - hb_retnl( bFound ? lPos + 2 : 0 ); - } - else - hb_retni( 0 ); - } - else - /* This function never seems to raise an error */ - hb_retni( 0 ); -} - -/* converts an ASCII code to a character value */ -HARBOUR HB_CHR( void ) -{ - if( ISNUM( 1 ) ) - { - char szChar[ 2 ]; - - /* NOTE: CA-Cl*pper's compiler optimizer will be wrong for those - CHR() cases where the passed parameter is a constant which - can be divided by 256 but it's not zero, in this case it - will return an empty string instead of a Chr(0). [vszakats] */ - - /* Believe it or not, clipper does this! */ - szChar[ 0 ] = hb_parnl( 1 ) % 256; - szChar[ 1 ] = '\0'; - - hb_retclen( szChar, 1 ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1104, NULL, "CHR" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* converts a character value to an ASCII code */ -HARBOUR HB_ASC( void ) -{ - PHB_ITEM pText = hb_param( 1, IT_STRING ); - - if( pText ) - { - if( hb_itemGetCLen( pText ) > 0 ) - hb_retni( ( BYTE ) * ( hb_itemGetCPtr( pText ) ) ); - else - hb_retni( 0 ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1107, NULL, "ASC" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* returns the left-most n characters in string */ - -HARBOUR HB_LEFT( void ) -{ - PHB_ITEM pText = hb_param( 1, IT_STRING ); - - if( pText && ISNUM( 2 ) ) - { - long lLen = hb_parnl( 2 ); - - if( lLen > ( long ) hb_itemGetCLen( pText ) ) - lLen = ( long ) hb_itemGetCLen( pText ); - - else if( lLen < 0 ) - lLen = 0; - - hb_retclen( hb_itemGetCPtr( pText ), lLen ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1124, NULL, "LEFT" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* returns the right-most n characters in string */ - -HARBOUR HB_RIGHT( void ) -{ - PHB_ITEM pText = hb_param( 1, IT_STRING ); - - if( pText && ISNUM( 2 ) ) - { - long lLen = hb_parnl( 2 ); - - if( lLen > ( long ) hb_itemGetCLen( pText ) ) - lLen = ( long ) hb_itemGetCLen( pText ); - - else if( lLen < 0 ) - lLen = 0; - - hb_retclen( hb_itemGetCPtr( pText ) + hb_itemGetCLen( pText ) - lLen, lLen ); - } - else - { - /* Clipper doesn't error */ - hb_retc( "" ); - } -} - -/* returns l characters from n characters into string */ - -HARBOUR HB_SUBSTR( void ) -{ - PHB_ITEM pText = hb_param( 1, IT_STRING ); - - if( pText && ISNUM( 2 ) ) - { - long lPos = hb_parnl( 2 ); - - if( lPos < 0 ) - { - lPos += ( long ) hb_itemGetCLen( pText ); - if( lPos < 0 ) - lPos = 0; - } - else if( lPos ) - { - lPos--; - } - - if( lPos < ( long ) hb_itemGetCLen( pText ) ) - { - long lLen; - - if( hb_pcount() >= 3 ) - { - if( ISNUM( 3 ) ) - { - lLen = hb_parnl( 3 ); - - if( lLen > ( long ) hb_itemGetCLen( pText ) - lPos ) - lLen = ( long ) hb_itemGetCLen( pText ) - lPos; - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1110, NULL, "SUBSTR" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - - /* NOTE: Exit from inside [vszakats] */ - return; - } - } - else - lLen = ( long ) hb_itemGetCLen( pText ) - lPos; - - if( lLen > 0 ) - hb_retclen( hb_itemGetCPtr( pText ) + lPos, lLen ); - else - hb_retc( "" ); - } - else - hb_retc( "" ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1110, NULL, "SUBSTR" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* converts szText to lower case. Does not create a new string! */ -char * hb_strLower( char * szText, ULONG ulLen ) -{ - ULONG i; - - HB_TRACE(HB_TR_DEBUG, ("hb_strLower(%s, %lu)", szText, ulLen)); - - for( i = 0; i < ulLen; i++ ) - szText[ i ] = tolower( szText[ i ] ); - - return szText; -} - -/* converts string to lower case */ -HARBOUR HB_LOWER( void ) -{ - PHB_ITEM pText = hb_param( 1, IT_STRING ); - - if( pText ) - { - char * pszBuffer = hb_itemGetC( pText ); - ULONG ulLen = hb_itemGetCLen( pText ); - - hb_retclen( hb_strLower( pszBuffer, ulLen ), ulLen ); - - hb_itemFreeC( pszBuffer ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1103, NULL, "LOWER" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* converts szText to upper case. Does not create a new string! */ -char * hb_strUpper( char * szText, ULONG ulLen ) -{ - ULONG i; - - HB_TRACE(HB_TR_DEBUG, ("hb_strUpper(%s, %lu)", szText, ulLen)); - - for( i = 0; i < ulLen; i++ ) - szText[ i ] = toupper( szText[ i ] ); - - return szText; -} - -/* This function copies and converts szText to upper case. - */ -char * hb_strncpyUpper( char * pDest, const char * pSource, ULONG ulLen ) -{ - char * pStart = pDest; - - HB_TRACE(HB_TR_DEBUG, ("hb_strncpyUpper(%p, %s, %lu)", pDest, pSource, ulLen)); - - pDest[ ulLen ] ='\0'; - while( ulLen-- ) - *pDest++ = toupper( *pSource++ ); - - return pStart; -} - - -/* converts string to upper case */ -HARBOUR HB_UPPER( void ) -{ - PHB_ITEM pText = hb_param( 1, IT_STRING ); - - if( pText ) - { - char * pszBuffer = hb_itemGetC( pText ); - ULONG ulLen = hb_itemGetCLen( pText ); - - hb_retclen( hb_strUpper( pszBuffer, ulLen ), ulLen ); - - hb_itemFreeC( pszBuffer ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1102, NULL, "UPPER" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* returns n copies of given string */ -/* TEST: QOUT( "replicate( 'abc', 5 ) = " + replicate( 'abc', 5 ) ) */ -HARBOUR HB_REPLICATE( void ) -{ - if( ISCHAR( 1 ) && ISNUM( 2 ) ) - { - long lTimes = hb_parnl( 2 ); - - if( lTimes > 0 ) - { - ULONG ulLen = hb_parclen( 1 ); - - if( ( double ) ( ( double ) ulLen * ( double ) lTimes ) < ( double ) ULONG_MAX ) - { - char * szText = hb_parc( 1 ); - char * szResult = ( char * ) hb_xgrab( ( ulLen * lTimes ) + 1 ); - char * szPtr = szResult; - long i; - - for( i = 0; i < lTimes; i++ ) - { - hb_xmemcpy( szPtr, szText, ulLen ); - szPtr += ulLen; - } - - hb_retclen( szResult, ulLen * lTimes ); - hb_xfree( szResult ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_STROVERFLOW, 1234, NULL, "REPLICATE" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } - } - else - hb_retc( "" ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1106, NULL, "REPLICATE" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* returns n copies of a single space */ -/* TEST: QOUT( "space( 5 ) = '" + space( 5 ) + "'" ) */ -HARBOUR HB_SPACE( void ) -{ - if( ISNUM( 1 ) ) - { - long lLen = hb_parnl( 1 ); - - if( lLen > 0 ) - { - char * szResult = ( char * ) hb_xgrab( lLen + 1 ); - - /* NOTE: String overflow could never occure since a string can - be as large as ULONG_MAX, and the maximum length that - can be specified is LONG_MAX here. [vszakats] */ - /* hb_errRT_BASE( EG_STROVERFLOW, 1233, NULL, "SPACE" ); */ - - hb_xmemset( szResult, ' ', lLen ); - hb_retclen( szResult, lLen ); - hb_xfree( szResult ); - } - else - hb_retc( "" ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1105, NULL, "SPACE" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* replaces characters in a string */ -HARBOUR HB_STUFF( void ) -{ - if( ISCHAR( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISCHAR( 4 ) ) - { - char * szText = hb_parc( 1 ); - ULONG ulText = hb_parclen( 1 ); - ULONG ulPos = hb_parnl( 2 ); - ULONG ulDel = hb_parnl( 3 ); - ULONG ulInsert = hb_parclen( 4 ); - - ULONG ulTotalLen; - - if( ulPos > 0 ) - ulPos--; - - if( ulPos > ulText ) - ulPos = ulText; - - if( ulDel > ulText - ulPos ) - ulDel = ulText - ulPos; - - if( ( ulTotalLen = ulText + ulInsert - ulDel ) > 0 ) - { - char * szResult = ( char * ) hb_xgrab( ulTotalLen + 1 ); - - hb_xmemcpy( szResult, szText, ulPos ); - hb_xmemcpy( szResult + ulPos, hb_parc( 4 ), ulInsert ); - hb_xmemcpy( szResult + ulPos + ulInsert, szText + ulPos + ulDel, ulText - ( ulPos + ulDel ) ); - - szResult[ ulTotalLen ] = '\0'; - hb_retclen( szResult, ulTotalLen ); - hb_xfree( szResult ); - } - else - hb_retc( "" ); - } - else - hb_retc( "" ); -} - -/* TOFIX: Check for string overflow, Clipper can crash if the resulting - string is too large. Example: - StrTran( "...", ".", Replicate( "A", 32000 ) ) [vszakats] */ - -/* replaces lots of characters in a string */ -/* TOFIX: Will not work with a search string of > 64 KB on some platforms */ -HARBOUR HB_STRTRAN( void ) -{ - PHB_ITEM pText = hb_param( 1, IT_STRING ); - - if( pText ) - { - PHB_ITEM pSeek = hb_param( 2, IT_STRING ); - - if( pSeek ) - { - char * szText = hb_itemGetCPtr( pText ); - ULONG ulText = hb_itemGetCLen( pText ); - ULONG ulSeek = hb_itemGetCLen( pSeek ); - - if( ulSeek && ulSeek <= ulText ) - { - char * szSeek = hb_itemGetCPtr( pSeek ); - char * szReplace; - ULONG ulStart; - - ulStart = ( ISNUM( 4 ) ? hb_parnl( 4 ) : 1 ); - - if( !ulStart ) - { - /* Clipper seems to work this way */ - hb_retc( "" ); - } - else if( ulStart > 0 ) - { - PHB_ITEM pReplace = hb_param( 3, IT_STRING ); - ULONG ulReplace; - ULONG ulCount; - BOOL bAll; - - if( pReplace ) - { - szReplace = hb_itemGetCPtr( pReplace ); - ulReplace = hb_itemGetCLen( pReplace ); - } - else - { - szReplace = ""; /* shouldn't matter that we don't allocate */ - ulReplace = 0; - } - - if( ISNUM( 5 ) ) - { - ulCount = hb_parnl( 5 ); - bAll = FALSE; - } - else - { - ulCount = 0; - bAll = TRUE; - } - - if( bAll || ulCount > 0 ) - { - ULONG ulFound = 0; - long lReplaced = 0; - ULONG i = 0; - ULONG ulLength = ulText; - - while( i < ulText ) - { - if( ( bAll || lReplaced < ( long ) ulCount ) && ! memcmp( szText + i, szSeek, ulSeek ) ) - { - ulFound++; - if( ulFound >= ulStart ) - { - lReplaced++; - ulLength = ulLength - ulSeek + ulReplace; - i += ulSeek; - } - else - i++; - } - else - i++; - } - - if( ulFound ) - { - char * szResult = ( char * ) hb_xgrab( ulLength + 1 ); - char * szPtr = szResult; - - ulFound = 0; - i = 0; - while( i < ulText ) - { - if( lReplaced && ! memcmp( szText + i, szSeek, ulSeek ) ) - { - ulFound++; - if( ulFound >= ulStart ) - { - lReplaced--; - memcpy( szPtr, szReplace, ulReplace ); - szPtr += ulReplace; - i += ulSeek; - } - else - { - *szPtr = szText[ i ]; - szPtr++; - i++; - } - } - else - { - *szPtr = szText[ i ]; - szPtr++; - i++; - } - } - hb_retclen( szResult, ulLength ); - hb_xfree( szResult ); - } - else - hb_retclen( szText, ulText ); - } - else - hb_retclen( szText, ulText ); - } - else - hb_retclen( szText, ulText ); - } - else - hb_retclen( szText, ulText ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1126, NULL, "STRTRAN" ); /* NOTE: Undocumented but existing Clipper Run-time error [vszakats] */ - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1126, NULL, "STRTRAN" ); /* NOTE: Undocumented but existing Clipper Run-time error [vszakats] */ - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* returns the numeric value of a character string representation of a number */ -double hb_strVal( const char * szText ) -{ - HB_TRACE(HB_TR_DEBUG, ("hb_strVal(%s)", szText)); - - return atof( szText ); -} - -/* returns the numeric value of a character string representation of a number */ -HARBOUR HB_VAL( void ) -{ - PHB_ITEM pText = hb_param( 1, IT_STRING ); - - if( pText ) - { - int iWidth; - int iDec; - char * ptr = strchr( hb_itemGetCPtr( pText ), '.' ); - - if( ptr ) - { - iWidth = ptr - hb_itemGetCPtr( pText ); - iDec = strlen( ptr + 1 ); - } - else - { - iWidth = strlen( hb_itemGetCPtr( pText ) ); - iDec = 0; - } - - hb_retndlen( hb_strVal( hb_itemGetCPtr( pText ) ), iWidth, iDec ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1098, NULL, "VAL" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -HARBOUR HB_STR( void ) -{ - BOOL bValid = TRUE; - PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); - PHB_ITEM pWidth = NULL; - PHB_ITEM pDec = NULL; - - if( !pNumber ) - bValid = FALSE; - else - { - if( hb_pcount() >= 2 ) - { - pWidth = hb_param( 2, IT_NUMERIC ); - if( !pWidth ) - bValid = FALSE; - } - if( hb_pcount() >= 3 ) - { - pDec = hb_param( 3, IT_NUMERIC ); - if( !pDec ) - bValid = FALSE; - } - } - if( bValid ) - { - char * szResult = hb_itemStr( pNumber, pWidth, pDec ); - - if( szResult ) - { - hb_retc( szResult ); - hb_xfree( szResult ); - } - else - hb_retc( "" ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1099, NULL, "STR" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -HARBOUR HB_STRZERO( void ) -{ - if( hb_pcount() >= 1 && hb_pcount() <= 3 ) - { - BOOL bValid = TRUE; - PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); - PHB_ITEM pWidth = NULL; - PHB_ITEM pDec = NULL; - - if( !pNumber ) - bValid = FALSE; - else - { - if( hb_pcount() >= 2 ) - { - pWidth = hb_param( 2, IT_NUMERIC ); - if( !pWidth ) - bValid = FALSE; - } - if( hb_pcount() >= 3 ) - { - pDec = hb_param( 3, IT_NUMERIC ); - if( !pDec ) - bValid = FALSE; - } - } - if( bValid ) - { - char * szResult = hb_itemStr( pNumber, pWidth, pDec ); - - if( szResult ) - { - ULONG ulPos = 0; - - while( szResult[ ulPos ] != '\0' && szResult[ ulPos ] != '-' ) - ulPos++; - - if( szResult[ ulPos ] == '-' ) - { - /* Negative sign found, put the negative sign to the first */ - /* position */ - - szResult[ ulPos ] = ' '; - - ulPos = 0; - while( szResult[ ulPos ] != '\0' && szResult[ ulPos ] == ' ' ) - szResult[ ulPos++ ] = '0'; - - szResult[ 0 ] = '-'; - } - else - { - /* Negative sign not found */ - - ulPos = 0; - while( szResult[ ulPos ] != '\0' && szResult[ ulPos ] == ' ' ) - szResult[ ulPos++ ] = '0'; - } - - hb_retc( szResult ); - hb_xfree( szResult ); - } - else - hb_retc( "" ); - } - else - { -#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY - /* NOTE: In CA-Cl*pper STRZERO() is written in Clipper, and will call - STR() to do the job, the error (if any) will also be thrown - by STR(). [vszakats] */ - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1099, NULL, "STR" ); -#else - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 9999, NULL, "STRZERO" ); -#endif - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } - } -} - -HARBOUR HB_HB_VALTOSTR( void ) -{ - ULONG ulLen; - BOOL bFreeReq; - char * buffer = hb_itemString( hb_param( 1, IT_ANY ), &ulLen, &bFreeReq ); - - hb_retclen( buffer, ulLen ); - - if( bFreeReq ) - hb_xfree( buffer ); -} - diff --git a/harbour/source/rtl/stris.c b/harbour/source/rtl/stris.c new file mode 100644 index 0000000000..946011ae3c --- /dev/null +++ b/harbour/source/rtl/stris.c @@ -0,0 +1,75 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * IS*() string functions + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include + +#include "hbapi.h" + +/* determines if first char of string is letter */ +/* TEST: QOUT( "isalpha( 'hello' ) = ", isalpha( 'hello' ) ) */ +/* TEST: QOUT( "isalpha( '12345' ) = ", isalpha( '12345' ) ) */ + +HARBOUR HB_ISALPHA( void ) +{ + hb_retl( isalpha( *hb_parc( 1 ) ) ); +} + +/* determines if first char of string is digit */ +/* TEST: QOUT( "isdigit( '12345' ) = ", isdigit( '12345' ) ) */ +/* TEST: QOUT( "isdigit( 'abcde' ) = ", isdigit( 'abcde' ) ) */ + +HARBOUR HB_ISDIGIT( void ) +{ + hb_retl( isdigit( *hb_parc( 1 ) ) ); +} + +/* determines if first char of string is upper-case */ +/* TEST: QOUT( "isupper( 'Abcde' ) = ", isupper( 'Abcde' ) ) */ +/* TEST: QOUT( "isupper( 'abcde' ) = ", isupper( 'abcde' ) ) */ + +HARBOUR HB_ISUPPER( void ) +{ + hb_retl( isupper( *hb_parc( 1 ) ) ); +} + +/* determines if first char of string is lower-case */ +/* TEST: QOUT( "islower( 'abcde' ) = ", islower( 'abcde' ) ) */ +/* TEST: QOUT( "islower( 'Abcde' ) = ", islower( 'Abcde' ) ) */ + +HARBOUR HB_ISLOWER( void ) +{ + hb_retl( islower( *hb_parc( 1 ) ) ); +} + diff --git a/harbour/source/rtl/strmatch.c b/harbour/source/rtl/strmatch.c new file mode 100644 index 0000000000..d2544ec156 --- /dev/null +++ b/harbour/source/rtl/strmatch.c @@ -0,0 +1,94 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * String matching functions + * + * Copyright 1999 Victor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include + +#include "hbapi.h" + +static BOOL hb_strMatchDOS( const char * pszString, const char * pszMask ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_strMatchDOS(%s, %s)", pszString, pszMask)); + + while( *pszMask && *pszString ) + { + if( *pszMask == '*' ) + { + while( *pszMask == '*' ) + pszMask++; + + if( ! ( *pszMask ) ) + return TRUE; + else + if( *pszMask == '?' ) + pszString++; + else + { + while( toupper( *pszString ) != toupper( *pszMask ) ) + { + if( ! ( *( ++pszString ) ) ) + return FALSE; + } + while( toupper( *pszString ) == toupper( *pszMask ) ) + { + if( ! ( *( ++pszString ) ) ) + break; + } + pszMask++; + } + } + else + if( toupper( *pszMask ) != toupper( *pszString ) && *pszMask != '?' ) + return FALSE; + else + { + pszMask++; + pszString++; + } + } + + return ! ( ( ! ( *pszString ) && *pszMask && *pszMask != '*') || + ( ! ( *pszMask ) && *pszString ) ); +} + +/* TODO: Replace it with a code that supports real regular expressions + * + */ +BOOL hb_strMatchRegExp( const char * szString, const char * szMask ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_strMatchRegExp(%s, %s)", szString, szMask)); + + return hb_strMatchDOS( szString, szMask ); +} + diff --git a/harbour/source/rtl/strtran.c b/harbour/source/rtl/strtran.c new file mode 100644 index 0000000000..66bdf375df --- /dev/null +++ b/harbour/source/rtl/strtran.c @@ -0,0 +1,197 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * STRTRAN function + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* TOFIX: Check for string overflow, Clipper can crash if the resulting + string is too large. Example: + StrTran( "...", ".", Replicate( "A", 32000 ) ) [vszakats] */ + +/* replaces lots of characters in a string */ +/* TOFIX: Will not work with a search string of > 64 KB on some platforms */ +HARBOUR HB_STRTRAN( void ) +{ + PHB_ITEM pText = hb_param( 1, IT_STRING ); + + if( pText ) + { + PHB_ITEM pSeek = hb_param( 2, IT_STRING ); + + if( pSeek ) + { + char * szText = hb_itemGetCPtr( pText ); + ULONG ulText = hb_itemGetCLen( pText ); + ULONG ulSeek = hb_itemGetCLen( pSeek ); + + if( ulSeek && ulSeek <= ulText ) + { + char * szSeek = hb_itemGetCPtr( pSeek ); + char * szReplace; + ULONG ulStart; + + ulStart = ( ISNUM( 4 ) ? hb_parnl( 4 ) : 1 ); + + if( !ulStart ) + { + /* Clipper seems to work this way */ + hb_retc( "" ); + } + else if( ulStart > 0 ) + { + PHB_ITEM pReplace = hb_param( 3, IT_STRING ); + ULONG ulReplace; + ULONG ulCount; + BOOL bAll; + + if( pReplace ) + { + szReplace = hb_itemGetCPtr( pReplace ); + ulReplace = hb_itemGetCLen( pReplace ); + } + else + { + szReplace = ""; /* shouldn't matter that we don't allocate */ + ulReplace = 0; + } + + if( ISNUM( 5 ) ) + { + ulCount = hb_parnl( 5 ); + bAll = FALSE; + } + else + { + ulCount = 0; + bAll = TRUE; + } + + if( bAll || ulCount > 0 ) + { + ULONG ulFound = 0; + long lReplaced = 0; + ULONG i = 0; + ULONG ulLength = ulText; + + while( i < ulText ) + { + if( ( bAll || lReplaced < ( long ) ulCount ) && ! memcmp( szText + i, szSeek, ulSeek ) ) + { + ulFound++; + if( ulFound >= ulStart ) + { + lReplaced++; + ulLength = ulLength - ulSeek + ulReplace; + i += ulSeek; + } + else + i++; + } + else + i++; + } + + if( ulFound ) + { + char * szResult = ( char * ) hb_xgrab( ulLength + 1 ); + char * szPtr = szResult; + + ulFound = 0; + i = 0; + while( i < ulText ) + { + if( lReplaced && ! memcmp( szText + i, szSeek, ulSeek ) ) + { + ulFound++; + if( ulFound >= ulStart ) + { + lReplaced--; + memcpy( szPtr, szReplace, ulReplace ); + szPtr += ulReplace; + i += ulSeek; + } + else + { + *szPtr = szText[ i ]; + szPtr++; + i++; + } + } + else + { + *szPtr = szText[ i ]; + szPtr++; + i++; + } + } + hb_retclen( szResult, ulLength ); + hb_xfree( szResult ); + } + else + hb_retclen( szText, ulText ); + } + else + hb_retclen( szText, ulText ); + } + else + hb_retclen( szText, ulText ); + } + else + hb_retclen( szText, ulText ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1126, NULL, "STRTRAN" ); /* NOTE: Undocumented but existing Clipper Run-time error [vszakats] */ + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1126, NULL, "STRTRAN" ); /* NOTE: Undocumented but existing Clipper Run-time error [vszakats] */ + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + diff --git a/harbour/source/rtl/strzero.c b/harbour/source/rtl/strzero.c new file mode 100644 index 0000000000..cd4160754c --- /dev/null +++ b/harbour/source/rtl/strzero.c @@ -0,0 +1,127 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * STRZERO() function + * + * Copyright 1999 Victor Szakats + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +HARBOUR HB_STRZERO( void ) +{ + if( hb_pcount() >= 1 && hb_pcount() <= 3 ) + { + BOOL bValid; + PHB_ITEM pNumber = hb_param( 1, IT_NUMERIC ); + PHB_ITEM pWidth = NULL; + PHB_ITEM pDec = NULL; + + if( pNumber ) + { + bValid = TRUE; + + if( hb_pcount() >= 2 ) + { + pWidth = hb_param( 2, IT_NUMERIC ); + if( !pWidth ) + bValid = FALSE; + } + + if( hb_pcount() >= 3 ) + { + pDec = hb_param( 3, IT_NUMERIC ); + if( !pDec ) + bValid = FALSE; + } + } + else + bValid = FALSE; + + if( bValid ) + { + char * szResult = hb_itemStr( pNumber, pWidth, pDec ); + + if( szResult ) + { + ULONG ulPos = 0; + + while( szResult[ ulPos ] != '\0' && szResult[ ulPos ] != '-' ) + ulPos++; + + if( szResult[ ulPos ] == '-' ) + { + /* Negative sign found, put the negative sign to the first */ + /* position */ + + szResult[ ulPos ] = ' '; + + ulPos = 0; + while( szResult[ ulPos ] != '\0' && szResult[ ulPos ] == ' ' ) + szResult[ ulPos++ ] = '0'; + + szResult[ 0 ] = '-'; + } + else + { + /* Negative sign not found */ + + ulPos = 0; + while( szResult[ ulPos ] != '\0' && szResult[ ulPos ] == ' ' ) + szResult[ ulPos++ ] = '0'; + } + + hb_retc( szResult ); + hb_xfree( szResult ); + } + else + hb_retc( "" ); + } + else + { +#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY + /* NOTE: In CA-Cl*pper STRZERO() is written in Clipper, and will call + STR() to do the job, the error (if any) will also be thrown + by STR(). [vszakats] */ + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1099, NULL, "STR" ); +#else + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 9999, NULL, "STRZERO" ); +#endif + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } + } +} diff --git a/harbour/source/rtl/stuff.c b/harbour/source/rtl/stuff.c new file mode 100644 index 0000000000..9bd4c7c5cd --- /dev/null +++ b/harbour/source/rtl/stuff.c @@ -0,0 +1,79 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * STUFF() function + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" + +/* replaces characters in a string */ +HARBOUR HB_STUFF( void ) +{ + if( ISCHAR( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) && ISCHAR( 4 ) ) + { + char * szText = hb_parc( 1 ); + ULONG ulText = hb_parclen( 1 ); + ULONG ulPos = hb_parnl( 2 ); + ULONG ulDel = hb_parnl( 3 ); + ULONG ulInsert = hb_parclen( 4 ); + + ULONG ulTotalLen; + + if( ulPos > 0 ) + ulPos--; + + if( ulPos > ulText ) + ulPos = ulText; + + if( ulDel > ulText - ulPos ) + ulDel = ulText - ulPos; + + if( ( ulTotalLen = ulText + ulInsert - ulDel ) > 0 ) + { + char * szResult = ( char * ) hb_xgrab( ulTotalLen + 1 ); + + hb_xmemcpy( szResult, szText, ulPos ); + hb_xmemcpy( szResult + ulPos, hb_parc( 4 ), ulInsert ); + hb_xmemcpy( szResult + ulPos + ulInsert, szText + ulPos + ulDel, ulText - ( ulPos + ulDel ) ); + + szResult[ ulTotalLen ] = '\0'; + hb_retclen( szResult, ulTotalLen ); + hb_xfree( szResult ); + } + else + hb_retc( "" ); + } + else + hb_retc( "" ); +} + diff --git a/harbour/source/rtl/substr.c b/harbour/source/rtl/substr.c new file mode 100644 index 0000000000..56ddacb8b0 --- /dev/null +++ b/harbour/source/rtl/substr.c @@ -0,0 +1,109 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * LEFT() function + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* returns l characters from n characters into string */ + +HARBOUR HB_SUBSTR( void ) +{ + PHB_ITEM pText = hb_param( 1, IT_STRING ); + + if( pText && ISNUM( 2 ) ) + { + long lPos = hb_parnl( 2 ); + + if( lPos < 0 ) + { + lPos += ( long ) hb_itemGetCLen( pText ); + if( lPos < 0 ) + lPos = 0; + } + else if( lPos ) + { + lPos--; + } + + if( lPos < ( long ) hb_itemGetCLen( pText ) ) + { + long lLen; + + if( hb_pcount() >= 3 ) + { + if( ISNUM( 3 ) ) + { + lLen = hb_parnl( 3 ); + + if( lLen > ( long ) hb_itemGetCLen( pText ) - lPos ) + lLen = ( long ) hb_itemGetCLen( pText ) - lPos; + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1110, NULL, "SUBSTR" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + + /* NOTE: Exit from inside [vszakats] */ + return; + } + } + else + lLen = ( long ) hb_itemGetCLen( pText ) - lPos; + + if( lLen > 0 ) + hb_retclen( hb_itemGetCPtr( pText ) + lPos, lLen ); + else + hb_retc( "" ); + } + else + hb_retc( "" ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1110, NULL, "SUBSTR" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} diff --git a/harbour/source/rtl/trim.c b/harbour/source/rtl/trim.c new file mode 100644 index 0000000000..24b35ab6b6 --- /dev/null +++ b/harbour/source/rtl/trim.c @@ -0,0 +1,167 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * *TRIM() functions + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* trims from the left, and returns a new pointer to szText */ +/* also returns the new length in lLen */ +char * hb_strLTrim( const char * szText, ULONG * ulLen ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_strLTrim(%s, %p)", szText, ulLen)); + + while( *ulLen && HB_ISSPACE( *szText ) ) + { + szText++; + ( *ulLen )--; + } + + return ( char * ) szText; +} + +/* returns szText and the new length in lLen */ +ULONG hb_strRTrimLen( const char * szText, ULONG ulLen, BOOL bAnySpace ) +{ + HB_TRACE(HB_TR_DEBUG, ("hb_strRTrimLen(%s, %lu. %d)", szText, ulLen, (int) bAnySpace)); + + if( bAnySpace ) + { + while( ulLen && HB_ISSPACE( szText[ ulLen - 1 ] ) ) + ulLen--; + } + else + { + while( ulLen && szText[ ulLen - 1 ] == ' ' ) + ulLen--; + } + + return ulLen; +} + +/* trims leading spaces from a string */ +/* TEST: QOUT( "ltrim( ' hello world ' ) = '" + ltrim( ' hello world ' ) + "'" ) */ + +HARBOUR HB_LTRIM( void ) +{ + PHB_ITEM pText = hb_param( 1, IT_STRING ); + + if( pText ) + { + ULONG ulLen = hb_itemGetCLen( pText ); + char * szText = hb_strLTrim( hb_itemGetCPtr( pText ), &ulLen ); + + hb_retclen( szText, ulLen ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1101, NULL, "LTRIM" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +/* NOTE: The second parameter is a Harbour extension [vszakats] */ + +/* trims trailing spaces from a string */ +/* TEST: QOUT( "rtrim( ' hello world ' ) = '" + rtrim( ' hello world ' ) + "'" ) */ +HARBOUR HB_RTRIM( void ) +{ + PHB_ITEM pText = hb_param( 1, IT_STRING ); + + if( pText ) + { + char * pszText = hb_itemGetCPtr( pText ); + BOOL bAnySpace = ( ISLOG( 2 ) ? hb_parl( 2 ) : FALSE ); + + hb_retclen( pszText, hb_strRTrimLen( pszText, hb_itemGetCLen( pText ), bAnySpace ) ); + } + else + { + /* NOTE: "TRIM" is right here [vszakats] */ + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1100, NULL, "TRIM" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +/* NOTE: The second parameter is a Harbour extension [vszakats] */ + +/* synonymn for RTRIM */ +HARBOUR HB_TRIM( void ) +{ + HB_RTRIM(); +} + +/* NOTE: The second parameter is a Harbour extension [vszakats] */ + +/* trims leading and trailing spaces from a string */ +/* TEST: QOUT( "alltrim( ' hello world ' ) = '" + alltrim( ' hello world ' ) + "'" ) */ +HARBOUR HB_ALLTRIM( void ) +{ + if( ISCHAR( 1 ) ) + { + char * szText = hb_parc( 1 ); + BOOL bAnySpace = ( ISLOG( 2 ) ? hb_parl( 2 ) : FALSE ); + ULONG ulLen = hb_strRTrimLen( szText, hb_parclen( 1 ), bAnySpace ); + + szText = hb_strLTrim( szText, &ulLen ); + + hb_retclen( szText, ulLen ); + } + else +#ifdef HB_COMPAT_C53 + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 2022, NULL, "ALLTRIM" ); /* NOTE: This appeared in CA-Cl*pper 5.3 [vszakats] */ + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +#else + hb_retc( "" ); +#endif +} + diff --git a/harbour/source/rtl/val.c b/harbour/source/rtl/val.c new file mode 100644 index 0000000000..1295a6713f --- /dev/null +++ b/harbour/source/rtl/val.c @@ -0,0 +1,75 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * VAL() function + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +/* returns the numeric value of a character string representation of a number */ +HARBOUR HB_VAL( void ) +{ + PHB_ITEM pText = hb_param( 1, IT_STRING ); + + if( pText ) + { + int iWidth; + int iDec; + char * ptr = strchr( hb_itemGetCPtr( pText ), '.' ); + + if( ptr ) + { + iWidth = ptr - hb_itemGetCPtr( pText ); + iDec = strlen( ptr + 1 ); + } + else + { + iWidth = strlen( hb_itemGetCPtr( pText ) ); + iDec = 0; + } + + hb_retndlen( hb_strVal( hb_itemGetCPtr( pText ) ), iWidth, iDec ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1098, NULL, "VAL" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + diff --git a/harbour/source/rtl/valtostr.c b/harbour/source/rtl/valtostr.c new file mode 100644 index 0000000000..ae80a9af67 --- /dev/null +++ b/harbour/source/rtl/valtostr.c @@ -0,0 +1,50 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * HB_VALTOSTR() function + * + * Copyright 1999 David G. Holm + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" + +HARBOUR HB_HB_VALTOSTR( void ) +{ + ULONG ulLen; + BOOL bFreeReq; + char * buffer = hb_itemString( hb_param( 1, IT_ANY ), &ulLen, &bFreeReq ); + + hb_retclen( buffer, ulLen ); + + if( bFreeReq ) + hb_xfree( buffer ); +} + diff --git a/harbour/source/vm/Makefile b/harbour/source/vm/Makefile index 436116b0c1..2601e7f1e4 100644 --- a/harbour/source/vm/Makefile +++ b/harbour/source/vm/Makefile @@ -6,6 +6,7 @@ ROOT = ../../ C_SOURCES=\ arrays.c \ + arrayshb.c \ break.c \ classes.c \ cmdarg.c \ diff --git a/harbour/source/vm/arrays.c b/harbour/source/vm/arrays.c index 1fa5d16e51..0c9c92b8e1 100644 --- a/harbour/source/vm/arrays.c +++ b/harbour/source/vm/arrays.c @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * The Array API + * The Array API (C level) * * Copyright 1999 Antonio Linares * www - http://www.harbour-project.org @@ -53,10 +53,6 @@ #include "hbapilng.h" #include "hbvm.h" -/* - * Internal - */ - BOOL hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */ { PHB_BASEARRAY pBaseArray = ( PHB_BASEARRAY ) hb_xgrab( sizeof( HB_BASEARRAY ) ); @@ -771,243 +767,3 @@ PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray ) return pDstArray; } -/* This function creates an array item using 'iDimension' as an index - * to retrieve the number of elements from the parameter list. - */ -static void hb_arrayNewRagged( PHB_ITEM pArray, int iDimension ) -{ - ULONG ulElements; - - HB_TRACE(HB_TR_DEBUG, ("hb_arrayNewRagged(%p, %d)", pArray, iDimension)); - - ulElements = ( ULONG ) hb_parnl( iDimension ); - - /* create an array */ - hb_arrayNew( pArray, ulElements ); - - if( ++iDimension <= hb_pcount() ) - { - /* call self recursively to create next dimensions - */ - while( ulElements ) - hb_arrayNewRagged( hb_arrayGetItemPtr( pArray, ulElements-- ), iDimension ); - } -} - -/* - * HARBOUR - */ - -HARBOUR HB_ARRAY( void ) -{ - int iPCount = hb_pcount(); - - if( iPCount > 0 ) - { - BOOL bError = FALSE; - int iParam; - - for( iParam = 1; iParam <= iPCount; iParam++ ) - { - if( ! ISNUM( iParam ) ) - { - bError = TRUE; - break; - } - - if( hb_parnl( iParam ) < 0 ) /* || hb_parnl( iParam ) <= 4096 */ - { - hb_errRT_BASE( EG_BOUND, 1131, NULL, hb_langDGetErrorDesc( EG_ARRDIMENSION ) ); - bError = TRUE; - break; - } - } - - if( ! bError ) - hb_arrayNewRagged( &hb_stack.Return, 1 ); - } -} - -HARBOUR HB_AADD( void ) -{ - PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); - - if( pArray ) - { - PHB_ITEM pValue = hb_param( 2, IT_ANY ); - - if( pValue && hb_arrayAdd( pArray, pValue ) ) - hb_itemReturn( pValue ); - else - hb_errRT_BASE( EG_BOUND, 1187, NULL, "AADD" ); - } - else - { - PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1123, NULL, "AADD" ); - - if( pResult ) - { - hb_itemReturn( pResult ); - hb_itemRelease( pResult ); - } - } -} - -/* NOTE: CA-Cl*pper 5.3 and older will return NIL on bad parameter, 5.3a,b - will throw a runtime error. [vszakats] */ - -HARBOUR HB_ASIZE( void ) -{ - PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); - - if( pArray && ISNUM( 2 ) ) - { - long lSize = hb_parnl( 2 ); - - hb_arraySize( pArray, HB_MAX_( lSize, 0 ) ); - - hb_itemReturn( pArray ); /* ASize() returns the array itself */ - } -#ifdef HB_COMPAT_C53 /* From CA-Cl*pper 5.3a */ - else - hb_errRT_BASE( EG_ARG, 2023, NULL, "ASIZE" ); -#endif -} - -HARBOUR HB_ATAIL( void ) -{ - PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); - - if( pArray ) - hb_arrayLast( pArray, &hb_stack.Return ); -} - -HARBOUR HB_AINS( void ) -{ - PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); - - if( pArray ) - { - if( ISNUM( 2 ) ) - hb_arrayIns( pArray, hb_parnl( 2 ) ); - - hb_itemReturn( pArray ); /* AIns() returns the array itself */ - } -} - -HARBOUR HB_ADEL( void ) -{ - PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); - - if( pArray ) - { - if( ISNUM( 2 ) ) - hb_arrayDel( pArray, hb_parnl( 2 ) ); - - hb_itemReturn( pArray ); /* ADel() returns the array itself */ - } -} - -HARBOUR HB_AFILL( void ) -{ - PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); - - if( pArray ) - { - PHB_ITEM pValue = hb_param( 2, IT_ANY ); - - if( pValue ) - { - ULONG ulStart = hb_parnl( 3 ); - ULONG ulCount = hb_parnl( 4 ); - - hb_arrayFill( pArray, - pValue, - ISNUM( 3 ) ? &ulStart : NULL, - ISNUM( 4 ) ? &ulCount : NULL ); - } - - hb_itemReturn( pArray ); /* AFill() returns the array itself */ - } -} - -HARBOUR HB_ASCAN( void ) -{ - PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); - PHB_ITEM pValue = hb_param( 2, IT_ANY ); - - if( pArray && pValue ) - { - ULONG ulStart = hb_parnl( 3 ); - ULONG ulCount = hb_parnl( 4 ); - - hb_retnl( hb_arrayScan( pArray, - pValue, - ISNUM( 3 ) ? &ulStart : NULL, - ISNUM( 4 ) ? &ulCount : NULL ) ); - } - else - hb_retnl( 0 ); -} - -HARBOUR HB_AEVAL( void ) -{ - PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); - PHB_ITEM pBlock = hb_param( 2, IT_BLOCK ); - - if( pArray && pBlock ) - { - ULONG ulStart = hb_parnl( 3 ); - ULONG ulCount = hb_parnl( 4 ); - - hb_arrayEval( pArray, - pBlock, - ISNUM( 3 ) ? &ulStart : NULL, - ISNUM( 4 ) ? &ulCount : NULL ); - - hb_itemReturn( pArray ); /* AEval() returns the array itself */ - } - else - hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL" ); -} - -HARBOUR HB_ACOPY( void ) -{ - PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY ); - PHB_ITEM pDstArray = hb_param( 2, IT_ARRAY ); - - if( pSrcArray && pDstArray ) - { - /* CA-Cl*pper works this way. */ - if( ! hb_arrayIsObject( pSrcArray ) && ! hb_arrayIsObject( pDstArray ) ) - { - ULONG ulStart = hb_parnl( 3 ); - ULONG ulCount = hb_parnl( 4 ); - ULONG ulTarget = hb_parnl( 5 ); - - hb_arrayCopy( pSrcArray, - pDstArray, - ISNUM( 3 ) ? &ulStart : NULL, - ISNUM( 4 ) ? &ulCount : NULL, - ISNUM( 5 ) ? &ulTarget : NULL ); - } - - hb_itemReturn( pDstArray ); /* ACopy() returns the target array */ - } -} - -/* NOTE: Clipper will return NIL if the parameter is not an array. [vszakats] */ - -HARBOUR HB_ACLONE( void ) -{ - PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY ); - - if( pSrcArray && ! hb_arrayIsObject( pSrcArray ) ) - { - PHB_ITEM pDstArray = hb_arrayClone( pSrcArray ); - - hb_itemReturn( pDstArray ); /* AClone() returns the new array */ - hb_itemRelease( pDstArray ); - } -} - diff --git a/harbour/source/vm/arrayshb.c b/harbour/source/vm/arrayshb.c new file mode 100644 index 0000000000..f54be12b31 --- /dev/null +++ b/harbour/source/vm/arrayshb.c @@ -0,0 +1,276 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * The Array API (Harbour level) + * + * Copyright 1999 Antonio Linares + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" +#include "hbapilng.h" + +/* This function creates an array item using 'iDimension' as an index + * to retrieve the number of elements from the parameter list. + */ +static void hb_arrayNewRagged( PHB_ITEM pArray, int iDimension ) +{ + ULONG ulElements; + + HB_TRACE(HB_TR_DEBUG, ("hb_arrayNewRagged(%p, %d)", pArray, iDimension)); + + ulElements = ( ULONG ) hb_parnl( iDimension ); + + /* create an array */ + hb_arrayNew( pArray, ulElements ); + + if( ++iDimension <= hb_pcount() ) + { + /* call self recursively to create next dimensions + */ + while( ulElements ) + hb_arrayNewRagged( hb_arrayGetItemPtr( pArray, ulElements-- ), iDimension ); + } +} + +HARBOUR HB_ARRAY( void ) +{ + int iPCount = hb_pcount(); + + if( iPCount > 0 ) + { + BOOL bError = FALSE; + int iParam; + + for( iParam = 1; iParam <= iPCount; iParam++ ) + { + if( ! ISNUM( iParam ) ) + { + bError = TRUE; + break; + } + + if( hb_parnl( iParam ) < 0 ) /* || hb_parnl( iParam ) <= 4096 */ + { + hb_errRT_BASE( EG_BOUND, 1131, NULL, hb_langDGetErrorDesc( EG_ARRDIMENSION ) ); + bError = TRUE; + break; + } + } + + if( ! bError ) + hb_arrayNewRagged( &hb_stack.Return, 1 ); + } +} + +HARBOUR HB_AADD( void ) +{ + PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + + if( pArray ) + { + PHB_ITEM pValue = hb_param( 2, IT_ANY ); + + if( pValue && hb_arrayAdd( pArray, pValue ) ) + hb_itemReturn( pValue ); + else + hb_errRT_BASE( EG_BOUND, 1187, NULL, "AADD" ); + } + else + { + PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1123, NULL, "AADD" ); + + if( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } + } +} + +/* NOTE: CA-Cl*pper 5.3 and older will return NIL on bad parameter, 5.3a,b + will throw a runtime error. [vszakats] */ + +HARBOUR HB_ASIZE( void ) +{ + PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + + if( pArray && ISNUM( 2 ) ) + { + long lSize = hb_parnl( 2 ); + + hb_arraySize( pArray, HB_MAX_( lSize, 0 ) ); + + hb_itemReturn( pArray ); /* ASize() returns the array itself */ + } +#ifdef HB_COMPAT_C53 /* From CA-Cl*pper 5.3a */ + else + hb_errRT_BASE( EG_ARG, 2023, NULL, "ASIZE" ); +#endif +} + +HARBOUR HB_ATAIL( void ) +{ + PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + + if( pArray ) + hb_arrayLast( pArray, &hb_stack.Return ); +} + +HARBOUR HB_AINS( void ) +{ + PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + + if( pArray ) + { + if( ISNUM( 2 ) ) + hb_arrayIns( pArray, hb_parnl( 2 ) ); + + hb_itemReturn( pArray ); /* AIns() returns the array itself */ + } +} + +HARBOUR HB_ADEL( void ) +{ + PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + + if( pArray ) + { + if( ISNUM( 2 ) ) + hb_arrayDel( pArray, hb_parnl( 2 ) ); + + hb_itemReturn( pArray ); /* ADel() returns the array itself */ + } +} + +HARBOUR HB_AFILL( void ) +{ + PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + + if( pArray ) + { + PHB_ITEM pValue = hb_param( 2, IT_ANY ); + + if( pValue ) + { + ULONG ulStart = hb_parnl( 3 ); + ULONG ulCount = hb_parnl( 4 ); + + hb_arrayFill( pArray, + pValue, + ISNUM( 3 ) ? &ulStart : NULL, + ISNUM( 4 ) ? &ulCount : NULL ); + } + + hb_itemReturn( pArray ); /* AFill() returns the array itself */ + } +} + +HARBOUR HB_ASCAN( void ) +{ + PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + PHB_ITEM pValue = hb_param( 2, IT_ANY ); + + if( pArray && pValue ) + { + ULONG ulStart = hb_parnl( 3 ); + ULONG ulCount = hb_parnl( 4 ); + + hb_retnl( hb_arrayScan( pArray, + pValue, + ISNUM( 3 ) ? &ulStart : NULL, + ISNUM( 4 ) ? &ulCount : NULL ) ); + } + else + hb_retnl( 0 ); +} + +HARBOUR HB_AEVAL( void ) +{ + PHB_ITEM pArray = hb_param( 1, IT_ARRAY ); + PHB_ITEM pBlock = hb_param( 2, IT_BLOCK ); + + if( pArray && pBlock ) + { + ULONG ulStart = hb_parnl( 3 ); + ULONG ulCount = hb_parnl( 4 ); + + hb_arrayEval( pArray, + pBlock, + ISNUM( 3 ) ? &ulStart : NULL, + ISNUM( 4 ) ? &ulCount : NULL ); + + hb_itemReturn( pArray ); /* AEval() returns the array itself */ + } + else + hb_errRT_BASE( EG_ARG, 2017, NULL, "AEVAL" ); +} + +HARBOUR HB_ACOPY( void ) +{ + PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY ); + PHB_ITEM pDstArray = hb_param( 2, IT_ARRAY ); + + if( pSrcArray && pDstArray ) + { + /* CA-Cl*pper works this way. */ + if( ! hb_arrayIsObject( pSrcArray ) && ! hb_arrayIsObject( pDstArray ) ) + { + ULONG ulStart = hb_parnl( 3 ); + ULONG ulCount = hb_parnl( 4 ); + ULONG ulTarget = hb_parnl( 5 ); + + hb_arrayCopy( pSrcArray, + pDstArray, + ISNUM( 3 ) ? &ulStart : NULL, + ISNUM( 4 ) ? &ulCount : NULL, + ISNUM( 5 ) ? &ulTarget : NULL ); + } + + hb_itemReturn( pDstArray ); /* ACopy() returns the target array */ + } +} + +/* NOTE: Clipper will return NIL if the parameter is not an array. [vszakats] */ + +HARBOUR HB_ACLONE( void ) +{ + PHB_ITEM pSrcArray = hb_param( 1, IT_ARRAY ); + + if( pSrcArray && ! hb_arrayIsObject( pSrcArray ) ) + { + PHB_ITEM pDstArray = hb_arrayClone( pSrcArray ); + + hb_itemReturn( pDstArray ); /* AClone() returns the new array */ + hb_itemRelease( pDstArray ); + } +} + diff --git a/harbour/source/vm/maindll.c b/harbour/source/vm/maindll.c index f5eab296b7..67499c96f6 100644 --- a/harbour/source/vm/maindll.c +++ b/harbour/source/vm/maindll.c @@ -38,7 +38,7 @@ #include #include "hbvm.h" -#if defined(__BORLAND__) +#if defined(__BORLANDC__) BOOL WINAPI _export #else __declspec(dllexport) BOOL diff --git a/harbour/utils/hbtest/hbtest.prg b/harbour/utils/hbtest/hbtest.prg index 3fd69ed17b..4ad364ef04 100644 --- a/harbour/utils/hbtest/hbtest.prg +++ b/harbour/utils/hbtest/hbtest.prg @@ -200,7 +200,7 @@ STATIC FUNCTION TEST_BEGIN( cParam ) FWrite( s_nFhnd, "---------------------------------------------------------------------------" + HB_OSNewLine() +; " Version: " + Version( 0 ) + HB_OSNewLine() +; " OS: " + OS() + HB_OSNewLine() +; - " Date, Time: " + DToS( Date() ) + " " + Time() + HB_OSNewLine() +; + " Date, Time: " + DToC( Date() ) + " " + Time() + HB_OSNewLine() +; " Output: " + s_cFileName + HB_OSNewLine() +; "Shortcut opt.: " + iif( s_lShortcut, "ON", "OFF" ) + HB_OSNewLine() +; " Switches: " + cParam + HB_OSNewLine() +;