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

2008-04-09 20:42 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/ChangeLog
  * harbour/harbour.spec
    * reverted translation to UTF8 - Tomaz please check your editor
      settings and disable automatic translation to UTF8. It's not
      the first as such situation happens.

  * harbour/include/hbclass.ch
    + added two missing PP directives
    ! protected against some repeated external definitions

  * harbour/source/pp/Makefile
  * harbour/source/pp/hbppgen.c
  * harbour/source/pp/ppcore.c
  * harbour/source/common/hbver.c
  * harbour/source/common/hbverdsp.c
  * harbour/source/main/harbour.c
  * harbour/source/vm/cmdarg.c
  * harbour/utils/hbpp/hbpp.c
  * harbour/include/hbpp.h
  * harbour/include/hbcomp.h
  * harbour/include/hbver.h
  * harbour/include/hbapi.h
  * harbour/make_vcce.mak
  * harbour/make_b32.mak
  * harbour/make_vc.mak
  * harbour/make_gcc.mak
    + added support for dynamically set during compilation ChangeLog entry
      ChangeLog ID and SVN revision and compilation flags
      Now hbppgen creates in include directory hbverbld.h file with
      information extracted from ChangeLog. New hbppgen parameters:
         Syntax:  ./hbppgen <file>[.prg] [options]
         Options: -i<path>       add #include file search path
                  -c[<file>]     look for ChangeLog file
                  -o<file>       creates .c file with PP rules
                  -v<file>       creates .h file with version information
                  -w             write preprocessed (.ppo) input file
                  -q             disable information messages
    + added new C functions:
         int hb_verSvnID( void )
            - retrieves ChangeLog SVN revision number
         const char * hb_verSvnChangeLogID( void )
            - retrieves a static buffer containing ChangeLog ID string
         const char * hb_verSvnLastEntry( void )
            - retrieves a static buffer containing ChangeLog last entry string
         const char * hb_verFlagsC( void )
            - retrieves a static buffer containing build time C compiler
              flags in C_USR envvar
         const char * hb_verFlagsL( void )
            - retrieves a static buffer containing build time linker
              flags in L_USR envvar
         const char * hb_verFlagsPRG( void )
            - retrieves a static buffer containing build time Harbour compiler
              flags in PRG_USR envvar
    + added new default PP defines which can be used in .prg code compiled
      by Harbour compiler: HB_VER_LENTRY, HB_VER_CHLID, HB_VER_SVNID

  * harbour/source/rtl/gtxwc/gtxwc.c
    * formatting

  * harbour/source/rtl/gttrm/gttrm.c
    ! fixed redrawing GPM mouse pointer after screen updating

  * harbour/source/rtl/gtstd/gtstd.c
  * harbour/source/rtl/gtpca/gtpca.c
    * updated for compilation even if some POSIX macros are not supported
      f.e. problems with some DJGPP versions reported recently

  * harbour/source/debug/dbgentry.c
  * harbour/source/debug/dbgtobj.prg
  * harbour/source/debug/dbgbrwsr.prg
  * harbour/source/debug/dbgthsh.prg
  * harbour/source/debug/tbrwtext.prg
  * harbour/source/debug/dbgwa.prg
  * harbour/source/debug/debugger.prg
  * harbour/source/debug/dbghelp.prg
  * harbour/source/debug/dbgtarr.prg
    ! Fixed object inspector in the debugger.
    ! Added HbDbBrowser:invalidate() message. Fixes work area browsing in debugger.
    ! Added an minimalistic TBrowse implementation that is just enough
      for internal use by the debugger. Fixes miscellaneous problems e.g.
      when debugging a piece of code with RELATIONs turned on.
    Fixes by Phil Krylov borrowed from xHarbour.
This commit is contained in:
Przemyslaw Czerpak
2008-04-09 18:44:03 +00:00
parent 25a56176ed
commit bf68197ca0
32 changed files with 873 additions and 300 deletions
Download Patch File Download Diff File Expand all files Collapse all files

147
harbour/source/debug/dbgbrwsr.prg
View File

