fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2001-07-23 22:30 MEST Martin Vogel <vogel@inttec.de>

Browse Source
This commit is contained in:
Martin Vogel
2001-07-23 19:23:34 +00:00
parent ba0478158a
commit 4ed4b8024d
10 changed files with 1392 additions and 90 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
harbour/ChangeLog
View File

@@ -1,3 +1,20 @@
2001-07-23 22:30 MEST Martin Vogel <vogel@inttec.de>
- 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 <davep@davep.org>
* source/rtl/profiler.prg

6
harbour/contrib/libct/Makefile
View File

@@ -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 \

20
harbour/contrib/libct/ctflist.txt
View File

@@ -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;

71
harbour/contrib/libct/ctposupp.c
View File

@@ -1,71 +0,0 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* POSUPPER() CA-Tools function
*
* Copyright 1999-2001 Viktor Szakats <viktor.szakats@syenar.hu>
* 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 <ctype.h>
#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 );
}

20
harbour/contrib/libct/makefile.bc
View File

@@ -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) -+$@,,

8
harbour/contrib/libct/makefile.vc
View File

@@ -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.*

370
harbour/contrib/libct/pos1.c Normal file
View File

@@ -0,0 +1,370 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* POSALPHA(), POSLOWER(), POSRANGE() and POSUPPER() CT3 string functions
*
* POSUPPER() Copyright 1999-2001 Viktor Szakats <viktor.szakats@syenar.hu>
*
* POSALPHA(), POSLOWER(), POSRANGE()
* Copyright 2001 IntTec GmbH, Neunlindenstr 32, 79106 Freiburg, Germany
* Author: Martin Vogel <vogel@inttec.de>
*
* 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 <ctype.h>
/* 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 (<cString>, [<lMode>], [<nIgnore>]) -> 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 (<cString>, [<lMode>], [<nIgnore>]) -> 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 (<cChar1>, <cChar2>, <cString>, [<lMode>],
* [<nIgnore>]) -> 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 (<cString>, [<lMode>], [<nIgnore>]) -> 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;
}

649
harbour/contrib/libct/pos2.c Normal file
View File

@@ -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 <vogel@inttec.de>
*
* 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>, <cCharacter|nCharacter>, [<nPosition>]) -> 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>, [<nStartPosition>], <nLength>) -> 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>, <cInsert>, [<nPosition>]) -> 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>, <cReplacement>, [<nStartPosition>]) -> 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 ("");
}
}
}
}

315
harbour/contrib/libct/posdiff.c Normal file
View File

@@ -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 <vogel@inttec.de>
*
* 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 (<cString1>, <cString2>, [<nIgnore>]) -> 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 (<cString1>, <cString2>, [<nCompare>], [<nIgnore>]) -> 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;
}

6
harbour/contrib/libct/readme.txt
View File

@@ -37,6 +37,8 @@ Martin Vogel <vogel@inttec.de>
+ CHARSUB() subtracts corresponding ASCII values
+ COSH() hyperbolic cosine
+ CSETARGERR() set behaviour on argument errors
+ CTINIT() library init function
@@ -48,6 +50,10 @@ Martin Vogel <vogel@inttec.de>
+ 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.