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

2001-08-18 16:45 MEST Martin Vogel <vogel@inttec.de>

Browse Source
This commit is contained in:
Martin Vogel
2001-08-18 14:46:29 +00:00
parent e760f9d865
commit 300a797b0d
12 changed files with 1802 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

26
harbour/ChangeLog
View File

@@ -1,3 +1,29 @@
2001-08-18 16:45 MEST Martin Vogel <vogel@inttec.de>
+ contrib/libct/numat.c
+ NUMAT() function
+ contrib/libct/pad.c
+ PADLEFT(), PADRIGHT() functions
+ contrib/libct/range.c
+ RANGEREM(), RANGEREPL() functions
+ contrib/libct/remove.c
+ REMALL(), REMLEFT(), REMRIGHT() functions
+ contrib/libct/replace.c
+ REPLALL(), REPLLEFT(), REPLRIGHT() functions
+ contrib/libct/strswap.c
+ STRSWAP() function
+ contrib/libct/wordtoch.c
+ WORDTOCH() function
* contrib/libct/Makefile
* contrib/libct/makefile.bc
* contrib/libct/makefile.vc
+ numat.c, pad.c, range.c, remove.c, replace.c,
strswap.c and wordtoch.c added
* contrib/libct/ctflist.txt
* function status updated
2001-08-17 22:15 GMT -3 Luiz Rafael Culik<culik@sl.conex.net>
*source/compiler/gencobj.c
*added conditional for _MSC_VER when checking if harbour -o is used

9
harbour/contrib/libct/Makefile
View File

@@ -33,13 +33,20 @@ C_SOURCES = \
justify.c \
math.c \
num1.c \
numat.c \
pad.c \
pos1.c \
pos2.c \
posdiff.c \
range.c \
relation.c \
remove.c \
replace.c \
strswap.c \
token1.c \
trig.c \
wordrepl.c \
wordrepl.c \
wordtoch.c \
PRG_SOURCES= \
ctmisc.prg \

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

@@ -218,11 +218,11 @@ JUSTRIGHT ;S;
LIKE ;N;
LTOC ;R;
MAXLINE ;N;
NUMAT ;N;
NUMAT ;S;
NUMLINE ;N;
NUMTOKEN ;R;
PADLEFT ;N;
PADRIGHT ;N;
PADLEFT ;S;
PADRIGHT ;S;
POSALPHA ;S;
POSCHAR ;S;
POSDEL ;S;
@@ -233,19 +233,19 @@ POSLOWER ;S;
POSRANGE ;S;
POSREPL ;S;
POSUPPER ;S;
RANGEREM ;N;
RANGEREPL ;N;
REMALL ;N;
REMLEFT ;N;
REMRIGHT ;N;
REPLALL ;N;
REPLLEFT ;N;
REPLRIGHT ;N;
RANGEREM ;S;
RANGEREPL ;S;
REMALL ;S;
REMLEFT ;S;
REMRIGHT ;S;
REPLALL ;S;
REPLLEFT ;S;
REPLRIGHT ;S;
RESTTOKEN ;N;
SAVETOKEN ;N;
SETATLIKE ;R;
STRDIFF ;N;
STRSWAP ;N;
STRSWAP ;S;
TABEXPAND ;N;
TABPACK ;N;
TOKEN ;R;
@@ -262,7 +262,7 @@ WORDONLY ;R;
WORDREM ;R; !NEW!
WORDREPL ;R;
WORDSWAP ;R;
WORDTOCHAR ;N;
WORDTOCHAR ;S;
;
;
;2.1 number and bit manipulation

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

