From 4399328f04a8eb1b3fc2708cc072cd55c4310202 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Wed, 23 Apr 2008 00:14:58 +0000 Subject: [PATCH] 2008-04-23 02:14 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/debug/dbgbrwsr.prg * respect oCol:colorBlock() used by debugger code in few places * harbour/source/debug/dbgtobj.prg * sort messages and show methods in lower letters just like Clipper * harbour/source/debug/dbgtobj.prg * harbour/source/debug/dbgthsh.prg * harbour/source/debug/dbgtarr.prg ! added protection against RT error when user type wrong expression in OBJECT, ARRAY and HASH inspectors --- harbour/ChangeLog | 13 +++++++++++++ harbour/source/debug/dbgbrwsr.prg | 16 ++++++++++------ harbour/source/debug/dbgtarr.prg | 7 ++++++- harbour/source/debug/dbgthsh.prg | 7 ++++++- harbour/source/debug/dbgtobj.prg | 29 ++++++++++++++++++----------- 5 files changed, 53 insertions(+), 19 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 3f14f6700c..374ea2c0cf 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,19 @@ 2008-12-31 13:59 UTC+0100 Foo Bar */ +2008-04-23 02:14 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/source/debug/dbgbrwsr.prg + * respect oCol:colorBlock() used by debugger code in few places + + * harbour/source/debug/dbgtobj.prg + * sort messages and show methods in lower letters just like Clipper + + * harbour/source/debug/dbgtobj.prg + * harbour/source/debug/dbgthsh.prg + * harbour/source/debug/dbgtarr.prg + ! added protection against RT error when user type wrong expression + in OBJECT, ARRAY and HASH inspectors + 2008-04-22 20:41 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbclass.ch * harbour/include/hbcomp.h diff --git a/harbour/source/debug/dbgbrwsr.prg b/harbour/source/debug/dbgbrwsr.prg index 180446b3c9..2c4d213e26 100644 --- a/harbour/source/debug/dbgbrwsr.prg +++ b/harbour/source/debug/dbgbrwsr.prg @@ -146,7 +146,7 @@ METHOD MoveCursor( nSkip ) RETURN Self METHOD ForceStable() - LOCAL nRow, nCol, xData, oCol, nColX, nWid, xOldColor := SetColor() + LOCAL nRow, nCol, xData, oCol, nColX, nWid, aClr, nClr IF !::lConfigured ::Configure() @@ -155,21 +155,26 @@ METHOD ForceStable() IF Empty( ::aRowState[ nRow ] ) ::GoTo( ::nFirstVisible + nRow - 1 ) IF ::hitBottom - SetColor( ::aColorSpec[ 1 ] ) - @ ::nTop + nRow - 1, ::nLeft SAY Space( ::nRight - ::nLeft + 1 ) + DispOutAt( ::nTop + nRow - 1, ::nLeft, Space( ::nRight - ::nLeft + 1 ), ::aColorSpec[ 1 ] ) ELSE nColX := ::nLeft FOR nCol := 1 TO Len( ::aColumns ) IF nColX <= ::nRight oCol := ::aColumns[ nCol ] - SetColor( ::aColorSpec[ oCol:defColor[ IIf( nRow == ::rowPos, 2, 1 ) ] ] ) xData := Eval( oCol:block ) + nClr := IIf( nRow == ::rowPos, 2, 1 ) + aClr := Eval( oCol:colorBlock, xData ) + IF VALTYPE( aClr ) == "A" + nClr := aClr[ nClr ] + ELSE + nClr := oCol:defColor[ nClr ] + ENDIF IF oCol:width == NIL nWid := Len( xData ) ELSE nWid := oCol:width ENDIF - @ ::nTop + nRow - 1, nColX SAY PadR( xData, nWid ) + IIf( nCol < Len( ::aColumns ), " ", "" ) + DispOutAt( ::nTop + nRow - 1, nColX, PadR( xData, nWid ) + IIf( nCol < Len( ::aColumns ), " ", "" ), ::aColorSpec[ nClr ] ) nColX += nWid + 1 ENDIF NEXT @@ -178,7 +183,6 @@ METHOD ForceStable() ENDIF NEXT ::GoTo( ::nFirstVisible + ::rowPos - 1 ) - SetColor( xOldColor ) SetPos( ::nTop + ::rowPos - 1, ::nLeft ) RETURN Self diff --git a/harbour/source/debug/dbgtarr.prg b/harbour/source/debug/dbgtarr.prg index b7c15f8e27..f4c6aaa353 100644 --- a/harbour/source/debug/dbgtarr.prg +++ b/harbour/source/debug/dbgtarr.prg @@ -157,6 +157,7 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbArray #ifndef HB_NO_READDBG LOCAL nKey + LOCAL oErr LOCAL GetList := {} LOCAL lScoreSave := Set( _SET_SCOREBOARD, .F. ) LOCAL lExitSave := Set( _SET_EXIT, .T. ) @@ -182,7 +183,11 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbArray READ IF LastKey() == K_ENTER - pItem[ nSet ] := &cValue + BEGIN SEQUENCE WITH {|oErr| break( oErr ) } + pItem[ nSet ] := &cValue + RECOVER USING oErr + Alert( oErr:description ) + END SEQUENCE ENDIF SetCursor( SC_NONE ) diff --git a/harbour/source/debug/dbgthsh.prg b/harbour/source/debug/dbgthsh.prg index 3e80810f88..684f545990 100644 --- a/harbour/source/debug/dbgthsh.prg +++ b/harbour/source/debug/dbgthsh.prg @@ -163,6 +163,7 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbHash #ifndef HB_NO_READDBG LOCAL nKey + LOCAL oErr LOCAL GetList := {} LOCAL lScoreSave := Set( _SET_SCOREBOARD, .F. ) LOCAL lExitSave := Set( _SET_EXIT, .T. ) @@ -188,7 +189,11 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbHash READ IF LastKey() == K_ENTER - HB_HValueAt( pItem, nSet, &cValue ) + BEGIN SEQUENCE WITH {|oErr| break( oErr ) } + HB_HValueAt( pItem, nSet, &cValue ) + RECOVER USING oErr + Alert( oErr:description ) + END SEQUENCE ENDIF SetCursor( SC_NONE ) diff --git a/harbour/source/debug/dbgtobj.prg b/harbour/source/debug/dbgtobj.prg index fd43495a69..e44a59a486 100644 --- a/harbour/source/debug/dbgtobj.prg +++ b/harbour/source/debug/dbgtobj.prg @@ -85,6 +85,7 @@ METHOD New( oObject, cVarName, lEditable ) CLASS HBDbObject /* create list of object messages */ aMessages := oObject:classSel() + ASort( aMessages,,, {|x,y| PAdR( x, 64 ) <= PAdR( y, 64 ) } ) aMethods := {} FOR EACH cMsg IN aMessages IF Left( cMsg, 1 ) == "_" .AND. ; @@ -97,7 +98,7 @@ METHOD New( oObject, cVarName, lEditable ) CLASS HBDbObject ENDIF NEXT FOR EACH cMsg IN aMethods - AAdd( ::pItems, { cMsg, "Method", .F. } ) + AAdd( ::pItems, { Lower( cMsg ), "Method", .F. } ) AAdd( ::AllNames, cMsg ) NEXT @@ -137,6 +138,7 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbObject oBrwSets := HBDbBrowser():New( oWndSets:nTop + 1, oWndSets:nLeft + 1, oWndSets:nBottom - 1, oWndSets:nRight - 1 ) ::ArrayReference := aArray + oBrwSets:autolite := .T. oBrwSets:ColorSpec := __Dbg():ClrModal() oBrwSets:GoTopBlock := { || ::Arrayindex := 1 } oBrwSets:GoBottomBlock := { || ::arrayindex := Len( ::ArrayReference ) } @@ -181,20 +183,13 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject LOCAL bInsSave := SetKey( K_INS ) LOCAL cValue LOCAL lCanAcc + LOCAL oErr // make sure browse is stable oBrowse:forceStable() // if confirming new record, append blank - - // set insert key to toggle insert mode and cursor - SetKey( K_INS, { || SetCursor( iif( ReadInsert( ! ReadInsert() ),; - SC_NORMAL, SC_INSERT ) ) } ) - - // initial cursor setting - SetCursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) ) - // get column object from browse column := oBrowse:getColumn( oBrowse:colPos ) @@ -205,7 +200,15 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject RETURN NIL ENDIF cValue := PadR( __dbgValToStr( cValue ), column:Width ) - @ Row(), Col() GET cValue ; + + // set insert key to toggle insert mode and cursor + SetKey( K_INS, { || SetCursor( iif( ReadInsert( ! ReadInsert() ),; + SC_NORMAL, SC_INSERT ) ), inkey(0) } ) + + // initial cursor setting + SetCursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) ) + + @ Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1 GET cValue ; VALID iif( Type( cValue ) == "UE", ( Alert( "Expression error" ), .F. ), .T. ) READ @@ -216,7 +219,11 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject SetKey( K_INS, bInsSave ) IF LastKey() == K_ENTER - __dbgObjSetValue( ::TheObj, pitem[ nSet, 1 ], &cValue ) + BEGIN SEQUENCE WITH {|oErr| break( oErr ) } + __dbgObjSetValue( ::TheObj, pitem[ nSet, 1 ], &cValue ) + RECOVER USING oErr + Alert( oErr:description ) + END SEQUENCE ENDIF // check exit key from get