From a1cbbb2cbf764a18e47d5778a8f03ced2a608ff9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Przemys=C5=82aw=20Czerpak?= Date: Wed, 13 Aug 2014 16:27:16 +0200 Subject: [PATCH] 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 command ! fixed CALLSTACK ON | OFF command ! fixed NUM command + added support for VIEW command + added support for LOCATE GOTOLINE command + added support for LOCATE FIND command + added support for RUN SPEED command + added support for LIST WP|TP command + added support for BP command + added support for DELETE ALL [TP|WP] and DELETE WP|TP commands % few optimizations and some other minor fixes --- ChangeLog.txt | 22 ++ src/debug/dbgentry.c | 18 +- src/debug/debugger.prg | 559 ++++++++++++++++++++++++----------------- src/debug/tbrwtext.prg | 21 +- 4 files changed, 359 insertions(+), 261 deletions(-) diff --git a/ChangeLog.txt b/ChangeLog.txt index 4b3a58f63f..3361908280 100644 --- a/ChangeLog.txt +++ b/ChangeLog.txt @@ -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 command + ! fixed CALLSTACK ON | OFF command + ! fixed NUM command + + added support for VIEW command + + added support for LOCATE GOTOLINE command + + added support for LOCATE FIND command + + added support for RUN SPEED command + + added support for LIST WP|TP command + + added support for BP command + + added support for DELETE ALL [TP|WP] and DELETE WP|TP + 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 diff --git a/src/debug/dbgentry.c b/src/debug/dbgentry.c index 3505d3b63d..992b2509ef 100644 --- a/src/debug/dbgentry.c +++ b/src/debug/dbgentry.c @@ -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 ) diff --git a/src/debug/debugger.prg b/src/debug/debugger.prg index 4e173b9c10..c94bb1a5da 100644 --- a/src/debug/debugger.prg +++ b/src/debug/debugger.prg @@ -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 */ - 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 */ 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 ) diff --git a/src/debug/tbrwtext.prg b/src/debug/tbrwtext.prg index 9336887bb8..a566ea1177 100644 --- a/src/debug/tbrwtext.prg +++ b/src/debug/tbrwtext.prg @@ -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 ) )