diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 8b803e0f6e..ca39f4e0ba 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,14 @@ +2001-02-24 19:45 UTC-0800 Ron Pinkas + * contrib/dot/pp.prg + + Added CompileNestedBlocks() #ifdef __CLIPPER__, because Clipper's Macro Compiler can *not* compile nested blocks. + + /* Clipper macro compiler can't compile literal blocks which contain nested blocks. This is needed by #commands like: + INDEX ON ... TO ... + Now PP will pre-compile such nested blocks. This makes PP fully functional when compiled with Clipper too :-) */ + + * harbour/source/rdd/dbfcdx1.c + ! Moved few declarations above the HB_TRACE() lien, to fix compilation errors. + 2001-02-24 18:10 UTC+0300 Alex Shashkov * harbour/source/rtl/console.c ! Fixed bug STDOUT(..,"",..) on Watcom C 11.0 diff --git a/harbour/contrib/dot/pp.prg b/harbour/contrib/dot/pp.prg index a76567d85c..d1b69a6a46 100644 --- a/harbour/contrib/dot/pp.prg +++ b/harbour/contrib/dot/pp.prg @@ -28,8 +28,12 @@ #INCLUDE "hbextern.ch" #DEFINE CRLF HB_OsNewLine() #else + #DEFINE __CLIPPER__ + #DEFINE CRLF Chr(13) + Chr(10) + STATIC s_abBlocks := {}, nBlockId := 0 + EXTERNAL BROWSE EXTERNAL ARRAY,ASIZE,ATAIL,AINS,ADEL,AFILL,ASCAN,AEVAL,ACOPY,ACLONE,ADIR, ASORT @@ -321,7 +325,27 @@ PROCEDURE ExecuteLine( sPPed ) sSymbol = "__SETDOCASE" .OR. sSymbol = "__SETCASE" .OR. sSymbol = "__SETOTHERWISE" .OR. sSymbol = "__SETENDCASE" .OR. ; abIf[ nIf ] + #ifdef __CLIPPER__ + /* Clipper Macro Compiler can't ompile nested blocks! */ + CompileNestedBlocks( sBlock, @sBlock ) + #endif + + IF ! bRun + @ 0,0 SAY "PP: " + @ 0,4 SAY Pad( sBlock, 76 ) COLOR "N/R" + ENDIF + DevPos( nRow, nCol ) + Eval( &( "{|| " + sBlock + " }" ) ) + nRow := Row() + nCol := Col() + + #ifdef __CLIPPER__ + IF ! bRun + nBlockID := 0 + aSize( s_abBlocks, 0 ) + ENDIF + #endif ENDIF sTemp := RTrim( SubStr( sTemp, nNext + 1 ) ) @@ -360,7 +384,26 @@ PROCEDURE ExecuteLine( sPPed ) sSymbol = "__SETIF" .OR. sSymbol = "__SETELSE" .OR. sSymbol = "__SETELSEIF" .OR. sSymbol = "__SETEND" .OR. ; sSymbol = "__SETDOCASE" .OR. sSymbol = "__SETCASE" .OR. sSymbol = "__SETOTHERWISE" .OR. sSymbol = "__SETENDCASE" .OR. ; abIf[ nIf ] - Eval( &( "{|| " + sTemp + " }" ) ) + + #ifdef __CLIPPER__ + /* Clipper Macro Compiler can't ompile nested blocks! */ + CompileNestedBlocks( sBlock, @sBlock ) + #endif + + IF ! bRun + @ 0,0 SAY "PP: " + @ 0,4 SAY Pad( sBlock, 76 ) COLOR "N/R" + ENDIF + DevPos( nRow, nCol ) + + Eval( &( "{|| " + sBlock + " }" ) ) + + #ifdef __CLIPPER__ + IF ! bRun + nBlockID := 0 + aSize( s_abBlocks, 0 ) + ENDIF + #endif ENDIF ENDIF @@ -497,6 +540,105 @@ FUNCTION __SetEndCase() RETURN nIf +//--------------------------------------------------------------// + +#ifdef __CLIPPER__ + + //--------------------------------------------------------------// + + FUNCTION CompileNestedBlocks( sTemp, sMain ) + + LOCAL asBlocks, nBlocks, Counter, aReplace + + asBlocks := asBlocks(sTemp ) + nBlocks := Len( asBlocks ) + + FOR Counter := 1 TO nBlocks + aReplace := CompileNestedBlocks( SubStr( asBlocks[Counter], 2 ), @sMain ) + NEXT + + IF ProcName(1) == ProcName(0) // .AND. nBlocks == 0 + IF aReplace != NIL + sTemp := StrTran( sTemp, aReplace[1], aReplace[2] ) + ELSE + aReplace := Array(2) + ENDIF + + aReplace[1] := '{' + sTemp + aReplace[2] := "PP_Block(" + LTrim( Str( ++nBlockId, 3, 0 ) ) + ')' + aAdd( s_abBlocks, &( aReplace[1]) ) + + sMain := StrTran( sMain, aReplace[1], aReplace[2] ) + + RETURN aReplace + ENDIF + + RETURN NIL + + //--------------------------------------------------------------// + + FUNCTION asBlocks( sBlock, asBlocks ) + + LOCAL nStart, nEnd, nPosition, sNested, nOpen, lBlock := .F. + + IF asBlocks == NIL + asBlocks := {} + ENDIF + + nStart := At( '{', sBlock ) + IF nStart > 0 + nEnd := Len( sBlock ) + FOR nPosition := nStart + 1 TO nEnd + IF SubStr( sBlock, nPosition, 1 ) != ' ' + EXIT + ENDIF + NEXT + IF SubStr( sBlock, nPosition, 1 ) == '|' + lBlock := .T. + ENDIF + + nOpen := 1 + DO WHILE nOpen > 0 .AND. nPosition <= nEnd + IF SubStr( sBlock, nPosition, 1 ) == '"' + DO WHILE nPosition <= nEnd + nPosition++ + IF SubStr( sBlock, nPosition, 1 ) == '"' + EXIT + ENDIF + ENDDO + ELSEIF SubStr( sBlock, nPosition, 1 ) == "'" + DO WHILE nPosition <= nEnd + nPosition++ + IF SubStr( sBlock, nPosition, 1 ) == "'" + EXIT + ENDIF + ENDDO + ELSEIF SubStr( sBlock, nPosition, 1 ) == '{' + nOpen++ + ELSEIF SubStr( sBlock, nPosition, 1 ) == '}' + nOpen-- + ENDIF + nPosition++ + ENDDO + ENDIF + + IF lBlock + sNested := SubStr( sBlock, nStart, ( nPosition - nStart ) ) + aAdd( asBlocks, sNested ) + asBlocks( SubStr( sBlock, nPosition + 1 ), asBlocks ) + ENDIF + + RETURN asBlocks + + //--------------------------------------------------------------// + + FUNCTION PP_Block( nId ) + + RETURN s_abBlocks[nId] + + //--------------------------------------------------------------// +#endif + //------------------------------- *** END - RP DOT Functions *** -------------------------------// FUNCTION ProcessFile( sSource, sSwitch ) diff --git a/harbour/source/rdd/dbfcdx/dbfcdx1.c b/harbour/source/rdd/dbfcdx/dbfcdx1.c index d7b391ce89..a055280c6b 100644 --- a/harbour/source/rdd/dbfcdx/dbfcdx1.c +++ b/harbour/source/rdd/dbfcdx/dbfcdx1.c @@ -890,8 +890,8 @@ ERRCODE hb_cdxOrderInfo( CDXAREAP pArea, USHORT uiIndex, LPDBORDERINFO pOrderInf { pTag = pTag->pNext; --uiTag; - } - } + } + } } if ( pTag ) pOrderInfo->itmResult = hb_itemPutC( pOrderInfo->itmResult, pTag->KeyExpr ); @@ -914,8 +914,8 @@ ERRCODE hb_cdxOrderInfo( CDXAREAP pArea, USHORT uiIndex, LPDBORDERINFO pOrderInf { pTag = pTag->pNext; --uiTag; - } - } + } + } } if ( pTag ) pOrderInfo->itmResult = hb_itemPutL( pOrderInfo->itmResult, pTag->UniqueKey ); @@ -939,8 +939,8 @@ ERRCODE hb_cdxOrderInfo( CDXAREAP pArea, USHORT uiIndex, LPDBORDERINFO pOrderInf { pTag = pTag->pNext; --uiTag; - } - } + } + } } if ( pTag ) pOrderInfo->itmResult = hb_itemPutC( pOrderInfo->itmResult, pTag->szName ); @@ -2408,7 +2408,7 @@ static LPCDXTAG hb_cdxGetActiveTag( LPCDXINDEX PIF ) { pTag = pTag->pNext; --uiTag; - } + } if( !pTag ) PIF->uiTag = 0; @@ -3179,7 +3179,7 @@ static void hb_cdxSortInsertWord( LPSORTINFO pSort, LONG Tag, char * Value, LPSORTDATA wx; hb_cdxDNtoSort( ( double ) Tag, (BYTE *) &s[0] ); - + if( pSort->NodeLimit - pSort->NodeCur < uiLen + 8 ) { cc = pSort->ChunkCur; @@ -4107,13 +4107,13 @@ extern ERRCODE hb_cdxOrderListClear( CDXAREAP pArea ) ERRCODE hb_cdxOrderListFocus( CDXAREAP pArea, LPDBORDERINFO pOrderInfo ) { + LPCDXTAG pTag = hb_cdxGetActiveTag( pArea->lpIndexes ); + HB_TRACE(HB_TR_DEBUG, ("cdxOrderListFocus(%p, %p)", pArea, pOrderInfo)); //HB_SYMBOL_UNUSED( pArea ); //HB_SYMBOL_UNUSED( pOrderInfo ); - LPCDXTAG pTag = hb_cdxGetActiveTag( pArea->lpIndexes ); - if ( ! pTag ) return SUCCESS; @@ -4132,10 +4132,11 @@ ERRCODE hb_cdxOrderListFocus( CDXAREAP pArea, LPDBORDERINFO pOrderInfo ) ERRCODE hb_cdxGoTop( CDXAREAP pArea ) { - HB_TRACE(HB_TR_DEBUG, ("cdxGoTop(%p)", pArea)); /*must change to follow ordSetFocus()*/ LPCDXTAG pTag = hb_cdxGetActiveTag( pArea->lpIndexes ); + HB_TRACE(HB_TR_DEBUG, ("cdxGoTop(%p)", pArea)); + if ( ! pTag ) SUPER_GOTOP( ( AREAP ) pArea ); else @@ -4149,10 +4150,11 @@ ERRCODE hb_cdxGoTop( CDXAREAP pArea ) ERRCODE hb_cdxGoBottom( CDXAREAP pArea ) { - HB_TRACE(HB_TR_DEBUG, ("cdxGoBottom(%p)", pArea)); /*must change to follow ordSetFocus()*/ LPCDXTAG pTag = hb_cdxGetActiveTag( pArea->lpIndexes ); + HB_TRACE(HB_TR_DEBUG, ("cdxGoBottom(%p)", pArea)); + if ( ! pTag ) SUPER_GOBOTTOM( ( AREAP ) pArea ); else @@ -4166,11 +4168,11 @@ ERRCODE hb_cdxGoBottom( CDXAREAP pArea ) ERRCODE hb_cdxSkipRaw( CDXAREAP pArea, LONG lToSkip ) { - HB_TRACE(HB_TR_DEBUG, ("cdxSkipRaw(%p, %ld)", pArea, lToSkip)); - /*must change to follow ordSetFocus()*/ LPCDXTAG pTag = hb_cdxGetActiveTag( pArea->lpIndexes ); + HB_TRACE(HB_TR_DEBUG, ("cdxSkipRaw(%p, %ld)", pArea, lToSkip)); + if ( ! pTag ) SUPER_SKIPRAW( ( AREAP ) pArea, lToSkip ); else @@ -4231,14 +4233,14 @@ ERRCODE hb_cdxSeek( CDXAREAP pArea, BOOL bSoftSeek, PHB_ITEM pKey, BOOL bFindLas { PHB_ITEM pError; ERRCODE retvalue; + LPCDXTAG pTag = hb_cdxGetActiveTag( pArea->lpIndexes ); + HB_TRACE(HB_TR_DEBUG, ("cdxSeek(%p, %d, %p, %d)", pArea, bSoftSeek, pKey, bFindLast)); /*HB_SYMBOL_UNUSED( pArea ); */ /*HB_SYMBOL_UNUSED( bSoftSeek ); */ /*HB_SYMBOL_UNUSED( pKey ); */ /*HB_SYMBOL_UNUSED( bFindLast ); */ - LPCDXTAG pTag = hb_cdxGetActiveTag( pArea->lpIndexes ); - if ( ! pTag ) { pError = hb_errNew(); @@ -4416,7 +4418,7 @@ ERRCODE hb_cdxGoHot( CDXAREAP pArea ) hb_vmPush( pTag->pKeyItem ); hb_vmDo( 0 ); hb_cdxKeyPutItem( pKey, &hb_stack.Return ); - } + } else { pMacro = ( HB_MACRO_PTR ) hb_itemGetPtr( pTag->pKeyItem );