From 9064a7fa40cf16dd6acb124c782e6c92b486bd1e Mon Sep 17 00:00:00 2001 From: Martin Vogel Date: Sat, 28 Apr 2001 21:12:26 +0000 Subject: [PATCH] 2001-04-28 23:15 CET Martin Vogel --- harbour/ChangeLog | 53 ++++ harbour/contrib/libct/Makefile | 2 + harbour/contrib/libct/atrepl.c | 356 +++++++++++++++++++++ harbour/contrib/libct/charlist.c | 384 +++++++++++++++++++++++ harbour/contrib/libct/ctflist.txt | 8 +- harbour/contrib/libct/makefile.bc | 10 + harbour/contrib/libct/makefile.vc | 4 + harbour/contrib/libct/readme.txt | 22 +- harbour/contrib/libct/tests/Makefile | 5 + harbour/contrib/libct/tests/atrepl.prg | 80 +++++ harbour/contrib/libct/tests/charhist.prg | 81 +++++ harbour/contrib/libct/tests/charlist.prg | 76 +++++ harbour/contrib/libct/tests/charnlst.prg | 77 +++++ harbour/contrib/libct/tests/charslst.prg | 76 +++++ 14 files changed, 1224 insertions(+), 10 deletions(-) create mode 100644 harbour/contrib/libct/atrepl.c create mode 100644 harbour/contrib/libct/charlist.c create mode 100644 harbour/contrib/libct/tests/atrepl.prg create mode 100644 harbour/contrib/libct/tests/charhist.prg create mode 100644 harbour/contrib/libct/tests/charlist.prg create mode 100644 harbour/contrib/libct/tests/charnlst.prg create mode 100644 harbour/contrib/libct/tests/charslst.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index d2647dac3d..3202d925d7 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,56 @@ +2001-04-28 23:15 CET Martin Vogel + + + 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 * doc/en/input.txt diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index 798682341e..16b4adb5f4 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -10,7 +10,9 @@ C_SOURCES=\ ascpos.c \ atadjust.c \ atnum.c \ + atrepl.c \ charevod.c \ + charlist.c \ charop.c \ ctset.c \ ctstr.c \ diff --git a/harbour/contrib/libct/atrepl.c b/harbour/contrib/libct/atrepl.c new file mode 100644 index 0000000000..28d73c3def --- /dev/null +++ b/harbour/contrib/libct/atrepl.c @@ -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 + * + * 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 (, , , [], + * [], []) --> cString + * $ARGUMENTS$ + * is the substring searched for in + * is the processed string + * is the replacement for sequences found + * [] specifies the number of replacements + * Default: last occurence + * [] if set to .T., only the th sequence + * of will be replaced, else + * all sequences will be replaced. + * Default: .F. + * []) specifies how many characters in from + * the beginning should be ignored by the function + * Default: 0 + * $RETURNS$ + * + * $DESCRIPTION$ + * The ATREPL() function searches and replaces sequences in a string. + * First, the function ignores the first characters of . + * Then, if is set to .T., it searches for the th + * occurence of in . If successful, the + * sequence will be replaced with . + * If is set to .F., the same search is performed, but EVERY + * occurence of till the th (inclusive) will + * be replaced with . Note that, in this case, + * the replacements are performed even if the 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 + * 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; + +} + + diff --git a/harbour/contrib/libct/charlist.c b/harbour/contrib/libct/charlist.c new file mode 100644 index 0000000000..d272c44a35 --- /dev/null +++ b/harbour/contrib/libct/charlist.c @@ -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 + * + * 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 ([]) -> cCharacterList + * $ARGUMENTS$ + * [] is the string for whom the function generates a list + * of all characters + * Default: "" (empty string) + * $RETURNS$ + * a list of the characters in + * $DESCRIPTION$ + * The CHARLIST() function generates a list of those characters that + * are contained in . 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 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 ([]) -> cSortedCharacterList + * $ARGUMENTS$ + * [] is the string for whom the function generates a + * sorted list of all characters + * Default: "" (empty string) + * $RETURNS$ + * a sorted list of the characters in + * $DESCRIPTION$ + * The CHARLIST() function generates a sorted list of those characters that + * are contained in . This list can contain each character + * only once, so that its maximum length is 256. The function + * gives the same result as CHARSORT(CHARLIST()) + * $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 ([]) -> cCharacterList + * $ARGUMENTS$ + * [] is the string for whom the function generates a list + * of all characters not contained in that string + * Default: "" (empty string) + * $RETURNS$ + * a list of the characters that are not contained in + * $DESCRIPTION$ + * The CHARNOLIST() function generates a list of those characters that + * are not contained in . 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 ([]) -> aCharacterCount + * $ARGUMENTS$ + * [] is the string for whom the function generates a + * character histogram + * Default: "" (empty string) + * $RETURNS$ + * 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 . This histogram is stored + * in an 256-element array where the nth element contains the count + * of ASCII character #(n-1) in . + * $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; + +} + + diff --git a/harbour/contrib/libct/ctflist.txt b/harbour/contrib/libct/ctflist.txt index 27152fe3d8..3ca57e6b94 100644 --- a/harbour/contrib/libct/ctflist.txt +++ b/harbour/contrib/libct/ctflist.txt @@ -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! diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index 581a2350e0..89ac399e66 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -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) -+$@,, diff --git a/harbour/contrib/libct/makefile.vc b/harbour/contrib/libct/makefile.vc index a62277cf18..2f4daa37e2 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -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.* diff --git a/harbour/contrib/libct/readme.txt b/harbour/contrib/libct/readme.txt index 9f2cae7fd0..afd496ba5f 100644 --- a/harbour/contrib/libct/readme.txt +++ b/harbour/contrib/libct/readme.txt @@ -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 + + + diff --git a/harbour/contrib/libct/tests/Makefile b/harbour/contrib/libct/tests/Makefile index 4bf97e929b..ce98073ea7 100644 --- a/harbour/contrib/libct/tests/Makefile +++ b/harbour/contrib/libct/tests/Makefile @@ -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 \ diff --git a/harbour/contrib/libct/tests/atrepl.prg b/harbour/contrib/libct/tests/atrepl.prg new file mode 100644 index 0000000000..885d1405bc --- /dev/null +++ b/harbour/contrib/libct/tests/atrepl.prg @@ -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 + * + * 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 + + + + diff --git a/harbour/contrib/libct/tests/charhist.prg b/harbour/contrib/libct/tests/charhist.prg new file mode 100644 index 0000000000..4b10846199 --- /dev/null +++ b/harbour/contrib/libct/tests/charhist.prg @@ -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 + * + * 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 + + + + diff --git a/harbour/contrib/libct/tests/charlist.prg b/harbour/contrib/libct/tests/charlist.prg new file mode 100644 index 0000000000..8a1909fc77 --- /dev/null +++ b/harbour/contrib/libct/tests/charlist.prg @@ -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 + * + * 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 + + + + diff --git a/harbour/contrib/libct/tests/charnlst.prg b/harbour/contrib/libct/tests/charnlst.prg new file mode 100644 index 0000000000..bcc4d1399f --- /dev/null +++ b/harbour/contrib/libct/tests/charnlst.prg @@ -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 + * + * 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 + + + + diff --git a/harbour/contrib/libct/tests/charslst.prg b/harbour/contrib/libct/tests/charslst.prg new file mode 100644 index 0000000000..4249e5451d --- /dev/null +++ b/harbour/contrib/libct/tests/charslst.prg @@ -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 + * + * 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 + + + +