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

2002-02-19 00:05 UTC+0100 Martin Vogel <vogel@inttec.de>

Browse Source
This commit is contained in:
Martin Vogel
2002-02-18 23:13:03 +00:00
parent 20e6086910
commit ef4da17646
15 changed files with 1647 additions and 474 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
harbour/ChangeLog
View File

@@ -7,6 +7,20 @@
For example:
2002-12-01 23:12 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
* minor fix borrowed from [x]Harbour
Many thanks to Ron
It fixes this kind of code:
#xcommand INIT[<c>] ;
=>;
+ contrib/libct/tab.c
function Main()
INIT["test"]
return nil
2002-02-18 23:41 UTC-0300 Luiz Rafael Culik <culikr@uol.com.br>
* utils/hbmake/hbmake.prg

3
harbour/contrib/libct/Makefile
View File

@@ -34,9 +34,11 @@ C_SOURCES = \
ctcrypt.c \
files.c \
finan.c \
ftoc.c \
justify.c \
keyset.c \
math.c \
misc1.c \
num1.c \
numat.c \
pad.c \
@@ -49,6 +51,7 @@ C_SOURCES = \
remove.c \
replace.c \
strswap.c \
tab.c \
token1.c \
token2.c \
trig.c \

29
harbour/contrib/libct/charonly.c
View File