@@ -118,13 +118,20 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\justify.obj \
$(OBJ_DIR)\math.obj \
$(OBJ_DIR)\num1.obj \
$(OBJ_DIR)\numat.obj \
$(OBJ_DIR)\pad.obj \
$(OBJ_DIR)\pos1.obj \
$(OBJ_DIR)\pos2.obj \
$(OBJ_DIR)\posdiff.obj \
$(OBJ_DIR)\range.obj \
$(OBJ_DIR)\relation.obj \
$(OBJ_DIR)\remove.obj \
$(OBJ_DIR)\replace.obj \
$(OBJ_DIR)\strswap.obj \
$(OBJ_DIR)\token1.obj \
$(OBJ_DIR)\trig.obj \
$(OBJ_DIR)\wordrepl.obj \
$(OBJ_DIR)\wordtoch.obj \
\
$(OBJ_DIR)\ctmisc.obj \
@@ -257,6 +264,14 @@ $(OBJ_DIR)\num1.obj : $(TOOLS_DIR)\num1.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\numat.obj : $(TOOLS_DIR)\numat.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\pad.obj : $(TOOLS_DIR)\pad.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\pos1.obj : $(TOOLS_DIR)\pos1.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
@@ -269,10 +284,26 @@ $(OBJ_DIR)\posdiff.obj : $(TOOLS_DIR)\posdiff.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\range.obj : $(TOOLS_DIR)\range.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\relation.obj : $(TOOLS_DIR)\relation.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\remove.obj : $(TOOLS_DIR)\remove.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\replace.obj : $(TOOLS_DIR)\replce.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\strswap.obj : $(TOOLS_DIR)\strswap.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\token1.obj : $(TOOLS_DIR)\token1.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
@@ -285,6 +316,10 @@ $(OBJ_DIR)\wordrepl.obj : $(TOOLS_DIR)\wordrepl.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\wordtoch.obj : $(TOOLS_DIR)\wordtoch.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\ctmisc.c : $(TOOLS_DIR)\ctmisc.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@

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

@@ -138,13 +138,20 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\justify.obj \
$(OBJ_DIR)\math.obj \
$(OBJ_DIR)\num1.obj \
$(OBJ_DIR)\numat.obj \
$(OBJ_DIR)\pad.obj \
$(OBJ_DIR)\pos1.obj \
$(OBJ_DIR)\pos2.obj \
$(OBJ_DIR)\posdiff.obj \
$(OBJ_DIR)\range.obj \
$(OBJ_DIR)\relation.obj \
$(OBJ_DIR)\remove.obj \
$(OBJ_DIR)\replace.obj \
$(OBJ_DIR)\strswap.obj \
$(OBJ_DIR)\token1.obj \
$(OBJ_DIR)\trig.obj \
$(OBJ_DIR)\wordrepl.obj \
$(OBJ_DIR)\wordtoch.obj \
\
$(OBJ_DIR)\ctmisc.obj \
@@ -185,13 +192,20 @@ CLEAN:
-@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)\numat.* del $(OBJ_DIR)\numat.*
-@if exist $(OBJ_DIR)\pad.* del $(OBJ_DIR)\pad.*
-@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)\range.* del $(OBJ_DIR)\range.*
-@if exist $(OBJ_DIR)\relation.* del $(OBJ_DIR)\relation.*
-@if exist $(OBJ_DIR)\remove.* del $(OBJ_DIR)\remove.*
-@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)\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)\ctmisc.* del $(OBJ_DIR)\ctmisc.*
-@if exist $(TOOLS_LIB) del $(TOOLS_LIB)

199
harbour/contrib/libct/numat.c Normal file
View File

