/* * $Id$ */ /* * Harbour Project source code: * The Debugger * * Copyright 1999 Antonio Linares * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version, with one exception: * * The exception is that if you link the Harbour Runtime Library (HRL) * and/or the Harbour Virtual Machine (HVM) with other files to produce * an executable, this does not by itself cause the resulting executable * to be covered by the GNU General Public License. Your use of that * executable is in no way restricted on account of linking the HRL * and/or HVM code into it. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit * their web site at http://www.gnu.org/). * */ /* NOTE: Don't use SAY/DevOut()/DevPos() for screen output, otherwise the debugger output may interfere with the applications output redirection, and is also slower. [vszel] */ #pragma -es0 #include "hbclass.ch" #include "hbmemvar.ch" #include "box.ch" #include "inkey.ch" #include "common.ch" #include "setcurs.ch" #define ALTD_DISABLE 0 #define ALTD_ENABLE 1 static s_oDebugger static s_lExit := .F. procedure AltD( nAction ) static s_lEnabled := .t. do case case nAction == nil if s_lEnabled s_lExit := .f. __dbgEntry( ProcLine( 2 ) ) endif case nAction == ALTD_DISABLE s_lEnabled := .f. case nAction == ALTD_ENABLE s_lEnabled := .t. endcase return procedure __dbgEntry( uParam1, uParam2, uParam3 ) // debugger entry point do case case ValType( uParam1 ) == "C" // called from hvm.c hb_vmModuleName() if ! s_lExit if s_oDebugger == nil s_oDebugger := TDebugger():New() s_oDebugger:Activate( uParam1 ) else s_oDebugger:ShowCode( uParam1 ) endif endif case ValType( uParam1 ) == "N" // called from hvm.c hb_vmDebuggerShowLines() if s_oDebugger != nil if PCount() == 3 // called from hvm.c hb_vmLocalName() and hb_vmStaticName() if uParam3 == 1 // static variable AAdd( s_oDebugger:aVars, { uParam2, uParam1, "Static", ProcName( 1 ) } ) else // local variable AAdd( s_oDebugger:aVars, { uParam2, uParam1, "Local", ProcName( 1 ) } ) endif if s_oDebugger:oBrwVars != nil s_oDebugger:oBrwVars:RefreshAll() endif return endif if s_oDebugger:lGo s_oDebugger:lGo := ! s_oDebugger:IsBreakPoint( uParam1 ) endif if s_oDebugger:lGo DispBegin() DispBegin() s_oDebugger:SaveAppStatus() s_oDebugger:RestoreAppStatus() DispEnd() DispEnd() else s_oDebugger:SaveAppStatus() s_oDebugger:GoToLine( uParam1 ) s_oDebugger:HandleEvent() endif endif otherwise // called from hvm.c hb_vmDebuggerEndProc() if s_oDebugger != nil s_oDebugger:EndProc() endif endcase return CLASS TDebugger DATA aWindows, nCurrentWindow DATA oPullDown DATA oWndCode, oWndCommand, oWndStack, oWndVars DATA oBar, oBrwText, cPrgName, oBrwStack, oBrwVars, aVars DATA cImage DATA lEnd DATA cAppImage, nAppRow, nAppCol, cAppColors, nAppCursor DATA aBreakPoints, aCallStack DATA aLastCommands, nCommand, oGetListCommand DATA lGo DATA cClrDialog METHOD New() METHOD Activate( cModuleName ) METHOD BuildCommandWindow() METHOD CodeWindowProcessKey( nKey ) METHOD CommandWindowProcessKey( nKey ) METHOD EditVar( nVar ) METHOD EndProc() METHOD Exit() INLINE ::lEnd := .t. METHOD Go() INLINE ::RestoreAppStatus(), ::lGo := .t., DispEnd(), ::Exit() METHOD GoToLine( nLine ) METHOD HandleEvent() METHOD Hide() METHOD InputBox( cMsg, uValue, bValid ) METHOD IsBreakPoint( nLine ) METHOD LoadVars() METHOD NextWindow() METHOD Open() METHOD PrevWindow() METHOD RestoreAppStatus() METHOD SaveAppStatus() METHOD Show() METHOD ShowAppScreen() METHOD ShowCallStack() METHOD ShowCode( cModuleName ) METHOD ShowVars() METHOD ToggleBreakPoint() METHOD ViewSets() METHOD WndVarsLButtonDown( nMRow, nMCol ) METHOD LineNumbers() // Toggles numbering of source code lines ENDCLASS METHOD New() CLASS TDebugger ::aWindows := {} ::nCurrentWindow := 1 ::cClrDialog := "N/W" ::oPullDown := __dbgBuildMenu( Self ) ::oWndCode := TDbWindow():New( 1, 0, MaxRow() - 6, MaxCol(),, "BG+/B" ) ::oWndCode:bKeyPressed := { | nKey | ::CodeWindowProcessKey( nKey ) } ::oWndCode:bGotFocus := { || ::oGetListCommand:SetFocus(), SetCursor( SC_SPECIAL1 ) } ::oWndCode:bLostFocus := { || SetCursor( SC_NONE ) } AAdd( ::aWindows, ::oWndCode ) ::BuildCommandWindow() ::lEnd := .f. ::aBreakPoints := {} ::aCallStack := {} ::lGo := .f. ::aVars := {} return Self METHOD Activate( cModuleName ) CLASS TDebugger ::Show() ::ShowCode( cModuleName ) ::ShowCallStack() ::ShowVars() ::RestoreAppStatus() return nil METHOD BuildCommandWindow() CLASS TDebugger local GetList := {} local cCommand ::oWndCommand := TDbWindow():New( MaxRow() - 5, 0, MaxRow() - 1, MaxCol(),; "Command", "BG+/B" ) ::oWndCommand:bGotFocus := { || ::oGetListCommand:SetFocus(), SetCursor( SC_NORMAL ) } ::oWndCommand:bLostFocus := { || SetCursor( SC_NONE ) } ::oWndCommand:bKeyPressed := { | nKey | ::CommandWindowProcessKey( nKey ) } ::oWndCommand:bPainted := { || DispOutAt( ::oWndCommand:nBottom - 1,; ::oWndCommand:nLeft + 1, "> ", ::oWndCommand:cColor ) } AAdd( ::aWindows, ::oWndCommand ) ::aLastCommands := {} ::nCommand := 0 cCommand := Space( ::oWndCommand:nRight - ::oWndCommand:nLeft - 3 ) // We don't use the GET command here to avoid the painting of the GET AAdd( GetList, Get():New( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 3,; { | u | iif( PCount() > 0, cCommand := u, cCommand ) }, "cCommand" ) ) ATail( GetList ):ColorSpec := Replicate( ::oWndCommand:cColor + ",", 5 ) ::oGetListCommand := TGetList():New( GetList ) return nil METHOD CodeWindowProcessKey( nKey ) CLASS TDebugger do case case nKey == K_HOME ::oBrwText:GoTop() case nKey == K_END ::oBrwText:GoBottom() case nKey == K_LEFT ::oBrwText:Left() case nKey == K_RIGHT ::oBrwText:Right() case nKey == K_UP ::oBrwText:Up() case nKey == K_DOWN ::oBrwText:Down() case nKey == K_PGUP ::oBrwText:PageUp() case nKey == K_PGDN ::oBrwText:PageDown() endcase return nil METHOD CommandWindowProcessKey( nKey ) CLASS TDebugger local cCommand, cResult, oE local bLastHandler do case case nKey == K_UP if ::nCommand > 0 ::oGetListCommand:oGet:VarPut( ::aLastCommands[ ::nCommand ] ) ::oGetListCommand:oGet:Buffer := ::aLastCommands[ ::nCommand ] ::oGetListCommand:oGet:Pos := 1 ::oGetListCommand:oGet:Display() if ::nCommand > 1 ::nCommand-- endif endif case nKey == K_DOWN if ::nCommand > 0 .AND. ::nCommand <= Len( ::aLastCommands ) ::oGetListCommand:oGet:VarPut( ::aLastCommands[ ::nCommand ] ) ::oGetListCommand:oGet:Buffer := ::aLastCommands[ ::nCommand ] ::oGetListCommand:oGet:Pos := 1 ::oGetListCommand:oGet:Display() if ::nCommand < Len( ::aLastCommands ) ::nCommand++ endif endif case nKey == K_ENTER cCommand := ::oGetListCommand:oGet:VarGet() AAdd( ::aLastCommands, cCommand ) ::nCommand++ ::oWndCommand:ScrollUp( 1 ) bLastHandler := ErrorBlock({ |objErr| BREAK (objErr) }) if SubStr( LTrim( cCommand ), 1, 2 ) == "? " begin sequence cResult := ValToStr( &( AllTrim( SubStr( LTrim( cCommand ), 3 ) ) ) ) recover using oE cResult := "Command error: " + oE:description end sequence else cResult := "Command error" endif ErrorBlock(bLastHandler) DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1,; Space( ::oWndCommand:nRight - ::oWndCommand:nLeft - 1 ),; ::oWndCommand:cColor ) DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 3, cResult,; ::oWndCommand:cColor ) ::oWndCommand:ScrollUp( 1 ) DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, "> ",; ::oWndCommand:cColor ) cCommand := Space( ::oWndCommand:nRight - ::oWndCommand:nLeft - 3 ) ::oGetListCommand:oGet:VarPut( cCommand ) ::oGetListCommand:oGet:Buffer := cCommand ::oGetListCommand:oGet:Pos := 1 ::oGetListCommand:oGet:Display() otherwise ::oGetListCommand:GetApplyKey( nKey ) endcase return nil METHOD EditVar( nVar ) CLASS TDebugger local cVarName := ::aVars[ nVar ][ 1 ] local uVarValue := ::aVars[ nVar ][ 2 ] local nProcLevel := 1 local aArray if ::aVars[ nVar ][ 3 ] == "Local" while ProcName( nProcLevel ) != ::aVars[ nVar ][ 4 ] nProcLevel++ end uVarValue = __vmVarLGet( nProcLevel, ::aVars[ nVar ][ 2 ] ) endif uVarValue := ::InputBox( cVarName, ValToStr( uVarValue ) ) do case case uVarValue == "{ ... }" if ::aVars[ nVar ][ 3 ] == "Local" aArray = __vmVarLGet( nProcLevel, ::aVars[ nVar ][ 2 ] ) if Len( aArray ) > 0 __DbgArrays( aArray, cVarName ) else Alert( "Array is empty" ) endif else aArray = ::aVars[ nVar ][ 2 ] if Len( aArray ) > 0 __DbgArrays( aArray, cVarName ) else Alert("Array is empty") endif endif case Upper( SubStr( uVarValue, 1, 5 ) ) == "CLASS" if ::aVars[ nVar ][ 3 ] == "Local" __DbgObject( __vmVarLGet( nProcLevel, ::aVars[ nVar ][ 2 ] ), cVarName ) else __DbgObject( ::aVars[ nVar ][ 2 ], cVarName ) endif otherwise if ::aVars[ nVar ][ 3 ] == "Local" __vmVarLSet( nProcLevel, ::aVars[ nVar ][ 2 ], &uVarValue ) else ::aVars[ nVar ][ 2 ] := &uVarValue &( ::aVars[ nVar ][ 1 ] ) := ::aVars[ nVar ][ 2 ] endif endcase ::oBrwVars:RefreshCurrent() ::oBrwVars:ForceStable() return nil METHOD EndProc() CLASS TDebugger if Len( ::aCallStack ) > 1 ADel( ::aCallStack, 1 ) ASize( ::aCallStack, Len( ::aCallStack ) - 1 ) if ::oBrwStack != nil ::oBrwStack:RefreshAll() endif endif return nil METHOD HandleEvent() CLASS TDebugger local nPopup, oWnd local nKey, nMRow, nMCol, n ::lEnd := .f. while ! ::lEnd nKey := InKey( 0, INKEY_ALL ) do case case ::oPullDown:IsOpen() ::oPullDown:ProcessKey( nKey ) if ::oPullDown:nOpenPopup == 0 // Closed ::aWindows[ ::nCurrentWindow ]:SetFocus( .t. ) endif case nKey == K_LDBLCLK if MRow() == 0 elseif MRow() == MaxRow() else nMRow := MRow() nMCol := MCol() for n := 1 to Len( ::aWindows ) if ::aWindows[ n ]:IsOver( nMRow, nMCol ) if ! ::aWindows[ n ]:lFocused ::aWindows[ ::nCurrentWindow ]:SetFocus( .f. ) ::nCurrentWindow := n ::aWindows[ n ]:SetFocus( .t. ) endif ::aWindows[ n ]:LDblClick( nMRow, nMCol ) n := Len( ::aWindows ) + 1 endif next endif case nKey == K_LBUTTONDOWN if MRow() == 0 if ( nPopup := ::oPullDown:GetItemOrdByCoors( 0, MCol() ) ) != 0 SetCursor( SC_NONE ) ::oPullDown:ShowPopup( nPopup ) endif elseif MRow() == MaxRow() else nMRow := MRow() nMCol := MCol() for n := 1 to Len( ::aWindows ) if ::aWindows[ n ]:IsOver( nMRow, nMCol ) if ! ::aWindows[ n ]:lFocused ::aWindows[ ::nCurrentWindow ]:SetFocus( .f. ) ::nCurrentWindow := n ::aWindows[ n ]:SetFocus( .t. ) endif ::aWindows[ n ]:LButtonDown( nMRow, nMCol ) n := Len( ::aWindows ) + 1 endif next endif case nKey == K_RBUTTONDOWN case nKey == K_ESC ::RestoreAppStatus() s_oDebugger := nil s_lExit := .T. DispEnd() ::Exit() case nKey == K_UP .or. nKey == K_DOWN .or. nKey == K_HOME .or. ; nKey == K_END .or. nKey == K_ENTER oWnd := ::aWindows[ ::nCurrentWindow ] oWnd:KeyPressed( nKey ) case nKey == K_F4 ::ShowAppScreen() case nKey == K_F5 ::Go() case nKey == K_F8 ::RestoreAppStatus() ::Exit() case nKey == K_F9 ::ToggleBreakPoint() case nKey == K_TAB ::NextWindow() case nKey == K_SH_TAB ::PrevWindow() case ::oWndCommand:lFocused .and. nKey < 272 // Alt ::oWndCommand:KeyPressed( nKey ) otherwise if ( nPopup := ::oPullDown:GetHotKeyPos( __dbgAltToKey( nKey ) ) ) != 0 if ::oPullDown:nOpenPopup != nPopup SetCursor( SC_NONE ) ::oPullDown:ShowPopup( nPopup ) endif endif endcase end return nil METHOD Hide() CLASS TDebugger RestScreen( ,,,, ::cAppImage ) ::cAppImage := nil SetColor( ::cAppColors ) SetCursor( ::nAppCursor ) return nil METHOD NextWindow() CLASS TDebugger local oWnd if Len( ::aWindows ) > 0 oWnd := ::aWindows[ ::nCurrentWindow++ ] oWnd:SetFocus( .f. ) if ::nCurrentWindow > Len( ::aWindows ) ::nCurrentWindow := 1 endif oWnd := ::aWindows[ ::nCurrentWindow ] oWnd:SetFocus( .t. ) endif return nil METHOD PrevWindow() CLASS TDebugger local oWnd if Len( ::aWindows ) > 0 oWnd := ::aWindows[ ::nCurrentWindow-- ] oWnd:SetFocus( .f. ) if ::nCurrentWindow < 1 ::nCurrentWindow := Len( ::aWindows ) endif oWnd := ::aWindows[ ::nCurrentWindow ] oWnd:SetFocus( .t. ) endif return nil METHOD Show() CLASS TDebugger ::cAppImage := SaveScreen() ::nAppRow := Row() ::nAppCol := Col() ::cAppColors := SetColor() ::nAppCursor := SetCursor( SC_NONE ) ::oPullDown:Display() ::oWndCode:Show( .t. ) ::oWndCommand:Show() DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, ">" ) SetColor( "N/BG" ) @ MaxRow(), 0 CLEAR TO MaxRow(), MaxCol() DispOutAt( MaxRow(), 0, "F1-Help F2-Zoom F3-Repeat F4-User F5-Go F6-WA F7-Here F8-Step F9-BkPt F10-Trace", "N/BG" ) DispOutAt( MaxRow(), 0, "F1", "GR+/BG" ) DispOutAt( MaxRow(), 8, "F2", "GR+/BG" ) DispOutAt( MaxRow(), 16, "F3", "GR+/BG" ) DispOutAt( MaxRow(), 26, "F4", "GR+/BG" ) DispOutAt( MaxRow(), 34, "F5", "GR+/BG" ) DispOutAt( MaxRow(), 40, "F6", "GR+/BG" ) DispOutAt( MaxRow(), 46, "F7", "GR+/BG" ) DispOutAt( MaxRow(), 54, "F8", "GR+/BG" ) DispOutAt( MaxRow(), 62, "F9", "GR+/BG" ) DispOutAt( MaxRow(), 70, "F10", "GR+/BG" ) return nil METHOD ShowAppScreen() CLASS TDebugger ::cImage := SaveScreen() RestScreen( 0, 0, MaxRow(), MaxCol(), ::cAppImage ) InKey( 0 ) RestScreen( 0, 0, MaxRow(), MaxCol(), ::cImage ) return nil METHOD ShowCallStack() CLASS TDebugger local n := 1 if ::oWndStack == nil ::oWndCode:nRight -= 16 ::oBrwText:Resize(,,, ::oBrwText:nRight - 16) ::oWndCode:SetFocus( .t. ) ::oWndStack := TDbWindow():New( 1, MaxCol() - 15, MaxRow() - 6, MaxCol(),; "Stack", "BG+/B" ) ::oWndStack:Show( .f. ) AAdd( ::aWindows, ::oWndStack ) ::oBrwStack := TBrowseNew( 2, MaxCol() - 14, MaxRow() - 7, MaxCol() - 1 ) ::oBrwStack:ColorSpec := "BG+/B, N/BG" ::oBrwStack:GoTopBlock := { || n := 1 } ::oBrwStack:GoBottomBlock := { || n := Len( ::aCallStack ) } ::oBrwStack:SkipBlock := { | nSkip, nPos | nPos := n,; n := iif( nSkip > 0, Min( Len( ::aCallStack ), n + nSkip ),; Max( 1, n + nSkip ) ), n - nPos } ::oBrwStack:AddColumn( TBColumnNew( "", { || PadC( ::aCallStack[ n ], 14 ) } ) ) ::oBrwStack:ForceStable() endif return nil METHOD LoadVars() CLASS TDebugger // updates monitored variables local nCount, n, xValue, cName ::aVars := {} nCount := __mvDbgInfo( HB_MV_PUBLIC ) for n := nCount to 1 step -1 xValue := __mvDbgInfo( HB_MV_PUBLIC, n, @cName ) AAdd( ::aVars, { cName, xValue, "Public" } ) next nCount := __mvDbgInfo( HB_MV_PRIVATE ) for n := nCount to 1 step -1 xValue := __mvDbgInfo( HB_MV_PRIVATE, n, @cName ) AAdd( ::aVars, { cName, xValue, "Private" } ) next return nil METHOD ShowVars(bSort,nType) CLASS TDebugger local n local nWidth if ::oWndVars == nil n := 1 ::oWndCode:nTop += 5 ::oBrwText:Resize(::oBrwText:nTop + 5) ::oBrwText:RefreshAll() ::oWndCode:SetFocus( .t. ) ::oWndVars := TDbWindow():New( 1, 0, 5,; MaxCol() - iif( ::oWndStack != nil, ::oWndStack:nWidth(), 0 ),; "Monitor", "BG+/B" ) ::oWndVars:Show( .f. ) AAdd( ::aWindows, ::oWndVars ) ::oWndVars:bKeyPressed := { | nKey | iif( nKey == K_DOWN, ( ::oBrwVars:Down(),; ::oBrwVars:ForceStable() ), nil ), iif( nKey == K_UP, ( ::oBrwVars:Up(),; ::oBrwVars:ForceStable() ), nil ), iif( nKey == K_ENTER, ::EditVar( n ), nil ) } ::oWndVars:bLButtonDown = { | nMRow, nMCol | ::WndVarsLButtonDown( nMRow, nMCol ) } ::oWndVars:bLDblClick = { | nMRow, nMCol | ::EditVar( n ) } ::oBrwVars := TBrowseNew( 2, 1, 4, MaxCol() - iif( ::oWndStack != nil,; ::oWndStack:nWidth(), 0 ) - 1 ) ::oBrwVars:ColorSpec := "BG+/B, N/BG" ::LoadVars() ::oBrwVars:GoTopBlock := { || n := 1 } ::oBrwVars:GoBottomBlock := { || n := Len( ::aVars ) } ::oBrwVars:SkipBlock := { | nSkip, nPos | nPos := n,; n := iif( nSkip > 0, Min( Len( ::aVars ), n + nSkip ),; Max( 1, n + nSkip ) ), n - nPos } nWidth := ::oWndVars:nWidth() - 1 ::oBrwVars:AddColumn( TBColumnNew( "", { || AllTrim( Str( n ) ) + ") " + ; PadR( GetVarInfo( ::aVars[ n ] ), ::oWndVars:nWidth() - 5 ) } ) ) ::oBrwVars:ForceStable() endif return nil static function GetVarInfo( aVar ) local nProcLevel := 1 do case case aVar[ 3 ] == "Local" while ProcName( nProcLevel ) != aVar[ 4 ] nProcLevel++ end return aVar[ 1 ] + " <" + aVar[ 3 ] + ", " + ; ValType( __vmVarLGet( nProcLevel, aVar[ 2 ] ) ) + ; ">: " + ValToStr( __vmVarLGet( nProcLevel, aVar[ 2 ] ) ) case aVar[ 3 ] == "Public" .or. aVar[ 3 ] == "Private" return aVar[ 1 ] + " <" + aVar[ 3 ] + ", " + ValType( aVar[ 2 ] ) + ; ">: " + ValToStr( aVar[ 2 ] ) case aVar[ 3 ] == "Static" return aVar[ 1 ] + " <" + aVar[ 3 ] + ", " + ValType( aVar[ 2 ] ) + ; ">: " + ValToStr( aVar[ 2 ] ) endcase return "" static function CompareLine( Self ) return { | a | a[ 1 ] == Self:oBrwText:nRow } // it was nLine METHOD ShowCode( cModuleName ) CLASS TDebugger local cFunction := SubStr( cModuleName, At( ":", cModuleName ) + 1 ) local cPrgName := SubStr( cModuleName, 1, At( ":", cModuleName ) - 1 ) ASize( ::aCallStack, Len( ::aCallStack ) + 1 ) AIns( ::aCallStack, 1 ) if Len( ::aCallStack ) == 1 ::aCallStack[ 1 ] := ProcName( 3 ) // cFunction else ::aCallStack[ 1 ] := ProcName( 2 ) // cFunction endif if ::oWndStack != nil ::oBrwStack:RefreshAll() endif if cPrgName != ::cPrgName ::cPrgName := cPrgName ::oBrwText := TBrwText():New( ::oWndCode:nTop + 1, ::oWndCode:nLeft + 1,; ::oWndCode:nBottom - 1, ::oWndCode:nRight - 1, ::cPrgName, "BG+/B, N/BG", "W+/R, W+/BG" ) //::oBrwText:aColumns[ 1 ]:ColorBlock := { || iif( AScan( ::aBreakPoints,; // CompareLine( Self ) ) != 0, { 3, 4 }, { 1, 2 } ) } ::oWndCode:SetCaption( ::cPrgName ) endif return nil METHOD Open() CLASS TDebugger local cFileName := ::InputBox( "Please enter the filename", Space( 30 ) ) return nil METHOD InputBox( cMsg, uValue, bValid ) CLASS TDebugger local nTop := ( MaxRow() / 2 ) - 5 local nLeft := ( MaxCol() / 2 ) - 20 local nBottom := ( MaxRow() / 2 ) - 3 local nRight := ( MaxCol() / 2 ) + 20 local uTemp := PadR( uValue, nRight - nLeft - 1 ) local GetList := {} local nOldCursor local lScoreBoard := Set( _SET_SCOREBOARD, .f. ) local oWndInput := TDbWindow():New( nTop, nLeft, nBottom, nRight, cMsg,; ::oPullDown:cClrPopup ) oWndInput:lShadow := .t. oWndInput:Show() if bValid == nil @ nTop + 1, nLeft + 1 GET uTemp else @ nTop + 1, nLeft + 1 GET uTemp VALID bValid endif nOldCursor := SetCursor( SC_NORMAL ) READ SetCursor( nOldCursor ) oWndInput:Hide() Set( _SET_SCOREBOARD, lScoreBoard ) return iif( LastKey() != K_ESC, AllTrim( uTemp ), uValue ) METHOD IsBreakPoint( nLine ) CLASS TDebugger return AScan( ::aBreakPoints, { | aBreak | aBreak[ 1 ] == nLine } ) != 0 METHOD GotoLine( nLine ) CLASS TDebugger ::oBrwText:GotoLine( nLine ) if ::oBrwVars != nil // ::LoadVars() ::oBrwVars:RefreshAll() ::oBrwVars:ForceStable() endif if ::oBrwStack != nil .and. ! ::oBrwStack:Stable ::oBrwStack:ForceStable() endif return nil METHOD RestoreAppStatus() CLASS TDebugger ::cImage := SaveScreen() DispBegin() RestScreen( 0, 0, MaxRow(), MaxCol(), ::cAppImage ) SetPos( ::nAppRow, ::nAppCol ) SetColor( ::cAppColors ) SetCursor( ::nAppCursor ) return nil METHOD SaveAppStatus() CLASS TDebugger ::cAppImage := SaveScreen() ::nAppRow := Row() ::nAppCol := Col() ::cAppColors := SetColor() ::nAppCursor := SetCursor() RestScreen( 0, 0, MaxRow(), MaxCol(), ::cImage ) SetCursor( SC_NONE ) DispEnd() return nil METHOD ToggleBreakPoint() CLASS TDebugger local nAt := AScan( ::aBreakPoints, { | aBreak | aBreak[ 1 ] == ; ::oBrwText:nRow } ) // it was nLine if nAt == 0 AAdd( ::aBreakPoints, { ::oBrwText:nRow, ::cPrgName } ) // it was nLine ::oBrwText:ToggleBreakPoint(::oBrwText:nRow, .T.) else ADel( ::aBreakPoints, nAt ) ASize( ::aBreakPoints, Len( ::aBreakPoints ) - 1 ) ::oBrwText:ToggleBreakPoint(::oBrwText:nRow, .F.) endif ::oBrwText:RefreshCurrent() return nil METHOD ViewSets() CLASS TDebugger local oWndSets := TDbWindow():New( 1, 8, MaxRow() - 2, MaxCol() - 8,; "System Settings[1..47]", ::cClrDialog ) local aSets := { "Exact", "Fixed", "Decimals", "DateFormat", "Epoch", "Path",; "Default", "Exclusive", "SoftSeek", "Unique", "Deleted",; "Cancel", "Debug", "TypeAhead", "Color", "Cursor", "Console",; "Alternate", "AltFile", "Device", "Extra", "ExtraFile",; "Printer", "PrintFile", "Margin", "Bell", "Confirm", "Escape",; "Insert", "Exit", "Intensity", "ScoreBoard", "Delimeters",; "DelimChars", "Wrap", "Message", "MCenter", "ScrollBreak",; "EventMask", "VideoMode", "MBlockSize", "MFileExt",; "StrictRead", "Optimize", "Autopen", "Autorder", "AutoShare" } local oBrwSets := TBrowseNew( oWndSets:nTop + 1, oWndSets:nLeft + 1,; oWndSets:nBottom - 1, oWndSets:nRight - 1 ) local n := 1 local nWidth := oWndSets:nRight - oWndSets:nLeft - 1 local oCol oBrwSets:ColorSpec := "N/W, R/W, N/BG" oBrwSets:GoTopBlock := { || n := 1 } oBrwSets:GoBottomBlock := { || n := Len( aSets ) } oBrwSets:SkipBlock := { | nSkip, nPos | nPos := n,; n := iif( nSkip > 0, Min( Len( aSets ), n + nSkip ),; Max( 1, n + nSkip ) ), n - nPos } oBrwSets:AddColumn( ocol := TBColumnNew( "", { || PadR( aSets[ n ], 12 ) } ) ) ocol:colorblock := { || { iif( n == oBrwSets:Cargo, 2, 1 ), 2 } } oBrwSets:AddColumn( oCol := TBColumnNew( "",; { || PadR( ValToStr( Set( n ) ), nWidth - 13 ) } ) ) oBrwSets:Cargo := 1 // Actual highligthed row oBrwSets:colPos:=2 oBrwSets:Freeze:=1 ocol:ColorBlock := { || { iif( n == oBrwSets:Cargo, 3, 1 ), 3 } } oWndSets:bPainted := { || oBrwSets:ForceStable() } oWndSets:bKeyPressed := { | nKey | SetsKeyPressed( nKey, oBrwSets, Len( aSets ),; oWndSets ) } SetCursor( SC_NONE ) oWndSets:ShowModal() return nil METHOD WndVarsLButtonDown( nMRow, nMCol ) CLASS TDebugger if nMRow > ::oWndVars:nTop .and. ; nMRow < ::oWndVars:nBottom .and. ; nMCol > ::oWndVars:nLeft .and. ; nMCol < ::oWndVars:nRight if nMRow - ::oWndVars:nTop >= 1 .and. ; nMRow - ::oWndVars:nTop <= Len( ::aVars ) while ::oBrwVars:RowPos > nMRow - ::oWndVars:nTop ::oBrwVars:Up() ::oBrwVars:ForceStable() end while ::oBrwVars:RowPos < nMRow - ::oWndVars:nTop ::oBrwVars:Down() ::oBrwVars:ForceStable() end endif endif return nil static procedure SetsKeyPressed( nKey, oBrwSets, nSets, oWnd ) local nSet := oBrwSets:Cargo do case case nKey == K_UP if oBrwSets:Cargo > 1 oBrwSets:Cargo-- oBrwSets:RefreshCurrent() oBrwSets:Up() oBrwSets:ForceStable() endif case nKey == K_DOWN if oBrwSets:Cargo < nSets oBrwSets:Cargo++ oBrwSets:RefreshCurrent() oBrwSets:Down() oBrwSets:ForceStable() endif case nKey == K_HOME if oBrwSets:Cargo > 1 oBrwSets:Cargo := 1 oBrwSets:GoTop() oBrwSets:ForceStable() endif case nKey == K_END if oBrwSets:Cargo < nSets oBrwSets:Cargo := nSets oBrwSets:GoBottom() oBrwSets:ForceStable() endif /* case nKey == K_ENTER ::doGet(*/ endcase if nSet != oBrwSets:Cargo oWnd:SetCaption( "System Settings[" + AllTrim( Str( oBrwSets:Cargo ) ) + ; "..47]" ) endif return static function ValToStr( uVal ) local cType := ValType( uVal ) local cResult := "U" do case case uVal == nil cResult := "NIL" case cType == "A" cResult := "{ ... }" Case cType =="B" cResult:= "{ || ... }" case cType $ "CM" cResult := '"' + uVal + '"' case cType == "L" cResult := iif( uVal, ".T.", ".F." ) case cType == "D" cResult := DToC( uVal ) case cType == "N" cResult := AllTrim( Str( uVal ) ) case cType == "O" cResult := "Class " + uVal:ClassName() + " object" endcase return cResult METHOD LineNumbers() CLASS TDebugger ::oBrwText:lLineNumbers := !::oBrwText:lLineNumbers ::oBrwText:RefreshAll() return Self