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

2014-08-13 16:27 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)

Browse Source 
* src/debug/dbgentry.c
  * src/debug/debugger.prg
  * src/debug/tbrwtext.prg
    * use one function to divide text per lines with the same rules
      as used in Cl*pper and Harbour PP.
    ! fixed input line size in SET edit window
    ! fixed validation in some input boxes
    * process only 1-st parameter in some commands just like Cl*pper does
    + added support for FILE OPEN <name> command
    ! fixed CALLSTACK ON | OFF command
    ! fixed NUM command
    + added support for VIEW <fileName> command
    + added support for LOCATE GOTOLINE <line> command
    + added support for LOCATE FIND <text> command
    + added support for RUN SPEED <num> command
    + added support for LIST WP|TP command
    + added support for BP <funcName> command
    + added support for DELETE ALL [TP|WP] and DELETE WP|TP <number>
      commands
    % few optimizations and some other minor fixes
This commit is contained in:
Przemysław Czerpak
2014-08-13 16:27:16 +02:00
parent 3f86036f80
commit a1cbbb2cbf
4 changed files with 359 additions and 261 deletions
Download Patch File Download Diff File Expand all files Collapse all files

22
ChangeLog.txt
View File

@@ -10,6 +10,28 @@
* Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment
*/
2014-08-13 16:27 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)
* src/debug/dbgentry.c
* src/debug/debugger.prg
* src/debug/tbrwtext.prg
* use one function to divide text per lines with the same rules
as used in Cl*pper and Harbour PP.
! fixed input line size in SET edit window
! fixed validation in some input boxes
* process only 1-st parameter in some commands just like Cl*pper does
+ added support for FILE OPEN <name> command
! fixed CALLSTACK ON | OFF command
! fixed NUM command
+ added support for VIEW <fileName> command
+ added support for LOCATE GOTOLINE <line> command
+ added support for LOCATE FIND <text> command
+ added support for RUN SPEED <num> command
+ added support for LIST WP|TP command
+ added support for BP <funcName> command
+ added support for DELETE ALL [TP|WP] and DELETE WP|TP <number>
commands
% few optimizations and some other minor fixes
2014-08-11 16:21 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)
+ contrib/hbcomio/hbcomio.hbx
+ added missing hbx file

18
src/debug/dbgentry.c
View File