@@ -0,0 +1,199 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* NUMAT() CT3 string function
*
* 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$
* NUMAT()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Number of occurrences of a sequence in a string
* $SYNTAX$
* NUMAT (<cStringToMatch>, <cString>, [<nIgnore>]) --> nCount
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* NUMAT() is compatible with CT3's NUMAT().
* $PLATFORMS$
* All
* $FILES$
* Source is numat.c, library is libct.
* $SEEALSO$
* CSETATMUPA(),SETATLIKE()
* $END$
*/
HB_FUNC(NUMAT)
{
if ((ISCHAR (1)) && (ISCHAR (2)))
{
char *pcStringToMatch = (char *)hb_parc (1);
size_t sStrToMatchLen = (size_t)hb_parclen (1);
char *pcString = (char *)hb_parc (2);
size_t sStrLen = (size_t)hb_parclen (2);
int iMultiPass = ct_getatmupa();
int iAtLike = ct_getatlike();
char cAtLike = ct_getatlikechar();
size_t sIgnore, sMatchStrLen, sSubStrLen;
ULONG ulCounter;
char *pc, *pcSubStr;
/* eventually ignore some characters */
if (ISNUM (3))
sIgnore = (size_t)hb_parnl (3);
else
sIgnore = 0;
if (sIgnore >= sStrLen)
{
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_NUMAT,
NULL, "NUMAT", 0, EF_CANDEFAULT, 3,
hb_paramError (1), hb_paramError (2),
hb_paramError (3));
}
hb_retnl (0);
return;
}
else
{
pcString += sIgnore;
sStrLen -= sIgnore;
}
ulCounter = 0;
pcSubStr = pcString;
sSubStrLen = sStrLen;
do
{
switch (iAtLike)
{
case CT_SETATLIKE_EXACT:
{
pc = ct_at_exact_forward (pcSubStr, sSubStrLen,
pcStringToMatch, sStrToMatchLen,
&sMatchStrLen);
}; break;
case CT_SETATLIKE_WILDCARD:
{
pc = ct_at_wildcard_forward (pcSubStr, sSubStrLen,
pcStringToMatch, sStrToMatchLen,
cAtLike, &sMatchStrLen);
}; break;
default:
{
pc = NULL;
};
}
ulCounter++;
if (iMultiPass)
pcSubStr = pc+1;
else
pcSubStr = pc+sMatchStrLen;
sSubStrLen = sStrLen-(pcSubStr-pcString);
} while (pc != NULL);
hb_retnl (ulCounter-1);
}
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_NUMAT,
NULL, "NUMAT", 0, EF_CANSUBSTITUTE, 3,
hb_paramError (1), hb_paramError (2),
hb_paramError (3));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retnl (0);
}
return;
}
return;
}

237
harbour/contrib/libct/pad.c Normal file
View File

@@ -0,0 +1,237 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* PADLEFT() and PADRIGHT() 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"
/* defines */
#define DO_PAD_PADLEFT 0
#define DO_PAD_PADRIGHT 1
/* helper function for the pad functions */
static void do_pad (int iSwitch)
{
if (ISCHAR (1) && ISNUM (2))
{
char *pcString = (char *)hb_parc (1);
size_t sStrLen = (size_t)hb_parclen (1);
char *pcRet, *pc;
long lRetLen;
size_t sRetLen;
char cFill;
lRetLen = hb_parnl (2);
if (lRetLen <= 0)
{
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
ct_error ((USHORT)iArgErrorMode, EG_ARG,
(iSwitch == DO_PAD_PADLEFT ? CT_ERROR_PADLEFT : CT_ERROR_PADRIGHT),
NULL,
(iSwitch == DO_PAD_PADLEFT ? "PADLEFT" : "ROR_PADRIGHT"),
0, EF_CANDEFAULT, 3,
hb_paramError (1), hb_paramError (2),
hb_paramError (3));
}
hb_retc ("");
return;
}
sRetLen = (size_t)lRetLen;
if (hb_parclen (3) > 0)
cFill = *(hb_parc (3));
else if (ISNUM (3))
cFill = hb_parnl (3) % 256;
else
cFill = 0x20;
pcRet = hb_xgrab (sRetLen);
if (iSwitch == DO_PAD_PADLEFT)
{
if (sRetLen > sStrLen)
{
/* fill with cFill */
for (pc = pcRet; pc < pcRet+(sRetLen-sStrLen); pc++)
*pc = cFill;
hb_xmemcpy (pcRet+(sRetLen-sStrLen), pcString, sStrLen);
}
else
{
hb_xmemcpy (pcRet, pcString+(sStrLen-sRetLen), sRetLen);
}
}
else
{
hb_xmemcpy (pcRet, pcString, (sRetLen < sStrLen ? sRetLen : sStrLen));
if (sRetLen > sStrLen)
{
/* fill with cFill */
for (pc = pcRet+sStrLen; pc < pcRet+sRetLen; pc++)
*pc = cFill;
}
}
hb_retclen (pcRet, sRetLen);
hb_xfree (pcRet);
}
else /* ISCHAR (1) && ISNUM (2) */
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG,
(iSwitch == DO_PAD_PADLEFT ? CT_ERROR_PADLEFT : CT_ERROR_PADRIGHT),
NULL,
(iSwitch == DO_PAD_PADLEFT ? "PADLEFT" : "ROR_PADRIGHT"),
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 ("");
}
return;
}
return;
}
/* $DOC$
* $FUNCNAME$
* PADLEFT()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Fills string to a certain length on the left
* $SYNTAX$
* PADLEFT (<cString>,<nLength>, [<cChar|nChar>]) -> cString
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* PADLEFT() is compatible with CT3's PADLEFT().
* $PLATFORMS$
* All
* $FILES$
* Source is pad.c, library is libct.
* $SEEALSO$
* PADRIGHT()
* $END$
*/
HB_FUNC (PADLEFT)
{
do_pad (DO_PAD_PADLEFT);
return;
}
/* $DOC$
* $FUNCNAME$
* PADRIGHT()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Fills string to a certain length on the right
* $SYNTAX$
* PADRIGHT (<cString>,<nLength>, [<cChar|nChar>]) -> cString
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* PADRIGHT() is compatible with CT3's PADRIGHT().
* $PLATFORMS$
* All
* $FILES$
* Source is pad.c, library is libct.
* $SEEALSO$
* PADLEFT()
* $END$
*/
HB_FUNC (PADRIGHT)
{
do_pad (DO_PAD_PADRIGHT);
return;
}

