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

2001-04-28 23:15 CET Martin Vogel <vogel@inttec.de>

Browse Source
This commit is contained in:
Martin Vogel
2001-04-28 21:12:26 +00:00
parent 31db690182
commit 9064a7fa40
14 changed files with 1224 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
harbour/ChangeLog
View File

@@ -1,3 +1,56 @@
2001-04-28 23:15 CET Martin Vogel <vogel@inttec.de>
+ contrib/libct/atrepl.c
! ATREPL() function with !new! 6th parameter
+ contrib/libct/charlist.c
! CHARLIST(), CHARNOLIST() function
+ CHARSLIST() sorted character list !New function!
+ CHARHIST() character histogram !New function!
* contrib/libct/Makefile
+ added atrepl.c
+ added charlist.c
* contrib/libct/makefile.bc
+ added atrepl.c
+ added charlist.c
* contrib/libct/makefile.vc
+ added atrepl.c
+ added charlist.c
* contrib/libct/readme.txt
! enhancement list updated !
* contrib/libct/ctflist.txt
! function status list updated !
+ contrib/libct/tests/atrepl.prg
! test program for the ATREPL() function
+ contrib/libct/tests/charlist.prg
! test program for the CHARLIST() function
+ contrib/libct/tests/charnlst.prg
! test program for the CHARNOLIST() function
+ contrib/libct/tests/charslst.prg
! test program for the new CHARSLIST() function
+ contrib/libct/tests/charhist.prg
! test program for new CHARHIST() function
* contrib/libct/tests/Makefile
+ added atrepl.prg
+ added charlist.prg
+ added charnlst.prg
+ added charslst.prg
+ added charhist.prg
* contrib/libct/ctflist.txt
! function status list updated !
2001-04-27 22:30 UTC-0400 David G. Holm <dholm@jsd-llc.com>
* doc/en/input.txt

2
harbour/contrib/libct/Makefile
View File

@@ -10,7 +10,9 @@ C_SOURCES=\
ascpos.c \
atadjust.c \
atnum.c \
atrepl.c \
charevod.c \
charlist.c \
charop.c \
ctset.c \
ctstr.c \

356
harbour/contrib/libct/atrepl.c Normal file
View File

