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

*** empty log message ***

Browse Source
This commit is contained in:
Ignacio Ortiz de Zuniga
2001-02-08 16:25:41 +00:00
parent 31e5c0167e
commit 41057bbe2c
4 changed files with 365 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
harbour/makefile.bc
View File

@@ -432,7 +432,8 @@ DEBUG_LIB_OBJS = \
$(OBJ_DIR)\debugger.obj \
$(OBJ_DIR)\dbgtarr.obj \
$(OBJ_DIR)\dbgtobj.obj \
$(OBJ_DIR)\tbrwtext.obj
$(OBJ_DIR)\tbrwtext.obj \
$(OBJ_DIR)\dbgwa.obj
#
# COMMON.LIB rules
@@ -2011,6 +2012,13 @@ $(OBJ_DIR)\dbgtobj.obj : $(OBJ_DIR)\dbgtobj.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(DEBUG_LIB) $(ARFLAGS) -+$@,,
$(OBJ_DIR)\dbgwa.c : $(DEBUG_DIR)\dbgwa.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\dbgwa.obj : $(OBJ_DIR)\dbgwa.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(DEBUG_LIB) $(ARFLAGS) -+$@,,
#
# GTCGI.LIB dependencies
#
@@ -2436,4 +2444,3 @@ $(OBJ_DIR)\prb_stak.c : $(HBMAKE_DIR)\prb_stak.prg
$(OBJ_DIR)\prb_stak.obj : $(OBJ_DIR)\prb_stak.c
$(CC) $(CLIBFLAGS) -o$@ $**

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

