From 9604dd514f4dbc6fd4704da86f773bd1a1cb0e87 Mon Sep 17 00:00:00 2001 From: Phil Krylov Date: Mon, 7 Jun 2004 14:14:49 +0000 Subject: [PATCH] 2004-06-07 18:15 UTC+0300 Phil Krylov --- harbour/ChangeLog | 5 + harbour/source/debug/dbgmenu.prg | 77 +++++++------ harbour/source/debug/debugger.prg | 177 ++++++++++++++++++------------ 3 files changed, 154 insertions(+), 105 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index aca1bb624f..4321c62063 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,11 @@ 2002-12-01 23:12 UTC+0100 Foo Bar */ +2004-06-07 18:15 UTC+0300 Phil Krylov + * source/debug/dbgmenu.prg + * source/debug/debugger.prg + ! Fixed some problems related to menus, colors and cursor positioning. + 2004-06-07 14:15 UTC+0300 Phil Krylov * source/rtl/inkey.c + Added hb_setInkeyLast() (copyright 2002 by Walter Negro) and diff --git a/harbour/source/debug/dbgmenu.prg b/harbour/source/debug/dbgmenu.prg index b5c2769eb5..8dfd7bc879 100644 --- a/harbour/source/debug/dbgmenu.prg +++ b/harbour/source/debug/dbgmenu.prg @@ -55,9 +55,9 @@ #xcommand MENU [] => [ := ] TDbMenu():New() #xcommand MENUITEM [ PROMPT ] ; [ IDENT ] [ ACTION ] ; - [ ] => ; + [ CHECKED ] => ; [ := ] TDbMenu():AddItem( TDbMenuItem():New( ,; - [{|Self|}] ,[<.checked.>], [] ) ) + [{|Self|}], [], [] ) ) #xcommand SEPARATOR => TDbMenu():AddItem( TDbMenuItem():New( "-" ) ) #xcommand ENDMENU => ATail( TDbMenu():aMenus ):Build() @@ -90,8 +90,9 @@ function __dbgBuildMenu( oDebugger ) // Builds the debugger pulldown menu MENUITEM " ~Previous" ACTION oDebugger:FindPrevious() MENUITEM " ~Goto line..." ACTION oDebugger:SearchLine() SEPARATOR - MENUITEM oCaseSensitive PROMPT " ~Case sensitive " ; - ACTION ( oDebugger:ToggleCaseSensitive(), oCaseSensitive:Toggle() ) + MENUITEM oCaseSensitive PROMPT " ~Case sensitive " IDENT "CASE" ; + ACTION oDebugger:ToggleCaseSensitive() ; + CHECKED oDebugger:lCaseSensitive ENDMENU MENUITEM " ~View " @@ -100,14 +101,16 @@ function __dbgBuildMenu( oDebugger ) // Builds the debugger pulldown menu MENUITEM " ~WorkAreas F6" ACTION oDebugger:ShowWorkAreas() MENUITEM " ~App Screen F4 " ACTION oDebugger:ShowAppScreen() SEPARATOR - MENUITEM oCallStack PROMPT " ~CallStack" ; - ACTION ( oDebugger:Stack(), oCallStack:Toggle() ) + MENUITEM oCallStack PROMPT " ~CallStack" IDENT "CALLSTACK"; + ACTION oDebugger:Stack() ; + CHECKED oDebugger:lShowCallStack ENDMENU MENUITEM " ~Run " MENU - MENUITEM " ~Animate" ; - ACTION ( oDebugger:ToggleAnimate(), oDebugger:Animate() ) + MENUITEM " ~Animate" IDENT "ANIMATE" ; + ACTION ( oDebugger:ToggleAnimate(), oDebugger:Animate() ) ; + CHECKED oDebugger:lAnimate MENUITEM " ~Step F8 " ACTION oDebugger:Step() MENUITEM " ~Trace F10" ACTION oDebugger:Trace() MENUITEM " ~Go F5" ACTION oDebugger:Go() @@ -127,45 +130,53 @@ function __dbgBuildMenu( oDebugger ) // Builds the debugger pulldown menu MENUITEM " ~Monitor " MENU - MENUITEM oPublic PROMPT " ~Public" ; - ACTION ( oDebugger:Public(), oPublic:Toggle() ) - - MENUITEM oPrivate PROMPT " pri~Vate " ; - ACTION ( oDebugger:Private(), oPrivate:Toggle() ) - - MENUITEM oStatic PROMPT " ~Static" ; - ACTION ( oDebugger:Static(), oStatic:Toggle() ) - - MENUITEM oLocal PROMPT " ~Local" ; - ACTION ( oDebugger:Local(), oLocal:Toggle() ) + MENUITEM oPublic PROMPT " ~Public" IDENT "PUBLIC" ; + ACTION oDebugger:Public() ; + CHECKED oDebugger:lShowPublics + MENUITEM oPrivate PROMPT " pri~Vate " IDENT "PRIVATE" ; + ACTION oDebugger:Private() ; + CHECKED oDebugger:lShowPrivates + + MENUITEM oStatic PROMPT " ~Static" IDENT "STATIC" ; + ACTION oDebugger:Static() ; + CHECKED oDebugger:lShowStatics + + MENUITEM oLocal PROMPT " ~Local" IDENT "LOCAL" ; + ACTION oDebugger:Local() ; + CHECKED oDebugger:lShowLocals + SEPARATOR - MENUITEM oAll PROMPT " ~All" ; - ACTION ( oDebugger:All(), oAll:Toggle(),; - oPublic:lChecked := oPrivate:lChecked := oStatic:lChecked := ; - oLocal:lChecked := oAll:lChecked ) + MENUITEM oAll PROMPT " ~All" IDENT "ALL" ; + ACTION oDebugger:All() ; + CHECKED oDebugger:lAll MENUITEM " s~Ort" ACTION oDebugger:Sort() ENDMENU MENUITEM " ~Options " MENU - MENUITEM oPPo PROMPT " ~Preprocessed Code" IDENT "PPO"; - ACTION (IIF( oDebugger:OpenPPO(), oPPo:Toggle(), NIL)) - MENUITEM oLineNumbers PROMPT " ~Line Numbers" ; - ACTION ( oDebugger:LineNumbers(), oLineNumbers:Toggle() ) CHECKED + MENUITEM oPPo PROMPT " ~Preprocessed Code" IDENT "PPO" ; + ACTION oDebugger:OpenPPO() ; + CHECKED oDebugger:lPPO + MENUITEM oLineNumbers PROMPT " ~Line Numbers" IDENT "LINE" ; + ACTION oDebugger:LineNumbers() ; + CHECKED oDebugger:lLineNumbers MENUITEM " ~Exchange Screens" ACTION oDebugger:NotSupported() MENUITEM " swap on ~Input" ACTION oDebugger:NotSupported() - MENUITEM oCBTrace PROMPT " code~Block Trace" ; - ACTION ( oDebugger:CodeblockTrace(), oCBTrace:Toggle() ) CHECKED + MENUITEM oCBTrace PROMPT " code~Block Trace" IDENT "CODEBLOCK" ; + ACTION oDebugger:CodeblockTrace() ; + CHECKED oDebugger:lCBTrace MENUITEM " ~Menu Bar" ACTION oDebugger:NotSupported() - MENUITEM oMonoDisplay PROMPT " mono ~Display" ; - ACTION ( oDebugger:MonoDisplay(), oMonoDisplay:Toggle() ) + MENUITEM oMonoDisplay PROMPT " mono ~Display" IDENT "MONO"; + ACTION oDebugger:MonoDisplay() ; + CHECKED oDebugger:lMonoDisplay MENUITEM " ~Colors..." ACTION oDebugger:Colors() MENUITEM " ~Tab Width..." ACTION oDebugger:TabWidth() MENUITEM " path for ~Files..." ACTION oDebugger:PathForFiles() - MENUITEM oRunAtStartup PROMPT " R~un at startup" IDENT "ALTD"; - ACTION ( oDebugger:RunAtStartup(), oRunAtStartup:Toggle() ) CHECKED + MENUITEM oRunAtStartup PROMPT " R~un at startup" IDENT "ALTD" ; + ACTION oDebugger:RunAtStartup() ; + CHECKED oDebugger:lRunAtStartup SEPARATOR MENUITEM " ~Save Settings..." ACTION oDebugger:SaveSettings() MENUITEM " ~Restore Settings... " ACTION oDebugger:RestoreSettings() diff --git a/harbour/source/debug/debugger.prg b/harbour/source/debug/debugger.prg index cf9a084bf2..61ae83039b 100644 --- a/harbour/source/debug/debugger.prg +++ b/harbour/source/debug/debugger.prg @@ -355,7 +355,8 @@ CLASS TDebugger METHOD HideVars() METHOD InputBox( cMsg, uValue, bValid, lEditable ) METHOD Inspect( uValue, cValueName ) - METHOD IsBreakPoint( nLine, cPrgName) + METHOD IsBreakPoint( nLine, cPrgName ) + METHOD LoadColors() METHOD LoadSettings() METHOD LoadVars() METHOD LoadCallStack() @@ -369,22 +370,24 @@ CLASS TDebugger // METHOD Resume() INLINE IIF( LEN(::aCallStack[1])>0, ::ShowCodeLine( ::aCallStack[1][ CSTACK_LINE ], ::aCallStack[1][ CSTACK_MODULE ] ), NIL) METHOD Resume() INLINE ::ShowCodeLine( 1 ) METHOD OSShell() - METHOD PathForFiles() + METHOD PathForFiles( cPathForFiles ) METHOD PrevWindow() METHOD Private() METHOD Public() - METHOD Quit() INLINE ::Exit(), ::Hide(), s_lExit:=.T., s_oDebugger:=NIL, __QUIT() + METHOD Quit() INLINE ::Exit(), ::Hide(), s_lExit := .T., s_oDebugger := NIL, __QUIT() + METHOD RefreshVars() METHOD RestoreAppStatus() METHOD RestoreSettings() - METHOD RunAtStartup() INLINE ::lRunAtStartup:=!::lRunAtStartup + METHOD RunAtStartup() INLINE ::lRunAtStartup := ::oPullDown:GetItemByIdent( "ALTD" ):checked := !::lRunAtStartup METHOD SaveAppStatus() METHOD SaveSettings() METHOD Show() METHOD ShowAppScreen() METHOD ShowCallStack() - METHOD ShowCodeLine( nLine, cPrgName ) - METHOD StackProc(cModuleName, nProcLevel) + //METHOD ShowCodeLine( nLine, cPrgName ) + METHOD ShowCodeLine( nProc ) + METHOD StackProc( cModuleName, nProcLevel ) METHOD ShowHelp( nTopic ) METHOD ShowVars() METHOD RedisplayBreakpoints() @@ -413,17 +416,17 @@ CLASS TDebugger METHOD ToCursor() METHOD NextRoutine() - METHOD CodeblockTrace() INLINE ::lCBTrace := ! ::lCBTrace + METHOD CodeblockTrace() INLINE ::oPullDown:GetItemByIdent( "CODEBLOCK" ):checked := ::lCBTrace := ! ::lCBTrace METHOD ViewSets() METHOD WndVarsLButtonDown( nMRow, nMCol ) - METHOD LineNumbers() // Toggles numbering of source code lines + METHOD LineNumbers( lLineNumbers ) // Toggles numbering of source code lines METHOD Locate() METHOD FindNext() METHOD FindPrevious() METHOD RemoveWindow() METHOD SearchLine() - METHOD ToggleAnimate() INLINE ::lAnimate := ! ::lAnimate - METHOD ToggleCaseSensitive() INLINE ::lCaseSensitive := ! ::lCaseSensitive + 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 ) @@ -536,7 +539,7 @@ METHOD All() CLASS TDebugger ::lShowPublics := ::lShowPrivates := ::lShowStatics := ; ::lShowLocals := ::lAll := ! ::lAll - iif( ::lAll, (::LoadVars(),::ShowVars()), ::HideVars() ) + ::RefreshVars() return nil @@ -747,7 +750,6 @@ METHOD Colors() CLASS TDebugger local oBrwColors := TBrowseNew( oWndColors:nTop + 1, oWndColors:nLeft + 1,; oWndColors:nBottom - 1, oWndColors:nRight - 1 ) - local n := 1 local nWidth := oWndColors:nRight - oWndColors:nLeft - 1 local oCol @@ -779,16 +781,10 @@ METHOD Colors() CLASS TDebugger { || ::EditColor( oBrwColors:Cargo[1], oBrwColors ) } ) } oWndColors:ShowModal() - ::oPullDown:LoadColors() - ::oPullDown:Refresh() - ::BarDisplay() + ::LoadColors() - for n := 1 to Len( ::aWindows ) - ::aWindows[ n ]:LoadColors() - ::aWindows[ n ]:Refresh() - next +RETURN NIL -return nil METHOD CommandWindowProcessKey( nKey ) CLASS TDebugger @@ -1230,24 +1226,35 @@ METHOD Hide() CLASS TDebugger return nil -METHOD MonoDisplay() CLASS TDebugger - local n - - ::lMonoDisplay := ! ::lMonoDisplay +METHOD LoadColors() CLASS TDebugger + + LOCAL n ::oPullDown:LoadColors() - ::oPullDown:Refresh() - - ::BarDisplay() - + IF ::lActive + ::oPullDown:Refresh() + ::BarDisplay() + ENDIF for n := 1 to Len( ::aWindows ) ::aWindows[ n ]:LoadColors() - ::aWindows[ n ]:Refresh() + IF ::lActive + ::aWindows[ n ]:Refresh() + ENDIF next + +RETURN NIL + + +METHOD MonoDisplay() CLASS TDebugger + + ::lMonoDisplay := ! ::lMonoDisplay + ::oPullDown:GetItemByIdent( "MONO" ):checked := ::lMonoDisplay + ::LoadColors() return nil + METHOD NextWindow() CLASS TDebugger local oWnd @@ -1548,6 +1555,24 @@ METHOD LoadVars() CLASS TDebugger // updates monitored variables return nil + +METHOD RefreshVars() CLASS TDebugger + ::oPulldown:GetItemByIdent( "LOCAL" ):checked := ::lShowLocals + ::oPulldown:GetItemByIdent( "PRIVATE" ):checked := ::lShowPrivates + ::oPulldown:GetItemByIdent( "PUBLIC" ):checked := ::lShowPublics + ::oPulldown:GetItemByIdent( "STATIC" ):checked := ::lShowStatics + ::oPulldown:GetItemByIdent( "ALL" ):checked := ::lAll + IF ::lActive + if ::lShowPublics .or. ::lShowPrivates .or. ::lShowStatics .or. ::lShowLocals + ::LoadVars() + ::ShowVars() + else + ::HideVars() + endif + ENDIF +RETURN NIL + + METHOD ShowHelp( nTopic ) CLASS TDebugger local nCursor := SetCursor( SC_NONE ) @@ -1813,10 +1838,9 @@ METHOD Open() CLASS TDebugger endif return nil - METHOD OpenPPO() CLASS TDebugger -LOCAL nPos -LOCAL lSuccess:=.F. + LOCAL nPos + LOCAL lSuccess:=.F. nPos := RAT(".PPO", UPPER(::cPrgName)) IF( nPos == 0 ) @@ -1839,15 +1863,18 @@ LOCAL lSuccess:=.F. ::oBrwText := TBrwText():New( ::oWndCode:nTop + 1, ::oWndCode:nLeft + 1,; ::oWndCode:nBottom - 1, ::oWndCode:nRight - 1, ::cPrgName,; __DbgColors()[ 2 ] + "," + __DbgColors()[ 5 ] + "," + ; - __DbgColors()[ 3 ] + "," + __DbgColors()[ 6 ] ) + __DbgColors()[ 3 ] + "," + __DbgColors()[ 6 ], ::lLineNumbers ) ::oWndCode:Browser := ::oBrwText ::RedisplayBreakpoints() // check for breakpoints in this file and display them ::oWndCode:SetCaption( ::cPrgName ) - ::oWndCode:Refresh() // to force the window caption to update + ::oWndCode:Refresh()// to force the window caption to update endif + ::oPullDown:GetItemByIdent( "PPO" ):checked := ::lPPO + return lSuccess + // check for breakpoints in the current file and display them METHOD RedisplayBreakPoints() CLASS TDebugger @@ -2058,45 +2085,34 @@ METHOD GotoLine( nLine ) CLASS TDebugger SetPos( nRow, nCol ) SetCursor( SC_SPECIAL1 ) endif + SetPos( nRow, nCol ) + + // Store cursor position to be restored by ::oWndCode:bGotFocus + ::oWndCode:cargo[ 1 ] := nRow + ::oWndCode:cargo[ 2 ] := nCol return nil + METHOD Local() CLASS TDebugger ::lShowLocals := ! ::lShowLocals - - if ::lShowPublics .or. ::lShowPrivates .or. ::lShowStatics .or. ::lShowLocals - ::LoadVars() - ::ShowVars() - else - ::HideVars() - endif + ::RefreshVars() return nil + METHOD Private() CLASS TDebugger ::lShowPrivates := ! ::lShowPrivates - - if ::lShowPublics .or. ::lShowPrivates .or. ::lShowStatics .or. ::lShowLocals - ::LoadVars() - ::ShowVars() - else - ::HideVars() - endif + ::RefreshVars() return nil METHOD Public() CLASS TDebugger ::lShowPublics := ! ::lShowPublics - - if ::lShowPublics .or. ::lShowPrivates .or. ::lShowStatics .or. ::lShowLocals - ::LoadVars() - ::ShowVars() - else - ::HideVars() - endif + ::RefreshVars() return nil @@ -2230,10 +2246,14 @@ return nil METHOD Stack() CLASS TDebugger - if ::lShowCallStack := ! ::lShowCallStack - ::ShowCallStack() - else - ::HideCallStack() + ::lShowCallStack := ! ::lShowCallStack + ::oPulldown:GetItemByIdent( "CALLSTACK" ):checked := ::lShowCallStack + if ::lActive + if ::lShowCallStack + ::ShowCallStack() + else + ::HideCallStack() + endif endif return nil @@ -2241,13 +2261,7 @@ return nil METHOD Static() CLASS TDebugger ::lShowStatics := ! ::lShowStatics - - ::LoadVars() - if ::lShowPublics .or. ::lShowPrivates .or. ::lShowStatics .or. ::lShowLocals - ::ShowVars() - else - ::HideVars() - endif + ::RefreshVars() return nil @@ -2455,16 +2469,21 @@ static function ValToStr( uVal ) return cResult -METHOD LineNumbers() CLASS TDebugger +METHOD LineNumbers( lLineNumbers ) CLASS TDebugger - ::oBrwText:lLineNumbers := !::oBrwText:lLineNumbers - ::oBrwText:RefreshAll() + If( lLineNumbers == NIL, lLineNumbers := !::lLineNumbers, ) + ::lLineNumbers := lLineNumbers + ::oPulldown:GetItemByIdent( "LINE" ):checked := ::lLineNumbers + IF ::oBrwText != NIL + ::oBrwText:lLineNumbers := lLineNumbers + ::oBrwText:RefreshAll() + ENDIF return Self METHOD Locate( nMode ) CLASS TDebugger - local cValue + local cValue, lFound DEFAULT nMode TO 0 @@ -2476,7 +2495,13 @@ METHOD Locate( nMode ) CLASS TDebugger ::cSearchString := cValue -return ::oBrwText:Search( ::cSearchString, ::lCaseSensitive, 0 ) + lFound := ::oBrwText:Search( ::cSearchString, ::lCaseSensitive, 0 ) + + // Save cursor position to be restored by ::oWndCode:bGotFocus + ::oWndCode:cargo[ 1 ] := Row() + ::oWndCode:cargo[ 2 ] := Col() + +RETURN lFound METHOD FindNext() CLASS TDebugger @@ -2486,6 +2511,10 @@ METHOD FindNext() CLASS TDebugger lFound := ::Locate( 1 ) else lFound := ::oBrwText:Search( ::cSearchString, ::lCaseSensitive, 1 ) + + // Save cursor position to be restored by ::oWndCode:bGotFocus + ::oWndCode:cargo[ 1 ] := Row() + ::oWndCode:cargo[ 2 ] := Col() endif return lFound @@ -2498,6 +2527,10 @@ METHOD FindPrevious() CLASS TDebugger lFound := ::Locate( 2 ) else lFound := ::oBrwText:Search( ::cSearchString, ::lCaseSensitive, 2 ) + + // Save cursor position to be restored by ::oWndCode:bGotFocus + ::oWndCode:cargo[ 1 ] := Row() + ::oWndCode:cargo[ 2 ] := Col() endif return lFound @@ -2522,7 +2555,7 @@ METHOD SearchLine() CLASS TDebugger cLine := ::InputBox( "Line number", "1" ) if Val( cLine ) > 0 - ::oBrwText:GotoLine ( Val( cLine ) ) + ::GotoLine ( Val( cLine ) ) endif return nil