@@ -0,0 +1,356 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* ATREPL() 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$
* ATREPL()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Search and replace sequences in a string
* $SYNTAX$
* ATREPL (<cStringToMatch>, <cString>, <cReplacement>, [<nCounter>],
* [<lMode>], [<nIgnore>]) --> cString
* $ARGUMENTS$
* <cStringToMatch> is the substring searched for in <cString>
* <cString> is the processed string
* <cReplacement> is the replacement for sequences found
* [<nCounter>] specifies the number of replacements
* Default: last occurence
* [<lMode>] if set to .T., only the <nCounter>th sequence
* of <cStringToMatch> will be replaced, else
* all sequences will be replaced.
* Default: .F.
* [<nIgnore>]) specifies how many characters in <cString> from
* the beginning should be ignored by the function
* Default: 0
* $RETURNS$
* <cString>
* $DESCRIPTION$
* The ATREPL() function searches and replaces sequences in a string.
* First, the function ignores the first <nIgnore> characters of <cString>.
* Then, if <lMode> is set to .T., it searches for the <nCounter>th
* occurence of <cStringToMatch> in <cString>. If successful, the
* sequence will be replaced with <cReplacement>.
* If <lMode> is set to .F., the same search is performed, but EVERY
* occurence of <cStringToMatch> till the <nCounter>th (inclusive) will
* be replaced with <cReplacement>. Note that, in this case,
* the replacements are performed even if the <nCounter>th occurence
* does not exist.
* By using the CSETATMUPA() switch you can decide whether the
* function restarts searching after a found sequence of after
* the first character of that sequence.
* The function allows the use of wildcards in <cStringToMatch>
* and looks for the settings of SETATLIKE().
* $EXAMPLES$
* ? ATREPL("ABC", "ABCDABCDABC", "xx") --> "xxDxxDxx"
* ? ATREPL("ABC", "ABCDABC", "ZYXW") --> "ZYXWDZYXW"
* ? ATREPL("ABC", "ABCDABCDABC", "xx", 2) --> "xxDxxDABC"
* ? ATREPL("ABC", "ABCDABCDABC", "xx", 2, .T.) --> "ABCDxxDABC"
* $TESTS$
* ATREPL("ABC", "ABCDABCDABC", "xx") == "xxDxxDxx"
* ATREPL("ABC", "ABCDABC", "ZYXW") == "ZYXWDZYXW"
* ATREPL("ABC", "ABCDABCDABC", "xx", 2) == "xxDxxDABC"
* ATREPL("ABC", "ABCDABCDABC", "xx", 2, .T.) == "ABCDxxDABC"
* $STATUS$
* Ready
* $COMPLIANCE$
* ATREPL() is compatible with CT3's ATREPL().
* Note the new, 6th parameter !
* $PLATFORMS$
* All
* $FILES$
* Source is atrepl.c, library is ct3.
* $SEEALSO$
* CSETATMUPA() SETATLIKE()
* $END$
*/
HB_FUNC (ATREPL)
{
if ((ISCHAR (1)) && (ISCHAR (2)))
{
char *pcStringToMatch = hb_parc (1);
size_t sStrToMatchLen = (size_t)hb_parclen (1);
char *pcString = 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;
ULONG ulCounter;
char *pc;
char *pcReplacement;
size_t sReplaceLen;
int iReplaceMode;
char *pcRetStr;
size_t sRetStrLen;
/* eventually ignore some characters */
if (ISNUM (6))
sIgnore = (size_t)hb_parnl (6);
else
sIgnore = 0;
if (sIgnore >= sStrLen)
{
hb_retclen (pcString, sStrLen);
return;
}
/* replacement */
if (ISCHAR (3))
{
pcReplacement = hb_parc (3);
sReplaceLen = hb_parclen (3);
}
else
{
pcReplacement = "";
sReplaceLen = 0;
}
/* replace mode */
if (ISLOG (5))
iReplaceMode = hb_parl (5);
else
iReplaceMode = 0;
/* nth match or last match ? */
if (ISNUM (4))
ulCounter = hb_parnl (4);
else
ulCounter = 0;
/* little trick: */
if ((iReplaceMode==0) && (ulCounter == 0))
ulCounter = HB_MKULONG (255,255,255,255); /* ULONG_MAX */
if (ulCounter != 0)
{
/* depending on iReplaceMode: replace all occurences including the nth one
or only the nth occurence
NOTE: if iReplaceMode = false and the nth occurence does not exist,
all occurences are replaced */
char *pcRetSubStr;
size_t sRetSubStrLen;
ULONG ulMatchCounter = 0;
sRetStrLen = sStrLen;
pcRetStr = hb_xgrab (sRetStrLen);
hb_xmemcpy (pcRetStr, pcString, sRetStrLen);
pcRetSubStr = pcRetStr+sIgnore;
sRetSubStrLen = sRetStrLen-sIgnore;
while (ulMatchCounter < ulCounter)
{
switch (iAtLike)
{
case CT_SETATLIKE_EXACT:
{
pc = ct_at_exact_forward (pcRetSubStr, sRetSubStrLen,
pcStringToMatch, sStrToMatchLen,
&sMatchStrLen);
}; break;
case CT_SETATLIKE_WILDCARD:
{
pc = ct_at_wildcard_forward (pcRetSubStr, sRetSubStrLen,
pcStringToMatch, sStrToMatchLen,
cAtLike, &sMatchStrLen);
}; break;
default:
{
pc = NULL;
};
}
if (pc == NULL)
{
hb_retclen (pcRetStr, sRetStrLen);
hb_xfree (pcRetStr);
return;
}
ulMatchCounter++;
/* replace match ? */
if ((iReplaceMode == 0) || (ulMatchCounter == ulCounter))
{
if (sMatchStrLen < sReplaceLen)
{
/* pcRetStr grows, so realloc memory */
/* save pc pointer */
size_t sPCPos = pc-pcRetStr;
pcRetStr = hb_xrealloc (pcRetStr, sRetStrLen+(sReplaceLen-sMatchStrLen));
pc = pcRetStr+sPCPos;
}
if (sReplaceLen != sMatchStrLen)
memmove (pc+sReplaceLen, pc+sMatchStrLen,
sRetStrLen-((pc+sMatchStrLen)-pcRetStr));
if (sReplaceLen > 0)
hb_xmemcpy (pc, pcReplacement, sReplaceLen);
if (iMultiPass)
pcRetSubStr = pc+1;
else
pcRetSubStr = pc+sReplaceLen;
sRetStrLen += (sReplaceLen-sMatchStrLen);
}
else
{
if (iMultiPass)
pcRetSubStr = pc+1;
else
pcRetSubStr = pc+sMatchStrLen;
}
sRetSubStrLen = sRetStrLen-(pcRetSubStr-pcRetStr);
}
}
else /* (ulCounter != 0) */
{
/* find and replace last match */
sRetStrLen = sStrLen;
pcRetStr = hb_xgrab (sRetStrLen);
hb_xmemcpy (pcRetStr, pcString, sRetStrLen);
/* we have to find the last match and replace it */
switch (iAtLike)
{
case CT_SETATLIKE_EXACT:
{
pc = ct_at_exact_backward (pcRetStr+sIgnore, sRetStrLen-sIgnore,
pcStringToMatch, sStrToMatchLen,
&sMatchStrLen);
}; break;
case CT_SETATLIKE_WILDCARD:
{
pc = ct_at_wildcard_backward (pcRetStr+sIgnore, sRetStrLen-sIgnore,
pcStringToMatch, sStrToMatchLen,
cAtLike, &sMatchStrLen);
}; break;
default:
{
pc = NULL;
};
}
if (pc == NULL)
{
hb_retclen (pcRetStr, sRetStrLen);
hb_xfree (pcRetStr);
return;
}
/* replace match */
if (sMatchStrLen < sReplaceLen)
{
/* pcRetStr grows, so realloc memory */
/* save pc pointer */
size_t sPCPos = pc-pcRetStr;
pcRetStr = hb_xrealloc (pcRetStr, sRetStrLen+(sReplaceLen-sMatchStrLen));
pc = pcRetStr+sPCPos;
}
if (sReplaceLen != sMatchStrLen)
memmove (pc+sReplaceLen, pc+sMatchStrLen,
sRetStrLen-((pc+sMatchStrLen)-pcRetStr));
if (sReplaceLen > 0)
hb_xmemcpy (pc, pcReplacement, sReplaceLen);
sRetStrLen += (sReplaceLen-sMatchStrLen);
}
hb_retclen (pcRetStr, sRetStrLen);
hb_xfree (pcRetStr);
}
else /* ((ISCHAR (1)) && (ISCHAR (2))) */
{
hb_retclen (hb_parc (2), hb_parclen (2));
}
return;
}