347
harbour/contrib/libct/range.c Normal file
View File

@@ -0,0 +1,347 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* RANGEREM() and RANGEREPL() 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$
* RANGEREM()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Remove characters within a certain ASCII range from a string
* $SYNTAX$
* RANGEREM (<cChar1|nChar1>, <cChar2|nChar2>, <cString>) -> cString
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* RANGEREM() is compatible with CT3's RANGEREM().
* $PLATFORMS$
* All
* $FILES$
* Source is range.c, library is libct.
* $SEEALSO$
* RANGEREPL()
* $END$
*/
HB_FUNC (RANGEREM)
{
if (((hb_parclen (1) > 0) || ISNUM (1)) &&
((hb_parclen (2) > 0) || ISNUM (2)) &&
ISCHAR (3))
{
char *pcString = (char *)hb_parc (3);
size_t sStrLen = (size_t)hb_parclen (3);
char *pcRet, *pc;
unsigned char ucChar1, ucChar2, ucReplace;
size_t sRetIndex;
int iMode, iBool;
if (ISNUM (1))
{
ucChar1 = hb_parnl (1)%256;
}
else
{
ucChar1 = *((unsigned char *)hb_parc (1));
}
if (ISNUM (2))
{
ucChar2 = hb_parnl (2)%256;
}
else
{
ucChar2 = *((unsigned char *)hb_parc (2));
}
iMode = (ucChar2 < ucChar1);
pcRet = hb_xgrab (sStrLen);
sRetIndex = 0;
for (pc = pcString; pc < pcString+sStrLen; pc++)
{
iBool = ((*pc) >= ucChar1);
if (iMode)
{
iBool |= ((*pc) <= ucChar2);
}
else
{
iBool &= ((*pc) <= ucChar2);
}
if (!iBool)
{
*(pcRet+sRetIndex) = *pc;
sRetIndex++;
}
}
hb_retclen (pcRet, sRetIndex+1);
}
else /* ((hb_parclen (1) > 0) || ISNUM (1)) &&
((hb_parclen (2) > 0) || ISNUM (2)) &&
ISCHAR (3)) */
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_RANGEREM,
NULL, "RANGEREM", 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 (3))
{
hb_retclen (hb_parc (3), hb_parclen (3));
}
else
{
hb_retc ("");
}
}
return;
}
return;
}
/* $DOC$
* $FUNCNAME$
* RANGEREPL
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Replace characters within a certain ASCII range from a string
* $SYNTAX$
* RANGEREPL (<cChar1|nChar1>, <cChar2|nChar2>,
* <[@]cString>, <cReplacementChar|nReplacementChar>) -> cString
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* RANGEREPL() is compatible with CT3's RANGEREPL().
* $PLATFORMS$
* All
* $FILES$
* Source is range.c, library is libct.
* $SEEALSO$
* RANGEREM()
* $END$
*/
HB_FUNC (RANGEREPL)
{
int iNoRef = ct_getref();
if (((hb_parclen (1) > 0) || ISNUM (1)) &&
((hb_parclen (2) > 0) || ISNUM (2)) &&
ISCHAR (3) &&
((hb_parclen (4) > 0) || ISNUM (4)))
{
char *pcString = (char *)hb_parc (3);
size_t sStrLen = (size_t)hb_parclen (3);
char *pcRet, *pc;
unsigned char ucChar1, ucChar2, ucReplace;
size_t sRetIndex;
int iMode, iBool;
if (ISNUM (1))
{
ucChar1 = hb_parnl (1)%256;
}
else
{
ucChar1 = *((unsigned char *)hb_parc (1));
}
if (ISNUM (2))
{
ucChar2 = hb_parnl (2)%256;
}
else
{
ucChar2 = *((unsigned char *)hb_parc (2));
}
if (ISNUM (4))
{
ucReplace = hb_parnl (4)%256;
}
else
{
ucReplace = *((unsigned char *)hb_parc (4));
}
iMode = (ucChar2 < ucChar1);
pcRet = hb_xgrab (sStrLen);
sRetIndex = 0;
for (pc = pcString; pc < pcString+sStrLen; pc++)
{
iBool = ((*pc) >= ucChar1);
if (iMode)
{
iBool |= ((*pc) <= ucChar2);
}
else
{
iBool &= ((*pc) <= ucChar2);
}
if (iBool)
{
*(pcRet+sRetIndex) = ucReplace;
sRetIndex++;
}
else
{
*(pcRet+sRetIndex) = *pc;
sRetIndex++;
}
}
if (ISBYREF (3))
{
hb_storclen (pcRet, sRetIndex+1, 3);
}
if (iNoRef)
{
hb_ret();
}
else
{
hb_retclen (pcRet, sRetIndex+1);
}
}
else /* ((hb_parclen (1) > 0) || ISNUM (1)) &&
((hb_parclen (2) > 0) || ISNUM (2)) &&
ISCHAR (3) &&
((hb_parclen (4) > 0))) */
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_RANGEREPL,
NULL, "RANGEREPL", 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
{
if (iNoRef)
{
hb_ret();
}
else
{
if (ISCHAR (3))
{
hb_retclen (hb_parc (3), hb_parclen (3));
}
else
{
hb_retc ("");
}
}
}
return;
}
return;
}