@@ -83,6 +83,35 @@ static void do_charonly (int iSwitch)
int iShift, iBool;
char *pcSub, *pc;
/* check for zero-length strings */
switch (iSwitch)
{
case DO_CHARONLY_CHARONLY:
case DO_CHARONLY_WORDONLY:
{
if ((sStrLen == 0) || (sOnlySetLen == 0))
{
hb_retc ("");
return;
}
}; break;
case DO_CHARONLY_CHARREM:
case DO_CHARONLY_WORDREM:
{
if (sStrLen == 0)
{
hb_retc ("");
return;
}
if (sOnlySetLen == 0)
{
hb_retclen (pcString, sStrLen);
return;
}
}; break;
}
if ((iSwitch == DO_CHARONLY_WORDONLY) || (iSwitch == DO_CHARONLY_WORDREM))
{
iShift = 2;

14
harbour/contrib/libct/charrepl.c
View File

@@ -145,6 +145,20 @@ HB_FUNC (CHARREPL)
char *pcRet;
size_t sIndex;
/* if sStrLen == 0, we can return immediately */
if (sStrLen == 0)
{
if (iNoRet)
{
hb_retl (0);
}
else
{
hb_retc ("");
}
return;
}
if (ISLOG (4))
{
iMode = hb_parl (4);

942
harbour/contrib/libct/cterror.ch
View File

File diff suppressed because it is too large Load Diff

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

@@ -246,8 +246,8 @@ SAVETOKEN ;R;
SETATLIKE ;R;
STRDIFF ;N;
STRSWAP ;S;
TABEXPAND ;N;
TABPACK ;N;
TABEXPAND ;S;
TABPACK ;S;
TOKEN ;R;
TOKENAT ;R;
TOKENEND ;R;
@@ -274,11 +274,11 @@ BITTOC ;S;
CELSIUS ;R;
CLEARBIT ;S;
CTOBIT ;S;
CTOF ;N;
CTOF ;S;
CTON ;S;
EXPONENT ;N;
FAHRENHEIT ;R;
FTOC ;N;
FTOC ;S;
INFINITY ;R;
INTNEG ;N;
INTPOS ;N;
@@ -592,7 +592,7 @@ SOUND ;N;
SPEED ;N;
STACKFREE ;N;
TOOLVER ;N;
XTOC ;N;
XTOC ;S;
;
;
;3.4 math functions

169
harbour/contrib/libct/ftoc.c Normal file
View File

@@ -0,0 +1,169 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 Number and bit manipulation functions: - FTOC()
* - CTOF()
*
* Copyright 2002 Walter Negro - FOEESITRA" <waltern@foeesitra.org.ar>
* 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$
* FTOC()
* $CATEGORY$
* CT3 number and bit manipulation functions
* $ONELINER$
* $SYNTAX$
* FTOC( <nFloatingPointNumber> ) --> cFloatingPointNumber
*
* $ARGUMENTS$
* <nFloatingPointNumber> Designate any Harbour number.
*
* $RETURNS$
* FTOC() return a string with the size of DOUBLE.
* ATTENTION: different implementations or platforms of Harbour, they
* could produce different format in the string returned by FTOC().
*
* $DESCRIPTION$
* Harbour internal numbers in Floating Point are stored in data type
* DOUBLE. FTOC() returns these bits as an string. In this way,
* numbers con be saved more compactly.
*
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* $PLATFORMS$
* All
* $FILES$
* Source is ftoc.c, library is libct.
* $SEEALSO$
* CTOF(), XTOC()
* $END$
*/
HB_FUNC( FTOC )
{
union
{
double value;
char string[ sizeof( double )];
} xConvert;
xConvert.value = hb_parnd( 1 );
hb_retclen( xConvert.string, sizeof( double ) );
}
/* $DOC$
* $FUNCNAME$
* CTOF()
* $CATEGORY$
* CT3 number and bit manipulation functions
* $ONELINER$
* $SYNTAX$
* CTOF( <cFloatingPointNumber> ) --> nFloatingPointNumber
*
* $ARGUMENTS$
* <cFloatingPointNumber> Designate a string that contains a Harbour
* number in flotaing point format.
* ATTENTION: different implementations or platforms of Harbour, they
* could produce different format in the string returned by FTOC().
*
* $RETURNS$
* CTOF() return the floating point number that corresponds to the
* string passed.
*
* $DESCRIPTION$
* Character strings created with FTOC() or XTOC() are convert into
* Harbour floating point number
*
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* $PLATFORMS$
* All
* $FILES$
* Source is ftoc.c, library is libct.
* $SEEALSO$
* FTOC(), XTOC()
* $END$
*/
HB_FUNC( CTOF )
{
union
{
double value;
char string[ sizeof( double )];
} xConvert;
char * pcString;
int i;
if (hb_parclen( 1 ) == sizeof( double ))
{
pcString = hb_parc( 1 );
for (i=0; i<sizeof(double); i++)
xConvert.string[i] = pcString[i];
hb_retnd( xConvert.value );
}
else
hb_retnd( 0.0 );
}

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

@@ -119,9 +119,11 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\ctcrypt.obj \
$(OBJ_DIR)\files.obj \
$(OBJ_DIR)\finan.obj \
$(OBJ_DIR)\ftoc.obj \
$(OBJ_DIR)\justify.obj \
$(OBJ_DIR)\keyset.obj \
$(OBJ_DIR)\math.obj \
$(OBJ_DIR)\misc1.obj \
$(OBJ_DIR)\num1.obj \
$(OBJ_DIR)\numat.obj \
$(OBJ_DIR)\pad.obj \
@@ -134,6 +136,7 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\remove.obj \
$(OBJ_DIR)\replace.obj \
$(OBJ_DIR)\strswap.obj \
$(OBJ_DIR)\tab.obj \
$(OBJ_DIR)\token1.obj \
$(OBJ_DIR)\token2.obj \
$(OBJ_DIR)\trig.obj \
@@ -278,6 +281,10 @@ $(OBJ_DIR)\finan.obj : $(TOOLS_DIR)\finan.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\ftoc.obj : $(TOOLS_DIR)\ftoc.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\justify.obj : $(TOOLS_DIR)\justify.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
@@ -290,6 +297,10 @@ $(OBJ_DIR)\math.obj : $(TOOLS_DIR)\math.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\misc1.obj : $(TOOLS_DIR)\misc1.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\num1.obj : $(TOOLS_DIR)\num1.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
@@ -338,6 +349,10 @@ $(OBJ_DIR)\strswap.obj : $(TOOLS_DIR)\strswap.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\tab.obj : $(TOOLS_DIR)\tab.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\token1.obj : $(TOOLS_DIR)\token1.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,,

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

@@ -138,9 +138,11 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\ctcolton.obj \
$(OBJ_DIR)\ctcrypt.obj \
$(OBJ_DIR)\finan.obj \
$(OBJ_DIR)\ftoc.obj \
$(OBJ_DIR)\justify.obj \
$(OBJ_DIR)\keyset.obj \
$(OBJ_DIR)\math.obj \
$(OBJ_DIR)\misc1.obj \
$(OBJ_DIR)\num1.obj \
$(OBJ_DIR)\numat.obj \
$(OBJ_DIR)\pad.obj \
@@ -153,6 +155,7 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\remove.obj \
$(OBJ_DIR)\replace.obj \
$(OBJ_DIR)\strswap.obj \
$(OBJ_DIR)\tab.obj \
$(OBJ_DIR)\token1.obj \
$(OBJ_DIR)\token2.obj \
$(OBJ_DIR)\trig.obj \
@@ -201,8 +204,10 @@ CLEAN:
-@if exist $(OBJ_DIR)\ctcolton.* del $(OBJ_DIR)\ctcolton.*
-@if exist $(OBJ_DIR)\ctcrypt.* del $(OBJ_DIR)\ctcrypt.*
-@if exist $(OBJ_DIR)\finan.* del $(OBJ_DIR)\finan.*
-@if exist $(OBJ_DIR)\ftoc.* del $(OBJ_DIR)\ftoc.*
-@if exist $(OBJ_DIR)\justify.* del $(OBJ_DIR)\justify.*
-@if exist $(OBJ_DIR)\math.* del $(OBJ_DIR)\math.*
-@if exist $(OBJ_DIR)\misc1.* del $(OBJ_DIR)\misc1.*
-@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.*
@@ -214,6 +219,7 @@ CLEAN:
-@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)\tab.* del $(OBJ_DIR)\tab.*
-@if exist $(OBJ_DIR)\token1.* del $(OBJ_DIR)\token1.*
-@if exist $(OBJ_DIR)\token2.* del $(OBJ_DIR)\token2.*
-@if exist $(OBJ_DIR)\trig.* del $(OBJ_DIR)\trig.*

146
harbour/contrib/libct/misc1.c Normal file
View File

@@ -0,0 +1,146 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT3 Miscellaneous functions: - XTOC()
*
* Copyright 2002 Walter Negro - FOEESITRA" <waltern@foeesitra.org.ar>
* 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$
* XTOC()
* $CATEGORY$
* CT3 miscellaneous functions
* $ONELINER$
* $SYNTAX$
* XTOC( <expValue> ) --> cValue
*
* $ARGUMENTS$
* <expValue> Designate an expression of some of the following data
* type: NUMBER, CHARACTER, DATE, LOGICAL.
*
* $RETURNS$
* XTOC() return a string with the representation of data type of
* expValue.
* ATTENTION: different implementations or platforms of Harbour, they
* could produce different format in the string returned by XTOC() for
* data type NUMBER.
*
* $DESCRIPTION$
* Each data type always returns a string with a particular fixed length:
*
* -----------------------------------------------------------
* Data Type Result Length Similar function
* -----------------------------------------------------------
* Numeric sizeof( DOUBLE ) FTOC()
* Logical 1
* Date 8 DTOS()
* String Unchanged
* -----------------------------------------------------------
*
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* $PLATFORMS$
* All
* $FILES$
* Source is misc1.c, library is libct.
* $SEEALSO$
* CTOF(), FTOC()
* $END$
*/
HB_FUNC( XTOC )
{
union
{
double value;
char string[ sizeof( double )];
} xConvert;
char pcString[ sizeof( double ) ];
if (ISCHAR( 1 ))
{
hb_retc( hb_parc( 1 ));
}
else if (ISNUM( 1 ))
{
xConvert.value = hb_parnd( 1 );
hb_retclen( xConvert.string, sizeof( double ) );
}
else if (ISLOG( 1 ))
{
if (hb_parl( 1 ) == 0)
pcString[0] = 0x46;
else
pcString[0] = 0x54;
hb_retclen( pcString, 1 );
}
else if (ISDATE( 1 ))
{
hb_retc( hb_pards( 1 ));
}
else
{
pcString[0] = 0x00;
hb_retc( pcString );
}
}

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

@@ -45,6 +45,13 @@ Martin Vogel <vogel@inttec.de>
+ CTEXIT() library exit function
+ NUMANDX() \
+ NUMORX() |
+ NUMXORX() |- equivalents to NUMAND(),... functions, but working
+ NUMNOTX() | with any bit number of 1 to 32
+ NUMROLX() |
+ NUMMIRRX() /
* SETATLIKE() 2nd parameter can be passed by reference so that SETATLIKE
can store the acutal wildcard character in it
@@ -52,6 +59,9 @@ Martin Vogel <vogel@inttec.de>
+ SINH() hyperbolic sine
* TABPACK() new 4th, 5th and 6th parameter to let one set the carriage-return-line-feed string,
* TABEXPAND() the tab character and the chr(141)[soft line feed] behaviour
+ TANH() hyperbolic tangent
* TOKEN() New 5th and 6th parameter where the function can store

2
harbour/contrib/libct/remove.c
View File

@@ -101,7 +101,7 @@ static void do_remove (int iSwitch)
}
}
if (iSwitch != DO_REMOVE_REMRIGHT)
if (iSwitch != DO_REMOVE_REMLEFT)
{
pc = pcString+sStrLen-1;
while ((*pc == cSearch) && (pc >= pcRet))

593
harbour/contrib/libct/tab.c Normal file
View File

@@ -0,0 +1,593 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* TABEXPAND(), TABPACK() CT3 string functions
*
* Copyright 2002 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$
* TABEXPAND()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Replace tabulator control characters with fill characters
* $SYNTAX$
* TABEXPAND (<cString>, [<nTabWidth>], [<cFillChar|nFillChar>],
* [<cNewLineCharacters>], [<cTabChar|nTabChar>],
* [<lIgnore141>]) -> cExpandedString
* $ARGUMENTS$
* <cString>
* <nTabWidth>
* <cFillChar|nFillChar>
* <cNewLineCharacters> string indicating new line,
* default is the string returned by
* hb_osnewline()
* <cTabChar|nTabChar> character indicating a tab stop,
* default is chr(9)
* <lIgnore141> .T., if the soft-CR used by MEMOEDIT()
* should be ignored as a newline indicator,
* default is .F. (functions uses chr(141))
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* tabexpand("-"+chr(9)+"!") == "- !"
* tabexpand("----"+chr(9) +"!") == "---- !"
* tabexpand("-"+chr(9)+"!",, "+") == "-+++++++!"
* tabexpand("-"+chr(9)+ "!", 4) == "- !"
* tabexpand("----"+chr(9)+ "!", 8) == "---- !"
* tabexpand("----"+chr(9)+ "!", 8, "+") == "----++++!"
* tabexpand("-"+chr(9)+"!"+hb_osnewline()+"----"+chr(9)+ "!",, "+") == "-+++++++!"+hb_osnewline()+"----++++!"
* $STATUS$
* Started
* $COMPLIANCE$
* TABEXPAND() is compatible with CT3's TABEXPAND(), but there are
* three new parameters for a better fine control of the function's
* behaviour.
* $PLATFORMS$
* All
* $FILES$
* Source is tab.c, library is libct.
* $SEEALSO$
* TABPACK()
* $END$
*/
HB_FUNC (TABEXPAND)
{
if (ISCHAR (1))
{
char *pcString = (char *)hb_parc (1);
size_t sStrLen = (size_t)hb_parclen (1);
char *pcRet;
size_t sRetLen;
size_t sTabWidth = 0;
char cFill, cTab, cCR;
char *pcNewLine;
size_t sNewLineLen;
int iIgnore141;
size_t sIndex, sLineIndex;
size_t sTabCnt = 0;
if (ISNUM (2))
{
sTabWidth = hb_parnl (2);
}
if ((signed)sTabWidth <= 0)
{
sTabWidth = 8;
}
if (ISNUM (3) ||
((ISCHAR (3)) && (hb_parclen(3)>0)))
{
if (ISNUM (3))
{
cFill = (char)((hb_parnl (3))%256);
}
else
{
cFill = (char)(*(hb_parc (3)));
}
}
else
{
cFill = 0x20;
}
if ((ISCHAR (4)) && (hb_parclen(4)>0))
{
pcNewLine = (char *)hb_parc (4);
sNewLineLen = hb_parclen (4);
}
else
{
pcNewLine = hb_conNewLine();
sNewLineLen = 0;
while (*(pcNewLine+sNewLineLen) != 0x00)
sNewLineLen++;
}
if (sNewLineLen > 0)
{
cCR = *(pcNewLine);
}
else
{
cCR = 13;
}
if (ISNUM (5) ||
((ISCHAR (5)) && (hb_parclen(5)>0)))
{
if (ISNUM (5))
{
cTab = (char)((hb_parnl (5))%256);
}
else
{
cTab = (char)(*(hb_parc (5)));
}
}
else
{
cTab = 0x09;
}
if (ISLOG (6))
{
iIgnore141 = hb_parl (6);
}
else
{
iIgnore141 = 0;
}
/* estimate maximum return length by assuming that EVERY tab char
can be replaced by at most <nTabWidth> characters */
for (sIndex = 0; sIndex < sStrLen; sIndex++)
{
if (*(pcString+sIndex) == cTab)
{
sTabCnt++;
}
}
pcRet = (char *)hb_xgrab (sStrLen+(sTabCnt*(sTabWidth-1)));
/* now copy the string */
sIndex = 0;
sRetLen = 0;
sLineIndex = 0;
while (sTabCnt > 0)
{
char cChar = (char)*(pcString+sIndex);
if (cChar == cTab)
{
/* tab character */
size_t sFillIndex;
for (sFillIndex = sTabWidth-(sLineIndex%sTabWidth);
sFillIndex > 0; sFillIndex--)
{
*(pcRet+sRetLen) = cFill;
sRetLen++;
sLineIndex++;
}
sTabCnt--;
sIndex++;
}
else if ((unsigned char)cChar == 141)
{
/* soft carriage return */
*(pcRet+sRetLen) = 141;
sRetLen++;
sIndex++;
if (iIgnore141)
{
sLineIndex++;
}
else
{
sLineIndex = 0;
}
}
else if (cChar == cCR)
{
/* newline string ? */
if ((sNewLineLen > 0) &&
((sIndex+sNewLineLen) <= sStrLen) &&
(ct_at_exact_forward (pcString+sIndex, sNewLineLen,
pcNewLine, sNewLineLen, NULL) == pcString+sIndex))
{
hb_xmemcpy (pcRet+sRetLen, pcString+sIndex, sNewLineLen);
sRetLen += sNewLineLen;
sIndex += sNewLineLen;
sLineIndex = 0;
}
else
{
*(pcRet+sRetLen) = cCR;
sRetLen++;
sIndex++;
sLineIndex++;
}
}
else
{
*(pcRet+sRetLen) = *(pcString+sIndex);
sRetLen++;
sIndex++;
sLineIndex++;
}
}
/* copy rest */
hb_xmemcpy (pcRet+sRetLen, pcString+sIndex, sStrLen-sIndex);
sRetLen += sStrLen-sIndex;
hb_retclen (pcRet, sRetLen);
hb_xfree (pcRet);
}
else /* ISCHAR (1) */
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_TABEXPAND,
NULL, "TABEXPAND", 0, EF_CANSUBSTITUTE, 6,
hb_paramError (1), hb_paramError (2), hb_paramError (3),
hb_paramError (4), hb_paramError (5), hb_paramError (6));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retc ("");
}
}
return;
}
/* $DOC$
* $FUNCNAME$
* TABPACK()
* $CATEGORY$
* CT3 string functions
* $ONELINER$
* Pack fill characters to appropriate tab characters
* $SYNTAX$
* TABPACK (<cString>, [<nTabWidth>], [<cFillChar|nFillChar>],
* [<cNewLineCharacters>], [<cTabChar|nTabChar>],
* [<lIgnore141>]) -> cPackedString
* $ARGUMENTS$
* <cString>
* <nTabWidth>
* <cFillChar|nFillChar>
* <cNewLineCharacters> string indicating new line,
* default is the string returned by
* hb_osnewline()
* <cTabChar|nTabChar> character indicating a tab stop,
* default is chr(9)
* <lIgnore141> .T., if the soft-CR used by MEMOEDIT()
* should be ignored as a newline indicator,
* default is .F. (functions uses chr(141))
* $RETURNS$
* $DESCRIPTION$
* TODO: add documentation
* $EXAMPLES$
* $TESTS$
* $STATUS$
* Started
* $COMPLIANCE$
* TABPACK() is compatible with CT3's TABPACK(), but there are
* three new parameters for a better fine control of the function's
* behaviour.
* $PLATFORMS$
* All
* $FILES$
* Source is tab.c, library is libct.
* $SEEALSO$
* TABEXPAND()
* $END$
*/
HB_FUNC (TABPACK)
{
if (ISCHAR (1))
{
char *pcString = (char *)hb_parc (1);
size_t sStrLen = (size_t)hb_parclen (1);
char *pcRet;
size_t sRetLen;
size_t sTabWidth = 0;
char cFill, cTab, cCR;
char *pcNewLine;
size_t sNewLineLen;
int iIgnore141;
size_t sIndex, sTabIndex, sFillCount;
if (ISNUM (2))
{
sTabWidth = hb_parnl (2);
}
if ((signed)sTabWidth <= 0)
{
sTabWidth = 8;
}
if (ISNUM (3) ||
((ISCHAR (3)) && (hb_parclen(3)>0)))
{
if (ISNUM (3))
{
cFill = (char)((hb_parnl (3))%256);
}
else
{
cFill = (char)(*(hb_parc (3)));
}
}
else
{
cFill = 0x20;
}
if ((ISCHAR (4)) && (hb_parclen(4)>0))
{
pcNewLine = (char *)hb_parc (4);
sNewLineLen = hb_parclen (4);
}
else
{
pcNewLine = hb_conNewLine();
sNewLineLen = 0;
while (*(pcNewLine+sNewLineLen) != 0x00)
sNewLineLen++;
}
if (sNewLineLen > 0)
{
cCR = *(pcNewLine);
}
else
{
cCR = 13;
}
if (ISNUM (5) ||
((ISCHAR (5)) && (hb_parclen(5)>0)))
{
if (ISNUM (5))
{
cTab = (char)((hb_parnl (5))%256);
}
else
{
cTab = (char)(*(hb_parc (5)));
}
}
else
{
cTab = 0x09;
}
if (ISLOG (6))
{
iIgnore141 = hb_parl (6);
}
else
{
iIgnore141 = 0;
}
/* estimate maximum return length by assuming that there's
nothing to pack */
pcRet = (char *)hb_xgrab (sStrLen);
/* now copy the string */
sIndex = 0;
sRetLen = 0;
sTabIndex = 0;
sFillCount = 0;
while (sIndex < sStrLen)
{
char cChar = (char)*(pcString+sIndex);
if (cChar == cFill)
{
if (sTabIndex==sTabWidth-1)
{
/* we have just found the last character of a tabstopp */
*(pcRet+sRetLen) = cTab;
sRetLen++;
sFillCount = 0;
sTabIndex = 0;
sIndex++;
}
else
{
sFillCount++;
sTabIndex++;
sIndex++;
}
}
else if (cChar == cTab)
{
*(pcRet+sRetLen) = cTab;
sRetLen++;
/* discard any fill characters before the tabstopp */
sFillCount = 0;
sTabIndex = 0;
sIndex++;
}
else if (((unsigned char)cChar == 141) && (!iIgnore141))
{
/* soft carriage return */
/* eventually not enough fill chars to fill a tab,
so copy them verbatim */
for (;sFillCount>0;sFillCount--)
{
*(pcRet+sRetLen) = cFill;
sRetLen++;
}
*(pcRet+sRetLen) = 141;
sRetLen++;
sTabIndex = 0;
sIndex++;
}
else if (cChar == cCR)
{
/* newline string ? */
if ((sNewLineLen > 0) &&
((sIndex+sNewLineLen) <= sStrLen) &&
(ct_at_exact_forward (pcString+sIndex, sNewLineLen,
pcNewLine, sNewLineLen, NULL) == pcString+sIndex))
{
/* eventually not enough fill chars to fill a tab,
so copy them verbatim */
for (;sFillCount>0;sFillCount--)
{
*(pcRet+sRetLen) = cFill;
sRetLen++;
}
hb_xmemcpy (pcRet+sRetLen, pcString+sIndex, sNewLineLen);
sRetLen += sNewLineLen;
sIndex += sNewLineLen;
sTabIndex = 0;
}
else
{
*(pcRet+sRetLen) = cCR;
sRetLen++;
sIndex++;
sTabIndex = 0;
}
}
else
{
/* eventually not enough fill chars to fill a tab,
so copy them verbatim */
for (;sFillCount>0;sFillCount--)
{
*(pcRet+sRetLen) = cFill;
sRetLen++;
sTabIndex++;
if (sTabIndex==sTabWidth-1)
{
sTabIndex = 0;
}
}
*(pcRet+sRetLen) = *(pcString+sIndex);
sRetLen++;
sIndex++;
sTabIndex++;
if (sTabIndex==sTabWidth-1)
{
sTabIndex = 0;
}
}
}
/* copy rest */
for (;sFillCount>0;sFillCount--)
{
*(pcRet+sRetLen) = cFill;
sRetLen++;
}
hb_retclen (pcRet, sRetLen);
hb_xfree (pcRet);
}
else /* ISCHAR (1) */
{
PHB_ITEM pSubst = NULL;
int iArgErrorMode = ct_getargerrormode();
if (iArgErrorMode != CT_ARGERR_IGNORE)
{
pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_TABPACK,
NULL, "TABPACK", 0, EF_CANSUBSTITUTE, 6,
hb_paramError (1), hb_paramError (2), hb_paramError (3),
hb_paramError (4), hb_paramError (5), hb_paramError (6));
}
if (pSubst != NULL)
{
hb_itemReturn (pSubst);
hb_itemRelease (pSubst);
}
else
{
hb_retc ("");
}
}
return;
}

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

