From 319305a9d76aad1eca85b4ffe22b82ceca3acdff Mon Sep 17 00:00:00 2001 From: Martin Vogel Date: Sun, 9 Sep 2001 19:05:13 +0000 Subject: [PATCH] 2001-09-09 21:00 MEST Martin Vogel --- harbour/ChangeLog | 32 + harbour/contrib/libct/Makefile | 7 +- harbour/contrib/libct/ct.prg | 162 +++ harbour/contrib/libct/{ct.c => ctc.c} | 58 +- harbour/contrib/libct/cterror.ch | 19 +- harbour/contrib/libct/ctflist.txt | 14 +- harbour/contrib/libct/makefile.bc | 17 +- harbour/contrib/libct/makefile.vc | 8 +- harbour/contrib/libct/readme.txt | 9 + harbour/contrib/libct/temper.c | 67 -- harbour/contrib/libct/tests/Makefile | 1 + harbour/contrib/libct/tests/token2.prg | 185 ++++ harbour/contrib/libct/token2.c | 1257 ++++++++++++++++++++++++ 13 files changed, 1710 insertions(+), 126 deletions(-) create mode 100644 harbour/contrib/libct/ct.prg rename harbour/contrib/libct/{ct.c => ctc.c} (87%) delete mode 100644 harbour/contrib/libct/temper.c create mode 100644 harbour/contrib/libct/tests/token2.prg create mode 100644 harbour/contrib/libct/token2.c diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 48049d745d..7b50f5a254 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,35 @@ +2001-09-09 21:00 MEST Martin Vogel + + + contrib/libct/token2.c + + Incremental tokenizer: TOKENINIT(), TOKENEXIT(), TOKENNEXT() + TOKENNUM(), TOKENAT(), SAVETOKEN() + RESTTOKEN(), TOKENEND() + with some enhanced functionality + + + contrib/libct/tests/token2.prg + + test program for incremental tokenizer + + - contrib/libct/ct.c + + contrib/libct/ctc.c + ! file renamed from ct.c to ctc.c, contains now C part of lib init/exit + code + + + contrib/libct/ct.prg + ! contains PRG part of lib init/exit code + + - contrib/libct/temper.c + ! file removed since CELSIUS() and FAHRENHEIT() functions have already + been implemted in num1.c + + * contrib/libct/Makefile + * contrib/libct/makefile.bc + * contrib/libct/makefile.vc + * contrib/libct/cterror.ch + * contrib/libct/ctflist.txt + * contrib/libct/readme.txt + * changes according to the above + + 2001-09-09 15:48 GMT+2 Maurilio Longo + contrib/hgf/os2pm/winctrl.prg + added diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index 194e363f37..d7ae8e3afb 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -22,7 +22,7 @@ C_SOURCES = \ charsort.c \ charswap.c \ count.c \ - ct.c \ + ctc.c \ ctmath.c \ ctset.c \ ctstr.c \ @@ -31,7 +31,7 @@ C_SOURCES = \ ctcrypt.c \ finan.c \ justify.c \ - files.c \ + files.c \ math.c \ num1.c \ numat.c \ @@ -45,12 +45,13 @@ C_SOURCES = \ replace.c \ strswap.c \ token1.c \ + token2.c \ trig.c \ - temper.c \ wordrepl.c \ wordtoch.c \ PRG_SOURCES= \ + ct.prg \ ctmisc.prg \ LIBNAME=libct diff --git a/harbour/contrib/libct/ct.prg b/harbour/contrib/libct/ct.prg new file mode 100644 index 0000000000..f52643cb85 --- /dev/null +++ b/harbour/contrib/libct/ct.prg @@ -0,0 +1,162 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 general functions (PRG part) + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries 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 Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +static sbInitialized := .F. + + +/* $DOC$ + * $FUNCNAME$ + * CTINIT() + * $CATEGORY$ + * CT3 general functions + * $ONELINER$ + * Initializes the CT3 library + * $SYNTAX$ + * CTINIT () -> lInitialized + * $ARGUMENTS$ + * None + * $RETURNS$ + * lInitialized .T. if the function has been correctly initialized + * $DESCRIPTION$ + * The CTINIT() function initializes the CT3 library. + * Identical code is declared as INIT FUNCTION, thus should be executed + * automatically at the beginning of the application, but it is a good + * idea to call it once again explicitly somewhere at the beginning of + * your program to check the initialization. + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CTINIT() is a new function in Harbour's CT3 library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is ct.prg, library is libct. + * $SEEALSO$ + * $END$ + */ + +function CTINIT() + + if !sbInitialized + sbInitialized := ctcinit() + endif + +return (sbInitialized) + +init function _CTINIT() + + if !sbInitialized + sbInitialized := ctcinit() + endif + +return (sbInitialized) + + +/* $DOC$ + * $FUNCNAME$ + * CTEXIT() + * $CATEGORY$ + * CT3 general functions + * $ONELINER$ + * Uninitializes the CT3 library + * $SYNTAX$ + * CTEXIT () -> nil + * $ARGUMENTS$ + * none + * $RETURNS$ + * nil + * $DESCRIPTION$ + * The CTEXIT() function uninitializes the CT3 library. + * Identical code is declared as EXIT FUNCTION, thus should be executed + * automatically at the end of the application, but it is a good idea + * to call it explicitly somewhere at the end of your program to make + * sure that the deinitialization takes place. + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * CTEXIT() is a new function in Harbour's CT3 library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is ct.prg, library is libct. + * $SEEALSO$ + * $END$ + */ + +function CTEXIT() + + if (sbInitialized) + /* call tokenexit to release static token environment */ + tokenexit() + ctcexit() + sbInitialized := .F. + endif + +return (nil) + +exit function _CTEXIT() + + if (sbInitialized) + /* call tokenexit to release static token environment */ + tokenexit() + ctcexit() + sbInitialized := .F. + endif + +return (nil) diff --git a/harbour/contrib/libct/ct.c b/harbour/contrib/libct/ctc.c similarity index 87% rename from harbour/contrib/libct/ct.c rename to harbour/contrib/libct/ctc.c index a7e0ffa7d7..73432ab302 100644 --- a/harbour/contrib/libct/ct.c +++ b/harbour/contrib/libct/ctc.c @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * CT3 general functions + * CT3 general functions (C part) * * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany * Author: Martin Vogel @@ -265,35 +265,36 @@ static int s_initialized = 0; /* TODO: make this thread safe */ /* $DOC$ * $FUNCNAME$ - * CTINIT() + * CTCINIT() * $CATEGORY$ * CT3 general functions * $ONELINER$ - * Initializes the CT3 library + * Initializes the CT3 library, C part * $SYNTAX$ - * CTINIT () -> lInitialized + * CTCINIT () -> lInitialized * $ARGUMENTS$ * None * $RETURNS$ * lInitialized .T. if the function has been correctly initialized * $DESCRIPTION$ - * The CTINIT() function initializes the CT3 library. Always call it - * once somewhere at the beginning of your program. + * The CTCINIT() function initializes the C source part of the CT3 + * library. Do not call this function directly. * $EXAMPLES$ * $TESTS$ * $STATUS$ * Ready * $COMPLIANCE$ - * CTINIT() is a new function in Harbour's CT3 library. + * CTCINIT() is a new function in Harbour's CT3 library. * $PLATFORMS$ * All * $FILES$ - * Source is ct.c, library is libct. + * Source is ctc.c, library is libct. * $SEEALSO$ + * CTINIT(),CTEXIT() * $END$ */ -HB_FUNC (CTINIT) +HB_FUNC (CTCINIT) { if (s_initialized == 0) @@ -304,16 +305,6 @@ HB_FUNC (CTINIT) s_initialized = iSuccess; } - if (hb_pcount() > 0) /* CTINIT accepts no params */ - { - int iArgErrorMode = ct_getargerrormode(); - if (iArgErrorMode != CT_ARGERR_IGNORE) - { - ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CTINIT, - NULL, "CTINIT", 0, EF_CANDEFAULT, 1, hb_paramError (1)); - } - } - hb_retl (s_initialized); } @@ -321,50 +312,43 @@ HB_FUNC (CTINIT) /* $DOC$ * $FUNCNAME$ - * CTEXIT() + * CTCEXIT() * $CATEGORY$ * CT3 general functions * $ONELINER$ - * Uninitializes the CT3 library + * Uninitializes the CT3 library, C part * $SYNTAX$ - * CTEXIT () -> nil + * CTCEXIT () -> nil * $ARGUMENTS$ * none * $RETURNS$ * nil * $DESCRIPTION$ - * The CTEXIT() function uninitializes the CT3 library. Always call it - * somewhere at the end of your program. + * The CTCEXIT() function uninitializes the C part of the CT3 library. + * Do not call this function directly. * $EXAMPLES$ * $TESTS$ * $STATUS$ * Ready * $COMPLIANCE$ - * CTEXIT() is a new function in Harbour's CT3 library. + * CTCEXIT() is a new function in Harbour's CT3 library. * $PLATFORMS$ * All * $FILES$ - * Source is ct.c, library is libct. + * Source is ctc.c, library is libct. * $SEEALSO$ + * CTINIT(),CTEXIT() * $END$ */ -HB_FUNC (CTEXIT) +HB_FUNC (CTCEXIT) { + ct_str_exit(); ct_math_exit(); s_initialized = 0; - if (hb_pcount() > 0) /* CTEXIT accepts no params */ - { - int iArgErrorMode = ct_getargerrormode(); - if (iArgErrorMode != CT_ARGERR_IGNORE) - { - ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CTEXIT, - NULL, "CTEXIT", 0, EF_CANDEFAULT, 1, hb_paramError (1)); - } - } - hb_ret(); + } diff --git a/harbour/contrib/libct/cterror.ch b/harbour/contrib/libct/cterror.ch index 7f3f73e50e..285cf44ff9 100644 --- a/harbour/contrib/libct/cterror.ch +++ b/harbour/contrib/libct/cterror.ch @@ -352,15 +352,16 @@ #define CT_ERROR_TOKENINIT 3954 #define CT_ERROR_TOKENLOWER 3961 #define CT_ERROR_TOKENNEXT 3971 -#define CT_ERROR_TOKENSEP 3981 -#define CT_ERROR_TOKENUPPER 3991 -#define CT_ERROR_VALPOS 4002 -#define CT_ERROR_WORDONE 4011 -#define CT_ERROR_WORDONLY 4021 -#define CT_ERROR_WORDREM 4031 -#define CT_ERROR_WORDREPL 4041 -#define CT_ERROR_WORDSWAP 4051 -#define CT_ERROR_WORDTOCHAR 4061 +#define CT_ERROR_TOKENNUM 3982 +#define CT_ERROR_TOKENSEP 3991 +#define CT_ERROR_TOKENUPPER 4001 +#define CT_ERROR_VALPOS 4012 +#define CT_ERROR_WORDONE 4021 +#define CT_ERROR_WORDONLY 4031 +#define CT_ERROR_WORDREM 4041 +#define CT_ERROR_WORDREPL 4051 +#define CT_ERROR_WORDSWAP 4061 +#define CT_ERROR_WORDTOCHAR 4071 /* number and bit manipulation */ #define CT_ERROR_BITTOC 4111 diff --git a/harbour/contrib/libct/ctflist.txt b/harbour/contrib/libct/ctflist.txt index 913fae0462..fe6da999d9 100644 --- a/harbour/contrib/libct/ctflist.txt +++ b/harbour/contrib/libct/ctflist.txt @@ -241,19 +241,21 @@ REMRIGHT ;S; REPLALL ;S; REPLLEFT ;S; REPLRIGHT ;S; -RESTTOKEN ;N; -SAVETOKEN ;N; +RESTTOKEN ;R; +SAVETOKEN ;R; SETATLIKE ;R; STRDIFF ;N; STRSWAP ;S; TABEXPAND ;N; TABPACK ;N; TOKEN ;R; -TOKENAT ;N; -TOKENEND ;N; -TOKENINIT ;N; +TOKENAT ;R; +TOKENEND ;R; +TOKENEXIT ;R; !NEW! +TOKENINIT ;R; TOKENLOWER ;R; -TOKENNEXT ;N; +TOKENNEXT ;R; +TOKENNUM ;R; !NEW! TOKENSEP ;R; TOKENUPPER ;R; VALPOS ;R; diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index c2ad8058ee..823261ea8e 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -107,7 +107,7 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\charsort.obj \ $(OBJ_DIR)\charswap.obj \ $(OBJ_DIR)\count.obj \ - $(OBJ_DIR)\ct.obj \ + $(OBJ_DIR)\ctc.obj \ $(OBJ_DIR)\ctmath.obj \ $(OBJ_DIR)\ctset.obj \ $(OBJ_DIR)\ctstr.obj \ @@ -129,10 +129,12 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\replace.obj \ $(OBJ_DIR)\strswap.obj \ $(OBJ_DIR)\token1.obj \ + $(OBJ_DIR)\token2.obj \ $(OBJ_DIR)\trig.obj \ $(OBJ_DIR)\wordrepl.obj \ $(OBJ_DIR)\wordtoch.obj \ \ + $(OBJ_DIR)\ct.obj \ $(OBJ_DIR)\ctmisc.obj \ # @@ -220,7 +222,7 @@ $(OBJ_DIR)\count.obj : $(TOOLS_DIR)\count.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, -$(OBJ_DIR)\ct.obj : $(TOOLS_DIR)\ct.c +$(OBJ_DIR)\ctc.obj : $(TOOLS_DIR)\ctc.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, @@ -308,6 +310,10 @@ $(OBJ_DIR)\token1.obj : $(TOOLS_DIR)\token1.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\token2.obj : $(TOOLS_DIR)\token2.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\trig.obj : $(TOOLS_DIR)\trig.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, @@ -320,6 +326,13 @@ $(OBJ_DIR)\wordtoch.obj : $(TOOLS_DIR)\wordtoch.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\ct.c : $(TOOLS_DIR)\ct.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\ct.obj : $(OBJ_DIR)\ct.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\ctmisc.c : $(TOOLS_DIR)\ctmisc.prg $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ diff --git a/harbour/contrib/libct/makefile.vc b/harbour/contrib/libct/makefile.vc index f1c24ba20e..3a342255aa 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -127,7 +127,7 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\charsort.obj \ $(OBJ_DIR)\charswap.obj \ $(OBJ_DIR)\count.obj \ - $(OBJ_DIR)\ct.obj \ + $(OBJ_DIR)\ctc.obj \ $(OBJ_DIR)\ctmath.obj \ $(OBJ_DIR)\ctset.obj \ $(OBJ_DIR)\ctstr.obj \ @@ -149,10 +149,12 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\replace.obj \ $(OBJ_DIR)\strswap.obj \ $(OBJ_DIR)\token1.obj \ + $(OBJ_DIR)\token2.obj \ $(OBJ_DIR)\trig.obj \ $(OBJ_DIR)\wordrepl.obj \ $(OBJ_DIR)\wordtoch.obj \ \ + $(OBJ_DIR)\ct.obj \ $(OBJ_DIR)\ctmisc.obj \ # @@ -181,7 +183,7 @@ CLEAN: -@if exist $(OBJ_DIR)\charsort.* del $(OBJ_DIR)\charsort.* -@if exist $(OBJ_DIR)\charswap.* del $(OBJ_DIR)\charswap.* -@if exist $(OBJ_DIR)\count.* del $(OBJ_DIR)\count.* - -@if exist $(OBJ_DIR)\ct.* del $(OBJ_DIR)\ct.* + -@if exist $(OBJ_DIR)\ctc.* del $(OBJ_DIR)\ctc.* -@if exist $(OBJ_DIR)\ctmath.* del $(OBJ_DIR)\ctmath.* -@if exist $(OBJ_DIR)\ctset.* del $(OBJ_DIR)\ctset.* -@if exist $(OBJ_DIR)\ctstr.* del $(OBJ_DIR)\ctstr.* @@ -203,9 +205,11 @@ CLEAN: -@if exist $(OBJ_DIR)\replace.* del $(OBJ_DIR)\replace.* -@if exist $(OBJ_DIR)\strswap.* del $(OBJ_DIR)\strswap.* -@if exist $(OBJ_DIR)\token1.* del $(OBJ_DIR)\token1.* + -@if exist $(OBJ_DIR)\token2.* del $(OBJ_DIR)\token2.* -@if exist $(OBJ_DIR)\trig.* del $(OBJ_DIR)\trig.* -@if exist $(OBJ_DIR)\wordrepl.* del $(OBJ_DIR)\wordrepl.* -@if exist $(OBJ_DIR)\wordtoch.* del $(OBJ_DIR)\wordtoch.* + -@if exist $(OBJ_DIR)\ct.* del $(OBJ_DIR)\ct.* -@if exist $(OBJ_DIR)\ctmisc.* del $(OBJ_DIR)\ctmisc.* -@if exist $(TOOLS_LIB) del $(TOOLS_LIB) diff --git a/harbour/contrib/libct/readme.txt b/harbour/contrib/libct/readme.txt index ca7fb69b5a..da931f39e9 100644 --- a/harbour/contrib/libct/readme.txt +++ b/harbour/contrib/libct/readme.txt @@ -57,6 +57,15 @@ Martin Vogel * TOKEN() New 5th and 6th parameter where the function can store the tokenizer before and after the extracted token. +* TOKENINIT() all incremental tokenizer functions + TOKENINIT(),TOKENEXIT(),TOKENNEXT(),TOKENNUM(), + TOKENAT(),SAVETOKEN(),RESTTOKEN(),TOKENEND() + now support locally stored token environments + ++ TOKENEXIT() new function related to TOKENINIT + ++ TOKENNUM() numtoken() functionality for incremental tokenizer + * TOKENLOWER() New 4th parameter * TOKENUPPER() New 4th parameter diff --git a/harbour/contrib/libct/temper.c b/harbour/contrib/libct/temper.c deleted file mode 100644 index d771815bc4..0000000000 --- a/harbour/contrib/libct/temper.c +++ /dev/null @@ -1,67 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * Celsius() and FAHRENHEIT() CT3 function - * - * Copyright 2001 Luiz Rafael Culik - * - * 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, or (at your option) - * any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). - * - * As a special exception, the Harbour Project gives permission for - * additional uses of the text contained in its release of Harbour. - * - * The exception is that, if you link the Harbour libraries 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 Harbour library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the Harbour - * Project under the name Harbour. If you copy code from other - * Harbour Project or Free Software Foundation releases into a copy of - * Harbour, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for Harbour, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. - * - */ - -#define HB_OS_WIN_32_USED -#include "hbapi.h" -#include "hbmath.h" - -HB_FUNC(CELSIUS) -{ - double dFarhrenheit=hb_parnd(1); - hb_retnd(((5*dFarhrenheit)-(5*32))/9); -} -HB_FUNC(FAHRENHEIT) -{ - double dCelsius=hb_parnd(1); - hb_retnd(((9*dCelsius)+(5*32))/5); -} diff --git a/harbour/contrib/libct/tests/Makefile b/harbour/contrib/libct/tests/Makefile index 787cd92d5f..5c5b6ef6ef 100644 --- a/harbour/contrib/libct/tests/Makefile +++ b/harbour/contrib/libct/tests/Makefile @@ -72,6 +72,7 @@ PRG_SOURCES=\ numtoken.prg \ setatlik.prg \ token.prg \ + token2.prg \ tokenlow.prg \ tokensep.prg \ tokenupp.prg \ diff --git a/harbour/contrib/libct/tests/token2.prg b/harbour/contrib/libct/tests/token2.prg new file mode 100644 index 0000000000..7042a1964a --- /dev/null +++ b/harbour/contrib/libct/tests/token2.prg @@ -0,0 +1,185 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Test CT3 functions + * - TOKENINIT() + * - TOKENEXIT() + * - TOKENNEXT() + * - TOKENNUM() + * - TOKENAT() + * - SAVETOKEN() + * - RESTTOKEN() + * - TOKENEND() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries 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 Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +#include "../ct.ch" + +procedure main + +local cStr1 := "A,BB,CCC,DDDD,EEEEE,FFFFFF" +local cStr2 := "ZZZZZZ,YYYYY,XXXX,WWW,VV,U" +local cStr3 := "0123456789ABCDEFGHIJKLM" +local cStr4 := "08:09:10:11:12" +local cStr5 := "05:00+20:00+35:00+50:00" +local cStr6 + +local cTE1, cTE2 + + ctinit() + + qout ("Begin test of incremental tokenizer function family") + qout ("") + + // Some simple tests with global token environment + qout ([ Incremental tokenizing the string "]+cStr1+["]) + qout ([ tokeninit (@cStr1, ",", 1) == .T. ? ----> ] + ltoc(tokeninit (@cStr1, ",", 1))) + qout ([ tokennum () == 6 ? ---------------------> ] + str(tokennum ())) + qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend())) + while (!tokenend()) + qout ([ tokennext (@cStr1) ------------------> "] + tokennext(@cStr1)+["]) + qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend())) + enddo + qout () + qout ([ rewind with tokeninit () == .T. ? ------> ] + ltoc(tokeninit ())) + qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend())) + while (!tokenend()) + qout ([ tokennext (@cStr1) ------------------> "] + tokennext(@cStr1)+["]) + qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend())) + enddo + qout () + qout ([ access tokens directly with tokennext]) + qout ([ tokennext (@cStr1,2) == "BB" ? -------> "] + tokennext(@cStr1,2)+["]) + qout ([ tokennext (@cStr1,4) == "DDDD" ? -----> "] + tokennext(@cStr1,4)+["]) + qout () + + qout ("...Press any key...") + qout () + inkey (0) + + qout ([ Incremental tokenizing the string "]+cStr3+[" with the]) + qout ([ token environment of cStr1 !]) + qout ([ rewind with tokeninit () == .T. ? ------> ] + ltoc(tokeninit ())) + qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend())) + while (!tokenend()) + qout ([ tokennext (@cStr3) ------------------> "] + tokennext(@cStr3)+["]) + qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend())) + enddo + qout () + qout ([ rewind with tokeninit () == .T. ? ------> ] + ltoc(tokeninit ())) + qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend())) + while (!tokenend()) + qout ([ start & end with tokenat(.F./.T.)-----> ] + str(tokenat())+[ ]+str(tokenat(.T.))) + tokennext(@cStr1) + qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend())) + enddo + qout () + qout ([ access tokens directly with tokenat]) + qout ([ tokenat (.F.,2) == 3 ? ---------------> ] + str(tokenat(.F.,2))) + qout ([ tokenat (.T.,4) == 14 ? --------------> ] + str(tokenat(.T.,4))) + qout() + + qout ("...Press any key...") + qout () + inkey (0) + + qout ([ Save global token environment with savetoken]) + cTE1 := savetoken() + qout ([ tokeninit a different string, cStr4 := "]+cStr4+[", with tokeninit()]) + qout ([ tokeninit (@cStr4, ":", 1) == .T. ? ----> ] + ltoc(tokeninit (@cStr4, ":", 1))) + qout ([ tokennum () == 5 ? ---------------------> ] + str(tokennum ())) + qout ([ tokennext() == "08" ? ------------------> "]+ tokennext (@cStr4)+["]) + qout ([ Now restore global token environment with resttoken and rewind it]) + resttoken (cTE1) + tokeninit() + qout ([ tokennum () == 6 ? ---------------------> ] + str(tokennum ())) + qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend())) + while (!tokenend()) + qout ([ tokennext (@cStr1) ------------------> "] + tokennext(@cStr1)+["]) + qout ([ tokenend() ? -------------------------> ] + ltoc (tokenend())) + enddo + qout ([ Release global TE with tokenexit () ----> ] + ltoc(tokenexit())) + qout () + + qout ("...Press any key...") + qout () + inkey (0) + + qout ([ Now tokenize cStr4 := "]+cStr4+[" and]) + qout ([ cStr5 := "]+cStr5+["]) + qout ([ and store the token environment locally to cTE1 and cTE2:]) + qout ([ tokeninit (@cStr4, ":", 1, @cTE1) == .T. ? -> ] + ltoc(tokeninit (@cStr4, ":", 1, @cTE1))) + qout ([ tokeninit (@cStr5, "+", 1, @cTE2) == .T. ? -> ] + ltoc(tokeninit (@cStr5, "+", 1, @cTE2))) + qout ([ tokennum (@cTE1) == 5 ? --------------------> ] + str(tokennum (@cTE1))) + qout ([ tokennum (@cTE2) == 4 ? --------------------> ] + str(tokennum (@cTE2))) + qout ([ tokenend (@cTE1) ? ---------------------> ] + ltoc (tokenend (@cTE1))) + qout ([ tokenend (@cTE2) ? ---------------------> ] + ltoc (tokenend (@cTE2))) + while (!tokenend (@cTE1) .AND. !tokenend (@cTE2)) + qout ([ next train at ]+tokennext (cStr4,,@cTE1)+":"+tokennext (cStr5,,@cTE2)) + qout ([ compiled with tokennext (cStr4,,@cTE1)+":"+tokennext (cStr5,,@cTE2)]) + qout ([ tokenend (@cTE1) ? ---------------------> ] + ltoc (tokenend (@cTE1))) + qout ([ tokenend (@cTE2) ? ---------------------> ] + ltoc (tokenend (@cTE2))) + enddo + + qout ("") + qout ("End test of incremental tokenizer function family") + qout () + + qout ("...Press any key...") + qout () + inkey (0) + + ctexit() + +return + + + diff --git a/harbour/contrib/libct/token2.c b/harbour/contrib/libct/token2.c new file mode 100644 index 0000000000..43adf190f0 --- /dev/null +++ b/harbour/contrib/libct/token2.c @@ -0,0 +1,1257 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 string functions + * - TOKENINIT() + * - TOKENEXIT() + * - TOKENNEXT() + * - TOKENNUM() + * - TOKENAT() + * - SAVETOKEN() + * - RESTTOKEN() + * - TOKENEND() + * + * Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany + * Author: Martin Vogel + * + * 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, or (at your option) + * any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries 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 Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + + +#include "ct.h" + + +/* ==================================================================== */ +/* static functions for token environment management */ +/* ==================================================================== */ + + +#define TOKEN_ENVIRONMENT_STEP 100 + +typedef struct _TOKEN_POSITION +{ + size_t sStartPos; /* relative 0-based index of first char of token */ + size_t sEndPos; /* relative 0-based index of first char BEHIND token, + so that length = sEndPos-sStartPos */ +} TOKEN_POSITION; +typedef TOKEN_POSITION * TOKEN_ENVIRONMENT; + + +/* -------------------------------------------------------------------- */ +/* alloc new token environment */ +/* -------------------------------------------------------------------- */ +static TOKEN_ENVIRONMENT sTokEnvNew (void) +{ + + TOKEN_ENVIRONMENT env = (TOKEN_ENVIRONMENT)hb_xalloc (sizeof (TOKEN_POSITION)*(2+TOKEN_ENVIRONMENT_STEP)); + + if (env == NULL) + { + return (NULL); + } + + /* use the first element to store current length and use of token env */ + env[0].sStartPos = 0; /* 0-based index to next free, unused element */ + env[0].sEndPos = 100; /* but there are 100 elements ready for use */ + + /* use second element to store actual index with tokennext() */ + env[1].sStartPos = 0; /* 0-based index value that is to be used NEXT */ + + return (env); + +} + +/* -------------------------------------------------------------------- */ +/* add a tokenizing position to a token environment +/* -------------------------------------------------------------------- */ + +static int sTokEnvAddPos (TOKEN_ENVIRONMENT env, TOKEN_POSITION *pPos) +{ + + size_t index; + + /* new memory needed ? */ + if (env[0].sStartPos == env[0].sEndPos) + { + env = (TOKEN_ENVIRONMENT)hb_xrealloc (env, + sizeof (TOKEN_POSITION)* + (2+env[0].sEndPos+TOKEN_ENVIRONMENT_STEP)); + if (env == NULL) + { + return (0); + } + + env[0].sEndPos += TOKEN_ENVIRONMENT_STEP; + } + + index = env[0].sStartPos+2; /* +2 because of extra elements */ + env[index].sStartPos = pPos->sStartPos; + env[index].sEndPos = pPos->sEndPos; + env[0].sStartPos++; + + return (1); + +} + +/* -------------------------------------------------------------------- */ +/* check to see if token pointer is at end of environment */ +/* -------------------------------------------------------------------- */ + +static int sTokEnvEnd (TOKEN_ENVIRONMENT env) +{ + return (env[1].sStartPos>=env[0].sStartPos); +} + +/* -------------------------------------------------------------------- */ +/* get size of token environment in memory */ +/* -------------------------------------------------------------------- */ + +static size_t sTokEnvGetSize (TOKEN_ENVIRONMENT env) +{ + + return (sizeof (TOKEN_POSITION)* + (2+env[0].sEndPos)); + +} + +/* -------------------------------------------------------------------- */ +/* get position element pointed to by tokenizing pointer */ +/* -------------------------------------------------------------------- */ + +static TOKEN_POSITION *sTokEnvGetPos (TOKEN_ENVIRONMENT env) +{ + + if (env[1].sStartPos>=env[0].sStartPos) + { + return (NULL); + } + + return (env+2+(env[1].sStartPos)); /* "+2" because of extra elements */ + +} + +/* -------------------------------------------------------------------- */ +/* get position element pointed to by given 0-based index */ +/* -------------------------------------------------------------------- */ + +static TOKEN_POSITION *sTokEnvGetPosIndex (TOKEN_ENVIRONMENT env, size_t index) +{ + + if (index>=env[0].sStartPos) + { + return (NULL); + } + + return (env+2+index); /* "+2" because of extra elements */ + +} + +/* -------------------------------------------------------------------- */ +/* increment tokenizing pointer by one */ +/* -------------------------------------------------------------------- */ + +static int sTokEnvIncPtr (TOKEN_ENVIRONMENT env) +{ + + if (env[1].sStartPos>=env[0].sStartPos) + { + return (0); + } + else + { + env[1].sStartPos++; + return (1); + } + +} + +/* -------------------------------------------------------------------- */ +/* set tokenizing pointer to 0-based value */ +/* -------------------------------------------------------------------- */ + +static int sTokEnvSetPtr (TOKEN_ENVIRONMENT env, size_t sCnt) +{ + + if (sCnt >= env[0].sStartPos) + { + return (0); + } + else + { + env[1].sStartPos = sCnt; + return (1); + } + +} + +/* -------------------------------------------------------------------- */ +/* decrement tokenizing pointer by one */ +/* -------------------------------------------------------------------- */ + +static int sTokEnvDecPtr (TOKEN_ENVIRONMENT env) +{ + + if (env[1].sStartPos <= 0) + { + return (0); + } + else + { + env[1].sStartPos--; + return (1); + } + +} + +/* -------------------------------------------------------------------- */ +/* get value of tokenizing pointer */ +/* -------------------------------------------------------------------- */ + +static size_t sTokEnvGetPtr (TOKEN_ENVIRONMENT env) +{ + + return (env[1].sStartPos); + +} + +/* -------------------------------------------------------------------- */ +/* get token count */ +/* -------------------------------------------------------------------- */ + +static size_t sTokEnvGetCnt (TOKEN_ENVIRONMENT env) +{ + + return (env[0].sStartPos); + +} + +/* -------------------------------------------------------------------- */ +/* free token environment */ +/* -------------------------------------------------------------------- */ + +static void sTokEnvDel (TOKEN_ENVIRONMENT env) +{ + + hb_xfree (env); + +} + +/* ==================================================================== */ +/* HARBOUR functions */ +/* ==================================================================== */ + +/* static data */ +/* TODO: make thread safe */ +static const char *spcSeparatorStr = "\x00""\x09""\x0A""\x0C""\x1A""\x20""\x8A""\x8C"",.;:!\?/\\<>()#&%+-*"; +static const size_t ssSeparatorStrLen = 26; + +static TOKEN_ENVIRONMENT ssTokenEnvironment = NULL; + + +/* $DOC$ + * $FUNCNAME$ + * TOKENINIT() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Initializes a token environment + * $SYNTAX$ + * TOKENINIT (<[@]cString>], [], [], + * [<@cTokenEnvironment>]) -> lState + * $ARGUMENTS$ + * <[@]cString> is the processed string + * is a list of characters separating the tokens + * in + * Default: chr(0)+chr(9)+chr(10)+chr(13)+chr(26)+ + * chr(32)+chr(32)+chr(138)+chr(141)+ + * ",.;:!\?/\\<>()#&%+-*" + * specifies the maximum number of successive + * tokenizing characters that are combined as + * ONE token stop, e.g. specifying 1 can + * yield to empty token + * Default: 0, any number of successive tokenizing + * characters are combined as ONE token stop + * <@cTokenEnvironment> is a token environment stored in a binary + * encoded string + * $RETURNS$ + * success of the initialization + * $DESCRIPTION$ + * The TOKENINIT() function initializes a token environment. A token + * environment is the information about how a string is to be tokenized. + * This information is created in the process of tokenization of the + * string - equal to the one used in the TOKEN() function + * with the help of the and parameters. + * + * This token environment can be very useful when large strings have + * to be tokenized since the tokenization has to take place only once + * whereas the TOKEN() function must always start the tokenizing process + * from scratch. + * + * Unlike CTIII, this function provides two mechanisms of storing the + * resulting token environment. If a variable is passed by reference + * as 4th parameter, the token environment is stored in this variable, + * otherwise the global token environment is used. Do not modify the + * token environment string directly ! + * + * Additionally, a counter is stored in the token environment, so that + * the tokens can successivly be obtained. This counter is first set to 1. + * When the TOKENINIT() function is called without a string a tokenize, + * the counter of either the global environment or the environment given + * by reference in the 4th parameter is rewind to 1. + * + * Additionally, unlike CTIII, tokeninit() does not need the string + * to be passed by reference, since one must provide the + * string in calls to TOKENNEXT() again. + * $EXAMPLES$ + * tokeninit (cString) // tokenize the string with default + * // rules and store the token environment globally + * // and eventually delete an old global TE + * tokeninit (@cString) // no difference in result, but eventually faster, + * // since the string must not be copied + * tokeninit() // rewind counter of global TE to 1 + * tokeninit ("1,2,3",",",1) // tokenize constant string, store in global TE + * tokeninit (cString,,1,@cTE1) // tokenize cString and store TE in + * // cTE1 only without overriding global TE + * tokeninit (cString,,1,cTE1) // tokenize cString and store TE in + * // GLOBAL TE since 4th parameter is + * // not given by reference !!! + * tokeninit (,,,@cTE1) // set counter in TE stored in cTE1 to 1 + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * TOKENINIT() is compatible with CTIII's TOKENINIT(), + * but there is an additional parameter featuring local token environments. + * $PLATFORMS$ + * All + * $FILES$ + * Source is token2.c, library is libct. + * $SEEALSO$ + * TOKEN(),TOKENEXIT(),TOKENNEXT(),TOKENNUM(),TOKENAT(),SAVETOKEN(),RESTTOKEN(),TOKENEND() + * $END$ + */ + +HB_FUNC (TOKENINIT) +{ + + if (ISCHAR (1)) + { + + char *pcString = hb_parc (1); + size_t sStrLen = (size_t)hb_parclen (1); + char *pcSeparatorStr; + size_t sSeparatorStrLen; + ULONG ulSkipCnt, ulSkip; + + char *pcSubStr, *pc; + size_t sSubStrLen; + + TOKEN_ENVIRONMENT sTokenEnvironment; + TOKEN_POSITION sTokenPosition; + + /* separator string */ + if (ISCHAR (2) && ((sSeparatorStrLen = hb_parclen (2)) != 0)) + { + pcSeparatorStr = hb_parc (2); + } + else + { + pcSeparatorStr = (char *)spcSeparatorStr; + sSeparatorStrLen = ssSeparatorStrLen; + } + + /* skip width */ + if (ISNUM (3)) + { + ulSkip = hb_parnl (3); + } + else + { + ulSkip = HB_MKULONG (255,255,255,255); + } + if (ulSkip == 0) + { + ulSkip = HB_MKULONG (255,255,255,255); + } + + /* allocate new token environment */ + if ((sTokenEnvironment = sTokEnvNew()) == NULL) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_MEM, CT_ERROR_TOKENINIT, + NULL, "TOKENINIT", 0, EF_CANDEFAULT, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + + hb_retl (0); + return; + } + + pcSubStr = pcString; + sSubStrLen = sStrLen; + + /* scan start condition */ + pc = pcSubStr-1; + + while (1) + { + + size_t sMatchedPos = sSeparatorStrLen; + + /* ulSkip */ + ulSkipCnt = 0; + do + { + sSubStrLen -= (pc-pcSubStr)+1; + pcSubStr = pc+1; + pc = ct_at_charset_forward (pcSubStr, sSubStrLen, + pcSeparatorStr, sSeparatorStrLen, + &sMatchedPos); + ulSkipCnt++; + } while ((ulSkipCnt < ulSkip) && (pc == pcSubStr)); + + if (sSubStrLen == 0) + break; + + sTokenPosition.sStartPos = pcSubStr-pcString; + if (pc == NULL) + { + sTokenPosition.sEndPos = pcSubStr-pcString+sSubStrLen; + } + else + { + sTokenPosition.sEndPos = pc-pcString; + } + + if (!sTokEnvAddPos (sTokenEnvironment, &sTokenPosition)) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_MEM, CT_ERROR_TOKENINIT, + NULL, "TOKENINIT", 0, EF_CANDEFAULT, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + + sTokEnvDel (sTokenEnvironment); + hb_retl (0); + return; + } + + if (pc == NULL) + break; + + } /* while (1); + + /* save token environment to 4th parameter OR to the static */ + if (ISBYREF (4)) + { + hb_storclen ((char *)sTokenEnvironment, + sTokEnvGetSize (sTokenEnvironment), 4); + sTokEnvDel (sTokenEnvironment); + } + else + { + if (ssTokenEnvironment != NULL) + sTokEnvDel (ssTokenEnvironment); + ssTokenEnvironment = sTokenEnvironment; + } + + hb_retl (1); + + } + else /* ISCHAR (1) */ + { + + /* if there is a token environment stored in either the 4th parameter or + in the static variable -> rewind to first token */ + TOKEN_ENVIRONMENT sTokenEnvironment; + + if (ISCHAR (4) && ISBYREF (4)) + { + sTokenEnvironment = (TOKEN_ENVIRONMENT)hb_parc (4); + } + else + { + sTokenEnvironment = ssTokenEnvironment; + } + + if (sTokenEnvironment != NULL) + { + /* rewind to first token */ + hb_retl (sTokEnvSetPtr (sTokenEnvironment, 0)); + if (ISCHAR (4) && ISBYREF (4)) + { + hb_storclen ((char *)sTokenEnvironment,sTokEnvGetSize(sTokenEnvironment),4); + } + } + else + { + /* nothing to rewind -> return .f. */ + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, + CT_ERROR_TOKENINIT, NULL, "TOKENINIT", + 0, EF_CANSUBSTITUTE, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retl (0); + } + } + + } + + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * TOKENNEXT() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Successivly obtains tokens from a string + * $SYNTAX$ + * TOKENNEXT (<[@]cString>, [], + * [<@cTokenEnvironment>]) -> cToken + * $ARGUMENTS$ + * <[@]cString> the processed string + * a token number + * <@cTokenEnvironment> a token environment + * $RETURNS$ + * a token from + * $DESCRIPTION$ + * With TOKENNEXT(), the tokens determined with the TOKENINIT() functions + * can be retrieved. To do this, TOKENNEXT() uses the information stored + * in either the global token environment or the local one supplied by + * . Note that, is supplied, this 3rd parameter has + * always to be passed by reference. + * + * If the 2nd parameter, is given, TOKENNEXT() simply returns + * the th token without manipulating the TE counter. Otherwise + * the token pointed to by the TE counter is returned and the counter + * is incremented by one. Like this, a simple loop with TOKENEND() can + * be used to retrieve all tokens of a string successivly. + * + * Note that does not have to be the same used in TOKENINIT(), + * so that one can do a "correlational tokenization", i.e. tokenize a string + * as if it was another! E.G. using TOKENINIT() with the string + * "AA,BBB" but calling TOKENNEXT() with "CCCEE" would + * give first "CC" and then "EE" (because "CCCEE" is not long enough). + * $EXAMPLES$ + * // default behavhiour + * tokeninit (cString) // initialize a TE + * do while (!tokenend()) + * ? tokennext (cString) // get all tokens successivly + * enddo + * ? tokennext (cString, 3) // get the 3rd token, counter will remain the same + * tokenexit() // free the memory used for the global TE + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * TOKENNEXT() is compatible with CTIII's TOKENNEXT(), + * but there are two additional parameters featuring local token + * environments and optional access to tokens. + * $PLATFORMS$ + * All + * $FILES$ + * Source is token2.c, library is libct. + * $SEEALSO$ + * TOKENINIT(),TOKENEXIT(),TOKENNUM(),TOKENAT(),SAVETOKEN(),RESTTOKEN(),TOKENEND() + * $END$ + */ + +HB_FUNC (TOKENNEXT) +{ + + if (ISCHAR (1)) + { + char *pcString = hb_parc (1); + size_t sStrLen = (size_t)hb_parclen (1); + + TOKEN_ENVIRONMENT sTokenEnvironment; + TOKEN_POSITION *psTokenPosition; + + /* token environment by parameter ... */ + if (ISCHAR (3) && ISBYREF(3)) + { + size_t sStrLen3 = (size_t)hb_parclen (3); + + if (sStrLen3 < sizeof (TOKEN_POSITION)*2) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_TOKENNEXT, + NULL, "TOKENNEXT", 0, EF_CANDEFAULT, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + hb_retc (""); + return; + } + sTokenEnvironment = (TOKEN_ENVIRONMENT)hb_xgrab (sStrLen3); + hb_xmemcpy ((char *)sTokenEnvironment, hb_parc (3), sStrLen3); + + } + else + { + + /* ... or static ? */ + if (ssTokenEnvironment == NULL) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_TOKENNEXT, + NULL, "TOKENNEXT", 0, EF_CANDEFAULT, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + hb_retc (""); + return; + } + sTokenEnvironment = ssTokenEnvironment; + + } + + /* nth token or next token ? */ + if (ISNUM (2)) + { + psTokenPosition = sTokEnvGetPosIndex (sTokenEnvironment, + hb_parnl (2)-1); + /* no increment here */ + } + else + { + psTokenPosition = sTokEnvGetPos (sTokenEnvironment); + /* increment counter */ + sTokEnvIncPtr (sTokenEnvironment); + } + + if ((psTokenPosition == NULL) || + (sStrLen <= psTokenPosition->sStartPos)) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_TOKENNEXT, + NULL, "TOKENNEXT", 0, EF_CANDEFAULT, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + if (ISCHAR (3) && ISBYREF (3)) + { + hb_storclen ((char *)sTokenEnvironment,sTokEnvGetSize(sTokenEnvironment),3); + hb_xfree ((char *)sTokenEnvironment); + } + hb_retc (""); + return; + } + + if (sStrLen < psTokenPosition->sEndPos) + { + hb_retclen (pcString+psTokenPosition->sStartPos, + sStrLen-(psTokenPosition->sStartPos)); + } + else + { + hb_retclen (pcString+psTokenPosition->sStartPos, + (psTokenPosition->sEndPos)-(psTokenPosition->sStartPos)); + } + + if (ISCHAR (3) && ISBYREF (3)) + { + hb_storclen ((char *)sTokenEnvironment,sTokEnvGetSize(sTokenEnvironment),3); + hb_xfree ((char *)sTokenEnvironment); + } + + } + else + { + /* no string given, no token returns */ + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, + CT_ERROR_TOKENNEXT, NULL, "TOKENNEXT", + 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retc (""); + } + } + +} + + +/* $DOC$ + * $FUNCNAME$ + * TOKENNUM() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Get the total number of tokens in a token environment + * $SYNTAX$ + * TOKENNUM ([<@cTokenEnvironment>]) -> nNumberofTokens + * $ARGUMENTS$ + * <@cTokenEnvironment> a token environment + * $RETURNS$ + * number of tokens in the token environment + * $DESCRIPTION$ + * The TOKENNUM() function can be used to retrieve the total number + * of tokens in a token environment. + * If the parameter <@cTokenEnvironment> is supplied (must be by + * reference), the information from this token environment is used, + * otherwise the global TE is used. + * $EXAMPLES$ + * tokeninit ("a.b.c.d", ".", 1) // initialize global TE + * ? tokennum() // --> 4 + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * TOKENNUM() is a new function in Harbour's CTIII library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is token2.c, library is libct. + * $SEEALSO$ + * TOKENINIT(),TOKENEXIT(),TOKENNEXT(),TOKENAT(),SAVETOKEN(),RESTTOKEN(),TOKENEND() + * $END$ + */ + +HB_FUNC (TOKENNUM) +{ + + TOKEN_ENVIRONMENT sTokenEnvironment; + + if (ISCHAR (1) && ISBYREF (1)) + { + sTokenEnvironment = (TOKEN_ENVIRONMENT)hb_parc (1); + } + else + { + sTokenEnvironment = ssTokenEnvironment; + } + + if ((void *)sTokenEnvironment != NULL) + { + hb_retnl (sTokEnvGetCnt (sTokenEnvironment)); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, + CT_ERROR_TOKENNUM, NULL, "TOKENNUM", + 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnl (0); + } + } + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * TOKENEND() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Check whether additional tokens are available with TOKENNEXT() + * $SYNTAX$ + * TOKENEND ([<@cTokenEnvironment>]) -> lTokenEnd + * $ARGUMENTS$ + * <@cTokenEnvironment> a token environment + * $RETURNS$ + * .T., if additional tokens are available + * $DESCRIPTION$ + * The TOKENEND() function can be used to check whether the next + * call to TOKENNEXT() would return a new token. This can not be + * decided with TOKENNEXT() alone, since an empty token cannot be + * distinguished from a "no more" tokens. + * If the parameter <@cTokenEnvironment> is supplied (must be by + * reference), the information from this token environment is used, + * otherwise the global TE is used. + * With a combination of TOKENEND() and TOKENNEXT(), all tokens from a + * string can be retrieved successivly (see example). + * $EXAMPLES$ + * tokeninit ("a.b.c.d", ".", 1) // initialize global TE + * do while (!tokenend()) + * ? tokennext ("a.b.c.d") // get all tokens successivly + * enddo + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * TOKENEND() is compatible with CTIII's TOKENEND(), + * but there are is an additional parameter featuring local token environments. + * $PLATFORMS$ + * All + * $FILES$ + * Source is token2.c, library is libct. + * $SEEALSO$ + * TOKENINIT(),TOKENEXIT(),TOKENNEXT(),TOKENNUM(),TOKENAT(),SAVETOKEN(),RESTTOKEN() + * $END$ + */ + +HB_FUNC (TOKENEND) +{ + + TOKEN_ENVIRONMENT sTokenEnvironment; + + if (ISCHAR (1) && ISBYREF (1)) + sTokenEnvironment = (TOKEN_ENVIRONMENT)hb_parc (1); + else + sTokenEnvironment = ssTokenEnvironment; + + if ((void *)sTokenEnvironment != NULL) + { + hb_retl (sTokEnvEnd (sTokenEnvironment)); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, + CT_ERROR_TOKENEND, NULL, "TOKENEND", + 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + /* it is CTIII behaviour to return .T. if there's no string TOKENINIT'ed */ + hb_retl (1); + } + } + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * TOKENEXIT() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Release global token environment + * $SYNTAX$ + * TOKENEXIT () -> lStaticEnvironmentReleased + * $ARGUMENTS$ + * $RETURNS$ + * .T., if global token environment is successfully released + * $DESCRIPTION$ + * The TOKENEXIT() function releases the memory associated with the + * global token environment. One should use it for every tokeninit() + * using the global TE. Additionally, TOKENEXIT() is implicitly called + * from CTEXIT() to free the memory at library shutdown. + * $EXAMPLES$ + * tokeninit (cString) // initialize a TE + * do while (!tokenend()) + * ? tokennext (cString) // get all tokens successivly + * enddo + * ? tokennext (cString, 3) // get the 3rd token, counter will remain the same + * tokenexit() // free the memory used for the global TE + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * TOKENEXIT() is a new function in Harbour's CTIII library. + * $PLATFORMS$ + * All + * $FILES$ + * Source is token2.c, library is libct. + * $SEEALSO$ + * TOKENINIT(),TOKENNEXT(),TOKENNUM(),TOKENAT(),SAVETOKEN(),RESTTOKEN(),TOKENEND() + * $END$ + */ + +HB_FUNC (TOKENEXIT) +{ + + if (ssTokenEnvironment != NULL) + { + sTokEnvDel (ssTokenEnvironment); + ssTokenEnvironment = NULL; + hb_retl (1); + } + else + { + hb_retl (0); + } + + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * TOKENAT() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Get start and end positions of tokens in a token environment + * $SYNTAX$ + * TOKENAT ([], [], + * [<@cTokenEnvironment>]) -> nPosition + * $ARGUMENTS$ + * .T., if TOKENAT() should return + * the position of the separator character + * BEHIND the token. + * Default: .F., return start position of a token. + * a token number + * <@cTokenEnvironment> a token environment + * $RETURNS$ + * + * $DESCRIPTION$ + * The TOKENAT() function is used to retrieve the start and end position + * of the tokens in a token environment. Note however that the position of + * last character of a token is given by tokenat (.T.)-1 !! + * + * If the 2nd parameter, is given, TOKENAT() returns the + * positions of the th token. Otherwise + * the token pointed to by the TE counter, i.e. the token that will + * be retrieved by TOKENNEXT() _NEXT_ is used. + * + * If the parameter <@cTokenEnvironment> is supplied (must be by + * reference), the information from this token environment is used, + * otherwise the global TE is used. + * $EXAMPLES$ + * $TESTS$ + * tokeninit (cString) // initialize a TE + * do while (!tokenend()) + * ? "From", tokenat(), "to", tokenat(.T.)-1 + * ? tokennext (cString) // get all tokens successivly + * enddo + * ? tokennext (cString, 3) // get the 3rd token, counter will remain the same + * tokenexit() // free the memory used for the global TE + * $STATUS$ + * Ready + * $COMPLIANCE$ + * TOKENAT() is compatible with CTIII's TOKENAT(), + * but there are two additional parameters featuring local token + * environments and optional access to tokens. + * $PLATFORMS$ + * All + * $FILES$ + * Source is token2.c, library is libct. + * $SEEALSO$ + * TOKENINIT(),TOKENEXIT(),TOKENNEXT(),TOKENNUM(),SAVETOKEN(),RESTTOKEN(),TOKENEND() + * $END$ + */ + +HB_FUNC (TOKENAT) +{ + + int iSeparatorPos = 0; + size_t sCurrentIndex; + TOKEN_ENVIRONMENT sTokenEnvironment; + TOKEN_POSITION *psTokenPosition; + + if (ISLOG (1)) + iSeparatorPos = hb_parl (1); + + if (ISCHAR (3) && ISBYREF(3)) + sTokenEnvironment = (TOKEN_ENVIRONMENT)hb_parc (3); + else + sTokenEnvironment = ssTokenEnvironment; + + if ((void *)sTokenEnvironment == NULL) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_TOKENAT, + NULL, "TOKENAT", 0, EF_CANDEFAULT, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + hb_retnl (0); + return; + } + + if (ISNUM (2)) + sCurrentIndex = hb_parnl (2)-1; + else + sCurrentIndex = sTokEnvGetPtr (sTokenEnvironment); + + psTokenPosition = sTokEnvGetPosIndex (sTokenEnvironment, sCurrentIndex); + if (psTokenPosition == NULL) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_TOKENAT, + NULL, "TOKENAT", 0, EF_CANDEFAULT, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + hb_retnl (0); + return; + } + + if (iSeparatorPos) + hb_retnl (psTokenPosition->sEndPos+1); + else + hb_retnl (psTokenPosition->sStartPos+1); + + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * SAVETOKEN() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Save the global token environment + * $SYNTAX$ + * SAVETOKEN () -> cStaticTokenEnvironment + * $ARGUMENTS$ + * $RETURNS$ + * a binary string encoding the global TE + * $DESCRIPTION$ + * The SAVETOKEN() function can be used to store the global TE for future + * use or when two or more incremental tokenizers must the nested. + * Note however that the latter can now be solved with locally stored + * token environments. + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * SAVETOKEN() is compatible with CTIII's SAVETOKEN(), + * $PLATFORMS$ + * All + * $FILES$ + * Source is token2.c, library is libct. + * $SEEALSO$ + * TOKENINIT(),TOKENEXIT(),TOKENNEXT(),TOKENNUM(),TOKENAT(),RESTTOKEN(),TOKENEND() + * $END$ + */ + +HB_FUNC (SAVETOKEN) +{ + + if (ssTokenEnvironment != NULL) + { + hb_retclen ((char *)ssTokenEnvironment, sTokEnvGetSize (ssTokenEnvironment)); + } + else + { + hb_retc (""); + } + + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * RESTTOKEN() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Restore global token environment + * $SYNTAX$ + * RESTTOKEN () -> cOldStaticEnvironment + * $ARGUMENTS$ + * a binary string encoding a TE + * $RETURNS$ + * a string encoding the old global TE + * $DESCRIPTION$ + * The RESTTOKEN() function restores the global TE to the one encoded + * in . This can either be the return value + * of SAVETOKEN() or the value stored in the 4th parameter in a + * TOKENINIT() call. + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Ready + * $COMPLIANCE$ + * RESTTOKEN() is compatible with CTIII's RESTTOKEN(), + * $PLATFORMS$ + * All + * $FILES$ + * Source is token2.c, library is libct. + * $SEEALSO$ + * TOKENINIT(),TOKENEXIT(),TOKENNEXT(),TOKENNUM(),TOKENAT(),SAVETOKEN(),TOKENEND() + * $END$ + */ + +HB_FUNC (RESTTOKEN) +{ + + if (ISCHAR (1)) + { + char *pcString = hb_parc (1); + size_t sStrLen = (size_t)hb_parclen (1); + + TOKEN_ENVIRONMENT sTokenEnvironment; + + if (sStrLen != 0) + { + /* alloc memory for new environment */ + sTokenEnvironment = (TOKEN_ENVIRONMENT)hb_xalloc (sStrLen); + if (sTokenEnvironment == NULL) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_MEM, CT_ERROR_RESTTOKEN, + NULL, "RESTTOKEN", 0, EF_CANDEFAULT, 1, + hb_paramError (1)); + } + hb_retc (""); + return; + } + hb_xmemcpy (sTokenEnvironment, pcString, sStrLen); + } + else + { + /* restored env has length 0 */ + sTokenEnvironment = NULL; + } + + /* return current environment, then delete it */ + if (ssTokenEnvironment != NULL) + { + hb_retclen ((char *)ssTokenEnvironment, sTokEnvGetSize (ssTokenEnvironment)); + sTokEnvDel (ssTokenEnvironment); + } + else + { + hb_retc (""); + } + + ssTokenEnvironment = sTokenEnvironment; + + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, + CT_ERROR_RESTTOKEN, NULL, "RESTTOKEN", + 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retc (""); + } + } + + return; + +} + + +