384
harbour/contrib/libct/charlist.c Normal file
View File

@@ -0,0 +1,384 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 string functions
* - CHARLIST()
* - CHARSLIST() (NEW)
* - CHARNOLIST()
* - CHARHIST() (NEW)
*
* 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_LIST_CHARLIST 0
#define DO_LIST_CHARNOLIST 1
#define DO_LIST_CHARHIST 2
#define DO_LIST_CHARSLIST 3
/* helper function for the list function */
static void do_list (int iSwitch)
{
char *pcString;
size_t sStrLen;
size_t asCharCnt[256];
size_t sCnt;
/* init asCharCnt */
for (sCnt = 0; sCnt < 256; sCnt++)
{
asCharCnt[sCnt] = 0;
}
/* init params */
if (ISCHAR (1))
{
pcString = hb_parc (1);
sStrLen = (size_t)hb_parclen (1);
}
else
{
pcString = "";
sStrLen = 0;
}
/* count characters */
if (iSwitch == DO_LIST_CHARLIST)
{
char pcRet[256];
size_t sRetStrLen = 0;
for (sCnt = 0; sCnt < sStrLen; sCnt++)
{
if (asCharCnt[pcString[sCnt]] == 0)
{
pcRet[sRetStrLen++] = pcString[sCnt];
asCharCnt[pcString[sCnt]] = 1;
}
}
hb_retclen (pcRet, sRetStrLen);
}
else
{
for (sCnt = 0; sCnt < sStrLen; sCnt++)
{
size_t sIndex = (size_t)(unsigned char)(*(pcString+sCnt));
asCharCnt[sIndex] = asCharCnt[sIndex]+1;
}
switch (iSwitch)
{
case DO_LIST_CHARSLIST:
{
char *pcRet;
size_t sRetStrLen = 0;
pcRet = hb_xgrab (256);
for (sCnt = 0; sCnt < 256; sCnt++)
{
if (asCharCnt[sCnt] != 0)
{
*(pcRet+sRetStrLen) = (unsigned char)sCnt;
sRetStrLen++;
}
}
hb_retclen (pcRet, sRetStrLen);
hb_xfree (pcRet);
}; break;
case DO_LIST_CHARNOLIST:
{
char *pcRet;
size_t sRetStrLen = 0;
pcRet = hb_xgrab (256);
for (sCnt = 0; sCnt < 256; sCnt++)
{
if (asCharCnt[sCnt] == 0)
{
*(pcRet+sRetStrLen) = (unsigned char)sCnt;
sRetStrLen++;
}
}
hb_retclen (pcRet, sRetStrLen);
hb_xfree (pcRet);
}; break;
case DO_LIST_CHARHIST:
{
PHB_ITEM pArray, pCount;
pArray = hb_itemArrayNew (256);
for (sCnt = 0; sCnt < 256; sCnt++)
{
pCount = hb_itemPutNL (NULL, asCharCnt[sCnt]);
hb_itemArrayPut (pArray, sCnt+1, pCount);
hb_itemRelease (pCount);
}
hb_itemReturn (pArray);
hb_itemRelease (pArray);
}; break;
}
}
return;
}
/* $DOC$
* $FUNCNAME$
* CHARLIST()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Generates a list of all characters in a string
* $SYNTAX$
* CHARLIST ([<cString>]) -> cCharacterList
* $ARGUMENTS$
* [<cString>] is the string for whom the function generates a list
* of all characters
* Default: "" (empty string)
* $RETURNS$
* <cCharacterList> a list of the characters in <cString>
* $DESCRIPTION$
* The CHARLIST() function generates a list of those characters that
* are contained in <cString>. This list can contain each character
* only once, so that its maximum length is 256. The list lists those
* characters first that are occuring in <cString> first.
* $EXAMPLES$
* ? charlist ("Hello World !") --> "Helo Wrd!"
* $TESTS$
* charlist ("Hello World !") == "Helo Wrd!"
* charlist (nil) == ""
* $STATUS$
* Ready
* $COMPLIANCE$
* CHARLIST() is compatible with CT3's CHARLIST().
* $PLATFORMS$
* All
* $FILES$
* Source is charlist.c, library is ct3.
* $SEEALSO$
* CHARNOLIST() CHARSLIST() CHARHIST()
* $END$
*/
HB_FUNC (CHARLIST)
{
do_list (DO_LIST_CHARLIST);
return;
}
/* $DOC$
* $FUNCNAME$
* CHARSLIST()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Generates a sorted list of all characters in a string
* $SYNTAX$
* CHARSLIST ([<cString>]) -> cSortedCharacterList
* $ARGUMENTS$
* [<cString>] is the string for whom the function generates a
* sorted list of all characters
* Default: "" (empty string)
* $RETURNS$
* <cSortedCharacterList> a sorted list of the characters in <cString>
* $DESCRIPTION$
* The CHARLIST() function generates a sorted list of those characters that
* are contained in <cString>. This list can contain each character
* only once, so that its maximum length is 256. The function
* gives the same result as CHARSORT(CHARLIST(<cString>))
* $EXAMPLES$
* ? charslist ("Hello World !") --> " !HWdelor"
* $TESTS$
* charslist ("Hello World !") == " !HWdelor"
* charslist ("Hello World !") == charsort (charlist ("Hello World !"))
* charslist (nil) == ""
* $STATUS$
* Ready
* $COMPLIANCE$
* CHARSLIST() is only available in Harbour's CT3 library.
* $PLATFORMS$
* All
* $FILES$
* Source is charlist.c, library is ct3.
* $SEEALSO$
* CHARNOLIST() CHARLIST() CHARHIST()
* $END$
*/
HB_FUNC (CHARSLIST)
{
do_list (DO_LIST_CHARSLIST);
return;
}
/* $DOC$
* $FUNCNAME$
* CHARNOLIST()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Generates a list of all characters not contained in a string
* $SYNTAX$
* CHARNOLIST ([<cString>]) -> cCharacterList
* $ARGUMENTS$
* [<cString>] is the string for whom the function generates a list
* of all characters not contained in that string
* Default: "" (empty string)
* $RETURNS$
* <cCharacterList> a list of the characters that are not contained in <cString>
* $DESCRIPTION$
* The CHARNOLIST() function generates a list of those characters that
* are not contained in <cString>. This list can contain each character
* only once, so that its maximum length is 256. The list is alphabetically
* sorted.
* $EXAMPLES$
* ? charnolist (charnolist ("Hello World !")) --> " !HWdelor"
* $TESTS$
* charnolist (charnolist ("Hello World !")) == charslist ("Hello World !")
* charnolist (charnolist (nil)) == ""
* $STATUS$
* Ready
* $COMPLIANCE$
* CHARNOLIST() is compatible with CT3's CHARNOLIST().
* $PLATFORMS$
* All
* $FILES$
* Source is charlist.c, library is ct3.
* $SEEALSO$
* CHARLIST() CHARSLIST() CHARHIST()
* $END$
*/
HB_FUNC (CHARNOLIST)
{
do_list (DO_LIST_CHARNOLIST);
return;
}
/* $DOC$
* $FUNCNAME$
* CHARHIST()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Generates a character histogram of a string
* $SYNTAX$
* CHARHIST ([<cString>]) -> aCharacterCount
* $ARGUMENTS$
* [<cString>] is the string for whom the function generates a
* character histogram
* Default: "" (empty string)
* $RETURNS$
* <aCharacterCount> an array with 256 elements where the nth element
* contains the count of character #(n-1) in cString
* $DESCRIPTION$
* The CHARHIST() function generates a character histogram of those
* characters that are contained in <cString>. This histogram is stored
* in an 256-element array where the nth element contains the count
* of ASCII character #(n-1) in <cString>.
* $EXAMPLES$
* ? charhist ("Hello World !")[109] --> 3 // chr(108)=="l"
* $TESTS$
* charhist ("Hello World !")[109] == 3
* eval ({||aeval (charhist ("Hello World !"),{|x|nTotal+=x}),nTotal==len("Hello World !")}
* $STATUS$
* Ready
* $COMPLIANCE$
* CHARHIST() is only available in Harbour's CT3 library.
* $PLATFORMS$
* All
* $FILES$
* Source is charlist.c, library is ct3.
* $SEEALSO$
* CHARLIST() CHARNOLIST() CHARSLIST()
* $END$
*/
HB_FUNC (CHARHIST)
{
do_list (DO_LIST_CHARHIST);
return;
}

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