256
harbour/contrib/libct/remove.c Normal file
View File

@@ -0,0 +1,256 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* REMALL(), REMLEFT() and REMRIGHT() 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"
/* defines */
#define DO_REMOVE_REMALL 0
#define DO_REMOVE_REMLEFT 1
#define DO_REMOVE_REMRIGHT 2
static const ULONG sulErrorSubcodes[3] = {CT_ERROR_REMALL,
CT_ERROR_REMLEFT,
CT_ERROR_REMRIGHT};
static const char * spcErrorOperation[3] = {"REMALL",
"REMLEFT",
"REMRIGHT"};
/* helper function for the remxxx functions */
static void do_remove (int iSwitch)
{
/* param check */
if (ISCHAR (1))
{
char *pcString = (char *)hb_parc (1);
size_t sStrLen = (size_t)hb_parclen (1);
char *pcRet, *pc;
size_t sRetLen;
char cSearch;
if (hb_parclen (2) > 0)
cSearch = *(hb_parc (2));
else if (ISNUM (2))
cSearch = hb_parnl (2) % 256;
else
cSearch = 0x20;
sRetLen = sStrLen;
pcRet = pcString;
if (iSwitch != DO_REMOVE_REMRIGHT)
{
while ((*pcRet == cSearch) && (pcRet < pcString+sStrLen))
{
pcRet++;
sRetLen--;
}
}
if (iSwitch != DO_REMOVE_REMRIGHT)
{
pc = pcString+sStrLen-1;
while ((*pc == cSearch) && (pc >= pcRet))
{
pc--;
sRetLen--;
}
}
if (sRetLen == 0)
hb_retc ("");
else
hb_retclen (pcRet, sRetLen);
}
else /* if (ISCHAR (1)) */
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, sulErrorSubcodes[iSwitch],
NULL, (char *)spcErrorOperation[iSwitch], 0, EF_CANSUBSTITUTE, 2,
hb_paramError (1), hb_paramError (2));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retc ("");
}
return;
}
return;
}
/* $DOC$
* $FUNCNAME$
* REMALL()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Remove certain characters at the left and right of a string
* $SYNTAX$
* REMALL (<cString>, [<cSearch|nSearch>]) -> cString
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* REMALL() is compatible with CT3's REMALL().
* $PLATFORMS$
* All
* $FILES$
* Source is remove.c, library is libct.
* $SEEALSO$
* REMLEFT(),REMRIGHT()
* $END$
*/
HB_FUNC (REMALL)
{
do_remove (DO_REMOVE_REMALL);
return;
}
/* $DOC$
* $FUNCNAME$
* REMLEFT()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Remove certain characters at the left of a string
* $SYNTAX$
* REMLEFT (<cString>, [<cSearch|nSearch>]) -> cString
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* REMLEFT() is compatible with CT3's REMLEFT().
* $PLATFORMS$
* All
* $FILES$
* Source is remove.c, library is libct.
* $SEEALSO$
* REMALL(),REMRIGHT()
* $END$
*/
HB_FUNC (REMLEFT)
{
do_remove (DO_REMOVE_REMLEFT);
return;
}
/* $DOC$
* $FUNCNAME$
* REMRIGHT()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Remove certain characters at the right of a string
* $SYNTAX$
* REMRIGHT (<cString>, [<cSearch|nSearch>]) -> cString
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* REMRIGHT() is compatible with CT3's REMRIGHT().
* $PLATFORMS$
* All
* $FILES$
* Source is remove.c, library is libct.
* $SEEALSO$
* REMALL(),REMLEFT()
* $END$
*/
HB_FUNC (REMRIGHT)
{
do_remove (DO_REMOVE_REMRIGHT);
return;
}