@@ -390,7 +390,7 @@ METHOD ProcessKey( nKey ) CLASS TDbMenu
if nPopup > 0 .and. oPopup:nOpenPopup != nPopup
oPopup:DeHilite()
oPopup:ShowPopup( nPopup )
//oPopup:aItems[ nPopup]:EvalAction()
::EvalAction()
endif
endif
else
@@ -405,21 +405,14 @@ METHOD ProcessKey( nKey ) CLASS TDbMenu
return nil
function __dbgAltToKey( nKey )
local nIndex
local cChar
cChar := Chr( nKey )
if IsAlpha( cChar )
return Upper( cChar )
else
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 }, nKey )
endif
return iif( nIndex > 0, SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ", nIndex, 1 ), "" )
return iif( nIndex > 0, SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ", nIndex, 1 ), "" )

349
harbour/source/debug/dbgwa.prg Normal file
View File

@@ -0,0 +1,349 @@
/*
* Harbour Project source code:
* The Debugger Array Inspector
*
* Copyright 2001 Ignacio Ortiz de Zuñiga <ignacio@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "setcurs.ch"
#include "inkey.ch"
function __dbgShowWorkAreas( oDebugger )
local oDlg, oCol
local aAlias, aBrw, aStruc, aInfo
local cColor
local n1, n2, n3
aAlias := {}
aBrw := Array(3)
n1 := 1
n2 := 1
n3 := 1
cColor := "N/W, N/BG, R/W, R/BG"
do while !Empty( Alias( n1 ) )
Aadd(aAlias, Alias( n1 ))
n1++
enddo
if len( aAlias ) == 0
Alert( "No workareas in use")
return nil
endif
/*
Window creation
*/
oDlg := TDbWindow():New( 2, 3, 21, 74, "", cColor )
oDlg:bKeyPressed := { | nKey | DlgWorkAreaKey( nKey, oDlg, aBrw, aAlias, @aStruc, @aInfo ) }
oDlg:bPainted := { || DlgWorkAreaPaint( oDlg, aBrw ) }
/*
Alias browse
*/
aBrw[1] := TBrowseNew( oDlg:nTop + 1, oDlg:nLeft + 1, oDlg:nBottom - 1, oDlg:nLeft + 11 )
aBrw[1]:Cargo := ( n1 := Select() )
aBrw[1]:ColorSpec := oDlg:cColor
aBrw[1]:GoTopBlock := { || n1 := 1 }
aBrw[1]:GoBottomBlock := { || n1 := Len( aAlias ) }
aBrw[1]:SkipBlock := { | nSkip, nPos | nPos := n1,;
n1 := iif( nSkip > 0, Min( Len( aAlias ), n1 + nSkip ),;
Max( 1, n1 + nSkip ) ), n1 - nPos }
aBrw[1]:AddColumn( oCol := TBColumnNew( "", { || PadR( aAlias[ n1 ], 11 ) } ) )
oCol:ColorBlock := { || iif( aAlias[ n1 ] == Alias(), {3, 4}, {1, 2} ) }
/*
Info Browse
*/
aInfo := ( aAlias[n1] )->(DbfInfo())
aBrw[2] := TBrowseNew( oDlg:nTop + 7, oDlg:nLeft + 13, oDlg:nBottom - 1, oDlg:nLeft + 50 )
aBrw[2]:Cargo := ( n2 := 1 )
aBrw[2]:ColorSpec := oDlg:cColor
aBrw[2]:GoTopBlock := { || n2 := 1 }
aBrw[2]:GoBottomBlock := { || n2 := Len( aInfo ) }
aBrw[2]:SkipBlock := { | nSkip, nPos | nPos := n2,;
n2 := iif( nSkip > 0, Min( Len( aInfo ), n2 + nSkip ),;
Max( 1, n2 + nSkip ) ), n2 - nPos }
aBrw[2]:AddColumn( oCol := TBColumnNew( "", { || Padr(aInfo[ n2 ], 38) } ) )
oCol:ColorBlock := { || iif( aAlias[ n1 ] == Alias() .and. n2 == 1, {3, 4}, {1, 2} ) }
/*
Struc browse
*/
aStruc := ( aAlias[n1] )->(DbStruct())
aBrw[3] := TBrowseNew( oDlg:nTop + 1, oDlg:nLeft + 52, oDlg:nBottom - 1, oDlg:nLeft + 70 )
aBrw[3]:Cargo := 1
aBrw[3]:ColorSpec := oDlg:cColor
aBrw[3]:GoTopBlock := { || n3 := 1 }
aBrw[3]:GoBottomBlock := { || n3 := Len( aStruc ) }
aBrw[3]:SkipBlock := { | nSkip, nPos | nPos := n3,;
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 ) } ) )
/*
Show dialog
*/
oDlg:ShowModal()
return nil
static function DlgWorkAreaPaint( oDlg, aBrw )
/*
Display captions
*/
DispOutAt( oDlg:nTop, oDlg:nLeft + 5 , " Area ", oDlg:cColor )
DispOutAt( oDlg:nTop, oDlg:nLeft + 28 , " Status ", oDlg:cColor )
DispOutAt( oDlg:nTop, oDlg:nLeft + 56 , " Structure ", oDlg:cColor )
/*
Display separator lines
*/
@ oDlg:nTop + 1, oDlg:nLeft + 12 TO ;
oDlg:nBottom - 1, oDlg:nLeft + 12 ;
COLOR oDlg:cColor
DispOutAt( oDlg:nTop , oDlg:nLeft + 12 , Chr( 194 ), oDlg:cColor )
DispOutAt( oDlg:nBottom , oDlg:nLeft + 12 , Chr( 193 ), oDlg:cColor )
@ oDlg:nTop + 1, oDlg:nLeft + 51 TO ;
oDlg:nBottom - 1, oDlg:nLeft + 51 ;
COLOR oDlg:cColor
DispOutAt( oDlg:nTop , oDlg:nLeft + 51 , Chr( 194 ), oDlg:cColor )
DispOutAt( oDlg:nBottom , oDlg:nLeft + 51 , Chr( 193 ), oDlg:cColor )
@ oDlg:nTop + 6, oDlg:nLeft + 13 TO ;
oDlg:nTop + 6, oDlg:nLeft + 50 ;
COLOR oDlg:cColor
DispOutAt( oDlg:nTop + 6 , oDlg:nLeft + 12 , Chr( 195 ), oDlg:cColor )
DispOutAt( oDlg:nTop + 6 , oDlg:nLeft + 51 , Chr( 180 ), oDlg:cColor )
/*
Display labels
*/
DispOutAt( oDlg:nTop + 1 , oDlg:nLeft + 13 , "Alias: Record: ", oDlg:cColor )
DispOutAt( oDlg:nTop + 2 , oDlg:nLeft + 13 , " BOF: Deleted: ", oDlg:cColor )
DispOutAt( oDlg:nTop + 3 , oDlg:nLeft + 13 , " EOF: Found: ", oDlg:cColor )
DispOutAt( oDlg:nTop + 4 , oDlg:nLeft + 13 , "Filter: ", oDlg:cColor )
DispOutAt( oDlg:nTop + 5 , oDlg:nLeft + 13 , " Key: ", oDlg:cColor )
/*
Estabilizar browse
*/
aBrw[1]:ForceStable()
aBrw[2]:ForceStable()
aBrw[3]:ForceStable()
aBrw[2]:Dehilite()
aBrw[3]:Dehilite()
UpdateInfo(oDlg, Alias())
return nil
static function DlgWorkAreaKey( nKey, oDlg, aBrw, aAlias, aStruc, aInfo )
static nFocus := 1
local nAlias
if nKey == K_TAB .or. nKey == K_SH_TAB
aBrw[nFocus]:Dehilite()
nFocus := nFocus + iif( nKey == K_TAB, 1, -1)
if nFocus < 1
nFocus := 3
endif
if nFocus > 3
nFocus := 1
endif
aBrw[nFocus]:Hilite()
return nil
endif
do case
case nFocus == 1
nAlias := aBrw[1]:Cargo
WorkAreasKeyPressed( nKey, aBrw[1], oDlg, len( aAlias ) )
if nAlias != aBrw[1]:Cargo
aBrw[2]:GoTop()
aBrw[2]:Invalidate()
aBrw[2]:ForceStable()
aInfo := ( aAlias[aBrw[1]:Cargo] )->(DbfInfo( aInfo ))
aBrw[3]:Configure()
aBrw[2]:Invalidate()
aBrw[2]:RefreshAll()
aBrw[2]:ForceStable()
aBrw[2]:Dehilite()
aBrw[3]:GoTop()
aBrw[3]:Invalidate()
aBrw[3]:ForceStable()
aStruc := ( aAlias[aBrw[1]:Cargo] )->(DbStruct())
aBrw[3]:Configure()
aBrw[3]:Invalidate()
aBrw[3]:RefreshAll()
aBrw[3]:ForceStable()
aBrw[3]:Dehilite()
UpdateInfo( oDlg, aAlias[aBrw[1]:Cargo] )
endif
case nFocus == 2
WorkAreasKeyPressed( nKey, aBrw[2], oDlg, len( aInfo ) )
case nFocus == 3
WorkAreasKeyPressed( nKey, aBrw[3], oDlg, len( aStruc ) )
end case
return nil
static procedure WorkAreasKeyPressed( nKey, oBrw, oDlg, nTotal )
do case
case nKey == K_UP
if oBrw:Cargo > 1
oBrw:Cargo--
oBrw:RefreshCurrent()
oBrw:Up()
oBrw:ForceStable()
endif
case nKey == K_DOWN
if oBrw:Cargo < nTotal
oBrw:Cargo++
oBrw:RefreshCurrent()
oBrw:Down()
oBrw:ForceStable()
endif
case nKey == K_HOME
if oBrw:Cargo > 1
oBrw:Cargo := 1
oBrw:GoTop()
oBrw:ForceStable()
endif
case nKey == K_END
if oBrw:Cargo < nTotal
oBrw:Cargo := nTotal
oBrw:GoBottom()
oBrw:ForceStable()
endif
endcase
return
static function DbfInfo( aInfo )
local nFor
local xType, xValue, cValue
aInfo := {}
Aadd(aInfo, "["+ltrim( str( Select(Alias()) ) ) + "] " + Alias())
Aadd(aInfo, Space( 4 ) + "Current Driver")
Aadd(aInfo, Space( 8 ) + RddName())
Aadd(aInfo, Space( 4 ) + "Workarea Information")
Aadd(aInfo, Space( 8 ) + "Select Area: " + ltrim( str( Select() ) ) )
Aadd(aInfo, Space( 8 ) + "Record Size: " + ltrim( str( Recsize() ) ) )
Aadd(aInfo, Space( 8 ) + "Header Size: " + ltrim( str( Header() ) ) )
Aadd(aInfo, Space( 8 ) + "Field Count: " + ltrim( str( Fcount() ) ) )
Aadd(aInfo, Space( 8 ) + "Last Update: " + Dtoc( lUpdate() ) )
Aadd(aInfo, Space( 8 ) + "Index order: " + ltrim( str( IndexOrd() ) ) )
Aadd(aInfo, Space( 4 ) + "Current Record")
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"
end case
Aadd(aInfo, Space( 8 ) + Padr(FieldName( nFor ), 10) + " = " + Padr( cValue , 17 ) )
next
return aInfo
static function UpdateInfo( oDlg, cAlias )
local cOldAlias := Alias()
SELECT (cAlias)
DispOutAt( oDlg:nTop + 1 , oDlg:nLeft + 20 , Padr( cAlias, 11 ), oDlg:cColor )
DispOutAt( oDlg:nTop + 1 , oDlg:nLeft + 42 ,;
Padr( ltrim( str( Recno() ) ) + "/" + ltrim( str( LastRec() ) ), 9 ),;
oDlg:cColor )
DispOutAt( oDlg:nTop + 2 , oDlg:nLeft + 21 , iif( Bof(),"Yes" , "No "), oDlg:cColor )
DispOutAt( oDlg:nTop + 2 , oDlg:nLeft + 38 , iif( Deleted(),"Yes" , "No "), oDlg:cColor )
DispOutAt( oDlg:nTop + 3 , oDlg:nLeft + 21 , iif( Bof(),"Yes" , "No "), oDlg:cColor )
DispOutAt( oDlg:nTop + 3 , oDlg:nLeft + 38 , iif( Found(),"Yes" , "No "), oDlg:cColor )
DispOutAt( oDlg:nTop + 4 , oDlg:nLeft + 21 , Padr( DbFilter(), 29 ), oDlg:cColor )
DispOutAt( oDlg:nTop + 4 , oDlg:nLeft + 21 , Padr( OrdKey(), 29 ), oDlg:cColor )
SELECT (cOldAlias)
return nil

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

@@ -216,6 +216,7 @@ CLASS TDebugger
METHOD FindPrevious()
METHOD SearchLine()
METHOD ToggleCaseSensitive() INLINE ::lCaseSensitive := !::lCaseSensitive
METHOD ShowWorkAreas() INLINE __dbgShowWorkAreas( Self )
ENDCLASS
@@ -750,7 +751,7 @@ METHOD LoadVars() CLASS TDebugger // updates monitored variables
AAdd( ::aVars, { cName, xValue, "Private" } )
next
if Type( "__DbgStatics" ) != "L"
if Type( "__DbgStatics" ) == "A"
for n = 1 to Len( __DbgStatics )
for m = 1 to Len( __DbgStatics[ n ][ 2 ] )
cStaticName = __DbgStatics[ n ][ 2 ][ m ]