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

2001-02-24 19:45 UTC-0800 Ron Pinkas <ron@profit-master.com>

Browse Source 
* 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.
This commit is contained in:
Ron Pinkas
2001-02-25 03:59:52 +00:00
parent d05b38d8d0
commit 3ceb194fed
3 changed files with 173 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
harbour/ChangeLog
View File

@@ -1,3 +1,14 @@
2001-02-24 19:45 UTC-0800 Ron Pinkas <ron@profit-master.com>
* 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 <shashkov@ostu.ru>
* harbour/source/rtl/console.c
! Fixed bug STDOUT(..,"",..) on Watcom C 11.0

144
harbour/contrib/dot/pp.prg
View File

@@ -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 )

36
harbour/source/rdd/dbfcdx/dbfcdx1.c
View File

@@ -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 );