diff --git a/harbour/ChangeLog b/harbour/ChangeLog index f216716565..0ff75529bb 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,53 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-04-04 10:35 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/contrib/tip/Makefile + - harbour/contrib/tip/atokens.c + * removed HB_ATOKENS() + + - harbour/source/rtl/teditorl.c + - removed __STRTOKEN(), __STRTKPTR() + + * harbour/common.mak + * harbour/source/rtl/Makefile + * harbour/include/hbextern.ch + + harbour/source/rtl/hbtoken.c + + added set of functions to manipulate string tokens: + HB_TOKENCOUNT( , [ ], [ ], + [ ] ) -> + HB_TOKENGET( , , [ ], [ ], + [ ] ) -> + HB_TOKENPTR( , @, [ ], [ ], + [ ] ) -> + HB_ATOKENS( , [ ], [ ], + [ ] ) -> + All these functions use the same method of tokenization. They can + accept as delimiters string longer then one character. By default + they are using " " as delimiter. " " delimiter has special mening + Unlike other delimiters repeted ' ' characters does not create empty + tokens, f.e.: HB_ATOKENS( " 1 2 3 " ) returns array { "1", "2" } + Any other delimiters are restrictly counted, f.e. HB_ATOKENS( ",,1,,2,") + return array: { "", "", "1", "", "2", "" }. + + + added emulation for old __STRTOKEN(), __STRTKPTR() and xHarbour's + __STRTOKENCOUNT() by HB_TOKEN*() functions. They do not return + exactly the same result as __STRT*() functions which in some cases + ignored some delimiters and return wrong results. + + * harbour/source/rdd/Makefile + + harbour/source/rdd/dbsql.c + + added __DBSQL() function + + * harbour/include/hbsetup.h + * harbour/source/vm/fm.c + + added support for native Windows memory allocation functions + It can be enabled by HB_FM_WIN32_ALLOC macro and disable C-RTL + memory manager. + + * harbour/tests/mousetst.prg + * touch screen output before MPRESENT() to work with GTXWC + 2007-04-03 20:05 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/rdd/dbf1.c ! fixed OS code in error message diff --git a/harbour/common.mak b/harbour/common.mak index 5160a67ec8..828d1b4210 100644 --- a/harbour/common.mak +++ b/harbour/common.mak @@ -383,6 +383,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\hbinet.obj \ $(OBJ_DIR)\hbrandom.obj \ $(OBJ_DIR)\hbregex.obj \ + $(OBJ_DIR)\hbtoken.obj \ $(OBJ_DIR)\idle.obj \ $(OBJ_DIR)\inkey.obj \ $(OBJ_DIR)\is.obj \ @@ -445,7 +446,6 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\strzero.obj \ $(OBJ_DIR)\stuff.obj \ $(OBJ_DIR)\substr.obj \ - $(OBJ_DIR)\teditorl.obj \ $(OBJ_DIR)\tone.obj \ $(OBJ_DIR)\trace.obj \ $(OBJ_DIR)\transfrm.obj \ diff --git a/harbour/contrib/tip/Makefile b/harbour/contrib/tip/Makefile index cf70356049..07f9dd0ba9 100644 --- a/harbour/contrib/tip/Makefile +++ b/harbour/contrib/tip/Makefile @@ -5,7 +5,6 @@ ROOT = ../../ C_SOURCES = \ - atokens.c \ base64x.c \ encmthd.c \ hbhex2n.c \ diff --git a/harbour/contrib/tip/atokens.c b/harbour/contrib/tip/atokens.c deleted file mode 100644 index 6b705c3d19..0000000000 --- a/harbour/contrib/tip/atokens.c +++ /dev/null @@ -1,123 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * HB_ATOKENS() - * - * Copyright 2007 Przemyslaw Czerpak - * 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" -#include "hbapierr.h" - -HB_FUNC( HB_ATOKENS ) -{ - char * szLine = hb_parc( 1 ); - - if( szLine ) - { - ULONG ulLen = hb_parclen( 1 ), ulDelim = hb_parclen( 2 ), - ulTokens, ulStart, ul; - char * szDelim, cQuote = 0; - BOOL fSkipStrings = hb_parl( 3 ); - BOOL fDoubleQuoteOnly = hb_parl( 4 ); - PHB_ITEM pArray; - - if( ulDelim ) - szDelim = hb_parc( 2 ); - else - { - szDelim = " "; - ulDelim = 1; - } - - for( ul = ulStart = ulTokens = 0; ul < ulLen; ++ul ) - { - if( cQuote ) - { - if( szLine[ ul ] == cQuote ) - cQuote = 0; - } - else if( fSkipStrings && ( szLine[ ul ] == '"' || - ( !fDoubleQuoteOnly && szLine[ ul ] == '\'' ) ) ) - cQuote = szLine[ ul ]; - else if( szLine[ ul ] == szDelim[ 0 ] && - ( ulDelim == 1 || !memcmp( szLine + ul, szDelim, ulDelim ) ) ) - { - ++ulTokens; - ulStart = ul + 1; - } - } - if( !cQuote && ulStart < ulLen ) - ++ulTokens; - - pArray = hb_itemArrayNew( ulTokens ); - for( ul = ulStart = ulTokens = 0; ul < ulLen; ++ul ) - { - if( cQuote ) - { - if( szLine[ ul ] == cQuote ) - cQuote = 0; - } - else if( fSkipStrings && ( szLine[ ul ] == '"' || - ( !fDoubleQuoteOnly && szLine[ ul ] == '\'' ) ) ) - cQuote = szLine[ ul ]; - else if( szLine[ ul ] == szDelim[ 0 ] && - ( ulDelim == 1 || !memcmp( szLine + ul, szDelim, ulDelim ) ) ) - { - hb_itemPutCL( hb_arrayGetItemPtr( pArray, ++ulTokens ), szLine + ulStart, ul - ulStart ); - ulStart = ul + 1; - } - } - if( !cQuote && ulStart < ulLen ) - hb_itemPutCL( hb_arrayGetItemPtr( pArray, ++ulTokens ), szLine + ulStart, ulLen - ulStart ); - - hb_itemRelease( hb_itemReturn( pArray ) ); - } - else - hb_errRT_BASE_SubstR( EG_ARG, 1123, NULL, &hb_errFuncName, HB_ERR_ARGS_BASEPARAMS ); -} diff --git a/harbour/include/hbextern.ch b/harbour/include/hbextern.ch index d00ca7fe36..cb1cb0ef67 100644 --- a/harbour/include/hbextern.ch +++ b/harbour/include/hbextern.ch @@ -684,6 +684,11 @@ EXTERNAL HB_TRACELEVEL EXTERNAL HB_TRACESTATE EXTERNAL HB_VALTOSTR +EXTERNAL HB_TOKENCOUNT +EXTERNAL HB_TOKENGET +EXTERNAL HB_TOKENPTR +EXTERNAL HB_ATOKENS + EXTERNAL HB_HASH EXTERNAL HB_HHASKEY EXTERNAL HB_HPOS diff --git a/harbour/include/hbsetup.h b/harbour/include/hbsetup.h index e3f7ea2d2a..ad630d1e20 100644 --- a/harbour/include/hbsetup.h +++ b/harbour/include/hbsetup.h @@ -145,7 +145,7 @@ /* *********************************************************************** * Use native Windows memory allocation functions (HB_OS_WIN_32) - * This option can disabled compiler memory allocation optimization + * This option can disable compiler memory allocation optimization * so you should really have a good reason to enable it */ diff --git a/harbour/source/rdd/Makefile b/harbour/source/rdd/Makefile index 3aaaf3b41f..4c12d18f7a 100644 --- a/harbour/source/rdd/Makefile +++ b/harbour/source/rdd/Makefile @@ -9,8 +9,9 @@ C_SOURCES=\ workarea.c \ dbf1.c \ dbnubs.c \ - sdf1.c \ + dbsql.c \ delim1.c \ + sdf1.c \ hbdbsort.c \ PRG_SOURCES=\ diff --git a/harbour/source/rdd/dbsql.c b/harbour/source/rdd/dbsql.c new file mode 100644 index 0000000000..b70e00fd46 --- /dev/null +++ b/harbour/source/rdd/dbsql.c @@ -0,0 +1,412 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * + * + * Copyright 2007 Przemyslaw Czerpak + * Copyright 2007 Lorenzo Fiorini + * 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 "hbapifs.h" +#include "hbapigt.h" +#include "hbapiitm.h" +#include "hbapirdd.h" +#include "hbapilng.h" +#include "hbapierr.h" +#include "hbdbferr.h" +#include "hbvm.h" + +#define HB_FILE_BUF_SIZE 0x10000 +typedef struct _HB_FILEBUF +{ + FHANDLE hFile; + BYTE * pBuf; + ULONG ulSize; + ULONG ulPos; +} HB_FILEBUF; +typedef HB_FILEBUF * PHB_FILEBUF; + +static void hb_flushFBuffer( PHB_FILEBUF pFileBuf ) +{ + if( pFileBuf->ulPos > 0 ) + { + hb_fsWriteLarge( pFileBuf->hFile, pFileBuf->pBuf, pFileBuf->ulPos ); + pFileBuf->ulPos = 0; + } +} + +static void hb_addToFBuffer( PHB_FILEBUF pFileBuf, char ch ) +{ + if( pFileBuf->ulPos == pFileBuf->ulSize ) + hb_flushFBuffer( pFileBuf ); + pFileBuf->pBuf[ pFileBuf->ulPos++ ] = ( BYTE ) ch; +} + +static void hb_addStrnToFBuffer( PHB_FILEBUF pFileBuf, char * str, ULONG ulSize ) +{ + ULONG ulPos = 0; + while( ulPos < ulSize ) + { + if( pFileBuf->ulPos == pFileBuf->ulSize ) + hb_flushFBuffer( pFileBuf ); + pFileBuf->pBuf[ pFileBuf->ulPos++ ] = ( BYTE ) str[ ulPos++ ]; + } +} + +static void hb_addStrToFBuffer( PHB_FILEBUF pFileBuf, char * szStr ) +{ + while( *szStr ) + { + if( pFileBuf->ulPos == pFileBuf->ulSize ) + hb_flushFBuffer( pFileBuf ); + pFileBuf->pBuf[ pFileBuf->ulPos++ ] = ( BYTE ) *szStr++; + } +} + +static void hb_destroyFBuffer( PHB_FILEBUF pFileBuf ) +{ + hb_flushFBuffer( pFileBuf ); + if( pFileBuf->pBuf ) + hb_xfree( pFileBuf->pBuf ); + hb_xfree( pFileBuf ); +} + +static PHB_FILEBUF hb_createFBuffer( FHANDLE hFile, ULONG ulSize ) +{ + PHB_FILEBUF pFileBuf = ( PHB_FILEBUF )hb_xgrab( sizeof( HB_FILEBUF ) ); + + pFileBuf->hFile = hFile; + pFileBuf->pBuf = ( BYTE * )hb_xgrab( ulSize ); + pFileBuf->ulSize = ulSize; + pFileBuf->ulPos = 0; + return pFileBuf; +} + + +/* Export field value into the buffer in SQL format */ +static BOOL hb_exportBufSqlVar( PHB_FILEBUF pFileBuf, PHB_ITEM pValue, + char * szDelim, char * szEsc ) +{ + switch( hb_itemType( pValue ) ) + { + case HB_IT_STRING: + { + ULONG ulLen = hb_itemGetCLen( pValue ), ulCnt = 0; + char *szVal = hb_itemGetCPtr( pValue ); + + hb_addStrToFBuffer( pFileBuf, szDelim ); + while( ulLen && HB_ISSPACE( szVal[ ulLen - 1 ] ) ) + ulLen--; + + while( *szVal && ulCnt++ < ulLen ) + { + if( *szVal == *szDelim || *szVal == *szEsc ) + hb_addToFBuffer( pFileBuf, *szEsc ); + if( ( UCHAR ) *szVal >= 32 ) + hb_addToFBuffer( pFileBuf, *szVal ); + else + { + /* printf( "%d %c", *szVal, *szVal ); */ + } + szVal++; + } + hb_addStrToFBuffer( pFileBuf, szDelim ); + break; + } + + case HB_IT_DATE: + { + char szDate[9]; + + hb_addStrToFBuffer( pFileBuf, szDelim ); + hb_itemGetDS( pValue, szDate ); + if( szDate[0] == ' ' ) + { + hb_addStrToFBuffer( pFileBuf, "0100-01-01" ); + } + else + { + hb_addStrnToFBuffer( pFileBuf, &szDate[0], 4 ); + hb_addToFBuffer( pFileBuf, '-' ); + hb_addStrnToFBuffer( pFileBuf, &szDate[4], 2 ); + hb_addToFBuffer( pFileBuf, '-' ); + hb_addStrnToFBuffer( pFileBuf, &szDate[6], 2 ); + } + hb_addStrToFBuffer( pFileBuf, szDelim ); + break; + } + + case HB_IT_LOGICAL: + hb_addStrToFBuffer( pFileBuf, szDelim ); + hb_addToFBuffer( pFileBuf, hb_itemGetCPtr( pValue ) ? 'Y' : 'N' ); + hb_addStrToFBuffer( pFileBuf, szDelim ); + break; + + case HB_IT_INTEGER: + case HB_IT_LONG: + case HB_IT_DOUBLE: + { + char szResult[ HB_MAX_DOUBLE_LENGTH ]; + int iSize, iWidth, iDec; + + hb_itemGetNLen( pValue, &iWidth, &iDec ); + iSize = ( iDec > 0 ? iWidth + 1 + iDec : iWidth ); + if( hb_itemStrBuf( szResult, pValue, iSize, iDec ) ) + { + int iPos = 0; + while( iSize && HB_ISSPACE( szResult[ iPos ] ) ) + { + iPos++; + iSize--; + } + hb_addStrnToFBuffer( pFileBuf, &szResult[ iPos ], iSize ); + } + else + hb_addToFBuffer( pFileBuf, '0' ); + break; + } + /* an "M" field or the other, might be a "V" in SixDriver */ + default: + /* We do not want MEMO contents */ + return FALSE; + } + return TRUE; +} + +/* Export DBF content to a SQL script file */ +static ULONG hb_db2Sql( AREAP pArea, PHB_ITEM pFields, HB_LONG llNext, + PHB_ITEM pWhile, PHB_ITEM pFor, + char * szDelim, char * szSep, char * szEsc, + char * szTable, FHANDLE hFile, + BOOL fInsert, BOOL fRecno ) +{ + PHB_FILEBUF pFileBuf; + ULONG ulRecords = 0; + USHORT uiFields = 0, ui; + PHB_ITEM pTmp = hb_itemNew( NULL ); + BOOL fWriteSep = FALSE; + char * szNewLine = hb_conNewLine(); + char * szInsert = NULL; + BOOL fEof = TRUE; + BOOL fNoFieldPassed = ( pFields == NULL || hb_arrayLen( pFields ) == 0 ); + + if( fInsert && szTable ) + szInsert = hb_xstrcpy( NULL, "INSERT INTO ", szTable, " VALUES ( ", NULL ); + + pFileBuf = hb_createFBuffer( hFile, HB_FILE_BUF_SIZE ); + + if( SELF_FIELDCOUNT( pArea, &uiFields ) == FAILURE ) + return 0; + + while( llNext-- > 0 && + ( !pWhile || hb_itemGetL( hb_vmEvalBlock( pWhile ) ) ) ) + { + if( SELF_EOF( pArea, &fEof ) == FAILURE || fEof ) + break; + + /* if For is NULL, hb__Eval returns TRUE */ + if( !pFor || hb_itemGetL( hb_vmEvalBlock( pFor ) ) ) + { + ++ulRecords; + + if( szInsert ) + hb_addStrToFBuffer( pFileBuf, szInsert ); + + if( fRecno ) + { + ULONG ulRec = ulRecords; + char szRecno[ 13 ], * szVal; + + szVal = szRecno + sizeof( szRecno ); + *--szVal = 0; + do + { + *--szVal = ( char ) ( ulRec % 10 ) + '0'; + ulRec /= 10; + } + while( ulRec ); + hb_addStrToFBuffer( pFileBuf, szVal ); + hb_addStrToFBuffer( pFileBuf, szSep ); + } + + if( fNoFieldPassed ) + { + for( ui = 1; ui <= uiFields; ui ++ ) + { + SELF_GETVALUE( pArea, ui, pTmp ); + if( fWriteSep ) + hb_addStrToFBuffer( pFileBuf, szSep ); + fWriteSep = hb_exportBufSqlVar( pFileBuf, pTmp, szDelim, szEsc ); + } + } + else + { + /* TODO: exporting only some fields */ + } + + if( szInsert ) + hb_addStrToFBuffer( pFileBuf, " );" ); + hb_addStrToFBuffer( pFileBuf, szNewLine ); + fWriteSep = FALSE; + } + + SELF_SKIP( pArea, 1 ); + + if( ( llNext % 10000 ) == 0 ) + hb_inkeyPoll(); + } + + /* Writing EOF */ + /* hb_fsWriteLarge( hFile, (BYTE*) "\x1A", 1 ); */ + + if( szInsert ) + hb_xfree( szInsert ); + hb_destroyFBuffer( pFileBuf ); + hb_itemRelease( pTmp ); + + return ulRecords; +} + +HB_FUNC( __DBSQL ) +{ + AREAP pArea = ( AREAP ) hb_rddGetCurrentWorkAreaPointer(); + if( pArea ) + { + BOOL fExport = hb_parl( 1 ); + char * szFileName = hb_parc( 2 ); + char * szTable = hb_parc( 3 ); + PHB_ITEM pFields = hb_param( 4, HB_IT_ARRAY ); + PHB_ITEM pFor = hb_param( 5, HB_IT_BLOCK ); + PHB_ITEM pWhile = hb_param( 6, HB_IT_BLOCK ); + PHB_ITEM pNext = hb_param( 7, HB_IT_NUMERIC ); + PHB_ITEM pRecord = ISNIL( 8 ) ? NULL : hb_param( 8, HB_IT_ANY ); + BOOL fRest = pWhile != NULL || ( ISLOG( 9 ) && hb_parl( 9 ) ); + BOOL fAppend = ISLOG( 10 ) && hb_parl( 10 ); + BOOL fInsert = ISLOG( 11 ) && hb_parl( 11 ); + BOOL fRecno = ISLOG( 12 ) && hb_parl( 12 ); + char * szSep = hb_parcx( 13 ); + char * szDelim = hb_parcx( 14 ); + char * szEsc = hb_parcx( 15 ); + HB_LONG llNext = HB_LONG_MAX; + FHANDLE hFile; + + if( ! szFileName ) + hb_errRT_DBCMD( EG_ARG, EDBCMD_DBCMDBADPARAMETER, NULL, &hb_errFuncName ); + else if( fExport ) /* COPY TO SQL */ + { + PHB_ITEM pError = NULL; + BOOL fRetry; + + /* Try to create Dat file */ + do + { + hFile = hb_fsExtOpen( ( BYTE * ) szFileName, NULL, + ( fAppend ? 0 : FXO_TRUNCATE ) | + FO_READWRITE | FO_EXCLUSIVE | + FXO_DEFAULTS | FXO_SHARELOCK, + NULL, pError ); + if( hFile == F_ERROR ) + { + if( !pError ) + { + pError = hb_errNew(); + hb_errPutSeverity( pError, ES_ERROR ); + if( fAppend ) + { + hb_errPutGenCode( pError, EG_OPEN ); + hb_errPutSubCode( pError, EDBF_OPEN_DBF ); + hb_errPutDescription( pError, hb_langDGetErrorDesc( EG_OPEN ) ); + } + else + { + hb_errPutGenCode( pError, EG_CREATE ); + hb_errPutSubCode( pError, EDBF_CREATE_DBF ); + hb_errPutDescription( pError, hb_langDGetErrorDesc( EG_CREATE ) ); + } + hb_errPutFileName( pError, szFileName ); + hb_errPutFlags( pError, EF_CANRETRY | EF_CANDEFAULT ); + hb_errPutSubSystem( pError, "DBF2SQL" ); + } + hb_errPutOsCode( pError, hb_fsError() ); + fRetry = hb_errLaunch( pError ) == E_RETRY; + } + else + fRetry = FALSE; + } + while( fRetry ); + + if( pError ) + hb_itemRelease( pError ); + + if( hFile != F_ERROR ) + { + if( fAppend ) + hb_fsSeekLarge( hFile, 0, FS_END ); + + if( pRecord ) + SELF_GOTOID( pArea, pRecord ); + else if( pNext ) + llNext = hb_itemGetNInt( pNext ); + else if( !fRest ) + SELF_GOTOP( pArea ); + + hb_retnint( hb_db2Sql( pArea, pFields, llNext, pWhile, pFor, + szDelim, szSep, szEsc, + szTable, hFile, fInsert, fRecno ) ); + hb_fsClose( hFile ); + } + } + else + { + /* TODO: import code */ + } + } + else + hb_errRT_DBCMD( EG_NOTABLE, EDBCMD_NOTABLE, NULL, &hb_errFuncName ); +} diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index 14743a5951..4b6be8f8a5 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -56,6 +56,7 @@ C_SOURCES=\ hbinet.c \ hbrandom.c \ hbregex.c \ + hbtoken.c \ idle.c \ inkey.c \ is.c \ @@ -118,7 +119,6 @@ C_SOURCES=\ strzero.c \ stuff.c \ substr.c \ - teditorl.c \ tone.c \ trace.c \ transfrm.c \ diff --git a/harbour/source/rtl/hbtoken.c b/harbour/source/rtl/hbtoken.c new file mode 100644 index 0000000000..36351795a9 --- /dev/null +++ b/harbour/source/rtl/hbtoken.c @@ -0,0 +1,308 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * + * + * Copyright 2007 Przemyslaw Czerpak + * 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" +#include "hbapierr.h" + +static ULONG hb_tokenCount( char * szLine, ULONG ulLen, + char * szDelim, ULONG ulDelim, + BOOL fSkipStrings, BOOL fDoubleQuoteOnly ) +{ + ULONG ul = 0, ulTokens = 1; + char cQuote = 0; + + while( ul < ulLen ) + { + if( cQuote ) + { + if( szLine[ ul ] == cQuote ) + cQuote = 0; + } + else if( fSkipStrings && ( szLine[ ul ] == '"' || + ( !fDoubleQuoteOnly && szLine[ ul ] == '\'' ) ) ) + cQuote = szLine[ ul ]; + else if( szLine[ ul ] == szDelim[ 0 ] && + ( ulDelim == 1 || !memcmp( szLine + ul, szDelim, ulDelim ) ) ) + { + ++ulTokens; + if( ulDelim == 1 && *szDelim == ' ' ) + { + while( ++ul < ulLen && szLine[ ul ] == ' ' ); + } + } + ++ul; + } + + return ulTokens; +} + +static char * hb_tokenGet( char * szLine, ULONG ulLen, + char * szDelim, ULONG ulDelim, + BOOL fSkipStrings, BOOL fDoubleQuoteOnly, + ULONG ulToken, ULONG * pulLen ) +{ + ULONG ul, ulStart; + char cQuote = 0; + + for( ul = ulStart = 0; ul < ulLen; ++ul ) + { + if( cQuote ) + { + if( szLine[ ul ] == cQuote ) + cQuote = 0; + } + else if( fSkipStrings && ( szLine[ ul ] == '"' || + ( !fDoubleQuoteOnly && szLine[ ul ] == '\'' ) ) ) + cQuote = szLine[ ul ]; + else if( szLine[ ul ] == szDelim[ 0 ] && + ( ulDelim == 1 || !memcmp( szLine + ul, szDelim, ulDelim ) ) ) + { + if( --ulToken == 0 ) + { + * pulLen = ul - ulStart; + return szLine + ulStart; + } + if( ulDelim == 1 && *szDelim == ' ' ) + { + while( ul < ulLen && szLine[ ul + 1 ] == ' ' ) + ++ul; + } + ulStart = ul + 1; + } + } + if( --ulToken == 0 ) + { + * pulLen = ul - ulStart; + return szLine + ulStart; + } + * pulLen = 0; + return NULL; +} + +static PHB_ITEM hb_tokenArray( char * szLine, ULONG ulLen, + char * szDelim, ULONG ulDelim, + BOOL fSkipStrings, BOOL fDoubleQuoteOnly ) +{ + ULONG ulTokens = hb_tokenCount( szLine, ulLen, szDelim, ulDelim, + fSkipStrings, fDoubleQuoteOnly ); + PHB_ITEM pArray = hb_itemArrayNew( ulTokens ); + + if( ulTokens ) + { + ULONG ul, ulStart, ulToken; + char cQuote = 0; + + for( ul = ulStart = ulToken = 0; ul < ulLen; ++ul ) + { + if( cQuote ) + { + if( szLine[ ul ] == cQuote ) + cQuote = 0; + } + else if( fSkipStrings && ( szLine[ ul ] == '"' || + ( !fDoubleQuoteOnly && szLine[ ul ] == '\'' ) ) ) + cQuote = szLine[ ul ]; + else if( szLine[ ul ] == szDelim[ 0 ] && + ( ulDelim == 1 || !memcmp( szLine + ul, szDelim, ulDelim ) ) ) + { + hb_itemPutCL( hb_arrayGetItemPtr( pArray, ++ulToken ), szLine + ulStart, ul - ulStart ); + if( ulDelim == 1 && *szDelim == ' ' ) + { + while( ul < ulLen && szLine[ ul + 1 ] == ' ' ) + ++ul; + } + ulStart = ul + 1; + } + } + hb_itemPutCL( hb_arrayGetItemPtr( pArray, ++ulToken ), szLine + ulStart, ul - ulStart ); + } + + return pArray; +} + +static void hb_tokenParam( int iDelim, ULONG ulSkip, + char ** pszLine, ULONG * pulLen, + char ** pszDelim, ULONG * pulDelim ) +{ + char * szLine = hb_parc( 1 ), * szDelim = NULL; + ULONG ulLen = hb_parclen( 1 ), ulDelim = 0; + + if( ulLen ) + { + if( ulSkip ) + { + szLine += ulSkip; + if( ulLen <= ulSkip ) + ulLen = 0; + else + ulLen -= ulSkip; + } + + ulDelim = hb_parclen( iDelim ); + if( ulDelim ) + szDelim = hb_parc( iDelim ); + else + { + szDelim = " "; + ulDelim = 1; + } + + if( ulDelim == 1 && *szDelim == ' ' ) + { + while( ulLen && * szLine == ' ' ) + { + ++szLine; + --ulLen; + } + while( ulLen && szLine[ ulLen - 1 ] == ' ' ) + --ulLen; + } + } + + *pulLen = ulLen; + *pulDelim = ulDelim; + *pszLine = szLine; + *pszDelim = szDelim; +} + +HB_FUNC( HB_TOKENCOUNT ) +{ + char * szLine, * szDelim; + ULONG ulLen, ulDelim; + + hb_tokenParam( 2, 0, &szLine, &ulLen, &szDelim, &ulDelim ); + + if( szLine ) + hb_retnint( hb_tokenCount( szLine, ulLen, szDelim, ulDelim, + hb_parl( 3 ), hb_parl( 4 ) ) ); + else + hb_retni( 0 ); +} + +HB_FUNC( HB_TOKENGET ) +{ + char * szLine, * szDelim; + ULONG ulLen, ulDelim; + + hb_tokenParam( 3, 0, &szLine, &ulLen, &szDelim, &ulDelim ); + + if( szLine ) + { + szLine = hb_tokenGet( szLine, ulLen, szDelim, ulDelim, + hb_parl( 4 ), hb_parl( 5 ), + hb_parnl( 2 ), &ulLen ); + hb_retclen( szLine, ulLen ); + } + else + hb_retc( NULL ); +} + +/* like HB_TOKENGET() but returns next token starting from passed position + * (0 based) inside string, f.e.: + * HB_TOKENPTR( cString, @nTokPos, Chr( 9 ) ) -> cToken + */ +HB_FUNC( HB_TOKENPTR ) +{ + char * szLine, * szDelim, * szToken; + ULONG ulLen, ulDelim, ulSkip, ulToken; + + hb_tokenParam( 3, hb_parnl( 2 ), &szLine, &ulLen, &szDelim, &ulDelim ); + + if( szLine ) + { + szToken = hb_tokenGet( szLine, ulLen, szDelim, ulDelim, + hb_parl( 4 ), hb_parl( 5 ), + 1, &ulToken ); + if( szToken && ulLen > ulToken ) + ulSkip = szToken - hb_parc( 1 ) + ulToken + ulDelim; + else + ulSkip = hb_parclen( 1 ) + 1; + + /* return position to start next search from */ + hb_stornl( ulSkip, 2 ); + /* return token */ + hb_retclen( szToken, ulToken ); + } + else + hb_retc( NULL ); +} + +HB_FUNC( HB_ATOKENS ) +{ + char * szLine, * szDelim; + ULONG ulLen, ulDelim; + + hb_tokenParam( 2, 0, &szLine, &ulLen, &szDelim, &ulDelim ); + + if( szLine ) + hb_itemRelease( hb_itemReturnForward( + hb_tokenArray( szLine, ulLen, szDelim, ulDelim, + hb_parl( 3 ), hb_parl( 4 ) ) ) ); + else + hb_errRT_BASE_SubstR( EG_ARG, 1123, NULL, &hb_errFuncName, HB_ERR_ARGS_BASEPARAMS ); +} + +HB_FUNC( __STRTOKEN ) +{ + HB_FUNC_EXEC( HB_TOKENGET ); +} + +HB_FUNC( __STRTKPTR ) +{ + HB_FUNC_EXEC( HB_TOKENPTR ); +} + +HB_FUNC( __STRTOKENCOUNT ) +{ + HB_FUNC_EXEC( HB_TOKENCOUNT ); +} diff --git a/harbour/source/rtl/teditorl.c b/harbour/source/rtl/teditorl.c deleted file mode 100644 index 2baf654b22..0000000000 --- a/harbour/source/rtl/teditorl.c +++ /dev/null @@ -1,151 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * __STRTOKEN() helper routine for TEDITOR.PRG - * - * Copyright 1999 Antonio Linares - * Matthew Hamilton - * 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" - -static char * hb_strToken( char * szText, ULONG ulText, - ULONG ulIndex, - char cDelimiter, - ULONG * pulLen ) -{ - ULONG ulStart; - ULONG ulEnd = 0; - ULONG ulCounter = 0; - - HB_TRACE(HB_TR_DEBUG, ("hb_strToken(%s, %lu, %lu, %d, %p)", szText, ulText, ulIndex, (int) cDelimiter, pulLen)); - - do - { - ulStart = ulEnd; - - if( cDelimiter != ' ' ) - { - if( szText[ ulStart ] == cDelimiter ) - ulStart++; - } - else - { - while( ulStart < ulText && szText[ ulStart ] == cDelimiter ) - ulStart++; - } - - if( ulStart < ulText && szText[ ulStart ] != cDelimiter ) - { - ulEnd = ulStart + 1; - - while( ulEnd < ulText && szText[ ulEnd ] != cDelimiter ) - ulEnd++; - } - else - ulEnd = ulStart; - - } - while( ulCounter++ < ulIndex - 1 && ulEnd < ulText ); - - if( ulCounter < ulIndex ) - { - *pulLen = 0; - return ""; - } - else - { - *pulLen = ulEnd - ulStart; - return szText + ulStart; - } -} - -/* returns the nth occurence of a substring within a token-delimited string */ -HB_FUNC( __STRTOKEN ) -{ - char * pszText; - ULONG ulLen; - - pszText = hb_strToken( hb_parc( 1 ), hb_parclen( 1 ), - hb_parnl( 2 ), - ISCHAR( 3 ) ? *hb_parc( 3 ) : ' ', - &ulLen ); - - hb_retclen( pszText, ulLen ); -} - - -/* like __STRTOKEN() but returns next token starting from passed position - (0 based) inside string. - __StrTkPtr( cString, @nTokPos, Chr( 9 ) ) -*/ -HB_FUNC( __STRTKPTR ) -{ - char * pszString = hb_parc( 1 ); - ULONG ulStrLen = hb_parclen( 1 ); - ULONG ulLen; - ULONG ulPos = hb_parnl( 2 ); - char * pszText; - - /* move start of string past last returned token */ - pszString += ulPos; - - /* decrease length of string consequently */ - ulStrLen -= ulPos + 1; - - pszText = hb_strToken( pszString, ulStrLen, - 1, - ISCHAR( 3 ) ? *hb_parc( 3 ) : ' ', - &ulLen ); - - /* return position to start next search from */ - hb_stornl( pszText - pszString + ulPos + ulLen, 2 ); - - /* return token */ - hb_retclen( pszText, ulLen ); -} - diff --git a/harbour/source/vm/fm.c b/harbour/source/vm/fm.c index 4f6735cd65..43f60ad6b5 100644 --- a/harbour/source/vm/fm.c +++ b/harbour/source/vm/fm.c @@ -87,9 +87,19 @@ #include "hbmemory.ch" #include "hbdate.h" +/* #define HB_FM_WIN32_ALLOC */ /* #define HB_PARANOID_MEM_CHECK */ -/*#undef HB_FM_STATISTICS*/ +#ifndef HB_OS_WIN_32 +# undef HB_FM_WIN32_ALLOC +#endif + +#ifdef HB_FM_WIN32_ALLOC +# define malloc( n ) (void *) LocalAlloc( LMEM_FIXED, ( n ) ) +# define realloc( p, n ) (void *) LocalReAlloc( (HLOCAL) ( p ), ( n ), LMEM_MOVEABLE ) +# define free( p ) LocalFree( (HLOCAL) ( p ) ) +#endif + #ifndef HB_FM_STATISTICS # undef HB_PARANOID_MEM_CHECK #endif diff --git a/harbour/tests/mousetst.prg b/harbour/tests/mousetst.prg index d7cf2a3cda..3df8a8c55a 100644 --- a/harbour/tests/mousetst.prg +++ b/harbour/tests/mousetst.prg @@ -12,9 +12,8 @@ PROCEDURE main() LOCAL nR := 5, nC := 38 -SET CURSOR OFF - - CLS + SET CURSOR OFF + ? "."; CLS IF ! MPRESENT() ? " No mouse present !" QUIT