@@ -165,17 +165,18 @@ ASCIISUM ;R;
ASCPOS ;R;
ATADJUST ;R;
ATNUM ;R;
ATREPL ;N;
ATREPL ;R;
ATTOKEN ;N;
BEFORATNUM ;R;
CENTER ;R;
CHARADD ;R;
CHARAND ;R;
CHAREVEN ;R;
CHARLIST ;N;
CHARHIST ;R; !NEW!
CHARLIST ;R;
CHARMIRR ;N;
CHARMIX ;R;
CHARNOLIST ;N;
CHARNOLIST ;R;
CHARNOT ;R;
CHARODD ;R;
CHARONE ;N;
@@ -190,6 +191,7 @@ CHARRLL ;R; !NEW!
CHARRLR ;R; !NEW!
CHARSHL ;R; !NEW!
CHARSHR ;R; !NEW!
CHARSLIST ;R; !NEW!
CHARSORT ;N;
CHARSPREAD ;N;
CHARSUB ;R; !NEW!

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

@@ -95,7 +95,9 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\ascpos.obj \
$(OBJ_DIR)\atadjust.obj \
$(OBJ_DIR)\atnum.obj \
$(OBJ_DIR)\atrepl.obj \
$(OBJ_DIR)\charevod.obj \
$(OBJ_DIR)\charlist.obj \
$(OBJ_DIR)\charop.obj \
$(OBJ_DIR)\ctset.obj \
$(OBJ_DIR)\ctstr.obj \
@@ -145,10 +147,18 @@ $(OBJ_DIR)\atnum.obj : $(TOOLS_DIR)\atnum.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\atrepl.obj : $(TOOLS_DIR)\atrepl.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\charevod.obj : $(TOOLS_DIR)\charevod.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\charlist.obj : $(TOOLS_DIR)\charlist.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\charop.obj : $(TOOLS_DIR)\charop.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,

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

