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

2014-08-01 02:04 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)

Browse Source 
* extras/gtwvw/gtwvwd.c
    ! fixed typo in WVW_SETICON() - thanks to Ash

  * src/rdd/dbcmd53.c
    ! typo in comment

  * src/rtl/dateshb.c
    % use hb_retclen() instead of hb_retc() when size is well known.

  * src/rtl/valtoexp.prg
    % use hb_defaultValue()

  * src/vm/estack.c
    * minor cleanup

  * src/vm/fm.c
    * modified a little bit HB_MEMINFO structure to force strict alignment
    + added debug code covered by HB_FM_FORCE_REALLOC macro which forces
      allocateing new block in each hb_xrealloc() call
    ! protect realloc() in HB_FM_STATISTIC by mutex, it fixes issue #77.

  * src/rtl/hbproces.c
    % unlock HVM waiting for process in OS2 builds
    ! build array of argument passed to process in hb_processRun() in
      parent process not forked one. It fixes possible deadlock in forked
      process because memory is allocated to create arguments array and
      in MT program memory managers may use mutexes internally which can
      be cloned to forked process in locked state.
      It fixes seldom and random HBMK2 freezing during compilation
      with -jobs=<n> parameter.

  * utils/hbmk2/hbmk2.prg
    ! fixed race condition in concurrent C compiler execution (-jobs=<n>)
      with script file

  * src/debug/dbgentry.c
    ! fixed crash when wrong expression is used as tracepoint
    ! fixed expression analyzer to correctly recognized extended strings e"..."
    * formatting

  * src/debug/dbgbrwsr.prg
  * src/debug/dbghelp.prg
  * src/debug/dbgtarr.prg
  * src/debug/dbgthsh.prg
  * src/debug/dbgtinp.prg
  * src/debug/dbgtmenu.prg
  * src/debug/dbgtobj.prg
  * src/debug/dbgtwin.prg
  * src/debug/dbgwa.prg
  * src/debug/debugger.prg
    * added calls to ::NotSupported() method for some still missing
      functionality
    ! do not use SetColor() but directly pass colors to used objects
      and functions
    ! do not use SetPos() and Row()/Col() for core functionality - it was
      source of few minor bugs
    % enable cursor only in input objects and disable it just after
    % eliminated code to save and restore cursor position and shape
    ! fixed initial positioning in help window
    + implemented HiLite() and DeHiLite() methods in HBDbBrowser() class
    ! fixed positioning when end of source data is reached in browser
    % eliminated some redundant or completely useless code and comments
    % use some fully functional HBDbBrowser() features instead of manual
      encoding similar functionality
    ! validate watchpoint and tracepoint expressions
    % use SWITCH statements
    ! fixed expression presentation (added __dbgValToExp() and __dbgValToStr())
    ! fixed input for new expressions
    ! fixed browser scrolling in object inspector
    ! fixed inkey() processing inside debugger (ALT+D and ALT+C)
    ! fixed browsers highliting in WA inspector
    ! fixed hardcoded limit for 512 workareas in WA inspector
    ! fixed initial WA positioning in WA inspector
    * resized WA  inspector window
    * many other minor fixes and improvements
This commit is contained in:
Przemysław Czerpak
2014-08-01 02:04:07 +02:00
parent 6529610475
commit 3f78fa0b6e
20 changed files with 629 additions and 742 deletions
Download Patch File Download Diff File Expand all files Collapse all files

398
src/debug/debugger.prg
View File

