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

2008-10-15 17:47 UTC+0200 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* 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.
This commit is contained in:
Viktor Szakats
2008-10-15 15:55:11 +00:00
parent 3ed8136c80
commit 57e094986e
13 changed files with 505 additions and 425 deletions
Download Patch File Download Diff File Expand all files Collapse all files

43
harbour/ChangeLog
View File

@@ -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

43
harbour/source/debug/dbgbrwsr.prg
View File

@@ -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 )

2
harbour/source/debug/dbghelp.prg
View File

@@ -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 ) ),;

15
harbour/source/debug/dbgtarr.prg
View File

@@ -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 - <maurilio.longo@libero.it>
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

15
harbour/source/debug/dbgthsh.prg
View File

@@ -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 - <maurilio.longo@libero.it>
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

371
harbour/source/debug/dbgtmenu.prg
View File

@@ -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 ), "" )

17
harbour/source/debug/dbgtobj.prg
View File

@@ -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

190
harbour/source/debug/dbgtwin.prg
View File

@@ -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

178
harbour/source/debug/dbgwa.prg
View File

@@ -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

50
harbour/source/debug/debugger.prg
View File

@@ -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" )

2
harbour/source/rtl/alert.prg
View File

@@ -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

2
harbour/source/rtl/tclass.prg
View File

@@ -73,6 +73,8 @@
/* Harbour Class HBClass to build classes */
#pragma DEBUGINFO=OFF
#include "common.ch"
#include "hboo.ch"

2
harbour/source/rtl/tobject.prg
View File

@@ -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"