From 41057bbe2ce2dd678783f934c78d7758fef59dc0 Mon Sep 17 00:00:00 2001 From: Ignacio Ortiz de Zuniga Date: Thu, 8 Feb 2001 16:25:41 +0000 Subject: [PATCH] *** empty log message *** --- harbour/makefile.bc | 11 +- harbour/source/debug/dbgtmenu.prg | 17 +- harbour/source/debug/dbgwa.prg | 349 ++++++++++++++++++++++++++++++ harbour/source/debug/debugger.prg | 3 +- 4 files changed, 365 insertions(+), 15 deletions(-) create mode 100644 harbour/source/debug/dbgwa.prg diff --git a/harbour/makefile.bc b/harbour/makefile.bc index 836c166e7f..906b78eabb 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -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$@ $** - diff --git a/harbour/source/debug/dbgtmenu.prg b/harbour/source/debug/dbgtmenu.prg index 51d6a12c26..e27f7c8099 100644 --- a/harbour/source/debug/dbgtmenu.prg +++ b/harbour/source/debug/dbgtmenu.prg @@ -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 ), "" ) \ No newline at end of file +return iif( nIndex > 0, SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ", nIndex, 1 ), "" ) + diff --git a/harbour/source/debug/dbgwa.prg b/harbour/source/debug/dbgwa.prg new file mode 100644 index 0000000000..7a09148a27 --- /dev/null +++ b/harbour/source/debug/dbgwa.prg @@ -0,0 +1,349 @@ +/* + * Harbour Project source code: + * The Debugger Array Inspector + * + * Copyright 2001 Ignacio Ortiz de Zuņiga + * 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 diff --git a/harbour/source/debug/debugger.prg b/harbour/source/debug/debugger.prg index f2432cc394..02de6a57d6 100644 --- a/harbour/source/debug/debugger.prg +++ b/harbour/source/debug/debugger.prg @@ -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 ]