From 981c0a536c6c67fa3d3a97c574cdb92ac410091b Mon Sep 17 00:00:00 2001 From: Phil Krylov Date: Mon, 7 Jun 2004 22:24:35 +0000 Subject: [PATCH] 2004-06-08 02:25 UTC+0300 Phil Krylov --- harbour/ChangeLog | 4 + harbour/source/debug/debugger.prg | 403 +++++++++++++++++------------- 2 files changed, 231 insertions(+), 176 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 4321c62063..9e73e4e236 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,10 @@ 2002-12-01 23:12 UTC+0100 Foo Bar */ +2004-06-08 02:25 UTC+0300 Phil Krylov + * source/debug/debugger.prg + + Added preliminary CLD-compatible scripting capabilities. + 2004-06-07 18:15 UTC+0300 Phil Krylov * source/debug/dbgmenu.prg * source/debug/debugger.prg diff --git a/harbour/source/debug/debugger.prg b/harbour/source/debug/debugger.prg index 61ae83039b..e652e68924 100644 --- a/harbour/source/debug/debugger.prg +++ b/harbour/source/debug/debugger.prg @@ -342,6 +342,8 @@ CLASS TDebugger METHOD CodeWindowProcessKey( nKey ) METHOD Colors() METHOD CommandWindowProcessKey( nKey ) + METHOD DoCommand( cCommand ) + METHOD DoScript( cFileName ) METHOD EditColor( nColor, oBrwColors ) METHOD EditSet( nSet, oBrwSets ) METHOD EditVar( nVar ) @@ -486,14 +488,9 @@ METHOD New() CLASS TDebugger ::lSortVars := .f. ::cSettingsFileName := "init.cld" ::lRunAtStartup := .t. //Clipper compatible - - if File( ::cSettingsFileName ) - ::LoadSettings() - endif ::lGo := ::lRunAtStartup ::oPullDown := __dbgBuildMenu( Self ) - ::oPulldown:GetItemByIdent( "ALTD" ):Checked := ::lRunAtStartup ::oWndCode := TDbWindow():New( 1, 0, MaxRow() - 6, MaxCol() ) ::oWndCode:Cargo := { ::oWndCode:nTop, ::oWndCode:nLeft } @@ -508,13 +505,18 @@ METHOD New() CLASS TDebugger ::BuildCommandWindow() ::BuildBrowseStack() + if File( ::cSettingsFileName ) + ::LoadSettings() + endif + ::lGo := ::lRunAtStartup + return Self METHOD Activate() CLASS TDebugger ::LoadCallStack() - IF( ! ::lActive ) + IF ! ::lActive ::lActive := .T. ::Show() if ::lShowCallStack @@ -822,65 +824,9 @@ METHOD CommandWindowProcessKey( nKey ) CLASS TDebugger AAdd( ::aLastCommands, cCommand ) ::nCommand++ ::oWndCommand:ScrollUp( 1 ) + ::DoCommand( cCommand ) endif - do case - case Empty( cCommand ) - lDisplay = .f. - - case SubStr( LTrim( cCommand ), 1, 2 ) == "??" .or. ; - SubStr( LTrim( cCommand ), 1, 1 ) == "?" - lDisplay := !Empty( cResult := DoCommand( Self,cCommand ) ) - - case Upper( SubStr( LTrim( cCommand ), 1, 4 ) ) == "ANIM" .or. ; - Upper( SubStr( LTrim( cCommand ), 1, 7 ) ) == "ANIMATE" - ::lAnimate = .t. - ::Animate() - SetCursor( SC_NORMAL ) - lDisplay = .f. - - case Upper( SubStr( LTrim( cCommand ), 1, 3 ) ) == "DOS" - ::OsShell() - SetCursor( SC_NORMAL ) - lDisplay = .f. - - case Upper( SubStr( LTrim( cCommand ), 1, 4 ) ) == "HELP" - ::ShowHelp() - lDisplay = .f. - - case Upper( SubStr( LTrim( cCommand ), 1, 4 ) ) == "QUIT" - ::Quit() - - case Upper( SubStr( LTrim( cCommand ), 1, 6 ) ) == "OUTPUT" - SetCursor( SC_NONE ) - ::ShowAppScreen() - SetCursor( SC_NORMAL ) - lDisplay = .f. - - case Upper( SubStr( LTrim( cCommand ), 1, 3 ) ) == "WP " - //add watchpoint - ::WatchpointAdd( SUBSTR( LTRIM(cCommand), 3 ) ) - lDisplay = .f. - - case Upper( SubStr( LTrim( cCommand ), 1, 3 ) ) == "TP " - //add tracepoint - ::TracepointAdd( SUBSTR( LTRIM(cCommand), 3 ) ) - lDisplay = .f. - - otherwise - cResult = "Command error" - lDisplay = .t. - - endcase - - DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1,; - Space( ::oWndCommand:nRight - ::oWndCommand:nLeft - 1 ),; - __DbgColors()[ 2 ] ) - if lDisplay - DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 3,; - cResult, __DbgColors()[ 2 ] ) - ::oWndCommand:ScrollUp( 1 ) - endif DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, "> ",; __DbgColors()[ 2 ] ) cCommand := Space( ::oWndCommand:nRight - ::oWndCommand:nLeft - 3 ) @@ -890,11 +836,215 @@ METHOD CommandWindowProcessKey( nKey ) CLASS TDebugger ::oGetListCommand:oGet:Display() otherwise - ::oGetListCommand:GetApplyKey( nKey ) + ::oGetListCommand:GetApplyKey( nKey ) endcase return nil + +/* + * ?? + * displays inspect window with value or display nothing on error + * ? + * displays either result or error description in command window + */ +METHOD DoCommand( cCommand ) CLASS TDebugger + LOCAL aCmnd + LOCAL cParam, cParam1 := "" + LOCAL cResult + LOCAL lValid + LOCAL n + + cCommand := ALLTRIM( cCommand ) + aCmnd := { NIL, NIL, NIL } + + DO CASE + CASE Empty( cCommand ) + RETURN "" + + CASE starts( cCommand, "??" ) + cParam := AllTrim( SUBSTR( cCommand, 3 ) ) + cCommand := "??" + + CASE starts( cCommand, "?" ) + cParam := SUBSTR( cCommand, 2 ) + cCommand := "?" + + OTHERWISE + IF ( n := At( " ", cCommand ) ) > 0 + cParam := AllTrim( SubStr( cCommand, n + 1 ) ) + cCommand := Left( cCommand, n - 1 ) + ENDIF + cCommand := Upper( cCommand ) + + ENDCASE + + DO CASE + CASE cCommand == "??" .OR. cCommand == "?" + aCmnd[WP_TYPE] := cCommand + aCmnd[WP_EXPR] := cParam + cResult := CreateExpression( cParam, aCmnd ) + IF( EMPTY(cResult) ) + //valid syntax + cResult := GetWatchValue( aCmnd, @lValid ) + IF( aCmnd[WP_TYPE] == "??" ) + IF( lValid ) + ::Inspect( aCmnd[WP_EXPR], cResult ) + ENDIF + cResult := '' //discard result + ELSE + IF( lValid ) + cResult := ValToStr( cResult ) + ENDIF + ENDIF + ELSE + IF( aCmnd[WP_TYPE] == "??" ) + cResult := '' //ignore error + ENDIF + ENDIF + + CASE starts( "ANIMATE", cCommand ) + IF ::lActive + ::lAnimate = .t. + ::Animate() + SetCursor( SC_NORMAL ) + ENDIF + + CASE starts( "BP", cCommand ) + IF !Empty( cParam ) + AAdd( ::aBreakPoints, ; + { Val( cParam ), ; + strip_path( SubStr( cParam, RAt( " ", cParam ) + 1 ) ) } ) + ELSE + ::ToggleBreakPoint() + ENDIF + + CASE starts( "DOS", cCommand ) + ::OsShell() + SetCursor( SC_NORMAL ) + + CASE starts( "HELP", cCommand ) + ::ShowHelp() + + CASE starts( "MONITOR", cCommand ) + cParam := Upper( cParam ) + DO CASE + CASE starts( "LOCAL", cParam ) + ::Local() + CASE starts( "PRIVATE", cParam ) + ::Private() + CASE starts( "PUBLIC", cParam ) + ::Public() + CASE starts( "SORT", cParam ) + ::Sort() + CASE starts( "STATIC", cParam ) + ::Static() + OTHERWISE + cResult := "Command error" + ENDCASE + + CASE starts( "NUM", cCommand ) + IF Upper( cParam ) == "OFF" + ::LineNumbers( .F. ) + ELSEIF Upper( cParam ) == "ON" + ::LineNumbers( .T. ) + ELSE + cResult := "Command error" + ENDIF + + CASE starts( "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 starts( "COLORS", cParam ) + IF Empty( cParam1 ) + ::Colors() + ELSE + cParam1 := SubStr( cParam1, At( "{", cParam1 ) + 1 ) + FOR n := 1 TO 11 + IF At( ",", cParam1 ) != 0 + ::aColors[ n ] := ; + StrTran( Left( cParam1, At( ",", cParam1 ) - 1 ), '"', "" ) + cParam1 := SubStr( cParam1, At( ",", cParam1 ) + 1 ) + ELSE + ::aColors[ n ] := ; + StrTran( Left( cParam1, At( "}", cParam1 ) - 1 ), '"', "" ) + ENDIF + NEXT + ::LoadColors() + ENDIF + CASE starts( "NORUNATSTARTUP", cParam ) + ::lRunAtStartup := .f. + CASE starts( "PATH", cParam ) + ::PathForFiles( AllTrim( cParam1 ) ) + CASE starts( "TAB", cParam ) + ::nTabWidth = Val( Left( cParam1, 3 ) ) + OTHERWISE + cResult := "Command error" + ENDCASE + + CASE starts( "OUTPUT", cCommand ) + + SetCursor( SC_NONE ) + ::ShowAppScreen() + SetCursor( SC_NORMAL ) + + CASE starts( "QUIT", cCommand ) + ::Quit() + + CASE starts( "TP", cCommand ) + ::TracepointAdd( cParam ) + + CASE starts( "VIEW", cCommand ) + IF !Empty( cParam ) .AND. starts( "CALLSTACK", Upper( cParam ) ) + ::Stack() + ELSE + cResult := "Command error" + ENDIF + + CASE starts( "WP", cCommand ) + ::WatchpointAdd( cParam ) + + OTHERWISE + cResult := "Command error" + + ENDCASE + + IF ::lActive + DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, ; + Space( ::oWndCommand:nRight - ::oWndCommand:nLeft - 1 ), ; + __DbgColors()[ 2 ] ) + IF !Empty( cResult ) + DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 3, ; + cResult, __DbgColors()[ 2 ] ) + ::oWndCommand:ScrollUp( 1 ) + ENDIF + ENDIF + +RETURN cResult + + +METHOD DoScript( cFileName ) CLASS TDebugger + + local cInfo + local n, cLine, nLen + + IF File( cFileName ) + cInfo := MemoRead( cFileName ) + nLen := MLCount( cInfo, , , .F. ) + for n := 1 to nLen + /* Dreadful MemoLine() limit is 254. It often cuts the end of the PATH */ + cLine := MemoLine( cInfo, 254, n, , .F. ) + ::DoCommand( cLine ) + next + ENDIF + +RETURN NIL + + METHOD EditColor( nColor, oBrwColors ) CLASS TDebugger local GetList := {} @@ -1353,7 +1503,6 @@ METHOD ShowCallStack() CLASS TDebugger local n := 1 local oCol - LOCAL i ::lShowCallStack = .t. @@ -1422,69 +1571,14 @@ LOCAL nlevel, nPos RETURN NIL + METHOD LoadSettings() CLASS TDebugger - local cInfo := MemoRead( ::cSettingsFileName ) - local n, cLine, nColor, nLen - - nLen := MLCount( cInfo ) - for n := 1 to nLen - cLine := MemoLine( cInfo, 120, n ) - do case - case Upper( SubStr( cLine, 1, 14 ) ) == "OPTIONS COLORS" - cLine := SubStr( cLine, At( "{", cLine ) + 1 ) - nColor := 1 - while nColor < 12 - if At( ",", cLine ) != 0 - ::aColors[ nColor ] := ; - StrTran( SubStr( cLine, 1, At( ",", cLine ) - 1 ), '"', "" ) - cLine := SubStr( cLine, At( ",", cLine ) + 1 ) - else - ::aColors[ nColor ] := ; - StrTran( SubStr( cLine, 1, At( "}", cLine ) - 1 ), '"', "" ) - endif - nColor++ - end - - case Upper( SubStr( cLine, 1, 11 ) ) == "OPTIONS TAB" - cLine = SubStr( cLine, 12, 3 ) - ::nTabWidth = Val( cLine ) - - case Upper( SubStr( cLine, 1, 12 ) ) == "OPTIONS PATH" - cLine = SubStr( cLine, 13, 120 ) - ::cPathForFiles = AllTrim( cLine ) - - case Upper( SubStr( cLine, 1, 22 ) ) == "OPTIONS NORUNATSTARTUP" - ::lRunAtStartup := .F. - - case Upper( SubStr( cLine, 1, 14 ) ) == "MONITOR STATIC" - ::lShowStatics = .t. - - case Upper( SubStr( cLine, 1, 14 ) ) == "MONITOR PUBLIC" - ::lShowPublics = .t. - - case Upper( SubStr( cLine, 1, 13 ) ) == "MONITOR LOCAL" - ::lShowLocals = .t. - - case Upper( SubStr( cLine, 1, 15 ) ) == "MONITOR PRIVATE" - ::lShowPrivates = .t. - - case Upper( SubStr( cLine, 1, 12 ) ) == "MONITOR SORT" - ::lSortVars = .t. - - case Upper( SubStr( cLine, 1, 14 ) ) == "VIEW CALLSTACK" - ::lShowCallStack = .t. - - case Upper( SubStr( cLine, 1, 2 ) ) == "BP" - AAdd( ::aBreakPoints,; - { Val( SubStr( cLine, 4, RAt( " ", cLine ) - 4 ) ),; - SubStr( cLine, RAt( " ", cLine ) ) } ) - - endcase - next + ::DoScript( ::cSettingsFileName ) return nil + METHOD LoadVars() CLASS TDebugger // updates monitored variables local nCount, n, m, xValue, cName @@ -2136,15 +2230,7 @@ METHOD RestoreSettings() CLASS TDebugger if LastKey() != K_ESC ::LoadSettings() - - ::oPullDown:LoadColors() - ::oPullDown:Refresh() - ::BarDisplay() ::ShowVars() - for n := 1 to Len( ::aWindows ) - ::aWindows[ n ]:LoadColors() - ::aWindows[ n ]:Refresh() - next endif return nil @@ -2232,9 +2318,13 @@ METHOD SaveSettings() CLASS TDebugger cInfo += "View CallStack" + HB_OsNewLine() endif + if ! ::lLineNumbers + cInfo += "Num Off" + HB_OsNewLine() + endif + if ! Empty( ::aBreakPoints ) for n := 1 to Len( ::aBreakPoints ) - cInfo += "BP " + AllTrim( Str( ::aBreakPoints[ n ][ 1 ] ) ) + " " + ; + cInfo += "BP " + AllTrim( Str( ::aBreakPoints[ n ][ 1 ], , 0 ) ) + " " + ; AllTrim( ::aBreakPoints[ n ][ 2 ] ) + HB_OsNewLine() next endif @@ -3202,50 +3292,6 @@ 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 ) ) -/* - ?? - displays inspect window with value or display nothing on error - ? - displays either result or error description in command window -*/ -static function DoCommand( o,cCommand ) -LOCAL aCmnd -LOCAL cResult -LOCAL lValid - - cCommand := ALLTRIM( cCommand ) - aCmnd := { NIL, NIL, NIL } - IF( LEFT(cCommand,2) == "??" ) - cCommand := SUBSTR( cCommand, 3 ) - aCmnd[WP_TYPE] := "??" - - ELSEIF( LEFT(cCommand,1) == "?" ) - cCommand := SUBSTR( cCommand, 2 ) - aCmnd[WP_TYPE] := "?" - ENDIF - aCmnd[WP_EXPR] := cCommand - cResult := CreateExpression( cCommand, aCmnd ) - IF( EMPTY(cResult) ) - //valid syntax - cResult := GetWatchValue( aCmnd, @lValid ) - IF( aCmnd[WP_TYPE] == "??" ) - IF( lValid ) - o:Inspect( aCmnd[WP_EXPR], cResult ) - ENDIF - cResult := '' //discard result - ELSE - IF( lValid ) - cResult := ValToStr( cResult ) - ENDIF - ENDIF - ELSE - IF( aCmnd[WP_TYPE] == "??" ) - cResult := '' //ignore error - ENDIF - ENDIF - -RETURN cResult - static function PathToArray( cList ) @@ -3273,6 +3319,11 @@ static function PathToArray( cList ) return aList +/* Check if a string starts with another string */ +STATIC FUNCTION starts( cLine, cStart ) +RETURN ( cStart == Left( cLine, Len( cStart ) ) ) + + /* Strip path from filename */ STATIC FUNCTION strip_path( cFileName ) LOCAL cName := "", cExt := ""