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

2014-08-01 02:04 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)

Browse Source 
* 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=<n> parameter.

  * utils/hbmk2/hbmk2.prg
    ! fixed race condition in concurrent C compiler execution (-jobs=<n>)
      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
This commit is contained in:
Przemysław Czerpak
2014-08-01 02:04:07 +02:00
parent 6529610475
commit 3f78fa0b6e
20 changed files with 629 additions and 742 deletions
Download Patch File Download Diff File Expand all files Collapse all files

90
src/debug/dbgbrwsr.prg
View File

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

58
src/debug/dbgentry.c
View File

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

12
src/debug/dbghelp.prg
View File

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

96
src/debug/dbgtarr.prg
View File

@@ -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 - <maurilio.longo@libero.it>
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 ) )

110
src/debug/dbgthsh.prg
View File

@@ -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 - <maurilio.longo@libero.it>
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 ) )

48
src/debug/dbgtinp.prg
View File

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

12
src/debug/dbgtmenu.prg
View File

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

203
src/debug/dbgtobj.prg
View File

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

22
src/debug/dbgtwin.prg
View File

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

98
src/debug/dbgwa.prg
View File

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

398
src/debug/debugger.prg
View File

@@ -52,17 +52,6 @@
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://harbour-project.org
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* __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 ] + " <Global, " + ValType( uValue ) + ">: " + __dbgValToStr( uValue )
CASE "L" ; RETURN aVar[ VAR_NAME ] + " <Local, " + ValType( uValue ) + ">: " + __dbgValToStr( uValue )
CASE "S" ; RETURN aVar[ VAR_NAME ] + " <Static, " + ValType( uValue ) + ">: " + __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 "<pointer>"
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 "<pointer>"
OTHERWISE
IF xVal == NIL
IF uVal == NIL
RETURN "NIL"
ENDIF
ENDSWITCH
RETURN "???:" + v
RETURN "U"