@@ -8,6 +8,8 @@
*
* Copyright 2004 Ryszard Glab <rglab@imid.med.pl>
* www - http://www.harbour-project.org
* Copyright 2007 Phil Krylov <phil a t newstar.rinet.ru>
* www - http://xharbour.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -52,24 +54,153 @@
#include "hbclass.ch"
CREATE CLASS HBDbBrowser INHERIT TBrowse // Debugger browser
/* HBDbBrowser
*
* A minimalistic TBrowse implementation just enough for use in
* the debugger instead of the HBBrowse monster
*/
CREATE CLASS HBDbBrowser
VAR Window
VAR Window
VAR cargo
VAR nTop
VAR nLeft
VAR nBottom
VAR nRight
VAR colorSpec
VAR autoLite INIT .T.
VAR goTopBlock
VAR goBottomBlock
VAR skipBlock
VAR stable INIT .F.
VAR rowCount INIT 0
VAR rowPos INIT 1
VAR colCount INIT 0
VAR colPos INIT 1
VAR hitBottom INIT .F.
VAR freeze INIT 0
VAR aColumns INIT {}
VAR aRowState INIT {}
VAR aColorSpec INIT {}
VAR nFirstVisible INIT 1
VAR lConfigured INIT .F.
METHOD New( nTop, nLeft, nBottom, nRight, oParentWindow )
METHOD AddColumn( oCol ) INLINE AAdd( ::aColumns, oCol ), ::colCount++, Self
METHOD Configure()
METHOD DeHiLite() INLINE Self
METHOD Down() INLINE ::MoveCursor( 1 )
METHOD ForceStable()
METHOD GetColumn( nColumn ) INLINE ::aColumns[ nColumn ]
METHOD GoTo( nRow )
METHOD GoTop() INLINE ::GoTo( 1 ), ::rowPos := 1, ::nFirstVisible := 1, ::RefreshAll()
METHOD GoBottom()
METHOD HiLite() INLINE Self
METHOD Invalidate() INLINE ::RefreshAll()
METHOD MoveCursor( nSkip )
METHOD PageDown() INLINE ::MoveCursor( ::rowCount )
METHOD PageUp() INLINE ::MoveCursor( -::rowCount )
METHOD RefreshAll() INLINE AFill( ::aRowState, .F. ), Self
METHOD RefreshCurrent() INLINE IIf( ::rowCount > 0, ::aRowState[ ::rowPos ] := .F., ), Self
METHOD Resize( nTop, nLeft, nBottom, nRight )
METHOD ForceStable() INLINE iif( ::RowCount > 0, ::Super:ForceStable(), )
METHOD RefreshAll() INLINE iif( ::RowCount > 0, ::Super:RefreshAll(), )
METHOD Stabilize() INLINE ::ForceStable()
METHOD Up() INLINE ::MoveCursor( -1 )
ENDCLASS
METHOD New( nTop, nLeft, nBottom, nRight, oParentWindow ) CLASS HBDbBrowser
::Window := oParentWindow
::super:New( nTop, nLeft, nBottom, nRight )
::nTop := nTop
::nLeft := nLeft
::nBottom := nBottom
::nRight := nRight
RETURN Self
METHOD Configure()
::rowCount := ::nBottom - ::nTop + 1
ASize( ::aRowState, ::rowCount )
::aColorSpec := hb_aTokens( ::colorSpec, "," )
::lConfigured := .T.
RETURN Self
METHOD MoveCursor( nSkip )
LOCAL nSkipped
nSkipped := ::GoTo( ::rowPos + ::nFirstVisible - 1 + nSkip )
IF !::hitBottom .OR. Abs( nSkipped ) > 0
IF IIf( nSkipped > 0, ::rowPos + nSkipped <= ::rowCount, ::rowPos + nSkipped >= 1 )
::RefreshCurrent()
::rowPos += nSkipped
::RefreshCurrent()
ELSE
::nFirstVisible := Max( 1, nSkipped + ::nFirstVisible )
::RefreshAll()
ENDIF
ENDIF
RETURN Self
METHOD ForceStable()
LOCAL nRow, nCol, xData, oCol, nColX, nWid, xOldColor := SetColor()
IF !::lConfigured
::Configure()
ENDIF
FOR nRow := 1 TO ::rowCount
IF Empty( ::aRowState[ nRow ] )
::GoTo( ::nFirstVisible + nRow - 1 )
IF ::hitBottom
SetColor( ::aColorSpec[ 1 ] )
@ ::nTop + nRow - 1, ::nLeft SAY Space( ::nRight - ::nLeft + 1 )
ELSE
nColX := ::nLeft
FOR nCol := 1 TO Len( ::aColumns )
IF nColX <= ::nRight
oCol := ::aColumns[ nCol ]
SetColor( ::aColorSpec[ oCol:defColor[ IIf( nRow == ::rowPos, 2, 1 ) ] ] )
xData := Eval( oCol:block )
IF oCol:width == NIL
nWid := Len( xData )
ELSE
nWid := oCol:width
ENDIF
@ ::nTop + nRow - 1, nColX SAY PadR( xData, nWid ) + IIf( nCol < Len( ::aColumns ), " ", "" )
nColX += nWid + 1
ENDIF
NEXT
ENDIF
::aRowState[ nRow ] := .T.
ENDIF
NEXT
::GoTo( ::nFirstVisible + ::rowPos - 1 )
SetColor( xOldColor )
SetPos( ::nTop + ::rowPos - 1, ::nLeft )
RETURN Self
METHOD GoTo( nRow )
LOCAL nOldRow := ::nFirstVisible + ::rowPos - 1
LOCAL nSkipped := 0
Eval( ::goTopBlock )
IF nRow == 1
::hitBottom := .F.
ELSE
nSkipped := Eval( ::skipBlock, nRow - 1 )
::hitBottom := ( nSkipped != nRow - 1 )
ENDIF
RETURN nSkipped - nOldRow + 1
METHOD GoBottom()
DO WHILE !::hitBottom
::PageDown()
ENDDO
RETURN Self
METHOD Resize( nTop, nLeft, nBottom, nRight )
LOCAL lResize := .F.
@@ -91,11 +222,7 @@ METHOD Resize( nTop, nLeft, nBottom, nRight )
ENDIF
IF lResize
/* The following check prevents a "High limit exceeded" error. Maybe it
* would be wiser to make TBrowse handle height of 0 rows -- Ph.K. */
IF ::nBottom >= ::nTop
::configure()
ENDIF
::Configure():ForceStable()
ENDIF
RETURN self

65
harbour/source/debug/dbgentry.c
View File