@@ -115,7 +115,9 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\ascpos.obj \
$(OBJ_DIR)\atadjust.obj \
$(OBJ_DIR)\atnum.obj \
$(OBJ_DIR)\atrepl.obj \
$(OBJ_DIR)\charevod.obj \
$(OBJ_DIR)\charlist.obj \
$(OBJ_DIR)\charop.obj \
$(OBJ_DIR)\ctset.obj \
$(OBJ_DIR)\ctstr.obj \
@@ -142,7 +144,9 @@ CLEAN:
-@if exist $(OBJ_DIR)\ascpos.* del $(OBJ_DIR)\ascpos.*
-@if exist $(OBJ_DIR)\atadjust.* del $(OBJ_DIR)\atadjust.*
-@if exist $(OBJ_DIR)\atnum.* del $(OBJ_DIR)\atnum.*
-@if exist $(OBJ_DIR)\atrepl.* del $(OBJ_DIR)\atrepl.*
-@if exist $(OBJ_DIR)\charevod.* del $(OBJ_DIR)\charevod.*
-@if exist $(OBJ_DIR)\charlist.* del $(OBJ_DIR)\charlist.*
-@if exist $(OBJ_DIR)\charop.* del $(OBJ_DIR)\charop.*
-@if exist $(OBJ_DIR)\ctset.* del $(OBJ_DIR)\ctset.*
-@if exist $(OBJ_DIR)\ctstr.* del $(OBJ_DIR)\ctstr.*

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