285
harbour/contrib/libct/replace.c Normal file
View File

@@ -0,0 +1,285 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* REPLALL(), REPLLEFT() and REPLRIGHT() 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"
/* defines */
#define DO_REPLACE_REPLALL 0
#define DO_REPLACE_REPLLEFT 1
#define DO_REPLACE_REPLRIGHT 2
static const ULONG sulErrorSubcodes[] = {CT_ERROR_REPLALL,
CT_ERROR_REPLLEFT,
CT_ERROR_REPLRIGHT};
static const char * spcErrorOperation[] = {"REPLALL",
"REPLLEFT",
"REPLRIGHT"};
/* helper function for the replxxx functions */
static void do_replace (int iSwitch)
{
/* suppressing return value ? */
int iNoRet = ct_getref();
/* param check */
if ((ISCHAR (1)) &&
((hb_parclen (2) > 0) || (ISNUM(2))))
{
char *pcString = (char *)hb_parc (2);
size_t sStrLen = (size_t)hb_parclen (2);
char *pcRet, *pc;
char cSearch, cReplace;
if (ISNUM (2))
{
cReplace = hb_parnl (2) % 256;
}
else
{
cReplace = *((char *)hb_parc (2));
}
if (hb_parclen (3) > 0)
{
cSearch = *((char *)hb_parc (3));
}
else if (ISNUM (3))
{
cSearch = hb_parnl (3) % 256;
}
else
{
cSearch = 0x20;
}
pcRet = hb_xgrab (sStrLen);
hb_xmemcpy (pcRet, pcString, sStrLen);
if (iSwitch != DO_REPLACE_REPLRIGHT)
{
pc = pcRet;
while ((*pc == cSearch) && (pc < pcRet+sStrLen))
{
*pc = cReplace;
pc++;
}
}
if (iSwitch != DO_REPLACE_REPLLEFT)
{
pc = pcRet+sStrLen-1;
while ((*pc == cSearch) && (pc >= pcRet))
{
*pc = cReplace;
pc--;
}
}
if (ISBYREF (1))
hb_storclen (pcRet, sStrLen, 1);
if (iNoRet)
hb_ret();
else
hb_retclen (pcRet, sStrLen);
hb_xfree (pcRet);
}
else /* if ((ISCHAR (1)) &&
((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, sulErrorSubcodes[iSwitch],
NULL, (char *)spcErrorOperation[iSwitch], 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 ("");
}
return;
}
return;
}
/* $DOC$
* $FUNCNAME$
* REPLALL()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Replace certain characters at the left and right of a string
* $SYNTAX$
* REPLALL (<cString>, <cReplace|nReplace>, [<cSearch|nSearch>]) -> cString
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* REPLALL() is compatible with CT3's REPLALL().
* $PLATFORMS$
* All
* $FILES$
* Source is replace.c, library is libct.
* $SEEALSO$
* REPLLEFT(),REPLRIGHT()
* $END$
*/
HB_FUNC (REPLALL)
{
do_replace (DO_REPLACE_REPLALL);
return;
}
/* $DOC$
* $FUNCNAME$
* REPLLEFT()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Replace certain characters at the left of a string
* $SYNTAX$
* REPLLEFT (<cString>, <cReplace|nReplace>, [<cSearch|nSearch>]) -> cString
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* REPLLEFT() is compatible with CT3's REPLLEFT().
* $PLATFORMS$
* All
* $FILES$
* Source is replace.c, library is libct.
* $SEEALSO$
* REPLALL(),REPLRIGHT()
* $END$
*/
HB_FUNC (REPLLEFT)
{
do_replace (DO_REPLACE_REPLLEFT);
return;
}
/* $DOC$
* $FUNCNAME$
* REPLRIGHT()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Replace certain characters at the right of a string
* $SYNTAX$
* REPLRIGHT (<cString>, <cReplace|nReplace>, [<cSearch|nSearch>]) -> cString
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* REPLRIGHT() is compatible with CT3's REPLRIGHT().
* $PLATFORMS$
* All
* $FILES$
* Source is replace.c, library is libct.
* $SEEALSO$
* REPLALL(),REPLLEFT()
* $END$
*/
HB_FUNC (REPLRIGHT)
{
do_replace (DO_REPLACE_REPLRIGHT);
return;
}

182
harbour/contrib/libct/strswap.c Normal file
View File

@@ -0,0 +1,182 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* STRSWAP() CT3 string function
*
* 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$
* STRSWAP()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Swap the contents of two strings
* $SYNTAX$
* STRSWAP (<[@]cString1>, <[@]cString2>) -> cString
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* STRSWAP() is compatible with CT3's STRSWAP().
* $PLATFORMS$
* All
* $FILES$
* Source is strswap.c, library is libct.
* $SEEALSO$
* $END$
*/
HB_FUNC (STRSWAP)
{
size_t sStrLen1, sStrLen2;
/* param check */
if (((sStrLen1 = (size_t)hb_parclen (1)) > 0) &&
((sStrLen2 = (size_t)hb_parclen (2)) > 0))
{
/* get parameters */
char *pcString1 = (char *)hb_parc (1);
char *pcString2 = (char *)hb_parc (2);
char *pcRet1, *pcRet2;
int iChange1, iChange2;
size_t sIndex, sCmpLen;
if ((iChange1=ISBYREF(1)) != 0)
{
pcRet1 = hb_xgrab (sStrLen1);
hb_xmemcpy (pcRet1, pcString1, sStrLen1);
}
if ((iChange2=ISBYREF(2)) != 0)
{
pcRet2 = hb_xgrab (sStrLen2);
hb_xmemcpy (pcRet2, pcString2, sStrLen2);
}
sCmpLen = (sStrLen1 < sStrLen2 ? sStrLen1 : sStrLen2);
for (sIndex = 0; sIndex < sCmpLen; sIndex++)
{
char cExchange;
if (iChange1)
{
cExchange = *(pcString1+sIndex);
*(pcRet1+sIndex) = *(pcString2+sIndex);
if (iChange2)
{
*(pcRet2+sIndex) = cExchange;
}
}
else
{
*(pcRet2+sIndex) = *(pcString1+sIndex);
}
}
/* strings */
if (iChange1)
{
hb_storclen (pcRet1, sStrLen1, 1);
hb_xfree (pcRet1);
}
if (iChange2)
{
hb_storclen (pcRet2, sStrLen2, 2);
hb_xfree (pcRet2);
}
hb_retc ("");
}
else /* ((sStrLen1 = (size_t)hb_parclen (1)) > 0) &&
((sStrLen2 = (size_t)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_STRSWAP,
NULL, "STRSWAP", 0, EF_CANSUBSTITUTE, 2,
hb_paramError (1), hb_paramError (2));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retc ("");
}
return;
}
return;
}

200
harbour/contrib/libct/wordtoch.c Normal file
View File

@@ -0,0 +1,200 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* WORDTOCHAR() CT3 string function
*
* 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$
* WORDTOCHAR()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Replace double with single characters
* $SYNTAX$
* WORDTOCHAR (<cDoubleCharacterSearchString>, <cString>,
* <cSingleCharacterReplaceString>) -> cString
* $ARGUMENTS$
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* WORDTOCHAR() is compatible with CT3's WORDTOCHAR().
* $PLATFORMS$
* All
* $FILES$
* Source is wordtoch.c, library is libct.
* $SEEALSO$
* CSETATMUPA(),CHARREPL(),WORDREPL()
* $END$
*/
HB_FUNC (WORDTOCHAR)
{
int iMultiPass;
size_t sSearchLen, sStrLen, sReplaceLen;
iMultiPass = ct_getatmupa();
/* param check */
if (((sSearchLen = (size_t)hb_parclen (1))/2 > 0) &&
((sStrLen = (size_t)hb_parclen (2))/2 > 0) &&
((sReplaceLen = (size_t)hb_parclen (3)) > 0))
{
/* get parameters */
char *pcSearch = (char *)hb_parc (1);
char *pcString = (char *)hb_parc (2);
char *pcReplace = (char *)hb_parc (3);
char *pcRet;
size_t sRetIndex, sIndex;
int iNoReplace;
pcRet = hb_xgrab (sStrLen);
sRetIndex = 0;
sIndex = 0;
iNoReplace = 0;
*pcRet = *pcString; /* copy first char */
do
{
size_t sMatchStrLen;
char *pc;
size_t sReplIndex;
*(pcRet+sRetIndex+1) = *(pcString+sIndex+1);
if (!iNoReplace &&
((pc = ct_at_exact_forward (pcSearch, sSearchLen,
pcRet+sRetIndex, 2,
&sMatchStrLen)) != NULL) &&
((sReplIndex=(pc-pcSearch)) & 1 != 1))
{
sReplIndex /= 2;
if (sReplIndex >= sReplaceLen)
{
sReplIndex = sReplaceLen-1;
}
*(pcRet+sRetIndex) = *(pcReplace+sReplIndex);
if (!iMultiPass)
{
iNoReplace = 1; /* just copy next char without searching & replacing */
}
}
else
{
iNoReplace = 0;
sRetIndex++;
}
sIndex++;
} while (sIndex < sStrLen-1);
/* return string */
hb_retclen (pcRet, sRetIndex+1);
hb_xfree (pcRet);
}
else /* ((sSearchLen = (size_t)hb_parclen (1))/2 > 0)
((sStrLen = (size_t)hb_parclen (2))/2 > 0 &&
((sReplaceLen = (size_t)hb_parclen (3)) > 0)) */
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_WORDTOCHAR,
NULL, "WORDTOCHAR", 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 (2))
{
hb_retclen (hb_parc (2), hb_parclen (2));
}
else
{
hb_retc ("");
}
}
return;
}
return;
}