@@ -402,8 +402,8 @@ void hb_dbgEntry( int nMode, int nLine, const char * szName, int nIndex, PHB_ITE
hb_dbgAddStack( info, szName, uiLine, hb_dbg_ProcLevel() );
for( i = 0; i < info->nBreakPoints; i++ )
{
if( info->aBreak[ i ].szFunction
&& ! strcmp( info->aBreak[ i ].szFunction, szProcName ) )
if( info->aBreak[ i ].szFunction &&
! strcmp( info->aBreak[ i ].szFunction, szProcName ) )
{
hb_dbg_InvokeDebug( HB_TRUE );
break;
@@ -577,9 +577,11 @@ void hb_dbgAddBreak( void * handle, const char * szModule, int nLine, const char
HB_DEBUGINFO * info = ( HB_DEBUGINFO * ) handle;
HB_BREAKPOINT * pBreak;
szModule = hb_dbgStripModuleName( szModule );
pBreak = ARRAY_ADD( HB_BREAKPOINT, info->aBreak, info->nBreakPoints );
pBreak->szModule = hb_strdup( szModule );
if( szModule )
pBreak->szModule = hb_strdup( hb_dbgStripModuleName( szModule ) );
else
pBreak->szModule = NULL;
pBreak->nLine = nLine;
if( szFunction )
@@ -864,7 +866,8 @@ void hb_dbgDelBreak( void * handle, int nBreak )
{
HB_BREAKPOINT * pBreak = &info->aBreak[ nBreak ];
hb_xfree( pBreak->szModule );
if( pBreak->szModule )
hb_xfree( pBreak->szModule );
if( pBreak->szFunction )
hb_xfree( pBreak->szFunction );
@@ -1394,7 +1397,8 @@ static int hb_dbgIsBreakPoint( HB_DEBUGINFO * info, const char * szModule, int n
{
HB_BREAKPOINT * point = &info->aBreak[ i ];
if( point->nLine == nLine && FILENAME_EQUAL( szModule, point->szModule ) )
if( point->nLine == nLine && point->szModule &&
FILENAME_EQUAL( szModule, point->szModule ) )
return i;
}
return -1;
@@ -1760,7 +1764,7 @@ HB_FUNC( __DBGADDBREAK )
void * ptr = hb_parptr( 1 );
if( ptr )
hb_dbgAddBreak( ptr, hb_parc( 2 ), hb_parni( 3 ), NULL );
hb_dbgAddBreak( ptr, hb_parc( 2 ), hb_parni( 3 ), hb_parc( 4 ) );
}
HB_FUNC( __DBGDELBREAK )

559
src/debug/debugger.prg
View File

@@ -275,7 +275,7 @@ CREATE CLASS HBDebugger
METHOD MonoDisplay()
METHOD NextWindow()
METHOD Open()
METHOD Open( cFileName )
METHOD OpenMenu( cName )
METHOD OpenPPO()
METHOD Resume() INLINE ::ShowCodeLine( 1 )
@@ -309,7 +309,7 @@ CREATE CLASS HBDebugger
METHOD Speed() INLINE ::nSpeed := ::InputBox( "Step delay (in tenths of a second)", ::nSpeed )
METHOD Stack()
METHOD Stack( cParam )
METHOD Static()
METHOD Step()
@@ -318,9 +318,10 @@ CREATE CLASS HBDebugger
::nTabWidth := ::InputBox( "Tab width", ::nTabWidth ), ;
::oBrwText:nTabWidth := ::nTabWidth, ::oBrwText:RefreshAll()
METHOD ToggleBreakPoint( nLine, cFileName )
METHOD DeleteBreakPoint( cPos )
METHOD ListBreakPoint()
METHOD BreakPointToggle( nLine, cFileName )
METHOD BreakPointDelete( cPos )
METHOD BreakPointFunc( cFuncName )
METHOD BreakPointList()
METHOD Trace()
@@ -330,19 +331,20 @@ CREATE CLASS HBDebugger
METHOD WndVarsLButtonDown( nMRow, nMCol )
METHOD LineNumbers( lLineNumbers ) // Toggles numbering of source code lines
METHOD RemoveWindow( oWnd )
METHOD SearchLine()
METHOD SearchLine( cLine )
METHOD ToggleAnimate() INLINE ::oPullDown:GetItemByIdent( "ANIMATE" ):checked := ::lAnimate := ! ::lAnimate
METHOD ToggleCaseSensitive() INLINE ::oPullDown:GetItemByIdent( "CASE" ):checked := ::lCaseSensitive := ! ::lCaseSensitive
METHOD ShowWorkAreas() INLINE __dbgShowWorkAreas( Self )
METHOD TracepointAdd( cExpr )
METHOD WatchpointAdd( cExpr )
METHOD WatchpointDel( nPos )
METHOD WatchpointDel( xPos )
METHOD WatchpointsShow()
METHOD WatchpointsHide()
METHOD WatchpointEdit( nPos )
METHOD WatchpointInspect( nPos )
METHOD WatchGetInfo( nWatch )
METHOD WatchpointList()
METHOD VarGetInfo( aVar )
METHOD VarGetValue( aVar )
@@ -840,8 +842,9 @@ METHOD PROCEDURE CommandWindowProcessKey( nKey ) CLASS HBDebugger
METHOD DoCommand( cCommand ) CLASS HBDebugger
LOCAL aCmnd[ 3 ]
LOCAL cParam := ""
LOCAL cParam1 := ""
LOCAL cParam2 := ""
LOCAL cParams := ""
LOCAL cResult
LOCAL lValid
LOCAL oWindow
@@ -854,29 +857,33 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
RETURN ""
CASE hb_LeftEq( cCommand, "??" )
cParam := AllTrim( SubStr( cCommand, 3 ) )
cParams := AllTrim( SubStr( cCommand, 3 ) )
cCommand := "??"
CASE hb_LeftEq( cCommand, "?" )
cParam := SubStr( cCommand, 2 )
cParams := SubStr( cCommand, 2 )
cCommand := "?"
OTHERWISE
IF ( n := At( " ", cCommand ) ) > 0
cParam := AllTrim( SubStr( cCommand, n + 1 ) )
cParam1 := cParams := AllTrim( SubStr( cCommand, n + 1 ) )
cCommand := Left( cCommand, n - 1 )
IF ( n := At( " ", cParam1 ) ) > 0
cParam2 := AllTrim( SubStr( cParam1, n + 1 ) )
cParam1 := Left( cParam1, n - 1 )
ENDIF
ENDIF
cCommand := Upper( cCommand )
cParam1 := Upper( cParam1 )
ENDCASE
DO CASE
CASE cCommand == "??" .OR. cCommand == "?"
aCmnd[ WP_TYPE ] := cCommand
aCmnd[ WP_EXPR ] := cParam
aCmnd[ WP_EXPR ] := cParams
::RestoreAppState()
cResult := ::GetExprValue( cParam, @lValid )
cResult := ::GetExprValue( cParams, @lValid )
::SaveAppState()
IF aCmnd[ WP_TYPE ] == "??"
@@ -896,36 +903,38 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
ENDIF
CASE cCommand == "BP"
/* TODO: Support BP <cFuncName> */
IF Empty( cParam )
::ToggleBreakPoint()
ELSE
IF ( n := At( " ", cParam ) ) > 0
cParam1 := AllTrim( SubStr( cParam, n + 1 ) )
cParam := Left( cParam, n - 1 )
ELSE
cParam1 := ::cPrgName
ENDIF
::ToggleBreakPoint( Val( cParam ), cParam1 )
IF Empty( cParam1 )
::BreakPointToggle()
ELSEIF IsDigit( cParam1 )
::BreakPointToggle( Val( cParam1 ), ;
iif( Empty( cParam2 ), ::cPrgName, cParam2 ) )
ELSEIF hb_asciiIsAlpha( cParam1 ) .OR. hb_LeftEq( cParam1, "_" )
::BreakPointFunc( cParam1 )
ENDIF
CASE hb_LeftEqN( "CALLSTACK", cCommand, 4 )
::Stack( Upper( cParam ) == "ON" )
::Stack( cParam1 )
CASE hb_LeftEqN( "DELETE", cCommand, 3 )
IF ( n := At( " ", cParam ) ) > 0
cParam1 := Upper( AllTrim( SubStr( cParam, n + 1 ) ) )
cParam := Left( cParam, n - 1 )
ENDIF
cParam := Upper( cParam )
DO CASE
CASE cParam == "ALL" .AND. hb_LeftEq( cParam1, "B" )
::DeleteBreakPoint( cParam )
CASE cParam == "BP"
::DeleteBreakPoint( cParam1 )
CASE cParam1 == "BP"
::BreakPointDelete( cParam2 )
CASE cParam1 == "WP" .OR. cParam2 == "TP"
::WatchpointDel( cParam2 )
CASE cParam1 == "ALL"
DO CASE
CASE Empty( cParam2 )
::BreakPointDelete( cParam1 )
::WatchpointDel( cParam1 )
CASE hb_LeftEqI( "BP", cParam2 )
::BreakPointDelete( cParam1 )
CASE hb_LeftEqI( "WP", cParam2 ) .OR. hb_LeftEqI( "TP", cParam2 )
::WatchpointDel( cParam1 )
OTHERWISE
/* Cl*pper clears break and watch points in such case */
cResult := "Command error"
ENDCASE
OTHERWISE
/* TODO: Support DELETE ALL [TP|WP], DELETE WP|TP <nNumber> */
cResult := "Command error"
ENDCASE
@@ -933,73 +942,72 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
::OsShell()
CASE hb_LeftEq( "FILE", cCommand )
cParam := Upper( cParam )
DO CASE
CASE Empty( cParam )
CASE Empty( cParam1 )
::OpenMenu( cCommand )
CASE hb_LeftEq( "OPEN", cParam )
::Open()
CASE hb_LeftEq( "RESUME", cParam )
CASE hb_LeftEq( "OPEN", cParam1 )
::Open( cParam2 )
CASE hb_LeftEq( "RESUME", cParam1 )
::Resume()
CASE hb_LeftEq( "OS", cParam ) .OR. hb_LeftEq( "DOS", cParam )
CASE hb_LeftEq( "OS", cParam1 ) .OR. hb_LeftEq( "DOS", cParam1 )
::OSShell()
CASE hb_LeftEq( "EXIT", cParam )
CASE hb_LeftEq( "EXIT", cParam1 )
::Quit()
OTHERWISE
cResult := "Command error"
ENDCASE
CASE cCommand == "FIND"
::Locate( 0, cParam )
::Locate( 0, cParams )
CASE hb_LeftEqN( "GOTO", cCommand, 4 ) .AND. Val( cParam ) > 0
::GoToLine( Val( cParam ) )
CASE hb_LeftEqN( "GOTO", cCommand, 4 ) .AND. ( n := Val( cParam1 ) ) > 0
::GoToLine( n )
CASE hb_LeftEq( "GO", cCommand )
::Go()
CASE cCommand == "HELP"
::ShowHelp( cParam )
::ShowHelp( cParam1 )
CASE hb_LeftEqN( "INPUT", cCommand, 4 )
IF Empty( cParam )
cParam := AllTrim( ::InputBox( "File name" ) )
IF Empty( cParams )
cParams := AllTrim( ::InputBox( "File name",, ;
{| cFile | hb_FileExists( cFile ) .OR. ;
( __dbgAlert( "File unavailable" ), .F. ) } ) )
IF LastKey() == K_ESC
cParam := ""
cParams := ""
ENDIF
ENDIF
IF ! Empty( cParam )
::DoScript( cParam )
IF ! Empty( cParams )
::DoScript( cParams )
ENDIF
CASE cCommand == "LIST"
IF ( n := At( " ", cParam ) ) > 0
cParam := Left( cParam, n - 1 )
ENDIF
cParam := Upper( cParam )
DO CASE
CASE cParam == "BP"
::ListBreakPoint()
SWITCH cParam1
CASE "BP"
::BreakPointList()
EXIT
CASE "WP"
CASE "TP"
::WatchpointList()
EXIT
OTHERWISE
/* TODO: Support LIST WP|TP */
cResult := "Command error"
ENDCASE
ENDSWITCH
CASE hb_LeftEq( "LOCATE", cCommand )
cParam := Upper( cParam )
DO CASE
CASE Empty( cParam )
CASE Empty( cParam1 )
::OpenMenu( cCommand )
CASE hb_LeftEq( "FIND", cParam )
::Locate()
CASE hb_LeftEq( "NEXT", cParam )
CASE hb_LeftEq( "FIND", cParam1 )
::Locate( 0, cParam2 )
CASE hb_LeftEq( "NEXT", cParam1 )
::FindNext()
CASE hb_LeftEq( "PREVIOUS", cParam )
CASE hb_LeftEq( "PREVIOUS", cParam1 )
::FindPrevious()
CASE hb_LeftEq( "GOTOLINE", cParam )
::SearchLine()
CASE hb_LeftEq( "CASESENSITIVE", cParam )
CASE hb_LeftEq( "GOTOLINE", cParam1 )
::SearchLine( cParam2 )
CASE hb_LeftEq( "CASESENSITIVE", cParam1 )
::ToggleCaseSensitive()
OTHERWISE
cResult := "Command error"
@@ -1007,26 +1015,24 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
CASE hb_LeftEq( "MONITOR", cCommand )
cParam := Upper( cParam )
/* Here the order of CASEs makes sense: M P is Public, while M Pr is
* Private, etc. */
DO CASE
CASE hb_LeftEq( "PUBLIC", cParam )
CASE hb_LeftEq( "PUBLIC", cParam1 )
::Public()
CASE hb_LeftEq( "PRIVATE", cParam )
CASE hb_LeftEq( "PRIVATE", cParam1 )
::Private()
CASE hb_LeftEq( "STATIC", cParam )
CASE hb_LeftEq( "STATIC", cParam1 )
::Static()
CASE hb_LeftEq( "LOCAL", cParam )
CASE hb_LeftEq( "LOCAL", cParam1 )
::Local()
CASE hb_LeftEq( "GLOBAL", cParam )
CASE hb_LeftEq( "GLOBAL", cParam1 )
::Global()
CASE hb_LeftEq( "ALL", cParam )
CASE hb_LeftEq( "ALL", cParam1 )
::All()
CASE hb_LeftEq( "SORT", cParam )
CASE hb_LeftEq( "SORT", cParam1 )
::Sort()
CASE hb_LeftEq( "SHOWALLGLOBALS", cParam )
CASE hb_LeftEq( "SHOWALLGLOBALS", cParam1 )
::ShowAllGlobals()
OTHERWISE
cResult := "Command error"
@@ -1036,72 +1042,64 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
::FindNext()
CASE cCommand == "NUM"
SWITCH Upper( cParam )
SWITCH cParam1
CASE "OFF"
::LineNumbers( .F. ) ; EXIT
CASE "ON"
::LineNumbers( .T. ) ; EXIT
OTHERWISE
cResult := "Command error"
::LineNumbers() ; EXIT
ENDSWITCH
CASE hb_LeftEq( "OPTIONS", cCommand )
IF ( n := At( " ", cParam ) ) > 0
cParam1 := AllTrim( SubStr( cParam, n + 1 ) )
cParam := Left( cParam, n - 1 )
ENDIF
cParam := Upper( cParam )
DO CASE
CASE Empty( cParam )
CASE Empty( cParam1 )
::OpenMenu( cCommand )
CASE hb_LeftEq( "PREPROCESSEDCODE", cParam )
CASE hb_LeftEq( "PREPROCESSEDCODE", cParam1 )
::OpenPPO()
CASE hb_LeftEq( "LINENUMBERS", cParam )
CASE hb_LeftEq( "LINENUMBERS", cParam1 )
::LineNumbers()
CASE hb_LeftEq( "EXCHANGESCREENS", cParam ) .OR. ;
hb_LeftEq( "SWAPONINPUT", cParam ) .OR. ;
hb_LeftEq( "MENUBAR", cParam )
CASE hb_LeftEq( "EXCHANGESCREENS", cParam1 ) .OR. ;
hb_LeftEq( "SWAPONINPUT", cParam1 ) .OR. ;
hb_LeftEq( "MENUBAR", cParam1 )
::NotSupported()
CASE hb_LeftEq( "CODEBLOCKTRACE", cParam )
CASE hb_LeftEq( "CODEBLOCKTRACE", cParam1 )
::CodeblockTrace()
CASE hb_LeftEq( "MONODISPLAY", cParam )
CASE hb_LeftEq( "MONODISPLAY", cParam1 )
::MonoDisplay()
CASE hb_LeftEq( "COLORS", cParam )
IF Empty( cParam1 )
CASE hb_LeftEq( "COLORS", cParam1 )
IF Empty( cParam2 )
::Colors()
ELSE
cParam1 := SubStr( cParam1, At( "{", cParam1 ) + 1 )
cParam2 := SubStr( cParam2, At( "{", cParam2 ) + 1 )
FOR n := 1 TO 11
IF "," $ cParam1
IF "," $ cParam2
::aColors[ n ] := ;
StrTran( Left( cParam1, At( ",", cParam1 ) - 1 ), '"' )
cParam1 := SubStr( cParam1, At( ",", cParam1 ) + 1 )
StrTran( Left( cParam2, At( ",", cParam2 ) - 1 ), '"' )
cParam2 := SubStr( cParam2, At( ",", cParam2 ) + 1 )
ELSE
::aColors[ n ] := ;
StrTran( Left( cParam1, At( "}", cParam1 ) - 1 ), '"' )
StrTran( Left( cParam2, At( "}", cParam2 ) - 1 ), '"' )
ENDIF
NEXT
::LoadColors()
ENDIF
CASE hb_LeftEq( "TABWIDTH", cParam )
IF Empty( cParam1 )
::TabWidth()
CASE hb_LeftEq( "TABWIDTH", cParam1 )
IF IsDigit( cParam2 )
::nTabWidth := Min( Val( cParam2 ), 16 )
ELSE
::nTabWidth := Val( Left( cParam1, 3 ) )
::TabWidth()
ENDIF
CASE hb_LeftEq( "PATHFORFILES", cParam )
::PathForFiles( AllTrim( cParam1 ) )
CASE hb_LeftEq( "RUNATSTARTUP", cParam )
CASE hb_LeftEq( "PATHFORFILES", cParam1 )
::PathForFiles( AllTrim( cParam2 ) )
CASE hb_LeftEq( "RUNATSTARTUP", cParam1 )
::RunAtStartup( .T. )
CASE hb_LeftEq( "NORUNATSTARTUP", cParam )
CASE hb_LeftEq( "NORUNATSTARTUP", cParam1 )
::RunAtStartup( .F. )
CASE hb_LeftEq( "SAVESETTINGS", cParam )
::SaveSettings( AllTrim( cParam1 ) )
CASE hb_LeftEq( "RESTORESETTINGS", cParam )
::RestoreSettings( AllTrim( cParam1 ) )
CASE hb_LeftEq( "SAVESETTINGS", cParam1 )
::SaveSettings( AllTrim( cParam2 ) )
CASE hb_LeftEq( "RESTORESETTINGS", cParam1 )
::RestoreSettings( AllTrim( cParam2 ) )
OTHERWISE
cResult := "Command error"
ENDCASE
@@ -1110,17 +1108,16 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
::ShowAppScreen()
CASE hb_LeftEq( "POINT", cCommand )
cParam := Upper( cParam )
DO CASE
CASE Empty( cParam )
CASE Empty( cParam1 )
::OpenMenu( cCommand )
CASE hb_LeftEq( "WATCHPOINT", cParam )
CASE hb_LeftEq( "WATCHPOINT", cParam1 )
::WatchpointAdd()
CASE hb_LeftEq( "TRACEPOINT", cParam )
CASE hb_LeftEq( "TRACEPOINT", cParam1 )
::TracepointAdd()
CASE hb_LeftEq( "BREAKPOINT", cParam )
::ToggleBreakPoint()
CASE hb_LeftEq( "DELETE", cParam )
CASE hb_LeftEq( "BREAKPOINT", cParam1 )
::BreakPointToggle()
CASE hb_LeftEq( "DELETE", cParam1 )
::WatchpointDel()
OTHERWISE
cResult := "Command error"
@@ -1138,110 +1135,105 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
::Resume()
CASE hb_LeftEq( "RUN", cCommand )
cParam := Upper( cParam )
DO CASE
CASE Empty( cParam )
CASE Empty( cParam1 )
::OpenMenu( cCommand )
CASE hb_LeftEq( "ANIMATE", cParam )
CASE hb_LeftEq( "ANIMATE", cParam1 )
::ToggleAnimate()
::Animate()
CASE hb_LeftEq( "STEP", cParam )
CASE hb_LeftEq( "STEP", cParam1 )
::Step()
CASE hb_LeftEq( "TRACE", cParam )
CASE hb_LeftEq( "TRACE", cParam1 )
::Trace()
CASE hb_LeftEq( "GO", cParam )
CASE hb_LeftEq( "GO", cParam1 )
::Go()
CASE hb_LeftEq( "TOCURSOR", cParam )
CASE hb_LeftEq( "TOCURSOR", cParam1 )
::ToCursor()
CASE hb_LeftEq( "NEXTROUTINE", cParam )
CASE hb_LeftEq( "NEXTROUTINE", cParam1 )
::NextRoutine()
CASE hb_LeftEq( "SPEED", cParam )
::Speed()
CASE hb_LeftEq( "SPEED", cParam1 )
IF IsDigit( cParam2 )
::nSpeed := Min( Val( cParam2 ), 65534 )
ELSE
::Speed()
ENDIF
OTHERWISE
cResult := "Command error"
ENDCASE
CASE hb_LeftEqN( "SPEED", cCommand, 4 )
IF Empty( cParam )
::nSpeed := 0
IF IsDigit( cParam1 )
::nSpeed := Min( Val( cParam1 ), 65534 )
ELSE
::nSpeed := Val( cParam )
::Speed()
ENDIF
CASE cCommand == "STEP"
::Step()
CASE cCommand == "TP"
::TracepointAdd( cParam )
::TracepointAdd( cParams )
CASE hb_LeftEq( "VIEW", cCommand )
cParam := Upper( cParam )
DO CASE
CASE Empty( cParam )
CASE Empty( cParam1 )
::OpenMenu( cCommand )
CASE hb_LeftEq( "SETS", cParam )
CASE hb_LeftEq( "SETS", cParam1 )
::ViewSets()
CASE hb_LeftEq( "WORKAREAS", cParam )
CASE hb_LeftEq( "WORKAREAS", cParam1 )
::ShowWorkAreas()
CASE hb_LeftEq( "APPSCREEN", cParam )
CASE hb_LeftEq( "APPSCREEN", cParam1 )
::ShowAppScreen()
CASE hb_LeftEq( "CALLSTACK", cParam )
CASE hb_LeftEq( "CALLSTACK", cParam1 )
::Stack()
OTHERWISE
cResult := "Command error"
::Open( cParams )
ENDCASE
CASE hb_LeftEq( "WINDOW", cCommand )
IF ( n := At( " ", cParam ) ) > 0
cParam1 := AllTrim( SubStr( cParam, n + 1 ) )
cParam := Left( cParam, n - 1 )
ENDIF
cParam := Upper( cParam )
DO CASE
CASE Empty( cParam )
CASE Empty( cParam1 )
::OpenMenu( cCommand )
CASE hb_LeftEq( "NEXT", cParam )
CASE hb_LeftEq( "NEXT", cParam1 )
::NextWindow()
CASE hb_LeftEq( "PREV", cParam )
CASE hb_LeftEq( "PREV", cParam1 )
::PrevWindow()
CASE hb_LeftEq( "MOVE", cParam )
IF Empty( cParam1 )
CASE hb_LeftEq( "MOVE", cParam1 )
IF Empty( cParam2 )
::NotSupported()
ELSE
oWindow := ::aWindows[ ::nCurrentWindow ]
IF ( n := At( " ", cParam1 ) ) > 0
n := Val( SubStr( cParam1, n ) )
IF ( n := At( " ", cParam2 ) ) > 0
n := Val( SubStr( cParam2, n ) )
ENDIF
oWindow:Resize( Val( cParam1 ), n, ;
oWindow:nBottom + Val( cParam1 ) - oWindow:nTop, ;
oWindow:Resize( Val( cParam2 ), n, ;
oWindow:nBottom + Val( cParam2 ) - oWindow:nTop, ;
oWindow:nRight + n - oWindow:nLeft )
::lWindowsAutoSized := .F.
ENDIF
CASE hb_LeftEq( "SIZE", cParam )
IF Empty( cParam1 )
CASE hb_LeftEq( "SIZE", cParam1 )
IF Empty( cParam2 )
::NotSupported()
ELSE
IF Val( cParam1 ) >= 2 .AND. ;
( n := At( " ", cParam1 ) ) > 0 .AND. Val( SubStr( cParam1, n ) ) > 0
IF Val( cParam2 ) >= 2 .AND. ;
( n := At( " ", cParam2 ) ) > 0 .AND. Val( SubStr( cParam2, n ) ) > 0
oWindow := ::aWindows[ ::nCurrentWindow ]
oWindow:Resize( oWindow:nTop, oWindow:nLeft, ;
Val( cParam1 ) - 1 + oWindow:nTop, ;
Val( SubStr( cParam1, n ) ) - 1 + oWindow:nLeft )
Val( cParam2 ) - 1 + oWindow:nTop, ;
Val( SubStr( cParam2, n ) ) - 1 + oWindow:nLeft )
::lWindowsAutoSized := .F.
ENDIF
ENDIF
CASE hb_LeftEq( "ZOOM", cParam ) .OR. ;
hb_LeftEq( "ICONIZE", cParam ) .OR. ;
hb_LeftEq( "TILE", cParam )
CASE hb_LeftEq( "ZOOM", cParam1 ) .OR. ;
hb_LeftEq( "ICONIZE", cParam1 ) .OR. ;
hb_LeftEq( "TILE", cParam1 )
::NotSupported()
OTHERWISE
cResult := "Command error"
ENDCASE
CASE cCommand == "WP"
::WatchpointAdd( cParam )
::WatchpointAdd( cParams )
OTHERWISE
cResult := "Command error"
@@ -1263,16 +1255,12 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
METHOD PROCEDURE DoScript( cFileName ) CLASS HBDebugger
LOCAL cInfo
LOCAL n, nPos
LOCAL nPos
LOCAL cLine
LOCAL nLen
IF hb_FileExists( cFileName )
cInfo := MemoRead( cFileName )
nLen := MLCount( cInfo, 16384,, .F., .T. )
FOR n := 1 TO nLen
cLine := AllTrim( MemoLine( cInfo, 16384, n,, .F., .T. ) )
FOR EACH cLine IN __dbgTextToArray( MemoRead( cFileName ) )
cLine := AllTrim( cLine )
IF ::lActive .OR. ( ( nPos := At( " ", cLine ) ) > 0 .AND. ;
hb_LeftEqI( "OPTIONS", Left( cLine, nPos - 1 ) ) )
// In inactive debugger, only "OPTIONS" commands can be executed safely
@@ -1286,16 +1274,14 @@ METHOD PROCEDURE DoScript( cFileName ) CLASS HBDebugger
METHOD PROCEDURE EditColor( nColor, oBrwColors ) CLASS HBDebugger
LOCAL cColor := PadR( '"' + ::aColors[ nColor ] + '"', ;
oBrwColors:getColumn( 2 ):Width )
LOCAL cColor := '"' + ::aColors[ nColor ] + '"'
oBrwColors:RefreshCurrent()
oBrwColors:ForceStable()
IF __dbgInput( Row(), Col() + 15,, @cColor, ;
{| cColor | Type( cColor ) == "C" .OR. ;
( __dbgAlert( "Must be string" ), .F. ) }, ;
SubStr( ::ClrModal(), 5 ) )
IF __dbgInput( Row(), Col() + 15, oBrwColors:getColumn( 2 ):Width, ;
@cColor, __dbgExprValidBlock( "C" ), ;
SubStr( ::ClrModal(), 5 ) )
::aColors[ nColor ] := &cColor
ENDIF
@@ -1306,16 +1292,16 @@ METHOD PROCEDURE EditColor( nColor, oBrwColors ) CLASS HBDebugger
METHOD PROCEDURE EditSet( nSet, oBrwSets ) CLASS HBDebugger
LOCAL cSet := __dbgValToExp( Set( nSet ) )
LOCAL cSet := PadR( __dbgValToExp( Set( nSet ) ), ;
oBrwSets:getColumn( 2 ):Width )
LOCAL cType := ValType( Set( nSet ) )
oBrwSets:RefreshCurrent()
oBrwSets:ForceStable()
IF __dbgInput( Row(), Col() + 13,, @cSet, ;
{| cSet | Type( cSet ) == cType .OR. ;
( __dbgAlert( "Must be of type '" + cType + "'" ), .F. ) }, ;
SubStr( ::ClrModal(), 5 ), 256 )
IF __dbgInput( Row(), Col() + 13, oBrwSets:getColumn( 2 ):Width, ;
@cSet, __dbgExprValidBlock( cType ), ;
SubStr( ::ClrModal(), 5 ), 256 )
Set( nSet, &cSet )
ENDIF
@@ -1588,7 +1574,7 @@ METHOD PROCEDURE HandleEvent() CLASS HBDebugger
EXIT
CASE K_F9
::ToggleBreakPoint()
::BreakPointToggle()
EXIT
CASE K_F10
@@ -1696,13 +1682,16 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger
IF hb_defaultValue( lEditable, .T. )
IF ! cType == "C" .OR. Len( uValue ) < nWidth
uTemp := PadR( uValue, nWidth )
uTemp := PadR( iif( cType == "N", hb_NToS( uValue ), ;
uValue ), nWidth )
ENDIF
IF bValid == NIL .AND. cType $ "N"
bValid := __dbgExprValidBlock( cType )
ENDIF
__dbgInput( nTop + 1, nLeft + 1, nWidth, @uTemp, bValid, ;
__dbgColors()[ 5 ], Max( Max( nWidth, Len( uTemp ) ), 256 ) )
SWITCH cType
CASE "C" ; uTemp := AllTrim( uTemp ) ; EXIT
CASE "D" ; uTemp := CToD( uTemp ) ; EXIT
CASE "N" ; uTemp := Val( uTemp ) ; EXIT
ENDSWITCH
@@ -2053,26 +2042,28 @@ METHOD PROCEDURE NextWindow() CLASS HBDebugger
RETURN
METHOD PROCEDURE Open() CLASS HBDebugger
METHOD PROCEDURE Open( cFileName ) CLASS HBDebugger
LOCAL nFileName
LOCAL cFileName
LOCAL cRealName
LOCAL aFiles := ::GetSourceFiles()
LOCAL aFiles
ASort( aFiles )
hb_AIns( aFiles, 1, "(Another file)", .T. )
IF Empty( cFileName )
aFiles := ::GetSourceFiles()
ASort( aFiles )
hb_AIns( aFiles, 1, "(Another file)", .T. )
nFileName := ::ListBox( "Please choose a source file", aFiles )
SWITCH nFileName
CASE 0
RETURN
CASE 1
cFileName := AllTrim( ::InputBox( "Please enter the filename" ) )
EXIT
OTHERWISE
cFileName := aFiles[ nFileName ]
ENDSWITCH
nFileName := ::ListBox( "Please choose a source file", aFiles )
SWITCH nFileName
CASE 0
RETURN
CASE 1
cFileName := AllTrim( ::InputBox( "Please enter the filename" ) )
EXIT
OTHERWISE
cFileName := aFiles[ nFileName ]
ENDSWITCH
ENDIF
IF ! Empty( cFileName ) .AND. ;
( ! HB_ISSTRING( ::cPrgName ) .OR. ! hb_FileMatch( cFileName, ::cPrgName ) )
@@ -2533,10 +2524,10 @@ METHOD PROCEDURE SaveSettings( cFileName ) CLASS HBDebugger
RETURN
METHOD PROCEDURE SearchLine() CLASS HBDebugger
::GotoLine( Max( 1, ::InputBox( "Line number", 1 ) ) )
METHOD PROCEDURE SearchLine( cLine ) CLASS HBDebugger
::GotoLine( Max( 1, iif( HB_ISSTRING( cLine ) .AND. IsDigit( cLine ), ;
Val( cLine ), ::InputBox( "Line number", 1 ) ) ) )
RETURN
@@ -2848,9 +2839,19 @@ METHOD PROCEDURE ShowVars() CLASS HBDebugger
RETURN
METHOD PROCEDURE Stack() CLASS HBDebugger
METHOD PROCEDURE Stack( cParam ) CLASS HBDebugger
SWITCH iif( HB_ISSTRING( cParam ), cParam, "" )
CASE "ON"
::lShowCallStack := .T.
EXIT
CASE "OFF"
::lShowCallStack := .F.
EXIT
OTHERWISE
::lShowCallStack := ! ::lShowCallStack
ENDSWITCH
::lShowCallStack := ! ::lShowCallStack
::oPulldown:GetItemByIdent( "CALLSTACK" ):checked := ::lShowCallStack
IF ::lActive
@@ -2900,7 +2901,7 @@ METHOD ToCursor() CLASS HBDebugger
// Toggle a breakpoint at the cursor position in the currently viewed file
// which may be different from the file in which execution was broken
METHOD PROCEDURE ToggleBreakPoint( nLine, cFileName ) CLASS HBDebugger
METHOD PROCEDURE BreakPointToggle( nLine, cFileName ) CLASS HBDebugger
// look for a breakpoint which matches both line number and module name
@@ -2926,7 +2927,7 @@ METHOD PROCEDURE ToggleBreakPoint( nLine, cFileName ) CLASS HBDebugger
RETURN
METHOD DeleteBreakPoint( cPos ) CLASS HBDebugger
METHOD BreakPointDelete( cPos ) CLASS HBDebugger
LOCAL nAt
@@ -2939,7 +2940,7 @@ METHOD DeleteBreakPoint( cPos ) CLASS HBDebugger
IF IsDigit( cPos )
__dbgDelBreak( ::pInfo, Val( cPos ) )
ELSEIF cPos == "ALL"
ELSEIF Upper( cPos ) == "ALL"
FOR nAt := Len( __dbgGetBreakPoints( ::pInfo ) ) - 1 TO 0 STEP -1
__dbgDelBreak( ::pInfo, nAt )
NEXT
@@ -2950,15 +2951,22 @@ METHOD DeleteBreakPoint( cPos ) CLASS HBDebugger
RETURN Self
METHOD ListBreakPoint() CLASS HBDebugger
METHOD BreakPointFunc( cFuncName ) CLASS HBDebugger
LOCAL aBreak
__dbgAddBreak( ::pInfo,,, cFuncName )
RETURN Self
METHOD BreakPointList() CLASS HBDebugger
LOCAL aBreak, cType
FOR EACH aBreak IN __dbgGetBreakPoints( ::pInfo )
::CommandWindowDisplay( ;
hb_ntos( aBreak:__enumIndex() - 1 ) + ") " + ;
hb_ntos( aBreak[ 1 ] ) + " " + ;
AllTrim( aBreak[ 2 ] ), .F. )
cType := iif( aBreak[ 3 ] != NIL, aBreak[ 3 ], ;
hb_ntos( aBreak[ 1 ] ) + " " + aBreak[ 2 ] )
::CommandWindowDisplay( hb_ntos( aBreak:__enumIndex() - 1 ) + ") " + ;
cType, .F. )
NEXT
RETURN Self
@@ -3137,22 +3145,37 @@ METHOD WatchpointAdd( cExpr ) CLASS HBDebugger
RETURN Self
METHOD WatchpointDel( nPos ) CLASS HBDebugger
METHOD WatchpointDel( xPos ) CLASS HBDebugger
LOCAL nPos := -1, lAll := .F.
IF ::oWndPnt != NIL .AND. ::oWndPnt:lVisible
IF nPos == NIL
// called from the menu
IF Empty( xPos )
nPos := ::InputBox( "Enter item number to delete", ::oBrwPnt:cargo[ 1 ] - 1 )
IF LastKey() == K_ESC
nPos := -1
ENDIF
ELSE
nPos--
ELSEIF HB_ISSTRING( xPos )
IF Upper( xPos ) == "ALL"
lAll := .T.
ELSEIF IsDigit( xPos )
nPos := Val( xPos )
ENDIF
ELSEIF HB_ISNUMERIC( xPos )
nPos := xPos
ENDIF
IF nPos >= 0 .AND. nPos < Len( ::aWatch )
IF lAll .OR. ( nPos >= 0 .AND. nPos < Len( ::aWatch ) )
::oBrwPnt:gotop()
__dbgDelWatch( ::pInfo, nPos )
hb_ADel( ::aWatch, nPos + 1, .T. )
IF lAll
FOR nPos := Len( ::aWatch ) - 1 TO 0 STEP -1
__dbgDelWatch( ::pInfo, nPos )
NEXT
ASize( ::aWatch, 0 )
ELSE
__dbgDelWatch( ::pInfo, nPos )
hb_ADel( ::aWatch, nPos + 1, .T. )
ENDIF
IF Len( ::aWatch ) == 0
::WatchpointsHide()
ELSE
@@ -3286,7 +3309,7 @@ METHOD PROCEDURE WatchpointsShow() CLASS HBDebugger
iif( nKey == K_PGUP, ::oBrwPnt:PageUp(), NIL ), ;
iif( nKey == K_HOME, ::oBrwPnt:GoTop(), NIL ), ;
iif( nKey == K_END, ::oBrwPnt:GoBottom(), NIL ), ;
iif( nKey == K_DEL, ::WatchpointDel( ::oBrwPnt:Cargo[ 1 ] ), NIL ), ;
iif( nKey == K_DEL, ::WatchpointDel( ::oBrwPnt:Cargo[ 1 ] - 1 ), NIL ), ;
iif( nKey == K_ENTER, ::WatchpointEdit( ::oBrwPnt:Cargo[ 1 ] ), NIL ), ;
iif( nKey == K_CTRL_ENTER, ::WatchpointInspect( ::oBrwPnt:Cargo[ 1 ] ), NIL ), ;
::oBrwPnt:ForceStable() ) }
@@ -3325,6 +3348,29 @@ METHOD PROCEDURE WatchpointsShow() CLASS HBDebugger
RETURN
METHOD PROCEDURE WatchpointList() CLASS HBDebugger
LOCAL aWatch, cType
FOR EACH aWatch IN ::aWatch
SWITCH aWatch[ WP_TYPE ]
CASE "wp"
cType := "WatchPoint"
EXIT
CASE "tp"
cType := "TracePoint"
EXIT
OTHERWISE
cType := aWatch[ WP_TYPE ]
ENDSWITCH
::CommandWindowDisplay( hb_ntos( aWatch:__enumIndex() - 1 ) + ") " + ;
cType + " " + ;
AllTrim( aWatch[ WP_EXPR ] ), .F. )
NEXT
RETURN
METHOD PROCEDURE WndVarsLButtonDown( nMRow, nMCol ) CLASS HBDebugger
IF nMRow > ::oWndVars:nTop .AND. ;
@@ -3463,8 +3509,50 @@ STATIC FUNCTION hb_LeftEqN( cLine, cStart, nMin )
RETURN Len( cStart ) >= nMin .AND. hb_LeftEq( cLine, cStart )
FUNCTION __dbgExprValidBlock()
RETURN {| u | ! Type( u ) == "UE" .OR. ( __dbgAlert( "Expression error" ), .F. ) }
FUNCTION __dbgExprValidBlock( cType )
LOCAL cTypeName
IF HB_ISSTRING( cType )
SWITCH cType
CASE "N"
cTypeName := "numeric"
EXIT
CASE "C"
cTypeName := "srtring"
EXIT
CASE "L"
cTypeName := "logical"
EXIT
CASE "D"
cTypeName := "date"
EXIT
CASE "T"
cTypeName := "timestamp"
EXIT
CASE "S"
cTypeName := "symbol"
EXIT
CASE "A"
cTypeName := "array"
EXIT
CASE "H"
cTypeName := "hash"
EXIT
CASE "P"
cTypeName := "pointer"
EXIT
ENDSWITCH
ENDIF
IF cTypeName != NIL
RETURN {| u | iif( Type( u ) == "UE", ;
( __dbgAlert( "Expression error" ), .F. ), ;
Type( u ) == cType .OR. ;
( __dbgAlert( "Must be " + cTypeName ), .F. ) ) }
ENDIF
RETURN {| u | ! Type( u ) == "UE" .OR. ;
( __dbgAlert( "Expression error" ), .F. ) }
FUNCTION __dbgInput( nRow, nCol, nWidth, cValue, bValid, cColor, nSize )
@@ -3555,6 +3643,9 @@ FUNCTION __dbgInkey()
RETURN nKey
FUNCTION __dbgTextToArray( cString )
RETURN hb_ATokens( StrTran( cString, Chr( 13 ) ), Chr( 10 ) )
FUNCTION __dbgValToStr( uVal )
SWITCH ValType( uVal )

21
src/debug/tbrwtext.prg
View File

@@ -189,7 +189,7 @@ METHOD PROCEDURE LoadFile( cFileName ) CLASS HBBrwText
LOCAL cLine
::cFileName := cFileName
::aRows := Text2Array( MemoRead( cFileName ) )
::aRows := __dbgTextToArray( MemoRead( cFileName ) )
::nRows := Len( ::aRows )
::nLineNoLen := Len( hb_ntos( ::nRows ) ) + 2
@@ -316,22 +316,3 @@ METHOD GoNext() CLASS HBBrwText
ENDIF
RETURN lMoved
STATIC FUNCTION WhichEOL( cString )
LOCAL nCRPos := At( Chr( 13 ), cString )
LOCAL nLFPos := At( Chr( 10 ), cString )
DO CASE
CASE nCRPos > 0 .AND. nLFPos == 0
RETURN Chr( 13 )
CASE nCRPos == 0 .AND. nLFPos > 0
RETURN Chr( 10 )
CASE nCRPos > 0 .AND. nLFPos == nCRPos + 1
RETURN Chr( 13 ) + Chr( 10 )
ENDCASE
RETURN hb_eol()
STATIC FUNCTION Text2Array( cString )
RETURN hb_ATokens( cString, WhichEOL( cString ) )