@@ -236,21 +236,10 @@ hb_dbgActivate( HB_DEBUGINFO *info )
PHB_ITEM aEntry = hb_itemArrayNew( 6 );
PHB_ITEM pItem;
pItem = hb_itemPutC( NULL, pEntry->szModule );
hb_arraySet( aEntry, 1, pItem );
hb_itemRelease( pItem );
pItem = hb_itemPutC( NULL, pEntry->szFunction );
hb_arraySet( aEntry, 2, pItem );
hb_itemRelease( pItem );
pItem = hb_itemPutNL( NULL, pEntry->nLine );
hb_arraySet( aEntry, 3, pItem );
hb_itemRelease( pItem );
pItem = hb_itemPutNL( NULL, pEntry->nProcLevel );
hb_arraySet( aEntry, 4, pItem );
hb_itemRelease( pItem );
hb_arraySetC( aEntry, 1, pEntry->szModule );
hb_arraySetC( aEntry, 2, pEntry->szFunction );
hb_arraySetNL( aEntry, 3, pEntry->nLine );
hb_arraySetNL( aEntry, 4, pEntry->nProcLevel );
pItem = hb_dbgActivateVarArray( pEntry->nLocals, pEntry->aLocals );
hb_arraySet( aEntry, 5, pItem );
@@ -294,23 +283,15 @@ hb_dbgActivateBreakArray( HB_DEBUGINFO *info )
for ( i = 0; i < info->nBreakPoints; i++ )
{
PHB_ITEM pBreak = hb_itemArrayNew( 3 );
PHB_ITEM item;
if ( !info->aBreak[ i ].szFunction )
{
item = hb_itemPutNI( NULL, info->aBreak[ i ].nLine );
hb_arraySet( pBreak, 1, item );
hb_itemRelease( item );
item = hb_itemPutC( NULL, info->aBreak[ i ].szModule );
hb_arraySet( pBreak, 2, item );
hb_itemRelease( item );
hb_arraySetNI( pBreak, 1, info->aBreak[ i ].nLine );
hb_arraySetC( pBreak, 2, info->aBreak[ i ].szModule );
}
else
{
item = hb_itemPutC( NULL, info->aBreak[ i ].szFunction );
hb_arraySet( pBreak, 3, item );
hb_itemRelease( item );
hb_arraySetC( pBreak, 3, info->aBreak[ i ].szFunction );
}
hb_arraySet( pArray, i + 1, pBreak );
@@ -331,9 +312,7 @@ hb_dbgActivateModuleArray( HB_DEBUGINFO *info )
PHB_ITEM pModule = hb_itemArrayNew( 4 );
PHB_ITEM item;
item = hb_itemPutC( NULL, info->aModules[ i ].szModule );
hb_arraySet( pModule, 1, item );
hb_itemRelease( item );
hb_arraySetC( pModule, 1, info->aModules[ i ].szModule );
item = hb_dbgActivateVarArray( info->aModules[ i ].nStatics,
info->aModules[ i ].aStatics );
@@ -366,23 +345,11 @@ hb_dbgActivateVarArray( int nVars, HB_VARINFO *aVars )
for ( i = 0; i < nVars; i++ )
{
PHB_ITEM aVar = hb_itemArrayNew( 4 );
PHB_ITEM item;
item = hb_itemPutC( NULL, aVars[ i ].szName );
hb_arraySet( aVar, 1, item );
hb_itemRelease( item );
item = hb_itemPutNL( NULL, aVars[ i ].nIndex );
hb_arraySet( aVar, 2, item );
hb_itemRelease( item );
item = hb_itemPutCL( NULL, &aVars[ i ].cType, 1 );
hb_arraySet( aVar, 3, item );
hb_itemRelease( item );
item = hb_itemPutNL( NULL, aVars[ i ].nFrame );
hb_arraySet( aVar, 4, item );
hb_itemRelease( item );
hb_arraySetC( aVar, 1, aVars[ i ].szName );
hb_arraySetNL( aVar, 2, aVars[ i ].nIndex );
hb_arraySetCL( aVar, 3, &aVars[ i ].cType, 1 );
hb_arraySetNL( aVar, 4, aVars[ i ].nFrame );
hb_arraySet( pArray, i + 1, aVar );
hb_itemRelease( aVar );
@@ -771,8 +738,8 @@ hb_dbgAddStopLines( HB_DEBUGINFO *info, PHB_ITEM pItem )
{
pBuffer[ nOrigMin / 8 + k - nMin / 8 ] |= pOrigBuffer[ k ];
}
hb_itemPutNL( hb_arrayGetItemPtr( pLines, 2 ), nMin );
hb_itemPutCPtr( hb_arrayGetItemPtr( pLines, 3 ), pBuffer, nLen - 1 );
hb_arraySetNL( pLines, 2, nMin );
hb_arraySetCPtr( pLines, 3, pBuffer, nLen - 1 );
bFound = TRUE;
break;
}
@@ -794,9 +761,7 @@ hb_dbgAddStopLines( HB_DEBUGINFO *info, PHB_ITEM pItem )
|| ( p = strrchr( szModule, '\\' ) ) != NULL )
{
char *szName = hb_strdup( p + 1 );
hb_itemPutC( hb_arrayGetItemPtr( pEntry, 1 ), szName );
hb_xfree( szName );
hb_arraySetCPtr( pEntry, 1, szName, strlen( szName ) );
}
}
}

2
harbour/source/debug/dbghelp.prg
View File

