From 300a797b0dd6eb708811186f6bec0c6e85da2489 Mon Sep 17 00:00:00 2001 From: Martin Vogel Date: Sat, 18 Aug 2001 14:46:29 +0000 Subject: [PATCH] 2001-08-18 16:45 MEST Martin Vogel --- harbour/ChangeLog | 26 +++ harbour/contrib/libct/Makefile | 9 +- harbour/contrib/libct/ctflist.txt | 26 +-- harbour/contrib/libct/makefile.bc | 35 +++ harbour/contrib/libct/makefile.vc | 14 ++ harbour/contrib/libct/numat.c | 199 +++++++++++++++++ harbour/contrib/libct/pad.c | 237 ++++++++++++++++++++ harbour/contrib/libct/range.c | 347 ++++++++++++++++++++++++++++++ harbour/contrib/libct/remove.c | 256 ++++++++++++++++++++++ harbour/contrib/libct/replace.c | 285 ++++++++++++++++++++++++ harbour/contrib/libct/strswap.c | 182 ++++++++++++++++ harbour/contrib/libct/wordtoch.c | 200 +++++++++++++++++ 12 files changed, 1802 insertions(+), 14 deletions(-) create mode 100644 harbour/contrib/libct/numat.c create mode 100644 harbour/contrib/libct/pad.c create mode 100644 harbour/contrib/libct/range.c create mode 100644 harbour/contrib/libct/remove.c create mode 100644 harbour/contrib/libct/replace.c create mode 100644 harbour/contrib/libct/strswap.c create mode 100644 harbour/contrib/libct/wordtoch.c diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 221bcf7047..2324caaef0 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,29 @@ +2001-08-18 16:45 MEST Martin Vogel + + + 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 *source/compiler/gencobj.c *added conditional for _MSC_VER when checking if harbour -o is used diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index b3f0c5e890..89b7010f33 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -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 \ diff --git a/harbour/contrib/libct/ctflist.txt b/harbour/contrib/libct/ctflist.txt index 7c5bee4b24..913fae0462 100644 --- a/harbour/contrib/libct/ctflist.txt +++ b/harbour/contrib/libct/ctflist.txt @@ -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 diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index 64964c8bcd..c2ad8058ee 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -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$@ diff --git a/harbour/contrib/libct/makefile.vc b/harbour/contrib/libct/makefile.vc index 5cc540fe1c..f1c24ba20e 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -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) diff --git a/harbour/contrib/libct/numat.c b/harbour/contrib/libct/numat.c new file mode 100644 index 0000000000..502da83c44 --- /dev/null +++ b/harbour/contrib/libct/numat.c @@ -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 + * + * 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 (, , []) --> 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; + +} + + diff --git a/harbour/contrib/libct/pad.c b/harbour/contrib/libct/pad.c new file mode 100644 index 0000000000..cff34044b2 --- /dev/null +++ b/harbour/contrib/libct/pad.c @@ -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 + * + * 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 + * $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 + * $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; + +} diff --git a/harbour/contrib/libct/range.c b/harbour/contrib/libct/range.c new file mode 100644 index 0000000000..6fea523d23 --- /dev/null +++ b/harbour/contrib/libct/range.c @@ -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 + * + * 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 (, , ) -> 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 (, , + * <[@]cString>, ) -> 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; + +} + + diff --git a/harbour/contrib/libct/remove.c b/harbour/contrib/libct/remove.c new file mode 100644 index 0000000000..d414351310 --- /dev/null +++ b/harbour/contrib/libct/remove.c @@ -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 + * + * 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 + * $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 + * $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 + * $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; + +} diff --git a/harbour/contrib/libct/replace.c b/harbour/contrib/libct/replace.c new file mode 100644 index 0000000000..0c3a8e05fb --- /dev/null +++ b/harbour/contrib/libct/replace.c @@ -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 + * + * 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 + * $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 + * $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 + * $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; + +} diff --git a/harbour/contrib/libct/strswap.c b/harbour/contrib/libct/strswap.c new file mode 100644 index 0000000000..4842e3c1bf --- /dev/null +++ b/harbour/contrib/libct/strswap.c @@ -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 + * + * 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; + +} + + + + diff --git a/harbour/contrib/libct/wordtoch.c b/harbour/contrib/libct/wordtoch.c new file mode 100644 index 0000000000..186f58ff43 --- /dev/null +++ b/harbour/contrib/libct/wordtoch.c @@ -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 + * + * 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 (, , + * ) -> 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; + +} + + + +