@@ -17,16 +17,24 @@ Changes and Enhancements over the original CA-T**ls 3 Library
* ADDASCII() New 4th parameter to enable a carry over in the addition
process
* SETATLIKE() 2nd parameter can be passed by reference so that SETATLIKE
can store the acutal wildcard character in it
* ATREPL() New 6th parameter to specify characters to be ignored
+ CHARSUB subtracts corresponding ASCII values
+ CHARSHL bitwise shift left operation on characters
+ CHARSHR bitwise shift right operation on characters
+ CHARHIST generates a character histogram of a string
+ CHARRLL bitwise roll to the left operation on characters
+ CHARRLR bitwise roll to the right operation on characters
+ CHARSHL bitwise shift left operation on characters
+ CHARSHR bitwise shift right operation on characters
+ CHARSLIST generates a sorted character list of a string
+ CHARSUB subtracts corresponding ASCII values
* SETATLIKE() 2nd parameter can be passed by reference so that SETATLIKE
can store the acutal wildcard character in it

5
harbour/contrib/libct/tests/Makefile
View File

@@ -36,10 +36,14 @@ PRG_SOURCES=\
ascpos.prg \
atadjust.prg \
atnum.prg \
atrepl.prg \
beforatn.prg \
charadd.prg \
charand.prg \
chareven.prg \
charhist.prg \
charlist.prg \
charnlst.prg \
charnot.prg \
charodd.prg \
charor.prg \
@@ -47,6 +51,7 @@ PRG_SOURCES=\
charrlr.prg \
charshl.prg \
charshr.prg \
charslst.prg \
charsub.prg \
charxor.prg \
csetref.prg \