@@ -71,6 +71,7 @@ PRG_SOURCES=\
num1.prg \
numtoken.prg \
setatlik.prg \
tab.prg \
token.prg \
token2.prg \
tokenlow.prg \

167
harbour/contrib/libct/tests/tab.prg Normal file
View File

@@ -0,0 +1,167 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Test CT3 functions TABEXPAND() and TABPACK()
*
* Copyright 2002 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 cStr, nLen, ni, cStr1
ctinit()
qout ("Begin test of TABEXPAND()")
qout ("")
// simple tests
qout ("Simple tests:")
qout ([ tabexpand("-"+chr(9)+"!") == "- !" ? -> "] + tabexpand ("-"+chr(9)+"!") + ["])
qout ([ tabexpand("----"+chr(9) +"!") == "---- !" ? -> "] + tabexpand ("----"+chr(9) +"!") + ["])
qout ([ tabexpand("-"+chr(9)+"!",, "+") == "-+++++++!" ? -> "] + tabexpand ("-"+chr(9)+"!",, "+") + ["])
qout ([ tabexpand("-"+chr(9)+ "!", 4) == "- !" ? -> "] + tabexpand ("-"+chr(9)+ "!", 4) + ["])
qout ([ tabexpand("----"+chr(9)+ "!", 8) == "---- !" ? -> "] + tabexpand ("----"+chr(9)+ "!", 8) + ["])
qout ([ tabexpand("----"+chr(9)+ "!", 8, "+") == "----++++!" ? -> "] + tabexpand ("----"+chr(9)+ "!", 8, "+") + ["])
qout ("")
qout ("Tests with newline characters: ^J == LF, ^M == CR")
cStr := hb_osnewline()
cStr := strtran (cStr, chr(10),"^J")
cStr := strtran (cStr, chr(13),"^M")
qout ([ hb_osnewline() = "] + cStr +["])
cStr := tabexpand("-"+chr(9)+"!"+hb_osnewline()+"----"+chr(9)+ "!",, "+")
cStr := strtran (cStr, chr(10),"^J")
cStr := strtran (cStr, chr(13),"^M")
qout ([ tabexpand("-"+chr(9)+"!"+hb_osnewline()+"----"+chr(9)+ "!",, "+")])
qout ([ == "-+++++++!"+hb_osnewline()+"----++++!" ? -> "] + cStr +["])
cStr := tabexpand("-"+chr(9)+"!$$--"+hb_osnewline()+"--"+chr(9)+ "!",, "+", "$")
cStr := strtran (cStr, chr(10),"^J")
cStr := strtran (cStr, chr(13),"^M")
qout ([ tabexpand("-"+chr(9)+"!$$--"+hb_osnewline()+--"+chr(9)+ "!",, "+", "$")])
nLen := len (hb_osnewline())
qout ([ == "-+++++++!$$--"+hb_osnewline()+"]+replicate("-",4-nLen)+[++!" ? -> "] + cStr +["])
qout ("")
qout ("Tests with tab characters:")
qout ([ tabexpand("-"+chr(9)+"-",,"+") == "-+++++++-" ? -> "] + tabexpand("-"+chr(9)+"-",,"+") + ["])
qout ([ tabexpand("-"+chr(9)+"-",,"+",,"-")])
qout ([ == "++++++++^I+++++++" ? -> "] + strtran(tabexpand("-"+chr(9)+"-",,"+",,"-"),chr(9),"^I")+ ["])
qout ("")
qout ("End test of TABEXPAND()")
qout ("Press any key to continue with tests of TABPACK()...")
qout ("")
inkey (0)
qout ("Begin test of TABPACK()")
qout ("")
// simple tests
qout ("Simple tests: ^I == tab character")
qout ([ tabpack("AAAAAAA*",, "*") == "AAAAAAA*" ? -> "] + strtran(tabpack("AAAAAAA*",, "*"),chr(9),"^I") + ["])
qout ([ tabpack("AAAAA***",, "*") == "AAAAA^I" ? -> "] + strtran(tabpack("AAAAA***",, "*"),chr(9),"^I") + ["])
qout ([ tabpack("AAAAA*****",, "*") == "AAAAA^I**" ? -> "] + strtran(tabpack("AAAAA*****",, "*"),chr(9),"^I")+ ["])
qout ("")
qout ("Tests with newline characters:")
cStr := hb_osnewline()
cStr := strtran (cStr, chr(10),"^J")
cStr := strtran (cStr, chr(13),"^M")
qout ([ hb_osnewline() = "] + cStr +["])
cStr := "ABCD+" + hb_osnewline() + "++---+++++"
cStr := tabpack (cStr, 4, "+")
cStr := strtran (cStr, chr(10),"^J")
cStr := strtran (cStr, chr(13),"^M")
cStr := strtran (cStr, chr(9),"^I")
qout ([ tabpack("ABCD+" + hb_osnewline() + "++---+++++", 4, "+")])
qout ([ == "ABCD+"+hb_osnewline()+"++---"+chr(9)+"++" ? -> "] + cStr +["])
qout ("End test of TABPACK()")
qout ("")
// qout ("Test with a MEMOEDITed string:")
// qout (" Now, a memoedit() will start. Please type a text, use tab characters")
// qout (" and make sure, you make use of soft and hard returns !")
// qout (" ...press any key to start the memoedit now...")
// qout ("")
// inkey (0)
// cls
// dispbox (0,0,20,60)
// cStr := memoedit (, 1, 1, 9, 59,,,59)
// cls
// qout (" Now printing the expanded text using a tab length of 4 and soft CRs")
// cStr1 := tabexpand (cStr,4,"+",,,.F.)
// cStr1 := strtran (cStr, chr(141), hb_osnewline())
//
// for ni := 1 to mlcount (cStr1, 59, 4, .T.)
// qout (" "+str(ni)+": "+memoline (cStr1, 59,ni,4,.T.))
// next ni
//
// qout (" Now printing the expanded text using a tab length of 4 but without soft CRs")
// cStr1 := tabexpand (cStr,4,"+",,,.T.)
//
// for ni := 1 to mlcount (cStr1, 59, 4, .T.)
// qout (" "+str(ni)+": "+memoline (cStr1, 59,ni,4,.T.))
// next ni
// inkey (0)
ctexit()
return