@@ -73,7 +73,7 @@ FUNCTION __dbgHelp( nTopic )
oDlg := HBDbWindow():New( 2, 2, MaxRow() - 2, MaxCol() - 2, "Help", cColor )
oBrw := TBrowseNew( oDlg:nTop + 1, oDlg:nLeft + 1, oDlg:nBottom - 1, oDlg:nLeft + 12 )
oBrw := HBDbBrowser():New( oDlg:nTop + 1, oDlg:nLeft + 1, oDlg:nBottom - 1, oDlg:nLeft + 12 )
oBrw:Cargo := 1
oBrw:AddColumn( TBColumnNew( "", { || aTopics[ oBrw:Cargo ][ 1 ] }, 12 ) )
oBrw:ColorSpec := StrTran( __Dbg():ClrModal(), ", R/W", "" )

2
harbour/source/debug/dbgtarr.prg
View File

@@ -107,7 +107,7 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbArray
AAdd( ::aWindows, oWndSets )
nWidth := oWndSets:nRight - oWndSets:nLeft - 1
oBrwSets := TBrowseNew( oWndSets:nTop + 1, oWndSets:nLeft + 1, oWndSets:nBottom - 1, oWndSets:nRight - 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

2
harbour/source/debug/dbgthsh.prg
View File

@@ -109,7 +109,7 @@ METHOD addWindows( hHash, nRow ) CLASS HBDbHash
AAdd( ::aWindows, oWndSets )
nWidth := oWndSets:nRight - oWndSets:nLeft - 1
oBrwSets := TBrowseNew( oWndSets:nTop + 1, oWndSets:nLeft + 1, oWndSets:nBottom - 1, oWndSets:nRight - 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

12
harbour/source/debug/dbgtobj.prg
View File

@@ -71,7 +71,7 @@ CREATE CLASS HBDbObject
METHOD New( oObject, cVarName, lEditable )
METHOD addWindows( aArray, nRow )
METHOD doGet( oBrowse, pItem, nSet )
METHOD SetsKeyPressed( nKey, oBrwSets, nSets, oWnd, cName, aArray )
METHOD SetsKeyPressed( nKey, oBrwSets, nSets, aArray )
ENDCLASS
@@ -126,7 +126,7 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbObject
nWidth := oWndSets:nRight - oWndSets:nLeft - 1
oBrwSets := TBrowseNew( oWndSets:nTop + 1, oWndSets:nLeft + 1, oWndSets:nBottom - 1, oWndSets:nRight - 1 )
oBrwSets := HBDbBrowser():New( oWndSets:nTop + 1, oWndSets:nLeft + 1, oWndSets:nBottom - 1, oWndSets:nRight - 1 )
::ArrayReference := aArray
oBrwSets:ColorSpec := __Dbg():ClrModal()
@@ -152,8 +152,7 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbObject
oCol:width := MaxCol() - 14 - nMaxLen
oBrwSets:colPos := 2
::aWindows[ ::nCurWindow ]:bPainted := { || oBrwSets:ForceStable() }
::aWindows[ ::nCurWindow ]:bKeyPressed := { | nKey | ::SetsKeyPressed( nKey, oBrwSets, Len( aArray ),;
::aWindows[ ::nCurWindow ], ::objname, ::Arrayreference ) }
::aWindows[ ::nCurWindow ]:bKeyPressed := { | nKey | ::SetsKeyPressed( nKey, oBrwSets, Len( aArray ), ::Arrayreference ) }
::aWindows[ ::nCurwindow ]:cCaption := ::objname + " is of class: " +::TheObj:ClassName()
SetCursor( SC_NONE )
@@ -222,14 +221,11 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject
RETURN NIL
METHOD SetsKeyPressed( nKey, oBrwSets, nSets, oWnd, cName, aArray ) CLASS HBDbObject
METHOD SetsKeyPressed( nKey, oBrwSets, nSets, aArray ) CLASS HBDbObject
LOCAL nSet := oBrwSets:Cargo
LOCAL cOldname := ::objname
HB_SYMBOL_UNUSED( oWnd )
HB_SYMBOL_UNUSED( cName )
DO CASE
CASE nKey == K_UP

37
harbour/source/debug/dbgwa.prg
View File

@@ -101,14 +101,14 @@ function __dbgShowWorkAreas()
/* Alias browse */
aBrw[ 1 ] := TBrowseNew( oDlg:nTop + 1, oDlg:nLeft + 1, oDlg:nBottom - 1, oDlg:nLeft + 11 )
aBrw[ 1 ] := HBDbBrowser():new( oDlg:nTop + 1, oDlg:nLeft + 1, oDlg:nBottom - 1, oDlg:nLeft + 11 )
aBrw[ 1 ]:Cargo := ( n1 := cur_id )
aBrw[ 1 ]:ColorSpec := oDlg:cColor
aBrw[ 1 ]:GoTopBlock := { || n1 := 1 }
aBrw[ 1 ]:GoBottomBlock := { || n1 := Len( aAlias ) }
aBrw[ 1 ]:GoTopBlock := { || aBrw[ 1 ]:Cargo := n1 := 1 }
aBrw[ 1 ]:GoBottomBlock := { || aBrw[ 1 ]:Cargo := n1 := Len( aAlias ) }
aBrw[ 1 ]:SkipBlock := { | nSkip, nPos | nPos := n1,;
n1 := iif( nSkip > 0, Min( Len( aAlias ), n1 + nSkip ),;
aBrw[ 1 ]:Cargo := n1 := iif( nSkip > 0, Min( Len( aAlias ), n1 + nSkip ),;
Max( 1, n1 + nSkip ) ),;
n1 - nPos }
@@ -120,15 +120,16 @@ function __dbgShowWorkAreas()
aInfo := ( aAlias[ n1 ][ 1 ] )->( DbfInfo() )
aBrw[ 2 ] := TBrowseNew( 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 + 50 )
aBrw[ 2 ]:Cargo := ( n2 := 1 )
aBrw[ 2 ]:ColorSpec := oDlg:cColor
aBrw[ 2 ]:GoTopBlock := { || aBrw[ 2 ]:Cargo := n2 := 1 }
aBrw[ 2 ]:GoBottomBlock := { || n2 := Len( aInfo ) }
aBrw[ 2 ]:SkipBlock := { | nSkip, nPos | nPos := n2,;
n2 := iif( nSkip > 0, Min( Len( aInfo ), n2 + nSkip ),;
Max( 1, n2 + nSkip ) ), n2 - nPos }
aBrw[ 2 ]:GoBottomBlock := { || aBrw[ 2 ]:Cargo := n2 := Len( aInfo ) }
aBrw[ 2 ]:SkipBlock := { | nSkip, nPos | nPos := n2, ;
aBrw[ 2 ]:Cargo := n2 := iif( nSkip > 0, Min( Len( aInfo ), n2 + nSkip ), ;
Max( 1, n2 + nSkip ) ), ;
n2 - nPos }
aBrw[ 2 ]:AddColumn( oCol := TBColumnNew( "", { || PadR( aInfo[ n2 ], 38 ) } ) )
@@ -138,14 +139,14 @@ function __dbgShowWorkAreas()
aStruc := ( aAlias[ n1 ][ 1 ] )->( DbStruct() )
aBrw[ 3 ] := TBrowseNew( oDlg:nTop + 1, oDlg:nLeft + 52, oDlg:nBottom - 1, oDlg:nLeft + 70 )
aBrw[ 3 ] := HBDbBrowser():new( oDlg:nTop + 1, oDlg:nLeft + 52, oDlg:nBottom - 1, oDlg:nLeft + 70 )
aBrw[ 3 ]:Cargo := 1
aBrw[ 3 ]:Cargo := n3 := 1
aBrw[ 3 ]:ColorSpec := oDlg:cColor
aBrw[ 3 ]:GoTopBlock := { || aBrw[ 3 ]:Cargo := n3 := 1 }
aBrw[ 3 ]:GoBottomBlock := { || n3 := Len( aStruc ) }
aBrw[ 3 ]:GoBottomBlock := { || aBrw[ 3 ]:Cargo := n3 := Len( aStruc ) }
aBrw[ 3 ]:SkipBlock := { | nSkip, nPos | nPos := n3,;
n3 := iif( nSkip > 0, Min( Len( aStruc ), n3 + nSkip ),;
aBrw[ 3 ]:Cargo := n3 := iif( nSkip > 0, Min( Len( aStruc ), n3 + nSkip ),;
Max( 1, n3 + nSkip ) ), n3 - nPos }
aBrw[ 3 ]:AddColumn( TBColumnNew( "", { || PadR( aStruc[ n3, 1 ], 11 ) + ;
@@ -234,7 +235,7 @@ static function DlgWorkAreaKey( nKey, oDlg, aBrw, aAlias, aStruc, aInfo )
do case
case s_nFocus == 1
nAlias := aBrw[ 1 ]:Cargo
WorkAreasKeyPressed( nKey, aBrw[ 1 ], oDlg, Len( aAlias ) )
WorkAreasKeyPressed( nKey, aBrw[ 1 ], Len( aAlias ) )
if nAlias != aBrw[ 1 ]:Cargo
aBrw[ 2 ]:GoTop()
aBrw[ 2 ]:Invalidate()
@@ -257,16 +258,14 @@ static function DlgWorkAreaKey( nKey, oDlg, aBrw, aAlias, aStruc, aInfo )
UpdateInfo( oDlg, aAlias[ aBrw[ 1 ]:Cargo ][ 2 ] )
endif
case s_nFocus == 2
WorkAreasKeyPressed( nKey, aBrw[ 2 ], oDlg, Len( aInfo ) )
WorkAreasKeyPressed( nKey, aBrw[ 2 ], Len( aInfo ) )
case s_nFocus == 3
WorkAreasKeyPressed( nKey, aBrw[ 3 ], oDlg, Len( aStruc ) )
WorkAreasKeyPressed( nKey, aBrw[ 3 ], Len( aStruc ) )
endcase
return nil
static procedure WorkAreasKeyPressed( nKey, oBrw, oDlg, nTotal )
HB_SYMBOL_UNUSED( oDlg )
static procedure WorkAreasKeyPressed( nKey, oBrw, nTotal )
do case
case nKey == K_UP

107
harbour/source/debug/debugger.prg
View File

@@ -129,12 +129,12 @@ PROCEDURE __dbgAltDEntry()
PROCEDURE __dbgEntry( nMode, uParam1, uParam2, uParam3, uParam4, uParam5 )
LOCAL lStartup
DO CASE
CASE nMode == HB_DBG_GETENTRY
hb_DBG_SetEntry()
CASE nMode == HB_DBG_ACTIVATE
IF ( lStartup := ( s_oDebugger == NIL ) )
@@ -212,7 +212,7 @@ CREATE CLASS HBDebugger
VAR lCaseSensitive INIT .F.
VAR lMonoDisplay INIT .F.
VAR lSortVars INIT .F.
VAR cSearchString INIT ""
VAR cPathForFiles
VAR cSettingsFileName INIT "init.cld"
@@ -220,7 +220,7 @@ CREATE CLASS HBDebugger
VAR nTabWidth INIT 4
VAR nSpeed INIT 0
VAR lShowPublics INIT .F.
VAR lShowPrivates INIT .F.
VAR lShowStatics INIT .F.
@@ -232,8 +232,8 @@ CREATE CLASS HBDebugger
VAR lGo // stores if GO was requested
VAR lActive INIT .F.
VAR lCBTrace INIT .T. // stores if codeblock tracing is allowed
VAR oBrwPnt
VAR oWndPnt
VAR oBrwPnt
VAR oWndPnt
VAR lPPO INIT .F.
VAR lRunAtStartup INIT .T. // Clipper compatible
VAR lLineNumbers INIT .T.
@@ -407,6 +407,7 @@ METHOD New() CLASS HBDebugger
IF File( ::cSettingsFileName )
::LoadSettings()
::lGo := ::lRunAtStartup // Once again after settings file is loaded
ENDIF
RETURN Self
@@ -508,7 +509,7 @@ METHOD BarDisplay() CLASS HBDebugger
METHOD BuildBrowseStack() CLASS HBDebugger
IF ::oBrwStack == NIL
::oBrwStack := TBrowseNew( 2, ::nMaxCol - 14, ::nMaxRow - 7, ::nMaxCol - 1 )
::oBrwStack := HBDbBrowser():New( 2, ::nMaxCol - 14, ::nMaxRow - 7, ::nMaxCol - 1 )
::oBrwStack:ColorSpec := ::aColors[ 3 ] + "," + ::aColors[ 4 ] + "," + ::aColors[ 5 ]
::oBrwStack:goTopBlock := { || ::oBrwStack:Cargo := 1 }
::oBrwStack:goBottomBlock := { || ::oBrwStack:Cargo := Len( ::aProcStack ) }
@@ -665,7 +666,7 @@ METHOD CodeWindowProcessKey( nKey ) CLASS HBDebugger
DO CASE
CASE nKey == K_HOME .OR. nKey == K_CTRL_PGUP .OR. nKey == K_CTRL_HOME
::oBrwText:GoTop()
IF ::oWndCode:lFocused
SetCursor( SC_SPECIAL1 )
@@ -674,29 +675,31 @@ METHOD CodeWindowProcessKey( nKey ) CLASS HBDebugger
CASE nKey == K_END .OR. nKey == K_CTRL_PGDN .OR. nKey == K_CTRL_END
::oBrwText:GoBottom()
::oBrwText:End()
::oBrwText:nCol = ::oWndCode:nLeft + 1
::oBrwText:nFirstCol = ::oWndCode:nLeft + 1
SetPos( Row(), ::oWndCode:nLeft + 1 )
IF ::oWndCode:lFocused
SetCursor( SC_SPECIAL1 )
ENDIF
CASE nKey == K_LEFT
::oBrwText:Left()
CASE nKey == K_RIGHT
::oBrwText:Right()
CASE nKey == K_UP
::oBrwText:Up()
CASE nKey == K_DOWN
::oBrwText:Down()
CASE nKey == K_PGUP
::oBrwText:PageUp()
CASE nKey == K_PGDN
::oBrwText:PageDown()
ENDCASE
ENDIF
@@ -711,8 +714,8 @@ METHOD Colors() CLASS HBDebugger
"Text High Sel.", "Text PPO Sel.", "Menu", "Menu High",;
"Menu Selected", "Menu High Sel." }
LOCAL oBrwColors := TBrowseNew( oWndColors:nTop + 1, oWndColors:nLeft + 1,;
oWndColors:nBottom - 1, oWndColors:nRight - 1 )
LOCAL oBrwColors := HBDbBrowser():New( oWndColors:nTop + 1, oWndColors:nLeft + 1,;
oWndColors:nBottom - 1, oWndColors:nRight - 1 )
LOCAL nWidth := oWndColors:nRight - oWndColors:nLeft - 1
LOCAL oCol
@@ -1223,7 +1226,7 @@ METHOD GetExprValue( xExpr, lValid ) CLASS HBDebugger
LOCAL xResult
LOCAL oErr
LOCAL bOldErrorBlock := ErrorBlock( { | oErr | Break( oErr ) } )
lValid := .F.
BEGIN SEQUENCE
@@ -1707,7 +1710,7 @@ METHOD LoadCallStack() CLASS HBDebugger
LOCAL nCurrLevel
LOCAL nlevel
LOCAL nPos
::aProcStack := Array( ::nProcLevel )
nCurrLevel := hb_dbg_ProcLevel() - 1
@@ -1851,9 +1854,9 @@ METHOD Local() CLASS HBDebugger
METHOD Locate( nMode, cValue ) CLASS HBDebugger
LOCAL lFound
DEFAULT nMode TO 0
IF Empty( cValue )
::cSearchString := PadR( ::cSearchString, 256 )
cValue := ::InputBox( "Search string", ::cSearchString )
@@ -1861,11 +1864,11 @@ METHOD Locate( nMode, cValue ) CLASS HBDebugger
RETURN NIL
ENDIF
ENDIF
::cSearchString := cValue
lFound := ::oBrwText:Search( ::cSearchString, ::lCaseSensitive, nMode )
// Save cursor position to be restored by ::oWndCode:bGotFocus
::oWndCode:cargo[ 1 ] := Row()
::oWndCode:cargo[ 2 ] := Col()
@@ -2129,7 +2132,7 @@ METHOD Public() CLASS HBDebugger
METHOD RedisplayBreakPoints() CLASS HBDebugger
LOCAL n
FOR n := 1 TO Len( ::aBreakpoints )
IF FILENAME_EQUAL( ::aBreakpoints[ n ][ 2 ], strip_path( ::cPrgName ) )
::oBrwText:ToggleBreakPoint( ::aBreakpoints[ n ][ 1 ], .T.)
@@ -2162,14 +2165,14 @@ METHOD RefreshVars() CLASS HBDebugger
METHOD RemoveWindow( oWnd ) CLASS HBDebugger
LOCAL n := AScan( ::aWindows, { | o | o == oWnd } )
IF n != 0
::aWindows := ADel( ::aWindows, n )
::aWindows := ASize( ::aWindows, Len( ::aWindows ) - 1 )
ENDIF
::nCurrentWindow := 1
RETURN NIL
@@ -2180,13 +2183,13 @@ METHOD ResizeWindows( oWindow ) CLASS HBDebugger
LOCAL oWindow2
LOCAL nTop
LOCAL lVisible2 := .F.
IF oWindow == ::oWndVars
oWindow2 := ::oWndPnt
ELSEIF oWindow == ::oWndPnt
oWindow2 := ::oWndVars
ENDIF
DispBegin()
IF oWindow2 == NIL
nTop := oWindow:nBottom + 1
@@ -2803,23 +2806,23 @@ METHOD ToggleBreakPoint( nLine, cFileName ) CLASS HBDebugger
// look for a breakpoint which matches both line number and program name
LOCAL nAt
IF !::lActive
RETURN NIL
ENDIF
IF nLine == NIL
cFileName := strip_path( ::cPrgName )
nLine := ::oBrwText:RowPos()
ENDIF
IF !::IsValidStopLine( cFileName, nLine )
RETURN NIL
ENDIF
nAt := AScan( ::aBreakPoints, { | aBreak | aBreak[ 1 ] == nLine ;
.AND. FILENAME_EQUAL( aBreak[ 2 ], cFileName ) } )
IF nAt == 0
AAdd( ::aBreakPoints, { nLine, cFileName } ) // it was nLine
hb_DBG_AddBreak( ::pInfo, cFileName, nLine )
@@ -2834,7 +2837,7 @@ METHOD ToggleBreakPoint( nLine, cFileName ) CLASS HBDebugger
::oBrwText:ToggleBreakPoint( nLine, .F. )
ENDIF
ENDIF
::oBrwText:RefreshCurrent()
RETURN NIL
@@ -2893,7 +2896,7 @@ METHOD VarGetInfo( aVar ) CLASS HBDebugger
METHOD VarGetValue( aVar ) CLASS HBDebugger
LOCAL cType := Left( aVar[ VAR_TYPE ], 1 )
DO CASE
CASE cType == "G" ; RETURN hb_dbg_vmVarGGet( aVar[ VAR_LEVEL ], aVar[ VAR_POS ] )
CASE cType == "L" ; RETURN hb_dbg_vmVarLGet( hb_dbg_procLevel() - aVar[ VAR_LEVEL ], aVar[ VAR_POS ] )
@@ -2910,22 +2913,22 @@ METHOD VarSetValue( aVar, uValue ) CLASS HBDebugger
LOCAL nProcLevel
LOCAL cType := Left( aVar[ VAR_TYPE ], 1 )
IF cType == "G"
hb_dbg_vmVarGSet( aVar[ VAR_LEVEL ], aVar[ VAR_POS ], uValue )
ELSEIF cType == "L"
nProcLevel := hb_dbg_procLevel() - aVar[ VAR_LEVEL ] //skip debugger stack
hb_dbg_vmVarLSet( nProcLevel, aVar[ VAR_POS ], uValue )
ELSEIF cType == "S"
hb_dbg_vmVarSSet( aVar[ VAR_LEVEL ], aVar[ VAR_POS ], uValue )
ELSE
// Public or Private
aVar[ VAR_POS ] := uValue
&( aVar[ VAR_NAME ] ) := uValue
ENDIF
RETURN Self
@@ -2945,8 +2948,8 @@ METHOD ViewSets() CLASS HBDebugger
"EventMask", "VideoMode", "MBlockSize", "MFileExt",;
"StrictRead", "Optimize", "Autopen", "Autorder", "AutoShare" }
LOCAL oBrwSets := TBrowseNew( oWndSets:nTop + 1, oWndSets:nLeft + 1,;
oWndSets:nBottom - 1, oWndSets:nRight - 1 )
LOCAL oBrwSets := HBDbBrowser():new( oWndSets:nTop + 1, oWndSets:nLeft + 1,;
oWndSets:nBottom - 1, oWndSets:nRight - 1 )
LOCAL nWidth := oWndSets:nRight - oWndSets:nLeft - 1
LOCAL oCol
@@ -3146,7 +3149,7 @@ METHOD WatchpointsShow() CLASS HBDebugger
::oWndPnt:Browser := ::oBrwPnt
::oBrwPnt:Cargo := { 1, {} } // Actual highligthed row
::oBrwPnt:Cargo := { 1, {} } // Actual highlighted row
::oBrwPnt:ColorSpec := ::aColors[ 2 ] + "," + ::aColors[ 5 ] + "," + ::aColors[ 3 ]
::oBrwPnt:goTopBlock := { || ::oBrwPnt:cargo[ 1 ] := Min( 1, Len(::aWatch ) ) }
::oBrwPnt:goBottomBlock := { || ::oBrwPnt:cargo[ 1 ] := Len( ::aWatch ) }
@@ -3285,7 +3288,7 @@ STATIC PROCEDURE StripUntil( pcLine, i, cChar )
LOCAL j
LOCAL n
LOCAL nLen := Len( pcLine )
n := Len( cChar )
j := i + n
DO WHILE j <= nLen .AND. SubStr( pcLine, j, n ) != cChar
@@ -3349,7 +3352,7 @@ STATIC FUNCTION PathToArray( cList )
AAdd( aList, cList ) // Add final element
/* Strip ending delimiters */
//AEval( aList, { | x, i | iif( Right( x, 1 ) $ cDirSep, aList[ i ] := Left( x, Len( x ) - 1 ), ) } )
AEval( aList, { | x, i | iif( Right( x, 1 ) $ cDirSep, aList[ i ] := Left( x, Len( x ) - 1 ), ) } )
ENDIF
RETURN aList
@@ -3376,14 +3379,14 @@ STATIC FUNCTION strip_path( cFileName )
#ifdef HB_NO_READDBG
STATIC FUNCTION getdbginput( nTop, nLeft, uValue, bValid, cColor )
LOCAL nOldCursor := SetCursor( SC_NORMAL )
LOCAL uTemp := uValue
IF cColor != NIL
SetColor( cColor )
ENDIF
DO WHILE .T.
@ nTop, nLeft SAY Space( Len( uTemp ) )
@ nTop, nLeft SAY ""
@@ -3396,7 +3399,7 @@ STATIC FUNCTION getdbginput( nTop, nLeft, uValue, bValid, cColor )
EXIT
ENDIF
ENDDO
SetCursor( nOldCursor )
RETURN uTemp

40
harbour/source/debug/tbrwtext.prg
View File

@@ -72,7 +72,7 @@ CREATE CLASS HBBrwText INHERIT HBEditor
ACCESS colorSpec INLINE ::cColorSpec
ASSIGN colorSpec( cClr ) INLINE ::cColorSpec := cClr
METHOD New( nTop, nLeft, nBottom, nRight, cFileName, cColor )
METHOD New( nTop, nLeft, nBottom, nRight, cFileName, cColor, lLineNumbers, nTabWidth )
METHOD GoTop() // Methods available on a standard TBrowse, needed to handle a HBEditor like a TBrowse
METHOD GoBottom()
@@ -85,6 +85,8 @@ CREATE CLASS HBBrwText INHERIT HBEditor
METHOD PageDown()
METHOD RefreshAll()
METHOD RefreshCurrent()
METHOD Resize( nTop, nLeft, nBottom, nRight )
METHOD ScrollTo( nCol ) // Scroll the window to specified column
METHOD ForceStable() INLINE NIL
METHOD GotoLine( n ) // Moves active line cursor
METHOD SetActiveLine( n ) // Sets the line to be executed
@@ -92,11 +94,11 @@ CREATE CLASS HBBrwText INHERIT HBEditor
METHOD LineColor( nRow ) // Redefine HBEditor method to handle line coloring
METHOD ToggleBreakPoint( nRow, lSet ) // if lSet is .T. there is a BreakPoint active at nRow, if lSet is .F. BreakPoint at nRow has to be removed
METHOD Search( cString, lCaseSensitive, nMode ) // 0 from Begining to end, 1 Forward, 2 Backwards
METHOD LoadFile( cFileName )
METHOD RowPos()
ENDCLASS
METHOD New( nTop, nLeft, nBottom, nRight, cFileName, cColor, lLineNumbers ) CLASS HBBrwText
METHOD New( nTop, nLeft, nBottom, nRight, cFileName, cColor, lLineNumbers, nTabWidth ) CLASS HBBrwText
DEFAULT cColor TO SetColor()
DEFAULT lLineNumbers TO .T.
@@ -104,18 +106,12 @@ METHOD New( nTop, nLeft, nBottom, nRight, cFileName, cColor, lLineNumbers ) CLAS
::cFileName := cFileName
::lLineNumbers := lLineNumbers
::Super:New( "", nTop, nLeft, nBottom, nRight, .T. )
::Super:New( "", nTop, nLeft, nBottom, nRight, .F., -1, nTabWidth )
::Super:SetColor( cColor )
::Super:LoadFile( cFileName )
RETURN Self
METHOD LoadFile( cFileName ) CLASS HBBrwText
::Super:LoadFile( cFileName )
RETURN Self
METHOD GoTop() CLASS HBBrwText
::MoveCursor( K_CTRL_PGUP )
@@ -170,6 +166,10 @@ METHOD PageDown() CLASS HBBrwText
RETURN Self
METHOD RowPos()
RETURN ::nRow
METHOD RefreshAll() CLASS HBBrwText
::display()
@@ -229,6 +229,26 @@ METHOD ToggleBreakPoint( nRow, lSet ) CLASS HBBrwText
RETURN Self
/* This method is to restore correct cursor position after ::Super:Resize() */
METHOD Resize( nTop, nLeft, nBottom, nRight ) CLASS HBBrwText
LOCAL nRow
nRow := ::nRow
::Super:Resize( nTop, nLeft, nBottom, nRight )
::GotoLine( nRow )
RETURN Self
METHOD ScrollTo( nCol ) CLASS HBBrwText
IF nCol >= 1
::nCol := nCol
::nFirstCol := nCol
::display()
::SetPos( ::Row(), ::nLeft )
ENDIF
RETURN Self
METHOD Search( cString, lCaseSensitive, nMode ) CLASS HBBrwText
LOCAL nFrom