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

2004-06-07 18:15 UTC+0300 Phil Krylov <phil@newstar.rinet.ru>

Browse Source
This commit is contained in:
Phil Krylov
2004-06-07 14:14:49 +00:00
parent c4d8ff8810
commit 9604dd514f
3 changed files with 154 additions and 105 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
harbour/ChangeLog
View File

@@ -8,6 +8,11 @@
2002-12-01 23:12 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2004-06-07 18:15 UTC+0300 Phil Krylov <phil@newstar.rinet.ru>
* 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 <phil@newstar.rinet.ru>
* source/rtl/inkey.c
+ Added hb_setInkeyLast() (copyright 2002 by Walter Negro) and

77
harbour/source/debug/dbgmenu.prg
View File

@@ -55,9 +55,9 @@
#xcommand MENU [<oMenu>] => [ <oMenu> := ] TDbMenu():New()
#xcommand MENUITEM [ <oMenuItem> PROMPT ] <cPrompt> ;
[ IDENT <nIdent> ] [ ACTION <uAction,...> ] ;
[ <checked: CHECK, CHECKED> ] => ;
[ CHECKED <bChecked> ] => ;
[ <oMenuItem> := ] TDbMenu():AddItem( TDbMenuItem():New( <cPrompt>,;
[{|Self|<uAction>}] ,[<.checked.>], [<nIdent>] ) )
[{|Self|<uAction>}], [<bChecked>], [<nIdent>] ) )
#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()

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

@@ -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