From e72214aecff159971324b996ccce7e7c93eb10eb Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Sun, 15 Jul 2007 07:20:25 +0000 Subject: [PATCH] 2007-07-15 09:20 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/contrib/libct/Makefile * harbour/contrib/libct/makefile.bc * harbour/contrib/libct/makefile.vc * harbour/contrib/libct/misc1.c + harbour/contrib/libct/misc2.c + harbour/contrib/libct/misc3.c * harbour/contrib/libct/num1.c * harbour/contrib/libct/numconv.prg + harbour/contrib/libct/numcount.c + harbour/contrib/libct/numline.c * harbour/contrib/libct/numat.c * synced with xHarbour modifications and fixes + added some missing functions borrowed from xHarbour, in most cases it was Pavel Tsarenko code ! some fixes * indenting * harbour/source/rtl/gtfunc.c * replaced hb_itemRelease( hb_itemReturn( pItem ) ) by hb_itemReturnRelease( pItem ) --- harbour/ChangeLog | 22 ++++ harbour/contrib/libct/Makefile | 4 + harbour/contrib/libct/makefile.bc | 20 ++++ harbour/contrib/libct/makefile.vc | 8 ++ harbour/contrib/libct/misc1.c | 54 +++------ harbour/contrib/libct/misc2.c | 103 ++++++++++++++++ harbour/contrib/libct/misc3.c | 90 ++++++++++++++ harbour/contrib/libct/num1.c | 127 +++++++++----------- harbour/contrib/libct/numat.c | 188 +++++++++++++----------------- harbour/contrib/libct/numconv.prg | 37 ++++-- harbour/contrib/libct/numcount.c | 71 +++++++++++ harbour/contrib/libct/numline.c | 92 +++++++++++++++ harbour/source/rtl/gtfunc.c | 2 +- 13 files changed, 589 insertions(+), 229 deletions(-) create mode 100644 harbour/contrib/libct/misc2.c create mode 100644 harbour/contrib/libct/misc3.c create mode 100644 harbour/contrib/libct/numcount.c create mode 100644 harbour/contrib/libct/numline.c diff --git a/harbour/ChangeLog b/harbour/ChangeLog index d6909ba37f..af9b290f5b 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,28 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-07-15 09:20 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/contrib/libct/Makefile + * harbour/contrib/libct/makefile.bc + * harbour/contrib/libct/makefile.vc + * harbour/contrib/libct/misc1.c + + harbour/contrib/libct/misc2.c + + harbour/contrib/libct/misc3.c + * harbour/contrib/libct/num1.c + * harbour/contrib/libct/numconv.prg + + harbour/contrib/libct/numcount.c + + harbour/contrib/libct/numline.c + * harbour/contrib/libct/numat.c + * synced with xHarbour modifications and fixes + + added some missing functions borrowed from xHarbour, in most + cases it was Pavel Tsarenko code + ! some fixes + * indenting + + * harbour/source/rtl/gtfunc.c + * replaced hb_itemRelease( hb_itemReturn( pItem ) ) by + hb_itemReturnRelease( pItem ) + 2007-07-14 22:55 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/rtl/gttrm/gttrm.c * added protection against corrupted by programmer screen buffer diff --git a/harbour/contrib/libct/Makefile b/harbour/contrib/libct/Makefile index 1b48a27340..ddbd85ca99 100644 --- a/harbour/contrib/libct/Makefile +++ b/harbour/contrib/libct/Makefile @@ -46,8 +46,12 @@ C_SOURCES = \ justify.c \ keyset.c \ misc1.c \ + misc2.c \ + misc3.c \ num1.c \ numat.c \ + numcount.c \ + numline.c \ pos1.c \ pos2.c \ posdiff.c \ diff --git a/harbour/contrib/libct/makefile.bc b/harbour/contrib/libct/makefile.bc index a2b23f6f69..6fc83c7ae6 100644 --- a/harbour/contrib/libct/makefile.bc +++ b/harbour/contrib/libct/makefile.bc @@ -130,8 +130,12 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\justify.obj \ $(OBJ_DIR)\keyset.obj \ $(OBJ_DIR)\misc1.obj \ + $(OBJ_DIR)\misc2.obj \ + $(OBJ_DIR)\misc3.obj \ $(OBJ_DIR)\num1.obj \ $(OBJ_DIR)\numat.obj \ + $(OBJ_DIR)\numcount.obj \ + $(OBJ_DIR)\numline.obj \ $(OBJ_DIR)\pos1.obj \ $(OBJ_DIR)\pos2.obj \ $(OBJ_DIR)\posdiff.obj \ @@ -333,6 +337,14 @@ $(OBJ_DIR)\misc1.obj : $(TOOLS_DIR)\misc1.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\misc2.obj : $(TOOLS_DIR)\misc2.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\misc3.obj : $(TOOLS_DIR)\misc3.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\num1.obj : $(TOOLS_DIR)\num1.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, @@ -341,6 +353,14 @@ $(OBJ_DIR)\numat.obj : $(TOOLS_DIR)\numat.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\numcount.obj : $(TOOLS_DIR)\numcount.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + +$(OBJ_DIR)\numline.obj : $(TOOLS_DIR)\numline.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\pos1.obj : $(TOOLS_DIR)\pos1.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(TOOLS_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/contrib/libct/makefile.vc b/harbour/contrib/libct/makefile.vc index f040402dec..0c5598c8da 100644 --- a/harbour/contrib/libct/makefile.vc +++ b/harbour/contrib/libct/makefile.vc @@ -147,8 +147,12 @@ TOOLS_LIB_OBJS = \ $(OBJ_DIR)\justify.obj \ $(OBJ_DIR)\keyset.obj \ $(OBJ_DIR)\misc1.obj \ + $(OBJ_DIR)\misc2.obj \ + $(OBJ_DIR)\misc3.obj \ $(OBJ_DIR)\num1.obj \ $(OBJ_DIR)\numat.obj \ + $(OBJ_DIR)\numcount.obj \ + $(OBJ_DIR)\numline.obj \ $(OBJ_DIR)\pos1.obj \ $(OBJ_DIR)\pos2.obj \ $(OBJ_DIR)\posdiff.obj \ @@ -218,8 +222,12 @@ CLEAN: -@if exist $(OBJ_DIR)\ftoc.* del $(OBJ_DIR)\ftoc.* -@if exist $(OBJ_DIR)\justify.* del $(OBJ_DIR)\justify.* -@if exist $(OBJ_DIR)\misc1.* del $(OBJ_DIR)\misc1.* + -@if exist $(OBJ_DIR)\misc2.* del $(OBJ_DIR)\misc2.* + -@if exist $(OBJ_DIR)\misc3.* del $(OBJ_DIR)\misc3.* -@if exist $(OBJ_DIR)\num1.* del $(OBJ_DIR)\num1.* -@if exist $(OBJ_DIR)\numat.* del $(OBJ_DIR)\numat.* + -@if exist $(OBJ_DIR)\numcount.* del $(OBJ_DIR)\numcount.* + -@if exist $(OBJ_DIR)\numline.* del $(OBJ_DIR)\numline.* -@if exist $(OBJ_DIR)\pos1.* del $(OBJ_DIR)\pos1.* -@if exist $(OBJ_DIR)\pos2.* del $(OBJ_DIR)\pos2.* -@if exist $(OBJ_DIR)\posdiff.* del $(OBJ_DIR)\posdiff.* diff --git a/harbour/contrib/libct/misc1.c b/harbour/contrib/libct/misc1.c index 76a4b9fc56..6253ef8769 100644 --- a/harbour/contrib/libct/misc1.c +++ b/harbour/contrib/libct/misc1.c @@ -50,7 +50,6 @@ * */ - #include "ct.h" @@ -103,44 +102,23 @@ HB_FUNC( XTOC ) { - union + union { double value; - char string[ sizeof( double )]; - } xConvert; - char pcString[ sizeof( double ) ]; + char string[sizeof( double )]; + } xConvert; - 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 ); - } - - + if( ISCHAR( 1 ) ) + hb_retc( hb_parc( 1 ) ); + else if( ISDATE( 1 ) ) + hb_retc( hb_pards( 1 ) ); + else if( ISNUM( 1 ) ) + { + xConvert.value = hb_parnd( 1 ); + hb_retclen( xConvert.string, sizeof( double ) ); + } + else if( ISLOG( 1 ) ) + hb_retclen( hb_parl( 1 ) ? "T" : "F", 1 ); + else + hb_retc( NULL ); } - diff --git a/harbour/contrib/libct/misc2.c b/harbour/contrib/libct/misc2.c new file mode 100644 index 0000000000..a3158a59f2 --- /dev/null +++ b/harbour/contrib/libct/misc2.c @@ -0,0 +1,103 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 Miscellaneous functions: - COMPLEMENT(), NUL() + * + * Copyright 2005 Pavel Tsarenko + * 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 "hbapi.h" +#include "hbapiitm.h" + +HB_FUNC( COMPLEMENT ) +{ + PHB_ITEM pItem = hb_param( 1, HB_IT_ANY ); + + if( pItem ) + { + if( HB_IS_STRING( pItem ) ) + { + ULONG ulLen = hb_itemGetCLen( pItem ), ulPos; + + if( ulLen > 0 ) + { + char *szBuffer = ( char * ) hb_xgrab( ulLen + 1 ), *szSrc = hb_itemGetCPtr( pItem ); + + for( ulPos = 0; ulPos < ulLen; ulPos++ ) + szBuffer[ulPos] = ~szSrc[ulPos]; + hb_retclen_buffer( szBuffer, ulLen ); + } + else + hb_retc( NULL ); + } + else if( HB_IS_DATE( pItem ) ) + hb_retdl( 4537847 - hb_itemGetDL( pItem ) ); + else if( HB_IS_NUMINT( pItem ) ) + hb_retnint( -hb_itemGetNInt( pItem ) ); + else if( HB_IS_NUMERIC( pItem ) ) + { + int iWidth, iDec; + double dValue; + + dValue = hb_itemGetND( pItem ); + hb_itemGetNLen( pItem, &iWidth, &iDec ); + hb_retndlen( -dValue, iWidth, iDec ); + } + else if( HB_IS_LOGICAL( pItem ) ) + hb_retl( !hb_itemGetL( pItem ) ); + else + hb_ret(); + } + else + hb_ret(); +} + + +HB_FUNC( NUL ) +{ + hb_retc( NULL ); +} diff --git a/harbour/contrib/libct/misc3.c b/harbour/contrib/libct/misc3.c new file mode 100644 index 0000000000..8d87d36282 --- /dev/null +++ b/harbour/contrib/libct/misc3.c @@ -0,0 +1,90 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * CT3 Miscellaneous functions: - KBDSTAT() + * + * Copyright 2005 Pavel Tsarenko + * 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 "hbapi.h" +#include "hbapigt.h" +#include "hbapiitm.h" +#include "hbset.h" + +HB_FUNC( KBDSTAT ) +{ + int iRet = 0; + HB_GT_INFO gtInfo; + + gtInfo.pNewVal = NULL; + gtInfo.pResult = NULL; + + hb_gtInfo( GTI_KBDSHIFTS, >Info ); + + if( gtInfo.pResult ) + { + int iState = hb_itemGetNI( gtInfo.pResult ); + + hb_itemRelease( gtInfo.pResult ); + if( iState & GTI_KBD_SHIFT ) + iRet |= 0x01; + if( iState & GTI_KBD_CTRL ) + iRet |= 0x04; + if( iState & GTI_KBD_ALT ) + iRet |= 0x08; + if( iState & GTI_KBD_SCROLOCK ) + iRet |= 0x10; + if( iState & GTI_KBD_NUMLOCK ) + iRet |= 0x20; + if( iState & GTI_KBD_CAPSLOCK ) + iRet |= 0x40; + if( hb_set.HB_SET_INSERT ) + iRet |= 0x80; + } + + hb_retni( iRet ); +} diff --git a/harbour/contrib/libct/num1.c b/harbour/contrib/libct/num1.c index 604df48f9f..eacd19f492 100644 --- a/harbour/contrib/libct/num1.c +++ b/harbour/contrib/libct/num1.c @@ -61,7 +61,7 @@ * */ - + #include "ct.h" @@ -104,36 +104,31 @@ HB_FUNC( CELSIUS ) { - if( ISNUM(1) ) - { - double dInput = hb_parnd(1); - double dResult; - - dResult = (5.0 / 9.0) * ( dInput - 32.0 ); - hb_retnd( dResult ); - } - else - { - PHB_ITEM pSubst = NULL; - int iArgErrorMode = ct_getargerrormode(); - if (iArgErrorMode != CT_ARGERR_IGNORE) - { - pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_CELSIUS, - NULL, "CELSIUS", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); - } - - if (pSubst != NULL) - { - hb_itemReturn (pSubst); - hb_itemRelease (pSubst); - } - else - { - hb_retnd (0.0); - } - } + if( ISNUM( 1 ) ) + { + double dInput = hb_parnd( 1 ); + double dResult; - return; + dResult = ( 5.0 / 9.0 ) * ( dInput - 32.0 ); + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + + if( iArgErrorMode != CT_ARGERR_IGNORE ) + { + pSubst = ct_error_subst( ( USHORT ) iArgErrorMode, EG_ARG, + CT_ERROR_CELSIUS, NULL, "CELSIUS", 0, + EF_CANSUBSTITUTE, HB_ERR_ARGS_BASEPARAMS ); + } + + if( pSubst != NULL ) + hb_itemReturnRelease( pSubst ); + else + hb_retnd( 0.0 ); + } } @@ -176,39 +171,34 @@ HB_FUNC( CELSIUS ) HB_FUNC( FAHRENHEIT ) { - if( ISNUM(1) ) - { - double dInput = hb_parnd(1); - double dResult; + if( ISNUM( 1 ) ) + { + double dInput = hb_parnd( 1 ); + double dResult; - dResult = (( 9.0 / 5.0) * dInput ) + 32.0 ; - hb_retnd( dResult ); - } - else - { - PHB_ITEM pSubst = NULL; - int iArgErrorMode = ct_getargerrormode(); - if (iArgErrorMode != CT_ARGERR_IGNORE) - { - pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_FAHRENHEIT, - NULL, "FAHRENHEIT", 0, EF_CANSUBSTITUTE, 1, hb_paramError (1)); - } - - if (pSubst != NULL) - { - hb_itemReturn (pSubst); - hb_itemRelease (pSubst); - } - else - { - hb_retnd (0.0); - } - } + dResult = ( ( 9.0 / 5.0 ) * dInput ) + 32.0; + hb_retnd( dResult ); + } + else + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); - return; + if( iArgErrorMode != CT_ARGERR_IGNORE ) + { + pSubst = ct_error_subst( ( USHORT ) iArgErrorMode, EG_ARG, + CT_ERROR_FAHRENHEIT, NULL, "FAHRENHEIT", 0, + EF_CANSUBSTITUTE, HB_ERR_ARGS_BASEPARAMS ); + } + + if( pSubst != NULL ) + hb_itemReturnRelease( pSubst ); + else + hb_retnd( 0.0 ); + } } - + /* $DOC$ * $FUNCNAME$ * INFINITY() @@ -244,19 +234,10 @@ HB_FUNC( FAHRENHEIT ) * $END$ */ -HB_FUNC( INFINITY ) +HB_FUNC( INFINITY ) { - - if (ISLOG (1) && hb_parl(1)) - { - hb_retnd (DBL_MAX); - } - else - { - hb_retnd (93786976294838206460.00); - } - return; - + if( ISLOG( 1 ) && hb_parl( 1 ) ) + hb_retnd( DBL_MAX ); + else + hb_retnd( 93786976294838206460.00 ); } - - diff --git a/harbour/contrib/libct/numat.c b/harbour/contrib/libct/numat.c index 502da83c44..89f93b094f 100644 --- a/harbour/contrib/libct/numat.c +++ b/harbour/contrib/libct/numat.c @@ -52,7 +52,6 @@ * */ - #include "ct.h" @@ -84,116 +83,93 @@ * $END$ */ -HB_FUNC(NUMAT) +HB_FUNC( NUMAT ) { + if( ( ISCHAR( 1 ) ) && ( ISCHAR( 2 ) ) ) + { + char *pcStringToMatch = ( char * ) hb_parc( 1 ); + size_t sStrToMatchLen = ( size_t ) hb_parclen( 1 ); + char *pcString = ( char * ) hb_parc( 2 ); + size_t sStrLen = ( size_t ) hb_parclen( 2 ); + int iMultiPass = ct_getatmupa(); + int iAtLike = ct_getatlike(); + char cAtLike = ct_getatlikechar(); + size_t sIgnore, sMatchStrLen, sSubStrLen; + ULONG ulCounter; + char *pc, *pcSubStr; - if ((ISCHAR (1)) && (ISCHAR (2))) - { - - char *pcStringToMatch = (char *)hb_parc (1); - size_t sStrToMatchLen = (size_t)hb_parclen (1); - char *pcString = (char *)hb_parc (2); - size_t sStrLen = (size_t)hb_parclen (2); - int iMultiPass = ct_getatmupa(); - int iAtLike = ct_getatlike(); - char cAtLike = ct_getatlikechar(); - size_t sIgnore, sMatchStrLen, sSubStrLen; - ULONG ulCounter; - char *pc, *pcSubStr; - - /* eventually ignore some characters */ - if (ISNUM (3)) - sIgnore = (size_t)hb_parnl (3); - else - sIgnore = 0; - - if (sIgnore >= sStrLen) - { - int iArgErrorMode = ct_getargerrormode(); - if (iArgErrorMode != CT_ARGERR_IGNORE) - { - ct_error ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_NUMAT, - NULL, "NUMAT", 0, EF_CANDEFAULT, 3, - hb_paramError (1), hb_paramError (2), - hb_paramError (3)); - } - hb_retnl (0); - return; - } - else - { - pcString += sIgnore; - sStrLen -= sIgnore; - } - - ulCounter = 0; - pcSubStr = pcString; - sSubStrLen = sStrLen; - - do - { - - switch (iAtLike) - { - case CT_SETATLIKE_EXACT: - { - pc = ct_at_exact_forward (pcSubStr, sSubStrLen, - pcStringToMatch, sStrToMatchLen, - &sMatchStrLen); - }; break; - - case CT_SETATLIKE_WILDCARD: - { - pc = ct_at_wildcard_forward (pcSubStr, sSubStrLen, - pcStringToMatch, sStrToMatchLen, - cAtLike, &sMatchStrLen); - }; break; - - default: - { - pc = NULL; - }; - } - - ulCounter++; - - if (iMultiPass) - pcSubStr = pc+1; + /* eventually ignore some characters */ + if( ISNUM( 3 ) ) + sIgnore = ( size_t ) hb_parnl( 3 ); else - pcSubStr = pc+sMatchStrLen; - sSubStrLen = sStrLen-(pcSubStr-pcString); - - } while (pc != NULL); + sIgnore = 0; - hb_retnl (ulCounter-1); + if( sIgnore >= sStrLen ) + { + int iArgErrorMode = ct_getargerrormode(); - } - else /* ((ISCHAR (1)) && (ISCHAR (2))) */ - { - PHB_ITEM pSubst = NULL; - int iArgErrorMode = ct_getargerrormode(); - if (iArgErrorMode != CT_ARGERR_IGNORE) - { - pSubst = ct_error_subst ((USHORT)iArgErrorMode, EG_ARG, CT_ERROR_NUMAT, - NULL, "NUMAT", 0, EF_CANSUBSTITUTE, 3, - hb_paramError (1), hb_paramError (2), - hb_paramError (3)); - } - - if (pSubst != NULL) - { - hb_itemReturn (pSubst); - hb_itemRelease (pSubst); - } - else - { - hb_retnl (0); - } - return; - } + if( iArgErrorMode != CT_ARGERR_IGNORE ) + { + ct_error( ( USHORT ) iArgErrorMode, EG_ARG, CT_ERROR_NUMAT, NULL, + "NUMAT", 0, EF_CANDEFAULT, HB_ERR_ARGS_BASEPARAMS ); + } + hb_retni( 0 ); + return; + } + else + { + pcString += sIgnore; + sStrLen -= sIgnore; + } - return; + ulCounter = 0; + pcSubStr = pcString; + sSubStrLen = sStrLen; + do + { + switch ( iAtLike ) + { + case CT_SETATLIKE_EXACT: + pc = ct_at_exact_forward( pcSubStr, sSubStrLen, pcStringToMatch, + sStrToMatchLen, &sMatchStrLen ); + break; + + case CT_SETATLIKE_WILDCARD: + pc = ct_at_wildcard_forward( pcSubStr, sSubStrLen, + pcStringToMatch, sStrToMatchLen, + cAtLike, &sMatchStrLen ); + break; + + default: + pc = NULL; + } + ulCounter++; + if( iMultiPass ) + pcSubStr = pc + 1; + else + pcSubStr = pc + sMatchStrLen; + sSubStrLen = sStrLen - ( pcSubStr - pcString ); + } + while( pc != NULL ); + + hb_retnl( ulCounter - 1 ); + } + else /* ( ISCHAR( 1 ) && ISCHAR( 2 ) ) */ + { + PHB_ITEM pSubst = NULL; + int iArgErrorMode = ct_getargerrormode(); + + if( iArgErrorMode != CT_ARGERR_IGNORE ) + { + pSubst = ct_error_subst( ( USHORT ) iArgErrorMode, EG_ARG, + CT_ERROR_NUMAT, NULL, "NUMAT", 0, + EF_CANSUBSTITUTE, HB_ERR_ARGS_BASEPARAMS ); + } + + if( pSubst != NULL ) + hb_itemReturnRelease( pSubst ); + else + hb_retni( 0 ); + } } - - diff --git a/harbour/contrib/libct/numconv.prg b/harbour/contrib/libct/numconv.prg index 06aaca0a34..fb9e24e71f 100644 --- a/harbour/contrib/libct/numconv.prg +++ b/harbour/contrib/libct/numconv.prg @@ -85,22 +85,28 @@ FUNCTION NTOC( xNum, nBase, nLenght, cPad ) LOCAL cNum -Default cPad to "0" +Default cPad to " " Default nBase to 10 IF VALTYPE( xNum ) == "C" - xNum = ALLTRIM( xNum ) - xNum = UPPER( xNum ) + xNum = UPPER( ALLTRIM( xNum ) ) xNum = CTON( xNum, 16 ) ENDIF IF nBase > 36 .OR. nBase < 2 RETURN "" ENDIF +if xNum < 0 + xNum += 4294967296 +endif cNum = B10TOBN( xNum, @nBase ) -IF ISNUMBER( nLenght ) .AND. ISCHARACTER( cPad ) .AND. LEN( cNum ) < nLenght - cNum = REPLICATE( cPad, nLenght - LEN( cNum ) ) + cNum +IF ISNUMBER( nLenght ) + IF LEN(cNum) > nLenght + cNum = REPLICATE( "*", nLenght ) + ELSEIF ISCHARACTER( cPad ) .AND. LEN( cNum ) < nLenght + cNum = REPLICATE( cPad, nLenght - LEN( cNum ) ) + cNum + ENDIF ENDIF RETURN cNum @@ -133,22 +139,27 @@ RETURN cNum */ FUNCTION CTON( xNum, nBase, lMode ) -LOCAL i, nNum:=0 +LOCAL i, nNum := 0, nPos Default lMode TO .F. Default nBase TO 10 -xNum = ALLTRIM(xNum) +IF ISCHARACTER(xNum) .and. nBase >= 2 .and. nBase <= 36 -IF nBase >= 2 .AND. nBase <= 36 + xNum := UPPER( ALLTRIM( xNum) ) FOR i=1 TO LEN( xNum ) - nNum += (nBase ** (i-1)) * ( AT( SUBSTR( xNum, -i, 1 ), WORLD ) - 1 ) + nPos := AT( SUBSTR( xNum, i, 1 ), WORLD ) + IF nPos == 0 .or. nPos > nBase + EXIT + ELSE + nNum := nNum * nBase + ( nPos - 1 ) + ENDIF NEXT IF lMode IF nNum > 32767 - nNum = nNum - 65536 + nNum := nNum - 65536 ENDIF ENDIF @@ -158,11 +169,15 @@ RETURN nNum STATIC FUNCTION B10TOBN( nNum, nBase ) +LOCAL nInt IF nNum > 0 - RETURN B10TOBN( INT( nNum / nBase), @nBase ) +; + nInt := INT( nNum / nBase) + RETURN IIF(nInt==0, "", B10TOBN( nInt, @nBase )) +; SUBSTR( WORLD, ( nNum % nBase ) + 1, 1 ) +ELSEIF nNum == 0 + RETURN "0" ENDIF RETURN "" diff --git a/harbour/contrib/libct/numcount.c b/harbour/contrib/libct/numcount.c new file mode 100644 index 0000000000..09aa1f7b5b --- /dev/null +++ b/harbour/contrib/libct/numcount.c @@ -0,0 +1,71 @@ +/* + * $Id: numcount.c,v 1.1 2004/11/29 22:11:31 ptsarenko Exp $ + */ + +/* + * xHarbour Project source code: + * CT3 numeric functions + * + * NUMCOUNT() + * Copyright 2004 Pavel Tsarenko + * www - http://www.xharbour.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 "hbapi.h" + +static LONG s_lCounter = 0; + +HB_FUNC( NUMCOUNT ) +{ + BOOL bMode = ISLOG( 2 ) && hb_parl( 2 ); + + if( ISNUM( 1 ) ) + { + if( bMode ) + s_lCounter = hb_parnl( 1 ); + else + s_lCounter += hb_parnl( 1 ); + } + + hb_retnl( s_lCounter ); +} diff --git a/harbour/contrib/libct/numline.c b/harbour/contrib/libct/numline.c new file mode 100644 index 0000000000..fa7a4b8fe2 --- /dev/null +++ b/harbour/contrib/libct/numline.c @@ -0,0 +1,92 @@ +/* + * $Id: numline.c,v 1.1 2004/11/29 22:11:31 ptsarenko Exp $ + */ + +/* + * xHarbour Project source code: + * CT3 numeric functions + * + * NUMLINE() + * Copyright 2004 Pavel Tsarenko + * www - http://www.xharbour.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 "hbapi.h" + +HB_FUNC( NUMLINE ) +{ + LONG lLines = 0; + + if( ISCHAR( 1 ) ) + { + char *pcString = hb_parc( 1 ); + char *pBuffer; + LONG lStrLen = hb_parclen( 1 ); + LONG lLength = ISNUM( 2 ) ? hb_parnl( 2 ) : 80; + + while( lStrLen > 0 ) + { + pBuffer = ( char * ) memchr( pcString, 13, lStrLen ); + if( !pBuffer ) + { + pBuffer = pcString + lStrLen; + } + + if( ( pBuffer - pcString ) > lLength ) + { + pBuffer = pcString + lLength; + } + else + { + pBuffer++; + if( *pBuffer == 10 ) + pBuffer++; + } + lStrLen -= pBuffer - pcString; + pcString = pBuffer; + lLines++; + } + } + + hb_retnl( lLines ); +} diff --git a/harbour/source/rtl/gtfunc.c b/harbour/source/rtl/gtfunc.c index 6a12d13a08..70c8022964 100644 --- a/harbour/source/rtl/gtfunc.c +++ b/harbour/source/rtl/gtfunc.c @@ -113,7 +113,7 @@ HB_FUNC( HB_GTINFO ) hb_gtInfo( hb_parni( 1 ), >Info ); if( gtInfo.pResult ) - hb_itemRelease( hb_itemReturn( gtInfo.pResult ) ); + hb_itemReturnRelease( gtInfo.pResult ); else hb_ret(); }