/* * $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] */ #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. static s_lEnabled := .t. function AltD( nAction ) 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 nil function __dbgEntry( uParam1, uParam2 ) // 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() == 2 // called from hvm.c hb_vmDebuggerLocalName() AAdd( s_oDebugger:aVars, { uParam2, "Local", uParam1 } ) if s_oDebugger:oBrwVars != nil s_oDebugger:oBrwVars:RefreshAll() endif return nil 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 nil 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() ENDCLASS METHOD New() CLASS TDebugger ::aWindows = {} ::nCurrentWindow = 1 ::cClrDialog = "N/W" ::oPullDown = BuildMenu( Self ) ::oWndCode = TDbWindow():New( 1, 0, MaxRow() - 6, MaxCol(),, "BG+/B" ) ::oWndCode:bKeyPressed = { | nKey | ::CodeWindowProcessKey( nKey ) } 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, TGet():New( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 3,; { | u | If( 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() ::oBrwText:ForceStable() case nKey == K_END ::oBrwText:GoBottom() ::oBrwText:ForceStable() case nKey == K_UP ::oBrwText:Up() ::oBrwText:ForceStable() case nKey == K_DOWN ::oBrwText:Down() ::oBrwText:ForceStable() case nKey == K_PGUP ::oBrwText:PageUp() ::oBrwText:ForceStable() case nKey == K_PGDN ::oBrwText:PageDown() ::oBrwText:ForceStable() endcase return nil METHOD CommandWindowProcessKey( nKey ) CLASS TDebugger local cCommand, cResult 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 <= 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 ) if SubStr( LTrim( cCommand ), 1, 2 ) == "? " cResult = ValToStr( &( AllTrim( SubStr( LTrim( cCommand ), 3 ) ) ) ) else cResult = "Command error" endif 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 ] uVarValue := ::InputBox( cVarName, ValToStr( uVarValue ) ) do case case uVarValue == "{ ... }" // It is an array, don't do anything case Upper( SubStr( uVarValue, 1, 5 ) ) == "CLASS" // It is an object, don't do anything otherwise ::aVars[ nVar ][ 2 ] = &uVarValue &( ::aVars[ nVar ][ 1 ] ) = ::aVars[ nVar ][ 2 ] 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 Alert( "Mouse Left button doble click" ) 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 ) .and. ; ! ::aWindows[ n ]:lFocused ::aWindows[ ::nCurrentWindow ]:SetFocus( .f. ) ::nCurrentWindow = n ::aWindows[ n ]:SetFocus( .t. ) 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( AltToKey( 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:nRight -= 16 ::oBrwText:aColumns[ 1 ]:Width -= 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 := If( 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() CLASS TDebugger local n local nWidth if ::oWndVars == nil n := 1 ::oWndCode:nTop += 5 ::oBrwText:nTop += 5 ::oBrwText:RefreshAll() ::oWndCode:SetFocus( .t. ) ::oWndVars = TDbWindow():New( 1, 0, 5,; MaxCol() - If( ::oWndStack != nil, ::oWndStack:nWidth(), 0 ),; "Monitor", "BG+/B" ) ::oWndVars:Show( .f. ) AAdd( ::aWindows, ::oWndVars ) ::oWndVars:bKeyPressed = { | nKey | If( nKey == K_DOWN, ( ::oBrwVars:Down(),; ::oBrwVars:ForceStable() ), nil ), If( nKey == K_UP, ( ::oBrwVars:Up(),; ::oBrwVars:ForceStable() ), nil ), If( nKey == K_ENTER, ::EditVar( n ), nil ) } ::oBrwVars = TBrowseNew( 2, 1, 4, MaxCol() - If( ::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 := If( 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 ) do case case aVar[ 3 ] == "Public" .or. aVar[ 3 ] == "Private" return aVar[ 1 ] + " <" + aVar[ 3 ] + ", " + ValType( aVar[ 2 ] ) + ; ">: " + ValToStr( aVar[ 2 ] ) case aVar[ 3 ] == "Local" return aVar[ 1 ] + " <" + aVar[ 2 ] + ", " + ; ValType( __vmVarLGet( 7, aVar[ 3 ] ) ) + ; ">: " + ValToStr( __vmVarLGet( 7, aVar[ 3 ] ) ) endcase return "" static function CompareLine( Self ) return { | a | a[ 1 ] == Self:oBrwText: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 = { || If( AScan( ::aBreakPoints,; CompareLine( Self ) ) != 0, { 3, 4 }, { 1, 2 } ) } ::oBrwText:ForceStable() ::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 If( 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:nLine } ) if nAt == 0 AAdd( ::aBreakPoints, { ::oBrwText:nLine, ::cPrgName } ) else ADel( ::aBreakPoints, nAt ) ASize( ::aBreakPoints, Len( ::aBreakPoints ) - 1 ) endif ::oBrwText:RefreshCurrent() ::oBrwText:ForceStable() 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, W+/W, N/BG" oBrwSets:GoTopBlock = { || n := 1 } oBrwSets:GoBottomBlock = { || n := Len( aSets ) } oBrwSets:SkipBlock = { | nSkip, nPos | nPos := n,; n := If( nSkip > 0, Min( Len( aSets ), n + nSkip ),; Max( 1, n + nSkip ) ), n - nPos } oBrwSets:AddColumn( TBColumnNew( "", { || PadR( aSets[ n ], 12 ) } ) ) oBrwSets:AddColumn( oCol := TBColumnNew( "",; { || PadR( ValToStr( Set( n ) ), nWidth - 13 ) } ) ) oBrwSets:Cargo = 1 // Actual highligthed row oCol:ColorBlock = { || { If( n == oBrwSets:Cargo, 3, 1 ), 3 } } oWndSets:bPainted = { || oBrwSets:ForceStable() } oWndSets:bKeyPressed = { | nKey | SetsKeyPressed( nKey, oBrwSets, Len( aSets ),; oWndSets ) } SetCursor( 0 ) oWndSets:ShowModal() return nil static function SetsKeyPressed( nKey, oBrwSets, nSets, oWnd ) local nSet := oBrwSets:Cargo do case case nKey == K_UP if oBrwSets:Cargo > 1 oBrwSets:Cargo-- SetsUp( oBrwSets ) endif case nKey == K_DOWN if oBrwSets:Cargo < nSets oBrwSets:Cargo++ SetsDown( oBrwSets ) endif case nKey == K_HOME if oBrwSets:Cargo > 1 oBrwSets:Cargo = 1 oBrwSets:GoTop() oBrwSets:RefreshAll() oBrwSets:ForceStable() endif case nKey == K_END if oBrwSets:Cargo < nSets oBrwSets:Cargo = nSets oBrwSets:GoBottom() oBrwSets:RefreshAll() oBrwSets:ForceStable() endif endcase if nSet != oBrwSets:Cargo oWnd:SetCaption( "System Settings[" + AllTrim( Str( oBrwSets:Cargo ) ) + ; "..47]" ) endif return nil static function SetsUp( oBrw ) local nRow := oBrw:RowPos local nSetPos if oBrw:RowPos = 1 nSetPos = oBrw:Cargo oBrw:Cargo = 0 oBrw:RefreshCurrent() oBrw:ForceStable() oBrw:Cargo = nSetPos endif oBrw:Up() oBrw:RefreshCurrent() if nRow != oBrw:Cargo oBrw:aReDraw[ nRow ] = .f. endif oBrw:ForceStable() return nil static function SetsDown( oBrw ) local nRow := oBrw:RowPos local nSetPos if oBrw:RowPos = oBrw:RowCount nSetPos = oBrw:Cargo oBrw:Cargo = 0 oBrw:RefreshCurrent() oBrw:ForceStable() oBrw:Cargo = nSetPos endif oBrw:Down() oBrw:RefreshCurrent() if nRow != oBrw:Cargo oBrw:aReDraw[ nRow ] = .f. endif oBrw:ForceStable() return nil CLASS TDbWindow // Debugger windows and dialogs DATA nTop, nLeft, nBottom, nRight DATA cCaption DATA cBackImage, cColor DATA lFocused, bGotFocus, bLostFocus DATA bKeyPressed, bPainted DATA lShadow DATA Cargo METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) METHOD Hide() METHOD IsOver( nRow, nCol ) METHOD nWidth() INLINE ::nRight - ::nLeft + 1 METHOD ScrollUp( nLines ) METHOD SetCaption( cCaption ) METHOD SetFocus( lOnOff ) METHOD Show( lFocused ) METHOD ShowModal() METHOD Move() METHOD KeyPressed( nKey ) ENDCLASS METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) CLASS TDbWindow ::nTop = nTop ::nLeft = nLeft ::nBottom = nBottom ::nRight = nRight ::cCaption = cCaption ::cColor = cColor ::lShadow = .f. return Self METHOD Hide() CLASS TDbWindow RestScreen( ::nTop, ::nLeft, ::nBottom + If( ::lShadow, 1, 0 ),; ::nRight + If( ::lShadow, 2, 0 ), ::cBackImage ) ::cBackImage = nil return nil METHOD IsOver( nRow, nCol ) CLASS TDbWindow return nRow >= ::nTop .and. nRow <= ::nBottom .and. ; nCol >= ::nLeft .and. nCol <= ::nRight METHOD ScrollUp( nLines ) CLASS TDbWindow DEFAULT nLines TO 1 SetColor( ::cColor ) Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1, nLines ) return nil METHOD SetCaption( cCaption ) CLASS TDbWindow local nOldLen := If( ::cCaption != nil, Len( ::cCaption ), 0 ) ::cCaption = cCaption if ! Empty( cCaption ) DispOutAt( ::nTop, ::nLeft + ( ( ::nRight - ::nLeft ) / 2 ) - ; ( ( Len( cCaption ) + 2 ) / 2 ),; " " + cCaption + " ", ::cColor ) endif return nil METHOD SetFocus( lOnOff ) CLASS TDbWindow if ! lOnOff .and. ::bLostFocus != nil Eval( ::bLostFocus, Self ) endif DispBegin() ::lFocused = lOnOff @ ::nTop, ::nLeft, ::nBottom, ::nRight BOX If( lOnOff, B_DOUBLE, B_SINGLE ) ; COLOR ::cColor DispOutAt( ::nTop, ::nLeft + 1, "[" + Chr( 254 ) + "]", ::cColor ) if ! Empty( ::cCaption ) ::SetCaption( ::cCaption ) endif if ::bPainted != nil Eval( ::bPainted, Self ) endif DispEnd() if lOnOff .and. ::bGotFocus != nil Eval( ::bGotFocus, Self ) endif return nil METHOD Show( lFocused ) CLASS TDbWindow DEFAULT lFocused TO .f. ::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom + If( ::lShadow, 1, 0 ),; ::nRight + If( ::lShadow, 2, 0 ) ) SetColor( ::cColor ) Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight ) ::SetFocus( lFocused ) If ::lShadow hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight ) endif return nil METHOD ShowModal() CLASS TDbWindow local lExit := .f. local nKey ::lShadow = .t. ::Show() while ! lExit nKey = InKey( 0 ) if ::bKeyPressed != nil Eval( ::bKeyPressed, nKey ) endif do case case nKey == K_ESC lExit = .t. endcase end ::Hide() return nil /*Method move() Move a window across the screen Copyright Luiz Rafael Culik 1999 */ METHOD Move() Class TDbWindow local nOldTop := ::nTop local nOldLeft := ::nLeft local nOldBottom := ::nbottom local nOldRight := ::nright local nKey while .t. RestScreen( ,,,, ::cbackimage ) DispBox( ::nTop, ::nLeft, ::nRight, ::nBottom, Replicate( Chr( 176 ), 8 ) + " " ) nKey := Inkey( 0 ) do case case nkey == K_UP if ::ntop != 0 ::ntop-- ::nbottom-- endif case nKey == K_DOWN if ::nBottom != MaxRow() ::nTop++ ::nBottom++ endif case nKey == K_LEFT if ::nLeft != 0 ::nLeft-- ::nRight-- endif case nKey == K_RIGHT if ::nBottom != MaxRow() ::nLeft++ ::nRight++ endif case nKey == K_ESC ::nTop := nOldTop ::nLeft := nOldLeft ::nBottom := nOldBottom ::nRight := nOldRight endcase if nKey == K_ESC .or. nKey == K_ENTER exit end end // __keyboard( chr( 0 ) ), inkey() ) return nil METHOD KeyPressed( nKey ) CLASS TDbWindow if ::bKeyPressed != nil Eval( ::bKeyPressed, nKey, Self ) endif return nil CLASS TDbMenu /* debugger menu */ CLASSDATA aMenus DATA nTop, nLeft, nBottom, nRight DATA aItems DATA cClrHilite, cClrHotKey, cClrHotFocus, cClrPopup DATA nOpenPopup // zero if no popup is shown DATA lPopup DATA cBackImage METHOD New( aItems ) METHOD AddItem( oMenuItem ) METHOD Build() METHOD ClosePopup() METHOD Close() INLINE ::ClosePopup( ::nOpenPopup ), ::nOpenPopup := 0 METHOD DeHilite() METHOD Display() METHOD EvalAction() METHOD GetHotKeyPos( nKey ) METHOD GetItemOrdByCoors( nRow, nCol ) METHOD GoBottom() METHOD GoDown() INLINE ::aItems[ ::nOpenPopup ]:bAction:GoRight() METHOD GoLeft() METHOD GoRight() METHOD GoTop() METHOD GoUp() INLINE ::aItems[ ::nOpenPopup ]:bAction:GoLeft() METHOD IsOpen() INLINE ::nOpenPopup != 0 METHOD ProcessKey( nKey ) METHOD ShowPopup( nPopup ) ENDCLASS METHOD New() CLASS TDbMenu local nCol := 0 if ::aMenus == nil ::aMenus = {} ::lPopup = .f. else ::lPopup = .t. endif ::nTop = 0 ::nLeft = 0 ::nBottom = 0 ::nRight = 0 ::aItems = {} ::cClrHilite = "W+/N" ::cClrHotFocus = "GR+/N" ::cClrHotKey = "GR+/BG" ::cClrPopup = "N/BG" ::nOpenPopup = 0 AAdd( ::aMenus, Self ) return Self METHOD AddItem( oMenuItem ) CLASS TDbMenu local oLastMenu := ATail( ::aMenus ), oLastMenuItem if oLastMenu:lPopup oMenuItem:nRow = Len( oLastMenu:aItems ) oMenuItem:nCol = oLastMenu:nLeft + 1 else oMenuItem:nRow = 0 if Len( oLastMenu:aItems ) > 0 oLastMenuItem = ATail( oLastMenu:aItems ) oMenuItem:nCol = oLastMenuItem:nCol + ; Len( StrTran( oLastMenuItem:cPrompt, "~", "" ) ) else oMenuItem:nCol = 0 endif endif AAdd( ATail( ::aMenus ):aItems, oMenuItem ) return oMenuItem METHOD Build() CLASS TDbMenu local n, nPos := 0, oMenuItem if Len( ::aMenus ) == 1 // pulldown menu for n = 1 to Len( ::aItems ) ::aItems[ n ]:nRow = 0 ::aItems[ n ]:nCol = nPos nPos += Len( StrTran( ::aItems[ n ]:cPrompt, "~", "" ) ) next else oMenuItem = ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ) ::nTop = oMenuItem:nRow + 1 ::nLeft = oMenuItem:nCol nPos = ::nLeft for n = 1 to Len( ::aItems ) ::aItems[ n ]:nRow = ::nTop + n ::aItems[ n ]:nCol = ::nLeft + 1 nPos = Max( nPos, ::nLeft + Len( StrTran( ::aItems[ n ]:cPrompt, "~", "" ) ) + 1 ) next ::nRight = nPos ::nBottom = ::nTop + Len( ::aItems ) + 1 for n = 1 to Len( ::aItems ) if ::aItems[ n ]:cPrompt != "-" ::aItems[ n ]:cPrompt = PadR( ::aItems[ n ]:cPrompt, ::nRight - ::nLeft ) endif next ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ):bAction = ATail( ::aMenus ) ::aMenus = ASize( ::aMenus, Len( ::aMenus ) - 1 ) endif return nil METHOD ClosePopup( nPopup ) CLASS TDbMenu local oPopup if nPopup != 0 oPopup = ::aItems[ nPopup ]:bAction if oPopup:ClassName() == "TDBMENU" RestScreen( oPopup:nTop, oPopup:nLeft, oPopup:nBottom + 1, oPopup:nRight + 2,; oPopup:cBackImage ) oPopup:cBackImage = nil endif ::aItems[ nPopup ]:Display( ::cClrPopup, ::cClrHotKey ) endif return nil METHOD DeHilite() CLASS TDbMenu local oMenuItem := ::aItems[ ::nOpenPopup ] oMenuItem:Display( ::cClrPopup, ::cClrHotKey ) return nil METHOD Display() CLASS TDbMenu local n SetColor( ::cClrPopup ) if ! ::lPopup DispOutAt( 0, 0, Space( MaxCol() + 1 ), ::cClrPopup ) SetPos( 0, 0 ) else ::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 2 ) @ ::nTop, ::nLeft, ::nBottom, ::nRight BOX B_SINGLE hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight ) endif for n = 1 to Len( ::aItems ) if ::aItems[ n ]:cPrompt == "-" // Separator DispOutAt( ::aItems[ n ]:nRow, ::nLeft,; Chr( 195 ) + Replicate( Chr( 196 ), ::nRight - ::nLeft - 1 ) + Chr( 180 ) ) else ::aItems[ n ]:Display( ::cClrPopup, ::cClrHotKey ) endif next return nil METHOD EvalAction() CLASS TDbMenu local oPopup, oMenuItem oPopup = ::aItems[ ::nOpenPopup ]:bAction oMenuItem = oPopup:aItems[ oPopup:nOpenPopup ] if oMenuItem:bAction != nil ::Close() Eval( oMenuItem:bAction, oMenuItem ) endif return nil METHOD GetHotKeyPos( cKey ) CLASS TDbMenu local n for n = 1 to Len( ::aItems ) if Upper( SubStr( ::aItems[ n ]:cPrompt,; At( "~", ::aItems[ n ]:cPrompt ) + 1, 1 ) ) == cKey return n endif next return 0 METHOD GetItemOrdByCoors( nRow, nCol ) CLASS TDbMenu local n for n = 1 to Len( ::aItems ) if ::aItems[ n ]:nRow == nRow .and. nCol >= ::aItems[ n ]:nCol .and. ; nCol <= ::aItems[ n ]:nCol + Len( ::aItems[ n ]:cPrompt ) - 2 return n endif next return 0 METHOD GoBottom() CLASS TDbMenu local oPopup if ::IsOpen() oPopup = ::aItems[ ::nOpenPopup ]:bAction oPopup:DeHilite() oPopup:ShowPopup( Len( oPopup:aItems ) ) endif return nil METHOD GoLeft() CLASS TDbMenu local oMenuItem := ::aItems[ ::nOpenPopup ] if ::nOpenPopup != 0 if ! ::lPopup ::ClosePopup( ::nOpenPopup ) else oMenuItem:Display( ::cClrPopup, ::CClrHotKey ) endif if ::nOpenPopup > 1 --::nOpenPopup while ::nOpenPopup > 1 .and. ; SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-" --::nOpenPopup end ::ShowPopup( ::nOpenPopup ) else ::ShowPopup( ::nOpenPopup := Len( ::aItems ) ) endif endif return nil METHOD GoRight() CLASS TDbMenu local oMenuItem := ::aItems[ ::nOpenPopup ] if ::nOpenPopup != 0 if ! ::lPopup ::ClosePopup( ::nOpenPopup ) else oMenuItem:Display( ::cClrPopup, ::cClrHotKey ) endif if ::nOpenPopup < Len( ::aItems ) ++::nOpenPopup while ::nOpenPopup < Len( ::aItems ) .and. ; SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-" ++::nOpenPopup end ::ShowPopup( ::nOpenPopup ) else ::ShowPopup( ::nOpenPopup := 1 ) endif endif return nil METHOD GoTop() CLASS TDbMenu local oPopup if ::IsOpen() oPopup = ::aItems[ ::nOpenPopup ]:bAction oPopup:DeHilite() oPopup:ShowPopup( 1 ) endif return nil METHOD ShowPopup( nPopup ) CLASS TDbMenu ::aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus ) ::nOpenPopup = nPopup if ValType( ::aItems[ nPopup ]:bAction ) == "O" ::aItems[ nPopup ]:bAction:Display() ::aItems[ nPopup ]:bAction:ShowPopup( 1 ) endif return nil METHOD ProcessKey( nKey ) CLASS TDbMenu local nPopup do case case nKey == K_LBUTTONDOWN if MRow() == 0 if ( nPopup := ::GetItemOrdByCoors( 0, MCol() ) ) != 0 if nPopup != ::nOpenPopup ::ClosePopup( ::nOpenPopup ) ::ShowPopup( nPopup ) endif endif endif case nKey == K_ESC ::Close() case nKey == K_LEFT ::GoLeft() case nKey == K_RIGHT ::GoRight() case nKey == K_DOWN ::GoDown() case nKey == K_UP ::GoUp() case nKey == K_ENTER ::EvalAction() case nKey == K_HOME ::GoTop() case nKey == K_END ::GoBottom() otherwise if ( nPopup := ::GetHotKeyPos( AltToKey( nKey ) ) ) != 0 if nPopup != ::nOpenPopup ::Close() ::ShowPopup( nPopup ) endif endif endcase return nil CLASS TDbMenuItem DATA nRow, nCol DATA cPrompt DATA bAction METHOD New( cPrompt, bAction ) METHOD Display( cClrText, cClrHotKey ) ENDCLASS METHOD New( cPrompt, bAction ) CLASS TDbMenuItem ::cPrompt = cPrompt ::bAction = bAction return Self METHOD Display( cClrText, cClrHotKey ) CLASS TDbMenuItem local nAt DispOutAt( ::nRow, ::nCol ,; StrTran( ::cPrompt, "~", "" ), cClrText ) DispOutAt( ::nRow, ::nCol + ; ( nAt := At( "~", ::cPrompt ) ) - 1,; SubStr( ::cPrompt, nAt + 1, 1 ), cClrHotKey ) return nil static function AltToKey( nKey ) local nIndex := AScan( { K_ALT_A, K_ALT_B, K_ALT_C, K_ALT_D, K_ALT_E, K_ALT_F,; K_ALT_G, K_ALT_H, K_ALT_I, K_ALT_J, K_ALT_K, K_ALT_L,; K_ALT_M, K_ALT_N, K_ALT_O, K_ALT_P, K_ALT_Q, K_ALT_R,; K_ALT_S, K_ALT_T, K_ALT_U, K_ALT_V, K_ALT_W, K_ALT_X,; K_ALT_Y, K_ALT_Z }, nKey ) local cKey if nIndex > 0 cKey := SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ", nIndex, 1 ) else cKey = "" endif return cKey static function ValToStr( uVal ) local cType := ValType( uVal ) local cResult := "U" do case case uVal == nil cResult = "NIL" case cType == "A" cResult = "{ ... }" case cType == "C" cResult = '"' + uVal + '"' case cType == "L" cResult = If( 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