@@ -52,17 +52,6 @@
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://harbour-project.org
*
* Copyright 2007 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* __dbgCStr()
*
* See COPYING.txt for licensing terms.
*
*/
/* 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. [vszakats] */
@@ -391,12 +380,7 @@ METHOD New() CLASS HBDebugger
::oPullDown := __dbgBuildMenu( Self )
::oWndCode := HBDbWindow():New( 1, 0, ::nMaxRow - 6, ::nMaxCol )
::oWndCode:Cargo := { ::oWndCode:nTop, ::oWndCode:nLeft }
::oWndCode:bKeyPressed := {| nKey | ::CodeWindowProcessKey( nKey ) }
::oWndCode:bGotFocus := {|| ::oGetCommand:SetFocus() }
::oWndCode:bLostFocus := {|| ::oGetCommand:KillFocus(), SetCursor( SC_NONE ), ;
::oWndCode:Cargo[ 1 ] := Row(), ;
::oWndCode:Cargo[ 2 ] := Col() }
AAdd( ::aWindows, ::oWndCode )
@@ -492,10 +476,7 @@ METHOD BarDisplay() CLASS HBDebugger
DispBegin()
SetColor( cClrItem )
hb_Scroll( ::nMaxRow, 0, ::nMaxRow, ::nMaxCol )
hb_Scroll( ::nMaxRow, 0, ::nMaxRow, ::nMaxCol,,, cClrItem )
hb_DispOutAt( ::nMaxRow, 0, "F1-Help F2-Zoom F3-Repeat F4-User F5-Go F6-WA F7-Here F8-Step F9-BkPt F10-Trace", cClrItem )
hb_DispOutAt( ::nMaxRow, 0, "F1", cClrHotKey )
hb_DispOutAt( ::nMaxRow, 8, "F2", cClrHotKey )
@@ -543,8 +524,6 @@ METHOD BuildCommandWindow() CLASS HBDebugger
::oWndCommand := HBDbWindow():New( ::nMaxRow - 5, 0, ::nMaxRow - 1, ::nMaxCol, "Command" )
::oWndCommand:bGotFocus := {|| ::oGetCommand:SetFocus() }
::oWndCommand:bLostFocus := {|| ::oGetCommand:KillFocus(), SetCursor( SC_NONE ) }
::oWndCommand:bKeyPressed := {| nKey | ::CommandWindowProcessKey( nKey ) }
::oWndCommand:bPainted := {|| ::CommandWindowDisplay(), ;
hb_DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, ;
@@ -558,7 +537,7 @@ METHOD BuildCommandWindow() CLASS HBDebugger
nSize := ::oWndCommand:nRight - ::oWndCommand:nLeft - 3
::oGetCommand := HbDbInput():new( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 3, ;
nSize, "", __dbgColors()[ 2 ], Max( nSize, 256 ) )
nSize, "", __dbgColors()[ 2 ], Max( nSize, 256 ) )
RETURN NIL
@@ -684,9 +663,6 @@ METHOD CodeWindowProcessKey( nKey ) CLASS HBDebugger
CASE K_CTRL_HOME
::oBrwText:GoTop()
IF ::oWndCode:lFocused
SetCursor( SC_SPECIAL1 )
ENDIF
EXIT
CASE K_CTRL_PGDN
@@ -695,10 +671,6 @@ METHOD CodeWindowProcessKey( nKey ) CLASS HBDebugger
::oBrwText:GoBottom()
::oBrwText:nCol := ::oWndCode:nLeft + 1
::oBrwText:nFirstCol := ::oWndCode:nLeft + 1
SetPos( Row(), ::oWndCode:nLeft + 1 )
IF ::oWndCode:lFocused
SetCursor( SC_SPECIAL1 )
ENDIF
EXIT
CASE K_HOME
@@ -780,6 +752,7 @@ METHOD Colors() CLASS HBDebugger
oWndColors:bKeyPressed := {| nKey | SetsKeyPressed( nKey, oBrwColors, ;
Len( aColors ), oWndColors, "Debugger Colors", ;
{|| ::EditColor( oBrwColors:Cargo[ 1 ], oBrwColors ) } ) }
oWndColors:ShowModal()
::LoadColors()
@@ -912,10 +885,8 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
::Inspect( aCmnd[ WP_EXPR ], cResult )
ENDIF
cResult := "" // discard result
ELSE
IF lValid
cResult := __dbgValToStr( cResult )
ENDIF
ELSEIF lValid
cResult := __dbgValToStr( cResult )
ENDIF
::RefreshVars()
@@ -923,7 +894,6 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
IF ::lActive
::lAnimate := .T.
::Animate()
SetCursor( SC_NORMAL )
ENDIF
CASE cCommand == "BP"
@@ -962,7 +932,6 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
CASE cCommand == "DOS"
::OsShell()
SetCursor( SC_NORMAL )
CASE starts( "FILE", cCommand )
cParam := Upper( cParam )
@@ -1139,9 +1108,7 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
ENDCASE
CASE starts( "OUTPUT", cCommand, 4 )
SetCursor( SC_NONE )
::ShowAppScreen()
SetCursor( SC_NORMAL )
CASE starts( "POINT", cCommand )
cParam := Upper( cParam )
@@ -1267,8 +1234,9 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger
::lWindowsAutoSized := .F.
ENDIF
ENDIF
CASE starts( "ZOOM", cParam ) .OR. starts( "ICONIZE", cParam) ;
.OR. starts( "TILE", cParam )
CASE starts( "ZOOM", cParam ) .OR. ;
starts( "ICONIZE", cParam) .OR. ;
starts( "TILE", cParam )
::NotSupported()
OTHERWISE
cResult := "Command error"
@@ -1307,7 +1275,8 @@ METHOD DoScript( cFileName ) CLASS HBDebugger
nLen := MLCount( cInfo, 16384, NIL, .F., .T. )
FOR n := 1 TO nLen
cLine := AllTrim( MemoLine( cInfo, 16384, n, NIL, .F., .T. ) )
IF ::lActive .OR. ( ( nPos := At( " ", cLine ) ) > 0 .AND. starts( "OPTIONS", Upper( Left( cLine, nPos - 1 ) ) ) )
IF ::lActive .OR. ( ( nPos := At( " ", cLine ) ) > 0 .AND. ;
starts( "OPTIONS", Upper( Left( cLine, nPos - 1 ) ) ) )
// In inactive debugger, only "OPTIONS" commands can be executed safely
::DoCommand( cLine )
ENDIF
@@ -1320,7 +1289,7 @@ METHOD DoScript( cFileName ) CLASS HBDebugger
METHOD EditColor( nColor, oBrwColors ) CLASS HBDebugger
LOCAL cColor := PadR( '"' + ::aColors[ nColor ] + '"', ;
oBrwColors:getColumn( 2 ):Width )
oBrwColors:getColumn( 2 ):Width )
oBrwColors:RefreshCurrent()
oBrwColors:ForceStable()
@@ -1339,16 +1308,16 @@ METHOD EditColor( nColor, oBrwColors ) CLASS HBDebugger
METHOD EditSet( nSet, oBrwSets ) CLASS HBDebugger
LOCAL cSet := PadR( __dbgValToStr( Set( nSet ) ), oBrwSets:getColumn( 2 ):Width )
LOCAL cType := ValType( Set( nSet ) )
LOCAL cSet := __dbgValToExp( Set( nSet ) )
LOCAL cType := ValType( Set( nSet ) )
oBrwSets:RefreshCurrent()
oBrwSets:ForceStable()
IF __dbgInput( Row(), Col() + 13,, @cSet, ;
{| cSet | iif( !( Type( cSet ) == cType ), ;
( __dbgAlert( "Must be of type '" + cType + "'" ), .F. ), .T. ) }, ;
SubStr( ::ClrModal(), 5 ) )
IF __dbgInput( Row(), Col() + 13, oBrwSets:getColumn( 2 ):Width, @cSet, ;
{| cSet | Type( cSet ) == cType .OR. ;
( __dbgAlert( "Must be of type '" + cType + "'" ), .F. ) }, ;
SubStr( ::ClrModal(), 5 ), 256 )
Set( nSet, &cSet )
ENDIF
@@ -1367,34 +1336,18 @@ METHOD EditVar( nVar ) CLASS HBDebugger
uVarValue := ::VarGetValue( ::aVars[ nVar ] )
IF ValType( uVarValue ) $ "AHOP"
::InputBox( cVarName, uVarValue, NIL, .F. )
IF ValType( uVarValue ) $ "AHOPB"
::InputBox( cVarName, uVarValue,, .F. )
ELSE
cVarStr := ::InputBox( cVarName, __dbgValToStr( uVarValue ), ;
{| u | iif( Type( u ) == "UE", ( __dbgAlert( "Expression error" ), .F. ), .T. ) } )
ENDIF
cVarStr := ::InputBox( cVarName, __dbgValToExp( uVarValue ), __dbgExprValidBlock() )
IF LastKey() != K_ESC
DO CASE
CASE cVarStr == "{ ... }"
// aArray := ::VarGetValue( ::aVars[ nVar ] )
IF Len( uVarValue ) > 0
__dbgArrays( uVarValue, cVarName )
ELSE
__dbgAlert( "Array is empty" )
ENDIF
CASE Upper( Left( cVarStr, 5 ) ) == "CLASS"
__dbgObject( uVarValue, cVarName )
OTHERWISE
IF LastKey() != K_ESC
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
::VarSetValue( ::aVars[ nVar ], &cVarStr )
RECOVER USING oErr
__dbgAlert( oErr:description )
END SEQUENCE
ENDCASE
ENDIF
ENDIF
::oBrwVars:RefreshCurrent()
@@ -1427,7 +1380,8 @@ METHOD GetExprValue( xExpr, lValid ) CLASS HBDebugger
xResult := oErr:operation + ": " + oErr:description
IF HB_ISARRAY( oErr:args )
xResult += "; arguments:"
AEval( oErr:args, {| x | xResult += " " + AllTrim( __dbgCStr( x ) ) } )
AEval( oErr:args, {| x, i | xResult += iif( i == 1, " ", ", " ) + ;
AllTrim( __dbgValToStr( x ) ) } )
ENDIF
lValid := .F.
END SEQUENCE
@@ -1468,41 +1422,7 @@ METHOD Go() CLASS HBDebugger
METHOD GotoLine( nLine ) CLASS HBDebugger
LOCAL nRow
LOCAL nCol
/*
IF ::oBrwVars != NIL
::ShowVars()
ENDIF
*/
::oBrwText:GotoLine( nLine )
nRow := Row()
nCol := Col()
// no source code line stored yet
/*
IF ::oBrwStack != NIL .AND. Len( ::aCallStack ) > 0 .AND. ;
::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] == NIL
::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] := nLine
ENDIF
*/
IF ::oWndStack != NIL .AND. ! ::oBrwStack:Stable
::oBrwStack:ForceStable()
ENDIF
IF ::oWndCode:lFocused .AND. SetCursor() != SC_SPECIAL1
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
@@ -1531,7 +1451,17 @@ METHOD HandleEvent() CLASS HBDebugger
DO WHILE ! ::lEnd
nKey := Inkey( 0, INKEY_ALL )
IF ::oWndCommand:lFocused
::oGetCommand:showCursor()
ELSEIF ::oWndCode:lFocused .AND. ::oBrwText != NIL
::oBrwText:ForceStable()
SetCursor( SC_SPECIAL1 )
ELSE
SetCursor( SC_NONE )
ENDIF
nKey := __dbgInkey()
SetCursor( SC_NONE )
IF nKey == K_ALT_X
t_oDebugger:Quit()
ELSEIF ::oPullDown:IsOpen()
@@ -1566,12 +1496,6 @@ METHOD HandleEvent() CLASS HBDebugger
IF MRow() == 0
IF ( nPopup := ::oPullDown:GetItemOrdByCoors( 0, MCol() ) ) != 0
IF ! ::oPullDown:IsOpen()
IF ::oWndCode:lFocused
Eval( ::oWndCode:bLostFocus )
ENDIF
SetCursor( SC_NONE )
ENDIF
::oPullDown:ShowPopup( nPopup )
ENDIF
@@ -1627,10 +1551,21 @@ METHOD HandleEvent() CLASS HBDebugger
::aWindows[ ::nCurrentWindow ]:KeyPressed( nKey )
EXIT
CASE K_ALT_G /* Grow active window */
CASE K_ALT_S /* Shrink active window */
CASE K_ALT_U /* Move the border between Command and Code windows Up */
CASE K_ALT_D /* Move the border between Command and Code windows Down */
::NotSupported()
EXIT
CASE K_F1
::ShowHelp()
EXIT
CASE K_F2
::NotSupported()
EXIT
CASE K_F4
::ShowAppScreen()
EXIT
@@ -1681,6 +1616,7 @@ METHOD HandleEvent() CLASS HBDebugger
RETURN NIL
METHOD Hide() CLASS HBDebugger
::CloseDebuggerWindow()
@@ -1734,10 +1670,6 @@ METHOD HideVars() CLASS HBDebugger
IF ::oBrwText != NIL
::oBrwText:Resize( ::oWndCode:nTop + 1 )
ENDIF
IF ::oWndCode:lFocused
::oWndCode:cargo[ 1 ] := Row()
::oWndCode:cargo[ 2 ] := Col()
ENDIF
IF ::aWindows[ ::nCurrentWindow ] == ::oWndVars
::NextWindow()
@@ -1755,31 +1687,23 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger
LOCAL cType := ValType( uValue )
LOCAL nWidth := nRight - nLeft - 1
LOCAL uTemp
LOCAL nOldCursor
LOCAL nOldRow
LOCAL nOldCol
LOCAL lExit
LOCAL oWndInput := HBDbWindow():New( nTop, nLeft, nBottom, nRight, cMsg, ;
::oPullDown:cClrPopup )
hb_default( @lEditable, .T. )
LOCAL oWndInput
oWndInput := HBDbWindow():New( nTop, nLeft, nBottom, nRight, cMsg, ;
::oPullDown:cClrPopup )
oWndInput:lShadow := .T.
oWndInput:Show()
nOldCursor := SetCursor()
nOldRow := Row()
nOldCol := Col()
uTemp := uValue
IF lEditable
IF hb_defaultValue( lEditable, .T. )
IF !( cType == "C" ) .OR. Len( uValue ) < nWidth
IF ! cType == "C" .OR. Len( uValue ) < nWidth
uTemp := PadR( uValue, nWidth )
ENDIF
__dbgInput( nTop + 1, nLeft + 1, nWidth, @uTemp, bValid, ;
__dbgColors()[ 5 ], Max( Max( nWidth, Len( uTemp ) ), 256 ) )
__dbgColors()[ 5 ], Max( Max( nWidth, Len( uTemp ) ), 256 ) )
SWITCH cType
CASE "C" ; uTemp := AllTrim( uTemp ) ; EXIT
CASE "D" ; uTemp := CToD( uTemp ) ; EXIT
@@ -1788,14 +1712,15 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger
ELSE
hb_DispOutAt( nTop + 1, nLeft + 1, __dbgValToStr( uValue ), "," + __dbgColors()[ 5 ] )
hb_DispOutAt( nTop + 1, nLeft + 1, left( __dbgValToStr( uValue ), nRight - nLeft - 1 ), ;
__dbgColors()[ 2 ] + "," + __dbgColors()[ 5 ] )
SetPos( nTop + 1, nLeft + 1 )
lExit := .F.
DO WHILE ! lExit
SWITCH Inkey( 0, INKEY_ALL )
SWITCH __dbgInkey()
CASE K_ESC
lExit := .T.
EXIT
@@ -1809,21 +1734,18 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger
ELSE
__dbgArrays( uValue, cMsg )
ENDIF
EXIT
LOOP
CASE "H"
IF Len( uValue ) == 0
__dbgAlert( "Hash is empty" )
ELSE
__dbgHashes( uValue, cMsg )
ENDIF
EXIT
LOOP
CASE "O"
__dbgObject( uValue, cMsg )
EXIT
OTHERWISE
__dbgAlert( "Value cannot be edited" )
LOOP
ENDSWITCH
EXIT
OTHERWISE
__dbgAlert( "Value cannot be edited" )
@@ -1833,9 +1755,6 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger
ENDIF
SetCursor( nOldCursor )
SetPos( nOldRow, nOldCol )
oWndInput:Hide()
RETURN uTemp
@@ -1843,7 +1762,7 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger
METHOD Inspect( uValue, cValueName ) CLASS HBDebugger
uValue := ::InputBox( uValue, cValueName,, .F. )
::InputBox( uValue, cValueName,, .F. )
RETURN NIL
@@ -2078,7 +1997,6 @@ METHOD Locate( nMode, cValue ) CLASS HBDebugger
hb_default( @nMode, 0 )
IF Empty( cValue )
::cSearchString := PadR( ::cSearchString, 256 )
cValue := ::InputBox( "Search string", ::cSearchString )
IF Empty( cValue )
RETURN NIL
@@ -2089,10 +2007,6 @@ METHOD Locate( nMode, cValue ) CLASS HBDebugger
lFound := ::oBrwText:Search( ::cSearchString, ::lCaseSensitive, nMode )
// Save cursor position to be restored by ::oWndCode:bGotFocus
::oWndCode:cargo[ 1 ] := Row()
::oWndCode:cargo[ 2 ] := Col()
RETURN lFound
@@ -2170,8 +2084,7 @@ METHOD Open() CLASS HBDebugger
CASE 0
RETURN NIL
CASE 1
cFileName := ::InputBox( "Please enter the filename", Space( 255 ) )
cFileName := AllTrim( cFileName )
cFileName := AllTrim( ::InputBox( "Please enter the filename" ) )
EXIT
OTHERWISE
cFileName := aFiles[ nFileName ]
@@ -2212,10 +2125,6 @@ METHOD OpenMenu( cName ) CLASS HBDebugger
RETURN .F.
ENDIF
IF ::oPullDown:nOpenPopup != nPopup
IF ::oWndCode:lFocused
Eval( ::oWndCode:bLostFocus )
ENDIF
SetCursor( SC_NONE )
::oPullDown:ShowPopup( nPopup )
ENDIF
@@ -2268,7 +2177,7 @@ METHOD OSShell() CLASS HBDebugger
SetColor( "W/N" )
CLS
QOut( "Type 'exit' to RETURN to the Debugger" )
SetCursor( SC_NORMAL )
SetCursor( SC_NORMAL ) // standard cursor for OS shell
BEGIN SEQUENCE WITH {| objErr | Break( objErr ) }
@@ -2279,7 +2188,7 @@ METHOD OSShell() CLASS HBDebugger
#elif defined( __PLATFORM__UNIX )
hb_run( GetEnv( "SHELL" ) )
#else
__dbgAlert( "Not implemented yet!" )
::NotSupported()
#endif
RECOVER USING oE
@@ -2437,10 +2346,6 @@ METHOD ResizeWindows( oWindow ) CLASS HBDebugger
ENDIF
::oWndCode:Resize( nTop )
IF ::oWndCode:lFocused
::oWndCode:cargo[ 1 ] := Row()
::oWndCode:cargo[ 2 ] := Col()
ENDIF
IF oWindow2 != NIL .AND. lVisible2
oWindow2:Show()
@@ -2651,11 +2556,7 @@ METHOD SaveSettings( cFileName ) CLASS HBDebugger
METHOD SearchLine() CLASS HBDebugger
LOCAL cLine := ::InputBox( "Line number", "1" )
IF Val( cLine ) > 0
::GotoLine ( Val( cLine ) )
ENDIF
::GotoLine( Max( 1, ::InputBox( "Line number", 1 ) ) )
RETURN NIL
@@ -2666,7 +2567,7 @@ METHOD Show() CLASS HBDebugger
::oPullDown:Display()
::oWndCode:Show( .T. )
::oWndCommand:Show()
hb_DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, ">" )
hb_DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, ">", __dbgColors()[ 2 ] )
::BarDisplay()
@@ -2686,9 +2587,9 @@ METHOD ShowAppScreen() CLASS HBDebugger
::CloseDebuggerWindow()
IF LastKey() == K_LBUTTONDOWN
Inkey( 0, INKEY_ALL )
__dbgInkey()
ENDIF
DO WHILE Inkey( 0, INKEY_ALL ) == K_MOUSEMOVE
DO WHILE __dbgInkey() == K_MOUSEMOVE
ENDDO
::OpenDebuggerWindow()
@@ -2702,8 +2603,6 @@ METHOD ShowCallStack() CLASS HBDebugger
IF ::oWndStack == NIL
SetCursor( SC_NONE )
DispBegin()
// Resize code window
::oWndCode:Resize( ,,, ::oWndCode:nRight - 16 )
@@ -2739,7 +2638,6 @@ METHOD ShowCallStack() CLASS HBDebugger
::oWndStack:bPainted := {|| ::oBrwStack:ColorSpec := __dbgColors()[ 2 ] + "," + ;
__dbgColors()[ 5 ] + "," + __dbgColors()[ 4 ] + "," + __dbgColors()[ 6 ], ;
::oBrwStack:RefreshAll(), ::oBrwStack:ForceStable() }
::oWndStack:bGotFocus := {|| SetCursor( SC_NONE ) }
::oWndStack:Show( .F. )
ENDIF
@@ -2825,10 +2723,7 @@ METHOD ShowCodeLine( nProc ) CLASS HBDebugger
METHOD ShowHelp( nTopic ) CLASS HBDebugger
LOCAL nCursor := SetCursor( SC_NONE )
__dbgHelp( nTopic )
SetCursor( nCursor )
RETURN NIL
@@ -3062,7 +2957,7 @@ METHOD DeleteBreakPoint( cPos ) CLASS HBDebugger
LOCAL nAt
IF Empty( cPos )
cPos := AllTrim( ::InputBox( "Item number to delete", 0 ) )
cPos := AllTrim( ::InputBox( "Item number to delete", "0" ) )
IF LastKey() == K_ESC
cPos := ""
ENDIF
@@ -3111,8 +3006,7 @@ METHOD TracepointAdd( cExpr ) CLASS HBDebugger
LOCAL aWatch
IF cExpr == NIL
cExpr := Space( 255 )
cExpr := AllTrim( ::InputBox( "Enter Tracepoint", cExpr ) )
cExpr := AllTrim( ::InputBox( "Enter Tracepoint",, __dbgExprValidBlock() ) )
IF LastKey() == K_ESC
RETURN Self
ENDIF
@@ -3134,17 +3028,22 @@ METHOD TracepointAdd( cExpr ) CLASS HBDebugger
METHOD VarGetInfo( aVar ) CLASS HBDebugger
LOCAL uValue := ::VarGetValue( aVar )
LOCAL cType
SWITCH Left( aVar[ VAR_TYPE ], 1 )
CASE "G" ; RETURN aVar[ VAR_NAME ] + " <Global, " + ValType( uValue ) + ">: " + __dbgValToStr( uValue )
CASE "L" ; RETURN aVar[ VAR_NAME ] + " <Local, " + ValType( uValue ) + ">: " + __dbgValToStr( uValue )
CASE "S" ; RETURN aVar[ VAR_NAME ] + " <Static, " + ValType( uValue ) + ">: " + __dbgValToStr( uValue )
OTHERWISE; RETURN aVar[ VAR_NAME ] + " <" + aVar[ VAR_TYPE ] + ", " + ValType( uValue ) + ">: " + __dbgValToStr( uValue )
CASE "G"
cType := "Global"
EXIT
CASE "L"
cType := "Local"
EXIT
CASE "S"
cType := "Static"
EXIT
OTHERWISE
cType := aVar[ VAR_TYPE ]
ENDSWITCH
// Never reached
RETURN ""
RETURN aVar[ VAR_NAME ] + " <" + cType + ", " + ValType( uValue ) + ">: " + __dbgValToStr( uValue )
METHOD VarGetValue( aVar ) CLASS HBDebugger
@@ -3216,7 +3115,7 @@ METHOD ViewSets() CLASS HBDebugger
AAdd( oBrwSets:Cargo[ 2 ], aSets )
ocol:defcolor := { 1, 2 }
oBrwSets:AddColumn( oCol := HBDbColumnNew( "", ;
{|| PadR( __dbgValToStr( Set( oBrwSets:cargo[ 1 ] ) ), nWidth - 13 ) } ) )
{|| PadR( __dbgValToExp( Set( oBrwSets:cargo[ 1 ] ) ), nWidth - 13 ) } ) )
ocol:defcolor := { 1, 3 }
ocol:width := 40
oWndSets:bPainted := {|| oBrwSets:ForceStable(), RefreshVarsS( oBrwSets ) }
@@ -3224,7 +3123,6 @@ METHOD ViewSets() CLASS HBDebugger
oWndSets, "System Settings", ;
{|| ::EditSet( oBrwSets:Cargo[ 1 ], oBrwSets ) } ) }
SetCursor( SC_NONE )
oWndSets:ShowModal()
RETURN NIL
@@ -3245,9 +3143,8 @@ METHOD WatchGetInfo( nWatch ) CLASS HBDebugger
cType := ValType( xVal )
xVal := __dbgValToStr( xVal )
ELSE
// xVal contains error description
cType := "U"
// xVal := "Undefined"
xVal := "Undefined"
ENDIF
RETURN aWatch[ WP_EXPR ] + " <" + aWatch[ WP_TYPE ] + ", " + cType + ">: " + xVal
@@ -3258,10 +3155,7 @@ METHOD WatchpointAdd( cExpr ) CLASS HBDebugger
LOCAL aWatch
IF cExpr == NIL
cExpr := Space( 255 )
cExpr := AllTrim( ::InputBox( "Enter Watchpoint", cExpr ) )
cExpr := ::InputBox( "Enter Watchpoint",, __dbgExprValidBlock() )
IF LastKey() == K_ESC
RETURN Self
ENDIF
@@ -3287,19 +3181,20 @@ METHOD WatchpointDel( nPos ) CLASS HBDebugger
IF nPos == NIL
// called from the menu
nPos := ::InputBox( "Enter item number to delete", ::oBrwPnt:cargo[ 1 ] - 1 )
IF LastKey() == K_ESC
nPos := -1
ENDIF
ELSE
nPos--
ENDIF
IF LastKey() != K_ESC
IF nPos >= 0 .AND. nPos < Len( ::aWatch )
::oBrwPnt:gotop()
__dbgDelWatch( ::pInfo, nPos )
hb_ADel( ::aWatch, nPos + 1, .T. )
IF Len( ::aWatch ) == 0
::WatchpointsHide()
ELSE
::WatchpointsShow()
ENDIF
IF nPos >= 0 .AND. nPos < Len( ::aWatch )
::oBrwPnt:gotop()
__dbgDelWatch( ::pInfo, nPos )
hb_ADel( ::aWatch, nPos + 1, .T. )
IF Len( ::aWatch ) == 0
::WatchpointsHide()
ELSE
::WatchpointsShow()
ENDIF
ENDIF
ENDIF
@@ -3312,9 +3207,7 @@ METHOD WatchpointEdit( nPos ) CLASS HBDebugger
LOCAL cExpr
LOCAL aWatch
cExpr := PadR( ::aWatch[ nPos ][ WP_EXPR ], 255 )
cExpr := AllTrim( ::InputBox( "Enter Watchpoint", cExpr ) )
cExpr := ::InputBox( "Enter Watchpoint", ::aWatch[ nPos ][ WP_EXPR ], __dbgExprValidBlock() )
IF LastKey() == K_ESC
RETURN Self
ENDIF
@@ -3416,10 +3309,9 @@ METHOD WatchpointsShow() CLASS HBDebugger
oCol := HBDbColumnNew( "", ;
{|| PadR( iif( Len( ::aWatch ) > 0, ;
hb_ntos( ::oBrwPnt:Cargo[ 1 ] - 1 ) + ") " + ;
::WatchGetInfo( Max( ::oBrwPnt:Cargo[ 1 ], 1 ) ), ;
" " ), ;
::oWndPnt:nWidth() - 2 ) } )
hb_ntos( ::oBrwPnt:Cargo[ 1 ] - 1 ) + ") " + ;
::WatchGetInfo( Max( ::oBrwPnt:Cargo[ 1 ], 1 ) ), ;
" " ), ::oWndPnt:nWidth() - 2 ) } )
::oBrwPnt:AddColumn( oCol )
AAdd( ::oBrwPnt:Cargo[ 2 ], ::aWatch )
oCol:DefColor := { 1, 2 }
@@ -3611,9 +3503,12 @@ STATIC FUNCTION starts( cLine, cStart, nMin )
( nMin == NIL .OR. Len( cStart ) >= nMin )
FUNCTION __dbgExprValidBlock()
RETURN {| u | ! Type( u ) == "UE" .OR. ( __dbgAlert( "Expression error" ), .F. ) }
FUNCTION __dbgInput( nRow, nCol, nWidth, cValue, bValid, cColor, nSize )
LOCAL nOldCursor := SetCursor( SC_NORMAL )
LOCAL lOK := .F.
LOCAL nKey
LOCAL oGet
@@ -3622,10 +3517,12 @@ FUNCTION __dbgInput( nRow, nCol, nWidth, cValue, bValid, cColor, nSize )
nWidth := Len( cValue )
ENDIF
oGet := HbDbInput():new( nRow, nCol, nWidth, cValue, cColor, nSize )
oGet:setFocus()
oGet:display()
DO WHILE .T.
nKey := Inkey( 0, INKEY_ALL )
oGet:showCursor()
nKey := __dbgInkey()
DO CASE
CASE nKey == K_ESC
EXIT
@@ -3640,7 +3537,7 @@ FUNCTION __dbgInput( nRow, nCol, nWidth, cValue, bValid, cColor, nSize )
ENDCASE
ENDDO
SetCursor( nOldCursor )
SetCursor( SC_NONE )
RETURN lOK
@@ -3653,7 +3550,7 @@ FUNCTION __dbgAChoice( nTop, nLeft, nBottom, nRight, aItems, cColors )
LOCAL nLen
oBrw := HBDbBrowser():New( nTop, nLeft, nBottom, nRight )
oBrw:colorSpec := iif( HB_ISSTRING( cColors ), cColors, SetColor() )
oBrw:colorSpec := cColors
nLen := nRight - nLeft + 1
nRow := 1
oCol := HBDbColumnNew( "", {|| PadR( aItems[ nRow ], nLen ) } )
@@ -3665,7 +3562,7 @@ FUNCTION __dbgAChoice( nTop, nLeft, nBottom, nRight, aItems, cColors )
nRow += n, n }
DO WHILE .T.
oBrw:forceStable()
SWITCH Inkey( 0, INKEY_ALL )
SWITCH __dbgInkey()
CASE K_UP; oBrw:up(); EXIT
CASE K_DOWN; oBrw:down(); EXIT
CASE K_PGUP; oBrw:pageUp(); EXIT
@@ -3684,20 +3581,43 @@ FUNCTION __dbgAlert( cMessage )
RETURN hb_gtAlert( cMessage, { "Ok" }, "W+/R", "W+/B" )
FUNCTION __dbgInkey()
LOCAL nKey
LOCAL lDebug, lCancel
lDebug := Set( _SET_DEBUG, .F. )
lCancel := Set( _SET_CANCEL, .F. )
nKey := Inkey( 0, INKEY_ALL )
Set( _SET_CANCEL, lCancel )
Set( _SET_DEBUG, lDebug )
RETURN nKey
FUNCTION __dbgValToStr( uVal )
SWITCH ValType( uVal )
CASE "B" ; RETURN "{|| ... }"
CASE "A" ; RETURN "{ ... }"
#ifdef HB_CLP_STRICT
CASE "C"
CASE "M" ; RETURN '"' + uVal + '"'
CASE "L" ; RETURN iif( uVal, ".T.", ".F." )
CASE "D" ; RETURN DToC( uVal )
CASE "T" ; RETURN hb_TToC( uVal )
CASE "N" ; RETURN Str( uVal )
CASE "O" ; RETURN "{ ... }"
#else
CASE "C"
CASE "M" ; RETURN hb_StrToExp( uVal )
CASE "D" ; RETURN Left( hb_TSToStr( uVal, .F. ), 10 )
CASE "T" ; RETURN hb_TSToStr( uVal, .T. )
CASE "O" ; RETURN "Class " + uVal:ClassName() + " object"
CASE "H" ; RETURN "Hash of " + hb_ntos( Len( uVal ) ) + " elements"
CASE "P" ; RETURN "Pointer"
#endif
CASE "N" ; RETURN Str( uVal )
CASE "L" ; RETURN iif( uVal, ".T.", ".F." )
CASE "S" ; RETURN "@" + uVal:name + "()"
CASE "B" ; RETURN "{|| ... }"
CASE "A" ; RETURN "{ ... }"
CASE "H" ; RETURN "{ => }"
CASE "P" ; RETURN "<pointer>"
OTHERWISE
IF uVal == NIL
RETURN "NIL"
@@ -3707,29 +3627,33 @@ FUNCTION __dbgValToStr( uVal )
RETURN "U"
/* NOTE: This is a copy of hb_CStr() */
FUNCTION __dbgValToExp( uVal )
FUNCTION __dbgCStr( xVal )
LOCAL v := ValType( xVal )
SWITCH v
SWITCH ValType( uVal )
#ifdef HB_CLP_STRICT
CASE "C"
CASE "M" ; RETURN xVal
CASE "N" ; RETURN Str( xVal )
CASE "D" ; RETURN iif( Empty( xVal ), "0d00000000", "0d" + DToS( xVal ) )
CASE "T" ; RETURN 't"' + hb_TSToStr( xVal, .T. ) + '"'
CASE "L" ; RETURN iif( xVal, ".T.", ".F." )
CASE "S" ; RETURN "@" + xVal:name + "()"
CASE "M" ; RETURN '"' + uVal + '"'
CASE "D" ; RETURN 'CTOD("' + DToC( uVal ) + '")'
CASE "T" ; RETURN 'HB_CTOT("' + hb_TToC( uVal ) + '")'
CASE "O" ; RETURN "Object"
#else
CASE "C"
CASE "M" ; RETURN hb_StrToExp( uVal )
CASE "D" ; RETURN 'd"' + Left( hb_TSToStr( uVal, .F. ), 10 ) + '"'
CASE "T" ; RETURN 't"' + hb_TSToStr( uVal, .T. ) + '"'
CASE "O" ; RETURN "{ " + uVal:className() + " Object }"
#endif
CASE "N" ; RETURN hb_ntos( uVal )
CASE "L" ; RETURN iif( uVal, ".T.", ".F." )
CASE "S" ; RETURN "@" + uVal:name + "()"
CASE "B" ; RETURN "{|| ... }"
CASE "O" ; RETURN "{ " + xVal:className() + " Object }"
CASE "A" ; RETURN "{ Array of " + hb_ntos( Len( xVal ) ) + " Items }"
CASE "H" ; RETURN "{ Hash of " + hb_ntos( Len( xVal ) ) + " Items }"
CASE "A" ; RETURN "{ ... }"
CASE "H" ; RETURN "{ => }"
CASE "P" ; RETURN "<pointer>"
OTHERWISE
IF xVal == NIL
IF uVal == NIL
RETURN "NIL"
ENDIF
ENDSWITCH
RETURN "???:" + v
RETURN "U"