80
harbour/contrib/libct/tests/atrepl.prg Normal file
View File

@@ -0,0 +1,80 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function ATREPL()
*
* 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.ch"
procedure main()
qout ("Begin test of ATREPL()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ atrepl ("ABC", "ABCDABCDABC", "xx") == "xxDxxDxx" ? --> "] + atrepl ("ABC", "ABCDABCDABC", "xx") + ["])
qout ([ atrepl ("ABC", "ABCDABC", "ZYXW") == "ZYXWDZYXW" ? --> "] + atrepl ("ABC", "ABCDABC", "ZYXW") + ["])
qout ([ atrepl ("ABC", "ABCDABCDABC", "xx", 2) == "xxDxxDABC" ? --> "] + atrepl ("ABC", "ABCDABCDABC", "xx", 2) + ["])
qout ([ atrepl ("ABC", "ABCDABCDABC", "xx", 2, .T.) == "ABCDxxDABC" ? --> "] + atrepl ("ABC", "ABCDABCDABC", "xx", 2, .T.) + ["])
qout ([ atrepl ("ABC", "ABCDABCDABC", "xx", 2, .T., 1) == "ABCDABCDxx" ? ])
qout ([ --> "] + atrepl ("ABC", "ABCDABCDABC", "xx", 2, .T., 1) + ["])
qout ("End test of ATREPL()")
qout ("")
return

81
harbour/contrib/libct/tests/charhist.prg Normal file
View File

@@ -0,0 +1,81 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function CHARHIST()
*
* 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.ch"
procedure main
local aArr
local nTotal := 0
qout ("Begin test of CHARHIST()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charhist ("Hello World !")]+"[109] == 3 ? --> ", charhist ("Hello World !")[109])
qout ([ aeval (charhist ("Hello World !"),{|x|nTotal+=x})])
aeval (charhist ("Hello World !"),{|x|nTotal+=x})
qout ([ ==> nTotal == len("Hello World !") ? --> ], nTotal == len("Hello World !"))
qout ("End test of CHARHIST()")
qout ("")
return

76
harbour/contrib/libct/tests/charlist.prg Normal file
View File

@@ -0,0 +1,76 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function CHARLIST()
*
* 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.ch"
procedure main
qout ("Begin test of CHARLIST()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charlist ("Hello World !") == "Helo Wrd!" ? -> "] + charlist ("Hello World !") + ["])
qout ([ charlist (nil) == "" ? -> "] + charlist (nil) + ["])
qout ("End test of CHARLIST()")
qout ("")
return

77
harbour/contrib/libct/tests/charnlst.prg Normal file
View File

@@ -0,0 +1,77 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function CHARNOLIST()
*
* 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.ch"
procedure main
qout ("Begin test of CHARNOLIST()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charnolist (charnolist ("Hello World !")) == " !HWdelor" ? -> "] + charnolist (charnolist ("Hello World !")) + ["])
qout ([ charnolist (charnolist (nil)) == ""? -> "] + charnolist (charnolist (nil)) + ["])
qout ("End test of CHARNOLIST()")
qout ("")
return

76
harbour/contrib/libct/tests/charslst.prg Normal file
View File

@@ -0,0 +1,76 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 function CHARSLIST()
*
* 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.ch"
procedure main
qout ("Begin test of CHARSLIST()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ charslist ("Hello World !") == " !HWdelor" ? -> "] + charslist ("Hello World !") + ["])
qout ([ charslist (nil) == "" ? -> "] + charslist (nil) + ["])
qout ("End test of CHARSLIST()")
qout ("")
return