diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 938a14b1c8..95760f7839 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,41 @@ 2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org) */ +2008-10-15 17:47 UTC+0200 Viktor Szakats (harbour.01 syenar hu) + * source/debug/dbgtobj.prg + * source/debug/dbgbrwsr.prg + * source/debug/dbgthsh.prg + * source/debug/debugger.prg + * source/debug/dbghelp.prg + * source/debug/dbgtarr.prg + * source/debug/dbgwa.prg + * source/debug/dbgtwin.prg + * source/debug/dbgtmenu.prg + + Added minimal Alert() clone, named ___dbgAlert(). + + Replaced Alert() with __dbgAlert() calls. + + Added minimal TBColumn() implementation, named HBDbColumn(). + + Replaced TBColumnNew() with HBDbColumnNew() calls. + + Enabled HB_NO_READDBG for all sources. This isn't + perfect, just a step into the right direction. + ; Please test above modifications. + ; Remaining RTL .prg dependencies: + - HBEDITOR() + - ACHOICE() + + * source/debug/dbgwa.prg + * source/debug/dbgtwin.prg + * source/debug/dbgtmenu.prg + * Formatted to Harbour standards. + + * source/rtl/tobject.prg + * source/rtl/tclass.prg + + Added '#pragma DEBUGINFO=OFF'. + ; NOTE: Maybe it'd be better to rewrite these in .c, + also for speed. If possible. + + * source/rtl/alert.prg + ! Minor typo. + 2008-10-15 17:50 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbstack.h * harbour/source/vm/estack.c @@ -58,12 +93,12 @@ using -b switch to compile Harbour. These are the core .prg modules currently used by hbdebug.lib: - HBGETLIST(), GET(), __GET(), __GETLISTACTIVE(), __GETLISTSETACTIVE(), READINSERT(), READMODAL() - - HBCLASS() - - HBOBJECT() + - HBCLASS() [DONE] + - HBOBJECT() [DONE] - HBEDITOR() - - TBCOLUMNNEW() + - TBCOLUMNNEW() [DONE] - ACHOICE() - - ALERT() + - ALERT() [DONE] * source/debug/dbgtobj.prg * source/debug/dbgbrwsr.prg diff --git a/harbour/source/debug/dbgbrwsr.prg b/harbour/source/debug/dbgbrwsr.prg index 7dfb64600d..e1bd0aa159 100644 --- a/harbour/source/debug/dbgbrwsr.prg +++ b/harbour/source/debug/dbgbrwsr.prg @@ -107,7 +107,7 @@ CREATE CLASS HBDbBrowser METHOD PageDown() INLINE ::MoveCursor( ::rowCount ) METHOD PageUp() INLINE ::MoveCursor( -::rowCount ) METHOD RefreshAll() INLINE AFill( ::aRowState, .F. ), Self - METHOD RefreshCurrent() INLINE IIf( ::rowCount > 0, ::aRowState[ ::rowPos ] := .F., ), Self + METHOD RefreshCurrent() INLINE iif( ::rowCount > 0, ::aRowState[ ::rowPos ] := .F., ), Self METHOD Resize( nTop, nLeft, nBottom, nRight ) METHOD Stabilize() INLINE ::ForceStable() METHOD Up() INLINE ::MoveCursor( -1 ) @@ -136,7 +136,7 @@ METHOD MoveCursor( nSkip ) nSkipped := ::GoTo( ::rowPos + ::nFirstVisible - 1 + nSkip ) IF !::hitBottom .OR. Abs( nSkipped ) > 0 - IF IIf( nSkipped > 0, ::rowPos + nSkipped <= ::rowCount, ::rowPos + nSkipped >= 1 ) + IF iif( nSkipped > 0, ::rowPos + nSkipped <= ::rowCount, ::rowPos + nSkipped >= 1 ) ::RefreshCurrent() ::rowPos += nSkipped ::RefreshCurrent() @@ -164,7 +164,7 @@ METHOD ForceStable() IF nColX <= ::nRight oCol := ::aColumns[ nCol ] xData := Eval( oCol:block ) - nClr := IIf( nRow == ::rowPos, 2, 1 ) + nClr := iif( nRow == ::rowPos, 2, 1 ) aClr := Eval( oCol:colorBlock, xData ) IF VALTYPE( aClr ) == "A" nClr := aClr[ nClr ] @@ -176,7 +176,7 @@ METHOD ForceStable() ELSE nWid := oCol:width ENDIF - DispOutAt( ::nTop + nRow - 1, nColX, PadR( xData, nWid ) + IIf( nCol < Len( ::aColumns ), " ", "" ), ::aColorSpec[ nClr ] ) + DispOutAt( ::nTop + nRow - 1, nColX, PadR( xData, nWid ) + iif( nCol < Len( ::aColumns ), " ", "" ), ::aColorSpec[ nClr ] ) nColX += nWid + 1 ENDIF NEXT @@ -232,3 +232,38 @@ METHOD Resize( nTop, nLeft, nBottom, nRight ) ENDIF RETURN self + +CREATE CLASS HBDbColumn + + VAR nWidth PROTECTED + VAR bBlock PROTECTED + VAR aDefColor PROTECTED INIT { 1, 2 } + + EXPORTED: + + METHOD block( bBlock ) SETGET /* Code block to retrieve data for the column */ + METHOD defColor( aDefColor ) SETGET /* Array of numeric indexes into the color table */ + METHOD width( nWidth ) SETGET /* Column display width */ + + METHOD New( cHeading, bBlock ) /* NOTE: This method is a Harbour extension [vszakats] */ + +ENDCLASS + +METHOD block( bBlock ) CLASS HBDbColumn + RETURN iif( ISBLOCK( bBlock ), ::bBlock := bBlock, ::bBlock ) + +METHOD defColor( aDefColor ) CLASS HBDbColumn + RETURN iif( ISARRAY( aDefColor ), ::aDefColor := aDefColor, ::aDefColor ) + +METHOD width( nWidth ) CLASS HBDbColumn + RETURN iif( ISNUMBER( nWidth ), ::nWidth := nWidth, ::nWidth ) + +METHOD New( cHeading, bBlock ) CLASS HBDbColumn + + HB_SYMBOL_UNUSED( cHeading ) + ::bBlock := bBlock + + RETURN Self + +FUNCTION HBDbColumnNew( cHeading, bBlock ) + RETURN HBDbColumn():New( cHeading, bBlock ) diff --git a/harbour/source/debug/dbghelp.prg b/harbour/source/debug/dbghelp.prg index b6d4c2ad81..277c2b8dcf 100644 --- a/harbour/source/debug/dbghelp.prg +++ b/harbour/source/debug/dbghelp.prg @@ -77,7 +77,7 @@ PROCEDURE __dbgHelp( nTopic ) oBrw := HBDbBrowser():New( oDlg:nTop + 1, oDlg:nLeft + 1, oDlg:nBottom - 1, oDlg:nLeft + 12 ) oBrw:Cargo := 1 - oBrw:AddColumn( TBColumnNew( "", { || aTopics[ oBrw:Cargo ][ 1 ] }, 12 ) ) + oBrw:AddColumn( HBDbColumnNew( "", { || aTopics[ oBrw:Cargo ][ 1 ] }, 12 ) ) oBrw:ColorSpec := StrTran( __Dbg():ClrModal(), ", R/W", "" ) oBrw:SkipBlock := { | nSkip, nOld | nOld := oBrw:Cargo, oBrw:Cargo += nSkip,; oBrw:Cargo := Min( Max( oBrw:Cargo, 1 ), Len( aTopics ) ),; diff --git a/harbour/source/debug/dbgtarr.prg b/harbour/source/debug/dbgtarr.prg index ea3c99d49f..c0c9ba36b0 100644 --- a/harbour/source/debug/dbgtarr.prg +++ b/harbour/source/debug/dbgtarr.prg @@ -51,6 +51,7 @@ */ #pragma DEBUGINFO=OFF +#define HB_NO_READDBG #include "hbclass.ch" @@ -115,12 +116,12 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbArray oBrwSets:Cargo := { 1, {} } // Actual highligthed row AAdd( oBrwSets:Cargo[ 2 ], aArray ) - oBrwSets:AddColumn( oCol := TBColumnNew( "", { || ::arrayName + "[" + LTrim( Str( oBrwSets:cargo[ 1 ], 6 ) ) + "]" } ) ) + oBrwSets:AddColumn( oCol := HBDbColumnNew( "", { || ::arrayName + "[" + LTrim( Str( oBrwSets:cargo[ 1 ], 6 ) ) + "]" } ) ) oCol:width := Len( ::arrayName + "[" + LTrim( Str( Len( aArray ), 6 ) ) + "]" ) oCol:DefColor := { 1, 2 } nColWidth := oCol:Width - oBrwSets:AddColumn( oCol := TBColumnNew( "", { || PadR( __dbgValToStr( aArray[ oBrwSets:cargo[ 1 ] ] ), nWidth - nColWidth - 1 ) } ) ) + oBrwSets:AddColumn( oCol := HBDbColumnNew( "", { || PadR( __dbgValToStr( aArray[ oBrwSets:cargo[ 1 ] ] ), nWidth - nColWidth - 1 ) } ) ) /* 09/08/2004 - Setting a fixed width like it is done in the next line of code wich I've @@ -180,7 +181,7 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbArray // create a corresponding GET @ Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1 GET cValue ; - VALID iif( Type( cValue ) == "UE", ( Alert( "Expression error" ), .F. ), .T. ) + VALID iif( Type( cValue ) == "UE", ( __dbgAlert( "Expression error" ), .F. ), .T. ) READ @@ -188,7 +189,7 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbArray BEGIN SEQUENCE WITH {|oErr| break( oErr ) } pItem[ nSet ] := &cValue RECOVER USING oErr - Alert( oErr:description ) + __dbgAlert( oErr:description ) END SEQUENCE ENDIF @@ -240,7 +241,7 @@ METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, aArray ) CLASS HBDbArray CASE nKey == K_ENTER IF ISARRAY( aArray[ nSet ] ) IF Len( aArray[ nSet ] ) == 0 - Alert( "Array is empty" ) + __dbgAlert( "Array is empty" ) ELSE SetPos( oWnd:nBottom, oWnd:nLeft ) ::aWindows[ ::nCurWindow ]:lFocused := .F. @@ -257,7 +258,7 @@ METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, aArray ) CLASS HBDbArray ENDIF ENDIF ELSEIF ISBLOCK( aArray[ nSet ] ) .OR. Valtype( aArray[ nSet ] ) == "P" - Alert( "Value cannot be edited" ) + __dbgAlert( "Value cannot be edited" ) ELSE IF ::lEditable oBrwSets:RefreshCurrent() @@ -271,7 +272,7 @@ METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, aArray ) CLASS HBDbArray oBrwSets:RefreshCurrent() oBrwSets:ForceStable() ELSE - Alert( "Value cannot be edited" ) + __dbgAlert( "Value cannot be edited" ) ENDIF ENDIF diff --git a/harbour/source/debug/dbgthsh.prg b/harbour/source/debug/dbgthsh.prg index 274144a709..f5c4705f7f 100644 --- a/harbour/source/debug/dbgthsh.prg +++ b/harbour/source/debug/dbgthsh.prg @@ -52,6 +52,7 @@ */ #pragma DEBUGINFO=OFF +#define HB_NO_READDBG #include "hbclass.ch" @@ -116,7 +117,7 @@ METHOD addWindows( hHash, nRow ) CLASS HBDbHash oBrwSets:Cargo := { 1, {} } // Actual highligthed row AAdd( oBrwSets:Cargo[ 2 ], hHash ) - oBrwSets:AddColumn( oCol := TBColumnNew( "", { || ::hashName + "[" + HashKeyString( hHash, oBrwSets:cargo[ 1 ] ) + "]" } ) ) + oBrwSets:AddColumn( oCol := HBDbColumnNew( "", { || ::hashName + "[" + HashKeyString( hHash, oBrwSets:cargo[ 1 ] ) + "]" } ) ) // calculate max key length nKeyLen := 0 @@ -125,7 +126,7 @@ METHOD addWindows( hHash, nRow ) CLASS HBDbHash oCol:DefColor := { 1, 2 } nColWidth := oCol:Width - oBrwSets:AddColumn( oCol := TBColumnNew( "" ,{ || PadR( __dbgValToStr( hb_HValueAt( hHash, oBrwSets:cargo[ 1 ] ) ), nWidth - nColWidth - 1 ) } ) ) + oBrwSets:AddColumn( oCol := HBDbColumnNew( "" ,{ || PadR( __dbgValToStr( hb_HValueAt( hHash, oBrwSets:cargo[ 1 ] ) ), nWidth - nColWidth - 1 ) } ) ) /* 09/08/2004 - Setting a fixed width like it is done in the next line of code wich I've @@ -185,7 +186,7 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbHash // create a corresponding GET @ Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1 GET cValue ; - VALID iif( Type( cValue ) == "UE", ( Alert( "Expression error" ), .F. ), .T. ) + VALID iif( Type( cValue ) == "UE", ( __dbgAlert( "Expression error" ), .F. ), .T. ) READ @@ -193,7 +194,7 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbHash BEGIN SEQUENCE WITH {|oErr| break( oErr ) } HB_HValueAt( pItem, nSet, &cValue ) RECOVER USING oErr - Alert( oErr:description ) + __dbgAlert( oErr:description ) END SEQUENCE ENDIF @@ -250,7 +251,7 @@ METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, hHash ) CLASS HBDbHash IF ValType( uValue ) == "H" IF Len( uValue ) == 0 - Alert( "Hash is empty" ) + __dbgAlert( "Hash is empty" ) ELSE SetPos( ownd:nBottom, ownd:nLeft ) ::aWindows[ ::nCurwindow ]:lFocused := .F. @@ -268,7 +269,7 @@ METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, hHash ) CLASS HBDbHash ENDIF ENDIF ELSEIF ISBLOCK( uValue ) .OR. ValType( uValue ) == "P" - Alert( "Value cannot be edited" ) + __dbgAlert( "Value cannot be edited" ) ELSE IF ::lEditable oBrwSets:RefreshCurrent() @@ -282,7 +283,7 @@ METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, hHash ) CLASS HBDbHash oBrwSets:RefreshCurrent() oBrwSets:ForceStable() ELSE - Alert( "Value cannot be edited" ) + __dbgAlert( "Value cannot be edited" ) ENDIF ENDIF diff --git a/harbour/source/debug/dbgtmenu.prg b/harbour/source/debug/dbgtmenu.prg index f6dfe60abd..019adbd72b 100644 --- a/harbour/source/debug/dbgtmenu.prg +++ b/harbour/source/debug/dbgtmenu.prg @@ -108,14 +108,14 @@ ENDCLASS METHOD New() CLASS HBDbMenu - local nCol := 0 + LOCAL nCol := 0 - if ::aMenus == nil + IF ::aMenus == NIL ::aMenus := {} - ::lPopup := .f. - else - ::lPopup := .t. - endif + ::lPopup := .F. + ELSE + ::lPopup := .T. + ENDIF ::nTop := 0 ::nLeft := 0 @@ -127,380 +127,379 @@ METHOD New() CLASS HBDbMenu AAdd( ::aMenus, Self ) -return Self + RETURN Self METHOD AddItem( oMenuItem ) CLASS HBDbMenu - local oLastMenu := ATail( ::aMenus ) - local oLastMenuItem + LOCAL oLastMenu := ATail( ::aMenus ) + LOCAL oLastMenuItem - if oLastMenu:lPopup + IF oLastMenu:lPopup oMenuItem:nRow := Len( oLastMenu:aItems ) oMenuItem:nCol := oLastMenu:nLeft + 1 - else + ELSE oMenuItem:nRow := 0 - if Len( oLastMenu:aItems ) > 0 + IF Len( oLastMenu:aItems ) > 0 oLastMenuItem := ATail( oLastMenu:aItems ) oMenuItem:nCol := oLastMenuItem:nCol + ; Len( StrTran( oLastMenuItem:cPrompt, "~", "" ) ) - else + ELSE oMenuItem:nCol := 0 - endif - endif + ENDIF + ENDIF AAdd( ATail( ::aMenus ):aItems, oMenuItem ) -return oMenuItem + RETURN oMenuItem METHOD Build() CLASS HBDbMenu - local n - local nPos := 0 - local oMenuItem + LOCAL n + LOCAL nPos := 0 + LOCAL oMenuItem - if Len( ::aMenus ) == 1 // pulldown menu - for n := 1 to Len( ::aItems ) + 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 + NEXT + ELSE oMenuItem := ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ) ::nTop := oMenuItem:nRow + 1 ::nLeft := oMenuItem:nCol nPos := ::nLeft - for n := 1 to Len( ::aItems ) + 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 + NEXT ::nRight := nPos + 1 ::nBottom := ::nTop + Len( ::aItems ) + 1 - for n := 1 to Len( ::aItems ) - if ::aItems[ n ]:cPrompt != "-" + FOR n := 1 TO Len( ::aItems ) + IF ::aItems[ n ]:cPrompt != "-" ::aItems[ n ]:cPrompt := " " + PadR( ::aItems[ n ]:cPrompt, ::nRight - ::nLeft - 1 ) - endif - next + ENDIF + NEXT ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ):bAction := ATail( ::aMenus ) ::aMenus := ASize( ::aMenus, Len( ::aMenus ) - 1 ) - endif + ENDIF -return nil + RETURN NIL METHOD ClosePopup( nPopup ) CLASS HBDbMenu - local oPopup + LOCAL oPopup - if nPopup != 0 + IF nPopup != 0 oPopup := ::aItems[ nPopup ]:bAction - if ValType( oPopup ) == "O" + IF ISOBJECT( oPopup ) RestScreen( oPopup:nTop, oPopup:nLeft, oPopup:nBottom + 1, oPopup:nRight + 2,; oPopup:cBackImage ) - oPopup:cBackImage := nil - endif + oPopup:cBackImage := NIL + ENDIF ::aItems[ nPopup ]:Display( ::cClrPopup, ::cClrHotKey ) - endif + ENDIF -return nil + RETURN NIL METHOD DeHilite() CLASS HBDbMenu - local oMenuItem := ::aItems[ ::nOpenPopup ] + LOCAL oMenuItem := ::aItems[ ::nOpenPopup ] oMenuItem:Display( ::cClrPopup, ::cClrHotKey ) -return nil + RETURN NIL METHOD Display() CLASS HBDbMenu - local n + LOCAL n SetColor( ::cClrPopup ) - if ! ::lPopup + IF ! ::lPopup DispOutAt( 0, 0, Space( MaxCol() + 1 ), ::cClrPopup ) SetPos( 0, 0 ) - else + ELSE ::cBackImage := SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 2 ) @ ::nTop, ::nLeft, ::nBottom, ::nRight BOX B_SINGLE hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight ) - endif + ENDIF - for n := 1 to Len( ::aItems ) - if ::aItems[ n ]:cPrompt == "-" // Separator + 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 + ELSE ::aItems[ n ]:Display( ::cClrPopup, ::cClrHotKey ) - endif - next + ENDIF + NEXT -return nil + RETURN NIL METHOD EvalAction() CLASS HBDbMenu - local oPopup, oMenuItem + LOCAL oPopup, oMenuItem oPopup := ::aItems[ ::nOpenPopup ]:bAction oMenuItem := oPopup:aItems[ oPopup:nOpenPopup ] - if oMenuItem:bAction != nil + IF oMenuItem:bAction != NIL ::Close() Eval( oMenuItem:bAction, oMenuItem ) - endif + ENDIF -return nil + RETURN NIL METHOD GetHotKeyPos( cKey ) CLASS HBDbMenu - local n + LOCAL n - for n := 1 to Len( ::aItems ) - if Upper( SubStr( ::aItems[ n ]:cPrompt,; + FOR n := 1 TO Len( ::aItems ) + IF Upper( SubStr( ::aItems[ n ]:cPrompt,; At( "~", ::aItems[ n ]:cPrompt ) + 1, 1 ) ) == cKey - return n - endif - next + RETURN n + ENDIF + NEXT -return 0 + RETURN 0 METHOD GetItemOrdByCoors( nRow, nCol ) CLASS HBDbMenu - local n + LOCAL n - for n := 1 to Len( ::aItems ) - if ::aItems[ n ]:nRow == nRow .and. nCol >= ::aItems[ n ]:nCol .and. ; + 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 n + ENDIF + NEXT -return 0 + RETURN 0 METHOD GetItemByIdent( uIdent ) CLASS HBDbMenu - local n - local oItem + LOCAL n + LOCAL oItem - for n := 1 to Len( ::aItems ) + FOR n := 1 TO Len( ::aItems ) IF ISOBJECT( ::aItems[ n ]:bAction ) oItem := ::aItems[ n ]:bAction:GetItemByIdent( uIdent ) IF oItem != NIL RETURN oItem ENDIF ELSE - if VALTYPE( ::aItems[ n ]:Ident ) == VALTYPE( uIdent ) .AND.; + IF VALTYPE( ::aItems[ n ]:Ident ) == VALTYPE( uIdent ) .AND.; ::aItems[ n ]:Ident == uIdent - return ::aItems[ n ] + RETURN ::aItems[ n ] ENDIF - endif - next + ENDIF + NEXT -return nil + RETURN NIL METHOD GoBottom() CLASS HBDbMenu - local oPopup + LOCAL oPopup - if ::IsOpen() + IF ::IsOpen() oPopup := ::aItems[ ::nOpenPopup ]:bAction oPopup:DeHilite() oPopup:ShowPopup( Len( oPopup:aItems ) ) - endif + ENDIF -return nil + RETURN NIL METHOD GoLeft() CLASS HBDbMenu - local oMenuItem := ::aItems[ ::nOpenPopup ] + LOCAL oMenuItem := ::aItems[ ::nOpenPopup ] - if ::nOpenPopup != 0 - if ! ::lPopup + IF ::nOpenPopup != 0 + IF ! ::lPopup ::ClosePopup( ::nOpenPopup ) - else + ELSE oMenuItem:Display( ::cClrPopup, ::CClrHotKey ) - endif - if ::nOpenPopup > 1 + ENDIF + IF ::nOpenPopup > 1 --::nOpenPopup - do while ::nOpenPopup > 1 .and. ; + DO WHILE ::nOpenPopup > 1 .AND. ; SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-" --::nOpenPopup - enddo + ENDDO ::ShowPopup( ::nOpenPopup ) - else + ELSE ::ShowPopup( ::nOpenPopup := Len( ::aItems ) ) - endif - endif + ENDIF + ENDIF -return nil + RETURN NIL METHOD GoRight() CLASS HBDbMenu - local oMenuItem := ::aItems[ ::nOpenPopup ] + LOCAL oMenuItem := ::aItems[ ::nOpenPopup ] - if ::nOpenPopup != 0 - if ! ::lPopup + IF ::nOpenPopup != 0 + IF ! ::lPopup ::ClosePopup( ::nOpenPopup ) - else + ELSE oMenuItem:Display( ::cClrPopup, ::cClrHotKey ) - endif - if ::nOpenPopup < Len( ::aItems ) + ENDIF + IF ::nOpenPopup < Len( ::aItems ) ++::nOpenPopup - do while ::nOpenPopup < Len( ::aItems ) .and. ; + DO WHILE ::nOpenPopup < Len( ::aItems ) .AND. ; SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-" ++::nOpenPopup - enddo + ENDDO ::ShowPopup( ::nOpenPopup ) - else + ELSE ::ShowPopup( ::nOpenPopup := 1 ) - endif - endif + ENDIF + ENDIF -return nil + RETURN NIL METHOD GoTop() CLASS HBDbMenu - local oPopup + LOCAL oPopup - if ::IsOpen() + IF ::IsOpen() oPopup := ::aItems[ ::nOpenPopup ]:bAction oPopup:DeHilite() oPopup:ShowPopup( 1 ) - endif + ENDIF -return nil + RETURN NIL METHOD LoadColors() CLASS HBDbMenu - local aColors := __DbgColors() - local n + LOCAL aColors := __DbgColors() + LOCAL n ::cClrPopup := aColors[ 8 ] ::cClrHotKey := aColors[ 9 ] ::cClrHilite := aColors[ 10 ] ::cClrHotFocus := aColors[ 11 ] - for n := 1 to Len( ::aItems ) - if ValType( ::aItems[ n ]:bAction ) == "O" + FOR n := 1 TO Len( ::aItems ) + IF ISOBJECT( ::aItems[ n ]:bAction ) ::aItems[ n ]:bAction:LoadColors() - endif - next + ENDIF + NEXT -return nil + RETURN NIL METHOD Refresh() CLASS HBDbMenu - local n + LOCAL n DispBegin() - if ! ::lPopup + IF ! ::lPopup DispOutAt( 0, 0, Space( MaxCol() + 1 ), ::cClrPopup ) SetPos( 0, 0 ) - endif + ENDIF - for n := 1 to Len( ::aItems ) + FOR n := 1 TO Len( ::aItems ) ::aItems[ n ]:Display( ::cClrPopup, ::cClrHotKey ) - next + NEXT DispEnd() -return nil + RETURN NIL METHOD ShowPopup( nPopup ) CLASS HBDbMenu ::aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus ) ::nOpenPopup := nPopup - if ValType( ::aItems[ nPopup ]:bAction ) == "O" + IF ISOBJECT( ::aItems[ nPopup ]:bAction ) ::aItems[ nPopup ]:bAction:Display() ::aItems[ nPopup ]:bAction:ShowPopup( 1 ) - endif + ENDIF -return nil + RETURN NIL METHOD ProcessKey( nKey ) CLASS HBDbMenu - local nPopup - local oPopup + LOCAL nPopup + LOCAL oPopup - do case - case nKey == K_LBUTTONDOWN - if MRow() == 0 - if ( nPopup := ::GetItemOrdByCoors( 0, MCol() ) ) != 0 - if nPopup != ::nOpenPopup - ::ClosePopup( ::nOpenPopup ) - ::ShowPopup( nPopup ) - endif - endif - else - oPopup := ::aItems[ ::nOpenPopup ]:bAction - if ( nPopup := oPopup:GetItemOrdByCoors( MRow(), MCol() ) ) == 0 - ::Close() - else - oPopup:DeHilite() - oPopup:nOpenPopup := nPopup - oPopup:aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus ) - ::EvalAction() - endif - endif + DO CASE + CASE nKey == K_LBUTTONDOWN + IF MRow() == 0 + IF ( nPopup := ::GetItemOrdByCoors( 0, MCol() ) ) != 0 + IF nPopup != ::nOpenPopup + ::ClosePopup( ::nOpenPopup ) + ::ShowPopup( nPopup ) + ENDIF + ENDIF + ELSE + oPopup := ::aItems[ ::nOpenPopup ]:bAction + IF ( nPopup := oPopup:GetItemOrdByCoors( MRow(), MCol() ) ) == 0 + ::Close() + ELSE + oPopup:DeHilite() + oPopup:nOpenPopup := nPopup + oPopup:aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus ) + ::EvalAction() + ENDIF + ENDIF - case nKey == K_ESC - ::Close() + CASE nKey == K_ESC + ::Close() - case nKey == K_LEFT - ::GoLeft() + CASE nKey == K_LEFT + ::GoLeft() - case nKey == K_RIGHT - ::GoRight() + CASE nKey == K_RIGHT + ::GoRight() - case nKey == K_DOWN - ::GoDown() + CASE nKey == K_DOWN + ::GoDown() - case nKey == K_UP - ::GoUp() + CASE nKey == K_UP + ::GoUp() - case nKey == K_ENTER - ::EvalAction() + CASE nKey == K_ENTER + ::EvalAction() - case nKey == K_HOME - ::GoTop() + CASE nKey == K_HOME + ::GoTop() - case nKey == K_END - ::GoBottom() + CASE nKey == K_END + ::GoBottom() - otherwise + OTHERWISE - if ::nOpenPopup > 0 - if IsAlpha( Chr( nKey ) ) - oPopup := ::aItems[ ::nOpenPopup ]:bAction - nPopup := oPopup:GetHotKeyPos( Upper( Chr( nKey ) ) ) - if nPopup > 0 .and. oPopup:nOpenPopup != nPopup - oPopup:DeHilite() - oPopup:ShowPopup( nPopup ) - ::EvalAction() - endif - endif - else - nPopup := ::GetHotKeyPos( __dbgAltToKey( nKey ) ) - if nPopup != ::nOpenPopup - ::Close() - ::ShowPopup( nPopup ) - endif - endif + IF ::nOpenPopup > 0 + IF IsAlpha( Chr( nKey ) ) + oPopup := ::aItems[ ::nOpenPopup ]:bAction + nPopup := oPopup:GetHotKeyPos( Upper( Chr( nKey ) ) ) + IF nPopup > 0 .AND. oPopup:nOpenPopup != nPopup + oPopup:DeHilite() + oPopup:ShowPopup( nPopup ) + ::EvalAction() + ENDIF + ENDIF + ELSE + nPopup := ::GetHotKeyPos( __dbgAltToKey( nKey ) ) + IF nPopup != ::nOpenPopup + ::Close() + ::ShowPopup( nPopup ) + ENDIF + ENDIF - endcase + ENDCASE -return nil + RETURN NIL +FUNCTION __dbgAltToKey( nKey ) -function __dbgAltToKey( nKey ) - - local nIndex := AScan( { K_ALT_A, K_ALT_B, K_ALT_C, K_ALT_D, K_ALT_E, K_ALT_F,; + 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, K_ALT_1, K_ALT_2, K_ALT_3, K_ALT_4,; K_ALT_5, K_ALT_6, K_ALT_7, K_ALT_8, K_ALT_9, K_ALT_0 }, nKey ) -return iif( nIndex > 0, SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890", nIndex, 1 ), "" ) + RETURN iif( nIndex > 0, SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890", nIndex, 1 ), "" ) diff --git a/harbour/source/debug/dbgtobj.prg b/harbour/source/debug/dbgtobj.prg index f0b35e3524..35dc694ba1 100644 --- a/harbour/source/debug/dbgtobj.prg +++ b/harbour/source/debug/dbgtobj.prg @@ -51,6 +51,7 @@ */ #pragma DEBUGINFO=OFF +#define HB_NO_READDBG #include "hbclass.ch" @@ -149,13 +150,13 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbObject Max( 1, ::arrayindex + nSkip ) ), ::arrayindex - nPos } nMaxLen := ArrayMaxLen( ::AllNames ) - oBrwSets:AddColumn( oCol := TBColumnNew( "",; + oBrwSets:AddColumn( oCol := HBDbColumnNew( "",; { || PadR( ::ArrayReference[ ::arrayindex, 1 ], nMaxLen ) } ) ) oCol:width := nMaxLen oCol:ColorBlock := { || { iif( ::Arrayindex == oBrwSets:Cargo, 2, 1 ), 2 } } oBrwSets:Freeze := 1 - oBrwSets:AddColumn( oCol := TBColumnNew( "", { || iif( ISCHARACTER( ::ArrayReference[ ::ArrayIndex, 2 ] ) .AND. !::ArrayReference[ ::ArrayIndex, 3 ],; + oBrwSets:AddColumn( oCol := HBDbColumnNew( "", { || iif( ISCHARACTER( ::ArrayReference[ ::ArrayIndex, 2 ] ) .AND. !::ArrayReference[ ::ArrayIndex, 3 ],; ::ArrayReference[ ::ArrayIndex, 2 ],; PadR( __dbgValToStr( __dbgObjGetValue( ::TheObj, ::ArrayReference[ ::arrayindex, 1 ] ) ), nWidth - 12 ) ) } ) ) @@ -198,7 +199,7 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject // create a corresponding GET cValue := __dbgObjGetValue( ::TheObj, pitem[ nSet, 1 ], @lCanAcc ) IF !lCanAcc - Alert( cValue ) + __dbgAlert( cValue ) RETURN NIL ENDIF cValue := PadR( __dbgValToStr( cValue ), column:Width ) @@ -211,7 +212,7 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject 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. ) + VALID iif( Type( cValue ) == "UE", ( __dbgAlert( "Expression error" ), .F. ), .T. ) READ @@ -224,7 +225,7 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject BEGIN SEQUENCE WITH {|oErr| break( oErr ) } __dbgObjSetValue( ::TheObj, pitem[ nSet, 1 ], &cValue ) RECOVER USING oErr - Alert( oErr:description ) + __dbgAlert( oErr:description ) END SEQUENCE ENDIF @@ -315,7 +316,7 @@ METHOD SetsKeyPressed( nKey, oBrwSets, nSets, aArray ) CLASS HBDbObject !aArray[ nSet, 3 ] ) .OR. ; ISBLOCK( aArray[ nSet, 2 ] ) .OR. ; ValType( aArray[ nSet, 2 ] ) == "P" - Alert( "Value cannot be edited" ) + __dbgAlert( "Value cannot be edited" ) ELSE IF ::lEditable oBrwSets:RefreshCurrent() @@ -323,7 +324,7 @@ METHOD SetsKeyPressed( nKey, oBrwSets, nSets, aArray ) CLASS HBDbObject oBrwSets:RefreshCurrent() oBrwSets:ForceStable() else - Alert( "Value cannot be edited" ) + __dbgAlert( "Value cannot be edited" ) ENDIF ENDIF ENDIF @@ -384,7 +385,7 @@ STATIC FUNCTION __dbgObjSetValue( oObject, cVar, xValue ) /* Try to access variables using class code level */ __dbgSENDMSG( 0, oObject, "_" + cVar, xValue ) RECOVER USING oErr - Alert( oErr:description ) + __dbgAlert( oErr:description ) END SEQUENCE END SEQUENCE diff --git a/harbour/source/debug/dbgtwin.prg b/harbour/source/debug/dbgtwin.prg index 39b2659106..b497f65fdb 100644 --- a/harbour/source/debug/dbgtwin.prg +++ b/harbour/source/debug/dbgtwin.prg @@ -130,28 +130,28 @@ METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) CLASS HBDbWindow ::cCaption := cCaption ::cColor := cColor -return Self + RETURN Self METHOD Clear() CLASS HBDbWindow SetColor( ::cColor ) Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1 ) -return nil + RETURN NIL METHOD Hide() CLASS HBDbWindow RestScreen( ::nTop, ::nLeft, ::nBottom + iif( ::lShadow, 1, 0 ),; ::nRight + iif( ::lShadow, 2, 0 ), ::cBackImage ) - ::cBackImage := nil - ::lVisible := .f. + ::cBackImage := NIL + ::lVisible := .F. -return nil + RETURN NIL METHOD IsOver( nRow, nCol ) CLASS HBDbWindow -return nRow >= ::nTop .and. nRow <= ::nBottom .and. ; - nCol >= ::nLeft .and. nCol <= ::nRight + RETURN nRow >= ::nTop .AND. nRow <= ::nBottom .AND. ; + nCol >= ::nLeft .AND. nCol <= ::nRight METHOD ScrollUp( nLines ) CLASS HBDbWindow @@ -160,37 +160,37 @@ METHOD ScrollUp( nLines ) CLASS HBDbWindow SetColor( ::cColor ) Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1, nLines ) -return nil + RETURN NIL METHOD SetCaption( cCaption ) CLASS HBDbWindow ::cCaption := cCaption -return nil + RETURN NIL METHOD ShowCaption CLASS HBDbWindow - if ! Empty( ::cCaption ) + IF ! Empty( ::cCaption ) DispOutAt( ::nTop, ::nLeft + ( ( ::nRight - ::nLeft ) / 2 ) - ; ( ( Len( ::cCaption ) + 2 ) / 2 ),; " " + ::cCaption + " ", ::cColor ) - endif + ENDIF -return nil + RETURN NIL METHOD SetFocus( lOnOff ) CLASS HBDbWindow - if ! lOnOff .and. ::bLostFocus != nil + IF ! lOnOff .AND. ::bLostFocus != NIL Eval( ::bLostFocus, Self ) - endif + ENDIF ::lFocused := lOnOff - if lOnOff .and. ::bGotFocus != nil + IF lOnOff .AND. ::bGotFocus != NIL Eval( ::bGotFocus, Self ) - endif + ENDIF -return nil + RETURN NIL METHOD Refresh() CLASS HBDbWindow @@ -203,13 +203,13 @@ METHOD Refresh() CLASS HBDbWindow ::ShowCaption( ::cCaption ) - if ::bPainted != nil + IF ::bPainted != NIL Eval( ::bPainted, Self ) - endif + ENDIF DispEnd() -return nil + RETURN NIL METHOD Show( lFocused ) CLASS HBDbWindow LOCAL nRow := Row() @@ -223,136 +223,136 @@ METHOD Show( lFocused ) CLASS HBDbWindow Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight ) ::SetFocus( lFocused ) - if ::lShadow + IF ::lShadow hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight ) - endif + ENDIF ::Refresh() - ::lVisible := .t. + ::lVisible := .T. SetPos( nRow, nCol ) -return nil + RETURN NIL METHOD ShowModal() CLASS HBDbWindow - local lExit := .f. - local nKey + LOCAL lExit := .F. + LOCAL nKey - ::lShadow := .t. + ::lShadow := .T. ::Show() - do while ! lExit + DO WHILE ! lExit nKey := Inkey( 0, INKEY_ALL ) - if ::bKeyPressed != nil + IF ::bKeyPressed != NIL Eval( ::bKeyPressed, nKey ) - endif + ENDIF - do case - case nKey == K_ESC - lExit := .t. + DO CASE + CASE nKey == K_ESC + lExit := .T. - case nKey == K_LBUTTONDOWN - if MRow() == ::nTop .and. MCol() >= ::nLeft + 1 .and. ; + CASE nKey == K_LBUTTONDOWN + IF MRow() == ::nTop .AND. MCol() >= ::nLeft + 1 .AND. ; MCol() <= ::nLeft + 3 - lExit := .t. - endif - endcase - enddo + lExit := .T. + ENDIF + ENDCASE + ENDDO ::Hide() -return nil + RETURN NIL METHOD LButtonDown( nMRow, nMCol ) CLASS HBDbWindow - if ::bLButtonDown != nil + IF ::bLButtonDown != NIL Eval( ::bLButtonDown, nMRow, nMCol ) - endif + ENDIF -return nil + RETURN NIL METHOD LDblClick( nMRow, nMCol ) CLASS HBDbWindow - if ::bLDblClick != nil + IF ::bLDblClick != NIL Eval( ::bLDblClick, nMRow, nMCol ) - endif + ENDIF -return nil + RETURN NIL METHOD Move() Class HBDbWindow - local nOldTop := ::nTop - local nOldLeft := ::nLeft - local nOldBottom := ::nbottom - local nOldRight := ::nright - local nKey + LOCAL nOldTop := ::nTop + LOCAL nOldLeft := ::nLeft + LOCAL nOldBottom := ::nbottom + LOCAL nOldRight := ::nright + LOCAL nKey - do while .t. + DO WHILE .T. RestScreen( ,,,, ::cbackimage ) DispBox( ::nTop, ::nLeft, ::nRight, ::nBottom, Replicate( Chr( 176 ), 8 ) + " " ) nKey := Inkey( 0 ) - do case - case nKey == K_UP + DO CASE + CASE nKey == K_UP - if ::ntop != 0 + IF ::ntop != 0 ::ntop-- ::nbottom-- - endif + ENDIF - case nKey == K_DOWN + CASE nKey == K_DOWN - if ::nBottom != MaxRow() + IF ::nBottom != MaxRow() ::nTop++ ::nBottom++ - endif + ENDIF - case nKey == K_LEFT + CASE nKey == K_LEFT - if ::nLeft != 0 + IF ::nLeft != 0 ::nLeft-- ::nRight-- - endif + ENDIF - case nKey == K_RIGHT + CASE nKey == K_RIGHT - if ::nBottom != MaxRow() + IF ::nBottom != MaxRow() ::nLeft++ ::nRight++ - endif + ENDIF - case nKey == K_ESC + CASE nKey == K_ESC ::nTop := nOldTop ::nLeft := nOldLeft ::nBottom := nOldBottom ::nRight := nOldRight - endcase + ENDCASE - if nKey == K_ESC .or. nKey == K_ENTER + IF nKey == K_ESC .OR. nKey == K_ENTER exit - endif - enddo + ENDIF + ENDDO // __Keyboard( Chr( 0 ) ), Inkey() ) -return nil + RETURN NIL METHOD KeyPressed( nKey ) CLASS HBDbWindow - if ::bKeyPressed != NIL + IF ::bKeyPressed != NIL Eval( ::bKeyPressed, nKey, Self ) - endif + ENDIF -return nil + RETURN NIL METHOD LoadColors() CLASS HBDbWindow - local aClr := __DbgColors() + LOCAL aClr := __DbgColors() ::cColor := aClr[ 1 ] @@ -360,42 +360,42 @@ METHOD LoadColors() CLASS HBDbWindow ::Browser:ColorSpec := aClr[ 2 ] + "," + aClr[ 5 ] + "," + aClr[ 3 ] ENDIF -return nil + RETURN NIL METHOD Resize( nTop, nLeft, nBottom, nRight ) CLASS HBDbWindow - local lShow + LOCAL lShow - if ( nTop == NIL .OR. nTop == ::nTop ) .AND. ; + IF ( nTop == NIL .OR. nTop == ::nTop ) .AND. ; ( nLeft == NIL .OR. nLeft == ::nLeft ) .AND. ; ( nBottom == NIL .OR. nBottom == ::nBottom ) .AND. ; ( nRight == NIL .OR. nRight == ::nRight ) - return Self - endif + RETURN Self + ENDIF - if ( lShow := ::lVisible ) + IF ( lShow := ::lVisible ) ::Hide() - endif + ENDIF - if nTop != NIL + IF nTop != NIL ::nTop := nTop - endif - if nBottom != NIL + ENDIF + IF nBottom != NIL ::nBottom := nBottom - endif - if nLeft != NIL + ENDIF + IF nLeft != NIL ::nLeft := nLeft - endif - if nRight != NIL + ENDIF + IF nRight != NIL ::nRight := nRight - endif + ENDIF - if ::Browser != NIL + IF ::Browser != NIL ::Browser:Resize( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1 ) - endif + ENDIF - if lShow + IF lShow ::Show( ::lFocused ) - endif + ENDIF -return self + RETURN self diff --git a/harbour/source/debug/dbgwa.prg b/harbour/source/debug/dbgwa.prg index 9b3910de62..16bb582118 100644 --- a/harbour/source/debug/dbgwa.prg +++ b/harbour/source/debug/dbgwa.prg @@ -56,39 +56,39 @@ #include "setcurs.ch" #include "inkey.ch" -procedure __dbgShowWorkAreas() +PROCEDURE __dbgShowWorkAreas() - local oDlg - local oCol + LOCAL oDlg + LOCAL oCol - local aAlias := {} - local aBrw[ 3 ] - local aStruc - local aInfo + LOCAL aAlias := {} + LOCAL aBrw[ 3 ] + LOCAL aStruc + LOCAL aInfo - local cColor := iif( __Dbg():lMonoDisplay, "N/W, W/N, W+/W, W+/N", "N/W, N/BG, R/W, R/BG" ) + LOCAL cColor := iif( __Dbg():lMonoDisplay, "N/W, W/N, W+/W, W+/N", "N/W, N/BG, R/W, R/BG" ) - local n1 - local n2 - local n3 := 1 - local cur_id := 1 + LOCAL n1 + LOCAL n2 + LOCAL n3 := 1 + LOCAL cur_id := 1 - local nOldArea := Select() + LOCAL nOldArea := Select() /* We can't determine the last used area, so use 512 here */ - for n1 := 1 to 512 - if ( n1 )->( Used() ) + FOR n1 := 1 TO 512 + IF ( n1 )->( Used() ) AAdd( aAlias, { n1, Alias( n1 ) } ) - if n1 == nOldArea + IF n1 == nOldArea cur_id := Len( aAlias ) - endif - endif - next + ENDIF + ENDIF + NEXT - if Len( aAlias ) == 0 - Alert( "No workareas in use") - return - endif + IF Len( aAlias ) == 0 + __dbgAlert( "No workareas in use") + RETURN + ENDIF IF !Used() dbSelectArea( aAlias[ 1 ][ 1 ] ) @@ -114,7 +114,7 @@ procedure __dbgShowWorkAreas() Max( 1, n1 + nSkip ) ),; n1 - nPos } - aBrw[ 1 ]:AddColumn( oCol := TBColumnNew( "", { || PadR( aAlias[ n1 ][ 2 ], 11 ) } ) ) + aBrw[ 1 ]:AddColumn( oCol := HBDbColumnNew( "", { || PadR( aAlias[ n1 ][ 2 ], 11 ) } ) ) oCol:ColorBlock := { || iif( aAlias[ n1 ][ 1 ] == Select(), { 3, 4 }, { 1, 2 } ) } @@ -133,9 +133,9 @@ procedure __dbgShowWorkAreas() Max( 1, n2 + nSkip ) ), ; n2 - nPos } - aBrw[ 2 ]:AddColumn( oCol := TBColumnNew( "", { || PadR( aInfo[ n2 ], 38 ) } ) ) + aBrw[ 2 ]:AddColumn( oCol := HBDbColumnNew( "", { || PadR( aInfo[ n2 ], 38 ) } ) ) - oCol:ColorBlock := { || iif( aAlias[ n1 ][ 1 ] == Select() .and. n2 == 1, { 3, 4 }, { 1, 2 } ) } + oCol:ColorBlock := { || iif( aAlias[ n1 ][ 1 ] == Select() .AND. n2 == 1, { 3, 4 }, { 1, 2 } ) } /* Struc browse */ @@ -151,10 +151,10 @@ procedure __dbgShowWorkAreas() aBrw[ 3 ]:Cargo := n3 := iif( nSkip > 0, Min( Len( aStruc ), n3 + nSkip ),; Max( 1, n3 + nSkip ) ), n3 - nPos } - aBrw[ 3 ]:AddColumn( TBColumnNew( "", { || PadR( aStruc[ n3, 1 ], 11 ) + ; - aStruc[ n3, 2 ] + ; - Str( aStruc[ n3, 3 ], 4 ) + ; - Str( aStruc[ n3, 4 ], 3 ) } ) ) + aBrw[ 3 ]:AddColumn( HBDbColumnNew( "", { || PadR( aStruc[ n3, 1 ], 11 ) + ; + aStruc[ n3, 2 ] + ; + Str( aStruc[ n3, 3 ], 4 ) + ; + Str( aStruc[ n3, 4 ], 3 ) } ) ) /* Show dialog */ @@ -162,9 +162,9 @@ procedure __dbgShowWorkAreas() dbSelectArea( nOldArea ) -return + RETURN -static procedure DlgWorkAreaPaint( oDlg, aBrw ) +STATIC PROCEDURE DlgWorkAreaPaint( oDlg, aBrw ) /* Display captions */ @@ -213,31 +213,31 @@ static procedure DlgWorkAreaPaint( oDlg, aBrw ) UpdateInfo( oDlg, Alias() ) -return + RETURN -static procedure DlgWorkAreaKey( nKey, oDlg, aBrw, aAlias, aStruc, aInfo ) +STATIC PROCEDURE DlgWorkAreaKey( nKey, oDlg, aBrw, aAlias, aStruc, aInfo ) - local oDebug := __Dbg() - local nAlias + LOCAL oDebug := __Dbg() + LOCAL nAlias - if nKey == K_TAB .or. nKey == K_SH_TAB + IF nKey == K_TAB .OR. nKey == K_SH_TAB aBrw[ oDebug:nWaFocus ]:Dehilite() oDebug:nWaFocus += iif( nKey == K_TAB, 1, -1 ) - if oDebug:nWaFocus < 1 + IF oDebug:nWaFocus < 1 oDebug:nWaFocus := 3 - endif - if oDebug:nWaFocus > 3 + ENDIF + IF oDebug:nWaFocus > 3 oDebug:nWaFocus := 1 - endif + ENDIF aBrw[ oDebug:nWaFocus ]:Hilite() - return - endif + RETURN + ENDIF - do case - case oDebug:nWaFocus == 1 + DO CASE + CASE oDebug:nWaFocus == 1 nAlias := aBrw[ 1 ]:Cargo WorkAreasKeyPressed( nKey, aBrw[ 1 ], Len( aAlias ) ) - if nAlias != aBrw[ 1 ]:Cargo + IF nAlias != aBrw[ 1 ]:Cargo aBrw[ 2 ]:GoTop() aBrw[ 2 ]:Invalidate() aBrw[ 2 ]:ForceStable() @@ -257,62 +257,62 @@ static procedure DlgWorkAreaKey( nKey, oDlg, aBrw, aAlias, aStruc, aInfo ) aBrw[ 3 ]:ForceStable() aBrw[ 3 ]:Dehilite() UpdateInfo( oDlg, aAlias[ aBrw[ 1 ]:Cargo ][ 2 ] ) - endif - case oDebug:nWaFocus == 2 + ENDIF + CASE oDebug:nWaFocus == 2 WorkAreasKeyPressed( nKey, aBrw[ 2 ], Len( aInfo ) ) - case oDebug:nWaFocus == 3 + CASE oDebug:nWaFocus == 3 WorkAreasKeyPressed( nKey, aBrw[ 3 ], Len( aStruc ) ) - endcase + ENDCASE -return + RETURN -static procedure WorkAreasKeyPressed( nKey, oBrw, nTotal ) +STATIC PROCEDURE WorkAreasKeyPressed( nKey, oBrw, nTotal ) - do case - case nKey == K_UP + DO CASE + CASE nKey == K_UP - if oBrw:Cargo > 1 + IF oBrw:Cargo > 1 oBrw:Cargo-- oBrw:RefreshCurrent() oBrw:Up() oBrw:ForceStable() - endif + ENDIF - case nKey == K_DOWN + CASE nKey == K_DOWN - if oBrw:Cargo < nTotal + IF oBrw:Cargo < nTotal oBrw:Cargo++ oBrw:RefreshCurrent() oBrw:Down() oBrw:ForceStable() - endif + ENDIF - case nKey == K_HOME .OR. nKey == K_CTRL_PGUP .OR. nKey == K_CTRL_HOME + CASE nKey == K_HOME .OR. nKey == K_CTRL_PGUP .OR. nKey == K_CTRL_HOME - if oBrw:Cargo > 1 + IF oBrw:Cargo > 1 oBrw:Cargo := 1 oBrw:GoTop() oBrw:ForceStable() - endif + ENDIF - case nKey == K_END .OR. nKey == K_CTRL_PGDN .OR. nKey == K_CTRL_END + CASE nKey == K_END .OR. nKey == K_CTRL_PGDN .OR. nKey == K_CTRL_END - if oBrw:Cargo < nTotal + IF oBrw:Cargo < nTotal oBrw:Cargo := nTotal oBrw:GoBottom() oBrw:ForceStable() - endif + ENDIF - endcase + ENDCASE -return + RETURN -static function DbfInfo( aInfo ) +STATIC FUNCTION DbfInfo( aInfo ) - local nFor - local xType - local xValue - local cValue + LOCAL nFor + LOCAL xType + LOCAL xValue + LOCAL cValue aInfo := {} @@ -328,33 +328,33 @@ static function DbfInfo( aInfo ) AAdd( aInfo, Space( 8 ) + "Index order: " + LTrim( Str( IndexOrd() ) ) ) AAdd( aInfo, Space( 4 ) + "Current Record" ) - for nFor := 1 to FCount() + FOR nFor := 1 TO FCount() xValue := FieldGet( nFor ) xType := ValType( xValue ) - do case - case xType $ "CM" ; cValue := xValue - case xType == "N" ; cValue := LTrim( Str( xValue ) ) - case xType == "D" ; cValue := DToC( xValue ) - case xType == "L" ; cValue := iif( xValue, ".T.", ".F." ) - case xType == "A" ; cValue := "Array" - otherwise ; cValue := "Error" - endcase + DO CASE + CASE xType $ "CM" ; cValue := xValue + CASE xType == "N" ; cValue := LTrim( Str( xValue ) ) + CASE xType == "D" ; cValue := DToC( xValue ) + CASE xType == "L" ; cValue := iif( xValue, ".T.", ".F." ) + CASE xType == "A" ; cValue := "Array" + OTHERWISE ; cValue := "Error" + ENDCASE AAdd( aInfo, Space( 8 ) + PadR( FieldName( nFor ), 10) + " = " + PadR( cValue, 17 ) ) - next + NEXT -return aInfo + RETURN aInfo -static procedure UpdateInfo( oDlg, cAlias ) +STATIC PROCEDURE UpdateInfo( oDlg, cAlias ) - local nOldArea + LOCAL nOldArea - if Empty( cAlias ) - return - endif + IF Empty( cAlias ) + RETURN + ENDIF nOldArea := Select() @@ -374,4 +374,4 @@ static procedure UpdateInfo( oDlg, cAlias ) dbSelectArea( nOldArea ) -return + RETURN diff --git a/harbour/source/debug/debugger.prg b/harbour/source/debug/debugger.prg index 9e478a1b41..f1407fcf05 100644 --- a/harbour/source/debug/debugger.prg +++ b/harbour/source/debug/debugger.prg @@ -63,6 +63,7 @@ redirection, and is also slower. [vszakats] */ #pragma DEBUGINFO=OFF +#define HB_NO_READDBG #include "hbclass.ch" #include "hbdebug.ch" // for "nMode" of __dbgEntry @@ -360,7 +361,7 @@ CREATE CLASS HBDebugger METHOD VarSetValue( aVar, uValue ) METHOD ResizeWindows( oWindow ) - METHOD NotSupported() INLINE Alert( "Not implemented yet!" ) + METHOD NotSupported() INLINE __dbgAlert( "Not implemented yet!" ) METHOD OpenDebuggerWindow() METHOD CloseDebuggerWindow() @@ -517,7 +518,7 @@ METHOD BuildBrowseStack() CLASS HBDebugger ::oBrwStack:Cargo := 1 // Actual highligthed row - ::oBrwStack:AddColumn( TBColumnNew( "", { || iif( Len( ::aProcStack ) > 0,; + ::oBrwStack:AddColumn( HBDbColumnNew( "", { || iif( Len( ::aProcStack ) > 0,; PadC( ::aProcStack[ ::oBrwStack:Cargo ][ CSTACK_FUNCTION ], 14 ), Space( 14 ) ) } ) ) ENDIF @@ -717,7 +718,7 @@ METHOD Colors() CLASS HBDebugger LOCAL oCol IF ::lMonoDisplay - Alert( "Monochrome display" ) + __dbgAlert( "Monochrome display" ) RETURN NIL ENDIF @@ -728,10 +729,10 @@ METHOD Colors() CLASS HBDebugger oBrwColors:skipBlock := { | nPos | ( nPos := ArrayBrowseSkip( nPos, oBrwColors ), oBrwColors:cargo[ 1 ] := ; oBrwColors:cargo[ 1 ] + nPos, nPos ) } - oBrwColors:AddColumn( oCol := TBColumnNew( "", { || PadR( aColors[ oBrwColors:Cargo[ 1 ] ], 14 ) } ) ) + oBrwColors:AddColumn( oCol := HBDbColumnNew( "", { || PadR( aColors[ oBrwColors:Cargo[ 1 ] ], 14 ) } ) ) oCol:defColor := { 1, 2 } AAdd( oBrwColors:Cargo[ 2 ], aColors ) - oBrwColors:AddColumn( oCol := TBColumnNew( "",; + oBrwColors:AddColumn( oCol := HBDbColumnNew( "",; { || PadR( '"' + ::aColors[ oBrwColors:Cargo[ 1 ] ] + '"', nWidth - 15 ) } ) ) AAdd( oBrwColors:Cargo[ 2 ], aColors ) oCol:defColor := { 1, 3 } @@ -1114,14 +1115,14 @@ METHOD EditColor( nColor, oBrwColors ) CLASS HBDebugger #ifndef HB_NO_READDBG SetCursor( SC_NORMAL ) @ Row(), Col() + 15 GET cColor COLOR SubStr( ::ClrModal(), 5 ) ; - VALID iif( Type( cColor ) != "C", ( Alert( "Must be string" ), .F. ), .T. ) + VALID iif( Type( cColor ) != "C", ( __dbgAlert( "Must be string" ), .F. ), .T. ) READ SetCursor( SC_NONE ) #else cColor := getdbginput( Row(), Col() + 15, cColor, ; { | cColor | iif( Type( cColor ) != "C", ; - ( Alert( "Must be string" ), .F. ), .T. ) }, ; + ( __dbgAlert( "Must be string" ), .F. ), .T. ) }, ; SubStr( ::ClrModal(), 5 ) ) #endif @@ -1151,14 +1152,14 @@ METHOD EditSet( nSet, oBrwSets ) CLASS HBDebugger #ifndef HB_NO_READDBG SetCursor( SC_NORMAL ) @ Row(), Col() + 13 GET cSet COLOR SubStr( ::ClrModal(), 5 ) ; - VALID iif( Type( cSet ) != cType, ( Alert( "Must be of type '" + cType + "'" ), .F. ), .T. ) + VALID iif( Type( cSet ) != cType, ( __dbgAlert( "Must be of type '" + cType + "'" ), .F. ), .T. ) READ SetCursor( SC_NONE ) #else cSet := getdbginput( Row(), Col() + 13, cSet, ; { | cSet | iif( Type( cSet ) != cType, ; - ( Alert( "Must be of type '" + cType + "'" ), .F. ), .T. ) }, ; + ( __dbgAlert( "Must be of type '" + cType + "'" ), .F. ), .T. ) }, ; SubStr( ::ClrModal(), 5 ) ) #endif @@ -1189,7 +1190,7 @@ METHOD EditVar( nVar ) CLASS HBDebugger ::InputBox( cVarName, uVarValue, NIL, .F. ) ELSE cVarStr := ::InputBox( cVarName, __dbgValToStr( uVarValue ),; - { | u | iif( Type( u ) == "UE", ( Alert( "Expression error" ), .F. ), .T. ) } ) + { | u | iif( Type( u ) == "UE", ( __dbgAlert( "Expression error" ), .F. ), .T. ) } ) ENDIF IF LastKey() != K_ESC @@ -1200,7 +1201,7 @@ METHOD EditVar( nVar ) CLASS HBDebugger IF Len( uVarValue ) > 0 __DbgArrays( uVarValue, cVarName ) ELSE - Alert( "Array is empty" ) + __dbgAlert( "Array is empty" ) ENDIF CASE Upper( Left( cVarStr, 5 ) ) == "CLASS" @@ -1210,7 +1211,7 @@ METHOD EditVar( nVar ) CLASS HBDebugger BEGIN SEQUENCE WITH {|oErr| break( oErr ) } ::VarSetValue( ::aVars[ nVar ], &cVarStr ) RECOVER USING oErr - Alert( oErr:description ) + __dbgAlert( oErr:description ) END SEQUENCE ENDCASE ENDIF @@ -1602,14 +1603,14 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger CASE LastKey() == K_ENTER IF cType == "A" IF Len( uValue ) == 0 - Alert( "Array is empty" ) + __dbgAlert( "Array is empty" ) ELSE __DbgArrays( uValue, cMsg ) ENDIF ELSEIF cType == "H" IF Len( uValue ) == 0 - Alert( "Hash is empty" ) + __dbgAlert( "Hash is empty" ) ELSE __DbgHashes( uValue, cMsg ) ENDIF @@ -1618,11 +1619,11 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger __DbgObject( uValue, cMsg ) ELSE - Alert( "Value cannot be edited" ) + __dbgAlert( "Value cannot be edited" ) ENDIF OTHERWISE - Alert( "Value cannot be edited" ) + __dbgAlert( "Value cannot be edited" ) ENDCASE ENDDO @@ -1965,7 +1966,7 @@ METHOD Open() CLASS HBDebugger IF ! File( cFileName ) .AND. ! Empty( ::cPathForFiles ) cRealName := ::LocatePrgPath( cFileName ) IF Empty( cRealName ) - Alert( "File '" + cFileName + "' not found!" ) + __dbgAlert( "File '" + cFileName + "' not found!" ) RETURN NIL ENDIF cFileName := cRealName @@ -2052,12 +2053,12 @@ METHOD OSShell() CLASS HBDebugger cShell := GetEnv( "SHELL" ) hb_Run( cShell ) ELSE - Alert( "Not implemented yet!" ) + __dbgAlert( "Not implemented yet!" ) ENDIF RECOVER USING oE - Alert( "Error: " + oE:description ) + __dbgAlert( "Error: " + oE:description ) END SEQUENCE @@ -2702,7 +2703,7 @@ METHOD ShowVars() CLASS HBDebugger ::oBrwVars:Cargo[ 1 ] - nOld } nWidth := ::oWndVars:nWidth() - 1 - oCol := TBColumnNew( "", ; + oCol := HBDbColumnNew( "", ; { || PadR( LTrim( Str( ::oBrwVars:Cargo[ 1 ] - 1 ) ) + ") " + ; ::VarGetInfo( ::aVars[ Max( ::oBrwVars:Cargo[ 1 ], 1 ) ] ), ; ::oWndVars:nWidth() - 2 ) } ) @@ -2965,10 +2966,10 @@ METHOD ViewSets() CLASS HBDebugger oBrwSets:goBottomBlock := { || oBrwSets:cargo[ 1 ] := Len( oBrwSets:cargo[ 2 ][ 1 ] ) } oBrwSets:skipBlock := { | nPos | ( nPos := ArrayBrowseSkip( nPos, oBrwSets ), oBrwSets:cargo[ 1 ] := ; oBrwSets:cargo[ 1 ] + nPos, nPos ) } - oBrwSets:AddColumn( oCol := TBColumnNew( "", { || PadR( aSets[ oBrwSets:cargo[ 1 ] ], 12 ) } ) ) + oBrwSets:AddColumn( oCol := HBDbColumnNew( "", { || PadR( aSets[ oBrwSets:cargo[ 1 ] ], 12 ) } ) ) AAdd( oBrwSets:Cargo[ 2 ], aSets ) ocol:defcolor := { 1, 2 } - oBrwSets:AddColumn( oCol := TBColumnNew( "",; + oBrwSets:AddColumn( oCol := HBDbColumnNew( "",; { || PadR( __dbgValToStr( Set( oBrwSets:cargo[ 1 ] ) ), nWidth - 13 ) } ) ) ocol:defcolor := { 1, 3 } ocol:width := 40 @@ -3165,7 +3166,7 @@ METHOD WatchpointsShow() CLASS HBDebugger iif( Len(::aWatch) > 0, ::oBrwPnt:Cargo[ 1 ] - nOld, 0 ) } nWidth := ::oWndPnt:nWidth() - 1 - oCol := TBColumnNew( "", ; + oCol := HBDbColumnNew( "", ; { || PadR( iif( Len( ::aWatch ) > 0, ; LTrim( Str( ::oBrwPnt:Cargo[ 1 ] - 1 ) ) + ") " + ; ::WatchGetInfo( Max( ::oBrwPnt:Cargo[ 1 ], 1 ) ), ; @@ -3429,3 +3430,6 @@ FUNCTION __dbgValToStr( uVal ) ENDCASE RETURN "U" + +FUNCTION __dbgAlert( cMessage ) + RETURN hb_gtAlert( cMessage, { "Ok" }, "W+/R", "W+/B" ) diff --git a/harbour/source/rtl/alert.prg b/harbour/source/rtl/alert.prg index bd7b8778f7..684360e8f7 100644 --- a/harbour/source/rtl/alert.prg +++ b/harbour/source/rtl/alert.prg @@ -136,7 +136,7 @@ FUNCTION Alert( xMessage, aOptions, cColorNorm, nDelay ) #endif ENDIF - RETURN hb_gtAlert( cMessage, aOptionsOK, cColorNorm, cColorHigh, nDelay ); + RETURN hb_gtAlert( cMessage, aOptionsOK, cColorNorm, cColorHigh, nDelay ) #ifdef HB_C52_UNDOC diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index ada247a539..5540eda006 100644 --- a/harbour/source/rtl/tclass.prg +++ b/harbour/source/rtl/tclass.prg @@ -73,6 +73,8 @@ /* Harbour Class HBClass to build classes */ +#pragma DEBUGINFO=OFF + #include "common.ch" #include "hboo.ch" diff --git a/harbour/source/rtl/tobject.prg b/harbour/source/rtl/tobject.prg index 40ec0216e0..7ab81d10c9 100644 --- a/harbour/source/rtl/tobject.prg +++ b/harbour/source/rtl/tobject.prg @@ -71,6 +71,8 @@ /* WARNING: Can not use the preprocessor, otherwise it will auto inherit from itself. */ +#pragma DEBUGINFO=OFF + #include "common.ch" #include "hboo.ch" #include "error.ch"