From 3f78fa0b6e10ca7c1c9edecb8cf51162c404df1e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Przemys=C5=82aw=20Czerpak?= Date: Fri, 1 Aug 2014 02:04:07 +0200 Subject: [PATCH] 2014-08-01 02:04 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * extras/gtwvw/gtwvwd.c ! fixed typo in WVW_SETICON() - thanks to Ash * src/rdd/dbcmd53.c ! typo in comment * src/rtl/dateshb.c % use hb_retclen() instead of hb_retc() when size is well known. * src/rtl/valtoexp.prg % use hb_defaultValue() * src/vm/estack.c * minor cleanup * src/vm/fm.c * modified a little bit HB_MEMINFO structure to force strict alignment + added debug code covered by HB_FM_FORCE_REALLOC macro which forces allocateing new block in each hb_xrealloc() call ! protect realloc() in HB_FM_STATISTIC by mutex, it fixes issue #77. * src/rtl/hbproces.c % unlock HVM waiting for process in OS2 builds ! build array of argument passed to process in hb_processRun() in parent process not forked one. It fixes possible deadlock in forked process because memory is allocated to create arguments array and in MT program memory managers may use mutexes internally which can be cloned to forked process in locked state. It fixes seldom and random HBMK2 freezing during compilation with -jobs= parameter. * utils/hbmk2/hbmk2.prg ! fixed race condition in concurrent C compiler execution (-jobs=) with script file * src/debug/dbgentry.c ! fixed crash when wrong expression is used as tracepoint ! fixed expression analyzer to correctly recognized extended strings e"..." * formatting * src/debug/dbgbrwsr.prg * src/debug/dbghelp.prg * src/debug/dbgtarr.prg * src/debug/dbgthsh.prg * src/debug/dbgtinp.prg * src/debug/dbgtmenu.prg * src/debug/dbgtobj.prg * src/debug/dbgtwin.prg * src/debug/dbgwa.prg * src/debug/debugger.prg * added calls to ::NotSupported() method for some still missing functionality ! do not use SetColor() but directly pass colors to used objects and functions ! do not use SetPos() and Row()/Col() for core functionality - it was source of few minor bugs % enable cursor only in input objects and disable it just after % eliminated code to save and restore cursor position and shape ! fixed initial positioning in help window + implemented HiLite() and DeHiLite() methods in HBDbBrowser() class ! fixed positioning when end of source data is reached in browser % eliminated some redundant or completely useless code and comments % use some fully functional HBDbBrowser() features instead of manual encoding similar functionality ! validate watchpoint and tracepoint expressions % use SWITCH statements ! fixed expression presentation (added __dbgValToExp() and __dbgValToStr()) ! fixed input for new expressions ! fixed browser scrolling in object inspector ! fixed inkey() processing inside debugger (ALT+D and ALT+C) ! fixed browsers highliting in WA inspector ! fixed hardcoded limit for 512 workareas in WA inspector ! fixed initial WA positioning in WA inspector * resized WA inspector window * many other minor fixes and improvements --- ChangeLog.txt | 77 ++++++++ extras/gtwvw/gtwvwd.c | 2 +- src/debug/dbgbrwsr.prg | 90 ++++++---- src/debug/dbgentry.c | 58 +++--- src/debug/dbghelp.prg | 12 +- src/debug/dbgtarr.prg | 96 ++++------ src/debug/dbgthsh.prg | 110 ++++-------- src/debug/dbgtinp.prg | 48 ++--- src/debug/dbgtmenu.prg | 12 +- src/debug/dbgtobj.prg | 203 +++++++++------------ src/debug/dbgtwin.prg | 22 +-- src/debug/dbgwa.prg | 98 ++++------ src/debug/debugger.prg | 398 +++++++++++++++++------------------------ src/rdd/dbcmd53.c | 2 +- src/rtl/dateshb.c | 12 +- src/rtl/hbproces.c | 8 +- src/rtl/valtoexp.prg | 4 +- src/vm/estack.c | 2 +- src/vm/fm.c | 96 ++++++---- utils/hbmk2/hbmk2.prg | 21 ++- 20 files changed, 629 insertions(+), 742 deletions(-) diff --git a/ChangeLog.txt b/ChangeLog.txt index 3585536bad..c8aeae7fc7 100644 --- a/ChangeLog.txt +++ b/ChangeLog.txt @@ -10,6 +10,83 @@ * Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment */ +2014-08-01 02:04 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) + * extras/gtwvw/gtwvwd.c + ! fixed typo in WVW_SETICON() - thanks to Ash + + * src/rdd/dbcmd53.c + ! typo in comment + + * src/rtl/dateshb.c + % use hb_retclen() instead of hb_retc() when size is well known. + + * src/rtl/valtoexp.prg + % use hb_defaultValue() + + * src/vm/estack.c + * minor cleanup + + * src/vm/fm.c + * modified a little bit HB_MEMINFO structure to force strict alignment + + added debug code covered by HB_FM_FORCE_REALLOC macro which forces + allocateing new block in each hb_xrealloc() call + ! protect realloc() in HB_FM_STATISTIC by mutex, it fixes issue #77. + + * src/rtl/hbproces.c + % unlock HVM waiting for process in OS2 builds + ! build array of argument passed to process in hb_processRun() in + parent process not forked one. It fixes possible deadlock in forked + process because memory is allocated to create arguments array and + in MT program memory managers may use mutexes internally which can + be cloned to forked process in locked state. + It fixes seldom and random HBMK2 freezing during compilation + with -jobs= parameter. + + * utils/hbmk2/hbmk2.prg + ! fixed race condition in concurrent C compiler execution (-jobs=) + with script file + + * src/debug/dbgentry.c + ! fixed crash when wrong expression is used as tracepoint + ! fixed expression analyzer to correctly recognized extended strings e"..." + * formatting + + * src/debug/dbgbrwsr.prg + * src/debug/dbghelp.prg + * src/debug/dbgtarr.prg + * src/debug/dbgthsh.prg + * src/debug/dbgtinp.prg + * src/debug/dbgtmenu.prg + * src/debug/dbgtobj.prg + * src/debug/dbgtwin.prg + * src/debug/dbgwa.prg + * src/debug/debugger.prg + * added calls to ::NotSupported() method for some still missing + functionality + ! do not use SetColor() but directly pass colors to used objects + and functions + ! do not use SetPos() and Row()/Col() for core functionality - it was + source of few minor bugs + % enable cursor only in input objects and disable it just after + % eliminated code to save and restore cursor position and shape + ! fixed initial positioning in help window + + implemented HiLite() and DeHiLite() methods in HBDbBrowser() class + ! fixed positioning when end of source data is reached in browser + % eliminated some redundant or completely useless code and comments + % use some fully functional HBDbBrowser() features instead of manual + encoding similar functionality + ! validate watchpoint and tracepoint expressions + % use SWITCH statements + ! fixed expression presentation (added __dbgValToExp() and __dbgValToStr()) + ! fixed input for new expressions + ! fixed browser scrolling in object inspector + ! fixed inkey() processing inside debugger (ALT+D and ALT+C) + ! fixed browsers highliting in WA inspector + ! fixed hardcoded limit for 512 workareas in WA inspector + ! fixed initial WA positioning in WA inspector + * resized WA inspector window + * many other minor fixes and improvements + 2014-07-11 15:33 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl) * src/rtl/gtstd/gtstd.c ! fixed typo in for() loop counter (issue #75) diff --git a/extras/gtwvw/gtwvwd.c b/extras/gtwvw/gtwvwd.c index 8f96821190..338a5b54c7 100644 --- a/extras/gtwvw/gtwvwd.c +++ b/extras/gtwvw/gtwvwd.c @@ -8170,7 +8170,7 @@ HB_FUNC( WVW_SETICON ) else { void * hImageName; - hb_retptr( ( void * ) hb_gt_wvwSetWindowIconFromFile( usWinNum, HB_PARSTRDEF( 1, &hImageName, NULL ) ) ); + hb_retptr( ( void * ) hb_gt_wvwSetWindowIconFromFile( usWinNum, HB_PARSTRDEF( 2, &hImageName, NULL ) ) ); hb_strfree( hImageName ); } } diff --git a/src/debug/dbgbrwsr.prg b/src/debug/dbgbrwsr.prg index fb01979ac0..853cdea40d 100644 --- a/src/debug/dbgbrwsr.prg +++ b/src/debug/dbgbrwsr.prg @@ -93,8 +93,9 @@ CREATE CLASS HBDbBrowser ACCESS ColorSpec INLINE ::cColorSpec ASSIGN ColorSpec( cColors ) METHOD SetColorSpec( cColors ) METHOD Configure() - METHOD DeHiLite() INLINE Self - METHOD HiLite() INLINE Self + METHOD DeHiLite() INLINE ::DispRow( ::rowPos, .F. ) + METHOD HiLite() INLINE ::DispRow( ::rowPos, .T. ) + METHOD DispRow( nRow, lHiLite ) METHOD MoveCursor( nSkip ) METHOD GoTo( nRow ) METHOD GoTop() INLINE ::GoTo( 1 ), ::rowPos := 1, ::nFirstVisible := 1, ::RefreshAll() @@ -122,7 +123,7 @@ METHOD New( nTop, nLeft, nBottom, nRight, oParentWindow ) CLASS HBDbBrowser RETURN Self -METHOD Configure() +METHOD Configure() CLASS HBDbBrowser ::rowCount := ::nBottom - ::nTop + 1 IF ::rowPos > ::rowCount @@ -134,7 +135,7 @@ METHOD Configure() RETURN Self -METHOD SetColorSpec( cColors ) +METHOD SetColorSpec( cColors ) CLASS HBDbBrowser IF HB_ISSTRING( cColors ) ::cColorSpec := cColors @@ -143,7 +144,7 @@ METHOD SetColorSpec( cColors ) RETURN ::cColorSpec -METHOD MoveCursor( nSkip ) +METHOD MoveCursor( nSkip ) CLASS HBDbBrowser LOCAL nSkipped @@ -161,9 +162,45 @@ METHOD MoveCursor( nSkip ) RETURN Self -METHOD ForceStable() +METHOD DispRow( nRow, lHiLite ) CLASS HBDbBrowser - LOCAL nRow, nCol, xData, oCol, nColX, nWid, aClr, nClr + LOCAL nCol, nColX, nWid, aClr, nClr + LOCAL xData + LOCAL oCol + + ::GoTo( ::nFirstVisible + nRow - 1 ) + IF ::hitBottom + hb_Scroll( ::nTop + nRow - 1, ::nLeft, ::nTop + nRow - 1, ::nRight,,, ::aColorSpec[ 1 ] ) + ELSE + DispBegin() + nColX := ::nLeft + FOR nCol := 1 TO Len( ::aColumns ) + IF nColX <= ::nRight + oCol := ::aColumns[ nCol ] + xData := Eval( oCol:block ) + nClr := iif( lHiLite, 2, 1 ) + aClr := Eval( oCol:colorBlock, xData ) + IF HB_ISARRAY( aClr ) + nClr := aClr[ nClr ] + ELSE + nClr := oCol:defColor[ nClr ] + ENDIF + nWid := oCol:width + IF nWid == NIL + nWid := Len( xData ) + ENDIF + hb_DispOutAt( ::nTop + nRow - 1, nColX, PadR( xData, nWid ) + iif( nCol < Len( ::aColumns ), " ", "" ), ::aColorSpec[ nClr ] ) + nColX += nWid + 1 + ENDIF + NEXT + DispEnd() + ENDIF + + RETURN Self + +METHOD ForceStable() CLASS HBDbBrowser + + LOCAL nRow IF ! ::lConfigured ::Configure() @@ -171,31 +208,7 @@ METHOD ForceStable() DispBegin() FOR nRow := 1 TO ::rowCount IF ! ::aRowState[ nRow ] - ::GoTo( ::nFirstVisible + nRow - 1 ) - IF ::hitBottom - hb_DispOutAt( ::nTop + nRow - 1, ::nLeft, Space( ::nRight - ::nLeft + 1 ), ::aColorSpec[ 1 ] ) - ELSE - nColX := ::nLeft - FOR nCol := 1 TO Len( ::aColumns ) - IF nColX <= ::nRight - oCol := ::aColumns[ nCol ] - xData := Eval( oCol:block ) - nClr := iif( nRow == ::rowPos, 2, 1 ) - aClr := Eval( oCol:colorBlock, xData ) - IF HB_ISARRAY( aClr ) - nClr := aClr[ nClr ] - ELSE - nClr := oCol:defColor[ nClr ] - ENDIF - nWid := oCol:width - IF nWid == NIL - nWid := Len( xData ) - ENDIF - hb_DispOutAt( ::nTop + nRow - 1, nColX, PadR( xData, nWid ) + iif( nCol < Len( ::aColumns ), " ", "" ), ::aColorSpec[ nClr ] ) - nColX += nWid + 1 - ENDIF - NEXT - ENDIF + ::DispRow( nRow, nRow == ::rowPos ) ::aRowState[ nRow ] := .T. ENDIF NEXT @@ -205,7 +218,7 @@ METHOD ForceStable() RETURN Self -METHOD GoTo( nRow ) +METHOD GoTo( nRow ) CLASS HBDbBrowser LOCAL nOldRow := ::nFirstVisible + ::rowPos - 1 LOCAL nSkipped := 0 @@ -220,15 +233,22 @@ METHOD GoTo( nRow ) RETURN nSkipped - nOldRow + 1 -METHOD GoBottom() +METHOD GoBottom() CLASS HBDbBrowser + + LOCAL nScroll DO WHILE ! ::hitBottom ::PageDown() ENDDO + IF ::rowPos < ::rowCount .AND. ::nFirstVisible > 1 + nScroll := Min( ::nFirstVisible - 1, ::rowCount - ::rowPos ) + ::nFirstVisible -= nScroll + ::rowPos += nScroll + ENDIF RETURN Self -METHOD Resize( nTop, nLeft, nBottom, nRight ) +METHOD Resize( nTop, nLeft, nBottom, nRight ) CLASS HBDbBrowser LOCAL lResize := .F. diff --git a/src/debug/dbgentry.c b/src/debug/dbgentry.c index 6e64c4bab5..2ee8cc0a2d 100644 --- a/src/debug/dbgentry.c +++ b/src/debug/dbgentry.c @@ -194,7 +194,6 @@ static void hb_dbgAddVar( int * nVars, HB_VARINFO ** aVars, const char * szN static void hb_dbgAddStopLines( PHB_ITEM pItem ); static void hb_dbgEndProc( HB_DEBUGINFO * info ); static PHB_ITEM hb_dbgEval( HB_DEBUGINFO * info, HB_WATCHPOINT * watch ); -static PHB_ITEM hb_dbgEvalMacro( const char * szExpr, PHB_ITEM pItem ); static PHB_ITEM hb_dbgEvalMakeBlock( HB_WATCHPOINT * watch ); static PHB_ITEM hb_dbgEvalResolve( HB_DEBUGINFO * info, HB_WATCHPOINT * watch ); static HB_BOOL hb_dbgIsAltD( void ); @@ -444,14 +443,15 @@ void hb_dbgEntry( int nMode, int nLine, const char * szName, int nIndex, PHB_ITE PHB_ITEM xValue; xValue = hb_dbgEval( info, &info->aWatch[ tp->nIndex ] ); - if( ! xValue ) - xValue = hb_itemNew( NULL ); - if( HB_ITEM_TYPE( xValue ) != HB_ITEM_TYPE( tp->xValue ) || - ! hb_dbgEqual( xValue, tp->xValue ) ) + if( ! ( xValue == NULL && tp->xValue == NULL ) && + ( xValue == NULL || tp->xValue == NULL || + HB_ITEM_TYPE( xValue ) != HB_ITEM_TYPE( tp->xValue ) || + ! hb_dbgEqual( xValue, tp->xValue ) ) ) { - hb_itemCopy( tp->xValue, xValue ); - hb_itemRelease( xValue ); + if( tp->xValue ) + hb_itemRelease( tp->xValue ); + tp->xValue = xValue; pTop->nLine = nLine; info->nProcLevel = nProcLevel - ( hb_dbgIsAltD() ? 2 : 0 ); @@ -468,7 +468,8 @@ void hb_dbgEntry( int nMode, int nLine, const char * szName, int nIndex, PHB_ITE hb_dbgActivate( info ); return; } - hb_itemRelease( xValue ); + if( xValue ) + hb_itemRelease( xValue ); } hb_clsSetScope( bOldClsScope ); @@ -1067,10 +1068,8 @@ static PHB_ITEM hb_dbgEvalMakeBlock( HB_WATCHPOINT * watch ) char * szWord; while( c && IS_IDENT_CHAR( c ) ) - { - j++; - c = watch->szExpr[ j ]; - } + c = watch->szExpr[ ++j ]; + nLen = j - i; i = j; if( c ) @@ -1078,7 +1077,8 @@ static PHB_ITEM hb_dbgEvalMakeBlock( HB_WATCHPOINT * watch ) while( watch->szExpr[ i ] == ' ' ) i++; - if( watch->szExpr[ i ] == '(' ) + if( watch->szExpr[ i ] == '(' || + ( nLen == 1 && i == j && watch->szExpr[ i ] == '"' ) ) continue; if( watch->szExpr[ i ] == '-' && watch->szExpr[ i + 1 ] == '>' ) @@ -1098,9 +1098,9 @@ static PHB_ITEM hb_dbgEvalMakeBlock( HB_WATCHPOINT * watch ) } if( c == '.' ) { - if( watch->szExpr[ i + 1 ] - && strchr( "TtFf", watch->szExpr[ i + 1 ] ) - && watch->szExpr[ i + 2 ] == '.' ) + if( watch->szExpr[ i + 1 ] && + strchr( "TtFf", watch->szExpr[ i + 1 ] ) && + watch->szExpr[ i + 2 ] == '.' ) { i += 3; } @@ -1108,8 +1108,8 @@ static PHB_ITEM hb_dbgEvalMakeBlock( HB_WATCHPOINT * watch ) { i += 4; } - else if( ! hb_strnicmp( watch->szExpr + i + 1, "AND.", 4 ) - || ! hb_strnicmp( watch->szExpr + i + 1, "NOT.", 4 ) ) + else if( ! hb_strnicmp( watch->szExpr + i + 1, "AND.", 4 ) || + ! hb_strnicmp( watch->szExpr + i + 1, "NOT.", 4 ) ) { i += 5; } @@ -1120,9 +1120,9 @@ static PHB_ITEM hb_dbgEvalMakeBlock( HB_WATCHPOINT * watch ) bAfterId = HB_FALSE; continue; } - if( c == ':' - || ( c == '-' && watch->szExpr[ i + 1 ] == '>' - && IS_IDENT_START( watch->szExpr[ i + 2 ] ) ) ) + if( c == ':' || + ( c == '-' && watch->szExpr[ i + 1 ] == '>' && + IS_IDENT_START( watch->szExpr[ i + 2 ] ) ) ) { if( c == ':' && watch->szExpr[ i + 1 ] == ':' ) { @@ -1348,6 +1348,14 @@ PHB_ITEM hb_dbgGetExpressionValue( void * handle, const char * expression ) } +PHB_ITEM hb_dbgGetWatchValue( void * handle, int nWatch ) +{ + HB_DEBUGINFO * info = ( HB_DEBUGINFO * ) handle; + + return hb_dbgEval( info, &( info->aWatch[ nWatch ] ) ); +} + + PHB_ITEM hb_dbgGetSourceFiles( void * handle ) { PHB_ITEM ret; @@ -1368,14 +1376,6 @@ PHB_ITEM hb_dbgGetSourceFiles( void * handle ) } -PHB_ITEM hb_dbgGetWatchValue( void * handle, int nWatch ) -{ - HB_DEBUGINFO * info = ( HB_DEBUGINFO * ) handle; - - return hb_dbgEval( info, &( info->aWatch[ nWatch ] ) ); -} - - static HB_BOOL hb_dbgIsAltD( void ) { char szName[ HB_SYMBOL_NAME_LEN + HB_SYMBOL_NAME_LEN + 5 ]; diff --git a/src/debug/dbghelp.prg b/src/debug/dbghelp.prg index 3e741f80dd..0c5edf8aed 100644 --- a/src/debug/dbghelp.prg +++ b/src/debug/dbghelp.prg @@ -82,7 +82,7 @@ PROCEDURE __dbgHelp( nTopic ) oBrw:GoBottomBlock := {|| oBrw:Cargo := Len( aTopics ) } IF nTopic > 1 - Eval( oBrw:SkipBlock, nTopic - 1 ) + oBrw:nFirstVisible := nTopic ENDIF oDlg:bPainted := {|| PaintWindow( oDlg, oBrw, aTopics ) } @@ -209,19 +209,15 @@ STATIC PROCEDURE ShowTopic( oDlg, aTopics, nTopic, nPageOp ) ENDCASE ENDIF - hb_Scroll( oDlg:nTop + 1, oDlg:nLeft + 14, oDlg:nBottom - 1, oDlg:nRight - 1 ) + hb_Scroll( oDlg:nTop + 1, oDlg:nLeft + 14, oDlg:nBottom - 1, oDlg:nRight - 1,,, oDlg:cColor ) nRowsToPaint := Min( nRows, Len( aTopics[ nTopic ][ 2 ] ) - ( ( oDebug:nHelpPage - 1 ) * nRows ) ) FOR n := 1 TO nRowsToPaint - hb_DispOutAt( 2 + n, 16, aTopics[ nTopic ][ 2 ][ ( ( oDebug:nHelpPage - 1 ) * nRows ) + n ] ) + hb_DispOutAt( 2 + n, 16, aTopics[ nTopic ][ 2 ][ ( ( oDebug:nHelpPage - 1 ) * nRows ) + n ], oDlg:cColor ) NEXT - IF Len( aTopics[ nTopic ][ 2 ] ) <= nRows - hb_DispOutAt( oDlg:nBottom, oDlg:nRight - 16, " Page 1 of 1 " ) - ELSE - hb_DispOutAt( oDlg:nBottom, oDlg:nRight - 16, " Page " + Str( oDebug:nHelpPage, 1 ) + " of " + Str( nPages, 1 ) + " " ) - ENDIF + hb_DispOutAt( oDlg:nBottom, oDlg:nRight - 16, " Page " + Str( oDebug:nHelpPage, 1 ) + " of " + Str( nPages, 1 ) + " ", oDlg:cColor ) RETURN diff --git a/src/debug/dbgtarr.prg b/src/debug/dbgtarr.prg index c8959ee6b0..6fae783b87 100644 --- a/src/debug/dbgtarr.prg +++ b/src/debug/dbgtarr.prg @@ -87,7 +87,6 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbArray LOCAL oBrwSets LOCAL nSize := Len( aArray ) LOCAL oWndSets - LOCAL nWidth LOCAL nColWidth LOCAL oCol @@ -105,9 +104,7 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbArray oWndSets:lFocused := .T. AAdd( ::aWindows, oWndSets ) - nWidth := oWndSets:nRight - oWndSets:nLeft - 1 oBrwSets := HBDbBrowser():New( oWndSets:nTop + 1, oWndSets:nLeft + 1, oWndSets:nBottom - 1, oWndSets:nRight - 1 ) - oBrwSets:autolite := .F. oBrwSets:ColorSpec := __Dbg():ClrModal() oBrwSets:Cargo := { 1, {} } // Actual highligthed row AAdd( oBrwSets:Cargo[ 2 ], aArray ) @@ -117,35 +114,20 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbArray oCol:DefColor := { 1, 2 } nColWidth := oCol:Width - oBrwSets:AddColumn( oCol := HBDbColumnNew( "", {|| PadR( __dbgValToStr( aArray[ oBrwSets:cargo[ 1 ] ] ), nWidth - nColWidth - 1 ) } ) ) - - /* 2004-08-09 - - Setting a fixed width like it is done in the next line of code wich I've - commented exploits a bug of current tbrowse, that is, if every column is - narrower than tbrowse but the sum of them is wider tbrowse paints - one above the other if code like the one inside RefreshVarsS() is called. - (That code is used to have current row fully highlighted and not only - current cell). Reproducing this situation on a smaller sample with - clipper causes that only column two is visible after first stabilization. - - I think tbrowse should trim columns up until the point where at leat - two are visible in the same moment, I leave this fix to tbrowse for - the reader ;) - oCol:width := 50 - */ + oBrwSets:AddColumn( oCol := HBDbColumnNew( "", {|| __dbgValToExp( aArray[ oBrwSets:cargo[ 1 ] ] ) } ) ) + oCol:width := oWndSets:nRight - oWndSets:nLeft - nColWidth - 2 oCol:defColor := { 1, 3 } oBrwSets:goTopBlock := {|| oBrwSets:cargo[ 1 ] := 1 } oBrwSets:goBottomBlock := {|| oBrwSets:cargo[ 1 ] := Len( oBrwSets:cargo[ 2 ][ 1 ] ) } - oBrwSets:skipBlock := {| nPos | ( nPos := ArrayBrowseSkip( nPos, oBrwSets ), oBrwSets:cargo[ 1 ] := ; - oBrwSets:cargo[ 1 ] + nPos, nPos ) } + oBrwSets:skipBlock := {| nPos | nPos := ArrayBrowseSkip( nPos, oBrwSets ), ; + oBrwSets:cargo[ 1 ] := oBrwSets:cargo[ 1 ] + nPos, nPos } + oBrwSets:colPos := 2 - ::aWindows[ ::nCurWindow ]:bPainted := {|| ( oBrwSets:forcestable(), RefreshVarsS( oBrwSets ) ) } - ::aWindows[ ::nCurWindow ]:bKeyPressed := {| nKey | ::SetsKeyPressed( nKey, oBrwSets, ; - ::aWindows[ ::nCurWindow ], ::arrayName, aArray ) } - - SetCursor( SC_NONE ) + ::aWindows[ ::nCurWindow ]:bPainted := {|| oBrwSets:forcestable() } + ::aWindows[ ::nCurWindow ]:bKeyPressed := ; + {| nKey | ::SetsKeyPressed( nKey, oBrwSets, ::aWindows[ ::nCurWindow ], ::arrayName, aArray ) } ::aWindows[ ::nCurWindow ]:ShowModal() @@ -154,15 +136,17 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbArray METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbArray LOCAL oErr - LOCAL cValue := PadR( __dbgValToStr( pItem[ nSet ] ), ; - oBrowse:nRight - oBrowse:nLeft - oBrowse:GetColumn( 1 ):width ) + LOCAL cValue // make sure browse is stable oBrowse:forceStable() // if confirming new record, append blank - IF __dbgInput( Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1,, @cValue, ; - {| cValue | iif( Type( cValue ) == "UE", ( __dbgAlert( "Expression error" ), .F. ), .T. ) } ) + cValue := __dbgValToExp( pItem[ nSet ] ) + + IF __dbgInput( Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1, ; + oBrowse:getColumn( 2 ):Width, @cValue, ; + __dbgExprValidBlock(), __dbgColors()[ 2 ], 256 ) BEGIN SEQUENCE WITH {| oErr | Break( oErr ) } pItem[ nSet ] := &cValue RECOVER USING oErr @@ -177,26 +161,36 @@ METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, aArray ) CLASS HBDbArray LOCAL nSet := oBrwSets:cargo[ 1 ] LOCAL cOldName := ::arrayName - DO CASE - CASE nKey == K_UP + SWITCH nKey + CASE K_UP oBrwSets:Up() + EXIT - CASE nKey == K_DOWN + CASE K_DOWN oBrwSets:Down() + EXIT - CASE nKey == K_HOME .OR. nKey == K_CTRL_PGUP .OR. nKey == K_CTRL_HOME + CASE K_HOME + CASE K_CTRL_PGUP + CASE K_CTRL_HOME oBrwSets:GoTop() + EXIT - CASE nKey == K_END .OR. nKey == K_CTRL_PGDN .OR. nKey == K_CTRL_END + CASE K_END + CASE K_CTRL_PGDN + CASE K_CTRL_END oBrwSets:GoBottom() + EXIT - CASE nKey == K_PGDN + CASE K_PGDN oBrwSets:pageDown() + EXIT - CASE nKey == K_PGUP + CASE K_PGUP oBrwSets:PageUp() + EXIT - CASE nKey == K_ENTER + CASE K_ENTER IF HB_ISARRAY( aArray[ nSet ] ) IF Len( aArray[ nSet ] ) == 0 __dbgAlert( "Array is empty" ) @@ -233,12 +227,12 @@ METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, aArray ) CLASS HBDbArray ENDIF ENDIF - ENDCASE + ENDSWITCH - RefreshVarsS( oBrwSets ) + oBrwSets:forceStable() ::aWindows[ ::nCurWindow ]:SetCaption( cName + "[" + hb_ntos( oBrwSets:cargo[ 1 ] ) + ".." + ; - hb_ntos( Len( aArray ) ) + "]" ) + hb_ntos( Len( aArray ) ) + "]" ) RETURN self @@ -251,23 +245,7 @@ STATIC FUNCTION GetTopPos( nPos ) STATIC FUNCTION GetBottomPos( nPos ) RETURN iif( nPos < MaxRow() - 2, nPos, MaxRow() - 2 ) -STATIC PROCEDURE RefreshVarsS( oBrowse ) - - LOCAL nLen := oBrowse:colCount - - IF nLen == 2 - oBrowse:deHilite():colPos := 2 - ENDIF - oBrowse:deHilite():forceStable() - - IF nLen == 2 - oBrowse:hilite():colPos := 1 - ENDIF - oBrowse:hilite() - - RETURN - STATIC FUNCTION ArrayBrowseSkip( nPos, oBrwSets ) RETURN iif( oBrwSets:cargo[ 1 ] + nPos < 1, 0 - oBrwSets:cargo[ 1 ] + 1, ; - iif( oBrwSets:cargo[ 1 ] + nPos > Len( oBrwSets:cargo[ 2 ][ 1 ] ), ; - Len( oBrwSets:cargo[ 2 ][ 1 ] ) - oBrwSets:cargo[ 1 ], nPos ) ) + iif( oBrwSets:cargo[ 1 ] + nPos > Len( oBrwSets:cargo[ 2 ][ 1 ] ), ; + Len( oBrwSets:cargo[ 2 ][ 1 ] ) - oBrwSets:cargo[ 1 ], nPos ) ) diff --git a/src/debug/dbgthsh.prg b/src/debug/dbgthsh.prg index f97f8c39f8..8be43ff6a0 100644 --- a/src/debug/dbgthsh.prg +++ b/src/debug/dbgthsh.prg @@ -87,7 +87,6 @@ METHOD addWindows( hHash, nRow ) CLASS HBDbHash LOCAL oBrwSets LOCAL nSize := Len( hHash ) LOCAL oWndSets - LOCAL nWidth LOCAL nColWidth LOCAL oCol LOCAL nKeyLen @@ -105,9 +104,7 @@ METHOD addWindows( hHash, nRow ) CLASS HBDbHash oWndSets:lFocused := .T. AAdd( ::aWindows, oWndSets ) - nWidth := oWndSets:nRight - oWndSets:nLeft - 1 oBrwSets := HBDbBrowser():New( oWndSets:nTop + 1, oWndSets:nLeft + 1, oWndSets:nBottom - 1, oWndSets:nRight - 1 ) - oBrwSets:autolite := .F. oBrwSets:ColorSpec := __dbg():ClrModal() oBrwSets:Cargo := { 1, {} } // Actual highligthed row AAdd( oBrwSets:Cargo[ 2 ], hHash ) @@ -116,40 +113,25 @@ METHOD addWindows( hHash, nRow ) CLASS HBDbHash // calculate max key length nKeyLen := 0 - hb_HEval( hHash, {| k, v, p | HB_SYMBOL_UNUSED( k ), HB_SYMBOL_UNUSED( v ), nKeyLen := Max( nKeyLen, Len( ::hashName + "[" + HashKeyString( hHash, p ) + "]" ) ) } ) + hb_HEval( hHash, {| k, v, p | HB_SYMBOL_UNUSED( k ), HB_SYMBOL_UNUSED( v ), nKeyLen := Max( nKeyLen, Len( ::hashName + HashKeyString( hHash, p ) ) + 2 ) } ) oCol:width := nKeyLen oCol:DefColor := { 1, 2 } nColWidth := oCol:Width - oBrwSets:AddColumn( oCol := HBDbColumnNew( "", {|| PadR( __dbgValToStr( hb_HValueAt( hHash, oBrwSets:cargo[ 1 ] ) ), nWidth - nColWidth - 1 ) } ) ) - - /* 2004-08-09 - - Setting a fixed width like it is done in the next line of code wich I've - commented exploits a bug of current tbrowse, that is, if every column is - narrower than tbrowse but the sum of them is wider tbrowse paints - one above the other if code like the one inside RefreshVarsS() is called. - (That code is used to have current row fully highlighted and not only - current cell). Reproducing this situation on a smaller sample with - clipper causes that only column two is visible after first stabilization. - - I think tbrowse should trim columns up until the point where at leat - two are visible in the same moment, I leave this fix to tbrowse for - the reader ;) - oCol:width := 50 - */ + oBrwSets:AddColumn( oCol := HBDbColumnNew( "", {|| __dbgValToExp( hb_HValueAt( hHash, oBrwSets:cargo[ 1 ] ) ) } ) ) + oCol:width := oWndSets:nRight - oWndSets:nLeft - nColWidth - 2 oCol:DefColor := { 1, 3 } oBrwSets:goTopBlock := {|| oBrwSets:cargo[ 1 ] := 1 } oBrwSets:goBottomBlock := {|| oBrwSets:cargo[ 1 ] := Len( oBrwSets:cargo[ 2 ][ 1 ] ) } - oBrwSets:skipBlock := {| nPos | ( nPos := HashBrowseSkip( nPos, oBrwSets ), oBrwSets:cargo[ 1 ] := ; - oBrwSets:cargo[ 1 ] + nPos, nPos ) } + oBrwSets:skipBlock := {| nPos | nPos := HashBrowseSkip( nPos, oBrwSets ), ; + oBrwSets:cargo[ 1 ] := oBrwSets:cargo[ 1 ] + nPos, nPos } + oBrwSets:colPos := 2 - ::aWindows[ ::nCurWindow ]:bPainted := {|| ( oBrwSets:forcestable(), RefreshVarsS( oBrwSets ) ) } - ::aWindows[ ::nCurWindow ]:bKeyPressed := {| nKey | ::SetsKeyPressed( nKey, oBrwSets, ; - ::aWindows[ ::nCurWindow ], ::hashName, hHash ) } - - SetCursor( SC_NONE ) + ::aWindows[ ::nCurWindow ]:bPainted := {|| oBrwSets:forcestable() } + ::aWindows[ ::nCurWindow ]:bKeyPressed := ; + {| nKey | ::SetsKeyPressed( nKey, oBrwSets, ::aWindows[ ::nCurWindow ], ::hashName, hHash ) } ::aWindows[ ::nCurWindow ]:ShowModal() @@ -158,15 +140,17 @@ METHOD addWindows( hHash, nRow ) CLASS HBDbHash METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbHash LOCAL oErr - LOCAL cValue := PadR( __dbgValToStr( hb_HValueAt( pItem, nSet ) ), ; - oBrowse:nRight - oBrowse:nLeft - oBrowse:GetColumn( 1 ):width ) + LOCAL cValue // make sure browse is stable oBrowse:forceStable() // if confirming new record, append blank - IF __dbgInput( Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1,, @cValue, ; - {| cValue | iif( Type( cValue ) == "UE", ( __dbgAlert( "Expression error" ), .F. ), .T. ) } ) + cValue := __dbgValToExp( hb_HValueAt( pItem, nSet ) ) + + IF __dbgInput( Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1, ; + oBrowse:getColumn( 2 ):Width, @cValue, ; + __dbgExprValidBlock(), __dbgColors()[ 2 ], 256 ) BEGIN SEQUENCE WITH {| oErr | Break( oErr ) } hb_HValueAt( pItem, nSet, &cValue ) RECOVER USING oErr @@ -182,27 +166,36 @@ METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, hHash ) CLASS HBDbHash LOCAL cOldname := ::hashName LOCAL uValue - DO CASE - CASE nKey == K_UP + SWITCH nKey + CASE K_UP oBrwSets:Up() + EXIT - CASE nKey == K_DOWN + CASE K_DOWN oBrwSets:Down() + EXIT - CASE nKey == K_HOME .OR. nKey == K_CTRL_PGUP .OR. nKey == K_CTRL_HOME + CASE K_HOME + CASE K_CTRL_PGUP + CASE K_CTRL_HOME oBrwSets:GoTop() + EXIT - CASE nKey == K_END .OR. nKey == K_CTRL_PGDN .OR. nKey == K_CTRL_END + CASE K_END + CASE K_CTRL_PGDN + CASE K_CTRL_END oBrwSets:GoBottom() + EXIT - CASE nKey == K_PGDN + CASE K_PGDN oBrwSets:pageDown() + EXIT - CASE nKey == K_PGUP + CASE K_PGUP oBrwSets:PageUp() + EXIT - CASE nKey == K_ENTER - + CASE K_ENTER uValue := hb_HValueAt( hHash, nSet ) IF HB_ISHASH( uValue ) @@ -244,12 +237,12 @@ METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, hHash ) CLASS HBDbHash ENDIF ENDIF - ENDCASE + ENDSWITCH - RefreshVarsS( oBrwSets ) + oBrwSets:forcestable() ::aWindows[ ::nCurwindow ]:SetCaption( cName + "[" + hb_ntos( oBrwSets:cargo[ 1 ] ) + ".." + ; - hb_ntos( Len( hHash ) ) + "]" ) + hb_ntos( Len( hHash ) ) + "]" ) RETURN self @@ -262,35 +255,10 @@ STATIC FUNCTION GetTopPos( nPos ) STATIC FUNCTION GetBottomPos( nPos ) RETURN iif( nPos < MaxRow() - 2, nPos, MaxRow() - 2 ) -STATIC PROCEDURE RefreshVarsS( oBrowse ) - - LOCAL nLen := oBrowse:colCount - - IF nLen == 2 - oBrowse:deHilite():colPos := 2 - ENDIF - oBrowse:deHilite():forceStable() - - IF nLen == 2 - oBrowse:hilite():colPos := 1 - ENDIF - oBrowse:hilite() - - RETURN - STATIC FUNCTION HashBrowseSkip( nPos, oBrwSets ) RETURN iif( oBrwSets:cargo[ 1 ] + nPos < 1, 0 - oBrwSets:cargo[ 1 ] + 1, ; - iif( oBrwSets:cargo[ 1 ] + nPos > Len( oBrwSets:cargo[ 2 ][ 1 ] ), ; - Len( oBrwSets:cargo[ 2 ][ 1 ] ) - oBrwSets:cargo[ 1 ], nPos ) ) + iif( oBrwSets:cargo[ 1 ] + nPos > Len( oBrwSets:cargo[ 2 ][ 1 ] ), ; + Len( oBrwSets:cargo[ 2 ][ 1 ] ) - oBrwSets:cargo[ 1 ], nPos ) ) STATIC FUNCTION HashKeyString( hHash, nAt ) - - LOCAL xVal := hb_HKeyAt( hHash, nAt ) - - SWITCH ValType( xVal ) - CASE "C" ; RETURN '"' + xVal + '"' - CASE "D" ; RETURN '"' + DToC( xVal ) + '"' - CASE "N" ; RETURN hb_ntos( xVal ) - ENDSWITCH - - RETURN AllTrim( __dbgCStr( xVal ) ) + RETURN __dbgValToExp( hb_HKeyAt( hHash, nAt ) ) diff --git a/src/debug/dbgtinp.prg b/src/debug/dbgtinp.prg index 9e6d186704..039aca15dc 100644 --- a/src/debug/dbgtinp.prg +++ b/src/debug/dbgtinp.prg @@ -68,7 +68,6 @@ CREATE CLASS HbDbInput VAR nSize AS INTEGER VAR cValue AS CHARACTER VAR acColor AS ARRAY - VAR lFocus AS LOGICAL INIT .F. EXPORTED: @@ -76,9 +75,8 @@ CREATE CLASS HbDbInput METHOD applyKey( nKey ) METHOD getValue() METHOD setValue( cValue ) - METHOD setFocus() - METHOD killFocus() METHOD display() + METHOD showCursor() METHOD newPos( nRow, nCol ) METHOD setColor( cColor ) @@ -91,7 +89,6 @@ METHOD new( nRow, nCol, nWidth, cValue, cColor, nSize ) CLASS HbDbInput ::nWidth := nWidth ::nSize := iif( HB_ISNUMERIC( nSize ), nSize, nWidth ) ::cValue := PadR( cValue, ::nSize ) - ::nRow := nRow ::setColor( cColor ) @@ -99,16 +96,10 @@ METHOD new( nRow, nCol, nWidth, cValue, cColor, nSize ) CLASS HbDbInput METHOD SetColor( cColor ) CLASS HbDbInput - ::acColor := { ; - hb_ColorIndex( cColor, CLR_STANDARD ), ; - hb_ColorIndex( cColor, CLR_ENHANCED ) } + ::acColor := { hb_ColorIndex( cColor, CLR_STANDARD ), ; + hb_ColorIndex( cColor, CLR_ENHANCED ) } IF hb_ColorToN( ::acColor[ 2 ] ) == -1 - ::acColor[ 2 ] := iif( hb_ColorToN( ::acColor[ 1 ] ) != -1, ; - ::acColor[ 1 ], ; - hb_ColorIndex( SetColor(), CLR_ENHANCED ) ) - ENDIF - IF hb_ColorToN( ::acColor[ 1 ] ) == -1 - ::acColor[ 1 ] := hb_ColorIndex( SetColor(), CLR_STANDARD ) + ::acColor[ 2 ] := ::acColor[ 1 ] ENDIF RETURN Self @@ -120,24 +111,6 @@ METHOD newPos( nRow, nCol ) CLASS HbDbInput RETURN Self -METHOD setFocus() CLASS HbDbInput - - IF ! ::lFocus - ::lFocus := .T. - ::display() - ENDIF - - RETURN Self - -METHOD killFocus() CLASS HbDbInput - - IF ::lFocus - ::lFocus := .F. - ::display() - ENDIF - - RETURN Self - METHOD getValue() CLASS HbDbInput RETURN ::cValue @@ -156,11 +129,14 @@ METHOD display() CLASS HbDbInput ::nFirst := ::nPos - ::nWidth + 1 ENDIF hb_DispOutAt( ::nRow, ::nCol, SubStr( ::cValue, ::nFirst, ::nWidth ), ; - ::acColor[ iif( ::lFocus, 2, 1 ) ] ) - IF ::lFocus - SetPos( ::nRow, ::nCol + ::nPos - ::nFirst ) - SetCursor( iif( Set( _SET_INSERT ), SC_INSERT, SC_NORMAL ) ) - ENDIF + ::acColor[ 2 ] ) + + RETURN Self + +METHOD showCursor() CLASS HbDbInput + + SetPos( ::nRow, ::nCol + ::nPos - ::nFirst ) + SetCursor( iif( Set( _SET_INSERT ), SC_INSERT, SC_NORMAL ) ) RETURN Self diff --git a/src/debug/dbgtmenu.prg b/src/debug/dbgtmenu.prg index bcfe8ca03b..23c15b93db 100644 --- a/src/debug/dbgtmenu.prg +++ b/src/debug/dbgtmenu.prg @@ -219,21 +219,18 @@ METHOD Display() CLASS HBDbMenu LOCAL oMenuItem - SetColor( ::cClrPopup ) - IF ! ::lPopup - hb_DispOutAt( 0, 0, Space( MaxCol() + 1 ), ::cClrPopup ) - SetPos( 0, 0 ) + hb_Scroll( 0, 0, 0, MaxCol(),,, ::cClrPopup ) ELSE ::cBackImage := SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 2 ) - hb_DispBox( ::nTop, ::nLeft, ::nBottom, ::nRight, HB_B_SINGLE_UNI ) + hb_DispBox( ::nTop, ::nLeft, ::nBottom, ::nRight, HB_B_SINGLE_UNI, ::cClrPopup ) hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight ) ENDIF FOR EACH oMenuItem IN ::aItems IF oMenuItem:cPrompt == "-" // Separator hb_DispOutAtBox( oMenuItem:nRow, ::nLeft, ; - hb_UTF8ToStrBox( "├" + Replicate( "─", ::nRight - ::nLeft - 1 ) + "┤" ) ) + hb_UTF8ToStrBox( "├" + Replicate( "─", ::nRight - ::nLeft - 1 ) + "┤" ), ::cClrPopup ) ELSE oMenuItem:Display( ::cClrPopup, ::cClrHotKey ) ENDIF @@ -399,8 +396,7 @@ METHOD Refresh() CLASS HBDbMenu DispBegin() IF ! ::lPopup - hb_DispOutAt( 0, 0, Space( MaxCol() + 1 ), ::cClrPopup ) - SetPos( 0, 0 ) + hb_Scroll( 0, 0, 0, MaxCol(),,, ::cClrPopup ) ENDIF FOR EACH oMenuItem IN ::aItems diff --git a/src/debug/dbgtobj.prg b/src/debug/dbgtobj.prg index 4fad5c94b0..08a01535a1 100644 --- a/src/debug/dbgtobj.prg +++ b/src/debug/dbgtobj.prg @@ -54,6 +54,11 @@ #include "inkey.ch" #include "setcurs.ch" +/* object message descirption */ +#define OMSG_NAME 1 +#define OMSG_VALUE 2 +#define OMSG_EDIT 3 + CREATE CLASS HBDbObject VAR aWindows INIT {} @@ -61,15 +66,13 @@ CREATE CLASS HBDbObject VAR objname VAR nCurWindow INIT 0 VAR pItems INIT {} - VAR ArrayReference INIT {} VAR ArrayIndex INIT 1 - VAR AllNames INIT {} VAR lEditable METHOD New( oObject, cVarName, lEditable ) - METHOD addWindows( aArray, nRow ) - METHOD doGet( oBrowse, pItem, nSet ) - METHOD SetsKeyPressed( nKey, oBrwSets, nSets, aArray ) + METHOD addWindows( nRow ) + METHOD doGet( oBrowse ) + METHOD SetsKeyPressed( nKey, oBrwSets ) ENDCLASS @@ -85,37 +88,34 @@ METHOD New( oObject, cVarName, lEditable ) CLASS HBDbObject /* create list of object messages */ aMessages := oObject:classSel() - ASort( aMessages,,, {| x, y | PadR( x, 64 ) <= PadR( y, 64 ) } ) + ASort( aMessages,,, {| x, y | x + chr( 0 ) < y + chr( 0 ) } ) aMethods := {} FOR EACH cMsg IN aMessages IF Left( cMsg, 1 ) == "_" .AND. ; hb_AScan( aMessages, cMsgAcc := SubStr( cMsg, 2 ),,, .T. ) != 0 xValue := __dbgObjGetValue( oObject, cMsgAcc ) AAdd( ::pItems, { cMsgAcc, xValue, .T. } ) - AAdd( ::AllNames, cMsgAcc ) ELSEIF hb_AScan( aMessages, "_" + cMsg,,, .T. ) == 0 AAdd( aMethods, cMsg ) ENDIF NEXT FOR EACH cMsg IN aMethods AAdd( ::pItems, { Lower( cMsg ), "Method", .F. } ) - AAdd( ::AllNames, cMsg ) NEXT ::objname := cVarName ::TheObj := oObject ::lEditable := lEditable - ::addWindows( ::pItems ) + ::addWindows() RETURN Self -METHOD addWindows( aArray, nRow ) CLASS HBDbObject +METHOD addWindows( nRow ) CLASS HBDbObject LOCAL oBrwSets - LOCAL nSize := Len( aArray ) + LOCAL nSize := Len( ::pItems ) LOCAL oWndSets - LOCAL nWidth LOCAL oCol LOCAL nMaxLen @@ -133,70 +133,62 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbObject oWndSets:lFocused := .T. AAdd( ::aWindows, oWndSets ) - nWidth := oWndSets:nRight - oWndSets:nLeft - 1 - oBrwSets := HBDbBrowser():New( oWndSets:nTop + 1, oWndSets:nLeft + 1, oWndSets:nBottom - 1, oWndSets:nRight - 1 ) - ::ArrayReference := aArray - oBrwSets:autolite := .T. oBrwSets:ColorSpec := __Dbg():ClrModal() oBrwSets:GoTopBlock := {|| ::Arrayindex := 1 } - oBrwSets:GoBottomBlock := {|| ::arrayindex := Len( ::ArrayReference ) } + oBrwSets:GoBottomBlock := {|| ::arrayindex := Len( ::pItems ) } oBrwSets:SkipBlock := {| nSkip, nPos | nPos := ::arrayindex, ; - ::arrayindex := iif( nSkip > 0, Min( ::arrayindex + nSkip, Len( ::arrayReference ) ), ; - Max( 1, ::arrayindex + nSkip ) ), ::arrayindex - nPos } + ::arrayindex := Max( 1, Min( ::arrayindex + nSkip, Len( ::pItems ) ) ), ; + ::arrayindex - nPos } - nMaxLen := ArrayMaxLen( ::AllNames ) - oBrwSets:AddColumn( oCol := HBDbColumnNew( "", ; - {|| PadR( ::ArrayReference[ ::arrayindex, 1 ], nMaxLen ) } ) ) + nMaxLen := 0 + AEval( ::pItems, {| x | nMaxLen := Max( nMaxLen, Len( x[ OMSG_NAME ] ) ) } ) + oBrwSets:AddColumn( oCol := HBDbColumnNew( "", {|| ::pItems[ ::arrayindex, OMSG_NAME ] } ) ) oCol:width := nMaxLen - oCol:ColorBlock := {|| { iif( ::Arrayindex == oBrwSets:Cargo, 2, 1 ), 2 } } + oCol:DefColor := { 1, 2 } oBrwSets:Freeze := 1 - oBrwSets:AddColumn( oCol := HBDbColumnNew( "", {|| iif( HB_ISSTRING( ::ArrayReference[ ::ArrayIndex, 2 ] ) .AND. ! ::ArrayReference[ ::ArrayIndex, 3 ], ; - ::ArrayReference[ ::ArrayIndex, 2 ], ; - PadR( __dbgValToStr( __dbgObjGetValue( ::TheObj, ::ArrayReference[ ::arrayindex, 1 ] ) ), nWidth - 12 ) ) } ) ) + oBrwSets:AddColumn( oCol := HBDbColumnNew( "", {|| iif( ! ::pItems[ ::ArrayIndex, OMSG_EDIT ], ; + ::pItems[ ::ArrayIndex, OMSG_VALUE ], ; + __dbgValToExp( __dbgObjGetValue( ::TheObj, ::pItems[ ::arrayindex, OMSG_NAME ] ) ) ) } ) ) - oBrwSets:Cargo := 1 // Actual highlighted row - oCol:ColorBlock := {|| { iif( ::Arrayindex == oBrwSets:Cargo, 3, 1 ), 3 } } - oCol:width := MaxCol() - 14 - nMaxLen + oCol:DefColor := { 1, 3 } + oCol:width := oWndSets:nRight - oWndSets:nLeft - nMaxLen - 2 oBrwSets:colPos := 2 - ::aWindows[ ::nCurWindow ]:bPainted := {|| oBrwSets:ForceStable() } - ::aWindows[ ::nCurWindow ]:bKeyPressed := {| nKey | ::SetsKeyPressed( nKey, oBrwSets, Len( aArray ), ::ArrayReference ) } - ::aWindows[ ::nCurwindow ]:cCaption := ::objname + " is of class: " + ::TheObj:ClassName() - SetCursor( SC_NONE ) + ::aWindows[ ::nCurWindow ]:bPainted := {|| oBrwSets:ForceStable() } + ::aWindows[ ::nCurWindow ]:bKeyPressed := {| nKey | ::SetsKeyPressed( nKey, oBrwSets ) } + ::aWindows[ ::nCurwindow ]:cCaption := ::objname + " is of class: " + ::TheObj:ClassName() ::aWindows[ ::nCurWindow ]:ShowModal() RETURN Self -METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject +METHOD doGet( oBrowse ) CLASS HBDbObject - LOCAL column + LOCAL oErr LOCAL cValue LOCAL lCanAcc - LOCAL oErr + LOCAL aItemRef // make sure browse is stable oBrowse:forceStable() // if confirming new record, append blank - // get column object from browse - column := oBrowse:getColumn( oBrowse:colPos ) - - // create a corresponding GET - cValue := __dbgObjGetValue( ::TheObj, pitem[ nSet, 1 ], @lCanAcc ) + aItemRef := ::pItems[ ::ArrayIndex ] + cValue := __dbgObjGetValue( ::TheObj, aItemRef[ OMSG_NAME ], @lCanAcc ) IF ! lCanAcc __dbgAlert( cValue ) RETURN NIL ENDIF - cValue := PadR( __dbgValToStr( cValue ), column:Width ) + cValue := __dbgValToExp( cValue ) - IF __dbgInput( Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1,, @cValue, ; - {| cValue | iif( Type( cValue ) == "UE", ( __dbgAlert( "Expression error" ), .F. ), .T. ) } ) + IF __dbgInput( Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1, ; + oBrowse:getColumn( oBrowse:colPos ):Width, @cValue, ; + __dbgExprValidBlock(), __dbgColors()[ 2 ], 256 ) BEGIN SEQUENCE WITH {| oErr | Break( oErr ) } - __dbgObjSetValue( ::TheObj, pitem[ nSet, 1 ], &cValue ) + __dbgObjSetValue( ::TheObj, aItemRef[ OMSG_NAME ], &cValue ) RECOVER USING oErr __dbgAlert( oErr:description ) END SEQUENCE @@ -204,110 +196,75 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject RETURN NIL -METHOD SetsKeyPressed( nKey, oBrwSets, nSets, aArray ) CLASS HBDbObject +METHOD SetsKeyPressed( nKey, oBrwSets ) CLASS HBDbObject - LOCAL nSet := oBrwSets:Cargo + LOCAL aItemRef - DO CASE - CASE nKey == K_UP + SWITCH nKey + CASE K_UP + oBrwSets:Up() + EXIT - IF oBrwSets:Cargo > 1 - oBrwSets:Cargo-- - oBrwSets:RefreshCurrent() - oBrwSets:Up() - oBrwSets:ForceStable() - ENDIF + CASE K_DOWN + oBrwSets:Down() + EXIT - CASE nKey == K_DOWN + CASE K_HOME + CASE K_CTRL_PGUP + CASE K_CTRL_HOME + oBrwSets:GoTop() + EXIT - IF oBrwSets:Cargo < nSets - oBrwSets:Cargo++ - oBrwSets:RefreshCurrent() - oBrwSets:Down() - oBrwSets:ForceStable() - ENDIF + CASE K_END + CASE K_CTRL_PGDN + CASE K_CTRL_END + oBrwSets:GoBottom() + EXIT - CASE nKey == K_HOME .OR. nKey == K_CTRL_PGUP .OR. nKey == K_CTRL_HOME - - IF oBrwSets:Cargo > 1 - oBrwSets:Cargo := 1 - oBrwSets:GoTop() - oBrwSets:ForceStable() - ENDIF - - CASE nKey == K_END .OR. nKey == K_CTRL_PGDN .OR. nKey == K_CTRL_END - - IF oBrwSets:Cargo < nSets - oBrwSets:Cargo := nSets - oBrwSets:GoBottom() - oBrwSets:ForceStable() - ENDIF - - CASE nKey == K_PGUP + CASE K_PGDN + oBrwSets:pageDown() + EXIT + CASE K_PGUP oBrwSets:PageUp() - oBrwSets:Cargo := ::ArrayIndex - oBrwSets:RefreshCurrent() - oBrwSets:ForceStable() + EXIT - CASE nKey == K_PGDN + CASE K_ENTER - oBrwSets:PageDown() - oBrwSets:Cargo := ::ArrayIndex - oBrwSets:RefreshCurrent() - oBrwSets:ForceStable() - - CASE nKey == K_ENTER - - IF nSet == oBrwSets:Cargo - IF HB_ISARRAY( aArray[ nSet, 2 ] ) - IF Len( aArray[ nSet, 2 ] ) > 0 - HBDbArray():New( aArray[ nSet, 2 ], ::pitems[ nSet, 1 ] ) + aItemRef := ::pItems[ ::ArrayIndex ] + IF HB_ISARRAY( aItemRef[ OMSG_VALUE ] ) + IF Len( aItemRef[ OMSG_VALUE ] ) > 0 + HBDbArray():New( aItemRef[ OMSG_VALUE ], aItemRef[ OMSG_NAME ] ) ENDIF - ELSEIF HB_ISHASH( aArray[ nSet, 2 ] ) - IF Len( aArray[ nSet, 2 ] ) > 0 - HBDbHash():New( aArray[ nSet, 2 ], ::pitems[ nSet, 1 ] ) + ELSEIF HB_ISHASH( aItemRef[ OMSG_VALUE ] ) + IF Len( aItemRef[ OMSG_VALUE ] ) > 0 + HBDbHash():New( aItemRef[ OMSG_VALUE ], aItemRef[ OMSG_NAME ] ) ENDIF - ELSEIF HB_ISOBJECT( aArray[ nSet, 2 ] ) - HBDbObject():New( aArray[ nSet, 2 ], ::pitems[ nSet, 1 ] ) - ELSEIF ( HB_ISSTRING( aArray[ nSet, 2 ] ) .AND. ; - ! aArray[ nSet, 3 ] ) .OR. ; - HB_ISBLOCK( aArray[ nSet, 2 ] ) .OR. ; - HB_ISPOINTER( aArray[ nSet, 2 ] ) + ELSEIF HB_ISOBJECT( aItemRef[ OMSG_VALUE ] ) + HBDbObject():New( aItemRef[ OMSG_VALUE ], aItemRef[ OMSG_NAME ] ) + ELSEIF ! aItemRef[ OMSG_EDIT ] .OR. ; + HB_ISBLOCK( aItemRef[ OMSG_VALUE ] ) .OR. ; + HB_ISPOINTER( aItemRef[ OMSG_VALUE ] ) __dbgAlert( "Value cannot be edited" ) ELSE IF ::lEditable oBrwSets:RefreshCurrent() - ::doGet( oBrwSets, ::arrayReference, nSet ) + ::doGet( oBrwSets ) oBrwSets:RefreshCurrent() oBrwSets:ForceStable() ELSE __dbgAlert( "Value cannot be edited" ) ENDIF ENDIF - ENDIF - ENDCASE + ENDSWITCH + + oBrwSets:ForceStable() RETURN NIL -FUNCTION __dbgObject( aArray, cVarName, lEditable ) - RETURN HBDbObject():New( aArray, cVarName, lEditable ) - -STATIC FUNCTION ArrayMaxLen( aArray ) - - LOCAL nMaxLen := 0 - LOCAL nLen - LOCAL cItem - - FOR EACH cItem IN aArray - nLen := Len( cItem ) - IF nMaxLen < nLen - nMaxLen := nLen - ENDIF - NEXT - - RETURN nMaxLen +FUNCTION __dbgObject( oObject, cVarName, lEditable ) + RETURN HBDbObject():New( oObject, cVarName, lEditable ) STATIC FUNCTION __dbgObjGetValue( oObject, cVar, lCanAcc ) diff --git a/src/debug/dbgtwin.prg b/src/debug/dbgtwin.prg index c97cf31eea..6526630344 100644 --- a/src/debug/dbgtwin.prg +++ b/src/debug/dbgtwin.prg @@ -131,8 +131,7 @@ METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) CLASS HBDbWindow METHOD Clear() CLASS HBDbWindow - SetColor( ::cColor ) - hb_Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1 ) + hb_Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1,,, ::cColor ) RETURN NIL @@ -154,8 +153,7 @@ METHOD ScrollUp( nLines ) CLASS HBDbWindow hb_default( @nLines, 1 ) - SetColor( ::cColor ) - hb_Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1, nLines ) + hb_Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1, nLines,, ::cColor ) RETURN NIL @@ -208,15 +206,11 @@ METHOD Refresh() CLASS HBDbWindow METHOD Show( lFocused ) CLASS HBDbWindow - LOCAL nRow := Row() - LOCAL nCol := Col() - hb_default( @lFocused, ::lFocused ) ::cBackImage := SaveScreen( ::nTop, ::nLeft, ::nBottom + iif( ::lShadow, 1, 0 ), ; ::nRight + iif( ::lShadow, 2, 0 ) ) - SetColor( ::cColor ) - hb_Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight ) + hb_Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight,,, ::cColor ) ::SetFocus( lFocused ) IF ::lShadow @@ -226,8 +220,6 @@ METHOD Show( lFocused ) CLASS HBDbWindow ::Refresh() ::lVisible := .T. - SetPos( nRow, nCol ) - RETURN NIL METHOD ShowModal() CLASS HBDbWindow @@ -239,7 +231,7 @@ METHOD ShowModal() CLASS HBDbWindow ::Show() DO WHILE ! lExit - nKey := Inkey( 0, INKEY_ALL ) + nKey := __dbgInkey() IF ::bKeyPressed != NIL Eval( ::bKeyPressed, nKey ) @@ -287,9 +279,9 @@ METHOD Move() CLASS HBDbWindow DO WHILE .T. RestScreen( ,,,, ::cBackImage ) - hb_DispBox( ::nTop, ::nLeft, ::nRight, ::nBottom, Replicate( hb_UTF8ToStrBox( "░" ), 8 ) + " " ) + hb_DispBox( ::nTop, ::nLeft, ::nRight, ::nBottom, Replicate( hb_UTF8ToStrBox( "░" ), 8 ) + " ", ::cColor ) - nKey := Inkey( 0, INKEY_ALL ) + nKey := __dbgInkey() DO CASE CASE nKey == K_UP @@ -334,7 +326,7 @@ METHOD Move() CLASS HBDbWindow ENDIF ENDDO - // hb_keyPut( 0 ); Inkey() + // hb_keySetLast( 0 ) RETURN NIL diff --git a/src/debug/dbgwa.prg b/src/debug/dbgwa.prg index e82af7e879..d8436a0edc 100644 --- a/src/debug/dbgwa.prg +++ b/src/debug/dbgwa.prg @@ -69,32 +69,25 @@ PROCEDURE __dbgShowWorkAreas() LOCAL n1 LOCAL n2 LOCAL n3 := 1 - LOCAL cur_id := 1 + LOCAL cur_id LOCAL nOldArea := Select() - /* We can't determine the last used area, so use 512 here */ - FOR n1 := 1 TO 512 - IF ( n1 )->( Used() ) - AAdd( aAlias, { n1, Alias( n1 ) } ) - IF n1 == nOldArea - cur_id := Len( aAlias ) - ENDIF - ENDIF - NEXT + hb_WAEval( {|| AAdd( aAlias, { select(), Alias() } ) } ) IF Len( aAlias ) == 0 __dbgAlert( "No workareas in use" ) RETURN ENDIF - IF ! Used() + IF ( cur_id := AScan( aAlias, {| x | x[ 1 ] == nOldArea } ) ) == 0 + cur_id := 1 dbSelectArea( aAlias[ 1 ][ 1 ] ) ENDIF /* Window creation */ - oDlg := HBDbWindow():New( 2, 3, 21, 74, "", cColor ) + oDlg := HBDbWindow():New( 2, 3, 21, 76, "", cColor ) oDlg:bKeyPressed := {| nKey | DlgWorkAreaKey( nKey, oDlg, aBrw, aAlias, @aStruc, @aInfo ) } oDlg:bPainted := {|| DlgWorkAreaPaint( oDlg, aBrw ) } @@ -116,11 +109,15 @@ PROCEDURE __dbgShowWorkAreas() oCol:ColorBlock := {|| iif( aAlias[ n1 ][ 1 ] == Select(), { 3, 4 }, { 1, 2 } ) } + IF cur_id > 1 + aBrw[ 1 ]:Configure():MoveCursor( cur_id - 1 ) + ENDIF + /* Info Browse */ aInfo := ( aAlias[ n1 ][ 1 ] )->( DbfInfo() ) - aBrw[ 2 ] := HBDbBrowser():new( oDlg:nTop + 7, oDlg:nLeft + 13, oDlg:nBottom - 1, oDlg:nLeft + 50 ) + aBrw[ 2 ] := HBDbBrowser():new( oDlg:nTop + 7, oDlg:nLeft + 13, oDlg:nBottom - 1, oDlg:nLeft + 52 ) aBrw[ 2 ]:Cargo := ( n2 := 1 ) aBrw[ 2 ]:ColorSpec := oDlg:cColor @@ -131,7 +128,7 @@ PROCEDURE __dbgShowWorkAreas() Max( 1, n2 + nSkip ) ), ; n2 - nPos } - aBrw[ 2 ]:AddColumn( oCol := HBDbColumnNew( "", {|| PadR( aInfo[ n2 ], 38 ) } ) ) + aBrw[ 2 ]:AddColumn( oCol := HBDbColumnNew( "", {|| PadR( aInfo[ n2 ], 40 ) } ) ) oCol:ColorBlock := {|| iif( aAlias[ n1 ][ 1 ] == Select() .AND. n2 == 1, { 3, 4 }, { 1, 2 } ) } @@ -139,7 +136,7 @@ PROCEDURE __dbgShowWorkAreas() aStruc := ( aAlias[ n1 ][ 1 ] )->( dbStruct() ) - aBrw[ 3 ] := HBDbBrowser():new( oDlg:nTop + 1, oDlg:nLeft + 52, oDlg:nBottom - 1, oDlg:nLeft + 70 ) + aBrw[ 3 ] := HBDbBrowser():new( oDlg:nTop + 1, oDlg:nLeft + 54, oDlg:nBottom - 1, oDlg:nLeft + 72 ) aBrw[ 3 ]:Cargo := n3 := 1 aBrw[ 3 ]:ColorSpec := oDlg:cColor @@ -149,10 +146,10 @@ PROCEDURE __dbgShowWorkAreas() aBrw[ 3 ]:Cargo := n3 := iif( nSkip > 0, Min( Len( aStruc ), n3 + nSkip ), ; Max( 1, n3 + nSkip ) ), n3 - nPos } - aBrw[ 3 ]:AddColumn( HBDbColumnNew( "", {|| PadR( aStruc[ n3, 1 ], 11 ) + ; - aStruc[ n3, 2 ] + ; - Str( aStruc[ n3, 3 ], 4 ) + ; - Str( aStruc[ n3, 4 ], 3 ) } ) ) + aBrw[ 3 ]:AddColumn( HBDbColumnNew( "", {|| PadR( aStruc[ n3, 1 ], 10 ) + " " + ; + Padr( aStruc[ n3, 2 ], 1 ) + " " + ; + Str( aStruc[ n3, 3 ], 3 ) + " " + ; + Str( aStruc[ n3, 4 ], 2 ) } ) ) /* Show dialog */ @@ -176,21 +173,21 @@ STATIC PROCEDURE DlgWorkAreaPaint( oDlg, aBrw ) hb_DispOutAtBox( oDlg:nTop, oDlg:nLeft + 12, hb_UTF8ToStrBox( "┬" ), oDlg:cColor ) hb_DispOutAtBox( oDlg:nBottom, oDlg:nLeft + 12, hb_UTF8ToStrBox( "┴" ), oDlg:cColor ) - hb_DispBox( oDlg:nTop + 1, oDlg:nLeft + 51, oDlg:nBottom - 1, oDlg:nLeft + 51, HB_B_SINGLE_UNI, oDlg:cColor ) - hb_DispOutAtBox( oDlg:nTop, oDlg:nLeft + 51, hb_UTF8ToStrBox( "┬" ), oDlg:cColor ) - hb_DispOutAtBox( oDlg:nBottom, oDlg:nLeft + 51, hb_UTF8ToStrBox( "┴" ), oDlg:cColor ) + hb_DispBox( oDlg:nTop + 1, oDlg:nLeft + 53, oDlg:nBottom - 1, oDlg:nLeft + 53, HB_B_SINGLE_UNI, oDlg:cColor ) + hb_DispOutAtBox( oDlg:nTop, oDlg:nLeft + 53, hb_UTF8ToStrBox( "┬" ), oDlg:cColor ) + hb_DispOutAtBox( oDlg:nBottom, oDlg:nLeft + 53, hb_UTF8ToStrBox( "┴" ), oDlg:cColor ) - hb_DispBox( oDlg:nTop + 6, oDlg:nLeft + 13, oDlg:nTop + 6, oDlg:nLeft + 50, HB_B_SINGLE_UNI, oDlg:cColor ) + hb_DispBox( oDlg:nTop + 6, oDlg:nLeft + 13, oDlg:nTop + 6, oDlg:nLeft + 52, HB_B_SINGLE_UNI, oDlg:cColor ) hb_DispOutAtBox( oDlg:nTop + 6, oDlg:nLeft + 12, hb_UTF8ToStrBox( "├" ), oDlg:cColor ) - hb_DispOutAtBox( oDlg:nTop + 6, oDlg:nLeft + 51, hb_UTF8ToStrBox( "┤" ), oDlg:cColor ) + hb_DispOutAtBox( oDlg:nTop + 6, oDlg:nLeft + 53, hb_UTF8ToStrBox( "┤" ), oDlg:cColor ) /* Display labels */ - hb_DispOutAt( oDlg:nTop + 1, oDlg:nLeft + 13, "Alias: Record: ", oDlg:cColor ) - hb_DispOutAt( oDlg:nTop + 2, oDlg:nLeft + 13, " BOF: Deleted: ", oDlg:cColor ) - hb_DispOutAt( oDlg:nTop + 3, oDlg:nLeft + 13, " EOF: Found: ", oDlg:cColor ) - hb_DispOutAt( oDlg:nTop + 4, oDlg:nLeft + 13, "Filter: ", oDlg:cColor ) - hb_DispOutAt( oDlg:nTop + 5, oDlg:nLeft + 13, " Key: ", oDlg:cColor ) + hb_DispOutAt( oDlg:nTop + 1, oDlg:nLeft + 15, "Alias: Record: ", oDlg:cColor ) + hb_DispOutAt( oDlg:nTop + 2, oDlg:nLeft + 15, " BOF: Deleted: ", oDlg:cColor ) + hb_DispOutAt( oDlg:nTop + 3, oDlg:nLeft + 15, " EOF: Found: ", oDlg:cColor ) + hb_DispOutAt( oDlg:nTop + 4, oDlg:nLeft + 15, "Filter: ", oDlg:cColor ) + hb_DispOutAt( oDlg:nTop + 5, oDlg:nLeft + 15, " Key: ", oDlg:cColor ) /* Stabilize browse */ @@ -299,7 +296,6 @@ STATIC PROCEDURE WorkAreasKeyPressed( nKey, oBrw, nTotal ) STATIC FUNCTION DbfInfo( aInfo ) LOCAL nFor - LOCAL xType LOCAL xValue LOCAL cValue @@ -320,39 +316,21 @@ STATIC FUNCTION DbfInfo( aInfo ) FOR nFor := 1 TO FCount() xValue := __Dbg():GetExprValue( "FieldGet(" + hb_ntos( nFor ) + ")" ) - xType := ValType( xValue ) - SWITCH xType + SWITCH ValType( xValue ) CASE "C" CASE "M" cValue := xValue EXIT - CASE "N" - cValue := hb_ntos( xValue ) - EXIT - CASE "D" - cValue := DToC( xValue ) - EXIT - CASE "T" - cValue := hb_TSToStr( xValue ) - EXIT +#ifdef HB_CLP_STRICT CASE "L" - cValue := iif( xValue, ".T.", ".F." ) - EXIT - CASE "A" - cValue := "Array" - EXIT - CASE "H" - cValue := "Hash" - EXIT - CASE "U" - cValue := "NIL" - EXIT + cValue := iif( xValue, "T", "F" ) +#endif OTHERWISE - cValue := "Error" + cValue := __dbgValToStr( xValue ) ENDSWITCH - AAdd( aInfo, Space( 8 ) + PadR( FieldName( nFor ), 10 ) + " = " + PadR( cValue, 17 ) ) + AAdd( aInfo, Space( 8 ) + PadR( FieldName( nFor ), 10 ) + " = " + PadR( cValue, 19 ) ) NEXT @@ -375,12 +353,12 @@ STATIC PROCEDURE UpdateInfo( oDlg, cAlias ) PadR( hb_ntos( RecNo() ) + "/" + hb_ntos( LastRec() ), 9 ), ; oDlg:cColor ) - hb_DispOutAt( oDlg:nTop + 2, oDlg:nLeft + 21, iif( Bof(), "Yes", "No " ), oDlg:cColor ) - hb_DispOutAt( oDlg:nTop + 2, oDlg:nLeft + 38, iif( Deleted(), "Yes", "No " ), oDlg:cColor ) - hb_DispOutAt( oDlg:nTop + 3, oDlg:nLeft + 21, iif( Eof(), "Yes", "No " ), oDlg:cColor ) - hb_DispOutAt( oDlg:nTop + 3, oDlg:nLeft + 38, iif( Found(), "Yes", "No " ), oDlg:cColor ) - hb_DispOutAt( oDlg:nTop + 4, oDlg:nLeft + 21, PadR( dbFilter(), 29 ), oDlg:cColor ) - hb_DispOutAt( oDlg:nTop + 5, oDlg:nLeft + 21, PadR( ordKey(), 29 ), oDlg:cColor ) + hb_DispOutAt( oDlg:nTop + 2, oDlg:nLeft + 23, iif( Bof(), "Yes", "No " ), oDlg:cColor ) + hb_DispOutAt( oDlg:nTop + 2, oDlg:nLeft + 40, iif( Deleted(), "Yes", "No " ), oDlg:cColor ) + hb_DispOutAt( oDlg:nTop + 3, oDlg:nLeft + 23, iif( Eof(), "Yes", "No " ), oDlg:cColor ) + hb_DispOutAt( oDlg:nTop + 3, oDlg:nLeft + 40, iif( Found(), "Yes", "No " ), oDlg:cColor ) + hb_DispOutAt( oDlg:nTop + 4, oDlg:nLeft + 23, PadR( dbFilter(), 29 ), oDlg:cColor ) + hb_DispOutAt( oDlg:nTop + 5, oDlg:nLeft + 23, PadR( ordKey(), 29 ), oDlg:cColor ) dbSelectArea( nOldArea ) diff --git a/src/debug/debugger.prg b/src/debug/debugger.prg index f2c125323a..cd2d7d1cb2 100644 --- a/src/debug/debugger.prg +++ b/src/debug/debugger.prg @@ -52,17 +52,6 @@ * */ -/* - * The following parts are Copyright of the individual authors. - * www - http://harbour-project.org - * - * Copyright 2007 Przemyslaw Czerpak - * __dbgCStr() - * - * See COPYING.txt for licensing terms. - * - */ - /* NOTE: Don't use SAY/DevOut()/DevPos() for screen output, otherwise the debugger output may interfere with the applications output redirection, and is also slower. [vszakats] */ @@ -391,12 +380,7 @@ METHOD New() CLASS HBDebugger ::oPullDown := __dbgBuildMenu( Self ) ::oWndCode := HBDbWindow():New( 1, 0, ::nMaxRow - 6, ::nMaxCol ) - ::oWndCode:Cargo := { ::oWndCode:nTop, ::oWndCode:nLeft } ::oWndCode:bKeyPressed := {| nKey | ::CodeWindowProcessKey( nKey ) } - ::oWndCode:bGotFocus := {|| ::oGetCommand:SetFocus() } - ::oWndCode:bLostFocus := {|| ::oGetCommand:KillFocus(), SetCursor( SC_NONE ), ; - ::oWndCode:Cargo[ 1 ] := Row(), ; - ::oWndCode:Cargo[ 2 ] := Col() } AAdd( ::aWindows, ::oWndCode ) @@ -492,10 +476,7 @@ METHOD BarDisplay() CLASS HBDebugger DispBegin() - SetColor( cClrItem ) - - hb_Scroll( ::nMaxRow, 0, ::nMaxRow, ::nMaxCol ) - + hb_Scroll( ::nMaxRow, 0, ::nMaxRow, ::nMaxCol,,, cClrItem ) hb_DispOutAt( ::nMaxRow, 0, "F1-Help F2-Zoom F3-Repeat F4-User F5-Go F6-WA F7-Here F8-Step F9-BkPt F10-Trace", cClrItem ) hb_DispOutAt( ::nMaxRow, 0, "F1", cClrHotKey ) hb_DispOutAt( ::nMaxRow, 8, "F2", cClrHotKey ) @@ -543,8 +524,6 @@ METHOD BuildCommandWindow() CLASS HBDebugger ::oWndCommand := HBDbWindow():New( ::nMaxRow - 5, 0, ::nMaxRow - 1, ::nMaxCol, "Command" ) - ::oWndCommand:bGotFocus := {|| ::oGetCommand:SetFocus() } - ::oWndCommand:bLostFocus := {|| ::oGetCommand:KillFocus(), SetCursor( SC_NONE ) } ::oWndCommand:bKeyPressed := {| nKey | ::CommandWindowProcessKey( nKey ) } ::oWndCommand:bPainted := {|| ::CommandWindowDisplay(), ; hb_DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, ; @@ -558,7 +537,7 @@ METHOD BuildCommandWindow() CLASS HBDebugger nSize := ::oWndCommand:nRight - ::oWndCommand:nLeft - 3 ::oGetCommand := HbDbInput():new( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 3, ; - nSize, "", __dbgColors()[ 2 ], Max( nSize, 256 ) ) + nSize, "", __dbgColors()[ 2 ], Max( nSize, 256 ) ) RETURN NIL @@ -684,9 +663,6 @@ METHOD CodeWindowProcessKey( nKey ) CLASS HBDebugger CASE K_CTRL_HOME ::oBrwText:GoTop() - IF ::oWndCode:lFocused - SetCursor( SC_SPECIAL1 ) - ENDIF EXIT CASE K_CTRL_PGDN @@ -695,10 +671,6 @@ METHOD CodeWindowProcessKey( nKey ) CLASS HBDebugger ::oBrwText:GoBottom() ::oBrwText:nCol := ::oWndCode:nLeft + 1 ::oBrwText:nFirstCol := ::oWndCode:nLeft + 1 - SetPos( Row(), ::oWndCode:nLeft + 1 ) - IF ::oWndCode:lFocused - SetCursor( SC_SPECIAL1 ) - ENDIF EXIT CASE K_HOME @@ -780,6 +752,7 @@ METHOD Colors() CLASS HBDebugger oWndColors:bKeyPressed := {| nKey | SetsKeyPressed( nKey, oBrwColors, ; Len( aColors ), oWndColors, "Debugger Colors", ; {|| ::EditColor( oBrwColors:Cargo[ 1 ], oBrwColors ) } ) } + oWndColors:ShowModal() ::LoadColors() @@ -912,10 +885,8 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger ::Inspect( aCmnd[ WP_EXPR ], cResult ) ENDIF cResult := "" // discard result - ELSE - IF lValid - cResult := __dbgValToStr( cResult ) - ENDIF + ELSEIF lValid + cResult := __dbgValToStr( cResult ) ENDIF ::RefreshVars() @@ -923,7 +894,6 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger IF ::lActive ::lAnimate := .T. ::Animate() - SetCursor( SC_NORMAL ) ENDIF CASE cCommand == "BP" @@ -962,7 +932,6 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger CASE cCommand == "DOS" ::OsShell() - SetCursor( SC_NORMAL ) CASE starts( "FILE", cCommand ) cParam := Upper( cParam ) @@ -1139,9 +1108,7 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger ENDCASE CASE starts( "OUTPUT", cCommand, 4 ) - SetCursor( SC_NONE ) ::ShowAppScreen() - SetCursor( SC_NORMAL ) CASE starts( "POINT", cCommand ) cParam := Upper( cParam ) @@ -1267,8 +1234,9 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger ::lWindowsAutoSized := .F. ENDIF ENDIF - CASE starts( "ZOOM", cParam ) .OR. starts( "ICONIZE", cParam) ; - .OR. starts( "TILE", cParam ) + CASE starts( "ZOOM", cParam ) .OR. ; + starts( "ICONIZE", cParam) .OR. ; + starts( "TILE", cParam ) ::NotSupported() OTHERWISE cResult := "Command error" @@ -1307,7 +1275,8 @@ METHOD DoScript( cFileName ) CLASS HBDebugger nLen := MLCount( cInfo, 16384, NIL, .F., .T. ) FOR n := 1 TO nLen cLine := AllTrim( MemoLine( cInfo, 16384, n, NIL, .F., .T. ) ) - IF ::lActive .OR. ( ( nPos := At( " ", cLine ) ) > 0 .AND. starts( "OPTIONS", Upper( Left( cLine, nPos - 1 ) ) ) ) + IF ::lActive .OR. ( ( nPos := At( " ", cLine ) ) > 0 .AND. ; + starts( "OPTIONS", Upper( Left( cLine, nPos - 1 ) ) ) ) // In inactive debugger, only "OPTIONS" commands can be executed safely ::DoCommand( cLine ) ENDIF @@ -1320,7 +1289,7 @@ METHOD DoScript( cFileName ) CLASS HBDebugger METHOD EditColor( nColor, oBrwColors ) CLASS HBDebugger LOCAL cColor := PadR( '"' + ::aColors[ nColor ] + '"', ; - oBrwColors:getColumn( 2 ):Width ) + oBrwColors:getColumn( 2 ):Width ) oBrwColors:RefreshCurrent() oBrwColors:ForceStable() @@ -1339,16 +1308,16 @@ METHOD EditColor( nColor, oBrwColors ) CLASS HBDebugger METHOD EditSet( nSet, oBrwSets ) CLASS HBDebugger - LOCAL cSet := PadR( __dbgValToStr( Set( nSet ) ), oBrwSets:getColumn( 2 ):Width ) - LOCAL cType := ValType( Set( nSet ) ) + LOCAL cSet := __dbgValToExp( Set( nSet ) ) + LOCAL cType := ValType( Set( nSet ) ) oBrwSets:RefreshCurrent() oBrwSets:ForceStable() - IF __dbgInput( Row(), Col() + 13,, @cSet, ; - {| cSet | iif( !( Type( cSet ) == cType ), ; - ( __dbgAlert( "Must be of type '" + cType + "'" ), .F. ), .T. ) }, ; - SubStr( ::ClrModal(), 5 ) ) + IF __dbgInput( Row(), Col() + 13, oBrwSets:getColumn( 2 ):Width, @cSet, ; + {| cSet | Type( cSet ) == cType .OR. ; + ( __dbgAlert( "Must be of type '" + cType + "'" ), .F. ) }, ; + SubStr( ::ClrModal(), 5 ), 256 ) Set( nSet, &cSet ) ENDIF @@ -1367,34 +1336,18 @@ METHOD EditVar( nVar ) CLASS HBDebugger uVarValue := ::VarGetValue( ::aVars[ nVar ] ) - IF ValType( uVarValue ) $ "AHOP" - ::InputBox( cVarName, uVarValue, NIL, .F. ) + IF ValType( uVarValue ) $ "AHOPB" + ::InputBox( cVarName, uVarValue,, .F. ) ELSE - cVarStr := ::InputBox( cVarName, __dbgValToStr( uVarValue ), ; - {| u | iif( Type( u ) == "UE", ( __dbgAlert( "Expression error" ), .F. ), .T. ) } ) - ENDIF + cVarStr := ::InputBox( cVarName, __dbgValToExp( uVarValue ), __dbgExprValidBlock() ) - IF LastKey() != K_ESC - - DO CASE - CASE cVarStr == "{ ... }" - // aArray := ::VarGetValue( ::aVars[ nVar ] ) - IF Len( uVarValue ) > 0 - __dbgArrays( uVarValue, cVarName ) - ELSE - __dbgAlert( "Array is empty" ) - ENDIF - - CASE Upper( Left( cVarStr, 5 ) ) == "CLASS" - __dbgObject( uVarValue, cVarName ) - - OTHERWISE + IF LastKey() != K_ESC BEGIN SEQUENCE WITH {| oErr | Break( oErr ) } ::VarSetValue( ::aVars[ nVar ], &cVarStr ) RECOVER USING oErr __dbgAlert( oErr:description ) END SEQUENCE - ENDCASE + ENDIF ENDIF ::oBrwVars:RefreshCurrent() @@ -1427,7 +1380,8 @@ METHOD GetExprValue( xExpr, lValid ) CLASS HBDebugger xResult := oErr:operation + ": " + oErr:description IF HB_ISARRAY( oErr:args ) xResult += "; arguments:" - AEval( oErr:args, {| x | xResult += " " + AllTrim( __dbgCStr( x ) ) } ) + AEval( oErr:args, {| x, i | xResult += iif( i == 1, " ", ", " ) + ; + AllTrim( __dbgValToStr( x ) ) } ) ENDIF lValid := .F. END SEQUENCE @@ -1468,41 +1422,7 @@ METHOD Go() CLASS HBDebugger METHOD GotoLine( nLine ) CLASS HBDebugger - LOCAL nRow - LOCAL nCol - - /* - IF ::oBrwVars != NIL - ::ShowVars() - ENDIF - */ - ::oBrwText:GotoLine( nLine ) - nRow := Row() - nCol := Col() - - // no source code line stored yet - - /* - IF ::oBrwStack != NIL .AND. Len( ::aCallStack ) > 0 .AND. ; - ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] == NIL - ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] := nLine - ENDIF - */ - - IF ::oWndStack != NIL .AND. ! ::oBrwStack:Stable - ::oBrwStack:ForceStable() - ENDIF - - IF ::oWndCode:lFocused .AND. SetCursor() != SC_SPECIAL1 - SetPos( nRow, nCol ) - SetCursor( SC_SPECIAL1 ) - ENDIF - SetPos( nRow, nCol ) - - // Store cursor position to be restored by ::oWndCode:bGotFocus - ::oWndCode:cargo[ 1 ] := nRow - ::oWndCode:cargo[ 2 ] := nCol RETURN NIL @@ -1531,7 +1451,17 @@ METHOD HandleEvent() CLASS HBDebugger DO WHILE ! ::lEnd - nKey := Inkey( 0, INKEY_ALL ) + IF ::oWndCommand:lFocused + ::oGetCommand:showCursor() + ELSEIF ::oWndCode:lFocused .AND. ::oBrwText != NIL + ::oBrwText:ForceStable() + SetCursor( SC_SPECIAL1 ) + ELSE + SetCursor( SC_NONE ) + ENDIF + nKey := __dbgInkey() + SetCursor( SC_NONE ) + IF nKey == K_ALT_X t_oDebugger:Quit() ELSEIF ::oPullDown:IsOpen() @@ -1566,12 +1496,6 @@ METHOD HandleEvent() CLASS HBDebugger IF MRow() == 0 IF ( nPopup := ::oPullDown:GetItemOrdByCoors( 0, MCol() ) ) != 0 - IF ! ::oPullDown:IsOpen() - IF ::oWndCode:lFocused - Eval( ::oWndCode:bLostFocus ) - ENDIF - SetCursor( SC_NONE ) - ENDIF ::oPullDown:ShowPopup( nPopup ) ENDIF @@ -1627,10 +1551,21 @@ METHOD HandleEvent() CLASS HBDebugger ::aWindows[ ::nCurrentWindow ]:KeyPressed( nKey ) EXIT + CASE K_ALT_G /* Grow active window */ + CASE K_ALT_S /* Shrink active window */ + CASE K_ALT_U /* Move the border between Command and Code windows Up */ + CASE K_ALT_D /* Move the border between Command and Code windows Down */ + ::NotSupported() + EXIT + CASE K_F1 ::ShowHelp() EXIT + CASE K_F2 + ::NotSupported() + EXIT + CASE K_F4 ::ShowAppScreen() EXIT @@ -1681,6 +1616,7 @@ METHOD HandleEvent() CLASS HBDebugger RETURN NIL + METHOD Hide() CLASS HBDebugger ::CloseDebuggerWindow() @@ -1734,10 +1670,6 @@ METHOD HideVars() CLASS HBDebugger IF ::oBrwText != NIL ::oBrwText:Resize( ::oWndCode:nTop + 1 ) ENDIF - IF ::oWndCode:lFocused - ::oWndCode:cargo[ 1 ] := Row() - ::oWndCode:cargo[ 2 ] := Col() - ENDIF IF ::aWindows[ ::nCurrentWindow ] == ::oWndVars ::NextWindow() @@ -1755,31 +1687,23 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger LOCAL cType := ValType( uValue ) LOCAL nWidth := nRight - nLeft - 1 LOCAL uTemp - LOCAL nOldCursor - LOCAL nOldRow - LOCAL nOldCol LOCAL lExit - LOCAL oWndInput := HBDbWindow():New( nTop, nLeft, nBottom, nRight, cMsg, ; - ::oPullDown:cClrPopup ) - - hb_default( @lEditable, .T. ) + LOCAL oWndInput + oWndInput := HBDbWindow():New( nTop, nLeft, nBottom, nRight, cMsg, ; + ::oPullDown:cClrPopup ) oWndInput:lShadow := .T. oWndInput:Show() - nOldCursor := SetCursor() - nOldRow := Row() - nOldCol := Col() - uTemp := uValue - IF lEditable + IF hb_defaultValue( lEditable, .T. ) - IF !( cType == "C" ) .OR. Len( uValue ) < nWidth + IF ! cType == "C" .OR. Len( uValue ) < nWidth uTemp := PadR( uValue, nWidth ) ENDIF __dbgInput( nTop + 1, nLeft + 1, nWidth, @uTemp, bValid, ; - __dbgColors()[ 5 ], Max( Max( nWidth, Len( uTemp ) ), 256 ) ) + __dbgColors()[ 5 ], Max( Max( nWidth, Len( uTemp ) ), 256 ) ) SWITCH cType CASE "C" ; uTemp := AllTrim( uTemp ) ; EXIT CASE "D" ; uTemp := CToD( uTemp ) ; EXIT @@ -1788,14 +1712,15 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger ELSE - hb_DispOutAt( nTop + 1, nLeft + 1, __dbgValToStr( uValue ), "," + __dbgColors()[ 5 ] ) + hb_DispOutAt( nTop + 1, nLeft + 1, left( __dbgValToStr( uValue ), nRight - nLeft - 1 ), ; + __dbgColors()[ 2 ] + "," + __dbgColors()[ 5 ] ) SetPos( nTop + 1, nLeft + 1 ) lExit := .F. DO WHILE ! lExit - SWITCH Inkey( 0, INKEY_ALL ) + SWITCH __dbgInkey() CASE K_ESC lExit := .T. EXIT @@ -1809,21 +1734,18 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger ELSE __dbgArrays( uValue, cMsg ) ENDIF - EXIT + LOOP CASE "H" IF Len( uValue ) == 0 __dbgAlert( "Hash is empty" ) ELSE __dbgHashes( uValue, cMsg ) ENDIF - EXIT + LOOP CASE "O" __dbgObject( uValue, cMsg ) - EXIT - OTHERWISE - __dbgAlert( "Value cannot be edited" ) + LOOP ENDSWITCH - EXIT OTHERWISE __dbgAlert( "Value cannot be edited" ) @@ -1833,9 +1755,6 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger ENDIF - SetCursor( nOldCursor ) - SetPos( nOldRow, nOldCol ) - oWndInput:Hide() RETURN uTemp @@ -1843,7 +1762,7 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger METHOD Inspect( uValue, cValueName ) CLASS HBDebugger - uValue := ::InputBox( uValue, cValueName,, .F. ) + ::InputBox( uValue, cValueName,, .F. ) RETURN NIL @@ -2078,7 +1997,6 @@ METHOD Locate( nMode, cValue ) CLASS HBDebugger hb_default( @nMode, 0 ) IF Empty( cValue ) - ::cSearchString := PadR( ::cSearchString, 256 ) cValue := ::InputBox( "Search string", ::cSearchString ) IF Empty( cValue ) RETURN NIL @@ -2089,10 +2007,6 @@ METHOD Locate( nMode, cValue ) CLASS HBDebugger lFound := ::oBrwText:Search( ::cSearchString, ::lCaseSensitive, nMode ) - // Save cursor position to be restored by ::oWndCode:bGotFocus - ::oWndCode:cargo[ 1 ] := Row() - ::oWndCode:cargo[ 2 ] := Col() - RETURN lFound @@ -2170,8 +2084,7 @@ METHOD Open() CLASS HBDebugger CASE 0 RETURN NIL CASE 1 - cFileName := ::InputBox( "Please enter the filename", Space( 255 ) ) - cFileName := AllTrim( cFileName ) + cFileName := AllTrim( ::InputBox( "Please enter the filename" ) ) EXIT OTHERWISE cFileName := aFiles[ nFileName ] @@ -2212,10 +2125,6 @@ METHOD OpenMenu( cName ) CLASS HBDebugger RETURN .F. ENDIF IF ::oPullDown:nOpenPopup != nPopup - IF ::oWndCode:lFocused - Eval( ::oWndCode:bLostFocus ) - ENDIF - SetCursor( SC_NONE ) ::oPullDown:ShowPopup( nPopup ) ENDIF @@ -2268,7 +2177,7 @@ METHOD OSShell() CLASS HBDebugger SetColor( "W/N" ) CLS QOut( "Type 'exit' to RETURN to the Debugger" ) - SetCursor( SC_NORMAL ) + SetCursor( SC_NORMAL ) // standard cursor for OS shell BEGIN SEQUENCE WITH {| objErr | Break( objErr ) } @@ -2279,7 +2188,7 @@ METHOD OSShell() CLASS HBDebugger #elif defined( __PLATFORM__UNIX ) hb_run( GetEnv( "SHELL" ) ) #else - __dbgAlert( "Not implemented yet!" ) + ::NotSupported() #endif RECOVER USING oE @@ -2437,10 +2346,6 @@ METHOD ResizeWindows( oWindow ) CLASS HBDebugger ENDIF ::oWndCode:Resize( nTop ) - IF ::oWndCode:lFocused - ::oWndCode:cargo[ 1 ] := Row() - ::oWndCode:cargo[ 2 ] := Col() - ENDIF IF oWindow2 != NIL .AND. lVisible2 oWindow2:Show() @@ -2651,11 +2556,7 @@ METHOD SaveSettings( cFileName ) CLASS HBDebugger METHOD SearchLine() CLASS HBDebugger - LOCAL cLine := ::InputBox( "Line number", "1" ) - - IF Val( cLine ) > 0 - ::GotoLine ( Val( cLine ) ) - ENDIF + ::GotoLine( Max( 1, ::InputBox( "Line number", 1 ) ) ) RETURN NIL @@ -2666,7 +2567,7 @@ METHOD Show() CLASS HBDebugger ::oPullDown:Display() ::oWndCode:Show( .T. ) ::oWndCommand:Show() - hb_DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, ">" ) + hb_DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, ">", __dbgColors()[ 2 ] ) ::BarDisplay() @@ -2686,9 +2587,9 @@ METHOD ShowAppScreen() CLASS HBDebugger ::CloseDebuggerWindow() IF LastKey() == K_LBUTTONDOWN - Inkey( 0, INKEY_ALL ) + __dbgInkey() ENDIF - DO WHILE Inkey( 0, INKEY_ALL ) == K_MOUSEMOVE + DO WHILE __dbgInkey() == K_MOUSEMOVE ENDDO ::OpenDebuggerWindow() @@ -2702,8 +2603,6 @@ METHOD ShowCallStack() CLASS HBDebugger IF ::oWndStack == NIL - SetCursor( SC_NONE ) - DispBegin() // Resize code window ::oWndCode:Resize( ,,, ::oWndCode:nRight - 16 ) @@ -2739,7 +2638,6 @@ METHOD ShowCallStack() CLASS HBDebugger ::oWndStack:bPainted := {|| ::oBrwStack:ColorSpec := __dbgColors()[ 2 ] + "," + ; __dbgColors()[ 5 ] + "," + __dbgColors()[ 4 ] + "," + __dbgColors()[ 6 ], ; ::oBrwStack:RefreshAll(), ::oBrwStack:ForceStable() } - ::oWndStack:bGotFocus := {|| SetCursor( SC_NONE ) } ::oWndStack:Show( .F. ) ENDIF @@ -2825,10 +2723,7 @@ METHOD ShowCodeLine( nProc ) CLASS HBDebugger METHOD ShowHelp( nTopic ) CLASS HBDebugger - LOCAL nCursor := SetCursor( SC_NONE ) - __dbgHelp( nTopic ) - SetCursor( nCursor ) RETURN NIL @@ -3062,7 +2957,7 @@ METHOD DeleteBreakPoint( cPos ) CLASS HBDebugger LOCAL nAt IF Empty( cPos ) - cPos := AllTrim( ::InputBox( "Item number to delete", 0 ) ) + cPos := AllTrim( ::InputBox( "Item number to delete", "0" ) ) IF LastKey() == K_ESC cPos := "" ENDIF @@ -3111,8 +3006,7 @@ METHOD TracepointAdd( cExpr ) CLASS HBDebugger LOCAL aWatch IF cExpr == NIL - cExpr := Space( 255 ) - cExpr := AllTrim( ::InputBox( "Enter Tracepoint", cExpr ) ) + cExpr := AllTrim( ::InputBox( "Enter Tracepoint",, __dbgExprValidBlock() ) ) IF LastKey() == K_ESC RETURN Self ENDIF @@ -3134,17 +3028,22 @@ METHOD TracepointAdd( cExpr ) CLASS HBDebugger METHOD VarGetInfo( aVar ) CLASS HBDebugger LOCAL uValue := ::VarGetValue( aVar ) + LOCAL cType SWITCH Left( aVar[ VAR_TYPE ], 1 ) - CASE "G" ; RETURN aVar[ VAR_NAME ] + " : " + __dbgValToStr( uValue ) - CASE "L" ; RETURN aVar[ VAR_NAME ] + " : " + __dbgValToStr( uValue ) - CASE "S" ; RETURN aVar[ VAR_NAME ] + " : " + __dbgValToStr( uValue ) - OTHERWISE; RETURN aVar[ VAR_NAME ] + " <" + aVar[ VAR_TYPE ] + ", " + ValType( uValue ) + ">: " + __dbgValToStr( uValue ) + CASE "G" + cType := "Global" + EXIT + CASE "L" + cType := "Local" + EXIT + CASE "S" + cType := "Static" + EXIT + OTHERWISE + cType := aVar[ VAR_TYPE ] ENDSWITCH - - // Never reached - - RETURN "" + RETURN aVar[ VAR_NAME ] + " <" + cType + ", " + ValType( uValue ) + ">: " + __dbgValToStr( uValue ) METHOD VarGetValue( aVar ) CLASS HBDebugger @@ -3216,7 +3115,7 @@ METHOD ViewSets() CLASS HBDebugger AAdd( oBrwSets:Cargo[ 2 ], aSets ) ocol:defcolor := { 1, 2 } oBrwSets:AddColumn( oCol := HBDbColumnNew( "", ; - {|| PadR( __dbgValToStr( Set( oBrwSets:cargo[ 1 ] ) ), nWidth - 13 ) } ) ) + {|| PadR( __dbgValToExp( Set( oBrwSets:cargo[ 1 ] ) ), nWidth - 13 ) } ) ) ocol:defcolor := { 1, 3 } ocol:width := 40 oWndSets:bPainted := {|| oBrwSets:ForceStable(), RefreshVarsS( oBrwSets ) } @@ -3224,7 +3123,6 @@ METHOD ViewSets() CLASS HBDebugger oWndSets, "System Settings", ; {|| ::EditSet( oBrwSets:Cargo[ 1 ], oBrwSets ) } ) } - SetCursor( SC_NONE ) oWndSets:ShowModal() RETURN NIL @@ -3245,9 +3143,8 @@ METHOD WatchGetInfo( nWatch ) CLASS HBDebugger cType := ValType( xVal ) xVal := __dbgValToStr( xVal ) ELSE - // xVal contains error description cType := "U" - // xVal := "Undefined" + xVal := "Undefined" ENDIF RETURN aWatch[ WP_EXPR ] + " <" + aWatch[ WP_TYPE ] + ", " + cType + ">: " + xVal @@ -3258,10 +3155,7 @@ METHOD WatchpointAdd( cExpr ) CLASS HBDebugger LOCAL aWatch IF cExpr == NIL - - cExpr := Space( 255 ) - cExpr := AllTrim( ::InputBox( "Enter Watchpoint", cExpr ) ) - + cExpr := ::InputBox( "Enter Watchpoint",, __dbgExprValidBlock() ) IF LastKey() == K_ESC RETURN Self ENDIF @@ -3287,19 +3181,20 @@ METHOD WatchpointDel( nPos ) CLASS HBDebugger IF nPos == NIL // called from the menu nPos := ::InputBox( "Enter item number to delete", ::oBrwPnt:cargo[ 1 ] - 1 ) + IF LastKey() == K_ESC + nPos := -1 + ENDIF ELSE nPos-- ENDIF - IF LastKey() != K_ESC - IF nPos >= 0 .AND. nPos < Len( ::aWatch ) - ::oBrwPnt:gotop() - __dbgDelWatch( ::pInfo, nPos ) - hb_ADel( ::aWatch, nPos + 1, .T. ) - IF Len( ::aWatch ) == 0 - ::WatchpointsHide() - ELSE - ::WatchpointsShow() - ENDIF + IF nPos >= 0 .AND. nPos < Len( ::aWatch ) + ::oBrwPnt:gotop() + __dbgDelWatch( ::pInfo, nPos ) + hb_ADel( ::aWatch, nPos + 1, .T. ) + IF Len( ::aWatch ) == 0 + ::WatchpointsHide() + ELSE + ::WatchpointsShow() ENDIF ENDIF ENDIF @@ -3312,9 +3207,7 @@ METHOD WatchpointEdit( nPos ) CLASS HBDebugger LOCAL cExpr LOCAL aWatch - cExpr := PadR( ::aWatch[ nPos ][ WP_EXPR ], 255 ) - cExpr := AllTrim( ::InputBox( "Enter Watchpoint", cExpr ) ) - + cExpr := ::InputBox( "Enter Watchpoint", ::aWatch[ nPos ][ WP_EXPR ], __dbgExprValidBlock() ) IF LastKey() == K_ESC RETURN Self ENDIF @@ -3416,10 +3309,9 @@ METHOD WatchpointsShow() CLASS HBDebugger oCol := HBDbColumnNew( "", ; {|| PadR( iif( Len( ::aWatch ) > 0, ; - hb_ntos( ::oBrwPnt:Cargo[ 1 ] - 1 ) + ") " + ; - ::WatchGetInfo( Max( ::oBrwPnt:Cargo[ 1 ], 1 ) ), ; - " " ), ; - ::oWndPnt:nWidth() - 2 ) } ) + hb_ntos( ::oBrwPnt:Cargo[ 1 ] - 1 ) + ") " + ; + ::WatchGetInfo( Max( ::oBrwPnt:Cargo[ 1 ], 1 ) ), ; + " " ), ::oWndPnt:nWidth() - 2 ) } ) ::oBrwPnt:AddColumn( oCol ) AAdd( ::oBrwPnt:Cargo[ 2 ], ::aWatch ) oCol:DefColor := { 1, 2 } @@ -3611,9 +3503,12 @@ STATIC FUNCTION starts( cLine, cStart, nMin ) ( nMin == NIL .OR. Len( cStart ) >= nMin ) +FUNCTION __dbgExprValidBlock() + RETURN {| u | ! Type( u ) == "UE" .OR. ( __dbgAlert( "Expression error" ), .F. ) } + + FUNCTION __dbgInput( nRow, nCol, nWidth, cValue, bValid, cColor, nSize ) - LOCAL nOldCursor := SetCursor( SC_NORMAL ) LOCAL lOK := .F. LOCAL nKey LOCAL oGet @@ -3622,10 +3517,12 @@ FUNCTION __dbgInput( nRow, nCol, nWidth, cValue, bValid, cColor, nSize ) nWidth := Len( cValue ) ENDIF oGet := HbDbInput():new( nRow, nCol, nWidth, cValue, cColor, nSize ) - oGet:setFocus() + + oGet:display() DO WHILE .T. - nKey := Inkey( 0, INKEY_ALL ) + oGet:showCursor() + nKey := __dbgInkey() DO CASE CASE nKey == K_ESC EXIT @@ -3640,7 +3537,7 @@ FUNCTION __dbgInput( nRow, nCol, nWidth, cValue, bValid, cColor, nSize ) ENDCASE ENDDO - SetCursor( nOldCursor ) + SetCursor( SC_NONE ) RETURN lOK @@ -3653,7 +3550,7 @@ FUNCTION __dbgAChoice( nTop, nLeft, nBottom, nRight, aItems, cColors ) LOCAL nLen oBrw := HBDbBrowser():New( nTop, nLeft, nBottom, nRight ) - oBrw:colorSpec := iif( HB_ISSTRING( cColors ), cColors, SetColor() ) + oBrw:colorSpec := cColors nLen := nRight - nLeft + 1 nRow := 1 oCol := HBDbColumnNew( "", {|| PadR( aItems[ nRow ], nLen ) } ) @@ -3665,7 +3562,7 @@ FUNCTION __dbgAChoice( nTop, nLeft, nBottom, nRight, aItems, cColors ) nRow += n, n } DO WHILE .T. oBrw:forceStable() - SWITCH Inkey( 0, INKEY_ALL ) + SWITCH __dbgInkey() CASE K_UP; oBrw:up(); EXIT CASE K_DOWN; oBrw:down(); EXIT CASE K_PGUP; oBrw:pageUp(); EXIT @@ -3684,20 +3581,43 @@ FUNCTION __dbgAlert( cMessage ) RETURN hb_gtAlert( cMessage, { "Ok" }, "W+/R", "W+/B" ) +FUNCTION __dbgInkey() + + LOCAL nKey + LOCAL lDebug, lCancel + + lDebug := Set( _SET_DEBUG, .F. ) + lCancel := Set( _SET_CANCEL, .F. ) + nKey := Inkey( 0, INKEY_ALL ) + Set( _SET_CANCEL, lCancel ) + Set( _SET_DEBUG, lDebug ) + + RETURN nKey + + FUNCTION __dbgValToStr( uVal ) SWITCH ValType( uVal ) - CASE "B" ; RETURN "{|| ... }" - CASE "A" ; RETURN "{ ... }" +#ifdef HB_CLP_STRICT CASE "C" CASE "M" ; RETURN '"' + uVal + '"' - CASE "L" ; RETURN iif( uVal, ".T.", ".F." ) CASE "D" ; RETURN DToC( uVal ) CASE "T" ; RETURN hb_TToC( uVal ) - CASE "N" ; RETURN Str( uVal ) + CASE "O" ; RETURN "{ ... }" +#else + CASE "C" + CASE "M" ; RETURN hb_StrToExp( uVal ) + CASE "D" ; RETURN Left( hb_TSToStr( uVal, .F. ), 10 ) + CASE "T" ; RETURN hb_TSToStr( uVal, .T. ) CASE "O" ; RETURN "Class " + uVal:ClassName() + " object" - CASE "H" ; RETURN "Hash of " + hb_ntos( Len( uVal ) ) + " elements" - CASE "P" ; RETURN "Pointer" +#endif + CASE "N" ; RETURN Str( uVal ) + CASE "L" ; RETURN iif( uVal, ".T.", ".F." ) + CASE "S" ; RETURN "@" + uVal:name + "()" + CASE "B" ; RETURN "{|| ... }" + CASE "A" ; RETURN "{ ... }" + CASE "H" ; RETURN "{ => }" + CASE "P" ; RETURN "" OTHERWISE IF uVal == NIL RETURN "NIL" @@ -3707,29 +3627,33 @@ FUNCTION __dbgValToStr( uVal ) RETURN "U" -/* NOTE: This is a copy of hb_CStr() */ +FUNCTION __dbgValToExp( uVal ) -FUNCTION __dbgCStr( xVal ) - - LOCAL v := ValType( xVal ) - - SWITCH v + SWITCH ValType( uVal ) +#ifdef HB_CLP_STRICT CASE "C" - CASE "M" ; RETURN xVal - CASE "N" ; RETURN Str( xVal ) - CASE "D" ; RETURN iif( Empty( xVal ), "0d00000000", "0d" + DToS( xVal ) ) - CASE "T" ; RETURN 't"' + hb_TSToStr( xVal, .T. ) + '"' - CASE "L" ; RETURN iif( xVal, ".T.", ".F." ) - CASE "S" ; RETURN "@" + xVal:name + "()" + CASE "M" ; RETURN '"' + uVal + '"' + CASE "D" ; RETURN 'CTOD("' + DToC( uVal ) + '")' + CASE "T" ; RETURN 'HB_CTOT("' + hb_TToC( uVal ) + '")' + CASE "O" ; RETURN "Object" +#else + CASE "C" + CASE "M" ; RETURN hb_StrToExp( uVal ) + CASE "D" ; RETURN 'd"' + Left( hb_TSToStr( uVal, .F. ), 10 ) + '"' + CASE "T" ; RETURN 't"' + hb_TSToStr( uVal, .T. ) + '"' + CASE "O" ; RETURN "{ " + uVal:className() + " Object }" +#endif + CASE "N" ; RETURN hb_ntos( uVal ) + CASE "L" ; RETURN iif( uVal, ".T.", ".F." ) + CASE "S" ; RETURN "@" + uVal:name + "()" CASE "B" ; RETURN "{|| ... }" - CASE "O" ; RETURN "{ " + xVal:className() + " Object }" - CASE "A" ; RETURN "{ Array of " + hb_ntos( Len( xVal ) ) + " Items }" - CASE "H" ; RETURN "{ Hash of " + hb_ntos( Len( xVal ) ) + " Items }" + CASE "A" ; RETURN "{ ... }" + CASE "H" ; RETURN "{ => }" CASE "P" ; RETURN "" OTHERWISE - IF xVal == NIL + IF uVal == NIL RETURN "NIL" ENDIF ENDSWITCH - RETURN "???:" + v + RETURN "U" diff --git a/src/rdd/dbcmd53.c b/src/rdd/dbcmd53.c index ec0f49095a..288a67e195 100644 --- a/src/rdd/dbcmd53.c +++ b/src/rdd/dbcmd53.c @@ -406,7 +406,7 @@ HB_FUNC( DBRECORDINFO ) } /* - * DBFILEPUT/BLOB2FILE - retrieve memo contents into file + * DBFILEGET/BLOB2FILE - retrieve memo contents into file */ HB_FUNC( DBFILEGET ) { diff --git a/src/rtl/dateshb.c b/src/rtl/dateshb.c index 9de6c2a4dc..58a4975054 100644 --- a/src/rtl/dateshb.c +++ b/src/rtl/dateshb.c @@ -446,10 +446,7 @@ HB_FUNC( HB_TSTOSTR ) if( lDate == 0 ) hb_retc_const( "00:00" ); else - { - szBuffer[ 10 ] = '\0'; - hb_retc( szBuffer ); - } + hb_retclen( szBuffer, 10 ); } else { @@ -462,15 +459,14 @@ HB_FUNC( HB_TSTOSTR ) if( szBuffer[ i - 1 ] == '0' && szBuffer[ i - 2 ] == '0' ) i -= 3; } - szBuffer[ i ] = '\0'; if( lDate == 0 ) - hb_retc( szBuffer + 11 ); + hb_retclen( szBuffer + 11, i - 11 ); else - hb_retc( szBuffer ); + hb_retclen( szBuffer, i ); } } else - hb_retc( szBuffer ); + hb_retclen( szBuffer, 23 ); } else hb_errRT_BASE_SubstR( EG_ARG, 3012, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS ); diff --git a/src/rtl/hbproces.c b/src/rtl/hbproces.c index 3eb63b75e6..0cc53ebb7c 100644 --- a/src/rtl/hbproces.c +++ b/src/rtl/hbproces.c @@ -497,6 +497,7 @@ HB_FHANDLE hb_fsProcessOpen( const char * pszFileName, #elif defined( HB_OS_UNIX ) && \ ! defined( HB_OS_VXWORKS ) && ! defined( HB_OS_SYMBIAN ) + char ** argv = hb_buildArgs( pszFileName ); pid_t pid = fork(); if( pid == -1 ) @@ -572,18 +573,15 @@ HB_FHANDLE hb_fsProcessOpen( const char * pszFileName, /* execute command */ { - char ** argv; - - argv = hb_buildArgs( pszFileName ); # if defined( __WATCOMC__ ) execvp( argv[ 0 ], ( const char ** ) argv ); # else execvp( argv[ 0 ], argv ); # endif - hb_freeArgs( argv ); exit( -1 ); } } + hb_freeArgs( argv ); #elif defined( HB_OS_OS2 ) || defined( HB_OS_WIN ) @@ -757,6 +755,7 @@ int hb_fsProcessValue( HB_FHANDLE hProcess, HB_BOOL fWait ) RESULTCODES resultCodes = { 0, 0 }; APIRET ret; + hb_vmUnlock(); ret = DosWaitChild( DCWA_PROCESS, fWait ? DCWW_WAIT : DCWW_NOWAIT, &resultCodes, &pid, pid ); hb_fsSetIOError( ret == NO_ERROR, 0 ); @@ -764,6 +763,7 @@ int hb_fsProcessValue( HB_FHANDLE hProcess, HB_BOOL fWait ) iRetStatus = resultCodes.codeResult; else iRetStatus = -2; + hb_vmLock(); } else hb_fsSetError( ( HB_ERRCODE ) FS_ERROR ); diff --git a/src/rtl/valtoexp.prg b/src/rtl/valtoexp.prg index 8ff7fba4d2..ee8412f30e 100644 --- a/src/rtl/valtoexp.prg +++ b/src/rtl/valtoexp.prg @@ -73,9 +73,7 @@ FUNCTION hb_CStr( xVal ) FUNCTION hb_ValToExp( xVal, lRaw ) - hb_default( @lRaw, .F. ) - - RETURN s_valToExp( xVal, lRaw ) + RETURN s_valToExp( xVal, hb_defaultValue( lRaw, .F. ) ) STATIC FUNCTION s_valToExp( xVal, lRaw, cInd, hRefs, cRefs, cObjs ) diff --git a/src/vm/estack.c b/src/vm/estack.c index dba1406f60..35b6c33f88 100644 --- a/src/vm/estack.c +++ b/src/vm/estack.c @@ -1216,8 +1216,8 @@ void hb_stackBaseProcInfo( char * szProcName, HB_USHORT * puiProcLine ) { szProcName[ 0 ] = '\0'; * puiProcLine = 0; - return; } + else #endif { HB_STACK_TLS_PRELOAD diff --git a/src/vm/fm.c b/src/vm/fm.c index 1387028cc8..6156732ea5 100644 --- a/src/vm/fm.c +++ b/src/vm/fm.c @@ -264,8 +264,8 @@ ! defined( HB_ATOM_INC ) || ! defined( HB_ATOM_DEC ) ) static HB_CRITICAL_NEW( s_fmMtx ); -# define HB_FM_LOCK() hb_threadEnterCriticalSection( &s_fmMtx ) -# define HB_FM_UNLOCK() hb_threadLeaveCriticalSection( &s_fmMtx ) +# define HB_FM_LOCK() do { hb_threadEnterCriticalSection( &s_fmMtx ) +# define HB_FM_UNLOCK() hb_threadLeaveCriticalSection( &s_fmMtx ); } while( 0 ) #else @@ -286,38 +286,41 @@ static HB_BOOL s_fInitedFM = HB_FALSE; #endif -#ifdef HB_FM_STATISTICS - #ifndef HB_MEMFILER # define HB_MEMFILER 0xff #endif + +#ifdef HB_FM_STATISTICS + #define HB_MEMINFO_SIGNATURE 0x19730403 typedef struct _HB_MEMINFO { HB_U32 u32Signature; - HB_SIZE nSize; HB_USHORT uiProcLine; + HB_USHORT uiReserved; + HB_SIZE nSize; char szProcName[ HB_SYMBOL_NAME_LEN + 1 ]; struct _HB_MEMINFO * pPrevBlock; struct _HB_MEMINFO * pNextBlock; } HB_MEMINFO, * PHB_MEMINFO; #ifdef HB_ALLOC_ALIGNMENT -# define _HB_MEMINFO_SIZE ( ( ( sizeof( HB_MEMINFO ) + HB_ALLOC_ALIGNMENT - 1 ) - \ - ( sizeof( HB_MEMINFO ) + HB_ALLOC_ALIGNMENT - 1 ) % HB_ALLOC_ALIGNMENT ) + \ - HB_COUNTER_OFFSET ) +# define _HB_MEMINFO_SIZE ( ( ( sizeof( HB_MEMINFO ) + HB_ALLOC_ALIGNMENT - 1 ) - \ + ( sizeof( HB_MEMINFO ) + HB_ALLOC_ALIGNMENT - 1 ) % HB_ALLOC_ALIGNMENT ) + \ + HB_COUNTER_OFFSET ) #else -# define _HB_MEMINFO_SIZE ( sizeof( HB_MEMINFO ) + HB_COUNTER_OFFSET ) +# define _HB_MEMINFO_SIZE ( sizeof( HB_MEMINFO ) + HB_COUNTER_OFFSET ) #endif -#define HB_MEMINFO_SIZE ( s_fStatistic ? sizeof( HB_MEMINFO ) + HB_COUNTER_OFFSET : HB_COUNTER_OFFSET ) +#define HB_MEMINFO_SIZE ( s_fStatistic ? sizeof( HB_MEMINFO ) + HB_COUNTER_OFFSET : HB_COUNTER_OFFSET ) +#define HB_MEMSIG_SIZE sizeof( HB_U32 ) #define HB_FM_GETSIG( p, n ) HB_GET_UINT32( ( HB_BYTE * ) ( p ) + ( n ) ) #define HB_FM_SETSIG( p, n ) HB_PUT_UINT32( ( HB_BYTE * ) ( p ) + ( n ), HB_MEMINFO_SIGNATURE ) #define HB_FM_CLRSIG( p, n ) HB_PUT_UINT32( ( HB_BYTE * ) ( p ) + ( n ), 0 ) -#define HB_ALLOC_SIZE( n ) ( ( n ) + ( s_fStatistic ? _HB_MEMINFO_SIZE + sizeof( HB_U32 ) : HB_COUNTER_OFFSET ) ) +#define HB_ALLOC_SIZE( n ) ( ( n ) + ( s_fStatistic ? _HB_MEMINFO_SIZE + HB_MEMSIG_SIZE : HB_COUNTER_OFFSET ) ) #define HB_FM_PTR( p ) ( ( PHB_MEMINFO ) ( ( HB_BYTE * ) ( p ) - HB_MEMINFO_SIZE ) ) #define HB_FM_BLOCKSIZE( p ) ( s_fStatistic ? HB_FM_PTR( pMem )->nSize : 0 ) @@ -614,9 +617,8 @@ void * hb_xalloc( HB_SIZE nSize ) /* allocates fixed memory, returns NUL if( s_fStatistic ) { - PHB_TRACEINFO pTrace; + PHB_TRACEINFO pTrace = hb_traceinfo(); - pTrace = hb_traceinfo(); if( hb_tr_level() >= HB_TR_DEBUG || pTrace->level == HB_TR_FM ) { /* NOTE: PRG line number/procname is not very useful during hunting @@ -649,8 +651,8 @@ void * hb_xalloc( HB_SIZE nSize ) /* allocates fixed memory, returns NUL s_pLastBlock->pNextBlock = pMem; } s_pLastBlock = pMem; - pMem->pNextBlock = NULL; + pMem->u32Signature = HB_MEMINFO_SIGNATURE; HB_FM_SETSIG( HB_MEM_PTR( pMem ), nSize ); pMem->nSize = nSize; /* size of the memory block */ @@ -700,9 +702,8 @@ void * hb_xgrab( HB_SIZE nSize ) /* allocates fixed memory, exits on fai if( s_fStatistic ) { - PHB_TRACEINFO pTrace; + PHB_TRACEINFO pTrace = hb_traceinfo(); - pTrace = hb_traceinfo(); if( hb_tr_level() >= HB_TR_DEBUG || pTrace->level == HB_TR_FM ) { /* NOTE: PRG line number/procname is not very useful during hunting @@ -735,8 +736,8 @@ void * hb_xgrab( HB_SIZE nSize ) /* allocates fixed memory, exits on fai s_pLastBlock->pNextBlock = pMem; } s_pLastBlock = pMem; - pMem->pNextBlock = NULL; + pMem->u32Signature = HB_MEMINFO_SIGNATURE; HB_FM_SETSIG( HB_MEM_PTR( pMem ), nSize ); pMem->nSize = nSize; /* size of the memory block */ @@ -803,37 +804,34 @@ void * hb_xrealloc( void * pMem, HB_SIZE nSize ) /* reallocates memory */ if( HB_FM_GETSIG( pMem, nMemSize ) != HB_MEMINFO_SIGNATURE ) hb_errInternal( HB_EI_XMEMOVERFLOW, NULL, NULL, NULL ); - HB_FM_CLRSIG( pMem, nMemSize ); + pMemBlock->u32Signature = 0; + HB_FM_CLRSIG( HB_MEM_PTR( pMemBlock ), nMemSize ); -#ifdef HB_PARANOID_MEM_CHECK +#if defined( HB_PARANOID_MEM_CHECK ) || defined( HB_FM_FORCE_REALLOC ) pMem = malloc( HB_ALLOC_SIZE( nSize ) ); - if( pMem ) - { - HB_ATOM_SET( HB_COUNTER_PTR( HB_MEM_PTR( pMem ) ), 1 ); - if( nSize > nMemSize ) - { - memcpy( pMem, pMemBlock, HB_ALLOC_SIZE( nMemSize ) ); - memset( ( HB_BYTE * ) pMem + HB_ALLOC_SIZE( nMemSize ), HB_MEMFILER, nSize - nMemSize ); - } - else - memcpy( pMem, pMemBlock, HB_ALLOC_SIZE( nSize ) ); - } - memset( pMemBlock, HB_MEMFILER, HB_ALLOC_SIZE( nMemSize ) ); - free( pMemBlock ); -#else - pMem = realloc( pMemBlock, HB_ALLOC_SIZE( nSize ) ); -#endif +# endif HB_FM_LOCK(); - s_nMemoryConsumed += ( nSize - nMemSize ); - if( s_nMemoryMaxConsumed < s_nMemoryConsumed ) - s_nMemoryMaxConsumed = s_nMemoryConsumed; +#if ! ( defined( HB_PARANOID_MEM_CHECK ) || defined( HB_FM_FORCE_REALLOC ) ) + pMem = realloc( pMemBlock, HB_ALLOC_SIZE( nSize ) ); +#endif if( pMem ) { +#if defined( HB_PARANOID_MEM_CHECK ) || defined( HB_FM_FORCE_REALLOC ) + memcpy( pMem, pMemBlock, nSize < nMemSize ? + HB_ALLOC_SIZE( nSize ) : HB_ALLOC_SIZE( nMemSize ) ); +#endif + + s_nMemoryConsumed += ( nSize - nMemSize ); + if( s_nMemoryMaxConsumed < s_nMemoryConsumed ) + s_nMemoryMaxConsumed = s_nMemoryConsumed; + ( ( PHB_MEMINFO ) pMem )->nSize = nSize; /* size of the memory block */ + ( ( PHB_MEMINFO ) pMem )->u32Signature = HB_MEMINFO_SIGNATURE; HB_FM_SETSIG( HB_MEM_PTR( pMem ), nSize ); + if( ( ( PHB_MEMINFO ) pMem )->pPrevBlock ) ( ( PHB_MEMINFO ) pMem )->pPrevBlock->pNextBlock = ( PHB_MEMINFO ) pMem; if( ( ( PHB_MEMINFO ) pMem )->pNextBlock ) @@ -846,6 +844,15 @@ void * hb_xrealloc( void * pMem, HB_SIZE nSize ) /* reallocates memory */ } HB_FM_UNLOCK(); + +#if defined( HB_PARANOID_MEM_CHECK ) || defined( HB_FM_FORCE_REALLOC ) +# ifdef HB_PARANOID_MEM_CHECK + memset( pMemBlock, HB_MEMFILER, HB_ALLOC_SIZE( nMemSize ) ); + if( nSize > nMemSize && pMem ) + memset( ( HB_BYTE * ) HB_MEM_PTR( pMem ) + nMemSize, HB_MEMFILER, nSize - nMemSize ); +# endif + free( pMemBlock ); +#endif } else pMem = realloc( HB_FM_PTR( pMem ), HB_ALLOC_SIZE( nSize ) ); @@ -870,7 +877,20 @@ void * hb_xrealloc( void * pMem, HB_SIZE nSize ) /* reallocates memory */ } else { +#ifdef HB_FM_FORCE_REALLOC + PHB_MEMINFO pMemBlock = HB_FM_PTR( pMem ); + + pMem = realloc( pMemBlock, HB_ALLOC_SIZE( nSize ) ); + if( pMem == pMemBlock ) + { + pMem = malloc( HB_ALLOC_SIZE( nSize ) ); + memcpy( pMem, pMemBlock, HB_ALLOC_SIZE( nSize ) ); + memset( pMemBlock, HB_MEMFILER, HB_ALLOC_SIZE( nSize ) ); + free( pMemBlock ); + } +#else pMem = realloc( HB_FM_PTR( pMem ), HB_ALLOC_SIZE( nSize ) ); +#endif } if( ! pMem ) diff --git a/utils/hbmk2/hbmk2.prg b/utils/hbmk2/hbmk2.prg index 076a6a3849..354b46d0fe 100644 --- a/utils/hbmk2/hbmk2.prg +++ b/utils/hbmk2/hbmk2.prg @@ -6868,9 +6868,9 @@ STATIC FUNCTION __hbmk( aArgs, nArgTarget, nLevel, /* @ */ lPause, /* @ */ lExit IF ! hbmk[ _HBMK_lDONTEXEC ] IF hb_mtvm() .AND. Len( aTO_DO:__enumBase() ) > 1 - AAdd( aThreads, { hb_threadStart( @hb_processRun(), cCommand ), cCommand } ) + AAdd( aThreads, { hb_threadStart( @hbmk_hb_processRunFile(), cCommand, cScriptFile ), cCommand } ) ELSE - IF ( tmp := hb_processRun( cCommand ) ) != 0 + IF ( tmp := hbmk_hb_processRunFile( cCommand, cScriptFile ) ) != 0 _hbmk_OutErr( hbmk, hb_StrFormat( I_( "Error: Running C/C++ compiler. %1$d" ), tmp ) ) IF ! hbmk[ _HBMK_lQuiet ] OutErr( cCommand + _OUT_EOL ) @@ -6881,11 +6881,10 @@ STATIC FUNCTION __hbmk( aArgs, nArgTarget, nLevel, /* @ */ lPause, /* @ */ lExit ENDIF ENDIF ENDIF - ENDIF - - IF ! Empty( cScriptFile ) + ELSEIF ! Empty( cScriptFile ) FErase( cScriptFile ) ENDIF + NEXT FOR EACH thread IN aThreads @@ -13161,6 +13160,18 @@ STATIC FUNCTION Apple_App_Template_Info_plist() #pragma __endtext +STATIC FUNCTION hbmk_hb_processRunFile( cCommand, cTempFile ) + + LOCAL nResult + + nResult := hb_processRun( cCommand ) + + IF ! Empty( cTempFile ) + FErase( cTempFile ) + ENDIF + + RETURN nResult + STATIC FUNCTION hbmk_hb_processRunCatch( cCommand, /* @ */ cStdOutErr ) LOCAL nExitCode