diff --git a/harbour/ChangeLog b/harbour/ChangeLog index d860f0ae7a..d806a51213 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,20 @@ +2001-07-23 22:30 MEST Martin Vogel + + - contrib/libct/ctposupp.c + ! merged into pos1.c + + contrib/libct/pos1.c + + POSALPHA(), POSLOWER(), POSRANGE(), POSUPPER() functions + + contrib/libct/pos2.c + + POSCHAR(), POSDEL(), POSINS(), POSREPL() functions + + contrib/libct/posdiff.c + + POSDIFF() & POSEQUAL() functions + + * contrib/libct/Makefile + * contrib/libct/makefile.bc + * contrib/libct/makefile.vc + + pos1.c, pos2.c and posdiff.c added + - ctposupp.c removed + 2001-07-23 18:24 GMT Dave Pearson * source/rtl/profiler.prg diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index 0a0c4bbabc..b3f0c5e890 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -29,11 +29,13 @@ C_SOURCES = \ ctchksum.c \ ctcolton.c \ ctcrypt.c \ - ctposupp.c \ - finan.c \ + finan.c \ justify.c \ math.c \ num1.c \ + pos1.c \ + pos2.c \ + posdiff.c \ relation.c \ token1.c \ trig.c \ diff --git a/harbour/contrib/libct/ctflist.txt b/harbour/contrib/libct/ctflist.txt index 58a23cb26f..7c5bee4b24 100644 --- a/harbour/contrib/libct/ctflist.txt +++ b/harbour/contrib/libct/ctflist.txt @@ -223,16 +223,16 @@ NUMLINE ;N; NUMTOKEN ;R; PADLEFT ;N; PADRIGHT ;N; -POSALPHA ;N; -POSCHAR ;N; -POSDEL ;N; -POSDIFF ;N; -POSEQUAL ;N; -POSINS ;N; -POSLOWER ;N; -POSRANGE ;N; -POSREPL ;N; -POSUPPER ;R; +POSALPHA ;S; +POSCHAR ;S; +POSDEL ;S; +POSDIFF ;S; +POSEQUAL ;S; +POSINS ;S; +POSLOWER ;S; +POSRANGE ;S; +POSREPL ;S; +POSUPPER ;S; RANGEREM ;N; RANGEREPL ;N; REMALL ;N; diff --git a/harbour/contrib/libct/ctposupp.c b/harbour/contrib/libct/ctposupp.c deleted file mode 100644 index 35886ce5b5..0000000000 --- a/harbour/contrib/libct/ctposupp.c +++ /dev/null @@ -1,71 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * POSUPPER() CA-Tools function - * - * Copyright 1999-2001 Viktor 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, 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 - -#include "hbapi.h" - -HB_FUNC( POSUPPER ) -{ - BYTE * pbyString = ( BYTE * ) hb_parc( 1 ); - ULONG ulLen = hb_parclen( 1 ); - ULONG ulPos; - - for( ulPos = 0; ulPos < ulLen; ulPos++ ) - { - if( isupper( pbyString[ ulPos ] ) ) - hb_retnl( ulPos + 1 ); - } - - hb_retnl( 0 ); -} - diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index 91e1e89cea..64964c8bcd 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -114,11 +114,13 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\ctchksum.obj \ $(OBJ_DIR)\ctcolton.obj \ $(OBJ_DIR)\ctcrypt.obj \ - $(OBJ_DIR)\ctposupp.obj \ $(OBJ_DIR)\finan.obj \ $(OBJ_DIR)\justify.obj \ $(OBJ_DIR)\math.obj \ $(OBJ_DIR)\num1.obj \ + $(OBJ_DIR)\pos1.obj \ + $(OBJ_DIR)\pos2.obj \ + $(OBJ_DIR)\posdiff.obj \ $(OBJ_DIR)\relation.obj \ $(OBJ_DIR)\token1.obj \ $(OBJ_DIR)\trig.obj \ @@ -239,10 +241,6 @@ $(OBJ_DIR)\ctcrypt.obj : $(TOOLS_DIR)\ctcrypt.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, -$(OBJ_DIR)\ctposupp.obj : $(TOOLS_DIR)\ctposupp.c - $(CC) $(CLIBFLAGS) -o$@ $** - tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, - $(OBJ_DIR)\finan.obj : $(TOOLS_DIR)\finan.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, @@ -259,6 +257,18 @@ $(OBJ_DIR)\num1.obj : $(TOOLS_DIR)\num1.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\pos1.obj : $(TOOLS_DIR)\pos1.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\pos2.obj : $(TOOLS_DIR)\pos2.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\posdiff.obj : $(TOOLS_DIR)\posdiff.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\relation.obj : $(TOOLS_DIR)\relation.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/contrib/libct/makefile.vc b/harbour/contrib/libct/makefile.vc index 8eb0670b60..5cc540fe1c 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -134,11 +134,13 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\ctchksum.obj \ $(OBJ_DIR)\ctcolton.obj \ $(OBJ_DIR)\ctcrypt.obj \ - $(OBJ_DIR)\ctposupp.obj \ $(OBJ_DIR)\finan.obj \ $(OBJ_DIR)\justify.obj \ $(OBJ_DIR)\math.obj \ $(OBJ_DIR)\num1.obj \ + $(OBJ_DIR)\pos1.obj \ + $(OBJ_DIR)\pos2.obj \ + $(OBJ_DIR)\posdiff.obj \ $(OBJ_DIR)\relation.obj \ $(OBJ_DIR)\token1.obj \ $(OBJ_DIR)\trig.obj \ @@ -179,11 +181,13 @@ CLEAN: -@if exist $(OBJ_DIR)\ctchksum.* del $(OBJ_DIR)\ctchksum.* -@if exist $(OBJ_DIR)\ctcolton.* del $(OBJ_DIR)\ctcolton.* -@if exist $(OBJ_DIR)\ctcrypt.* del $(OBJ_DIR)\ctcrypt.* - -@if exist $(OBJ_DIR)\ctposupp.* del $(OBJ_DIR)\ctposupp.* -@if exist $(OBJ_DIR)\finan.* del $(OBJ_DIR)\finan.* -@if exist $(OBJ_DIR)\justify.* del $(OBJ_DIR)\justify.* -@if exist $(OBJ_DIR)\math.* del $(OBJ_DIR)\math.* -@if exist $(OBJ_DIR)\num1.* del $(OBJ_DIR)\num1.* + -@if exist $(OBJ_DIR)\pos1.* del $(OBJ_DIR)\pos1.* + -@if exist $(OBJ_DIR)\pos2.* del $(OBJ_DIR)\pos2.* + -@if exist $(OBJ_DIR)\posdiff.* del $(OBJ_DIR)\posdiff.* -@if exist $(OBJ_DIR)\relation.* del $(OBJ_DIR)\relation.* -@if exist $(OBJ_DIR)\token1.* del $(OBJ_DIR)\token1.* -@if exist $(OBJ_DIR)\trig.* del $(OBJ_DIR)\trig.* diff --git a/harbour/contrib/libct/pos1.c b/harbour/contrib/libct/pos1.c new file mode 100644 index 0000000000..d6b308d3bc --- /dev/null +++ b/harbour/contrib/libct/pos1.c @@ -0,0 +1,370 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * POSALPHA(), POSLOWER(), POSRANGE() and POSUPPER() CT3 string functions + * + * POSUPPER() Copyright 1999-2001 Viktor Szakats + * + * POSALPHA(), POSLOWER(), POSRANGE() + * 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" +#include + + +/* defines */ +#define DO_POS1_POSALPHA 0 +#define DO_POS1_POSLOWER 1 +#define DO_POS1_POSRANGE 2 +#define DO_POS1_POSUPPER 3 + +/* helper function for the posxxx() functions */ +static void do_pos1 (int iSwitch) +{ + + if ((ISCHAR (1)) /* all functions need string as 1st param */ + && + ((iSwitch != DO_POS1_POSRANGE) /* that's the only condition for all funcs _except_ POSRANGE */ + || + ((iSwitch == DO_POS1_POSRANGE) /* In addition, POSRANGE needs .. */ + && + (ISCHAR (2)) /* .. string as 2nd .. */ + && + (ISCHAR (3)) /* .. and 3rd param */ + ) + ) + ) + { + + char *pcString; + size_t sStrLen; + unsigned char *puc, ucChar1, ucChar2; + int iMode; + size_t sIgnore; + int iParamShift = 0; + + if (iSwitch == DO_POS1_POSRANGE) + { + + if (hb_parclen (1) == 0) + { + hb_retnl (0); + return; + } + else + { + ucChar1 = *(hb_parc (1)); + } + + if (hb_parclen (2) == 0) + { + hb_retnl (0); + return; + } + else + { + ucChar2 = *(hb_parc (2)); + } + + iParamShift += 2; + } + + pcString = hb_parc (iParamShift+1); + sStrLen = (size_t)hb_parclen (iParamShift+1); + + if (ISLOG (iParamShift+2)) + iMode = hb_parl (iParamShift+2); + else + iMode = 0; + + if (ISNUM (iParamShift+3)) + sIgnore = (size_t)hb_parnl (iParamShift+3); + else + sIgnore = 0; + + for (puc = pcString+sIgnore; puc < pcString+sStrLen; puc++) + { + int iDoRet; + switch (iSwitch) + { + case DO_POS1_POSALPHA: + { + iDoRet = isalpha(*puc); + }; break; + + case DO_POS1_POSLOWER: + { + iDoRet = islower(*puc); + }; break; + + case DO_POS1_POSRANGE: + { + iDoRet = ((ucChar1 <= *puc) && (ucChar2 >= *puc)); + }; break; + + case DO_POS1_POSUPPER: + { + iDoRet = isupper(*puc); + }; break; + } + + if ((iMode && iDoRet) || (!iMode && !iDoRet)) + { + hb_retnl (puc-pcString+1); + return; + } + } + + hb_retnl (0); + + } + else /* ISCHAR (1) etc. */ + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + switch (iSwitch) + { + case DO_POS1_POSALPHA: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSALPHA, + NULL, "POSALPHA", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), hb_paramError (3)); + }; break; + + case DO_POS1_POSLOWER: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSLOWER, + NULL, "POSLOWER", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), hb_paramError (3)); + }; break; + + case DO_POS1_POSRANGE: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSRANGE, + NULL, "POSRANGE", 0, EF_CANSUBSTITUTE, 5, + hb_paramError (1), hb_paramError (2), hb_paramError (3), + hb_paramError (4), hb_paramError (5)); + }; break; + + case DO_POS1_POSUPPER: + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSUPPER, + NULL, "POSUPPER", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), hb_paramError (3)); + }; break; + } + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + hb_retnl (0); + } + } + + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * POSALPHA() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Left-most position of a letter in a string + * $SYNTAX$ + * POSALPHA (, [], []) -> nPosition + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * POSALPHA() is compatible with CT3's POSALPHA(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is pos1.c, library is libct. + * $SEEALSO$ + * POSLOWER(),POSUPPER(),POSRANGE() + * $END$ + */ + +HB_FUNC (POSALPHA) +{ + + do_pos1 (DO_POS1_POSALPHA); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * POSLOWER() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Left-most position of a lowercase letter in a string + * $SYNTAX$ + * POSLOWER (, [], []) -> nPosition + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * POSLOWER() is compatible with CT3's POSLOWER(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is pos1.c, library is libct. + * $SEEALSO$ + * POSALPHA(),POSUPPER(),POSRANGE() + * $END$ + */ + +HB_FUNC (POSLOWER) +{ + + do_pos1 (DO_POS1_POSLOWER); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * POSRANGE() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Left-most position of a character from a set in a string + * $SYNTAX$ + * POSRANGE (, , , [], + * []) -> nPosition + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * POSRANGE() is compatible with CT3's POSRANGE(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is pos1.c, library is libct. + * $SEEALSO$ + * POSALPHA(),POSLOWER(),POSUPPER() + * $END$ + */ + +HB_FUNC (POSRANGE) +{ + + do_pos1 (DO_POS1_POSRANGE); + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * POSUPPER() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Left-most position of an uppercase letter in a string + * $SYNTAX$ + * POSUPPER (, [], []) -> nPosition + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * POSUPPER() is compatible with CT3's POSUPPER(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is pos1.c, library is libct. + * $SEEALSO$ + * POSALPHA(),POSLOWER(),POSRANGE() + * $END$ + */ + +HB_FUNC (POSUPPER) +{ + + do_pos1 (DO_POS1_POSUPPER); + return; + +} diff --git a/harbour/contrib/libct/pos2.c b/harbour/contrib/libct/pos2.c new file mode 100644 index 0000000000..41ca5e0c10 --- /dev/null +++ b/harbour/contrib/libct/pos2.c @@ -0,0 +1,649 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * POSCHAR(), POSDEL(), POSINS() and POSREPL() CT3 functions + * + * 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" + + +/* $DOC$ + * $FUNCNAME$ + * POSCHAR() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Replace character at a certain position within a string + * $SYNTAX$ + * POSCHAR (<[@]cString>, , []) -> cString + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * POSCHAR() is compatible with CT3's POSCHAR(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is pos2.c, library is libct. + * $SEEALSO$ + * POSDEL(),POSINS(),POSREPL(),CSETREF() + * $END$ + */ + +HB_FUNC (POSCHAR) +{ + + int iNoRet; + + iNoRet = ct_getref(); + + if (hb_parclen (1) > 0) + { + if ((hb_parclen (2) > 0) || ISNUM (2)) + { + char *pcString = hb_parc (1); + size_t sStrLen = hb_parclen (1); + char *pcRet; + char cReplace; + size_t sPosition; + + if (ISCHAR (2)) + { + cReplace = *(hb_parc (2)); + } + else + { + cReplace = hb_parnl (2)%256; + } + + if (ISNUM (3)) + { + sPosition = hb_parnl (3); + if (sPosition == 0) + { + sPosition = sStrLen; + } + } + else + { + sPosition = sStrLen; + } + + pcRet = hb_xgrab (sStrLen); + hb_xmemcpy (pcRet, pcString, sStrLen); + *(pcRet+sPosition-1) = cReplace; + + if (ISBYREF (1)) + { + hb_storclen (pcRet, sStrLen, 1); + } + + if (iNoRet) + { + hb_ret(); + } + else + { + hb_retclen (pcRet, sStrLen); + } + + hb_xfree (pcRet); + + } + else /* (hb_parclen (2) > 0) || ISNUM (2) */ + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSCHAR, + NULL, "POSCHAR", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), hb_paramError (3)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + if (iNoRet) + { + hb_ret(); + } + else + { + hb_retclen (hb_parc (1), hb_parclen (1)); + } + } + } + } + else /* hb_parclen (1) > 0 */ + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSCHAR, + NULL, "POSCHAR", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), hb_paramError (3)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + if (iNoRet) + hb_ret(); + else + hb_retc (""); + } + } + +} + + +/* $DOC$ + * $FUNCNAME$ + * POSDEL() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Delete characters at a certain position within a string + * $SYNTAX$ + * POSDEL (, [], ) -> cString + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * POSDEL() is compatible with CT3's POSDEL(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is pos2.c, library is libct. + * $SEEALSO$ + * POSCHAR(),POSINS(),POSREPL() + * $END$ + */ + +HB_FUNC (POSDEL) +{ + + if (ISCHAR (1)) + { + + char *pcString = hb_parc (1); + size_t sStrLen = hb_parclen (1); + size_t sStartPos, sDelLen; + char *pcRet; + + if (ISNUM (3)) + { + sDelLen = hb_parnl (3); + } + else + { + sDelLen = 1; /* set new standard behavior */ + } + + if (ISNUM (2)) + { + sStartPos = hb_parnl (2); + if (sStartPos == 0) + { + sStartPos = sStrLen-sDelLen+1; + } + } + else + { + sStartPos = sStrLen-sDelLen+1; + } + + pcRet = hb_xgrab (sStrLen-sDelLen); + + /* copy first part */ + if (sStartPos > 1) + { + hb_xmemcpy (pcRet, pcString, sStartPos-1); + } + + /* copy second part */ + if (sStrLen > (sStartPos-1+sDelLen)) + { + hb_xmemcpy (pcRet+sStartPos-1, pcString+sStartPos-1+sDelLen, + sStrLen-(sStartPos-1+sDelLen)); + } + + hb_retclen (pcRet, sStrLen-sDelLen); + hb_xfree (pcRet); + + } + else /* ISCHAR (1) */ + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSDEL, + NULL, "POSDEL", 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$ + * POSINS() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Insert characters at a certain position within a string + * $SYNTAX$ + * POSINS (, , []) -> cString + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * POSINS() is compatible with CT3's POSINS(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is pos2.c, library is libct. + * $SEEALSO$ + * POSCHAR,POSDEL(),POSREPL() + * $END$ + */ + +HB_FUNC (POSINS) +{ + + if (ISCHAR (1)) + { + + char *pcString = hb_parc (1); + size_t sStrLen = hb_parclen (1); + char *pcInsert; + size_t sInsLen; + + if ((sInsLen = hb_parclen (2)) > 0) + { + + size_t sStartPos; + char *pcRet; + + pcInsert = hb_parc (2); + + if (ISNUM (3)) + { + sStartPos = hb_parnl (3); + if (sStartPos == 0) + { + sStartPos = sStrLen; + } + } + else + { + sStartPos = sStrLen; + } + + /* check for false sStartPos */ + if (sStartPos > sStrLen+1) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSINS, + NULL, "POSINS", 0, EF_CANDEFAULT, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + hb_retclen (pcString, sStrLen); + return; + } + + pcRet = hb_xgrab (sStrLen+sInsLen); + + /* copy first part */ + if (sStartPos > 1) + { + hb_xmemcpy (pcRet, pcString, sStartPos-1); + } + + /* insert string */ + hb_xmemcpy (pcRet+sStartPos-1, pcInsert, sInsLen); + + /* copy second part */ + if (sStrLen > (sStartPos-1)) + { + hb_xmemcpy (pcRet+sStartPos-1+sInsLen, pcString+sStartPos-1, + sStrLen-(sStartPos-1)); + } + + hb_retclen (pcRet, sStrLen+sInsLen); + hb_xfree (pcRet); + + } + else /* hb_parclen (2) > 0 */ + { + hb_retclen (pcString, sStrLen); + } + + } + else /* ISCHAR (1) */ + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSINS, + NULL, "POSINS", 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$ + * POSREPL() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * Replace characters at a certain position within a string + * $SYNTAX$ + * POSREPL (<[@]cString>, , []) -> cString + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * POSREPL() is compatible with CT3's POSREPL(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is pos2.c, library is libct. + * $SEEALSO$ + * POSCHAR(),POSDEL(),POSINS(),CSETREF() + * $END$ + */ + +HB_FUNC (POSREPL) +{ + + int iNoRet; + + iNoRet = ct_getref(); + + if (ISCHAR (1)) + { + + char *pcString = hb_parc (1); + size_t sStrLen = hb_parclen (1); + char *pcReplace; + size_t sReplLen; + + if ((sReplLen = hb_parclen (2)) > 0) + { + + size_t sStartPos; + char *pcRet; + size_t sRetLen; + + pcReplace = hb_parc (2); + + if (ISNUM (3)) + { + sStartPos = hb_parnl (3); + if (sStartPos == 0) + { + if (sReplLen > sStrLen) + { + sStartPos = 1; + } + else + { + sStartPos = sStrLen-sReplLen+1; + } + } + } + else + { + if (sReplLen > sStrLen) + { + sStartPos = 1; + } + else + { + sStartPos = sStrLen-sReplLen+1; + } + } + + /* check for false sStartPos */ + if (sStartPos > sStrLen+1) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSREPL, + NULL, "POSREPL", 0, EF_CANDEFAULT, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + if (iNoRet) + { + hb_ret(); + } + else + { + hb_retclen (pcString, sStrLen); + } + + return; + } + + if (sStrLen > (sStartPos+sReplLen-1)) + { + sRetLen = sStrLen; + } + else + { + sRetLen = sStartPos+sReplLen-1; + } + + pcRet = hb_xgrab (sRetLen); + + /* copy first part */ + if (sStartPos > 1) + { + hb_xmemcpy (pcRet, pcString, sStartPos-1); + } + + /* insert replacement string */ + hb_xmemcpy (pcRet+sStartPos-1, pcReplace, sReplLen); + + /* copy second part */ + if (sStrLen > (sStartPos-1+sReplLen)) + { + hb_xmemcpy (pcRet+sStartPos-1+sReplLen, pcString+sStartPos-1+sReplLen, + sStrLen-(sStartPos-1+sReplLen)); + } + + if (iNoRet) + { + hb_ret(); + } + else + { + hb_retclen (pcRet, sRetLen); + } + + if (ISBYREF (1)) + { + hb_storclen (pcRet, sRetLen, 1); + } + + hb_xfree (pcRet); + + } + else /* hb_parclen (2) > 0 */ + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSREPL, + NULL, "POSREPL", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), hb_paramError (3)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + if (iNoRet) + { + hb_ret(); + } + else + { + hb_retclen (pcString, sStrLen); + } + } + } + + } + else /* ISCHAR (1) */ + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSREPL, + NULL, "POSREPL", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), hb_paramError (3)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + if (iNoRet) + { + hb_ret(); + } + else + { + hb_retc (""); + } + } + + } + +} + + + + diff --git a/harbour/contrib/libct/posdiff.c b/harbour/contrib/libct/posdiff.c new file mode 100644 index 0000000000..cbebda9e2a --- /dev/null +++ b/harbour/contrib/libct/posdiff.c @@ -0,0 +1,315 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * POSDIFF() and POSEQUAL() CT3 string functions + * + * 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" + + +/* $DOC$ + * $FUNCNAME$ + * POSDIFF() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * The left-most position there two string differ + * $SYNTAX$ + * POSDIFF (, , []) -> nPosition + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * POSDIFF() is compatible with CT3's POSDIFF(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is posdiff.c, library is libct. + * $SEEALSO$ + * POSEQUAL() + * $END$ + */ + +HB_FUNC (POSDIFF) +{ + + if (ISCHAR (1) && ISCHAR (2)) + { + + char *pcString1 = hb_parc (1); + size_t sStrLen1 = hb_parclen (1); + char *pcString2 = hb_parc (2); + size_t sStrLen2 = hb_parclen (2); + char *pc1, *pc2; + + size_t sIgnore; + + if (ISNUM (3)) + sIgnore = hb_parnl (3); + else + sIgnore = 0; + + if ((sIgnore > sStrLen1) || (sIgnore > sStrLen2)) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSDIFF, + NULL, "POSDIFF", 0, EF_CANDEFAULT, 3, + hb_paramError (1), hb_paramError (2), + hb_paramError (3)); + } + + hb_retnl (0); + return; + } + + if (sStrLen1 != sStrLen2) + { + hb_retnl ((sStrLen1 < sStrLen2 ? sStrLen1 : sStrLen2)+1); + return; + } + + pc1 = pcString1+sIgnore; + pc2 = pcString2+sIgnore; + + while (pc1 < pcString1+sStrLen1) + { + if (*pc1 != *pc2) + { + hb_retnl ((pc1-pcString1)+1); + return; + } + pc1++; + pc2++; + } + + hb_retnl (0); + + } + else /* (ISCHAR (1) && ISCHAR (2)) */ + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSDIFF, + NULL, "POSDIFF", 0, EF_CANSUBSTITUTE, 3, + hb_paramError (1), hb_paramError (2), hb_paramError (3)); + } + + if (pSubst != NULL) + { + hb_itemReturn (pSubst); + hb_itemRelease (pSubst); + } + else + { + if (ISCHAR (1) || ISCHAR (2)) + hb_retnl (1); + else + hb_retnl (0); + } + + } + + return; + +} + + +/* $DOC$ + * $FUNCNAME$ + * POSEQUAL() + * $CATEGORY$ + * CT3 string functions + * $ONELINER$ + * The left-most position there two string begin to be equal + * $SYNTAX$ + * POSEQUAL (, , [], []) -> nPosition + * $ARGUMENTS$ + * $RETURNS$ + * $DESCRIPTION$ + * TODO: add documentation + * $EXAMPLES$ + * $TESTS$ + * $STATUS$ + * Started + * $COMPLIANCE$ + * POSEQUAL() is compatible with CT3's POSEQUAL(). + * $PLATFORMS$ + * All + * $FILES$ + * Source is posdiff.c, library is libct. + * $SEEALSO$ + * POSDIFF() + * $END$ + */ + +HB_FUNC (POSEQUAL) +{ + + if (ISCHAR (1) && ISCHAR (2)) + { + + char *pcString1 = hb_parc (1); + size_t sStrLen1 = hb_parclen (1); + char *pcString2 = hb_parc (2); + size_t sStrLen2 = hb_parclen (2); + char *pc1, *pc2; + + size_t sIgnore, sCompare, sCompareCnt, sRet; + + if (ISNUM (4)) + sIgnore = hb_parnl (4); + else + sIgnore = 0; + + if (ISNUM (3)) + sCompare = hb_parnl (3); + else + sCompare = (sStrLen1 < sStrLen2 ? sStrLen1 : sStrLen2)-sIgnore; + + if ((sCompare == 0) || (sIgnore > sStrLen1) || (sIgnore > sStrLen2)) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSEQUAL, + NULL, "POSEQUAL", 0, EF_CANDEFAULT, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + + hb_retnl (0); + return; + } + + if ((sStrLen1 < (sCompare+sIgnore)) || (sStrLen2 < (sCompare+sIgnore))) + { + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSEQUAL, + NULL, "POSEQUAL", 0, EF_CANDEFAULT, 4, + hb_paramError (1), hb_paramError (2), + hb_paramError (3), hb_paramError (4)); + } + + hb_retnl (0); + return; + } + + pc1 = pcString1+sIgnore; + pc2 = pcString2+sIgnore; + sCompareCnt = 0; + + while (pc1 < pcString1+sStrLen1) + { + if (*pc1 == *pc2) + { + /* save possible return value */ + if (sCompareCnt == 0) + sRet = pc1-pcString1+1; + + sCompareCnt++; + if (sCompareCnt == sCompare) + { + hb_retnl (sRet); + return; + } + } + else + { + /* reset compare counter */ + sCompareCnt = 0; + } + pc1++; + pc2++; + } + + hb_retnl (0); + + } + else /* (ISCHAR (1) && ISCHAR (2)) */ + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + if (iArgErrorMode != CT_ARGERR_IGNORE) + { + pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_POSEQUAL, + NULL, "POSEQUAL", 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_retnl (0); + } + } + + return; + +} + + diff --git a/harbour/contrib/libct/readme.txt b/harbour/contrib/libct/readme.txt index be72185559..ca7fb69b5a 100644 --- a/harbour/contrib/libct/readme.txt +++ b/harbour/contrib/libct/readme.txt @@ -37,6 +37,8 @@ Martin Vogel + CHARSUB() subtracts corresponding ASCII values ++ COSH() hyperbolic cosine + + CSETARGERR() set behaviour on argument errors + CTINIT() library init function @@ -48,6 +50,10 @@ Martin Vogel + SETMATHERR() math error handling ++ SINH() hyperbolic sine + ++ TANH() hyperbolic tangent + * TOKEN() New 5th and 6th parameter where the function can store the tokenizer before and after the extracted token.