From 7ace63cd2e0a9948c30cce25d30807296529c305 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Sun, 9 Sep 2007 17:42:53 +0000 Subject: [PATCH] 2007-09-09 19:38 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * include/setcurs.ch * include/hbapigt.h * SC_UNDEF moved to .prg level. ! SC_* defs not duplicated on C level. * include/hbcompat.ch + Added debugger class compatibility translations. * source/rtl/tmenusys.prg * source/rtl/menusys.prg * Formatting. * source/rtl/teditor.prg * source/debug/debugger.prg + Added :RowPow(), :ColPos(), :IsWordWrap(), :WordWrapCol() ! Changed debugger to use the above methods instead of direct instance var access. * source/rtl/tbcolumn.prg * source/rtl/tget.prg * source/rtl/tbrowse.prg ! Public class initializator names hidden when in strict (and non-XPP) mode. * source/rtl/tbrowse.prg + Some work in progress towards better C5.x compatibility (borrowed from xhb) * source/rtl/getsys.prg * source/rtl/tgetlist.prg + (Better) C5.3 message line support, several 5.3 fixes, some of them borrowed from xhb. * include/hbcompat.ch * source/debug/dbgtobj.prg * source/debug/dbgbrwsr.prg * source/debug/dbgtwin.prg * source/debug/dbgmenu.prg * source/debug/dbgthsh.prg * source/debug/tbrwtext.prg * source/debug/dbgwa.prg * source/debug/debugger.prg * source/debug/dbghelp.prg * source/debug/dbgtarr.prg * source/debug/dbgtmenu.prg * source/debug/dbgtmitm.prg ! Class names named to be in the Harbour namespace. xhb compatibility translations added to hbcompat.ch ! Unneeded BEGINDUMP and .h inclusions removed. ! Added :End() to HBBrwText to avoid using some internals vars of the class. ! Fixed problem with HBDebugger:SaveAppScreen() where it crashed due to wrong initialization of TBrowse() screen coordinates. Bug appeared due to the now more compatible TBrowse() behaviour. % Optimizations and cleanups. % Unused vars/functions removed. * Formatting (except large parts of debugger.prg and those files which were okey). ; Majority of formatting, optimization and code cleanup work is still left to do. Please test as much as you can. --- harbour/ChangeLog | 63 + harbour/include/hbapigt.h | 8 - harbour/include/hbcompat.ch | 38 +- harbour/include/setcurs.ch | 1 + harbour/source/debug/dbgbrwsr.prg | 27 +- harbour/source/debug/dbghelp.prg | 298 +-- harbour/source/debug/dbgmenu.prg | 14 +- harbour/source/debug/dbgtarr.prg | 424 ++-- harbour/source/debug/dbgthsh.prg | 467 ++-- harbour/source/debug/dbgtmenu.prg | 85 +- harbour/source/debug/dbgtmitm.prg | 35 +- harbour/source/debug/dbgtobj.prg | 513 ++--- harbour/source/debug/dbgtwin.prg | 263 ++- harbour/source/debug/dbgwa.prg | 381 ++-- harbour/source/debug/debugger.prg | 3372 +++++++++++++++-------------- harbour/source/debug/tbrwtext.prg | 267 ++- harbour/source/rtl/getsys.prg | 144 +- harbour/source/rtl/menusys.prg | 43 +- harbour/source/rtl/tbcolumn.prg | 4 + harbour/source/rtl/tbrowse.prg | 53 +- harbour/source/rtl/teditor.prg | 16 + harbour/source/rtl/tget.prg | 6 +- harbour/source/rtl/tgetlist.prg | 1355 ++++++------ harbour/source/rtl/tmenusys.prg | 60 +- 24 files changed, 4125 insertions(+), 3812 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index f829f444d2..fc25ccdcb9 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,69 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-09-09 19:38 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * include/setcurs.ch + * include/hbapigt.h + * SC_UNDEF moved to .prg level. + ! SC_* defs not duplicated on C level. + + * include/hbcompat.ch + + Added debugger class compatibility translations. + + * source/rtl/tmenusys.prg + * source/rtl/menusys.prg + * Formatting. + + * source/rtl/teditor.prg + * source/debug/debugger.prg + + Added :RowPow(), :ColPos(), :IsWordWrap(), :WordWrapCol() + ! Changed debugger to use the above methods instead of direct + instance var access. + + * source/rtl/tbcolumn.prg + * source/rtl/tget.prg + * source/rtl/tbrowse.prg + ! Public class initializator names hidden when in strict + (and non-XPP) mode. + + * source/rtl/tbrowse.prg + + Some work in progress towards better C5.x compatibility + (borrowed from xhb) + + * source/rtl/getsys.prg + * source/rtl/tgetlist.prg + + (Better) C5.3 message line support, several 5.3 fixes, + some of them borrowed from xhb. + + * include/hbcompat.ch + * source/debug/dbgtobj.prg + * source/debug/dbgbrwsr.prg + * source/debug/dbgtwin.prg + * source/debug/dbgmenu.prg + * source/debug/dbgthsh.prg + * source/debug/tbrwtext.prg + * source/debug/dbgwa.prg + * source/debug/debugger.prg + * source/debug/dbghelp.prg + * source/debug/dbgtarr.prg + * source/debug/dbgtmenu.prg + * source/debug/dbgtmitm.prg + ! Class names named to be in the Harbour namespace. + xhb compatibility translations added to hbcompat.ch + ! Unneeded BEGINDUMP and .h inclusions removed. + ! Added :End() to HBBrwText to avoid using some + internals vars of the class. + ! Fixed problem with HBDebugger:SaveAppScreen() + where it crashed due to wrong initialization + of TBrowse() screen coordinates. Bug appeared + due to the now more compatible TBrowse() behaviour. + % Optimizations and cleanups. + % Unused vars/functions removed. + * Formatting (except large parts of debugger.prg and + those files which were okey). + ; Majority of formatting, optimization and code cleanup + work is still left to do. + 2007-09-08 15:15 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/dbinfo.ch * updated comment diff --git a/harbour/include/hbapigt.h b/harbour/include/hbapigt.h index d9c275af9e..8620536ed2 100644 --- a/harbour/include/hbapigt.h +++ b/harbour/include/hbapigt.h @@ -80,14 +80,6 @@ HB_EXTERN_BEGIN #include "setcurs.ch" #include "hbgtinfo.ch" -/* Cursor style constants */ -#define SC_UNDEF -1 /* undefined */ -#define SC_NONE 0 /* None */ -#define SC_NORMAL 1 /* Underline */ -#define SC_INSERT 2 /* Lower half block */ -#define SC_SPECIAL1 3 /* Full block */ -#define SC_SPECIAL2 4 /* Upper half block */ - /* maximum length of color string */ #define CLR_STRLEN 64 diff --git a/harbour/include/hbcompat.ch b/harbour/include/hbcompat.ch index 0053c28307..229f6ee7dc 100644 --- a/harbour/include/hbcompat.ch +++ b/harbour/include/hbcompat.ch @@ -83,7 +83,17 @@ #xtranslate HB_RASCAN([]) => RASCAN() - #xtranslate HB_ISPOINTER( ) => ISPOINTER( ) + #xtranslate HB_ISPOINTER( )=> ISPOINTER( ) + + #xtranslate HBDebugger() => TDebugger() + #xtranslate HBBrwText() => TBrwText() + #xtranslate HBDbMenu() => TDbMenu() + #xtranslate HBDbMenuItem() => TDbMenuItem() + #xtranslate HBDbWindow() => TDbWindow() + #xtranslate HBDbBrowse() => TDBGBrowser() + #xtranslate HBDbArray() => TDBGArray() + #xtranslate HBDbHash() => TDBGHash() + #xtranslate HBDbObject() => TDBGobject() #else @@ -165,14 +175,24 @@ #xcommand > [<*x*>] => } /* xHarbour operators: IN, HAS, LIKE, >>, <<, |, &, ^^ */ - #translate ( IN ) => ( () $ () ) - #translate ( HAS ) => ( HB_REGEXHAS( (), () ) ) - #translate ( LIKE ) => ( HB_REGEXLIKE( (), () ) ) - #translate ( \<\< ) => ( HB_BITSHIFT( (), () ) ) - #translate ( >> ) => ( HB_BITSHIFT( (), -() ) ) - #translate ( | ) => ( HB_BITOR( (), () ) ) - #translate ( & ) => ( HB_BITAND( (), () ) ) - #translate ( ^^ ) => ( HB_BITXOR( (), () ) ) + #translate ( IN ) => ( () $ () ) + #translate ( HAS ) => ( HB_REGEXHAS( (), () ) ) + #translate ( LIKE ) => ( HB_REGEXLIKE( (), () ) ) + #translate ( \<\< ) => ( HB_BITSHIFT( (), () ) ) + #translate ( >> ) => ( HB_BITSHIFT( (), -() ) ) + #translate ( | ) => ( HB_BITOR( (), () ) ) + #translate ( & ) => ( HB_BITAND( (), () ) ) + #translate ( ^^ ) => ( HB_BITXOR( (), () ) ) + + #xtranslate TDebugger() => HBDebugger() + #xtranslate TBrwText() => HBBrwText() + #xtranslate TDbMenu() => HBDbMenu() + #xtranslate TDbMenuItem() => HBDbMenuItem() + #xtranslate TDbWindow() => HBDbWindow() + #xtranslate TDBGBrowser() => HBDbBrowse() + #xtranslate TDBGArray() => HBDbArray() + #xtranslate TDBGHash() => HBDbHash() + #xtranslate TDBGobject() => HBDbObject() #endif diff --git a/harbour/include/setcurs.ch b/harbour/include/setcurs.ch index 3659faab23..04e00ac9f2 100644 --- a/harbour/include/setcurs.ch +++ b/harbour/include/setcurs.ch @@ -53,6 +53,7 @@ #ifndef _SETCURS_CH #define _SETCURS_CH +#define SC_UNDEF -1 /* NOTE: This is a Harbour extension. */ #define SC_NONE 0 #define SC_NORMAL 1 #define SC_INSERT 2 diff --git a/harbour/source/debug/dbgbrwsr.prg b/harbour/source/debug/dbgbrwsr.prg index 8795096c04..62324c239d 100644 --- a/harbour/source/debug/dbgbrwsr.prg +++ b/harbour/source/debug/dbgbrwsr.prg @@ -52,44 +52,45 @@ #include "hbclass.ch" -CLASS TDbgBrowser FROM TBrowse // Debugger browser +CREATE CLASS HBDbBrowser FROM TBrowse // Debugger browser - DATA Window + VAR Window METHOD New( nTop, nLeft, nBottom, nRight, oParentWindow ) METHOD Resize( nTop, nLeft, nBottom, nRight ) - METHOD ForceStable() INLINE IIf( ::RowCount > 0, ::Super:ForceStable(), ) - METHOD RefreshAll() INLINE IIf( ::RowCount > 0, ::Super:RefreshAll(), ) + METHOD ForceStable() INLINE iif( ::RowCount > 0, ::Super:ForceStable(), ) + METHOD RefreshAll() INLINE iif( ::RowCount > 0, ::Super:RefreshAll(), ) ENDCLASS -METHOD New( nTop, nLeft, nBottom, nRight, oParentWindow ) CLASS TDbgBrowser +METHOD New( nTop, nLeft, nBottom, nRight, oParentWindow ) CLASS HBDbBrowser ::Window := oParentWindow ::super:New( nTop, nLeft, nBottom, nRight ) -RETURN Self + RETURN Self METHOD Resize( nTop, nLeft, nBottom, nRight ) -LOCAL lResize:=.F. + LOCAL lResize := .F. - IF( nTop != NIL .AND. nTop != ::nTop ) + IF nTop != NIL .AND. nTop != ::nTop ::nTop := nTop lResize := .T. ENDIF - IF( nLeft != NIL .AND. nLeft != ::nLeft ) + IF nLeft != NIL .AND. nLeft != ::nLeft ::nLeft := nLeft lResize := .T. ENDIF - IF( nBottom != NIL .AND. nBottom != ::nBottom ) + IF nBottom != NIL .AND. nBottom != ::nBottom ::nBottom := nBottom lResize := .T. ENDIF - IF( nRight != NIL .AND. nRight != ::nRight ) + IF nRight != NIL .AND. nRight != ::nRight ::nRight := nRight lResize := .T. ENDIF - IF( lResize ) + + IF lResize /* The following check prevents a "High limit exceeded" error. Maybe it * would be wiser to make TBrowse handle height of 0 rows -- Ph.K. */ IF ::nBottom >= ::nTop @@ -97,4 +98,4 @@ LOCAL lResize:=.F. ENDIF ENDIF -RETURN self + RETURN self diff --git a/harbour/source/debug/dbghelp.prg b/harbour/source/debug/dbghelp.prg index 59c38e6172..1d81f3dcfa 100644 --- a/harbour/source/debug/dbghelp.prg +++ b/harbour/source/debug/dbghelp.prg @@ -55,176 +55,186 @@ * */ +/* NOTE: Don't use SAY/DevOut()/DevPos() for screen output, otherwise + the debugger output may interfere with the applications output + redirection, and is also slower. [vszakats] */ + #include "common.ch" #include "inkey.ch" -function __dbgHelp( nTopic ) +FUNCTION __dbgHelp( nTopic ) - local oDlg - local cColor := If( __Dbg():lMonoDisplay, "N/W, W/N, W+/W, W+/N",; - "N/W, N/BG, R/W, R/BG" ) - local oBrw, aTopics := GetTopics() + LOCAL oDlg + LOCAL cColor := iif( __Dbg():lMonoDisplay, "N/W, W/N, W+/W, W+/N", "N/W, N/BG, R/W, R/BG" ) + LOCAL oBrw + LOCAL aTopics := GetTopics() DEFAULT nTopic TO 1 - oDlg = TDbWindow():New( 2, 2, MaxRow() - 2, MaxCol() - 2, "Help", cColor ) + oDlg := HBDbWindow():New( 2, 2, MaxRow() - 2, MaxCol() - 2, "Help", cColor ) - oBrw = TBrowseNew( oDlg:nTop + 1, oDlg:nLeft + 1, oDlg:nBottom - 1,; - oDlg:nLeft + 12 ) - oBrw:Cargo = 1 + oBrw := TBrowseNew( oDlg:nTop + 1, oDlg:nLeft + 1, oDlg:nBottom - 1, oDlg:nLeft + 12 ) + oBrw:Cargo := 1 oBrw:AddColumn( TBColumnNew( "", { || aTopics[ oBrw:Cargo ][ 1 ] }, 12 ) ) - oBrw:ColorSpec = StrTran( __Dbg():ClrModal(), ", R/W", "" ) - oBrw:SkipBlock = { | nSkip, nOld | nOld := oBrw:Cargo, oBrw:Cargo += nSkip,; + 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 ) ),; oBrw:Cargo - nOld } - oBrw:GoTopBlock = { || oBrw:Cargo := 1 } - oBrw:GoBottomBlock = { || oBrw:Cargo := Len( aTopics ) } + oBrw:GoTopBlock := { || oBrw:Cargo := 1 } + oBrw:GoBottomBlock := { || oBrw:Cargo := Len( aTopics ) } - if nTopic > 1 + IF nTopic > 1 Eval( oBrw:SkipBlock, nTopic - 1 ) - endif + ENDIF - oDlg:bPainted = { || PaintWindow( oDlg, oBrw, aTopics ) } - oDlg:bKeyPressed = { | nKey | ProcessKey( nKey, oDlg, oBrw, aTopics, oDlg:cColor ) } + oDlg:bPainted := { || PaintWindow( oDlg, oBrw, aTopics ) } + oDlg:bKeyPressed := { | nKey | ProcessKey( nKey, oDlg, oBrw, aTopics, oDlg:cColor ) } oDlg:ShowModal() -return nil + RETURN NIL -static procedure PaintWindow( oDlg, oBrw, aTopics ) - - @ oDlg:nTop + 1, oDlg:nLeft + 13 TO ; - oDlg:nBottom - 1, oDlg:nLeft + 13 ; - COLOR oDlg:cColor +STATIC PROCEDURE PaintWindow( oDlg, oBrw, aTopics ) + DispBox( oDlg:nTop + 1, oDlg:nLeft + 13, oDlg:nBottom - 1, oDlg:nLeft + 13, 1, oDlg:cColor ) DispOutAt( oDlg:nTop , oDlg:nLeft + 13 , Chr( 194 ), oDlg:cColor ) DispOutAt( oDlg:nBottom , oDlg:nLeft + 13 , Chr( 193 ), oDlg:cColor ) oBrw:ForceStable() ShowTopic( oDlg, aTopics, oBrw:Cargo, 0 ) // Start on page 1 -return + RETURN -static procedure ProcessKey( nKey, oDlg, oBrw, aTopics ) +STATIC PROCEDURE ProcessKey( nKey, oDlg, oBrw, aTopics ) - local n, nSkip + LOCAL n + LOCAL nSkip - do case - case nKey == K_UP - if oBrw:Cargo > 1 - oBrw:Up() - oBrw:ForceStable() - ShowTopic( oDlg, aTopics, oBrw:Cargo, 0 ) // Start on page 1 - endif + DO CASE + CASE nKey == K_UP - case nKey == K_DOWN - if oBrw:Cargo < Len( aTopics ) - oBrw:Down() - oBrw:ForceStable() - ShowTopic( oDlg, aTopics, oBrw:Cargo, 0 ) // Start on page 1 - endif + IF oBrw:Cargo > 1 + oBrw:Up() + oBrw:ForceStable() + ShowTopic( oDlg, aTopics, oBrw:Cargo, 0 ) // Start on page 1 + ENDIF - case nKey == K_HOME - if oBrw:Cargo > 1 - oBrw:GoTop() - oBrw:ForceStable() - ShowTopic( oDlg, aTopics, oBrw:Cargo, 0 ) // Start on page 1 - endif + CASE nKey == K_DOWN - case nKey == K_END - if oBrw:Cargo < Len( aTopics ) - oBrw:GoBottom() - oBrw:ForceStable() - ShowTopic( oDlg, aTopics, oBrw:Cargo, 0 ) // Start on page 1 - endif + IF oBrw:Cargo < Len( aTopics ) + oBrw:Down() + oBrw:ForceStable() + ShowTopic( oDlg, aTopics, oBrw:Cargo, 0 ) // Start on page 1 + ENDIF - case nKey == K_PGUP .OR. nKey == K_CTRL_B - ShowTopic( oDlg, aTopics, oBrw:Cargo, -1 ) // Skip to prev page + CASE nKey == K_HOME - case nKey == K_PGDN .OR. nKey == K_CTRL_F .OR. nKey == K_SPACE - ShowTopic( oDlg, aTopics, oBrw:Cargo, 1 ) // Skip to next page + IF oBrw:Cargo > 1 + oBrw:GoTop() + oBrw:ForceStable() + ShowTopic( oDlg, aTopics, oBrw:Cargo, 0 ) // Start on page 1 + ENDIF - case nKey == K_LBUTTONDOWN - if ( nSkip := MRow() - oDlg:nTop - oBrw:RowPos ) != 0 - if nSkip > 0 - for n = 1 to nSkip - oBrw:Down() - oBrw:Stabilize() - next - else - for n = 1 to nSkip + 2 step -1 - oBrw:Up() - oBrw:Stabilize() - next - endif - oBrw:ForceStable() - ShowTopic( oDlg, aTopics, oBrw:Cargo, 0 ) // Start on page 1 - endif - endcase + CASE nKey == K_END -return + IF oBrw:Cargo < Len( aTopics ) + oBrw:GoBottom() + oBrw:ForceStable() + ShowTopic( oDlg, aTopics, oBrw:Cargo, 0 ) // Start on page 1 + ENDIF -procedure ShowTopic( oDlg, aTopics, nTopic, nPageOp ) + CASE nKey == K_PGUP .OR. nKey == K_CTRL_B - local n - local nRows := oDlg:nBottom - oDlg:nTop - 1 - local nPages := Len( aTopics[ nTopic ][ 2 ] ) / nRows - local nRowsToPaint + ShowTopic( oDlg, aTopics, oBrw:Cargo, -1 ) // Skip to prev page - static nPage + CASE nKey == K_PGDN .OR. nKey == K_CTRL_F .OR. nKey == K_SPACE - if nPages > 1 .and. Int( nPages ) < nPages - nPages = Int( nPages ) + 1 - endif + ShowTopic( oDlg, aTopics, oBrw:Cargo, 1 ) // Skip to next page - if nPages == 1 - if nPageOp == -1 .or. nPageOp == 1 - return - endif - nPage = 1 - else - do case - case nPageOp == 0 // Show first page - nPage = 1 + CASE nKey == K_LBUTTONDOWN - case nPageOp == 1 // Show next page - if nPage < nPages - nPage++ - else - return - endif + IF ( nSkip := MRow() - oDlg:nTop - oBrw:RowPos ) != 0 + IF nSkip > 0 + FOR n := 1 TO nSkip + oBrw:Down() + oBrw:Stabilize() + NEXT + ELSE + FOR n := 1 TO nSkip + 2 STEP -1 + oBrw:Up() + oBrw:Stabilize() + NEXT + ENDIF + oBrw:ForceStable() + ShowTopic( oDlg, aTopics, oBrw:Cargo, 0 ) // Start on page 1 + ENDIF - case nPageOp == -1 // Show prev page - if nPage > 1 - nPage-- - else - return - endif - endcase - endif + ENDCASE - @ oDlg:nTop + 1, oDlg:nLeft + 14 CLEAR TO oDlg:nBottom - 1,; - oDlg:nRight - 1 + RETURN - nRowsToPaint = Min( nRows, Len( aTopics[ nTopic ][ 2 ] ) - ( ( nPage - 1 ) * ; - nRows ) ) +STATIC PROCEDURE ShowTopic( oDlg, aTopics, nTopic, nPageOp ) - for n = 1 to nRowsToPaint - @ 2 + n, 16 SAY aTopics[ nTopic ][ 2 ][ ( ( nPage - 1 ) * nRows ) + n ] - next + STATIC s_nPage - if Len( aTopics[ nTopic ][ 2 ] ) <= nRows - @ oDlg:nBottom, oDlg:nRight - 16 SAY " Page 1 of 1 " - else - @ oDlg:nBottom, oDlg:nRight - 16 SAY " Page " + Str( nPage, 1 ) + " of " + ; - Str( nPages, 1 ) + " " - endif + LOCAL nRows := oDlg:nBottom - oDlg:nTop - 1 + LOCAL nPages := Len( aTopics[ nTopic ][ 2 ] ) / nRows + LOCAL nRowsToPaint + LOCAL n -return + IF nPages > 1 .AND. Int( nPages ) < nPages + nPages := Int( nPages ) + 1 + ENDIF -static function GetTopics() + IF nPages == 1 + IF nPageOp == -1 .OR. nPageOp == 1 + RETURN + ENDIF + s_nPage := 1 + ELSE + DO CASE + CASE nPageOp == 0 // Show first page - local aTopics := { { "About Help ", },; + s_nPage := 1 + + CASE nPageOp == 1 // Show next page + + IF s_nPage < nPages + s_nPage++ + ELSE + RETURN + ENDIF + + CASE nPageOp == -1 // Show prev page + + IF s_nPage > 1 + s_nPage-- + ELSE + RETURN + ENDIF + + ENDCASE + ENDIF + + Scroll( oDlg:nTop + 1, oDlg:nLeft + 14, oDlg:nBottom - 1, oDlg:nRight - 1 ) + + nRowsToPaint := Min( nRows, Len( aTopics[ nTopic ][ 2 ] ) - ( ( s_nPage - 1 ) * nRows ) ) + + FOR n := 1 TO nRowsToPaint + DispOutAt( 2 + n, 16, aTopics[ nTopic ][ 2 ][ ( ( s_nPage - 1 ) * nRows ) + n ] ) + NEXT + + IF Len( aTopics[ nTopic ][ 2 ] ) <= nRows + DispOutAt( oDlg:nBottom, oDlg:nRight - 16, " Page 1 of 1 " ) + ELSE + DispOutAt( oDlg:nBottom, oDlg:nRight - 16, " Page " + Str( s_nPage, 1 ) + " of " + Str( nPages, 1 ) + " " ) + ENDIF + + RETURN + +STATIC FUNCTION GetTopics() + + LOCAL aTopics := { { "About Help ", },; { "Keys ", },; { " Function ", },; { " Window ", },; @@ -247,13 +257,13 @@ static function GetTopics() { "Commands ", },; { "Script files", } } - aTopics[ 1 ][ 2 ] = ; + aTopics[ 1 ][ 2 ] := ; { " " + Chr( 24 ) + Chr( 25 ) + " Select help topic.",; " PageUp Page help text down.",; " PageDn Page help text down.",; " Esc Returns to debugger." } - aTopics[ 2 ][ 2 ] = ; + aTopics[ 2 ][ 2 ] := ; { "Special debugger keys fall into the following",; "categories:",; "",; @@ -270,7 +280,7 @@ static function GetTopics() "Other keys (typeable characters) are sent to",; "the Command window and treated as input text." } - aTopics[ 3 ][ 2 ] = ; + aTopics[ 3 ][ 2 ] := ; { "F1 Help",; "F2 Zoom active window",; "",; @@ -286,7 +296,7 @@ static function GetTopics() "F9 Set breakpoint on cursor line",; "F10 Trace" } - aTopics[ 4 ][ 2 ] = ; + aTopics[ 4 ][ 2 ] := ; { "Enter If input is pending in the Command window,",; " will execute the command, regardless",; " of which window is active. Otherwise, if the",; @@ -340,7 +350,7 @@ static function GetTopics() "Esc In Command window, clears command line.",; " In other windows, does nothing." } - aTopics[ 5 ][ 2 ] = ; + aTopics[ 5 ][ 2 ] := ; { "TAB Next window",; "",; "SHIFT-TAB Previous window",; @@ -357,7 +367,7 @@ static function GetTopics() "",; "ALT-X Exit" } - aTopics[ 6 ][ 2 ] = ; + aTopics[ 6 ][ 2 ] := ; { "The Debugger display consists of the following five",; "windows:",; "",; @@ -402,7 +412,7 @@ static function GetTopics() "menu option will restore the windows to their original",; "size and location." } - aTopics[ 7 ][ 2 ] = ; + aTopics[ 7 ][ 2 ] := ; { "The Command window accepts debugger commands as line",; "input, and displays the response from an executed",; "command, if any.",; @@ -418,7 +428,7 @@ static function GetTopics() "When the Command window is active, the UP and DOWN",; "arrow keys can be used to recall previous commands." } - aTopics[ 8 ][ 2 ] = ; + aTopics[ 8 ][ 2 ] := ; { "The Code window displays Clipper source code for",; "the program being debugged.",; "",; @@ -452,7 +462,7 @@ static function GetTopics() "the viewed file for a specific string, or go to a particular",; "line within it, using options found in the Locate menu." } - aTopics[ 9 ][ 2 ] = ; + aTopics[ 9 ][ 2 ] := ; { "The Watch window displays Watchpoint and Tracepoint",; "expressions, and their current values.",; "",; @@ -471,7 +481,7 @@ static function GetTopics() "activation level represented by the selected call in the",; "CallStack window." } - aTopics[ 10 ][ 2 ] = ; + aTopics[ 10 ][ 2 ] := ; { "The Monitor window displays monitored variables.",; "",; "Classes of variables may be monitored via options in the",; @@ -487,7 +497,7 @@ static function GetTopics() "activation level represented by the selected call in the",; "CallStack window." } - aTopics[ 11 ][ 2 ] = ; + aTopics[ 11 ][ 2 ] := ; { "The CallStack window displays the program's call stack.",; "It is opened and closed via the View:CallStack menu",; "option.",; @@ -505,7 +515,7 @@ static function GetTopics() "window are all in the context of the activation level",; "selected in the CallStack window." } - aTopics[ 12 ][ 2 ] = ; + aTopics[ 12 ][ 2 ] := ; { "The debugger menus contain various debugger functions.",; "",; "Each menu may be accessed at any time by pressing the",; @@ -536,7 +546,7 @@ static function GetTopics() "For more information on this class of commands, see",; "the 'Commands' section of this help." } - aTopics[ 13 ][ 2 ] = ; + aTopics[ 13 ][ 2 ] := ; { "Options:",; "",; " Open...",; @@ -548,7 +558,7 @@ static function GetTopics() " Exit Alt-X",; " Exit the debugger" } - aTopics[ 14 ][ 2 ] = ; + aTopics[ 14 ][ 2 ] := ; { "Facilites for navigating the file in the Code window",; "",; "Options:",; @@ -572,7 +582,7 @@ static function GetTopics() " Toggles case sensitivity in searches. Default is",; " OFF." } - aTopics[ 15 ][ 2 ] = ; + aTopics[ 15 ][ 2 ] := ; { "Options:",; "",; " Sets",; @@ -587,7 +597,7 @@ static function GetTopics() " CallStack",; " Toggles the CallStack window. Default is OFF" } - aTopics[ 16 ][ 2 ] = ; + aTopics[ 16 ][ 2 ] := ; { "Options:",; "",; " Restart",; @@ -617,7 +627,7 @@ static function GetTopics() " sPeed...",; " Set step speed for Animate mode execution" } - aTopics[ 17 ][ 2 ] = ; + aTopics[ 17 ][ 2 ] := ; { "Options:",; "",; " Watchpoint...",; @@ -655,7 +665,7 @@ static function GetTopics() "",; " Delete Tracepoint or Watchpoint." } - aTopics[ 18 ][ 2 ] = ; + aTopics[ 18 ][ 2 ] := ; { "Options:",; "",; " Public",; @@ -680,7 +690,7 @@ static function GetTopics() " Toggles whether monitored variables are sorted by",; " name. Default is OFF." } - aTopics[ 19 ][ 2 ] = ; + aTopics[ 19 ][ 2 ] := ; { "Options:",; "",; " Preprocessed code",; @@ -738,7 +748,7 @@ static function GetTopics() " Restore debugger settings from a previously",; " saved script file." } - aTopics[ 20 ][ 2 ] = ; + aTopics[ 20 ][ 2 ] := ; { "Options:",; "",; " Next Tab",; @@ -769,7 +779,7 @@ static function GetTopics() " Tile",; " Restore all windows to original size and position." } - aTopics[ 21 ][ 2 ] = ; + aTopics[ 21 ][ 2 ] := ; { "There are two sets of debugger commands:",; "",; "1. Menu option commands. These commands are formed",; @@ -892,7 +902,7 @@ static function GetTopics() " Establish as a Watchpoint. may be a",; " variable or expression." } - aTopics[ 22 ][ 2 ] = ; + aTopics[ 22 ][ 2 ] := ; { "Script files contain debugger commands, in the same",; "form they would take as input in the Command window.",; "By default, script files use the extension CLD, as in",; @@ -940,4 +950,4 @@ static function GetTopics() "preferences in INIT.CLD -- specifying colors,",; "turning on the CallStack window, and so on." } -return aTopics + RETURN aTopics diff --git a/harbour/source/debug/dbgmenu.prg b/harbour/source/debug/dbgmenu.prg index 56a8825f57..56068ab21e 100644 --- a/harbour/source/debug/dbgmenu.prg +++ b/harbour/source/debug/dbgmenu.prg @@ -52,18 +52,18 @@ #include "hbclass.ch" -#xcommand MENU [] => [ := ] TDbMenu():New() +#xcommand MENU [] => [ := ] HBDbMenu():New() #xcommand MENUITEM [ PROMPT ] ; [ IDENT ] [ ACTION ] ; [ CHECKED ] => ; - [ := ] TDbMenu():AddItem( TDbMenuItem():New( ,; + [ := ] HBDbMenu():AddItem( HBDbMenuItem():New( ,; [{||}], [], [] ) ) -#xcommand SEPARATOR => TDbMenu():AddItem( TDbMenuItem():New( "-" ) ) -#xcommand ENDMENU => ATail( TDbMenu():aMenus ):Build() +#xcommand SEPARATOR => HBDbMenu():AddItem( HBDbMenuItem():New( "-" ) ) +#xcommand ENDMENU => ATail( HBDbMenu():aMenus ):Build() -function __dbgBuildMenu( oDebugger ) // Builds the debugger pulldown menu +FUNCTION __dbgBuildMenu( oDebugger ) // Builds the debugger pulldown menu - local oMenu + LOCAL oMenu MENU oMenu MENUITEM " ~File " @@ -207,4 +207,4 @@ function __dbgBuildMenu( oDebugger ) // Builds the debugger pulldown menu ENDMENU -return oMenu + RETURN oMenu diff --git a/harbour/source/debug/dbgtarr.prg b/harbour/source/debug/dbgtarr.prg index c5ed93f278..66e61601de 100644 --- a/harbour/source/debug/dbgtarr.prg +++ b/harbour/source/debug/dbgtarr.prg @@ -50,70 +50,75 @@ * */ - -#include "setcurs.ch" #include "hbclass.ch" -#include "inkey.ch" + #include "common.ch" +#include "inkey.ch" +#include "setcurs.ch" -Class TDBGArray +CREATE CLASS HBDbArray -data aWindows -data TheArray -data arrayname -data nCurWindow -data lEditable -Method new -method addWindows -method doget -method SetsKeyPressed -end class + VAR aWindows INIT {} + VAR TheArray + VAR arrayname + VAR nCurWindow INIT 0 + VAR lEditable -method new(aArray,pArName,lEditable) Class TDBGArray + METHOD New( aArray, cVarName, lEditable ) - DEFAULT lEditable TO .t. + METHOD addWindows( aArray, nRow ) + METHOD doGet( oBrowse, pItem, nSet ) + METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, aArray ) - ::aWindows:={} - ::arrayName:=parName - ::TheArray:=aArray - ::nCurWindow:=0 +ENDCLASS + +METHOD New( aArray, cVarName, lEditable ) CLASS HBDbArray + + DEFAULT lEditable TO .T. + + ::arrayName := cVarName + ::TheArray := aArray ::lEditable := lEditable - ::addWindows(::TheArray) -Return Self + ::addWindows( ::TheArray ) + + RETURN Self + +METHOD addWindows( aArray, nRow ) CLASS HBDbArray + LOCAL oBrwSets + LOCAL nSize := Len( aArray ) + LOCAL oWndSets + LOCAL nWidth + LOCAL nColWidth + LOCAL oCol + + IF nSize < MaxRow() - 2 + IF nRow != NIL + oWndSets := HBDbWindow():New( GetTopPos( nRow ), 5, getBottomPos( nRow + nSize + 1 ), MaxCol() - 5, ::arrayName + "[1.." + LTrim( Str( nSize, 6 ) ) + "]", "N/W" ) + ELSE + oWndSets := HBDbWindow():New( 1, 5, 2 + nSize, MaxCol() - 5, ::arrayName + "[1.." + LTrim( Str( nSize, 6 ) ) + "]", "N/W" ) + ENDIF + ELSE + oWndSets := HBDbWindow():New( 1, 5, MaxRow() - 2, MaxCol() - 5, ::arrayName + "[1.." + LTrim( Str( nSize, 6 ) ) + "]", "N/W" ) + ENDIF -Method addWindows(aArray,nRow) Class TDBGArray -local oBrwSets,nSize:=Len(AArray) -local n:=1 -Local owndsets - local nWidth, nColWidth - local oCol - if (nsize nil - owndsets:=TDbWindow():New( GetTopPos(nRow), 5, getBottomPos(nRow+nsize+1), maxcol()-5, ::arrayName+"[1.."+alltrim(str(nsize,6))+"]" ,"N/W" ) - else - owndsets:=TDbWindow():New( 1, 5, 2+nsize, maxcol()-5, ::arrayName+"[1.."+alltrim(str(nsize,6))+"]" ,"N/W") - endif - else - owndsets:=TDbWindow():New( 1, 5, maxrow()-2, maxcol()-5, ::arrayName+"[1.."+alltrim(str(nsize,6))+"]" ,"N/W") - endif ::nCurWindow++ - oWndSets:lFocused:=.t. - aadd(::aWindows,owndsets) + oWndSets:lFocused := .T. + AAdd( ::aWindows, oWndSets ) nWidth := oWndSets:nRight - oWndSets:nLeft - 1 - oBrwSets:=TbrowseNew(owndsets:nTop+1, owndsets:nLeft+1, owndsets:nBottom-1, owndsets:nRight-1) - oBrwSets:autolite:=.f. + oBrwSets := TBrowseNew( oWndSets:nTop + 1, oWndSets:nLeft + 1, oWndSets:nBottom - 1, oWndSets:nRight - 1 ) + oBrwSets:autolite := .F. oBrwSets:ColorSpec := __Dbg():ClrModal() - oBrwSets:Cargo :={ 1,{}} // Actual highligthed row - aadd(oBrwSets:Cargo[2],aarray) + oBrwSets:Cargo := { 1, {} } // Actual highligthed row + AAdd( oBrwSets:Cargo[ 2 ], aArray ) - oBrwSets:AddColumn( ocol:= TBColumnNew("", { || ::arrayName+"["+alltrim(str(oBrwSets:cargo[ 1 ],6))+"]"} ) ) - ocol:width:=len(::arrayName+"["+alltrim(str(len(aarray),6))+"]" ) - oCol:DefColor:={1,2} + oBrwSets:AddColumn( oCol := TBColumnNew( "", { || ::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( ValToStr( aArray[oBrwSets:cargo[ 1 ] ] ), nWidth - nColWidth - 1 ) } ) ) + oBrwSets:AddColumn( oCol := TBColumnNew( "", { || 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 @@ -127,226 +132,177 @@ Local owndsets I think tbrowse should trim columns up until the point where at leat two are visible in the same moment, I leave this fix to tbrowse for the reader ;) - oCol:width:=50 + oCol:width := 50 */ - ocol:DefColor:={1,3} + oCol:defColor := { 1, 3 } - oBrwSets:GOTOPBLOCK := { || oBrwSets:cargo[ 1 ]:= 1 } - 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:goTopBlock := { || oBrwSets:cargo[ 1 ] := 1 } + 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 ) } - ::aWindows[::nCurWindow]:bPainted := { || (oBrwSets:forcestable(),RefreshVarsS(oBrwSets))} - ::aWindows[::nCurWindow]:bKeyPressed := { | nKey | ::SetsKeyPressed( nKey, oBrwSets, Len( aArray ),; - ::aWindows[::nCurWindow],::arrayName ,Len(aArray),aArray)} + ::aWindows[ ::nCurWindow ]:bPainted := { || ( oBrwSets:forcestable(), RefreshVarsS( oBrwSets ) ) } + ::aWindows[ ::nCurWindow ]:bKeyPressed := { | nKey | ::SetsKeyPressed( nKey, oBrwSets,; + ::aWindows[ ::nCurWindow ], ::arrayName, aArray ) } SetCursor( SC_NONE ) - ::aWindows[::nCurWindow]:ShowModal() -return self + ::aWindows[ ::nCurWindow ]:ShowModal() -method SetsKeyPressed( nKey, oBrwSets, nSets, oWnd ,cName,LenArr,aArray) Class TDBGArray + RETURN Self - local nSet := oBrwSets:cargo[1] - local cTemp:=str(nSet,4) - local cOldname:= ::arrayName - - HB_SYMBOL_UNUSED( nSets ) - - do case - case nKey == K_UP - oBrwSets:Up() - - case nKey == K_DOWN - oBrwSets:Down() - - case nKey == K_HOME .or. (nKey == K_CTRL_PGUP) .or. (nKey == K_CTRL_HOME) - oBrwSets:GoTop() - - case nKey == K_END .or. (nkey == K_CTRL_PGDN) .or. (nkey == K_CTRL_END ) - oBrwSets:GoBottom() - - Case nKey == K_PGDN - oBrwSets:pageDown() - - Case nKey == K_PGUP - OBrwSets:PageUp() - - Case nKey == K_ENTER - if valtype(aArray[nSet])=="A" - if Len( aArray[ nSet ] ) == 0 - Alert( "Array is empty" ) - else - SetPos(ownd:nBottom,ownd:nLeft) - ::aWindows[::nCurwindow]:lFocused:=.f. - ::arrayname:= ::arrayname+"["+alltrim(cTemp)+"]" - ::AddWindows(aArray[nSet],oBrwSets:RowPos+oBrwSets:nTop) - ::arrayname:=coldname - - adel(::aWindows,::nCurWindow) - asize(::awindows,len(::awindows)-1) - if ::nCurwindow==0 - ::ncurwindow:=1 - else - ::ncurwindow-- - endif - endif - elseif valtype(aArray[nSet])=="B" .or. valtype(aArray[nSet])=="P" - Alert("Value cannot be edited") - else - if ::lEditable - oBrwSets:RefreshCurrent() - if ValType( aArray[ nSet ] ) == "O" - __DbgObject( aArray[ nSet ], cName + ; - "[" + AllTrim( Str( nSet ) ) + "]" ) - elseif ValType( aArray[ nSet ] ) == "H" - __DbgHashes( aArray[ nSet ], cName + ; - "[" + AllTrim( Str( nSet ) ) + "]" ) - else - ::doget(oBrwsets,aarray,nSet) - endif - oBrwSets:RefreshCurrent() - oBrwSets:ForceStable() - else - Alert("Value cannot be edited") - endif - - endif - - endcase - - RefreshVarsS( oBrwSets ) - - ::aWindows[::nCurwindow]:SetCaption( cName + "["+AllTrim( Str( oBrwSets:cargo[1] ) ) +".."+ ; - Alltrim(str(LenArr))+ "]") -return self - -static function ValToStr( uVal ) - - local cType := ValType( uVal ) - local cResult := "U" - - do case - case uVal == nil - cResult := "NIL" - - Case cType =="B" - cResult:= "{ || ... }" - - case cType == "A" - cResult := "{ ... }" - - case cType == "H" - cResult := "Hash of " + AllTrim( Str( Len( uVal ) ) ) + " elements" - - case cType $ "CM" - cResult := '"' + uVal + '"' - - case cType == "L" - cResult := iif( uVal, ".T.", ".F." ) - - case cType == "D" - cResult := DToC( uVal ) - - case cType == "N" - cResult := AllTrim( Str( uVal ) ) - - case cType == "O" - cResult := "Class " + uVal:ClassName() + " object" - - case cType == "P" - cResult := "Pointer" - - endcase - -return cResult - -METHOD doGet( oBro, pItem, nSet ) Class TDBGArray +METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbArray #ifndef HB_NO_READDBG - LOCAL nKey - local getlist := {} - // save state - LOCAL lScoreSave := Set( _SET_SCOREBOARD, .f. ) - LOCAL lExitSave := Set( _SET_EXIT, .t. ) - LOCAL bInsSave := SetKey( K_INS ) - local cValue := PadR( ValToStr( pItem[ nSet ] ),; - oBro:nRight - oBro:nLeft - oBro:GetColumn( 1 ):width ) + LOCAL nKey + LOCAL GetList := {} + LOCAL lScoreSave := Set( _SET_SCOREBOARD, .F. ) + LOCAL lExitSave := Set( _SET_EXIT, .T. ) + LOCAL bInsSave := SetKey( K_INS ) + LOCAL cValue := PadR( __dbgValToStr( pItem[ nSet ] ),; + oBrowse:nRight - oBrowse:nLeft - oBrowse:GetColumn( 1 ):width ) - // make sure browse is stable - obro:forcestable() - // if confirming new record, append blank + // make sure browse is stable + oBrowse:forceStable() + // if confirming new record, append blank - // set insert key to toggle insert mode and cursor - SetKey( K_INS, { || SetCursor( if( ReadInsert( ! ReadInsert() ),; - SC_NORMAL, SC_INSERT ) ) } ) + // set insert key to toggle insert mode and cursor + SetKey( K_INS, { || SetCursor( iif( ReadInsert( ! ReadInsert() ),; + SC_NORMAL, SC_INSERT ) ) } ) - // initial cursor setting - SetCursor( IF( ReadInsert(), SC_INSERT, SC_NORMAL ) ) + // initial cursor setting + SetCursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) ) - // create a corresponding GET - @ row(), oBro:nLeft + oBro:GetColumn( 1 ):width + 1 GET cValue ; - VALID If( Type( cValue ) == "UE", ( Alert( "Expression error" ), .f. ), .t. ) + // create a corresponding GET + @ Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1 GET cValue ; + VALID iif( Type( cValue ) == "UE", ( Alert( "Expression error" ), .F. ), .T. ) - READ + READ - if LastKey() == K_ENTER - pItem[ nSet ] = &cValue - endif + IF LastKey() == K_ENTER + pItem[ nSet ] = &cValue + ENDIF - SetCursor( 0 ) - Set( _SET_SCOREBOARD, lScoreSave ) - Set( _SET_EXIT, lExitSave ) - SetKey( K_INS, bInsSave ) + SetCursor( SC_NONE ) + Set( _SET_SCOREBOARD, lScoreSave ) + Set( _SET_EXIT, lExitSave ) + SetKey( K_INS, bInsSave ) - // check exit key from get - nKey := LastKey() - IF nKey == K_UP .OR. nKey == K_DOWN .OR. nKey == K_PGUP .OR. nKey == K_PGDN - KEYBOARD CHR( nKey ) - END + // check exit key from get + nKey := LastKey() + IF nKey == K_UP .OR. nKey == K_DOWN .OR. nKey == K_PGUP .OR. nKey == K_PGDN + KEYBOARD Chr( nKey ) + ENDIF #else - HB_SYMBOL_UNUSED( oBro ) - HB_SYMBOL_UNUSED( pItem ) - HB_SYMBOL_UNUSED( nSet ) + HB_SYMBOL_UNUSED( oBrowse ) + HB_SYMBOL_UNUSED( pItem ) + HB_SYMBOL_UNUSED( nSet ) #endif -RETURN nil + RETURN NIL -function __DbgArrays( aArray, cArrayName, lEditable ) +METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, aArray ) CLASS HBDbArray -return TDBGArray():New( aArray, cArrayName, lEditable ) + LOCAL nSet := oBrwSets:cargo[ 1 ] + LOCAL cOldName := ::arrayName -Static function GetTopPos(nPos) -Local nReturn:=0 -nReturn:=if((maxrow()-nPos)<5,Maxrow()-nPos,nPos) -return nReturn + DO CASE + CASE nKey == K_UP + oBrwSets:Up() -Static function GetBottomPos(nPos) -Local nReturn:=0 -nReturn :=if(nPos Len(oBrwSets:cargo[ 2 ][ 1 ]), ; - Len(oBrwSets:cargo[ 2 ][ 1 ]) - oBrwSets:cargo[ 1 ], nPos ) ) +STATIC FUNCTION ArrayBrowseSkip( nPos, oBrwSets ) + RETURN iif( oBrwSets:cargo[ 1 ] + nPos < 1, 0 - oBrwSets:cargo[ 1 ] + 1 , ; + iif( oBrwSets:cargo[ 1 ] + nPos > Len( oBrwSets:cargo[ 2 ][ 1 ] ), ; + Len( oBrwSets:cargo[ 2 ][ 1 ] ) - oBrwSets:cargo[ 1 ], nPos ) ) diff --git a/harbour/source/debug/dbgthsh.prg b/harbour/source/debug/dbgthsh.prg index 5aef738adb..8a26ca452b 100644 --- a/harbour/source/debug/dbgthsh.prg +++ b/harbour/source/debug/dbgthsh.prg @@ -51,84 +51,80 @@ * */ - /* - 26/06/2006 - FSG - Converted dbgtarr.prg to work with hashes. - */ - -#include "setcurs.ch" #include "hbclass.ch" -#include "inkey.ch" + #include "common.ch" +#include "inkey.ch" +#include "setcurs.ch" -Class TDBGHash +CREATE CLASS HBDbHash - data aWindows - data TheHash - data hashName - data nCurWindow - data lEditable - Method new - method addWindows - method doget - method SetsKeyPressed + VAR aWindows INIT {} + VAR TheHash + VAR hashName + VAR nCurWindow INIT 0 + VAR lEditable -end class + METHOD New( hHash, cVarName, lEditable ) -method new(hHash,pArName,lEditable) Class TDBGHash + METHOD addWindows( hHash, nRow ) + METHOD doGet( oBrowse, pItem, nSet ) + METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, hHash ) - DEFAULT lEditable TO .t. +ENDCLASS - ::aWindows := {} - ::hashName := parName - ::TheHash := hHash - ::nCurWindow := 0 - ::lEditable := lEditable +METHOD New( hHash, cVarName, lEditable ) CLASS HBDbHash + + DEFAULT lEditable TO .T. + + ::hashName := cVarName + ::TheHash := hHash + ::lEditable := lEditable + ::addWindows( ::TheHash ) -Return Self + RETURN Self -Method addWindows( hHash, nRow ) Class TDBGHash - local oBrwSets, nSize := Len( hHash ) - local n := 1 - Local owndsets - local nWidth, nColWidth - local oCol, nKeyLen +METHOD addWindows( hHash, nRow ) CLASS HBDbHash + LOCAL oBrwSets + LOCAL nSize := Len( hHash ) + LOCAL oWndSets + LOCAL nWidth + LOCAL nColWidth + LOCAL oCol + LOCAL nKeyLen - if ( nsize < maxrow() - 2 ) - if nRow <> nil - owndsets := TDbWindow():New( GetTopPos(nRow), 5, getBottomPos(nRow+nsize+1), maxcol()-5, ::hashName+"[1.."+alltrim(str(nsize,6))+"]" ,"N/W" ) - else - owndsets := TDbWindow():New( 1, 5, 2+nsize, maxcol()-5, ::hashName+"[1.."+alltrim(str(nsize,6))+"]" ,"N/W") - endif - else - owndsets:=TDbWindow():New( 1, 5, maxrow()-2, maxcol()-5, ::hashName+"[1.."+alltrim(str(nsize,6))+"]" ,"N/W") - endif + IF nSize < MaxRow() - 2 + IF nRow != NIL + oWndSets := HBDbWindow():New( GetTopPos( nRow ), 5, getBottomPos( nRow + nSize + 1 ), MaxCol() - 5, ::hashName + "[1.." + LTrim( Str( nSize, 6 ) ) + "]", "N/W" ) + ELSE + oWndSets := HBDbWindow():New( 1, 5, 2 + nSize, MaxCol() - 5, ::hashName + "[1.." + LTrim( Str( nSize, 6 ) ) + "]", "N/W" ) + ENDIF + ELSE + oWndSets := HBDbWindow():New( 1, 5, MaxRow() - 2, MaxCol() - 5, ::hashName + "[1.." + LTrim( Str( nSize, 6 ) ) + "]", "N/W" ) + ENDIF ::nCurWindow++ - oWndSets:lFocused:=.t. - aadd(::aWindows,owndsets) + oWndSets:lFocused := .T. + AAdd( ::aWindows, oWndSets ) nWidth := oWndSets:nRight - oWndSets:nLeft - 1 - oBrwSets:=TbrowseNew(owndsets:nTop+1, owndsets:nLeft+1, owndsets:nBottom-1, owndsets:nRight-1) - oBrwSets:autolite:=.f. + oBrwSets := TBrowseNew( oWndSets:nTop + 1, oWndSets:nLeft + 1, oWndSets:nBottom - 1, oWndSets:nRight - 1 ) + oBrwSets:autolite := .F. oBrwSets:ColorSpec := __Dbg():ClrModal() - oBrwSets:Cargo :={ 1,{}} // Actual highligthed row - aadd(oBrwSets:Cargo[2],hHash) + oBrwSets:Cargo := { 1, {} } // Actual highligthed row + AAdd( oBrwSets:Cargo[ 2 ], hHash ) - //oBrwSets:AddColumn( ocol:= TBColumnNew("", { || ::hashName+"["+alltrim(str(oBrwSets:cargo[ 1 ],6))+"]"} ) ) - oBrwSets:AddColumn( ocol:= TBColumnNew("", { || ::hashName+"[" + HashKeyString( hHash, oBrwSets:cargo[ 1 ] ) +"]" } ) ) + oBrwSets:AddColumn( oCol := TBColumnNew( "", { || ::hashName + "[" + HashKeyString( hHash, oBrwSets:cargo[ 1 ] ) + "]" } ) ) // calculate max key length nKeyLen := 0 - HB_hEval( hHash, {|k,v,p| HB_SYMBOL_UNUSED( k ), HB_SYMBOL_UNUSED( v ), nKeyLen := Max( nKeyLen, len( ::hashName+"["+ HashKeyString( hHash, p ) +"]" ) ) } ) + hb_HEval( hHash, {| k, v, p | HB_SYMBOL_UNUSED( k ), HB_SYMBOL_UNUSED( v ), nKeyLen := Max( nKeyLen, Len( ::hashName + "[" + HashKeyString( hHash, p ) + "]" ) ) } ) oCol:width := nKeyLen - //ocol:width:=len(::arrayName+"["+alltrim(str(len(aarray),6))+"]" ) - oCol:DefColor:={1,2} + oCol:DefColor := { 1, 2 } nColWidth = oCol:Width - //oBrwSets:AddColumn( ocol:=TBColumnNew( "" ,{ || PadR( ValToStr( hHash[ oBrwSets:cargo[ 1 ] ] ), nWidth - nColWidth - 1 ) } ) ) - oBrwSets:AddColumn( ocol:=TBColumnNew( "" ,{ || PadR( ValToStr( HB_HValueAt( hHash, oBrwSets:cargo[ 1 ] ) ), nWidth - nColWidth - 1 ) } ) ) + oBrwSets:AddColumn( oCol := TBColumnNew( "" ,{ || 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 @@ -142,247 +138,196 @@ Method addWindows( hHash, nRow ) Class TDBGHash I think tbrowse should trim columns up until the point where at leat two are visible in the same moment, I leave this fix to tbrowse for the reader ;) - oCol:width:=50 + oCol:width := 50 */ - ocol:DefColor:={1,3} + oCol:DefColor:= { 1, 3 } - oBrwSets:GOTOPBLOCK := { || oBrwSets:cargo[ 1 ]:= 1 } - oBrwSets:GoBottomBlock := { || oBrwSets:cargo[ 1 ]:= Len(oBrwSets:cargo[ 2 ][ 1 ])} - oBrwSets:SKIPBLOCK := { |nPos| ( nPos:= HashBrowseSkip(nPos, oBrwSets), oBrwSets:cargo[ 1 ]:= ; - oBrwSets:cargo[ 1 ] + nPos,nPos ) } + oBrwSets:goTopBlock := { || oBrwSets:cargo[ 1 ] := 1 } + oBrwSets:goBottomBlock := { || oBrwSets:cargo[ 1 ] := Len( oBrwSets:cargo[ 2 ][ 1 ] ) } + oBrwSets:skipBlock := { |nPos| ( nPos := HashBrowseSkip(nPos, oBrwSets), oBrwSets:cargo[ 1 ] := ; + oBrwSets:cargo[ 1 ] + nPos, nPos ) } - ::aWindows[::nCurWindow]:bPainted := { || (oBrwSets:forcestable(),RefreshVarsS(oBrwSets))} - ::aWindows[::nCurWindow]:bKeyPressed := { | nKey | ::SetsKeyPressed( nKey, oBrwSets, Len( hHash ),; - ::aWindows[::nCurWindow],::hashName ,Len(hHash),hHash)} + ::aWindows[ ::nCurWindow ]:bPainted := { || ( oBrwSets:forcestable(), RefreshVarsS( oBrwSets ) ) } + ::aWindows[ ::nCurWindow ]:bKeyPressed := { | nKey | ::SetsKeyPressed( nKey, oBrwSets,; + ::aWindows[ ::nCurWindow ],::hashName, hHash ) } SetCursor( SC_NONE ) - ::aWindows[::nCurWindow]:ShowModal() + + ::aWindows[ ::nCurWindow ]:ShowModal() -return self + RETURN Self -method SetsKeyPressed( nKey, oBrwSets, nSets, oWnd, cName, LenArr, hHash ) Class TDBGHash - - local nSet := oBrwSets:cargo[1] - local cOldname := ::hashName - Local uValue - - HB_SYMBOL_UNUSED( nSets ) - - do case - case nKey == K_UP - oBrwSets:Up() - - case nKey == K_DOWN - oBrwSets:Down() - - case nKey == K_HOME .or. (nKey == K_CTRL_PGUP) .or. (nKey == K_CTRL_HOME) - oBrwSets:GoTop() - - case nKey == K_END .or. (nkey == K_CTRL_PGDN) .or. (nkey == K_CTRL_END ) - oBrwSets:GoBottom() - - Case nKey == K_PGDN - oBrwSets:pageDown() - - Case nKey == K_PGUP - OBrwSets:PageUp() - - Case nKey == K_ENTER - uValue := HB_HValueAt( hHash, nSet ) - if valtype( uValue ) == "H" - if Len( uValue ) == 0 - Alert( "Hash is empty" ) - else - SetPos(ownd:nBottom,ownd:nLeft) - ::aWindows[::nCurwindow]:lFocused:=.f. - - ::hashName:= ::hashName + "[" + HashKeyString( hHash, nSet ) + "]" - ::AddWindows( HB_HValueAt( hHash, nSet ), oBrwSets:RowPos+oBrwSets:nTop) - ::hashName:=coldname - - adel(::aWindows,::nCurWindow) - asize(::awindows,len(::awindows)-1) - if ::nCurwindow==0 - ::nCurwindow:=1 - else - ::nCurwindow-- - endif - endif - elseif valtype( uValue ) == "B" .or. valtype( uValue ) == "P" - Alert("Value cannot be edited") - else - if ::lEditable - oBrwSets:RefreshCurrent() - if ValType( uValue ) == "O" - - __DbgObject( uValue, cName + ; - "[" + HashKeyString( hHash, nSet ) + "]" ) - elseif ValType( uValue ) == "A" - - __DbgArrays( uValue, cName + ; - "[" + HashKeyString( hHash, nSet ) + "]" ) - else - ::doget(oBrwsets, hHash, nSet) - endif - oBrwSets:RefreshCurrent() - oBrwSets:ForceStable() - else - Alert("Value cannot be edited") - endif - - endif - - endcase - - RefreshVarsS( oBrwSets ) - - ::aWindows[::nCurwindow]:SetCaption( cName + "["+AllTrim( Str( oBrwSets:cargo[1] ) ) +".."+ ; - Alltrim(str(LenArr))+ "]") -return self - -static function ValToStr( uVal ) - - local cType := ValType( uVal ) - local cResult := "U" - - do case - case uVal == nil - cResult := "NIL" - - Case cType =="B" - cResult:= "{ || ... }" - - case cType == "A" - cResult := "{ ... }" - - case cType $ "CM" - cResult := '"' + uVal + '"' - - case cType == "L" - cResult := iif( uVal, ".T.", ".F." ) - - case cType == "D" - cResult := DToC( uVal ) - - case cType == "N" - cResult := AllTrim( Str( uVal ) ) - - case cType == "O" - cResult := "Class " + uVal:ClassName() + " object" - - case cType == "H" - cResult := "Hash of " + AllTrim( Str( Len( uVal ) ) ) + " elements" - - case cType == "P" - cResult := "Pointer" - - endcase - -return cResult - -METHOD doGet( oBro, pItem, nSet ) Class TDBGHash +METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbHash #ifndef HB_NO_READDBG - LOCAL nKey - local getlist := {} - // save state - LOCAL lScoreSave := Set( _SET_SCOREBOARD, .f. ) - LOCAL lExitSave := Set( _SET_EXIT, .t. ) - LOCAL bInsSave := SetKey( K_INS ) - local cValue := PadR( ValToStr( HB_HValueAt( pItem, nSet ) ),; - oBro:nRight - oBro:nLeft - oBro:GetColumn( 1 ):width ) + LOCAL nKey + LOCAL GetList := {} + LOCAL lScoreSave := Set( _SET_SCOREBOARD, .F. ) + LOCAL lExitSave := Set( _SET_EXIT, .T. ) + LOCAL bInsSave := SetKey( K_INS ) + LOCAL cValue := PadR( __dbgValToStr( HB_HValueAt( pItem, nSet ) ),; + oBrowse:nRight - oBrowse:nLeft - oBrowse:GetColumn( 1 ):width ) - // make sure browse is stable - obro:forcestable() - // if confirming new record, append blank + // make sure browse is stable + oBrowse:forceStable() + // if confirming new record, append blank - // set insert key to toggle insert mode and cursor - SetKey( K_INS, { || SetCursor( if( ReadInsert( ! ReadInsert() ),; - SC_NORMAL, SC_INSERT ) ) } ) + // set insert key to toggle insert mode and cursor + SetKey( K_INS, { || SetCursor( iif( ReadInsert( ! ReadInsert() ),; + SC_NORMAL, SC_INSERT ) ) } ) - // initial cursor setting - SetCursor( IF( ReadInsert(), SC_INSERT, SC_NORMAL ) ) + // initial cursor setting + SetCursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) ) - // create a corresponding GET - @ row(), oBro:nLeft + oBro:GetColumn( 1 ):width + 1 GET cValue ; - VALID If( Type( cValue ) == "UE", ( Alert( "Expression error" ), .f. ), .t. ) + // create a corresponding GET + @ Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1 GET cValue ; + VALID iif( Type( cValue ) == "UE", ( Alert( "Expression error" ), .F. ), .T. ) - READ + READ - if LastKey() == K_ENTER - HB_HValueAt( pItem, nSet, &cValue ) - endif + IF LastKey() == K_ENTER + HB_HValueAt( pItem, nSet, &cValue ) + ENDIF - SetCursor( 0 ) - Set( _SET_SCOREBOARD, lScoreSave ) - Set( _SET_EXIT, lExitSave ) - SetKey( K_INS, bInsSave ) + SetCursor( SC_NONE ) + Set( _SET_SCOREBOARD, lScoreSave ) + Set( _SET_EXIT, lExitSave ) + SetKey( K_INS, bInsSave ) - // check exit key from get - nKey := LastKey() - IF nKey == K_UP .OR. nKey == K_DOWN .OR. nKey == K_PGUP .OR. nKey == K_PGDN - KEYBOARD CHR( nKey ) - END + // check exit key from get + nKey := LastKey() + IF nKey == K_UP .OR. nKey == K_DOWN .OR. nKey == K_PGUP .OR. nKey == K_PGDN + KEYBOARD Chr( nKey ) + ENDIF #else - HB_SYMBOL_UNUSED( oBro ) - HB_SYMBOL_UNUSED( pItem ) - HB_SYMBOL_UNUSED( nSet ) + HB_SYMBOL_UNUSED( oBrowse ) + HB_SYMBOL_UNUSED( pItem ) + HB_SYMBOL_UNUSED( nSet ) #endif -RETURN nil + RETURN NIL -function __DbgHashes( hHash, chashName, lEditable ) +METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, hHash ) CLASS HBDbHash -return TDBGHash():New( hHash, chashName, lEditable ) + LOCAL nSet := oBrwSets:cargo[ 1 ] + LOCAL cOldname := ::hashName + LOCAL uValue -Static function GetTopPos(nPos) -Local nReturn:=0 -nReturn:=if((maxrow()-nPos)<5,Maxrow()-nPos,nPos) -return nReturn + DO CASE + CASE nKey == K_UP + oBrwSets:Up() -Static function GetBottomPos(nPos) -Local nReturn:=0 -nReturn :=if(nPos Len(oBrwSets:cargo[ 2 ][ 1 ]), ; - Len(oBrwSets:cargo[ 2 ][ 1 ]) - oBrwSets:cargo[ 1 ], nPos ) ) +STATIC FUNCTION HashBrowseSkip( nPos, oBrwSets ) + RETURN iif( oBrwSets:cargo[ 1 ] + nPos < 1, 0 - oBrwSets:cargo[ 1 ] + 1 , ; + iif( oBrwSets:cargo[ 1 ] + nPos > Len( oBrwSets:cargo[ 2 ][ 1 ] ), ; + Len( oBrwSets:cargo[ 2 ][ 1 ] ) - oBrwSets:cargo[ 1 ], nPos ) ) -static function HashKeyString( hHash, nAt ) - LOCAL cString - LOCAL xVal := HB_HKeyAt( hHash, nAt ) - LOCAL cType := ValType( xVal ) - DO CASE - CASE cType == "C" - cString := '"' + xVal + '"' - CASE cType == "D" - cString := '"' + DToC( xVal ) + '"' - CASE cType == "N" - cString := AllTrim( Str( xVal ) ) - OTHERWISE - cString := AllTrim( HB_CStr( xVal ) ) - ENDCASE +STATIC FUNCTION HashKeyString( hHash, nAt ) -RETURN cString + LOCAL xVal := HB_HKeyAt( hHash, nAt ) + LOCAL cType := ValType( xVal ) + + DO CASE + CASE cType == "C" ; RETURN '"' + xVal + '"' + CASE cType == "D" ; RETURN '"' + DToC( xVal ) + '"' + CASE cType == "N" ; RETURN LTrim( Str( xVal ) ) + ENDCASE + + RETURN AllTrim( HB_CStr( xVal ) ) diff --git a/harbour/source/debug/dbgtmenu.prg b/harbour/source/debug/dbgtmenu.prg index 8ed3c86bf9..0dd90c785e 100644 --- a/harbour/source/debug/dbgtmenu.prg +++ b/harbour/source/debug/dbgtmenu.prg @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * The Debugger (TDbMenu class) + * The Debugger (HBDbMenu class) * * Copyright 1999 Antonio Linares * www - http://www.harbour-project.org @@ -56,21 +56,28 @@ #include "hbclass.ch" #include "hbmemvar.ch" + #include "box.ch" -#include "inkey.ch" #include "common.ch" +#include "inkey.ch" #include "setcurs.ch" -CLASS TDbMenu /* debugger menu */ +CREATE CLASS HBDbMenu CLASSDATA aMenus - DATA nTop, nLeft, nBottom, nRight - DATA aItems - DATA cClrHilite, cClrHotKey, cClrHotFocus, cClrPopup - DATA nOpenPopup // zero if no popup is shown - DATA lPopup - DATA cBackImage + VAR nTop + VAR nLeft + VAR nBottom + VAR nRight + VAR aItems + VAR cClrHilite + VAR cClrHotKey + VAR cClrHotFocus + VAR cClrPopup + VAR nOpenPopup // zero if no popup is shown + VAR lPopup + VAR cBackImage METHOD New( aItems ) METHOD AddItem( oMenuItem ) @@ -90,14 +97,14 @@ CLASS TDbMenu /* debugger menu */ METHOD GoTop() METHOD GoUp() INLINE ::aItems[ ::nOpenPopup ]:bAction:GoLeft() METHOD IsOpen() INLINE ::nOpenPopup != 0 - METHOD LoadColors() // Load current debugger colors settings + METHOD LoadColors() // Load current debugger colors settings METHOD ProcessKey( nKey ) - METHOD Refresh() // Repaints the top bar + METHOD Refresh() // Repaints the top bar METHOD ShowPopup( nPopup ) ENDCLASS -METHOD New() CLASS TDbMenu +METHOD New() CLASS HBDbMenu local nCol := 0 @@ -120,9 +127,10 @@ METHOD New() CLASS TDbMenu return Self -METHOD AddItem( oMenuItem ) CLASS TDbMenu +METHOD AddItem( oMenuItem ) CLASS HBDbMenu - local oLastMenu := ATail( ::aMenus ), oLastMenuItem + local oLastMenu := ATail( ::aMenus ) + local oLastMenuItem if oLastMenu:lPopup oMenuItem:nRow := Len( oLastMenu:aItems ) @@ -142,9 +150,11 @@ METHOD AddItem( oMenuItem ) CLASS TDbMenu return oMenuItem -METHOD Build() CLASS TDbMenu +METHOD Build() CLASS HBDbMenu - local n, nPos := 0, oMenuItem + local n + local nPos := 0 + local oMenuItem if Len( ::aMenus ) == 1 // pulldown menu for n := 1 to Len( ::aItems ) @@ -175,7 +185,7 @@ METHOD Build() CLASS TDbMenu return nil -METHOD ClosePopup( nPopup ) CLASS TDbMenu +METHOD ClosePopup( nPopup ) CLASS HBDbMenu local oPopup @@ -191,7 +201,7 @@ METHOD ClosePopup( nPopup ) CLASS TDbMenu return nil -METHOD DeHilite() CLASS TDbMenu +METHOD DeHilite() CLASS HBDbMenu local oMenuItem := ::aItems[ ::nOpenPopup ] @@ -199,7 +209,7 @@ METHOD DeHilite() CLASS TDbMenu return nil -METHOD Display() CLASS TDbMenu +METHOD Display() CLASS HBDbMenu local n @@ -225,7 +235,7 @@ METHOD Display() CLASS TDbMenu return nil -METHOD EvalAction() CLASS TDbMenu +METHOD EvalAction() CLASS HBDbMenu local oPopup, oMenuItem @@ -239,7 +249,7 @@ METHOD EvalAction() CLASS TDbMenu return nil -METHOD GetHotKeyPos( cKey ) CLASS TDbMenu +METHOD GetHotKeyPos( cKey ) CLASS HBDbMenu local n @@ -252,7 +262,7 @@ METHOD GetHotKeyPos( cKey ) CLASS TDbMenu return 0 -METHOD GetItemOrdByCoors( nRow, nCol ) CLASS TDbMenu +METHOD GetItemOrdByCoors( nRow, nCol ) CLASS HBDbMenu local n @@ -265,9 +275,10 @@ METHOD GetItemOrdByCoors( nRow, nCol ) CLASS TDbMenu return 0 -METHOD GetItemByIdent( uIdent ) CLASS TDbMenu +METHOD GetItemByIdent( uIdent ) CLASS HBDbMenu - local n, oItem + local n + local oItem for n := 1 to Len( ::aItems ) IF( VALTYPE(::aItems[n]:bAction) == 'O' ) @@ -283,9 +294,9 @@ METHOD GetItemByIdent( uIdent ) CLASS TDbMenu endif next -return NIL +return nil -METHOD GoBottom() CLASS TDbMenu +METHOD GoBottom() CLASS HBDbMenu local oPopup @@ -297,7 +308,7 @@ METHOD GoBottom() CLASS TDbMenu return nil -METHOD GoLeft() CLASS TDbMenu +METHOD GoLeft() CLASS HBDbMenu local oMenuItem := ::aItems[ ::nOpenPopup ] @@ -321,7 +332,7 @@ METHOD GoLeft() CLASS TDbMenu return nil -METHOD GoRight() CLASS TDbMenu +METHOD GoRight() CLASS HBDbMenu local oMenuItem := ::aItems[ ::nOpenPopup ] @@ -345,7 +356,7 @@ METHOD GoRight() CLASS TDbMenu return nil -METHOD GoTop() CLASS TDbMenu +METHOD GoTop() CLASS HBDbMenu local oPopup @@ -357,7 +368,7 @@ METHOD GoTop() CLASS TDbMenu return nil -METHOD LoadColors() CLASS TDbMenu +METHOD LoadColors() CLASS HBDbMenu local aColors := __DbgColors() local n @@ -375,7 +386,7 @@ METHOD LoadColors() CLASS TDbMenu return nil -METHOD Refresh() CLASS TDbMenu +METHOD Refresh() CLASS HBDbMenu local n @@ -394,7 +405,7 @@ METHOD Refresh() CLASS TDbMenu return nil -METHOD ShowPopup( nPopup ) CLASS TDbMenu +METHOD ShowPopup( nPopup ) CLASS HBDbMenu ::aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus ) ::nOpenPopup := nPopup @@ -406,9 +417,10 @@ METHOD ShowPopup( nPopup ) CLASS TDbMenu return nil -METHOD ProcessKey( nKey ) CLASS TDbMenu +METHOD ProcessKey( nKey ) CLASS HBDbMenu - local nPopup, oPopup + local nPopup + local oPopup do case case nKey == K_LBUTTONDOWN @@ -486,6 +498,7 @@ function __dbgAltToKey( nKey ) 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 ) + 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( "ABCDEFGHIJKLMNOPQRSTUVWXYZ", nIndex, 1 ), "" ) +return iif( nIndex > 0, SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890", nIndex, 1 ), "" ) diff --git a/harbour/source/debug/dbgtmitm.prg b/harbour/source/debug/dbgtmitm.prg index 13e329cbf1..e4d7a4242b 100644 --- a/harbour/source/debug/dbgtmitm.prg +++ b/harbour/source/debug/dbgtmitm.prg @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * The Debugger (TDbMenuItem Class) + * The Debugger (HBDbMenuItem Class) * * Copyright 1999 Antonio Linares * www - http://www.harbour-project.org @@ -55,18 +55,20 @@ redirection, and is also slower. [vszakats] */ #include "hbclass.ch" + #include "common.ch" -CLASS TDbMenuItem +CREATE CLASS HBDbMenuItem - DATA nRow, nCol - DATA cPrompt - DATA bAction - DATA lChecked - DATA Ident + VAR nRow + VAR nCol + VAR cPrompt + VAR bAction + VAR lChecked + VAR Ident - ACCESS Checked() INLINE ::lChecked - ASSIGN Checked(lOnOff) INLINE ::lChecked:=lOnOff + ACCESS Checked() INLINE ::lChecked + ASSIGN Checked( lChecked ) INLINE ::lChecked := lChecked METHOD New( cPrompt, bAction, lChecked, xIdent ) METHOD Display( cClrText, cClrHotKey ) @@ -74,23 +76,22 @@ CLASS TDbMenuItem ENDCLASS -METHOD New( cPrompt, bAction, lChecked, xIdent ) CLASS TDbMenuItem +METHOD New( cPrompt, bAction, lChecked, xIdent ) CLASS HBDbMenuItem - DEFAULT lChecked TO .f. + DEFAULT lChecked TO .F. ::cPrompt := cPrompt ::bAction := bAction ::lChecked := lChecked ::Ident := xIdent -return Self + RETURN Self -METHOD Display( cClrText, cClrHotKey ) CLASS TDbMenuItem +METHOD Display( cClrText, cClrHotKey ) CLASS HBDbMenuItem - local nAt + LOCAL nAt - DispOutAt( ::nRow, ::nCol ,; - StrTran( ::cPrompt, "~", "" ), cClrText ) + DispOutAt( ::nRow, ::nCol, StrTran( ::cPrompt, "~", "" ), cClrText ) DispOutAt( ::nRow, ::nCol + ; ( nAt := At( "~", ::cPrompt ) ) - 1,; @@ -98,4 +99,4 @@ METHOD Display( cClrText, cClrHotKey ) CLASS TDbMenuItem DispOutAt( ::nRow, ::nCol, iif( ::lChecked, Chr( 251 ), "" ), cClrText ) -return Self + RETURN Self diff --git a/harbour/source/debug/dbgtobj.prg b/harbour/source/debug/dbgtobj.prg index 0dc1ef1b56..21489522a2 100644 --- a/harbour/source/debug/dbgtobj.prg +++ b/harbour/source/debug/dbgtobj.prg @@ -50,344 +50,283 @@ * */ - -#include "setcurs.ch" -#include "common.ch" #include "hbclass.ch" + +#include "common.ch" #include "inkey.ch" +#include "setcurs.ch" -//#pragma -es0 +CREATE CLASS HBDbObject -Class TDBGobject -//export: -data aWindows -data Theobj -data objname -data nCurWindow -data pItems -Data ArrayReference -Data ArrayIndex -Data AllNames -data lEditable -Method new -method addWindows -method doget -method SetsKeyPressed -endclass + VAR aWindows INIT {} + VAR Theobj + VAR objname + VAR nCurWindow INIT 0 + VAR pItems INIT {} + VAR ArrayReference INIT {} + VAR ArrayIndex INIT 1 + VAR AllNames INIT {} + VAR lEditable -method new(aArray,pArName,lEditable) class tdbgObject -Local aTemp + METHOD New( aArray, cVarName, lEditable ) + METHOD addWindows( aArray, nRow ) + METHOD doGet( oBrowse, pItem, nSet ) + METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, aArray ) -DEFAULT lEditable TO .t. -::pItems:={} -::AllNames:={} -for each aTemp in __objGetValueList(aArray) - aadd(::pItems,{aTemp[1],aTemp[2]}) - aadd(::AllNames,aTemp[1]) -next -for each aTemp in __objGetMethodList(aArray) - if !empty(aTemp) - aadd(::pItems,{aTemp,"Method"}) - aadd(::AllNames,aTemp) - endif -next -::aWindows:={} -::objname:=parName -::TheObj:=aArray +ENDCLASS -::nCurWindow:=0 -::ArrayReference:={} -::ArrayIndex:=1 -::lEditable = lEditable +METHOD New( aArray, cVarName, lEditable ) CLASS HBDbObject -::addWindows(::pItems) -Return Self + LOCAL aTemp -Method addWindows(aArray,nRow) class tdbgObject -local oBrwSets,nSize:=Len(AArray) -//local n:=1 -Local owndsets - local nWidth - local oCol - local nMaxElem + DEFAULT lEditable TO .T. - if (nsize nil - owndsets:=TDbWindow():New( nRow, 5, if(nRow+nsize+1 0, Min( ::arrayindex+nSkip, Len(::arrayreference)),; + ::arrayindex := iif( nSkip > 0, Min( ::arrayindex + nSkip, Len( ::arrayreference ) ),; Max( 1, ::arrayindex + nSkip ) ), ::arrayindex - nPos } - nMaxElem := maxelem(::AllNames) - oBrwSets:AddColumn( ocol := TBColumnNew( "",; - { || PadR( ::ArrayReference[ ::arrayindex, 1 ], nMaxElem ) } ) ) - ocol:width := nMaxElem - ocol:ColorBlock := { || { iif( ::Arrayindex == oBrwSets:Cargo, 2, 1 ), 2 } } - oBrwSets:Freeze:=1 + nMaxLen := ArrayMaxLen( ::AllNames ) + oBrwSets:AddColumn( oCol := TBColumnNew( "",; + { || 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( ValType( ; - ::ArrayReference[ ::ArrayIndex, 2 ] ) == "C" .and. ; - ::ArrayReference[ ::ArrayIndex, 2 ] == "Method",; - "Method", PadR( ValToStr( __ObjSendMsg( ::TheObj, ::ArrayReference[ ::arrayindex ,1] ) ),; - nWidth - 12 ) ) } ) ) + oBrwSets:AddColumn( oCol := TBColumnNew( "", { || iif( ISCHARACTER( ::ArrayReference[ ::ArrayIndex, 2 ] ) .AND. ::ArrayReference[ ::ArrayIndex, 2 ] == "Method",; + "Method",; + PadR( __dbgValToStr( __ObjSendMsg( ::TheObj, ::ArrayReference[ ::arrayindex, 1 ] ) ), nWidth - 12 ) ) } ) ) oBrwSets:Cargo := 1 // Actual highligthed row - ocol:ColorBlock := { || { iif( ::Arrayindex == oBrwSets:Cargo, 3, 1 ), 3 } } - ocol:width:= MaxCol() - 14 - nMaxElem - oBrwsets:colpos:=2 - ::aWindows[::nCurWindow]:bPainted := { || oBrwSets:ForceStable() } - ::aWindows[::nCurWindow]:bKeyPressed := { | nKey | ::SetsKeyPressed( nKey, oBrwSets, Len( aArray ),; - ::aWindows[::nCurWindow],::objname ,Len(::Arrayreference),::pitems) } - ::aWindows[::nCurwindow]:cCaption := ::objname +" is of class: " +::TheObj:classname() + oCol:ColorBlock := { || { iif( ::Arrayindex == oBrwSets:Cargo, 3, 1 ), 3 } } + oCol:width := MaxCol() - 14 - nMaxLen + oBrwSets:colpos := 2 + ::aWindows[ ::nCurWindow ]:bPainted := { || oBrwSets:ForceStable() } + ::aWindows[ ::nCurWindow ]:bKeyPressed := { | nKey | ::SetsKeyPressed( nKey, oBrwSets, Len( aArray ),; + ::aWindows[ ::nCurWindow ], ::objname, Len( ::Arrayreference ), ::pitems ) } + ::aWindows[ ::nCurwindow ]:cCaption := ::objname + " is of class: " +::TheObj:ClassName() SetCursor( SC_NONE ) - ::aWindows[::nCurWindow]:ShowModal() -return self + ::aWindows[ ::nCurWindow ]:ShowModal() -method SetsKeyPressed( nKey, oBrwSets, nSets, oWnd ,cName,LenArr,aArray) class tdbgObject + RETURN Self - local nSet := oBrwSets:Cargo - local cTemp:=str(nSet,4) - local cOldname:= ::objname - - HB_SYMBOL_UNUSED( nSets ) - HB_SYMBOL_UNUSED( oWnd ) - HB_SYMBOL_UNUSED( cName ) - HB_SYMBOL_UNUSED( LenArr ) - - Switch nKey - case K_UP - if oBrwSets:Cargo > 1 - oBrwSets:Cargo-- - oBrwSets:RefreshCurrent() - oBrwSets:Up() - oBrwSets:ForceStable() - endif - exit - - case K_DOWN - if oBrwSets:Cargo < nSets - oBrwSets:Cargo++ - oBrwSets:RefreshCurrent() - oBrwSets:Down() - oBrwSets:ForceStable() - endif - exit - - case K_HOME - if oBrwSets:Cargo > 1 - oBrwSets:Cargo := 1 - oBrwSets:GoTop() - oBrwSets:ForceStable() - endif - exit - - case K_END - if oBrwSets:Cargo < nSets - oBrwSets:Cargo := nSets - oBrwSets:GoBottom() - oBrwSets:ForceStable() - endif - exit - - case K_PGUP - oBrwSets:PageUp() - oBrwSets:Cargo := ::ArrayIndex - oBrwSets:RefreshCurrent() - oBrwSets:ForceStable() - exit - - case K_PGDN - oBrwSets:PageDown() - oBrwSets:Cargo := ::ArrayIndex - oBrwSets:RefreshCurrent() - oBrwSets:ForceStable() - exit - - Case K_ENTER - if nSet==oBrwSets:Cargo - if valtype(aArray[nSet,2])=="A" - if len( aArray[nSet,2])>0 - TDBGArray():New(aArray[nSet,2],::pitems[nSet,1]) - endif - elseif valtype(aArray[nSet,2])=="H" - if len( aArray[nSet,2])>0 - TDBGHash():New(aArray[nSet,2],::pitems[nSet,1]) - endif - elseif valtype(aArray[nSet,2])=="O" - tdbgObject():New(aArray[nSet,2],::pitems[nSet,1]) - elseif ( ValType( aArray[ nSet, 2 ] ) == "C" .AND. ; - aArray[ nSet, 2 ] == "Method" ) .OR. ; - ValType( aArray[ nSet, 2 ] ) == "B" .OR. ; - ValType( aArray[ nSet, 2 ] ) == "P" - Alert("Value cannot be edited") - - else - if ::lEditable - oBrwSets:RefreshCurrent() - cTemp:=::doget(oBrwsets,::arrayreference,nSet) - oBrwSets:RefreshCurrent() - oBrwSets:ForceStable() - else - Alert( "Value cannot be edited" ) - endif - - endif - - endif - exit - - end - -return nil - -static function ValToStr( uVal ) - - local cType := ValType( uVal ) - local cResult := "U" - - Switch cType - case "U" - cResult := "NIL" - exit - - case "A" - cResult := "{ ... }" - exit - - case "H" - cResult := "Hash of " + AllTrim( Str( Len( uVal ) ) ) + " elements" - exit - - case "C" - case "M" - cResult := '"' + uVal + '"' - exit - - case "L" - cResult := iif( uVal, ".T.", ".F." ) - exit - - case "D" - cResult := DToC( uVal ) - exit - - case "N" - cResult := AllTrim( Str( uVal ) ) - exit - - case "O" - cResult := "Class " + uVal:ClassName() + " object" - exit - - case "B" - cResult:= "{ || ... }" - exit - - case "P" - cResult := "Pointer" - exit - - end - -return cResult - -METHOD doGet(oBro,pItem,nSet) class tdbgObject +METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject #ifndef HB_NO_READDBG - LOCAL column, nKey - local getlist:={} - // save state - LOCAL lScoreSave := Set( _SET_SCOREBOARD, .f. ) - LOCAL lExitSave := Set( _SET_EXIT, .t. ) - LOCAL bInsSave := SetKey( K_INS ) - local cValue + LOCAL column + LOCAL nKey + LOCAL GetList := {} + LOCAL lScoreSave := Set( _SET_SCOREBOARD, .F. ) + LOCAL lExitSave := Set( _SET_EXIT, .T. ) + LOCAL bInsSave := SetKey( K_INS ) + LOCAL cValue - // make sure browse is stable - obro:forcestable() - // if confirming new record, append blank + // make sure browse is stable + oBrowse:forceStable() + // if confirming new record, append blank - // set insert key to toggle insert mode and cursor - SetKey( K_INS, ; - { || SetCursor( if(ReadInsert(!ReadInsert()), SC_NORMAL, SC_INSERT)) }; - ) + // set insert key to toggle insert mode and cursor + SetKey( K_INS, { || SetCursor( iif( ReadInsert( ! ReadInsert() ),; + SC_NORMAL, SC_INSERT ) ) } ) - // initial cursor setting - SetCursor( IF( ReadInsert(), SC_INSERT, SC_NORMAL ) ) + // initial cursor setting + SetCursor( iif( ReadInsert(), SC_INSERT, SC_NORMAL ) ) - // get column object from browse - column := oBro:getColumn( oBro:colPos ) + // get column object from browse + column := oBrowse:getColumn( oBrowse:colPos ) - // create a corresponding GET - cValue := PadR( ValToStr( pitem[nSet,2] ), column:Width ) - @ row(),col() GET cValue ; - VALID If( Type( cValue ) == "UE", ( Alert( "Expression error" ), .f. ), .t. ) + // create a corresponding GET + cValue := PadR( __dbgValToStr( pitem[ nSet, 2 ] ), column:Width ) + @ Row(), Col() GET cValue ; + VALID iif( Type( cValue ) == "UE", ( Alert( "Expression error" ), .F. ), .T. ) + READ - // read it - ReadModal(getlist ) -// eval(column:block,get:Buffer) - // restore state - SetCursor( 0 ) - Set( _SET_SCOREBOARD, lScoreSave ) - Set( _SET_EXIT, lExitSave ) - SetKey( K_INS, bInsSave ) + SetCursor( SC_NONE ) + Set( _SET_SCOREBOARD, lScoreSave ) + Set( _SET_EXIT, lExitSave ) + SetKey( K_INS, bInsSave ) - if LastKey() == K_ENTER - __ObjSendMsg( ::TheObj, "_" + pitem[ nSet, 1 ], &cValue ) - endif + IF LastKey() == K_ENTER + __ObjSendMsg( ::TheObj, "_" + pitem[ nSet, 1 ], &cValue ) + ENDIF - // check exit key from get - nKey := LastKey() - IF nKey == K_UP .OR. nKey == K_DOWN .OR. nKey == K_PGUP .OR. nKey == K_PGDN - KEYBOARD CHR( nKey ) - END + // check exit key from get + nKey := LastKey() + IF nKey == K_UP .OR. nKey == K_DOWN .OR. nKey == K_PGUP .OR. nKey == K_PGDN + KEYBOARD Chr( nKey ) + ENDIF #else - HB_SYMBOL_UNUSED( oBro ) - HB_SYMBOL_UNUSED( pItem ) - HB_SYMBOL_UNUSED( nSet ) + HB_SYMBOL_UNUSED( oBrowse ) + HB_SYMBOL_UNUSED( pItem ) + HB_SYMBOL_UNUSED( nSet ) #endif -RETURN nil + RETURN NIL -static FUNC maxelem( a ) +METHOD SetsKeyPressed( nKey, oBrwSets, nSets, oWnd, cName, aArray ) CLASS HBDbObject - LOCAL max := 0 - LOCAL tam := 0 - LOCAL elem + LOCAL nSet := oBrwSets:Cargo + LOCAL cOldname := ::objname - for each elem in a - tam := LEN( elem ) - max := IF( tam > max, tam, max ) + HB_SYMBOL_UNUSED( oWnd ) + HB_SYMBOL_UNUSED( cName ) + + DO CASE + CASE nKey == K_UP + + IF oBrwSets:Cargo > 1 + oBrwSets:Cargo-- + oBrwSets:RefreshCurrent() + oBrwSets:Up() + oBrwSets:ForceStable() + ENDIF + + CASE nKey == K_DOWN + + IF oBrwSets:Cargo < nSets + oBrwSets:Cargo++ + oBrwSets:RefreshCurrent() + oBrwSets:Down() + oBrwSets:ForceStable() + ENDIF + + CASE nKey == K_HOME + + IF oBrwSets:Cargo > 1 + oBrwSets:Cargo := 1 + oBrwSets:GoTop() + oBrwSets:ForceStable() + ENDIF + + CASE nKey == K_END + + IF oBrwSets:Cargo < nSets + oBrwSets:Cargo := nSets + oBrwSets:GoBottom() + oBrwSets:ForceStable() + ENDIF + + CASE nKey == K_PGUP + + oBrwSets:PageUp() + oBrwSets:Cargo := ::ArrayIndex + oBrwSets:RefreshCurrent() + oBrwSets:ForceStable() + + CASE nKey == K_PGDN + + oBrwSets:PageDown() + oBrwSets:Cargo := ::ArrayIndex + oBrwSets:RefreshCurrent() + oBrwSets:ForceStable() + + CASE nKey == K_ENTER + + IF nSet == oBrwSets:Cargo + IF ISARRAY( aArray[ nSet, 2 ] ) + IF Len( aArray[ nSet, 2 ] ) > 0 + HBDbArray():New( aArray[ nSet, 2 ], ::pitems[ nSet, 1 ] ) + ENDIF + ELSEIF ValType( aArray[ nSet, 2 ] ) == "H" + IF Len( aArray[ nSet, 2 ] ) > 0 + HBDbHash():New( aArray[ nSet, 2 ], ::pitems[ nSet, 1 ] ) + ENDIF + ELSEIF ISOBJECT( aArray[ nSet, 2 ] ) + HBDbObject():New( aArray[ nSet, 2 ], ::pitems[ nSet, 1 ] ) + ELSEIF ( ISCHARACTER( aArray[ nSet, 2 ] ) .AND. ; + aArray[ nSet, 2 ] == "Method" ) .OR. ; + ISBLOCK( aArray[ nSet, 2 ] ) .OR. ; + ValType( aArray[ nSet, 2 ] ) == "P" + Alert( "Value cannot be edited" ) + ELSE + IF ::lEditable + oBrwSets:RefreshCurrent() + ::doGet( oBrwSets, ::arrayreference, nSet ) + oBrwSets:RefreshCurrent() + oBrwSets:ForceStable() + else + Alert( "Value cannot be edited" ) + ENDIF + ENDIF + ENDIF + + ENDCASE + + RETURN NIL + +FUNCTION __dbgObject( aArray, cVarName, lEditable ) + RETURN HBDbObject():New( aArray, cVarName, lEditable ) + +STATIC FUNCTION ArrayMaxLen( aArray ) + + LOCAL nMaxLen := 0 + LOCAL nLen + LOCAL cItem + + FOR EACH cItem IN aArray + nLen := Len( cItem ) + IF nMaxLen < nLen + nMaxLen := nLen + ENDIF NEXT -RETURN max - -function __DbgObject(aArray,pArName,lEditable) -return TDBGObject():New(aArray,pArName,lEditable) + RETURN nMaxLen diff --git a/harbour/source/debug/dbgtwin.prg b/harbour/source/debug/dbgtwin.prg index 81e2e965aa..9d3886c094 100644 --- a/harbour/source/debug/dbgtwin.prg +++ b/harbour/source/debug/dbgtwin.prg @@ -50,29 +50,52 @@ * */ +/* + * The following parts are Copyright of the individual authors. + * www - http://www.harbour-project.org + * + * Copyright 2000 Luiz Rafael Culik + * :Move() + * + * See doc/license.txt for licensing terms. + * + */ + /* NOTE: Don't use SAY/DevOut()/DevPos() for screen output, otherwise the debugger output may interfere with the applications output redirection, and is also slower. [vszakats] */ #include "hbclass.ch" #include "hbmemvar.ch" + #include "box.ch" -#include "inkey.ch" #include "common.ch" +#include "inkey.ch" #include "setcurs.ch" -CLASS TDbWindow // Debugger windows and dialogs +CREATE CLASS HBDbWindow // Debugger windows and dialogs - DATA nTop, nLeft, nBottom, nRight - DATA cCaption - DATA cBackImage, cColor - DATA lFocused, bGotFocus, bLostFocus - DATA bKeyPressed, bPainted, bLButtonDown, bLDblClick - DATA lShadow, lVisible - DATA Cargo - DATA Browser + VAR nTop + VAR nLeft + VAR nBottom + VAR nRight + VAR cCaption + VAR cBackImage + VAR cColor + VAR lFocused INIT .F. + VAR bGotFocus + VAR bLostFocus + VAR bKeyPressed + VAR bPainted + VAR bLButtonDown + VAR bLDblClick + VAR lShadow INIT .F. + VAR lVisible INIT .F. + VAR Cargo + VAR Browser METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) + METHOD Hide() METHOD IsOver( nRow, nCol ) METHOD nWidth() INLINE ::nRight - ::nLeft + 1 @@ -94,14 +117,7 @@ CLASS TDbWindow // Debugger windows and dialogs ENDCLASS -METHOD Clear() CLASS TDbWindow - - SetColor( ::cColor ) - Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1 ) - -RETURN nil - -METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) CLASS TDbWindow +METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) CLASS HBDbWindow DEFAULT cColor TO __DbgColors()[ 1 ] @@ -111,13 +127,17 @@ METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) CLASS TDbWindow ::nRight := nRight ::cCaption := cCaption ::cColor := cColor - ::lShadow := .f. - ::lVisible := .f. - ::lFocused := .f. return Self -METHOD Hide() CLASS TDbWindow +METHOD Clear() CLASS HBDbWindow + + SetColor( ::cColor ) + Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1 ) + +return nil + +METHOD Hide() CLASS HBDbWindow RestScreen( ::nTop, ::nLeft, ::nBottom + iif( ::lShadow, 1, 0 ),; ::nRight + iif( ::lShadow, 2, 0 ), ::cBackImage ) @@ -126,12 +146,12 @@ METHOD Hide() CLASS TDbWindow return nil -METHOD IsOver( nRow, nCol ) CLASS TDbWindow +METHOD IsOver( nRow, nCol ) CLASS HBDbWindow return nRow >= ::nTop .and. nRow <= ::nBottom .and. ; nCol >= ::nLeft .and. nCol <= ::nRight -METHOD ScrollUp( nLines ) CLASS TDbWindow +METHOD ScrollUp( nLines ) CLASS HBDbWindow DEFAULT nLines TO 1 @@ -140,12 +160,14 @@ METHOD ScrollUp( nLines ) CLASS TDbWindow return nil -METHOD SetCaption( cCaption ) CLASS TDbWindow +METHOD SetCaption( cCaption ) CLASS HBDbWindow ::cCaption := cCaption + return nil -METHOD ShowCaption CLASS TDbWindow +METHOD ShowCaption CLASS HBDbWindow + if ! Empty( ::cCaption ) DispOutAt( ::nTop, ::nLeft + ( ( ::nRight - ::nLeft ) / 2 ) - ; ( ( Len( ::cCaption ) + 2 ) / 2 ),; @@ -154,7 +176,7 @@ METHOD ShowCaption CLASS TDbWindow return nil -METHOD SetFocus( lOnOff ) CLASS TDbWindow +METHOD SetFocus( lOnOff ) CLASS HBDbWindow if ! lOnOff .and. ::bLostFocus != nil Eval( ::bLostFocus, Self ) @@ -168,7 +190,7 @@ METHOD SetFocus( lOnOff ) CLASS TDbWindow return nil -METHOD Refresh() CLASS TDbWindow +METHOD Refresh() CLASS HBDbWindow DispBegin() @@ -187,13 +209,11 @@ METHOD Refresh() CLASS TDbWindow return nil -METHOD Show( lFocused ) CLASS TDbWindow - LOCAL nRow, nCol +METHOD Show( lFocused ) CLASS HBDbWindow + LOCAL nRow := Row() + LOCAL nCol := Col() DEFAULT lFocused TO ::lFocused - - nRow := Row() - nCol := Col() ::cBackImage := SaveScreen( ::nTop, ::nLeft, ::nBottom + iif( ::lShadow, 1, 0 ),; ::nRight + iif( ::lShadow, 2, 0 ) ) @@ -201,7 +221,7 @@ METHOD Show( lFocused ) CLASS TDbWindow Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight ) ::SetFocus( lFocused ) - If ::lShadow + if ::lShadow hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight ) endif @@ -209,9 +229,10 @@ METHOD Show( lFocused ) CLASS TDbWindow ::lVisible := .t. SetPos( nRow, nCol ) + return nil -METHOD ShowModal() CLASS TDbWindow +METHOD ShowModal() CLASS HBDbWindow local lExit := .f. local nKey @@ -219,30 +240,30 @@ METHOD ShowModal() CLASS TDbWindow ::lShadow := .t. ::Show() - while ! lExit - nKey := InKey( 0, INKEY_ALL ) + do while ! lExit + nKey := Inkey( 0, INKEY_ALL ) if ::bKeyPressed != nil Eval( ::bKeyPressed, nKey ) endif do case - case nKey == K_ESC - lExit := .t. + case nKey == K_ESC + lExit := .t. - case nKey == K_LBUTTONDOWN - if MRow() == ::nTop .and. MCol() >= ::nLeft + 1 .and. ; - MCol() <= ::nLeft + 3 - lExit := .t. - endif + case nKey == K_LBUTTONDOWN + if MRow() == ::nTop .and. MCol() >= ::nLeft + 1 .and. ; + MCol() <= ::nLeft + 3 + lExit := .t. + endif endcase - end + enddo ::Hide() return nil -METHOD LButtonDown( nMRow, nMCol ) CLASS TDbWindow +METHOD LButtonDown( nMRow, nMCol ) CLASS HBDbWindow if ::bLButtonDown != nil Eval( ::bLButtonDown, nMRow, nMCol ) @@ -250,7 +271,7 @@ METHOD LButtonDown( nMRow, nMCol ) CLASS TDbWindow return nil -METHOD LDblClick( nMRow, nMCol ) CLASS TDbWindow +METHOD LDblClick( nMRow, nMCol ) CLASS HBDbWindow if ::bLDblClick != nil Eval( ::bLDblClick, nMRow, nMCol ) @@ -258,11 +279,7 @@ METHOD LDblClick( nMRow, nMCol ) CLASS TDbWindow return nil -/*Method move() -Move a window across the screen -Copyright Luiz Rafael Culik 1999 -*/ -METHOD Move() Class TDbWindow +METHOD Move() Class HBDbWindow local nOldTop := ::nTop local nOldLeft := ::nLeft @@ -270,101 +287,113 @@ METHOD Move() Class TDbWindow local nOldRight := ::nright local nKey - 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 - if ::ntop != 0 - ::ntop-- - ::nbottom-- - endif + case nKey == K_UP - case nKey == K_DOWN - if ::nBottom != MaxRow() - ::nTop++ - ::nBottom++ - endif + if ::ntop != 0 + ::ntop-- + ::nbottom-- + endif - case nKey == K_LEFT - if ::nLeft != 0 - ::nLeft-- - ::nRight-- - endif + case nKey == K_DOWN - case nKey == K_RIGHT - if ::nBottom != MaxRow() - ::nLeft++ - ::nRight++ - endif + if ::nBottom != MaxRow() + ::nTop++ + ::nBottom++ + endif + + case nKey == K_LEFT + + if ::nLeft != 0 + ::nLeft-- + ::nRight-- + endif + + case nKey == K_RIGHT + + if ::nBottom != MaxRow() + ::nLeft++ + ::nRight++ + endif + + case nKey == K_ESC + + ::nTop := nOldTop + ::nLeft := nOldLeft + ::nBottom := nOldBottom + ::nRight := nOldRight - case nKey == K_ESC - ::nTop := nOldTop - ::nLeft := nOldLeft - ::nBottom := nOldBottom - ::nRight := nOldRight endcase if nKey == K_ESC .or. nKey == K_ENTER exit - end - end + endif + enddo - // __keyboard( chr( 0 ) ), inkey() ) + // __Keyboard( Chr( 0 ) ), Inkey() ) return nil -METHOD KeyPressed( nKey ) CLASS TDbWindow +METHOD KeyPressed( nKey ) CLASS HBDbWindow - if ::bKeyPressed != nil + if ::bKeyPressed != NIL Eval( ::bKeyPressed, nKey, Self ) endif return nil -METHOD LoadColors() CLASS TDbWindow - LOCAL aClr:=__DbgColors() +METHOD LoadColors() CLASS HBDbWindow + + local aClr := __DbgColors() ::cColor := aClr[ 1 ] - IF( ::Browser!=NIL ) + + IF ::Browser != NIL ::Browser:ColorSpec := aClr[ 2 ] + "," + aClr[ 5 ] + "," + aClr[ 3 ] ENDIF -RETURN nil +return nil -METHOD Resize( nTop, nLeft, nBottom, nRight ) CLASS TDbWindow - LOCAL lShow +METHOD Resize( nTop, nLeft, nBottom, nRight ) CLASS HBDbWindow - 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 + local lShow + + 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 + + if ( lShow := ::lVisible ) + ::Hide() + endif - IF lShow:=::lVisible - ::Hide() - ENDIF - IF nTop != NIL - ::nTop := nTop - ENDIF - IF nBottom != NIL - ::nBottom := nBottom - ENDIF - IF nLeft != NIL - ::nLeft := nLeft - ENDIF - IF nRight != NIL - ::nRight := nRight - ENDIF + if nTop != NIL + ::nTop := nTop + endif + if nBottom != NIL + ::nBottom := nBottom + endif + if nLeft != NIL + ::nLeft := nLeft + endif + if nRight != NIL + ::nRight := nRight + endif + + if ::Browser != NIL + ::Browser:Resize( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1 ) + endif + + if lShow + ::Show( ::lFocused ) + endif - IF ::Browser != NIL - ::Browser:Resize( ::nTop+1, ::nLeft+1, ::nBottom-1, ::nRight-1 ) - ENDIF - - IF lShow - ::Show( ::lFocused ) - ENDIF - -RETURN self +return self diff --git a/harbour/source/debug/dbgwa.prg b/harbour/source/debug/dbgwa.prg index 9b6e7c7988..d779074211 100644 --- a/harbour/source/debug/dbgwa.prg +++ b/harbour/source/debug/dbgwa.prg @@ -56,227 +56,211 @@ function __dbgShowWorkAreas() - local oDlg, oCol - local aAlias, aBrw, aStruc, aInfo - local cColor - local n1, n2, n3, cur_id - LOCAL nOldArea := Select() + local oDlg + local oCol - aAlias := {} - aBrw := Array(3) - n1 := 1 - n2 := 1 - n3 := 1 - cur_id := 1 + local aAlias := {} + local aBrw[ 3 ] + local aStruc + local aInfo - 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 nOldArea := Select() /* We can't determine the last used area, so use 512 here */ for n1 := 1 to 512 if ( n1 )->( Used() ) - AAdd(aAlias, { n1, Alias(n1) }) + AAdd( aAlias, { n1, Alias( n1 ) } ) if n1 == nOldArea - cur_id = Len(aAlias) + cur_id := Len( aAlias ) endif endif next - if len( aAlias ) == 0 + if Len( aAlias ) == 0 Alert( "No workareas in use") return nil endif IF !Used() - SELECT ( aAlias[1][1] ) + dbSelectArea( aAlias[ 1 ][ 1 ] ) ENDIF - /* - Window creation - */ + /* Window creation */ - oDlg := TDbWindow():New( 2, 3, 21, 74, "", cColor ) + oDlg := HBDbWindow():New( 2, 3, 21, 74, "", cColor ) oDlg:bKeyPressed := { | nKey | DlgWorkAreaKey( nKey, oDlg, aBrw, aAlias, @aStruc, @aInfo ) } oDlg:bPainted := { || DlgWorkAreaPaint( oDlg, aBrw ) } - /* - Alias browse - */ + /* Alias browse */ - aBrw[1] := TBrowseNew( oDlg:nTop + 1, oDlg:nLeft + 1, oDlg:nBottom - 1, oDlg:nLeft + 11 ) + aBrw[ 1 ] := TBrowseNew( oDlg:nTop + 1, oDlg:nLeft + 1, oDlg:nBottom - 1, oDlg:nLeft + 11 ) - aBrw[1]:Cargo := ( n1 := cur_id ) - 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 ),; + aBrw[ 1 ]:Cargo := ( n1 := cur_id ) + 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 } + n1 - nPos } - aBrw[1]:AddColumn( oCol := TBColumnNew( "", { || PadR( aAlias[n1][2], 11 ) } ) ) + aBrw[ 1 ]:AddColumn( oCol := TBColumnNew( "", { || PadR( aAlias[ n1 ][ 2 ], 11 ) } ) ) - oCol:ColorBlock := { || iif( aAlias[n1][1] == Select(), {3, 4}, {1, 2} ) } + oCol:ColorBlock := { || iif( aAlias[ n1 ][ 1 ] == Select(), { 3, 4 }, { 1, 2 } ) } - /* - Info Browse - */ + /* Info Browse */ - aInfo := ( aAlias[n1][1] )->( DbfInfo() ) + aInfo := ( aAlias[ n1 ][ 1 ] )->( DbfInfo() ) - aBrw[2] := TBrowseNew( oDlg:nTop + 7, oDlg:nLeft + 13, oDlg:nBottom - 1, oDlg:nLeft + 50 ) + 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 := { || aBrw[2]:Cargo := n2 := 1 } - aBrw[2]:GoBottomBlock := { || n2 := Len( aInfo ) } - aBrw[2]:SkipBlock := { | nSkip, nPos | nPos := n2,; - n2 := iif( nSkip > 0, Min( Len( aInfo ), n2 + nSkip ),; + aBrw[ 2 ]:Cargo := ( n2 := 1 ) + aBrw[ 2 ]:ColorSpec := oDlg:cColor + aBrw[ 2 ]:GoTopBlock := { || aBrw[ 2 ]:Cargo := 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) } ) ) + aBrw[ 2 ]:AddColumn( oCol := TBColumnNew( "", { || 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 - */ + /* Struc browse */ - aStruc := ( aAlias[n1][1] )->( DbStruct() ) + aStruc := ( aAlias[ n1 ][ 1 ] )->( DbStruct() ) - aBrw[3] := TBrowseNew( oDlg:nTop + 1, oDlg:nLeft + 52, oDlg:nBottom - 1, oDlg:nLeft + 70 ) + 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 := { || aBrw[3]:Cargo := n3 := 1 } - aBrw[3]:GoBottomBlock := { || n3 := Len( aStruc ) } - aBrw[3]:SkipBlock := { | nSkip, nPos | nPos := n3,; - n3 := iif( nSkip > 0, Min( Len( aStruc ), n3 + nSkip ),; + aBrw[ 3 ]:Cargo := 1 + aBrw[ 3 ]:ColorSpec := oDlg:cColor + aBrw[ 3 ]:GoTopBlock := { || aBrw[ 3 ]:Cargo := 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 ) } ) ) + aBrw[ 3 ]:AddColumn( TBColumnNew( "", { || PadR( aStruc[ n3, 1 ], 11) + ; + aStruc[ n3, 2 ] + ; + Str( aStruc[ n3, 3 ], 4 ) + ; + Str( aStruc[ n3, 4 ], 3 ) } ) ) - /* - Show dialog - */ + /* Show dialog */ oDlg:ShowModal() - SELECT ( nOldArea ) + dbSelectArea( nOldArea ) + return nil static function DlgWorkAreaPaint( oDlg, aBrw ) - /* - Display captions - */ + /* 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 - */ + /* 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 ) + 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 ) + 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 ) + DispOutAt( oDlg:nTop + 6, oDlg:nLeft + 12, Chr( 195 ), oDlg:cColor ) + DispOutAt( oDlg:nTop + 6, oDlg:nLeft + 51, Chr( 180 ), oDlg:cColor ) - /* - Display labels - */ + /* 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 ) + 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 - */ + /* Stabilize browse */ - aBrw[1]:ForceStable() - aBrw[2]:ForceStable() - aBrw[3]:ForceStable() - aBrw[2]:Dehilite() - aBrw[3]:Dehilite() + aBrw[ 1 ]:ForceStable() + aBrw[ 2 ]:ForceStable() + aBrw[ 3 ]:ForceStable() + aBrw[ 2 ]:Dehilite() + aBrw[ 3 ]:Dehilite() - UpdateInfo(oDlg, Alias()) + UpdateInfo( oDlg, Alias() ) return nil static function DlgWorkAreaKey( nKey, oDlg, aBrw, aAlias, aStruc, aInfo ) - static nFocus := 1 + static s_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 + aBrw[ s_nFocus ]:Dehilite() + s_nFocus := s_nFocus + iif( nKey == K_TAB, 1, -1) + if s_nFocus < 1 + s_nFocus := 3 endif - if nFocus > 3 - nFocus := 1 + if s_nFocus > 3 + s_nFocus := 1 endif - aBrw[nFocus]:Hilite() + aBrw[ s_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][1] )->( 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][1] )->( DbStruct() ) - aBrw[3]:Configure() - aBrw[3]:Invalidate() - aBrw[3]:RefreshAll() - aBrw[3]:ForceStable() - aBrw[3]:Dehilite() - UpdateInfo( oDlg, aAlias[aBrw[1]:Cargo][2] ) + case s_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 ][ 1 ] )->( 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 ][ 1 ] )->( DbStruct() ) + aBrw[ 3 ]:Configure() + aBrw[ 3 ]:Invalidate() + aBrw[ 3 ]:RefreshAll() + aBrw[ 3 ]:ForceStable() + aBrw[ 3 ]:Dehilite() + UpdateInfo( oDlg, aAlias[ aBrw[ 1 ]:Cargo ][ 2 ] ) endif - case nFocus == 2 - WorkAreasKeyPressed( nKey, aBrw[2], oDlg, len( aInfo ) ) - case nFocus == 3 - WorkAreasKeyPressed( nKey, aBrw[3], oDlg, len( aStruc ) ) - end case + case s_nFocus == 2 + WorkAreasKeyPressed( nKey, aBrw[ 2 ], oDlg, Len( aInfo ) ) + case s_nFocus == 3 + WorkAreasKeyPressed( nKey, aBrw[ 3 ], oDlg, Len( aStruc ) ) + endcase return nil @@ -285,35 +269,39 @@ static procedure WorkAreasKeyPressed( nKey, oBrw, oDlg, nTotal ) HB_SYMBOL_UNUSED( oDlg ) do case - case nKey == K_UP - if oBrw:Cargo > 1 - oBrw:Cargo-- - oBrw:RefreshCurrent() - oBrw:Up() - oBrw:ForceStable() - endif + case nKey == K_UP - case nKey == K_DOWN - if oBrw:Cargo < nTotal - oBrw:Cargo++ - oBrw:RefreshCurrent() - oBrw:Down() - oBrw:ForceStable() - endif + if oBrw:Cargo > 1 + oBrw:Cargo-- + oBrw:RefreshCurrent() + oBrw:Up() + oBrw:ForceStable() + endif - case nKey == K_HOME - if oBrw:Cargo > 1 - oBrw:Cargo := 1 - oBrw:GoTop() - oBrw:ForceStable() - endif + case nKey == K_DOWN - case nKey == K_END - if oBrw:Cargo < nTotal - oBrw:Cargo := nTotal - oBrw:GoBottom() - oBrw:ForceStable() - endif + 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 @@ -322,43 +310,39 @@ return static function DbfInfo( aInfo ) local nFor - local xType, xValue, cValue + local xType + local xValue + local 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") + 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 ) + 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 + 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 ) ) + AAdd( aInfo, Space( 8 ) + PadR( FieldName( nFor ), 10) + " = " + PadR( cValue, 17 ) ) next @@ -368,27 +352,26 @@ static function UpdateInfo( oDlg, cAlias ) local nOldArea - if empty(cAlias) - return NIL + if Empty( cAlias ) + return NIL endif nOldArea := Select() - SELECT (cAlias) + dbSelectArea( 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 ),; + 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( Eof(),"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 + 5, oDlg:nLeft + 21 , Padr( OrdKey(), 29 ), 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( Eof(),"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 + 5, oDlg:nLeft + 21, PadR( ordKey(), 29 ), oDlg:cColor ) - SELECT (nOldArea) + dbSelectArea( nOldArea ) return nil - diff --git a/harbour/source/debug/debugger.prg b/harbour/source/debug/debugger.prg index f840c75067..e16f1db53a 100644 --- a/harbour/source/debug/debugger.prg +++ b/harbour/source/debug/debugger.prg @@ -62,29 +62,17 @@ the debugger output may interfere with the applications output redirection, and is also slower. [vszakats] */ -//#pragma -es0 - -#pragma BEGINDUMP - -#include "hbapigt.h" -#include "hbapidbg.h" - -#pragma ENDDUMP - #include "hbclass.ch" -#include "hbmemvar.ch" -#include "box.ch" -#include "inkey.ch" -#include "common.ch" -#include "set.ch" -#include "setcurs.ch" -#include "getexit.ch" #include "hbdebug.ch" // for "nMode" of __dbgEntry #include "hbgtinfo.ch" +#include "hbmemvar.ch" - -#define NTRIM(x) (ALLTRIM(STR(x))) - +#include "box.ch" +#include "common.ch" +#include "getexit.ch" +#include "inkey.ch" +#include "set.ch" +#include "setcurs.ch" /* A macro to compare filenames on different platforms. */ #ifdef __PLATFORM__DOS @@ -103,121 +91,168 @@ /* Information structure stored in DATA aCallStack */ -#define CSTACK_MODULE 1 //module name (.PRG file) -#define CSTACK_FUNCTION 2 //function name -#define CSTACK_LINE 3 //start line -#define CSTACK_LEVEL 4 //eval stack level of the function -#define CSTACK_LOCALS 5 //an array with local variables -#define CSTACK_STATICS 6 //an array with static variables +#define CSTACK_MODULE 1 //module name (.PRG file) +#define CSTACK_FUNCTION 2 //function name +#define CSTACK_LINE 3 //start line +#define CSTACK_LEVEL 4 //eval stack level of the function +#define CSTACK_LOCALS 5 //an array with local variables +#define CSTACK_STATICS 6 //an array with static variables /* Information structure stored in aCallStack[n][ CSTACK_LOCALS ] { cLocalName, nLocalIndex, "Local", ProcName( 1 ), nLevel } */ -#define VAR_NAME 1 -#define VAR_POS 2 -#define VAR_TYPE 3 -#define VAR_LEVEL 4 //eval stack level of the function +#define VAR_NAME 1 +#define VAR_POS 2 +#define VAR_TYPE 3 +#define VAR_LEVEL 4 //eval stack level of the function /* Information structure stored in ::aWatch (watchpoints) */ -#define WP_TYPE 1 //wp = watchpoint, tr = tracepoint -#define WP_EXPR 2 //source of an expression +#define WP_TYPE 1 //wp = watchpoint, tr = tracepoint +#define WP_EXPR 2 //source of an expression /* Information structure stored in ::aModules */ -#define MODULE_NAME 1 -#define MODULE_STATICS 2 -#define MODULE_GLOBALS 3 -#define MODULE_EXTERNGLOBALS 4 +#define MODULE_NAME 1 +#define MODULE_STATICS 2 +#define MODULE_GLOBALS 3 +#define MODULE_EXTERNGLOBALS 4 * The dimension of the debugger window -#define DEBUGGER_MINROW 0 -#define DEBUGGER_MINCOL 0 -#define DEBUGGER_MAXROW 22 -#define DEBUGGER_MAXCOL 77 +#define DEBUGGER_MINROW 0 +#define DEBUGGER_MINCOL 0 +#define DEBUGGER_MAXROW 22 +#define DEBUGGER_MAXCOL 77 -static s_oDebugger +STATIC s_oDebugger +PROCEDURE __dbgAltDEntry() -procedure __dbgAltDEntry() /* do not activate the debugger imediatelly because the module where ALTD() was called can have no debugger info - stop on first LINE with debugged info */ - HB_DBG_INVOKEDEBUG( SET( _SET_DEBUG ) ) -return + hb_DBG_INVOKEDEBUG( Set( _SET_DEBUG ) ) + RETURN -procedure __dbgEntry( nMode, uParam1, uParam2, uParam3, uParam4, uParam5 ) // debugger entry point - LOCAL bStartup := .F. +PROCEDURE __dbgEntry( nMode, uParam1, uParam2, uParam3, uParam4, uParam5 ) // debugger entry point - DO CASE - CASE nMode == HB_DBG_GETENTRY - HB_DBG_SetEntry() + LOCAL bStartup := .F. + + DO CASE + CASE nMode == HB_DBG_GETENTRY + + hb_DBG_SetEntry() + + CASE nMode == HB_DBG_ACTIVATE - CASE nMode == HB_DBG_ACTIVATE IF s_oDebugger == NIL - bStartup := .T. - s_oDebugger := TDebugger():New() - s_oDebugger:pInfo := uParam1 + bStartup := .T. + s_oDebugger := HBDebugger():New() + s_oDebugger:pInfo := uParam1 ENDIF s_oDebugger:nProcLevel := uParam2 s_oDebugger:aCallStack := uParam3 s_oDebugger:aModules := uParam4 s_oDebugger:aBreakPoints := uParam5 IF bStartup - IF s_oDebugger:lRunAtStartup - HB_DBG_SetGo( uParam1 ) - RETURN - ENDIF + IF s_oDebugger:lRunAtStartup + hb_DBG_SetGo( uParam1 ) + RETURN + ENDIF ENDIF s_oDebugger:lGo := .F. s_oDebugger:Activate() - ENDCASE -return + ENDCASE + RETURN -CLASS TDebugger - DATA pInfo - DATA aWindows, nCurrentWindow - DATA oPullDown - DATA oWndCode, oWndCommand, oWndStack, oWndVars - DATA oBar, oBrwText, cPrgName, oBrwStack, oBrwVars, aVars - DATA nAppDispCount - DATA nAppLastKey, bAppInkeyAfter, bAppInkeyBefore, bAppClassScope - DATA nAppDirCase, nAppFileCase, oAppGetList, nAppTypeAhead - DATA nMaxRow, nMaxCol +CREATE CLASS HBDebugger - DATA hUserWindow, hDebuggerWindow - DATA lDebuggerWindowIsOpen INIT .F. + VAR pInfo + VAR aWindows INIT {} + VAR nCurrentWindow INIT 1 + VAR oPullDown - DATA aBreakPoints - DATA aCallStack //stack of procedures with debug info - DATA aProcStack //stack of all procedures - DATA nProcLevel //procedure level where the debugger is currently - DATA aModules // array of modules with static and GLOBAL variables - DATA aColors - DATA aWatch - DATA aLastCommands, nCommand, oGetListCommand - DATA lAnimate, lEnd, lCaseSensitive, lMonoDisplay, lSortVars - DATA cSearchString, cPathForFiles, cSettingsFileName, aPathDirs - DATA nTabWidth, nSpeed - DATA lShowPublics, lShowPrivates, lShowStatics, lShowLocals, lShowGlobals - DATA lShowAllGlobals, lAll - DATA lShowCallStack - DATA lGo //stores if GO was requested - DATA lActive INIT .F. - DATA lCBTrace INIT .T. //stores if codeblock tracing is allowed - DATA oBrwPnt, oWndPnt - DATA lPPO INIT .F. - DATA lRunAtStartup - DATA lLineNumbers INIT .T. + VAR oWndCode + VAR oWndCommand + VAR oWndStack + VAR oWndVars + + VAR oBar + VAR oBrwText + VAR cPrgName + VAR oBrwStack + VAR oBrwVars + VAR aVars INIT {} + + VAR nAppDispCount + VAR nAppLastKey + VAR bAppInkeyAfter + VAR bAppInkeyBefore + VAR bAppClassScope + + VAR nAppDirCase + VAR nAppFileCase + VAR oAppGetList + VAR nAppTypeAhead + + VAR nMaxRow + VAR nMaxCol + + VAR hUserWindow + VAR hDebuggerWindow + VAR lDebuggerWindowIsOpen INIT .F. + + VAR aBreakPoints INIT {} + VAR aCallStack INIT {} // stack of procedures with debug info + VAR aProcStack INIT {} // stack of all procedures + VAR nProcLevel // procedure level where the debugger is currently + VAR aModules INIT {} // array of modules with static and GLOBAL variables + VAR aWatch INIT {} + VAR aColors INIT { "W+/BG", "N/BG", "R/BG", "N+/BG", "W+/B", "GR+/B", "W/B", "N/W", "R/W", "N/BG", "R/BG" } + + VAR aLastCommands + VAR nCommand + VAR oGetListCommand + + VAR lAnimate INIT .F. + VAR lEnd INIT .F. + VAR lCaseSensitive INIT .F. + VAR lMonoDisplay INIT .F. + VAR lSortVars INIT .F. + + VAR cSearchString INIT "" + VAR cPathForFiles + VAR cSettingsFileName INIT "init.cld" + VAR aPathDirs + + VAR nTabWidth INIT 4 + VAR nSpeed INIT 0 + + VAR lShowPublics INIT .F. + VAR lShowPrivates INIT .F. + VAR lShowStatics INIT .F. + VAR lShowLocals INIT .F. + VAR lShowGlobals INIT .F. + VAR lShowAllGlobals INIT .F. + VAR lAll INIT .F. + VAR lShowCallStack INIT .F. + VAR lGo // stores if GO was requested + VAR lActive INIT .F. + VAR lCBTrace INIT .T. // stores if codeblock tracing is allowed + VAR oBrwPnt + VAR oWndPnt + VAR lPPO INIT .F. + VAR lRunAtStartup INIT .T. // Clipper compatible + VAR lLineNumbers INIT .T. METHOD New() METHOD Activate() METHOD All() - METHOD Animate() INLINE If( ::lAnimate, ::Step(), nil ) + METHOD Animate() INLINE iif( ::lAnimate, ::Step(), NIL ) METHOD BarDisplay() METHOD BuildCommandWindow() @@ -236,7 +271,7 @@ CLASS TDebugger METHOD EditColor( nColor, oBrwColors ) METHOD EditSet( nSet, oBrwSets ) METHOD EditVar( nVar ) - METHOD Exit() INLINE ::lEnd := .t. + METHOD Exit() INLINE ::lEnd := .T. METHOD FindNext() METHOD FindPrevious() METHOD GetExprValue( xExpr, lValid ) @@ -293,9 +328,9 @@ CLASS TDebugger METHOD RedisplayBreakpoints() METHOD LocatePrgPath( cPrgName ) METHOD Sort() INLINE ASort( ::aVars,,, {|x,y| x[1] < y[1] } ),; - ::lSortVars := .t.,; - iif( ::oBrwVars != nil, ::oBrwVars:RefreshAll(), nil ),; - iif( ::oWndVars != nil .and. ::oWndVars:lVisible, iif(!::lGo,::oBrwVars:ForceStable(),),) + ::lSortVars := .T.,; + iif( ::oBrwVars != NIL, ::oBrwVars:RefreshAll(), NIL ),; + iif( ::oWndVars != NIL .AND. ::oWndVars:lVisible, iif(!::lGo,::oBrwVars:ForceStable(),),) METHOD Speed() INLINE ; ::nSpeed := ::InputBox( "Step delay (in tenths of a second)",; @@ -347,56 +382,28 @@ CLASS TDebugger ENDCLASS -METHOD New() CLASS TDebugger +METHOD New() CLASS HBDebugger s_oDebugger := Self - ::aColors := {"W+/BG","N/BG","R/BG","N+/BG","W+/B","GR+/B","W/B","N/W","R/W","N/BG","R/BG"} - ::lMonoDisplay := .f. - ::aWindows := {} - ::nCurrentWindow := 1 - ::lAnimate := .f. - ::lEnd := .f. - ::aBreakPoints := {} - ::aWatch := {} - ::aCallStack := {} - ::aModules := {} - ::aProcStack := {} - ::aVars := {} - ::lCaseSensitive := .f. - ::cSearchString := "" - // default the search path for files to the current directory // that way if the source is in the same directory it will still be found even if the application // changes the current directory with the SET DEFAULT command ::cPathForFiles := getenv( "HB_DBG_PATH" ) - if empty( ::cPathForFiles ) + if Empty( ::cPathForFiles ) ::cPathForFiles := getenv( "PATH" ) endif ::aPathDirs := PathToArray( ::cPathForFiles ) - ::nTabWidth := 4 - ::nSpeed := 0 - ::lShowCallStack := .f. - ::lShowPublics := .f. - ::lShowPrivates := .f. - ::lShowStatics := .f. - ::lShowLocals := .f. - ::lShowGlobals := .F. - ::lShowAllGlobals := .F. - ::lAll := .f. - ::lSortVars := .f. - ::cSettingsFileName := "init.cld" - ::lRunAtStartup := .t. //Clipper compatible - ::lGo := ::lRunAtStartup + ::lGo := ::lRunAtStartup /* Store the initial screen dimensions for now */ ::nMaxRow := MaxRow() ::nMaxCol := MaxCol() - ::oPullDown := __dbgBuildMenu( Self ) + ::oPullDown := __dbgBuildMenu( Self ) - ::oWndCode := TDbWindow():New( 1, 0, ::nMaxRow - 6, ::nMaxCol ) + ::oWndCode := HBDbWindow():New( 1, 0, ::nMaxRow - 6, ::nMaxCol ) ::oWndCode:Cargo := { ::oWndCode:nTop, ::oWndCode:nLeft } ::oWndCode:bKeyPressed := { | nKey | ::CodeWindowProcessKey( nKey ) } ::oWndCode:bGotFocus := { || ::oGetListCommand:SetFocus(), SetCursor( SC_SPECIAL1 ), ; @@ -412,83 +419,86 @@ METHOD New() CLASS TDebugger if File( ::cSettingsFileName ) ::LoadSettings() endif - ::lGo := ::lRunAtStartup -return Self + + RETURN Self + +METHOD OpenDebuggerWindow() CLASS HBDebugger + + if !::lDebuggerWindowIsOpen + ::hUserWindow := hb_gtInfo( GTI_GETWIN ) + if ::hDebuggerWindow == NIL + ::hDebuggerWindow := hb_gtInfo( GTI_GETWIN, ; + { "Debugger", DEBUGGER_MINROW, DEBUGGER_MINCOL, ; + DEBUGGER_MAXROW, DEBUGGER_MAXCOL } ) + else + hb_gtInfo( GTI_SETWIN, ::hDebuggerWindow ) + endif + ::lDebuggerWindowIsOpen := .T. + endif + + RETURN NIL -METHOD OpenDebuggerWindow() CLASS TDebugger +METHOD CloseDebuggerWindow() CLASS HBDebugger - if !::lDebuggerWindowIsOpen - ::hUserWindow = hb_gtInfo( GTI_GETWIN ) - if ::hDebuggerWindow == NIL - ::hDebuggerWindow := hb_gtInfo( GTI_GETWIN, ; - { "Debugger", DEBUGGER_MINROW, DEBUGGER_MINCOL, ; - DEBUGGER_MAXROW, DEBUGGER_MAXCOL } ) - else - hb_gtInfo( GTI_SETWIN, ::hDebuggerWindow ) - endif - ::lDebuggerWindowIsOpen := .t. - endif + if ::lDebuggerWindowIsOpen + ::hDebuggerWindow := hb_gtInfo( GTI_GETWIN ) + hb_gtInfo( GTI_SETWIN, ::hUserWindow ) + ::lDebuggerWindowIsOpen := .F. + endif -return nil + RETURN NIL -METHOD CloseDebuggerWindow() CLASS Tdebugger +METHOD Activate() CLASS HBDebugger - if ::lDebuggerWindowIsOpen - ::hDebuggerWindow = hb_gtInfo( GTI_GETWIN ) - hb_gtInfo( GTI_SETWIN, ::hUserWindow ) - ::lDebuggerWindowIsOpen := .f. - endif + ::LoadCallStack() + ::SaveAppState() -return nil + IF ! ::lActive + ::lActive := .T. + ::Show() + IF ::lShowCallStack + ::ShowCallStack() + ENDIF + ELSE + ::SaveAppScreen() + ENDIF + + ::LoadVars() + ::ShowVars() + + IF ::oWndPnt != NIL + ::WatchpointsShow() + ENDIF + + // show the topmost procedure + ::ShowCodeLine( 1 ) //::aCallStack[1][ CSTACK_LINE ], ::aCallStack[1][ CSTACK_MODULE ] ) + ::HandleEvent() + + RETURN NIL -METHOD Activate() CLASS TDebugger - - ::LoadCallStack() - ::SaveAppState() - IF ! ::lActive - ::lActive := .T. - ::Show() - if ::lShowCallStack - ::ShowCallStack() - endif - ELSE - ::SaveAppScreen() - ENDIF - ::LoadVars() - ::ShowVars() - IF( ::oWndPnt != NIL ) - ::WatchpointsShow() - ENDIF - // show the topmost procedure - ::ShowCodeLine( 1 ) //::aCallStack[1][ CSTACK_LINE ], ::aCallStack[1][ CSTACK_MODULE ] ) - ::HandleEvent() - -return nil - -METHOD All() CLASS TDebugger +METHOD All() CLASS HBDebugger ::lShowPublics := ::lShowPrivates := ::lShowStatics := ; ::lShowLocals := ::lShowGlobals := ::lAll := ! ::lAll ::RefreshVars() -return nil + RETURN NIL -METHOD BarDisplay() CLASS TDebugger +METHOD BarDisplay() CLASS HBDebugger - local cClrItem := __DbgColors()[ 8 ] - local cClrHotKey := __DbgColors()[ 9 ] + LOCAL cClrItem := __DbgColors()[ 8 ] + LOCAL cClrHotKey := __DbgColors()[ 9 ] DispBegin() + SetColor( cClrItem ) @ ::nMaxRow, 0 CLEAR TO ::nMaxRow, ::nMaxCol - DispOutAt( ::nMaxRow, 0,; - "F1-Help F2-Zoom F3-Repeat F4-User F5-Go F6-WA F7-Here F8-Step F9-BkPt F10-Trace",; - cClrItem ) + DispOutAt( ::nMaxRow, 0, "F1-Help F2-Zoom F3-Repeat F4-User F5-Go F6-WA F7-Here F8-Step F9-BkPt F10-Trace", cClrItem ) DispOutAt( ::nMaxRow, 0, "F1", cClrHotKey ) DispOutAt( ::nMaxRow, 8, "F2", cClrHotKey ) DispOutAt( ::nMaxRow, 16, "F3", cClrHotKey ) @@ -499,39 +509,40 @@ METHOD BarDisplay() CLASS TDebugger DispOutAt( ::nMaxRow, 54, "F8", cClrHotKey ) DispOutAt( ::nMaxRow, 62, "F9", cClrHotKey ) DispOutAt( ::nMaxRow, 70, "F10", cClrHotKey ) + DispEnd() -return nil + RETURN NIL -METHOD BuildBrowseStack() CLASS TDebugger +METHOD BuildBrowseStack() CLASS HBDebugger - if ::oBrwStack == nil + IF ::oBrwStack == NIL ::oBrwStack := TBrowseNew( 2, ::nMaxCol - 14, ::nMaxRow - 7, ::nMaxCol - 1 ) ::oBrwStack:ColorSpec := ::aColors[ 3 ] + "," + ::aColors[ 4 ] + "," + ::aColors[ 5 ] ::oBrwStack:GoTopBlock := { || ::oBrwStack:Cargo := 1 } ::oBrwStack:GoBottomBlock := { || ::oBrwStack:Cargo := Len( ::aProcStack ) } - ::oBrwStack:SkipBlock = { | nSkip, nOld | nOld := ::oBrwStack:Cargo,; + ::oBrwStack:SkipBlock := { | nSkip, nOld | nOld := ::oBrwStack:Cargo,; ::oBrwStack:Cargo += nSkip,; ::oBrwStack:Cargo := Min( Max( ::oBrwStack:Cargo, 1 ),; Len( ::aProcStack ) ), ::oBrwStack:Cargo - nOld } ::oBrwStack:Cargo := 1 // Actual highligthed row - ::oBrwStack:AddColumn( TBColumnNew( "", { || If( Len( ::aProcStack ) > 0,; + ::oBrwStack:AddColumn( TBColumnNew( "", { || iif( Len( ::aProcStack ) > 0,; PadC( ::aProcStack[ ::oBrwStack:Cargo ][ CSTACK_FUNCTION ], 14 ), Space( 14 ) ) } ) ) - endif + ENDIF -return nil + RETURN NIL -METHOD BuildCommandWindow() CLASS TDebugger +METHOD BuildCommandWindow() CLASS HBDebugger - local GetList := {}, oGet - local cCommand + LOCAL GetList := {} + LOCAL oGet + LOCAL cCommand - ::oWndCommand := TDbWindow():New( ::nMaxRow - 5, 0, ::nMaxRow - 1, ::nMaxCol,; - "Command" ) + ::oWndCommand := HBDbWindow():New( ::nMaxRow - 5, 0, ::nMaxRow - 1, ::nMaxCol, "Command" ) ::oWndCommand:bGotFocus := { || ::oGetListCommand:SetFocus(), SetCursor( SC_NORMAL ) } ::oWndCommand:bLostFocus := { || SetCursor( SC_NONE ) } @@ -541,7 +552,7 @@ METHOD BuildCommandWindow() CLASS TDebugger oGet:ColorDisp( Replicate( __DbgColors()[ 2 ] + ",", 5 ) ),; hb_ClrArea( ::oWndCommand:nTop + 1, ::oWndCommand:nLeft + 1,; ::oWndCommand:nBottom - 2, ::oWndCommand:nRight - 1,; - iif( ::lMonoDisplay, 15, HB_ColorToN( __DbgColors()[ 2 ] ) ) ) } + iif( ::lMonoDisplay, 15, hb_ColorToN( __DbgColors()[ 2 ] ) ) ) } AAdd( ::aWindows, ::oWndCommand ) ::aLastCommands := { "" } @@ -554,78 +565,88 @@ METHOD BuildCommandWindow() CLASS TDebugger oGet:ColorSpec := Replicate( __DbgColors()[ 2 ] + ",", 5 ) ::oGetListCommand := HBGetList():New( GetList ) -return nil + RETURN NIL -METHOD CallStackProcessKey( nKey ) CLASS TDebugger +METHOD CallStackProcessKey( nKey ) CLASS HBDebugger - local n, nSkip, lUpdate := .f. + LOCAL n + LOCAL nSkip + LOCAL lUpdate := .F. do case - case nKey == K_HOME - if ::oBrwStack:Cargo > 1 - ::oBrwStack:GoTop() - ::oBrwStack:ForceStable() - lUpdate = .t. - endif + case nKey == K_HOME - case nKey == K_END - if ::oBrwStack:Cargo < Len( ::aProcStack ) - ::oBrwStack:GoBottom() - ::oBrwStack:ForceStable() - lUpdate = .t. - endif + if ::oBrwStack:Cargo > 1 + ::oBrwStack:GoTop() + ::oBrwStack:ForceStable() + lUpdate := .T. + endif - case nKey == K_UP - if ::oBrwStack:Cargo > 1 - ::oBrwStack:Up() - ::oBrwStack:ForceStable() - lUpdate = .t. - endif + case nKey == K_END - case nKey == K_DOWN - if ::oBrwStack:Cargo < Len( ::aProcStack ) - ::oBrwStack:Down() - ::oBrwStack:ForceStable() - lUpdate = .t. - endif + if ::oBrwStack:Cargo < Len( ::aProcStack ) + ::oBrwStack:GoBottom() + ::oBrwStack:ForceStable() + lUpdate := .T. + endif - case nKey == K_PGUP - ::oBrwStack:PageUp() - ::oBrwStack:ForceStable() - lUpdate = .t. + case nKey == K_UP - case nKey == K_PGDN - ::oBrwStack:PageDown() - ::oBrwStack:ForceStable() - lUpdate = .t. + if ::oBrwStack:Cargo > 1 + ::oBrwStack:Up() + ::oBrwStack:ForceStable() + lUpdate := .T. + endif + + case nKey == K_DOWN + + if ::oBrwStack:Cargo < Len( ::aProcStack ) + ::oBrwStack:Down() + ::oBrwStack:ForceStable() + lUpdate := .T. + endif + + case nKey == K_PGUP + + ::oBrwStack:PageUp() + ::oBrwStack:ForceStable() + lUpdate := .T. + + case nKey == K_PGDN + + ::oBrwStack:PageDown() + ::oBrwStack:ForceStable() + lUpdate := .T. + + case nKey == K_LBUTTONDOWN + + if ( nSkip := MRow() - ::oWndStack:nTop - ::oBrwStack:RowPos ) != 0 + if nSkip > 0 + for n := 1 to nSkip + ::oBrwStack:Down() + ::oBrwStack:Stabilize() + next + else + for n := 1 to nSkip + 2 step -1 + ::oBrwStack:Up() + ::oBrwStack:Stabilize() + next + endif + ::oBrwStack:ForceStable() + endif + lUpdate := .T. - case nKey == K_LBUTTONDOWN - if ( nSkip := MRow() - ::oWndStack:nTop - ::oBrwStack:RowPos ) != 0 - if nSkip > 0 - for n = 1 to nSkip - ::oBrwStack:Down() - ::oBrwStack:Stabilize() - next - else - for n = 1 to nSkip + 2 step -1 - ::oBrwStack:Up() - ::oBrwStack:Stabilize() - next - endif - ::oBrwStack:ForceStable() - endif - lUpdate = .t. endcase if lUpdate - if ::oWndVars != nil .AND. ::oWndVars:lVisible + if ::oWndVars != NIL .AND. ::oWndVars:lVisible ::LoadVars() ::ShowVars() endif // jump to source line for a function - /*if ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] != nil + /*if ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] != NIL ::ShowCodeLine( ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ], ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_MODULE ] ) else ::GotoLine( 1 ) @@ -633,73 +654,71 @@ METHOD CallStackProcessKey( nKey ) CLASS TDebugger ::ShowCodeLine( ::oBrwStack:Cargo ) endif -return nil + RETURN NIL METHOD CodeblockTrace() - ::oPullDown:GetItemByIdent( "CODEBLOCK" ):checked := ::lCBTrace := ! ::lCBTrace - HB_DBG_SetCBTrace( ::pInfo, ::lCBTrace ) -RETURN NIL + ::oPullDown:GetItemByIdent( "CODEBLOCK" ):checked := ::lCBTrace := ! ::lCBTrace + hb_DBG_SetCBTrace( ::pInfo, ::lCBTrace ) + RETURN NIL -METHOD CodeWindowProcessKey( nKey ) CLASS TDebugger - IF ::oBrwText != NIL - DO CASE +METHOD CodeWindowProcessKey( nKey ) CLASS HBDebugger + IF ::oBrwText != NIL + DO CASE case nKey == K_HOME - + ::oBrwText:GoTop() if ::oWndCode:lFocused SetCursor( SC_SPECIAL1 ) endif - + case nKey == K_END ::oBrwText:GoBottom() - ::oBrwText:nCol = ::oWndCode:nLeft + 1 - ::oBrwText:nFirstCol = ::oWndCode:nLeft + 1 - SetPos( Row(), ::oWndCode:nLeft + 1 ) + ::oBrwText:End() if ::oWndCode:lFocused SetCursor( SC_SPECIAL1 ) endif - + case nKey == K_LEFT ::oBrwText:Left() - + case nKey == K_RIGHT ::oBrwText:Right() - + case nKey == K_UP ::oBrwText:Up() - + case nKey == K_DOWN ::oBrwText:Down() - + case nKey == K_PGUP ::oBrwText:PageUp() - + case nKey == K_PGDN ::oBrwText:PageDown() - - ENDCASE - ENDIF -RETURN NIL + + ENDCASE + ENDIF + RETURN NIL -METHOD Colors() CLASS TDebugger +METHOD Colors() CLASS HBDebugger - local oWndColors := TDbWindow():New( 4, 5, 16, ::nMaxCol - 5,; + LOCAL oWndColors := HBDbWindow():New( 4, 5, 16, ::nMaxCol - 5,; "Debugger Colors[1..11]", ::ClrModal() ) - local aColors := { "Border", "Text", "Text High", "Text PPO", "Text Selected",; + LOCAL aColors := { "Border", "Text", "Text High", "Text PPO", "Text Selected",; "Text High Sel.", "Text PPO Sel.", "Menu", "Menu High",; "Menu Selected", "Menu High Sel." } - local oBrwColors := TBrowseNew( oWndColors:nTop + 1, oWndColors:nLeft + 1,; + LOCAL oBrwColors := TBrowseNew( oWndColors:nTop + 1, oWndColors:nLeft + 1,; oWndColors:nBottom - 1, oWndColors:nRight - 1 ) - local nWidth := oWndColors:nRight - oWndColors:nLeft - 1 - local oCol + LOCAL nWidth := oWndColors:nRight - oWndColors:nLeft - 1 + LOCAL oCol if ::lMonoDisplay Alert( "Monochrome display" ) - return nil + RETURN NIL endif oBrwColors:Cargo :={ 1,{}} // Actual highligthed row oBrwColors:ColorSpec := ::ClrModal() @@ -710,13 +729,13 @@ METHOD Colors() CLASS TDebugger oBrwColors:AddColumn( ocol := TBColumnNew( "", { || PadR( aColors[ oBrwColors:Cargo[1] ], 14 ) } ) ) oCol:DefColor:={1,2} - aadd(oBrwColors:Cargo[2],acolors) + AAdd(oBrwColors:Cargo[2],acolors) oBrwColors:AddColumn( oCol := TBColumnNew( "",; { || PadR( '"' + ::aColors[ oBrwColors:Cargo[1] ] + '"', nWidth - 15 ) } ) ) - aadd(oBrwColors:Cargo[2],acolors) + AAdd(oBrwColors:Cargo[2],acolors) oCol:DefColor:={1,3} ocol:width:=50 - oBrwColors:autolite:=.f. + oBrwColors:autolite:=.F. oWndColors:bPainted := { || oBrwColors:ForceStable(),RefreshVarsS(oBrwColors)} @@ -727,70 +746,71 @@ METHOD Colors() CLASS TDebugger ::LoadColors() -RETURN NIL + RETURN NIL -METHOD CommandWindowProcessKey( nKey ) CLASS TDebugger +METHOD CommandWindowProcessKey( nKey ) CLASS HBDebugger - local cCommand - local n, nWidth := ::oWndCommand:nRight - ::oWndCommand:nLeft - 3 + LOCAL cCommand + LOCAL n + LOCAL nWidth := ::oWndCommand:nRight - ::oWndCommand:nLeft - 3 do case - case nKey == K_UP .OR. nKey == K_F3 - if ::nCommand > 1 - ::oGetListCommand:oGet:Assign() - ::aLastCommands[ ::nCommand ] := Trim( ::oGetListCommand:oGet:VarGet() ) - ::nCommand-- - cCommand := PadR( ::aLastCommands[ ::nCommand ], nWidth ) - ::oGetListCommand:oGet:VarPut( cCommand ) - ::oGetListCommand:oGet:Buffer := cCommand - ::oGetListCommand:oGet:Pos := Len( ::aLastCommands[ ::nCommand ] ) + 1 - ::oGetListCommand:oGet:Display() - endif - - case nKey == K_DOWN - if ::nCommand < Len( ::aLastCommands ) - ::oGetListCommand:oGet:Assign() - ::aLastCommands[ ::nCommand ] := Trim( ::oGetListCommand:oGet:VarGet() ) - ::nCommand++ - cCommand := PadR( ::aLastCommands[ ::nCommand ], nWidth ) - ::oGetListCommand:oGet:VarPut( cCommand ) - ::oGetListCommand:oGet:Buffer := cCommand - ::oGetListCommand:oGet:Pos := Len( ::aLastCommands[ ::nCommand ] ) + 1 - ::oGetListCommand:oGet:Display() - endif - - case nKey == K_ENTER - /* We must call :Assign() before :VarGet(), because it's no longer - * called on every change */ + case nKey == K_UP .OR. nKey == K_F3 + if ::nCommand > 1 ::oGetListCommand:oGet:Assign() - cCommand := Trim( ::oGetListCommand:oGet:VarGet() ) - - if ! Empty( cCommand ) - IF ( n := AScan( ::aLastCommands, cCommand ) ) > 0 .AND. n < Len( ::aLastCommands ) - ADel( ::aLastCommands, n, .T. ) - ENDIF - ::nCommand := Len( ::aLastCommands ) - ::aLastCommands[ ::nCommand ] := cCommand - AAdd( ::aLastCommands, "" ) - ::nCommand := Len( ::aLastCommands ) - ::oWndCommand:ScrollUp( 1 ) - ::DoCommand( cCommand ) - endif - - DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, "> ",; - __DbgColors()[ 2 ] ) - cCommand := Space( nWidth ) + ::aLastCommands[ ::nCommand ] := Trim( ::oGetListCommand:oGet:VarGet() ) + ::nCommand-- + cCommand := PadR( ::aLastCommands[ ::nCommand ], nWidth ) ::oGetListCommand:oGet:VarPut( cCommand ) ::oGetListCommand:oGet:Buffer := cCommand - ::oGetListCommand:oGet:Pos := 1 + ::oGetListCommand:oGet:Pos := Len( ::aLastCommands[ ::nCommand ] ) + 1 ::oGetListCommand:oGet:Display() + endif - otherwise - ::oGetListCommand:GetApplyKey( nKey ) + case nKey == K_DOWN + if ::nCommand < Len( ::aLastCommands ) + ::oGetListCommand:oGet:Assign() + ::aLastCommands[ ::nCommand ] := Trim( ::oGetListCommand:oGet:VarGet() ) + ::nCommand++ + cCommand := PadR( ::aLastCommands[ ::nCommand ], nWidth ) + ::oGetListCommand:oGet:VarPut( cCommand ) + ::oGetListCommand:oGet:Buffer := cCommand + ::oGetListCommand:oGet:Pos := Len( ::aLastCommands[ ::nCommand ] ) + 1 + ::oGetListCommand:oGet:Display() + endif + + case nKey == K_ENTER + /* We must call :Assign() before :VarGet(), because it's no longer + * called on every change */ + ::oGetListCommand:oGet:Assign() + cCommand := Trim( ::oGetListCommand:oGet:VarGet() ) + + if ! Empty( cCommand ) + IF ( n := AScan( ::aLastCommands, cCommand ) ) > 0 .AND. n < Len( ::aLastCommands ) + ADel( ::aLastCommands, n, .T. ) + ENDIF + ::nCommand := Len( ::aLastCommands ) + ::aLastCommands[ ::nCommand ] := cCommand + AAdd( ::aLastCommands, "" ) + ::nCommand := Len( ::aLastCommands ) + ::oWndCommand:ScrollUp( 1 ) + ::DoCommand( cCommand ) + endif + + DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, "> ",; + __DbgColors()[ 2 ] ) + cCommand := Space( nWidth ) + ::oGetListCommand:oGet:VarPut( cCommand ) + ::oGetListCommand:oGet:Buffer := cCommand + ::oGetListCommand:oGet:Pos := 1 + ::oGetListCommand:oGet:Display() + + otherwise + ::oGetListCommand:GetApplyKey( nKey ) endcase -return nil + RETURN NIL /* @@ -799,238 +819,248 @@ return nil * ? * displays either result or error description in command window */ -METHOD DoCommand( cCommand ) CLASS TDebugger +METHOD DoCommand( cCommand ) CLASS HBDebugger + LOCAL aCmnd - LOCAL cParam, cParam1 := "" + LOCAL cParam + LOCAL cParam1 := "" LOCAL cResult LOCAL lValid LOCAL n - cCommand := ALLTRIM( cCommand ) + cCommand := AllTrim( cCommand ) aCmnd := { NIL, NIL, NIL } DO CASE - CASE Empty( cCommand ) - RETURN "" + CASE Empty( cCommand ) + RETURN "" - CASE starts( cCommand, "??" ) - cParam := AllTrim( SUBSTR( cCommand, 3 ) ) - cCommand := "??" + CASE starts( cCommand, "??" ) + cParam := AllTrim( SubStr( cCommand, 3 ) ) + cCommand := "??" - CASE starts( cCommand, "?" ) - cParam := SUBSTR( cCommand, 2 ) - cCommand := "?" + CASE starts( cCommand, "?" ) + cParam := SubStr( cCommand, 2 ) + cCommand := "?" - OTHERWISE - IF ( n := At( " ", cCommand ) ) > 0 - cParam := AllTrim( SubStr( cCommand, n + 1 ) ) - cCommand := Left( cCommand, n - 1 ) - ENDIF - cCommand := Upper( cCommand ) + OTHERWISE + IF ( n := At( " ", cCommand ) ) > 0 + cParam := AllTrim( SubStr( cCommand, n + 1 ) ) + cCommand := Left( cCommand, n - 1 ) + ENDIF + cCommand := Upper( cCommand ) ENDCASE DO CASE - CASE cCommand == "??" .OR. cCommand == "?" - aCmnd[WP_TYPE] := cCommand - aCmnd[WP_EXPR] := cParam + CASE cCommand == "??" .OR. cCommand == "?" + aCmnd[WP_TYPE] := cCommand + aCmnd[WP_EXPR] := cParam - ::RestoreAppState() - cResult := ::GetExprValue( cParam, @lValid ) - ::SaveAppState() + ::RestoreAppState() + cResult := ::GetExprValue( cParam, @lValid ) + ::SaveAppState() - IF( aCmnd[WP_TYPE] == "??" ) - IF( lValid ) - ::Inspect( aCmnd[WP_EXPR], cResult ) - ENDIF - cResult := '' //discard result - ELSE - IF( lValid ) - cResult := ValToStr( cResult ) - ENDIF + IF aCmnd[WP_TYPE] == "??" + IF lValid + ::Inspect( aCmnd[WP_EXPR], cResult ) ENDIF - ::RefreshVars() - - CASE starts( "ANIMATE", cCommand ) - IF ::lActive - ::lAnimate = .t. - ::Animate() - SetCursor( SC_NORMAL ) - ENDIF - - CASE starts( "BP", cCommand ) - /* TODO: Support BP */ - IF !Empty( cParam ) - IF ( n := At( " ", cParam ) ) > 0 - cParam1 := AllTrim( SubStr( cParam, n + 1 ) ) - cParam := Left( cParam, n - 1 ) - ELSE - cParam1 := ::cPrgName - ENDIF - ::ToggleBreakPoint( Val( cParam ), strip_path( cParam1 ) ) - ELSE - ::ToggleBreakPoint() - ENDIF - - CASE starts( "CALLSTACK", cCommand ) - ::Stack( Upper( cParam ) == "ON" ) - - /* TODO: Support DELETE ALL [TP|BP|WP], DELETE WP|TP|BP */ - - CASE starts( "DOS", cCommand ) - ::OsShell() - SetCursor( SC_NORMAL ) - - CASE starts( "FIND", cCommand ) - ::Locate( 0, cParam ) - - CASE starts( "GO", cCommand ) - ::Go() - - CASE starts( "GOTO", cCommand ) .AND. Val( cParam ) > 0 - ::GoToLine( Val( cParam ) ) - - CASE starts( "HELP", cCommand ) - ::ShowHelp() - - CASE starts( "INPUT", cCommand ) .AND. !Empty( cParam ) - ::DoScript( cParam ) - - /* TODO: Support LIST BP|WP|TP */ - - CASE starts( "MONITOR", cCommand ) - cParam := Upper( cParam ) - DO CASE - CASE starts( "GLOBAL", cParam ) - ::Global() - CASE starts( "LOCAL", cParam ) - ::Local() - CASE starts( "PRIVATE", cParam ) - ::Private() - CASE starts( "PUBLIC", cParam ) - ::Public() - CASE starts( "SORT", cParam ) - ::Sort() - CASE starts( "STATIC", cParam ) - ::Static() - OTHERWISE - cResult := "Command error" - ENDCASE - - CASE starts( "NEXT", cCommand ) - ::FindNext() - - CASE starts( "NUM", cCommand ) - IF Upper( cParam ) == "OFF" - ::LineNumbers( .F. ) - ELSEIF Upper( cParam ) == "ON" - ::LineNumbers( .T. ) - ELSE - cResult := "Command error" + cResult := '' //discard result + ELSE + IF lValid + cResult := __dbgValToStr( cResult ) ENDIF + ENDIF + ::RefreshVars() - CASE starts( "OPTIONS", cCommand ) - IF ( n := At( " ", cParam ) ) > 0 - cParam1 := AllTrim( SubStr( cParam, n + 1 ) ) - cParam := Left( cParam, n - 1 ) - ENDIF - cParam := Upper( cParam ) - DO CASE - CASE starts( "COLORS", cParam ) - IF Empty( cParam1 ) - ::Colors() - ELSE - cParam1 := SubStr( cParam1, At( "{", cParam1 ) + 1 ) - FOR n := 1 TO 11 - IF At( ",", cParam1 ) != 0 - ::aColors[ n ] := ; - StrTran( Left( cParam1, At( ",", cParam1 ) - 1 ), '"', "" ) - cParam1 := SubStr( cParam1, At( ",", cParam1 ) + 1 ) - ELSE - ::aColors[ n ] := ; - StrTran( Left( cParam1, At( "}", cParam1 ) - 1 ), '"', "" ) - ENDIF - NEXT - ::LoadColors() - ENDIF - CASE starts( "NORUNATSTARTUP", cParam ) - ::lRunAtStartup := .f. - CASE starts( "PATH", cParam ) - ::PathForFiles( AllTrim( cParam1 ) ) - CASE starts( "TAB", cParam ) - ::nTabWidth = Val( Left( cParam1, 3 ) ) - OTHERWISE - cResult := "Command error" - ENDCASE - - CASE starts( "OUTPUT", cCommand ) - SetCursor( SC_NONE ) - ::ShowAppScreen() + CASE starts( "ANIMATE", cCommand ) + IF ::lActive + ::lAnimate := .T. + ::Animate() SetCursor( SC_NORMAL ) + ENDIF - CASE starts( "PREV", cCommand ) - ::FindPrevious() - - CASE starts( "QUIT", cCommand ) - ::Quit() - - /* TODO: Support RESTART */ - - CASE starts( "RESUME", cCommand ) - ::Resume() - - CASE starts( "SPEED", cCommand ) - IF !Empty( cParam ) - ::nSpeed := Val( cParam ) - ELSE - ::nSpeed := 0 - ENDIF - - CASE starts( "STEP", cCommand ) - ::Step() - - CASE starts( "TP", cCommand ) - ::TracepointAdd( cParam ) - - CASE starts( "VIEW", cCommand ) - IF !Empty( cParam ) .AND. starts( "CALLSTACK", Upper( cParam ) ) - ::Stack() - ELSE - cResult := "Command error" - ENDIF - - CASE starts( "WINDOW", cCommand ) + CASE starts( "BP", cCommand ) + /* TODO: Support BP */ + IF !Empty( cParam ) IF ( n := At( " ", cParam ) ) > 0 cParam1 := AllTrim( SubStr( cParam, n + 1 ) ) cParam := Left( cParam, n - 1 ) + ELSE + cParam1 := ::cPrgName ENDIF - DO CASE - CASE starts( "MOVE", cParam ) - WITH OBJECT ::aWindows[ ::nCurrentWindow ] - n := At( " ", cParam1 ) - IF n > 0 - n := Val( SubStr( cParam1, n ) ) - ENDIF - :Resize( Val( cParam1 ), n, ; - :nBottom + Val( cParam1 ) - :nTop, :nRight + n - :nLeft ) - END - CASE starts( "NEXT", cParam ) - ::NextWindow() - CASE starts( "SIZE", cParam ) - WITH OBJECT ::aWindows[ ::nCurrentWindow ] - n := At( " ", cParam1 ) - IF Val( cParam1 ) >= 2 .AND. n > 0 .AND. Val( SubStr( cParam1, n ) ) > 0 - :Resize( :nTop, :nLeft, Val( cParam1 ) - 1 + :nTop, ; - Val( SubStr( cParam1, n ) ) - 1 + :nLeft ) - ENDIF - END - ENDCASE + ::ToggleBreakPoint( Val( cParam ), strip_path( cParam1 ) ) + ELSE + ::ToggleBreakPoint() + ENDIF - CASE starts( "WP", cCommand ) - ::WatchpointAdd( cParam ) + CASE starts( "CALLSTACK", cCommand ) + ::Stack( Upper( cParam ) == "ON" ) + /* TODO: Support DELETE ALL [TP|BP|WP], DELETE WP|TP|BP */ + + CASE starts( "DOS", cCommand ) + ::OsShell() + SetCursor( SC_NORMAL ) + + CASE starts( "FIND", cCommand ) + ::Locate( 0, cParam ) + + CASE starts( "GO", cCommand ) + ::Go() + + CASE starts( "GOTO", cCommand ) .AND. Val( cParam ) > 0 + ::GoToLine( Val( cParam ) ) + + CASE starts( "HELP", cCommand ) + ::ShowHelp() + + CASE starts( "INPUT", cCommand ) .AND. !Empty( cParam ) + ::DoScript( cParam ) + + /* TODO: Support LIST BP|WP|TP */ + + CASE starts( "MONITOR", cCommand ) + + cParam := Upper( cParam ) + + DO CASE + CASE starts( "GLOBAL", cParam ) + ::Global() + CASE starts( "LOCAL", cParam ) + ::Local() + CASE starts( "PRIVATE", cParam ) + ::Private() + CASE starts( "PUBLIC", cParam ) + ::Public() + CASE starts( "SORT", cParam ) + ::Sort() + CASE starts( "STATIC", cParam ) + ::Static() OTHERWISE cResult := "Command error" + ENDCASE + + CASE starts( "NEXT", cCommand ) + ::FindNext() + + CASE starts( "NUM", cCommand ) + IF Upper( cParam ) == "OFF" + ::LineNumbers( .F. ) + ELSEIF Upper( cParam ) == "ON" + ::LineNumbers( .T. ) + ELSE + cResult := "Command error" + ENDIF + + CASE starts( "OPTIONS", cCommand ) + + IF ( n := At( " ", cParam ) ) > 0 + cParam1 := AllTrim( SubStr( cParam, n + 1 ) ) + cParam := Left( cParam, n - 1 ) + ENDIF + + cParam := Upper( cParam ) + + DO CASE + CASE starts( "COLORS", cParam ) + + IF Empty( cParam1 ) + ::Colors() + ELSE + cParam1 := SubStr( cParam1, At( "{", cParam1 ) + 1 ) + FOR n := 1 TO 11 + IF At( ",", cParam1 ) != 0 + ::aColors[ n ] := ; + StrTran( Left( cParam1, At( ",", cParam1 ) - 1 ), '"', "" ) + cParam1 := SubStr( cParam1, At( ",", cParam1 ) + 1 ) + ELSE + ::aColors[ n ] := ; + StrTran( Left( cParam1, At( "}", cParam1 ) - 1 ), '"', "" ) + ENDIF + NEXT + ::LoadColors() + ENDIF + CASE starts( "NORUNATSTARTUP", cParam ) + ::lRunAtStartup := .F. + CASE starts( "PATH", cParam ) + ::PathForFiles( AllTrim( cParam1 ) ) + CASE starts( "TAB", cParam ) + ::nTabWidth := Val( Left( cParam1, 3 ) ) + OTHERWISE + cResult := "Command error" + ENDCASE + + CASE starts( "OUTPUT", cCommand ) + SetCursor( SC_NONE ) + ::ShowAppScreen() + SetCursor( SC_NORMAL ) + + CASE starts( "PREV", cCommand ) + ::FindPrevious() + + CASE starts( "QUIT", cCommand ) + ::Quit() + + /* TODO: Support RESTART */ + + CASE starts( "RESUME", cCommand ) + ::Resume() + + CASE starts( "SPEED", cCommand ) + IF !Empty( cParam ) + ::nSpeed := Val( cParam ) + ELSE + ::nSpeed := 0 + ENDIF + + CASE starts( "STEP", cCommand ) + ::Step() + + CASE starts( "TP", cCommand ) + ::TracepointAdd( cParam ) + + CASE starts( "VIEW", cCommand ) + IF !Empty( cParam ) .AND. starts( "CALLSTACK", Upper( cParam ) ) + ::Stack() + ELSE + cResult := "Command error" + ENDIF + + CASE starts( "WINDOW", cCommand ) + + IF ( n := At( " ", cParam ) ) > 0 + cParam1 := AllTrim( SubStr( cParam, n + 1 ) ) + cParam := Left( cParam, n - 1 ) + ENDIF + + DO CASE + CASE starts( "MOVE", cParam ) + WITH OBJECT ::aWindows[ ::nCurrentWindow ] + n := At( " ", cParam1 ) + IF n > 0 + n := Val( SubStr( cParam1, n ) ) + ENDIF + :Resize( Val( cParam1 ), n, ; + :nBottom + Val( cParam1 ) - :nTop, :nRight + n - :nLeft ) + END + CASE starts( "NEXT", cParam ) + ::NextWindow() + CASE starts( "SIZE", cParam ) + WITH OBJECT ::aWindows[ ::nCurrentWindow ] + n := At( " ", cParam1 ) + IF Val( cParam1 ) >= 2 .AND. n > 0 .AND. Val( SubStr( cParam1, n ) ) > 0 + :Resize( :nTop, :nLeft, Val( cParam1 ) - 1 + :nTop, ; + Val( SubStr( cParam1, n ) ) - 1 + :nLeft ) + ENDIF + END + ENDCASE + + CASE starts( "WP", cCommand ) + ::WatchpointAdd( cParam ) + + OTHERWISE + cResult := "Command error" ENDCASE @@ -1045,13 +1075,15 @@ METHOD DoCommand( cCommand ) CLASS TDebugger ENDIF ENDIF -RETURN cResult + RETURN cResult -METHOD DoScript( cFileName ) CLASS TDebugger +METHOD DoScript( cFileName ) CLASS HBDebugger - local cInfo - local n, cLine, nLen + LOCAL cInfo + LOCAL n + LOCAL cLine + LOCAL nLen IF File( cFileName ) cInfo := MemoRead( cFileName ) @@ -1062,15 +1094,15 @@ METHOD DoScript( cFileName ) CLASS TDebugger next ENDIF -RETURN NIL + RETURN NIL -METHOD EditColor( nColor, oBrwColors ) CLASS TDebugger +METHOD EditColor( nColor, oBrwColors ) CLASS HBDebugger - local GetList := {} - local lPrevScore := Set( _SET_SCOREBOARD, .f. ) - local lPrevExit := Set( _SET_EXIT, .t. ) - local cColor := PadR( '"' + ::aColors[ nColor ] + '"',; + LOCAL GetList := {} + LOCAL lPrevScore := Set( _SET_SCOREBOARD, .F. ) + LOCAL lPrevExit := Set( _SET_EXIT, .T. ) + LOCAL cColor := PadR( '"' + ::aColors[ nColor ] + '"',; oBrwColors:getColumn(2):Width ) oBrwColors:RefreshCurrent() @@ -1079,12 +1111,12 @@ METHOD EditColor( nColor, oBrwColors ) CLASS TDebugger #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", ( Alert( "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. ) }, SubStr( ::ClrModal(), 5 ) ) + cColor := getdbginput( Row(), Col() + 15, cColor, { |cColor| iif( Type( cColor ) != "C", ( Alert( "Must be string" ), .F. ), .T. ) }, SubStr( ::ClrModal(), 5 ) ) #endif Set( _SET_SCOREBOARD, lPrevScore ) @@ -1097,28 +1129,28 @@ METHOD EditColor( nColor, oBrwColors ) CLASS TDebugger oBrwColors:RefreshCurrent() oBrwColors:ForceStable() -return nil + RETURN NIL -METHOD EditSet( nSet, oBrwSets ) CLASS TDebugger +METHOD EditSet( nSet, oBrwSets ) CLASS HBDebugger - local GetList := {} - local lPrevScore := Set( _SET_SCOREBOARD, .f. ) - local lPrevExit := Set( _SET_EXIT, .t. ) - local cSet := PadR( ValToStr( Set( nSet ) ), oBrwSets:getColumn(2):Width ) - local cType := VALTYPE(SET(nSet)) + LOCAL GetList := {} + LOCAL lPrevScore := Set( _SET_SCOREBOARD, .F. ) + LOCAL lPrevExit := Set( _SET_EXIT, .T. ) + LOCAL cSet := PadR( __dbgValToStr( Set( nSet ) ), oBrwSets:getColumn(2):Width ) + LOCAL cType := ValType( Set( nSet ) ) oBrwSets:RefreshCurrent() oBrwSets:ForceStable() #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. ) + @ Row(), Col() + 13 GET cSet COLOR SubStr( ::ClrModal(), 5 ) ; + VALID iif( Type(cSet) != cType, (Alert( "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. ) }, SubStr( ::ClrModal(), 5 ) ) + cSet := getdbginput( Row(), Col()+13, cSet, { |cSet| iif( Type(cSet) != cType, (Alert( "Must be of type '"+cType+"'" ), .F. ), .T. ) }, SubStr( ::ClrModal(), 5 ) ) #endif Set( _SET_SCOREBOARD, lPrevScore ) @@ -1131,131 +1163,135 @@ METHOD EditSet( nSet, oBrwSets ) CLASS TDebugger oBrwSets:RefreshCurrent() oBrwSets:ForceStable() -return nil + RETURN NIL -METHOD EditVar( nVar ) CLASS TDebugger +METHOD EditVar( nVar ) CLASS HBDebugger - local cVarName := ::aVars[ nVar ][ 1 ] - local uVarValue := ::aVars[ nVar ][ 2 ] - local cVarType := ::aVars[ nVar ][ 3 ] - local cVarStr + LOCAL cVarName := ::aVars[ nVar ][ 1 ] + LOCAL uVarValue := ::aVars[ nVar ][ 2 ] + LOCAL cVarType := ::aVars[ nVar ][ 3 ] + LOCAL cVarStr uVarValue := ::VarGetValue( ::aVars[ nVar ] ) do case - case ValType( uVarValue ) == "A" .or. ; - ValType( uVarValue ) == "H" .or. ; - ValType( uVarValue ) == "O" .or. ; - ValType( uVarValue ) == "P" + case ValType( uVarValue ) == "A" .OR. ; + ValType( uVarValue ) == "H" .OR. ; + ValType( uVarValue ) == "O" .OR. ; + ValType( uVarValue ) == "P" - ::InputBox( cVarName, uVarValue,, .f. ) + ::InputBox( cVarName, uVarValue,, .F. ) - otherwise - cVarStr := ::InputBox( cVarName, ValToStr( uVarValue ),; - { | u | If( Type( u ) == "UE", ( Alert( "Expression error" ), .f. ), .t. ) } ) + otherwise + cVarStr := ::InputBox( cVarName, __dbgValToStr( uVarValue ),; + { | u | iif( Type( u ) == "UE", ( Alert( "Expression error" ), .F. ), .T. ) } ) endcase if LastKey() != K_ESC do case - case cVarStr == "{ ... }" - //aArray := ::VarGetValue( ::aVars[ nVar ] ) - if Len( uVarValue ) > 0 - __DbgArrays( uVarValue, cVarName ) - else - Alert( "Array is empty" ) - endif + case cVarStr == "{ ... }" + //aArray := ::VarGetValue( ::aVars[ nVar ] ) + if Len( uVarValue ) > 0 + __DbgArrays( uVarValue, cVarName ) + else + Alert( "Array is empty" ) + endif - case Upper( SubStr( cVarStr, 1, 5 ) ) == "CLASS" - __DbgObject( uVarValue, cVarName ) + case Upper( SubStr( cVarStr, 1, 5 ) ) == "CLASS" + __DbgObject( uVarValue, cVarName ) - otherwise - ::VarSetValue( ::aVars[ nVar ], &cVarStr ) + otherwise + ::VarSetValue( ::aVars[ nVar ], &cVarStr ) endcase endif ::oBrwVars:RefreshCurrent() ::oBrwVars:ForceStable() -return nil + RETURN NIL -METHOD FindNext() CLASS TDebugger -RETURN ::Locate( 1, ::cSearchString ) +METHOD FindNext() CLASS HBDebugger + RETURN ::Locate( 1, ::cSearchString ) -METHOD FindPrevious() CLASS TDebugger -RETURN ::Locate( 2, ::cSearchString ) +METHOD FindPrevious() CLASS HBDebugger + RETURN ::Locate( 2, ::cSearchString ) -METHOD GetExprValue( xExpr, lValid ) CLASS TDebugger - LOCAL xResult, oErr, bOldErrorBlock +METHOD GetExprValue( xExpr, lValid ) CLASS HBDebugger - lValid := .F. - bOldErrorBlock := ErrorBlock( {|oErr| Break( oErr ) } ) - BEGIN SEQUENCE - xResult := HB_DBG_GetExprValue( ::pInfo, xExpr, @lValid ) - IF !lValid - xResult := "Syntax error" - ENDIF - RECOVER USING oErr - xResult := oErr:operation + ": " + oErr:description - IF ValType( oErr:args ) == 'A' - xResult += "; arguments:" - AEval( oErr:args, {|x| xResult += " " + AllTrim( HB_CStr( x ) ) } ) - ENDIF - lValid := .F. - END SEQUENCE - ErrorBlock( bOldErrorBlock ) -RETURN xResult + LOCAL xResult + LOCAL oErr + LOCAL bOldErrorBlock + + lValid := .F. + bOldErrorBlock := ErrorBlock( {|oErr| Break( oErr ) } ) + BEGIN SEQUENCE + xResult := hb_DBG_GetExprValue( ::pInfo, xExpr, @lValid ) + IF !lValid + xResult := "Syntax error" + ENDIF + RECOVER USING oErr + xResult := oErr:operation + ": " + oErr:description + IF ValType( oErr:args ) == 'A' + xResult += "; arguments:" + AEval( oErr:args, {|x| xResult += " " + AllTrim( hb_CStr( x ) ) } ) + ENDIF + lValid := .F. + END SEQUENCE + ErrorBlock( bOldErrorBlock ) + RETURN xResult -METHOD GetSourceFiles() CLASS TDebugger -RETURN HB_DBG_GetSourceFiles( ::pInfo ) +METHOD GetSourceFiles() CLASS HBDebugger + RETURN hb_DBG_GetSourceFiles( ::pInfo ) -METHOD Global() CLASS TDebugger +METHOD Global() CLASS HBDebugger ::lShowGlobals := ! ::lShowGlobals ::RefreshVars() -RETURN NIL + RETURN NIL -METHOD Go() CLASS TDebugger - // we are starting to run again so reset to the deepest call if - // displaying stack - IF ! ::oBrwStack == NIL - ::oBrwStack:GoTop() - ENDIF - ::RestoreAppScreen() - ::RestoreAppState() - HB_DBG_SetGo( ::pInfo ) - ::Exit() -RETURN NIL +METHOD Go() CLASS HBDebugger + // we are starting to run again so reset to the deepest call if + // displaying stack + IF ! ::oBrwStack == NIL + ::oBrwStack:GoTop() + ENDIF + ::RestoreAppScreen() + ::RestoreAppState() + hb_DBG_SetGo( ::pInfo ) + ::Exit() + RETURN NIL -METHOD GotoLine( nLine ) CLASS TDebugger +METHOD GotoLine( nLine ) CLASS HBDebugger - local nRow, nCol + LOCAL nRow + LOCAL nCol - /*if ::oBrwVars != nil + /*if ::oBrwVars != NIL ::ShowVars() endif*/ ::oBrwText:GotoLine( nLine ) - nRow = Row() - nCol = Col() + nRow := Row() + nCol := Col() // no source code line stored yet - /*if ::oBrwStack != nil .and. Len( ::aCallStack ) > 0 .and. ; - ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] == nil - ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] = nLine + /*if ::oBrwStack != NIL .AND. Len( ::aCallStack ) > 0 .AND. ; + ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] == NIL + ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] := nLine endif*/ - if ::oWndStack != nil .and. ! ::oBrwStack:Stable + if ::oWndStack != NIL .AND. ! ::oBrwStack:Stable ::oBrwStack:ForceStable() endif - if ::oWndCode:lFocused .and. SetCursor() != SC_SPECIAL1 + if ::oWndCode:lFocused .AND. SetCursor() != SC_SPECIAL1 SetPos( nRow, nCol ) SetCursor( SC_SPECIAL1 ) endif @@ -1265,192 +1301,196 @@ METHOD GotoLine( nLine ) CLASS TDebugger ::oWndCode:cargo[ 1 ] := nRow ::oWndCode:cargo[ 2 ] := nCol -return nil + RETURN NIL -METHOD HandleEvent() CLASS TDebugger +METHOD HandleEvent() CLASS HBDebugger - local nPopup, oWnd - local nKey, nMRow, nMCol, n + LOCAL nPopup + LOCAL oWnd + LOCAL nKey + LOCAL nMRow + LOCAL nMCol + LOCAL n if ::lAnimate if ::nSpeed != 0 Inkey( ::nSpeed / 10 ) endif - if HB_DBG_INVOKEDEBUG() //NextKey() == K_ALT_D - ::lAnimate := .f. + if hb_DBG_INVOKEDEBUG() //NextKey() == K_ALT_D + ::lAnimate := .F. else ::Step() - RETURN nil + RETURN NIL endif endif - ::lEnd := .f. + ::lEnd := .F. - while ! ::lEnd + do while ! ::lEnd - nKey := InKey( 0, INKEY_ALL ) + nKey := Inkey( 0, INKEY_ALL ) do case - case nKey == K_ALT_X - s_oDebugger:Quit() + case nKey == K_ALT_X + s_oDebugger:Quit() - case ::oPullDown:IsOpen() - ::oPullDown:ProcessKey( nKey ) - if ::oPullDown:nOpenPopup == 0 // Closed - ::aWindows[ ::nCurrentWindow ]:Show( .t. ) - endif + case ::oPullDown:IsOpen() + ::oPullDown:ProcessKey( nKey ) + if ::oPullDown:nOpenPopup == 0 // Closed + ::aWindows[ ::nCurrentWindow ]:Show( .T. ) + endif - case nKey == K_LDBLCLK - if MRow() == 0 + case nKey == K_LDBLCLK + if MRow() == 0 - elseif MRow() == ::nMaxRow + elseif MRow() == ::nMaxRow - else - nMRow := MRow() - nMCol := MCol() - for n := 1 to Len( ::aWindows ) - if ::aWindows[ n ]:IsOver( nMRow, nMCol ) - if ! ::aWindows[ n ]:lFocused - ::aWindows[ ::nCurrentWindow ]:Show( .f. ) - ::nCurrentWindow := n - ::aWindows[ n ]:Show( .t. ) - endif - ::aWindows[ n ]:LDblClick( nMRow, nMCol ) - exit + else + nMRow := MRow() + nMCol := MCol() + for n := 1 to Len( ::aWindows ) + if ::aWindows[ n ]:IsOver( nMRow, nMCol ) + if ! ::aWindows[ n ]:lFocused + ::aWindows[ ::nCurrentWindow ]:Show( .F. ) + ::nCurrentWindow := n + ::aWindows[ n ]:Show( .T. ) endif - next - endif - - case nKey == K_LBUTTONDOWN - if MRow() == 0 - if ( nPopup := ::oPullDown:GetItemOrdByCoors( 0, MCol() ) ) != 0 - if ! ::oPullDown:IsOpen() - if ::oWndCode:lFocused - Eval( ::oWndCode:bLostFocus ) - endif - SetCursor( SC_NONE ) - endif - ::oPullDown:ShowPopup( nPopup ) + ::aWindows[ n ]:LDblClick( nMRow, nMCol ) + exit endif + next + endif - elseif MRow() == ::nMaxRow - - else - nMRow := MRow() - nMCol := MCol() - for n := 1 to Len( ::aWindows ) - if ::aWindows[ n ]:IsOver( nMRow, nMCol ) - if ! ::aWindows[ n ]:lFocused - ::aWindows[ ::nCurrentWindow ]:Show( .f. ) - ::nCurrentWindow := n - ::aWindows[ n ]:Show( .t. ) - endif - ::aWindows[ n ]:LButtonDown( nMRow, nMCol ) - exit - endif - next - endif - - case nKey == K_RBUTTONDOWN - - /*case nKey == K_ESC - ::RestoreAppStatus() - s_oDebugger := nil - s_lExit := .T. - DispEnd() - ::Exit()*/ - - case nKey == K_UP .or. nKey == K_DOWN .or. nKey == K_HOME .or. ; - nKey == K_END .or. nKey == K_ENTER .or. nKey == K_PGDN .or. ; - nKey == K_PGUP .or. nKey == K_DEL .or. nKey == K_LEFT .or. ; - nKey == K_RIGHT .or. nKey == K_CTRL_ENTER - oWnd := ::aWindows[ ::nCurrentWindow ] - oWnd:KeyPressed( nKey ) - - case nKey == K_F1 - ::ShowHelp() - - case nKey == K_F4 - ::ShowAppScreen() - - case nKey == K_F5 - ::Go() - - case nKey == K_CTRL_F5 - ::NextRoutine() - - case nKey == K_F6 - ::ShowWorkAreas() - - case nKey == K_F7 - ::ToCursor() - - case nKey == K_F8 - ::Step() - - case nKey == K_F9 - ::ToggleBreakPoint() - - case nKey == K_F10 - ::Trace() - - case nKey == K_TAB - ::NextWindow() - - case nKey == K_SH_TAB - ::PrevWindow() - - case ::oWndCommand:lFocused .and. nKey < 272 // Alt - ::oWndCommand:KeyPressed( nKey ) - - otherwise - if ( nPopup := ::oPullDown:GetHotKeyPos( __dbgAltToKey( nKey ) ) ) != 0 - if ::oPullDown:nOpenPopup != nPopup + case nKey == K_LBUTTONDOWN + if MRow() == 0 + if ( nPopup := ::oPullDown:GetItemOrdByCoors( 0, MCol() ) ) != 0 + if ! ::oPullDown:IsOpen() if ::oWndCode:lFocused Eval( ::oWndCode:bLostFocus ) endif SetCursor( SC_NONE ) - ::oPullDown:ShowPopup( nPopup ) endif + ::oPullDown:ShowPopup( nPopup ) endif + + elseif MRow() == ::nMaxRow + + else + nMRow := MRow() + nMCol := MCol() + for n := 1 to Len( ::aWindows ) + if ::aWindows[ n ]:IsOver( nMRow, nMCol ) + if ! ::aWindows[ n ]:lFocused + ::aWindows[ ::nCurrentWindow ]:Show( .F. ) + ::nCurrentWindow := n + ::aWindows[ n ]:Show( .T. ) + endif + ::aWindows[ n ]:LButtonDown( nMRow, nMCol ) + exit + endif + next + endif + + case nKey == K_RBUTTONDOWN + + /*case nKey == K_ESC + ::RestoreAppStatus() + s_oDebugger := NIL + s_lExit := .T. + DispEnd() + ::Exit()*/ + + case nKey == K_UP .OR. nKey == K_DOWN .OR. nKey == K_HOME .OR. ; + nKey == K_END .OR. nKey == K_ENTER .OR. nKey == K_PGDN .OR. ; + nKey == K_PGUP .OR. nKey == K_DEL .OR. nKey == K_LEFT .OR. ; + nKey == K_RIGHT .OR. nKey == K_CTRL_ENTER + oWnd := ::aWindows[ ::nCurrentWindow ] + oWnd:KeyPressed( nKey ) + + case nKey == K_F1 + ::ShowHelp() + + case nKey == K_F4 + ::ShowAppScreen() + + case nKey == K_F5 + ::Go() + + case nKey == K_CTRL_F5 + ::NextRoutine() + + case nKey == K_F6 + ::ShowWorkAreas() + + case nKey == K_F7 + ::ToCursor() + + case nKey == K_F8 + ::Step() + + case nKey == K_F9 + ::ToggleBreakPoint() + + case nKey == K_F10 + ::Trace() + + case nKey == K_TAB + ::NextWindow() + + case nKey == K_SH_TAB + ::PrevWindow() + + case ::oWndCommand:lFocused .AND. nKey < 272 // Alt + ::oWndCommand:KeyPressed( nKey ) + + otherwise + if ( nPopup := ::oPullDown:GetHotKeyPos( __dbgAltToKey( nKey ) ) ) != 0 + if ::oPullDown:nOpenPopup != nPopup + if ::oWndCode:lFocused + Eval( ::oWndCode:bLostFocus ) + endif + SetCursor( SC_NONE ) + ::oPullDown:ShowPopup( nPopup ) + endif + endif endcase - end + enddo -return nil + RETURN NIL -METHOD Hide() CLASS TDebugger +METHOD Hide() CLASS HBDebugger ::CloseDebuggerWindow() -return nil + RETURN NIL -METHOD HideCallStack() CLASS TDebugger +METHOD HideCallStack() CLASS HBDebugger - ::lShowCallStack = .f. + ::lShowCallStack := .F. - if ::oWndStack != nil + if ::oWndStack != NIL DispBegin() ::oWndStack:Hide() if ::aWindows[ ::nCurrentWindow ] == ::oWndStack ::NextWindow() endif ::RemoveWindow( ::oWndStack ) - ::oWndStack = nil + ::oWndStack := NIL ::oWndCode:Resize(,,, ::oWndCode:nRight + 16 ) - if ::oWndVars != nil + if ::oWndVars != NIL ::oWndVars:Resize(,,, ::oWndVars:nRight + 16 ) endif - if ::oWndPnt != nil + if ::oWndPnt != NIL ::oWndPnt:Resize(,,, ::oWndPnt:nRight + 16 ) endif DispEnd() endif -return nil + RETURN NIL -METHOD HideVars() CLASS TDebugger +METHOD HideVars() CLASS HBDebugger LOCAL nTop IF ::oWndVars == NIL @@ -1459,11 +1499,11 @@ METHOD HideVars() CLASS TDebugger ::oWndVars:Hide() IF ::oWndPnt == NIL - nTop := 1 + nTop := 1 ELSE - ::oWndPnt:Resize( 1, , ::oWndPnt:nBottom - ( ::oWndPnt:nTop - 1 ) ) - ::oBrwPnt:Resize( 2, , ::oWndPnt:nBottom - 1 ) - nTop := ::oWndPnt:nBottom + 1 + ::oWndPnt:Resize( 1, , ::oWndPnt:nBottom - ( ::oWndPnt:nTop - 1 ) ) + ::oBrwPnt:Resize( 2, , ::oWndPnt:nBottom - 1 ) + nTop := ::oWndPnt:nBottom + 1 ENDIF ::oWndCode:Resize( nTop ) ::oBrwText:Resize( ::oWndCode:nTop+1 ) @@ -1476,45 +1516,45 @@ METHOD HideVars() CLASS TDebugger ::NextWindow() ENDIF -return nil + RETURN NIL -METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS TDebugger +METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger - local nTop := Int( ( ::nMaxRow / 2 ) - 5 ) - local nLeft := Int( ( ::nMaxCol / 2 ) - 25 ) - local nBottom := nTop + 2 - local nRight := nLeft + 50 - local cType := ValType( uValue ) - local nWidth := nRight - nLeft - 1 - local cPicture - local uTemp - local GetList := {} - local nOldCursor - local lScoreBoard := Set( _SET_SCOREBOARD, .f. ) - local lExit - local oWndInput := TDbWindow():New( nTop, nLeft, nBottom, nRight, cMsg,; + LOCAL nTop := Int( ( ::nMaxRow / 2 ) - 5 ) + LOCAL nLeft := Int( ( ::nMaxCol / 2 ) - 25 ) + LOCAL nBottom := nTop + 2 + LOCAL nRight := nLeft + 50 + LOCAL cType := ValType( uValue ) + LOCAL nWidth := nRight - nLeft - 1 + LOCAL cPicture + LOCAL uTemp + LOCAL GetList := {} + LOCAL nOldCursor + LOCAL lScoreBoard := Set( _SET_SCOREBOARD, .F. ) + LOCAL lExit + LOCAL oWndInput := HBDbWindow():New( nTop, nLeft, nBottom, nRight, cMsg,; ::oPullDown:cClrPopup ) #ifndef HB_NO_READDBG - local bMouseSave - local oGet + LOCAL bMouseSave + LOCAL oGet #endif - DEFAULT lEditable TO .t. + DEFAULT lEditable TO .T. - if cType = "C" .and. Len( uValue ) > nWidth + if cType == "C" .AND. Len( uValue ) > nWidth uTemp := uValue cPicture := '@s' + LTrim(Str(nWidth)) else uTemp := PadR( uValue, nWidth ) endif - oWndInput:lShadow := .t. + oWndInput:lShadow := .T. oWndInput:Show() if lEditable #ifndef HB_NO_READDBG - if bValid == nil + if bValid == NIL @ nTop + 1, nLeft + 1 GET uTemp PICTURE cPicture COLOR "," + __DbgColors()[ 5 ] else @ nTop + 1, nLeft + 1 GET uTemp PICTURE cPicture VALID Eval( bValid, uTemp ) ; @@ -1523,7 +1563,7 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS TDebugger nOldCursor := SetCursor( SC_NORMAL ) oGet := ATAIL( GetList ) - bMouseSave := Setkey( K_LBUTTONDOWN, {|| if(MRow() == nTop .and. MCol() == nLeft + 2,; + bMouseSave := Setkey( K_LBUTTONDOWN, {|| iif(MRow() == nTop .AND. MCol() == nLeft + 2,; (oGet:undo(), oGet:exitState := GE_ESCAPE, .T.), .F.)}) READ Setkey( K_LBUTTONDOWN, bMouseSave) @@ -1532,45 +1572,45 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS TDebugger uTemp := getdbginput( nTop + 1, nLeft + 1, uTemp, bValid, __DbgColors()[ 5 ] ) #endif else - @ nTop + 1, nLeft + 1 SAY ValToStr( uValue ) COLOR "," + __DbgColors()[ 5 ] + DispOutAt( nTop + 1, nLeft + 1, __dbgValToStr( uValue ), "," + __DbgColors()[ 5 ] ) SetPos( nTop + 1, nLeft + 1 ) nOldCursor := SetCursor( SC_NONE ) - lExit = .f. + lExit := .F. - while ! lExit + do while ! lExit Inkey( 0 ) do case - case LastKey() == K_ESC - lExit = .t. - - case LastKey() == K_ENTER - if cType == "A" - if Len( uValue ) == 0 - Alert( "Array is empty" ) - else - __DbgArrays( uValue, cMsg ) - endif - - elseif cType == "H" - if Len( uValue ) == 0 - Alert( "Hash is empty" ) - else - __DbgHashes( uValue, cMsg ) - endif - - elseif cType == "O" - __DbgObject( uValue, cMsg ) + case LastKey() == K_ESC + lExit := .T. + case LastKey() == K_ENTER + if cType == "A" + if Len( uValue ) == 0 + Alert( "Array is empty" ) else - Alert( "Value cannot be edited" ) + __DbgArrays( uValue, cMsg ) endif - otherwise + elseif cType == "H" + if Len( uValue ) == 0 + Alert( "Hash is empty" ) + else + __DbgHashes( uValue, cMsg ) + endif + + elseif cType == "O" + __DbgObject( uValue, cMsg ) + + else Alert( "Value cannot be edited" ) + endif + + otherwise + Alert( "Value cannot be edited" ) endcase - end + enddo SetCursor( nOldCursor ) endif @@ -1585,34 +1625,34 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS TDebugger Set( _SET_SCOREBOARD, lScoreBoard ) do case - case cType == "C" - uTemp := AllTrim( uTemp ) + case cType == "C" + uTemp := AllTrim( uTemp ) - case cType == "D" - uTemp := CToD( uTemp ) - - case cType == "N" - uTemp := Val( uTemp ) + case cType == "D" + uTemp := CToD( uTemp ) + case cType == "N" + uTemp := Val( uTemp ) endcase -return iif( LastKey() != K_ESC, uTemp, uValue ) + RETURN iif( LastKey() != K_ESC, uTemp, uValue ) -METHOD Inspect( uValue, cValueName ) CLASS TDebugger +METHOD Inspect( uValue, cValueName ) CLASS HBDebugger - uValue = ::InputBox( uValue, cValueName,, .f. ) + uValue := ::InputBox( uValue, cValueName,, .F. ) -return nil + RETURN NIL -METHOD IsValidStopLine( cName, nLine ) CLASS TDebugger -RETURN HB_DBG_IsValidStopLine( ::pInfo, cName, nLine ) +METHOD IsValidStopLine( cName, nLine ) CLASS HBDebugger + RETURN hb_DBG_IsValidStopLine( ::pInfo, cName, nLine ) -METHOD LineNumbers( lLineNumbers ) CLASS TDebugger +METHOD LineNumbers( lLineNumbers ) CLASS HBDebugger + + DEFAULT lLineNumbers TO !::lLineNumbers - If( lLineNumbers == NIL, lLineNumbers := !::lLineNumbers, ) ::lLineNumbers := lLineNumbers ::oPulldown:GetItemByIdent( "LINE" ):checked := ::lLineNumbers IF ::oBrwText != NIL @@ -1620,14 +1660,22 @@ METHOD LineNumbers( lLineNumbers ) CLASS TDebugger ::oBrwText:RefreshAll() ENDIF -return Self + RETURN Self -METHOD ListBox( cCaption, aItems ) CLASS TDebugger - LOCAL nItems, nMaxWid, nLeft, nTop, nBottom, nRight - LOCAL oWndList, cSelected := "" +METHOD ListBox( cCaption, aItems ) CLASS HBDebugger + + LOCAL nItems + LOCAL nMaxWid + LOCAL nLeft + LOCAL nTop + LOCAL nBottom + LOCAL nRight + LOCAL oWndList + LOCAL cSelected := "" LOCAL cColors - LOCAL GetList := {}, n + LOCAL GetList := {} + LOCAL n nItems := Len( aItems ) nMaxWid := Len( cCaption ) + 2 @@ -1638,7 +1686,7 @@ METHOD ListBox( cCaption, aItems ) CLASS TDebugger nBottom := ( ::nMaxRow / 2 ) + Min( nItems, ::nMaxRow - 5 ) / 2 + 1 nLeft := ( ::nMaxCol / 2 ) - Min( nMaxWid, ::nMaxCol * 3 / 2 ) / 2 nRight := ( ::nMaxCol / 2 ) + Min( nMaxWid, ::nMaxCol * 3 / 2 ) / 2 - oWndList := TDbWindow():new( nTop, nLeft, nBottom, nRight, cCaption, ; + oWndList := HBDbWindow():new( nTop, nLeft, nBottom, nRight, cCaption, ; ::oPullDown:cClrPopup ) oWndList:lShadow := .T. oWndList:Show() @@ -1648,32 +1696,34 @@ METHOD ListBox( cCaption, aItems ) CLASS TDebugger SetColor( cColors ) oWndList:Hide() -RETURN n + RETURN n -METHOD LoadCallStack() CLASS TDebugger - LOCAL i - LOCAL nDebugLevel - LOCAL nCurrLevel - LOCAL nlevel, nPos +METHOD LoadCallStack() CLASS HBDebugger - ::aProcStack := ARRAY( ::nProcLevel ) - nCurrLevel := hb_dbg_ProcLevel() - 1 - nDebugLevel := nCurrLevel - ::nProcLevel + 1 - FOR i := nDebugLevel TO nCurrLevel - nLevel := nCurrLevel - i + 1 - nPos := ASCAN( ::aCallStack, {|a| a[CSTACK_LEVEL] == nLevel} ) - IF ( nPos > 0 ) - //a procedure with debug info - ::aProcStack[i-nDebugLevel+1] := ::aCallStack[ nPos ] - ELSE - ::aProcStack[i-nDebugLevel+1] := { , PROCNAME( i )+"("+NTRIM(PROCLINE(i))+")", , nLevel, , } - ENDIF - NEXT -RETURN NIL + LOCAL i + LOCAL nDebugLevel + LOCAL nCurrLevel + LOCAL nlevel + LOCAL nPos + + ::aProcStack := ARRAY( ::nProcLevel ) + nCurrLevel := hb_dbg_ProcLevel() - 1 + nDebugLevel := nCurrLevel - ::nProcLevel + 1 + FOR i := nDebugLevel TO nCurrLevel + nLevel := nCurrLevel - i + 1 + nPos := AScan( ::aCallStack, {|a| a[CSTACK_LEVEL] == nLevel} ) + IF nPos > 0 + //a procedure with debug info + ::aProcStack[i-nDebugLevel+1] := ::aCallStack[ nPos ] + ELSE + ::aProcStack[i-nDebugLevel+1] := { , ProcName( i ) + "(" + LTrim( Str( ProcLine( i ) ) ) + ")", , nLevel, , } + ENDIF + NEXT + RETURN NIL -METHOD LoadColors() CLASS TDebugger +METHOD LoadColors() CLASS HBDebugger LOCAL n @@ -1689,17 +1739,21 @@ METHOD LoadColors() CLASS TDebugger ENDIF next -RETURN NIL + RETURN NIL -METHOD LoadSettings() CLASS TDebugger +METHOD LoadSettings() CLASS HBDebugger ::DoScript( ::cSettingsFileName ) -return nil + RETURN NIL -METHOD LoadVars() CLASS TDebugger // updates monitored variables +METHOD LoadVars() CLASS HBDebugger // updates monitored variables - local nCount, n, m, xValue, cName + LOCAL nCount + LOCAL n + LOCAL m + LOCAL xValue + LOCAL cName LOCAL aVars LOCAL aBVars @@ -1721,7 +1775,7 @@ METHOD LoadVars() CLASS TDebugger // updates monitored variables next endif - IF ::aProcStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] != nil + IF ::aProcStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] != NIL IF ::lShowGlobals cName := ::aProcStack[ ::oBrwStack:Cargo ][ CSTACK_MODULE ] FOR n := 1 TO Len( ::aModules ) @@ -1745,8 +1799,8 @@ METHOD LoadVars() CLASS TDebugger // updates monitored variables if ::lShowStatics cName := ::aProcStack[ ::oBrwStack:Cargo ][ CSTACK_MODULE ] - n := ASCAN( ::aModules, {|a| FILENAME_EQUAL( a[ MODULE_NAME ], cName ) } ) - IF ( n > 0 ) + n := AScan( ::aModules, {|a| FILENAME_EQUAL( a[ MODULE_NAME ], cName ) } ) + IF n > 0 aVars := ::aModules[ n ][ MODULE_STATICS ] for m := 1 to Len( aVars ) AAdd( aBVars, aVars[ m ] ) @@ -1764,7 +1818,7 @@ METHOD LoadVars() CLASS TDebugger // updates monitored variables cName := aVars[ n ][ VAR_NAME ] m := AScan( aBVars,; // Is there another var with this name ? { | aVar | aVar[ VAR_NAME ] == cName .AND. Left( aVar[ VAR_TYPE ], 1 ) == 'S' } ) - IF ( m > 0 ) + IF m > 0 aBVars[ m ] := aVars[ n ] ELSE AAdd( aBVars, aVars[ n ] ) @@ -1773,113 +1827,115 @@ METHOD LoadVars() CLASS TDebugger // updates monitored variables endif ENDIF - IF( ::oBrwVars != NIL .AND. ::oBrwVars:cargo[1] > LEN(aBVars) ) - ::oBrwVars:GoTop() + IF ::oBrwVars != NIL .AND. ::oBrwVars:cargo[ 1 ] > Len( aBVars ) + ::oBrwVars:GoTop() ENDIF ::aVars := aBVars if ::lSortVars ::Sort() endif -return nil + RETURN NIL -METHOD Local() CLASS TDebugger +METHOD Local() CLASS HBDebugger ::lShowLocals := ! ::lShowLocals ::RefreshVars() -return nil + RETURN NIL -METHOD Locate( nMode, cValue ) CLASS TDebugger - LOCAL lFound +METHOD Locate( nMode, cValue ) CLASS HBDebugger - DEFAULT nMode TO 0 - - IF Empty( cValue ) - ::cSearchString := Padr( ::cSearchString, 256 ) - cValue := ::InputBox( "Search string", ::cSearchString ) - IF Empty( cValue ) - RETURN NIL - ENDIF - ENDIF - - ::cSearchString := cValue - - lFound := ::oBrwText:Search( ::cSearchString, ::lCaseSensitive, nMode ) - - // Save cursor position to be restored by ::oWndCode:bGotFocus - ::oWndCode:cargo[ 1 ] := Row() - ::oWndCode:cargo[ 2 ] := Col() -RETURN lFound + LOCAL lFound + + DEFAULT nMode TO 0 + + IF Empty( cValue ) + ::cSearchString := PadR( ::cSearchString, 256 ) + cValue := ::InputBox( "Search string", ::cSearchString ) + IF Empty( cValue ) + RETURN NIL + ENDIF + ENDIF + + ::cSearchString := cValue + + lFound := ::oBrwText:Search( ::cSearchString, ::lCaseSensitive, nMode ) + + // Save cursor position to be restored by ::oWndCode:bGotFocus + ::oWndCode:cargo[ 1 ] := Row() + ::oWndCode:cargo[ 2 ] := Col() + RETURN lFound -METHOD LocatePrgPath( cPrgName ) CLASS TDebugger +METHOD LocatePrgPath( cPrgName ) CLASS HBDebugger - local i - local iMax - local aPaths - local cRetPrgName - local cSep + LOCAL i + LOCAL iMax + LOCAL aPaths + LOCAL cRetPrgName + LOCAL cSep - cSep := HB_OsPathSeparator() + cSep := hb_OsPathSeparator() aPaths := ::aPathDirs - iMax := len( aPaths ) + iMax := Len( aPaths ) for i := 1 to iMax cRetPrgName := aPaths[i] + cSep + cPrgName - if file( cRetPrgName ) + if File( cRetPrgName ) exit else - cRetPrgName := nil + cRetPrgName := NIL endif next i -return cRetPrgName + RETURN cRetPrgName -METHOD MonoDisplay() CLASS TDebugger +METHOD MonoDisplay() CLASS HBDebugger ::lMonoDisplay := ! ::lMonoDisplay ::oPullDown:GetItemByIdent( "MONO" ):checked := ::lMonoDisplay ::LoadColors() -return nil + RETURN NIL -METHOD NextRoutine() CLASS TDebugger - ::RestoreAppScreen() - ::RestoreAppState() - HB_DBG_SetNextRoutine( ::pInfo ) - ::Exit() -RETURN self +METHOD NextRoutine() CLASS HBDebugger + ::RestoreAppScreen() + ::RestoreAppState() + hb_DBG_SetNextRoutine( ::pInfo ) + ::Exit() + RETURN Self -METHOD NextWindow() CLASS TDebugger +METHOD NextWindow() CLASS HBDebugger - local oWnd + LOCAL oWnd if Len( ::aWindows ) > 0 oWnd := ::aWindows[ ::nCurrentWindow++ ] - oWnd:Show( .f. ) + oWnd:Show( .F. ) if ::nCurrentWindow > Len( ::aWindows ) ::nCurrentWindow := 1 endif - while ! ::aWindows[ ::nCurrentWindow ]:lVisible + do while ! ::aWindows[ ::nCurrentWindow ]:lVisible ::nCurrentWindow++ if ::nCurrentWindow > Len( ::aWindows ) ::nCurrentWindow := 1 endif - end + enddo oWnd := ::aWindows[ ::nCurrentWindow ] - oWnd:Show( .t. ) + oWnd:Show( .T. ) endif -return nil + RETURN NIL -METHOD Open() CLASS TDebugger +METHOD Open() CLASS HBDebugger + LOCAL nFileName LOCAL cFileName LOCAL cRealName @@ -1892,21 +1948,22 @@ METHOD Open() CLASS TDebugger nFileName := ::ListBox( "Please choose a source file", aFiles ) IF nFileName == 0 - RETURN NIL + RETURN NIL ELSEIF nFileName == 1 - cFileName := ::InputBox( "Please enter the filename", Space( 255 ) ) - cFileName:= ALLTRIM( cFileName ) + cFileName := ::InputBox( "Please enter the filename", Space( 255 ) ) + cFileName := AllTrim( cFileName ) ELSE - cFileName := aFiles[ nFileName ] + cFileName := aFiles[ nFileName ] ENDIF - IF ( !Empty( cFileName ) ; - .AND. ( ValType( ::cPrgName ) == 'U' .OR. !FILENAME_EQUAL( cFileName, ::cPrgName ) ) ) - if ! File( cFileName ) .and. ! Empty( ::cPathForFiles ) + IF !Empty( cFileName ) ; + .AND. ( ValType( ::cPrgName ) == 'U' .OR. !FILENAME_EQUAL( cFileName, ::cPrgName ) ) + + if ! File( cFileName ) .AND. ! Empty( ::cPathForFiles ) cRealName := ::LocatePrgPath( cFileName ) if Empty( cRealName ) Alert( "File '" + cFileName + "' not found!" ) - return NIL + RETURN NIL endif cFileName := cRealName endif @@ -1914,23 +1971,26 @@ METHOD Open() CLASS TDebugger hb_FNameSplit( cFileName, NIL, NIL, @cExt ) ::lppo := ( Lower( cExt ) == ".ppo" ) ::oPulldown:GetItemByIdent( "PPO" ):Checked := ::lppo - ::oBrwText := nil - ::oBrwText := TBrwText():New( ::oWndCode:nTop + 1, ::oWndCode:nLeft + 1,; - ::oWndCode:nBottom - 1, ::oWndCode:nRight - 1, cFileName,; - __DbgColors()[ 2 ] + "," + __DbgColors()[ 5 ] + "," + ; - __DbgColors()[ 3 ] + "," + __DbgColors()[ 6 ], ; - ::lLineNumbers, ::nTabWidth ) + ::oBrwText := NIL + ::oBrwText := HBBrwText():New( ::oWndCode:nTop + 1, ::oWndCode:nLeft + 1,; + ::oWndCode:nBottom - 1, ::oWndCode:nRight - 1, cFileName,; + __DbgColors()[ 2 ] + "," + __DbgColors()[ 5 ] + "," + ; + __DbgColors()[ 3 ] + "," + __DbgColors()[ 6 ], ; + ::lLineNumbers, ::nTabWidth ) ::oWndCode:Browser := ::oBrwText ::RedisplayBreakpoints() // check for breakpoints in this file and display them ::oWndCode:SetCaption( ::cPrgName ) ::oWndCode:Refresh() // to force the window caption to update endif -return nil + RETURN NIL -METHOD OpenPPO() CLASS TDebugger - LOCAL lSuccess:=.F. - LOCAL cDir, cName, cExt +METHOD OpenPPO() CLASS HBDebugger + + LOCAL lSuccess := .F. + LOCAL cDir + LOCAL cName + LOCAL cExt IF Empty( ::cPrgName ) RETURN .F. @@ -1940,17 +2000,17 @@ METHOD OpenPPO() CLASS TDebugger IF Lower( cExt ) == ".ppo" ::cPrgName := hb_FNameMerge( cDir, cName, ".prg" ) - lSuccess := FILE( ::cPrgName ) + lSuccess := File( ::cPrgName ) ::lppo := !lSuccess ELSE ::cPrgName := hb_FNameMerge( cDir, cName, ".ppo" ) - lSuccess := FILE( ::cPrgName ) + lSuccess := File( ::cPrgName ) ::lppo := lSuccess ENDIF - IF( lSuccess ) - ::oBrwText := nil - ::oBrwText := TBrwText():New( ::oWndCode:nTop + 1, ::oWndCode:nLeft + 1,; + IF lSuccess + ::oBrwText := NIL + ::oBrwText := HBBrwText():New( ::oWndCode:nTop + 1, ::oWndCode:nLeft + 1,; ::oWndCode:nBottom - 1, ::oWndCode:nRight - 1, ::cPrgName,; __DbgColors()[ 2 ] + "," + __DbgColors()[ 5 ] + "," + ; __DbgColors()[ 3 ] + "," + __DbgColors()[ 6 ], ::lLineNumbers, ::nTabWidth ) @@ -1962,58 +2022,63 @@ METHOD OpenPPO() CLASS TDebugger ::oPullDown:GetItemByIdent( "PPO" ):checked := ::lPPO -return lSuccess + RETURN lSuccess -METHOD OSShell() CLASS TDebugger +METHOD OSShell() CLASS HBDebugger - local cImage := SaveScreen() - local cColors := SetColor() - local cOs := Upper( OS() ) - local cShell - local bLastHandler := ErrorBlock({ |objErr| BREAK (objErr) }) - local oE + LOCAL cImage := SaveScreen() + LOCAL cColors := SetColor() + LOCAL cOs := Upper( OS() ) + LOCAL cShell + LOCAL bLastHandler := ErrorBlock( { | objErr | Break( objErr ) } ) + LOCAL oE - SET COLOR TO "W/N" + SetColor( "W/N" ) CLS - ? "Type 'exit' to return to the Debugger" + ? "Type 'exit' to RETURN to the Debugger" SetCursor( SC_NORMAL ) - begin sequence - if At("WINDOWS", cOs) != 0 .OR. At("DOS", cOs) != 0 .OR. At("OS/2", cOs) != 0 - cShell := GetEnv("COMSPEC") - RUN ( cShell ) - elseif At("LINUX", cOs) != 0 .OR. At( "BSD", cOs ) != 0 .OR. At( "DARWIN", cOs ) != 0 - cShell := GetEnv("SHELL") - RUN ( cShell ) - else - Alert( "Not implemented yet!" ) - endif + BEGIN SEQUENCE + + IF At( "WINDOWS", cOs ) != 0 .OR. At( "DOS", cOs ) != 0 .OR. At( "OS/2", cOs ) != 0 + cShell := GetEnv( "COMSPEC" ) + RUN ( cShell ) + ELSEIF At( "LINUX", cOs ) != 0 .OR. At( "BSD", cOs ) != 0 .OR. At( "DARWIN", cOs ) != 0 + cShell := GetEnv( "SHELL" ) + RUN ( cShell ) + ELSE + Alert( "Not implemented yet!" ) + ENDIF + + RECOVER USING oE - recover using oE Alert("Error: " + oE:description) - end sequence + END SEQUENCE - ErrorBlock(bLastHandler) + ErrorBlock( bLastHandler ) SetCursor( SC_NONE ) RestScreen( ,,,, cImage ) SetColor( cColors ) -return nil + RETURN NIL -METHOD Quit() CLASS TDebugger - ::Exit() - ::Hide() - HB_DBG_SetQuit( ::pInfo ) - s_oDebugger := NIL - __QUIT() -RETURN NIL +METHOD Quit() CLASS HBDebugger + + ::Exit() + ::Hide() + hb_DBG_SetQuit( ::pInfo ) + s_oDebugger := NIL + + __QUIT() + + RETURN NIL -METHOD PathForFiles( cPathForFiles ) CLASS TDebugger +METHOD PathForFiles( cPathForFiles ) CLASS HBDebugger IF cPathForFiles == NIL cPathForFiles := ::InputBox( "Search path for source files:", ::cPathForFiles ) @@ -2022,57 +2087,66 @@ METHOD PathForFiles( cPathForFiles ) CLASS TDebugger ::aPathDirs := PathToArray( ::cPathForFiles ) ::Resume() -RETURN Self + RETURN Self -METHOD PrevWindow() CLASS TDebugger +METHOD PrevWindow() CLASS HBDebugger - local oWnd + LOCAL oWnd + + IF Len( ::aWindows ) > 0 - if Len( ::aWindows ) > 0 oWnd := ::aWindows[ ::nCurrentWindow-- ] - oWnd:Show( .f. ) + oWnd:Show( .F. ) if ::nCurrentWindow < 1 ::nCurrentWindow := Len( ::aWindows ) endif - while ! ::aWindows[ ::nCurrentWindow ]:lVisible + do while ! ::aWindows[ ::nCurrentWindow ]:lVisible ::nCurrentWindow-- if ::nCurrentWindow < 1 ::nCurrentWindow := Len( ::aWindows ) endif - end + enddo oWnd := ::aWindows[ ::nCurrentWindow ] - oWnd:Show( .t. ) - endif + oWnd:Show( .T. ) -return nil + ENDIF + + RETURN NIL -METHOD Private() CLASS TDebugger +METHOD Private() CLASS HBDebugger + ::lShowPrivates := ! ::lShowPrivates ::RefreshVars() -return nil + + RETURN NIL -METHOD Public() CLASS TDebugger +METHOD Public() CLASS HBDebugger + ::lShowPublics := ! ::lShowPublics ::RefreshVars() -return nil + + RETURN NIL // check for breakpoints in the current file and display them -METHOD RedisplayBreakPoints() CLASS TDebugger - LOCAL n +METHOD RedisplayBreakPoints() CLASS HBDebugger - FOR n := 1 TO Len( ::aBreakpoints ) - IF FILENAME_EQUAL( ::aBreakpoints[ n ][ 2 ], strip_path( ::cPrgName ) ) - ::oBrwText:ToggleBreakPoint(::aBreakpoints[ n ][ 1 ], .T.) - ENDIF - NEXT -RETURN NIL + LOCAL n + + FOR n := 1 TO Len( ::aBreakpoints ) + IF FILENAME_EQUAL( ::aBreakpoints[ n ][ 2 ], strip_path( ::cPrgName ) ) + ::oBrwText:ToggleBreakPoint( ::aBreakpoints[ n ][ 1 ], .T.) + ENDIF + NEXT + + RETURN NIL -METHOD RefreshVars() CLASS TDebugger +METHOD RefreshVars() CLASS HBDebugger + ::oPulldown:GetItemByIdent( "GLOBAL" ):checked := ::lShowGlobals ::oPulldown:GetItemByIdent( "LOCAL" ):checked := ::lShowLocals ::oPulldown:GetItemByIdent( "PRIVATE" ):checked := ::lShowPrivates @@ -2080,109 +2154,116 @@ METHOD RefreshVars() CLASS TDebugger ::oPulldown:GetItemByIdent( "STATIC" ):checked := ::lShowStatics ::oPulldown:GetItemByIdent( "ALL" ):checked := ::lAll ::oPulldown:GetItemByIdent( "SHOWALLGLOBALS" ):checked := ::lShowAllGlobals + IF ::lActive - if ::lShowGlobals .OR. ::lShowPublics .or. ::lShowPrivates .or. ::lShowStatics .or. ::lShowLocals + IF ::lShowGlobals .OR. ::lShowPublics .OR. ::lShowPrivates .OR. ::lShowStatics .OR. ::lShowLocals ::LoadVars() ::ShowVars() - else - ::HideVars() - endif - ENDIF -RETURN NIL - - -METHOD RemoveWindow( oWnd ) CLASS TDebugger - - local n := AScan( ::aWindows, { | o | o == oWnd } ) - - if n != 0 - ::aWindows = ADel ( ::aWindows, n ) - ::aWindows = ASize( ::aWindows, Len( ::aWindows ) - 1 ) - endif - - ::nCurrentWindow = 1 - -return nil - - -METHOD ResizeWindows( oWindow ) CLASS TDebugger - LOCAL oWindow2, nTop, lVisible2 := .F. - - IF oWindow == ::oWndVars - oWindow2 := ::oWndPnt - ELSEIF oWindow == ::oWndPnt - oWindow2 := ::oWndVars - ENDIF - - DispBegin() - IF oWindow2 == NIL - nTop := oWindow:nBottom +1 - ELSE - lVisible2 := oWindow2:lVisible - IF oWindow2:lVisible - IF oWindow:nTop < oWindow2:nTop - nTop := oWindow2:nBottom - oWindow2:nTop + 1 - oWindow2:Resize( oWindow:nBottom+1,, oWindow:nBottom+nTop) ELSE - nTop := oWindow:nBottom - oWindow:nTop + 1 - oWindow:Resize( oWindow2:nBottom+1,, oWindow2:nBottom+nTop) + ::HideVars() ENDIF - nTop := MAX( oWindow:nBottom, oWindow2:nBottom ) + 1 - ELSE - IF oWindow:nTop > 1 - nTop := oWindow:nBottom - oWindow:nTop + 1 - oWindow:Resize( 1, , nTop ) + ENDIF + + RETURN NIL + + +METHOD RemoveWindow( oWnd ) CLASS HBDebugger + + LOCAL n := AScan( ::aWindows, { | o | o == oWnd } ) + + IF n != 0 + ::aWindows := ADel( ::aWindows, n ) + ::aWindows := ASize( ::aWindows, Len( ::aWindows ) - 1 ) + ENDIF + + ::nCurrentWindow := 1 + + RETURN NIL + + +METHOD ResizeWindows( oWindow ) CLASS HBDebugger + + LOCAL oWindow2 + LOCAL nTop + LOCAL lVisible2 := .F. + + IF oWindow == ::oWndVars + oWindow2 := ::oWndPnt + ELSEIF oWindow == ::oWndPnt + oWindow2 := ::oWndVars + ENDIF + + DispBegin() + IF oWindow2 == NIL + nTop := oWindow:nBottom +1 + ELSE + lVisible2 := oWindow2:lVisible + IF oWindow2:lVisible + IF oWindow:nTop < oWindow2:nTop + nTop := oWindow2:nBottom - oWindow2:nTop + 1 + oWindow2:Resize( oWindow:nBottom+1,, oWindow:nBottom+nTop) + ELSE + nTop := oWindow:nBottom - oWindow:nTop + 1 + oWindow:Resize( oWindow2:nBottom+1,, oWindow2:nBottom+nTop) + ENDIF + nTop := MAX( oWindow:nBottom, oWindow2:nBottom ) + 1 + ELSE + IF oWindow:nTop > 1 + nTop := oWindow:nBottom - oWindow:nTop + 1 + oWindow:Resize( 1, , nTop ) + ENDIF + nTop := oWindow:nBottom + 1 ENDIF - nTop := oWindow:nBottom + 1 - ENDIF - ENDIF + ENDIF - oWindow:hide() - IF oWindow2 != NIL - oWindow2:hide() - ENDIF + oWindow:hide() + IF oWindow2 != NIL + oWindow2:hide() + ENDIF - ::oWndCode:Resize( nTop ) - IF ::oWndCode:lFocused - ::oWndCode:cargo[ 1 ] := Row() - ::oWndCode:cargo[ 2 ] := Col() - ENDIF + ::oWndCode:Resize( nTop ) + IF ::oWndCode:lFocused + ::oWndCode:cargo[ 1 ] := Row() + ::oWndCode:cargo[ 2 ] := Col() + ENDIF - IF oWindow2 != NIL .AND. lVisible2 - oWindow2:show() - ENDIF - oWindow:show() - DispEnd() + IF oWindow2 != NIL .AND. lVisible2 + oWindow2:show() + ENDIF + oWindow:show() + DispEnd() -RETURN self + RETURN Self -METHOD RestoreAppScreen() CLASS TDebugger - LOCAL i +METHOD RestoreAppScreen() CLASS HBDebugger - ::CloseDebuggerWindow() + LOCAL i - FOR i := 1 TO ::nAppDispCount - DispBegin() - NEXT -return nil + ::CloseDebuggerWindow() + + FOR i := 1 TO ::nAppDispCount + DispBegin() + NEXT + + RETURN NIL -METHOD RestoreAppState() CLASS TDebugger - Set( _SET_DIRCASE, ::nAppDirCase ) - Set( _SET_FILECASE, ::nAppFileCase ) - Set( _SET_TYPEAHEAD, ::nAppTypeAhead ) - HB_SetLastKey( ::nAppLastKey ) +METHOD RestoreAppState() CLASS HBDebugger + Set( _SET_DIRCASE, ::nAppDirCase ) + Set( _SET_FILECASE, ::nAppFileCase ) + Set( _SET_TYPEAHEAD, ::nAppTypeAhead ) + hb_SetLastKey( ::nAppLastKey ) #ifdef __XHARBOUR__ - SetInkeyAfterBlock( ::bAppInkeyAfter ) - SetInkeyBeforeBlock( ::bAppInkeyBefore ) - __SetClassScope( ::bAppClassScope ) + SetInkeyAfterBlock( ::bAppInkeyAfter ) + SetInkeyBeforeBlock( ::bAppInkeyBefore ) + __SetClassScope( ::bAppClassScope ) #endif - __GetListSetActive( ::oAppGetList ) -RETURN NIL + __GetListSetActive( ::oAppGetList ) + RETURN NIL -METHOD RestoreSettings() CLASS TDebugger +METHOD RestoreSettings() CLASS HBDebugger ::cSettingsFileName := ::InputBox( "File name", ::cSettingsFileName ) @@ -2191,76 +2272,81 @@ METHOD RestoreSettings() CLASS TDebugger ::ShowVars() endif -return nil + RETURN NIL -METHOD SaveAppScreen() CLASS TDebugger - LOCAL nRight, nTop, i +METHOD SaveAppScreen() CLASS HBDebugger - ::nAppDispCount := DispCount() - FOR i := 1 TO ::nAppDispCount - DispEnd() - NEXT - - ::OpenDebuggerWindow() - - IF ::nMaxRow != MaxRow() .OR. ::nMaxCol != MaxCol() - DispBegin() - ::nMaxRow := MaxRow() - ::nMaxCol := MaxCol() - nTop := 1 - nRight := ::nMaxCol - ::oWndCommand:Resize( ::nMaxRow - 5, 0, ::nMaxRow - 1, ::nMaxCol ) - ::oGetListCommand:oGet:Row := ::oWndCommand:nBottom - 1 - ::oGetListCommand:oGet:Col := ::oWndCommand:nLeft + 3 - ::oBrwStack:nRight := ::nMaxCol - 1 - ::oBrwStack:nBottom := ::nMaxRow - 7 - ::oBrwStack:nLeft := ::nMaxCol - 14 - ::oBrwStack:nTop := 2 - IF ::oWndStack != NIL - nRight -= 16 - ::oWndStack:Resize( , nRight + 1, ::nMaxRow - 6, ::nMaxCol ) - ENDIF - IF ::oWndVars != NIL - ::oWndVars:Resize( , , , nRight ) - nTop := Max( nTop, ::oWndVars:nBottom + 1 ) - ENDIF - IF ::oWndPnt != NIL - ::oWndPnt:Resize( , , , nRight ) - nTop := Max( nTop, ::oWndPnt:nBottom + 1 ) - ENDIF - ::oWndCode:Resize( nTop, 0, ::nMaxRow - 6, nRight ) - ::oPullDown:Refresh() - ::BarDisplay() - DispEnd() - ENDIF -return nil + LOCAL nRight + LOCAL nTop + LOCAL i + + ::nAppDispCount := DispCount() + FOR i := 1 TO ::nAppDispCount + DispEnd() + NEXT + + ::OpenDebuggerWindow() + + IF ::nMaxRow != MaxRow() .OR. ::nMaxCol != MaxCol() + DispBegin() + ::nMaxRow := MaxRow() + ::nMaxCol := MaxCol() + nTop := 1 + nRight := ::nMaxCol + ::oWndCommand:Resize( ::nMaxRow - 5, 0, ::nMaxRow - 1, ::nMaxCol ) + ::oGetListCommand:oGet:Row := ::oWndCommand:nBottom - 1 + ::oGetListCommand:oGet:Col := ::oWndCommand:nLeft + 3 + ::oBrwStack:nTop := 2 + ::oBrwStack:nLeft := ::nMaxCol - 14 + ::oBrwStack:nRight := ::nMaxCol - 1 + ::oBrwStack:nBottom := ::nMaxRow - 7 + IF ::oWndStack != NIL + nRight -= 16 + ::oWndStack:Resize( , nRight + 1, ::nMaxRow - 6, ::nMaxCol ) + ENDIF + IF ::oWndVars != NIL + ::oWndVars:Resize( , , , nRight ) + nTop := Max( nTop, ::oWndVars:nBottom + 1 ) + ENDIF + IF ::oWndPnt != NIL + ::oWndPnt:Resize( , , , nRight ) + nTop := Max( nTop, ::oWndPnt:nBottom + 1 ) + ENDIF + ::oWndCode:Resize( nTop, 0, ::nMaxRow - 6, nRight ) + ::oPullDown:Refresh() + ::BarDisplay() + DispEnd() + ENDIF + RETURN NIL -METHOD SaveAppState() CLASS TDebugger - ::nAppDirCase := Set( _SET_DIRCASE, 0 ) - ::nAppFileCase := Set( _SET_FILECASE, 0 ) - ::nAppTypeAhead := Set( _SET_TYPEAHEAD, 16 ) - ::nAppLastKey := LastKey() +METHOD SaveAppState() CLASS HBDebugger + ::nAppDirCase := Set( _SET_DIRCASE, 0 ) + ::nAppFileCase := Set( _SET_FILECASE, 0 ) + ::nAppTypeAhead := Set( _SET_TYPEAHEAD, 16 ) + ::nAppLastKey := LastKey() #ifdef __XHARBOUR__ - ::bAppInkeyAfter := SetInkeyAfterBlock( NIL ) - ::bAppInkeyBefore := SetInkeyBeforeBlock( NIL ) - ::bAppClassScope := __SetClassScope( .F. ) + ::bAppInkeyAfter := SetInkeyAfterBlock( NIL ) + ::bAppInkeyBefore := SetInkeyBeforeBlock( NIL ) + ::bAppClassScope := __SetClassScope( .F. ) #endif - ::oAppGetList := __GetListActive() -RETURN NIL + ::oAppGetList := __GetListActive() + RETURN NIL -METHOD SaveSettings() CLASS TDebugger +METHOD SaveSettings() CLASS HBDebugger - local cInfo := "", n, oWnd + LOCAL cInfo := "" + LOCAL n + LOCAL oWnd ::cSettingsFileName := ::InputBox( "File name", ::cSettingsFileName ) if LastKey() != K_ESC if ! Empty( ::cPathForFiles ) - cInfo += "Options Path " + ::cPathForFiles + HB_OsNewLine() + cInfo += "Options Path " + ::cPathForFiles + hb_OsNewLine() endif cInfo += "Options Colors {" @@ -2270,135 +2356,131 @@ METHOD SaveSettings() CLASS TDebugger cInfo += "," endif next - cInfo += "}" + HB_OsNewLine() + cInfo += "}" + hb_OsNewLine() if ::lMonoDisplay - cInfo += "Options mono " + HB_OsNewLine() + cInfo += "Options mono " + hb_OsNewLine() endif if !::lRunAtStartup - cInfo += "Options NoRunAtStartup " + HB_OsNewLine() + cInfo += "Options NoRunAtStartup " + hb_OsNewLine() endif if ::nSpeed != 0 - cInfo += "Run Speed " + AllTrim( Str( ::nSpeed ) ) + HB_OsNewLine() + cInfo += "Run Speed " + LTrim( Str( ::nSpeed ) ) + hb_OsNewLine() endif if ::nTabWidth != 4 - cInfo += "Options Tab " + AllTrim( Str( ::nTabWidth ) ) + HB_OsNewLine() + cInfo += "Options Tab " + LTrim( Str( ::nTabWidth ) ) + hb_OsNewLine() endif if ::lShowStatics - cInfo += "Monitor Static" + HB_OsNewLine() + cInfo += "Monitor Static" + hb_OsNewLine() endif if ::lShowPublics - cInfo += "Monitor Public" + HB_OsNewLine() + cInfo += "Monitor Public" + hb_OsNewLine() endif if ::lShowLocals - cInfo += "Monitor Local" + HB_OsNewLine() + cInfo += "Monitor Local" + hb_OsNewLine() endif if ::lShowPrivates - cInfo += "Monitor Private" + HB_OsNewLine() + cInfo += "Monitor Private" + hb_OsNewLine() endif if ::lShowGlobals - cInfo += "Monitor Global" + HB_OsNewLine() + cInfo += "Monitor Global" + hb_OsNewLine() endif if ::lSortVars - cInfo += "Monitor Sort" + HB_OsNewLine() + cInfo += "Monitor Sort" + hb_OsNewLine() endif if ::lShowCallStack - cInfo += "View CallStack" + HB_OsNewLine() + cInfo += "View CallStack" + hb_OsNewLine() endif if ! ::lLineNumbers - cInfo += "Num Off" + HB_OsNewLine() + cInfo += "Num Off" + hb_OsNewLine() endif if ! Empty( ::aBreakPoints ) for n := 1 to Len( ::aBreakPoints ) - cInfo += "BP " + AllTrim( Str( ::aBreakPoints[ n ][ 1 ] ) ) + " " + ; - AllTrim( ::aBreakPoints[ n ][ 2 ] ) + HB_OsNewLine() + cInfo += "BP " + LTrim( Str( ::aBreakPoints[ n ][ 1 ] ) ) + " " + ; + AllTrim( ::aBreakPoints[ n ][ 2 ] ) + hb_OsNewLine() next endif /* This part of the script must be executed after all windows are created */ for n := 1 to Len( ::aWindows ) oWnd := ::aWindows[ n ] - cInfo += "Window Size " + AllTrim( Str( oWnd:nBottom - oWnd:nTop + 1 ) ) + " " - cInfo += AllTrim( Str( oWnd:nRight - oWnd:nLeft + 1 ) ) + HB_OsNewLine() - cInfo += "Window Move " + AllTrim( Str( oWnd:nTop ) ) + " " - cInfo += AllTrim( Str( oWnd:nLeft ) ) + HB_OsNewLine() - cInfo += "Window Next" + HB_OsNewLine() + cInfo += "Window Size " + LTrim( Str( oWnd:nBottom - oWnd:nTop + 1 ) ) + " " + cInfo += LTrim( Str( oWnd:nRight - oWnd:nLeft + 1 ) ) + hb_OsNewLine() + cInfo += "Window Move " + LTrim( Str( oWnd:nTop ) ) + " " + cInfo += LTrim( Str( oWnd:nLeft ) ) + hb_OsNewLine() + cInfo += "Window Next" + hb_OsNewLine() next MemoWrit( ::cSettingsFileName, cInfo ) endif -return nil + RETURN NIL -METHOD SearchLine() CLASS TDebugger +METHOD SearchLine() CLASS HBDebugger - local cLine - - cLine := ::InputBox( "Line number", "1" ) + LOCAL cLine := ::InputBox( "Line number", "1" ) if Val( cLine ) > 0 ::GotoLine ( Val( cLine ) ) endif -return nil + RETURN NIL -METHOD Show() CLASS TDebugger +METHOD Show() CLASS HBDebugger ::SaveAppScreen() ::oPullDown:Display() - ::oWndCode:Show( .t. ) + ::oWndCode:Show( .T. ) ::oWndCommand:Show() DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, ">" ) ::BarDisplay() -return nil + RETURN NIL -METHOD ShowAllGlobals() CLASS TDebugger +METHOD ShowAllGlobals() CLASS HBDebugger ::lShowAllGlobals := ! ::lShowAllGlobals ::RefreshVars() -RETURN NIL + RETURN NIL -METHOD ShowAppScreen() CLASS TDebugger +METHOD ShowAppScreen() CLASS HBDebugger ::CloseDebuggerWindow() if LastKey() == K_LBUTTONDOWN - InKey( 0, INKEY_ALL ) + Inkey( 0, INKEY_ALL ) endif - while InKey( 0, INKEY_ALL ) == K_MOUSEMOVE - end + do while Inkey( 0, INKEY_ALL ) == K_MOUSEMOVE + enddo ::OpenDebuggerWindow() -return nil + RETURN NIL -METHOD ShowCallStack() CLASS TDebugger +METHOD ShowCallStack() CLASS HBDebugger - local n := 1 + ::lShowCallStack := .T. - ::lShowCallStack = .t. - - if ::oWndStack == nil + if ::oWndStack == NIL SetCursor( SC_NONE ) @@ -2406,75 +2488,78 @@ METHOD ShowCallStack() CLASS TDebugger // Resize code window ::oWndCode:Resize(,,, ::oWndCode:nRight - 16 ) // Resize vars window - if ::oWndVars != nil + if ::oWndVars != NIL ::oWndVars:Resize(,,, ::oWndVars:nRight - 16 ) endif // Resize watchpoints window - if ::oWndPnt != nil + if ::oWndPnt != NIL ::oWndPnt:Resize(,,, ::oWndPnt:nRight - 16) endif DispEnd() if ::aWindows[ ::nCurrentWindow ]:lFocused - ::aWindows[ ::nCurrentWindow ]:Show( .f. ) + ::aWindows[ ::nCurrentWindow ]:Show( .F. ) endif - ::oWndStack := TDbWindow():New( 1, ::nMaxCol - 15, ::nMaxRow - 6, ::nMaxCol,; + ::oWndStack := HBDbWindow():New( 1, ::nMaxCol - 15, ::nMaxRow - 6, ::nMaxCol,; "Calls" ) ::oWndStack:bKeyPressed := { | nKey | ::CallStackProcessKey( nKey ) } ::oWndStack:bLButtonDown := { || ::CallStackProcessKey( K_LBUTTONDOWN ) } AAdd( ::aWindows, ::oWndStack ) - //::nCurrentWindow = Len( ::aWindows ) + //::nCurrentWindow := Len( ::aWindows ) - if ::oBrwStack == nil + if ::oBrwStack == NIL ::BuildBrowseStack() endif ::oWndStack:bPainted := { || ::oBrwStack:ColorSpec := __DbgColors()[ 2 ] + "," + ; __DbgColors()[ 5 ] + "," + __DbgColors()[ 4 ],; ::oBrwStack:RefreshAll(), ::oBrwStack:ForceStable() } - ::oWndStack:bGotFocus = { || SetCursor( SC_NONE ) } + ::oWndStack:bGotFocus := { || SetCursor( SC_NONE ) } - ::oWndStack:Show( .f. ) + ::oWndStack:Show( .F. ) endif -return nil + RETURN NIL -METHOD ShowCodeLine( nProc ) CLASS TDebugger - LOCAL cDir, cName - LOCAL nLine, cPrgName +METHOD ShowCodeLine( nProc ) CLASS HBDebugger + + LOCAL cDir + LOCAL cName + LOCAL nLine + LOCAL cPrgName // we only update the stack window and up a new browse // to view the code if we have just broken execution if !::lGo - if ::oWndStack != nil + if ::oWndStack != NIL ::oBrwStack:RefreshAll() endif nLine := ::aProcStack[ nProc ][ CSTACK_LINE ] cPrgName := ::aProcStack[ nProc ][ CSTACK_MODULE ] - IF ( nLine == NIL ) - ::oBrwText := nil - ::oWndCode:Browser := nil + IF nLine == NIL + ::oBrwText := NIL + ::oWndCode:Browser := NIL ::oWndCode:SetCaption( ::aProcStack[ nProc ][ CSTACK_FUNCTION ] +; ": Code not available" ) ::oWndCode:Refresh()// to force the window caption to update - RETURN nil + RETURN NIL ENDIF - if( ::lppo ) + if ::lppo hb_FNameSplit( cPrgName, @cDir, @cName, NIL ) cPrgName := hb_FNameMerge( cDir, cName, ".ppo" ) endif - if ! empty( cPrgName ) + if ! Empty( cPrgName ) - if ( !FILENAME_EQUAL( strip_path( cPrgName ), strip_path( ::cPrgName ) ) ; - .OR. ::oBrwText == NIL ) + if !FILENAME_EQUAL( strip_path( cPrgName ), strip_path( ::cPrgName ) ) ; + .OR. ::oBrwText == NIL - if ! File( cPrgName ) .and. !Empty( ::cPathForFiles ) + if ! File( cPrgName ) .AND. !Empty( ::cPathForFiles ) cPrgName := ::LocatePrgPath( cPrgName ) endif @@ -2489,12 +2574,12 @@ METHOD ShowCodeLine( nProc ) CLASS TDebugger RETURN NIL ENDIF - if ::oBrwText == nil - ::oBrwText := TBrwText():New( ::oWndCode:nTop + 1, ::oWndCode:nLeft + 1,; - ::oWndCode:nBottom - 1, ::oWndCode:nRight - 1, cPrgName,; - __DbgColors()[ 2 ] + "," + __DbgColors()[ 5 ] + "," + ; - __DbgColors()[ 3 ] + "," + __DbgColors()[ 6 ], ; - ::lLineNumbers, ::nTabWidth ) + if ::oBrwText == NIL + ::oBrwText := HBBrwText():New( ::oWndCode:nTop + 1, ::oWndCode:nLeft + 1,; + ::oWndCode:nBottom - 1, ::oWndCode:nRight - 1, cPrgName,; + __DbgColors()[ 2 ] + "," + __DbgColors()[ 5 ] + "," + ; + __DbgColors()[ 3 ] + "," + __DbgColors()[ 6 ], ; + ::lLineNumbers, ::nTabWidth ) ::oWndCode:Browser := ::oBrwText @@ -2502,7 +2587,7 @@ METHOD ShowCodeLine( nProc ) CLASS TDebugger ::oBrwText:LoadFile(cPrgName) endif - ::oWndCode:bPainted := {|| IIF( ::oBrwText != nil, ::oBrwText:RefreshAll():ForceStable(), ::oWndCode:Clear() ) } + ::oWndCode:bPainted := {|| iif( ::oBrwText != NIL, ::oBrwText:RefreshAll():ForceStable(), ::oWndCode:Clear() ) } ::RedisplayBreakpoints() // check for breakpoints in this file and display them ::oWndCode:SetCaption( ::cPrgName ) ::oWndCode:Refresh() // to force the window caption to update @@ -2513,47 +2598,48 @@ METHOD ShowCodeLine( nProc ) CLASS TDebugger endif -return nil + RETURN NIL -METHOD ShowHelp( nTopic ) CLASS TDebugger +METHOD ShowHelp( nTopic ) CLASS HBDebugger - local nCursor := SetCursor( SC_NONE ) + LOCAL nCursor := SetCursor( SC_NONE ) __dbgHelp( nTopic ) SetCursor( nCursor ) -return nil + RETURN NIL #define MAX_VARS_HEIGHT 7 -METHOD ShowVars() CLASS TDebugger +METHOD ShowVars() CLASS HBDebugger - local nWidth, n := 1 - Local oCol - local lRepaint := .f. - local nTop, nBottom + LOCAL nWidth + LOCAL oCol + LOCAL lRepaint := .F. + LOCAL nTop + LOCAL nBottom LOCAL lWindowCreated := .F. if ::lGo - return nil + RETURN NIL endif - if ! ( ::lShowLocals .or. ::lShowStatics .or. ::lShowPrivates .or. ; - ::lShowPublics .or. ::lShowGlobals ) - return nil + if ! ( ::lShowLocals .OR. ::lShowStatics .OR. ::lShowPrivates .OR. ; + ::lShowPublics .OR. ::lShowGlobals ) + RETURN NIL endif DispBegin() - if ::oWndVars == nil + if ::oWndVars == NIL - nTop := IIF(::oWndPnt!=NIL .AND. ::oWndPnt:lVisible,::oWndPnt:nBottom+1,1) - nBottom = nTop + Min( MAX_VARS_HEIGHT, Len( ::aVars ) + 1 ) + nTop := iif(::oWndPnt!=NIL .AND. ::oWndPnt:lVisible,::oWndPnt:nBottom+1,1) + nBottom := nTop + Min( MAX_VARS_HEIGHT, Len( ::aVars ) + 1 ) - ::oWndVars := TDbWindow():New( nTop, 0, nBottom,; - ::nMaxCol - iif( ::oWndStack != nil, ::oWndStack:nWidth(), 0 ),; + ::oWndVars := HBDbWindow():New( nTop, 0, nBottom,; + ::nMaxCol - iif( ::oWndStack != NIL, ::oWndStack:nWidth(), 0 ),; "Monitor:" + ; iif( ::lShowGlobals, " Global", "" ) + iif( ::lShowLocals, " Local", "" ) + ; iif( ::lShowStatics, " Static", "" ) + iif( ::lShowPrivates, " Private", "" ) + ; @@ -2561,17 +2647,17 @@ METHOD ShowVars() CLASS TDebugger ::oWndVars:bLButtonDown := { | nMRow, nMCol | ::WndVarsLButtonDown( nMRow, nMCol ) } ::oWndVars:bLDblClick := { || ::EditVar( ::oBrwVars:Cargo[ 1 ] ) } - ::oWndVars:bPainted := { || if(Len( ::aVars ) > 0, ( ::oBrwVars:RefreshAll():ForceStable(),RefreshVarsS(::oBrwVars) ),) } + ::oWndVars:bPainted := { || iif(Len( ::aVars ) > 0, ( ::oBrwVars:RefreshAll():ForceStable(),RefreshVarsS(::oBrwVars) ),) } - ::oWndVars:bKeyPressed := { | nKey | IIf( Len( ::aVars ) == 0, NIL, ( ; - iif( nKey == K_DOWN, ::oBrwVars:Down(), nil ) ; - , iif( nKey == K_UP, ::oBrwVars:Up(), nil ) ; - , iif( nKey == K_PGDN, ::oBrwVars:PageDown(), nil ) ; - , iif( nKey == K_PGUP, ::oBrwVars:PageUp(), nil ) ; - , iif( nKey == K_HOME, ::oBrwVars:GoTop(), nil ) ; - , iif( nKey == K_END, ::oBrwVars:GoBottom(), nil ) ; - , iif( nKey == K_ENTER, ::EditVar( ::oBrwVars:Cargo[1] ), nil ), ; - IIF(LEN(::aVars)>0, ::oBrwVars:ForceStable(), nil) ) ) } + ::oWndVars:bKeyPressed := { | nKey | iif( Len( ::aVars ) == 0, NIL, ( ; + iif( nKey == K_DOWN, ::oBrwVars:Down(), NIL ) ; + , iif( nKey == K_UP, ::oBrwVars:Up(), NIL ) ; + , iif( nKey == K_PGDN, ::oBrwVars:PageDown(), NIL ) ; + , iif( nKey == K_PGUP, ::oBrwVars:PageUp(), NIL ) ; + , iif( nKey == K_HOME, ::oBrwVars:GoTop(), NIL ) ; + , iif( nKey == K_END, ::oBrwVars:GoBottom(), NIL ) ; + , iif( nKey == K_ENTER, ::EditVar( ::oBrwVars:Cargo[1] ), NIL ), ; + iif(Len(::aVars)>0, ::oBrwVars:ForceStable(), NIL) ) ) } AAdd( ::aWindows, ::oWndVars ) lWindowCreated := .T. @@ -2600,14 +2686,14 @@ METHOD ShowVars() CLASS TDebugger ENDIF IF Len( ::aVars ) > 0 .AND. ::oBrwVars == NIL - ::oBrwVars := TDbgBrowser():New( nTop+1, 1, nBottom - 1, ; - ::nMaxCol - iif( ::oWndStack != nil, ::oWndStack:nWidth(), 0 ) - 1 ) + ::oBrwVars := HBDbBrowser():New( nTop+1, 1, nBottom - 1, ; + ::nMaxCol - iif( ::oWndStack != NIL, ::oWndStack:nWidth(), 0 ) - 1 ) ::oBrwVars:Cargo :={ 1,{}} // Actual highlighted row ::oBrwVars:ColorSpec := ::aColors[ 2 ] + "," + ::aColors[ 5 ] + "," + ::aColors[ 3 ] ::oBrwVars:GOTOPBLOCK := { || ::oBrwVars:cargo[ 1 ] := Min( 1, Len( ::aVars ) ) } ::oBrwVars:GoBottomBlock := { || ::oBrwVars:cargo[ 1 ] := Max( 1, Len( ::aVars ) ) } - ::oBrwVars:SkipBlock = { | nSkip, nOld | ; + ::oBrwVars:SkipBlock := { | nSkip, nOld | ; nOld := ::oBrwVars:Cargo[ 1 ],; ::oBrwVars:Cargo[ 1 ] += nSkip,; ::oBrwVars:Cargo[ 1 ] := Min( Max( ::oBrwVars:Cargo[ 1 ], 1 ), Len( ::aVars ) ),; @@ -2615,7 +2701,7 @@ METHOD ShowVars() CLASS TDebugger nWidth := ::oWndVars:nWidth() - 1 oCol := TBColumnNew( "", ; - { || PadR( AllTrim( Str( ::oBrwVars:Cargo[1] -1 ) ) + ") " + ; + { || PadR( LTrim( Str( ::oBrwVars:Cargo[1] -1 ) ) + ") " + ; ::VarGetInfo( ::aVars[ Max( ::oBrwVars:Cargo[1], 1 ) ] ), ; ::oWndVars:nWidth() - 2 ) } ) ::oBrwVars:AddColumn( oCol ) @@ -2649,7 +2735,7 @@ METHOD ShowVars() CLASS TDebugger ENDIF IF nBottom != ::oWndVars:nBottom ::oWndVars:Resize( ,, nBottom ) - lRepaint := .t. + lRepaint := .T. else IF ::oBrwVars != NIL ::oBrwVars:RefreshAll():ForceStable() @@ -2663,208 +2749,199 @@ METHOD ShowVars() CLASS TDebugger DispEnd() -return nil + RETURN NIL -METHOD Stack() CLASS TDebugger +METHOD Stack() CLASS HBDebugger ::lShowCallStack := ! ::lShowCallStack ::oPulldown:GetItemByIdent( "CALLSTACK" ):checked := ::lShowCallStack - if ::lActive - if ::lShowCallStack + + IF ::lActive + IF ::lShowCallStack ::ShowCallStack() - else + ELSE ::HideCallStack() - endif - endif + ENDIF + ENDIF -return nil + RETURN NIL -METHOD Static() CLASS TDebugger +METHOD Static() CLASS HBDebugger ::lShowStatics := ! ::lShowStatics ::RefreshVars() -return nil + RETURN NIL -METHOD Step() CLASS TDebugger - // we are starting to run again so reset to the deepest call if - // displaying stack - if ! ::oBrwStack == nil - ::oBrwStack:GoTop() - endif - ::RestoreAppScreen() - ::RestoreAppState() - ::Exit() -RETURN nil +METHOD Step() CLASS HBDebugger + + // we are starting to run again so reset to the deepest call if displaying stack + IF ! ::oBrwStack == NIL + ::oBrwStack:GoTop() + ENDIF + + ::RestoreAppScreen() + ::RestoreAppState() + ::Exit() + + RETURN NIL -METHOD ToCursor() CLASS TDebugger - LOCAL cName := strip_path( ::cPrgName ), nLine := ::oBrwText:nRow +METHOD ToCursor() CLASS HBDebugger - IF ::IsValidStopLine( cName, nLine ) - HB_DBG_SetToCursor( ::pInfo, strip_path( ::cPrgName ), ::oBrwText:nRow ) - ::RestoreAppScreen() - ::RestoreAppState() - ::Exit() - ENDIF -RETURN self + IF ::IsValidStopLine( strip_path( ::cPrgName ), ::oBrwText:RowPos() ) + hb_DBG_SetToCursor( ::pInfo, strip_path( ::cPrgName ), ::oBrwText:RowPos() ) + ::RestoreAppScreen() + ::RestoreAppState() + ::Exit() + ENDIF + + RETURN Self // Toggle a breakpoint at the cursor position in the currently viewed file // which may be different from the file in which execution was broken -METHOD ToggleBreakPoint( nLine, cFileName ) CLASS TDebugger - // look for a breakpoint which matches both line number and program name - local nAt +METHOD ToggleBreakPoint( nLine, cFileName ) CLASS HBDebugger - IF !::lActive - RETURN NIL - ENDIF + // look for a breakpoint which matches both line number and program name - IF nLine == NIL - cFileName := strip_path( ::cPrgName ) - nLine := ::oBrwText:nRow - ENDIF - - IF !::IsValidStopLine( cFileName, nLine ) - RETURN NIL - ENDIF - - nAt := AScan( ::aBreakPoints, { | aBreak | aBreak[ 1 ] == nLine ; - .AND. FILENAME_EQUAL( aBreak[ 2 ], cFileName ) } ) - - if nAt == 0 - AAdd( ::aBreakPoints, { nLine, cFileName } ) // it was nLine - HB_DBG_AddBreak( ::pInfo, cFileName, nLine ) - IF FILENAME_EQUAL( cFileName, strip_path( ::cPrgName ) ) - ::oBrwText:ToggleBreakPoint( nLine, .T. ) - ENDIF - else - ADel( ::aBreakPoints, nAt ) - ASize( ::aBreakPoints, Len( ::aBreakPoints ) - 1 ) - HB_DBG_DelBreak( ::pInfo, nAt - 1 ) - IF FILENAME_EQUAL( cFileName, strip_path( ::cPrgName ) ) - ::oBrwText:ToggleBreakPoint( nLine, .F. ) - ENDIF - endif - - ::oBrwText:RefreshCurrent() - -return nil - - -METHOD Trace() CLASS TDebugger - HB_DBG_SetTrace( ::pInfo ) - ::Step() //forces a Step() -RETURN Self - - -METHOD TracepointAdd( cExpr ) CLASS TDebugger - LOCAL aWatch - - IF( cExpr == NIL ) - cExpr:=SPACE(255) - cExpr := ALLTRIM( ::InputBox( "Enter Tracepoint", cExpr ) ) - IF( LASTKEY() == K_ESC ) - RETURN self + LOCAL nAt + + IF !::lActive + RETURN NIL + ENDIF + + IF nLine == NIL + cFileName := strip_path( ::cPrgName ) + nLine := ::oBrwText:RowPos() + ENDIF + + IF !::IsValidStopLine( cFileName, nLine ) + RETURN NIL + ENDIF + + nAt := AScan( ::aBreakPoints, { | aBreak | aBreak[ 1 ] == nLine ; + .AND. FILENAME_EQUAL( aBreak[ 2 ], cFileName ) } ) + + IF nAt == 0 + AAdd( ::aBreakPoints, { nLine, cFileName } ) // it was nLine + hb_DBG_AddBreak( ::pInfo, cFileName, nLine ) + IF FILENAME_EQUAL( cFileName, strip_path( ::cPrgName ) ) + ::oBrwText:ToggleBreakPoint( nLine, .T. ) + ENDIF + ELSE + ADel( ::aBreakPoints, nAt ) + ASize( ::aBreakPoints, Len( ::aBreakPoints ) - 1 ) + hb_DBG_DelBreak( ::pInfo, nAt - 1 ) + IF FILENAME_EQUAL( cFileName, strip_path( ::cPrgName ) ) + ::oBrwText:ToggleBreakPoint( nLine, .F. ) ENDIF ENDIF - cExpr := ALLTRIM( cExpr ) - IF( EMPTY(cExpr) ) - RETURN self + + ::oBrwText:RefreshCurrent() + + RETURN NIL + + +METHOD Trace() CLASS HBDebugger + + hb_DBG_SetTrace( ::pInfo ) + ::Step() //forces a Step() + + RETURN Self + + +METHOD TracepointAdd( cExpr ) CLASS HBDebugger + + LOCAL aWatch + + IF cExpr == NIL + cExpr := Space( 255 ) + cExpr := AllTrim( ::InputBox( "Enter Tracepoint", cExpr ) ) + IF LastKey() == K_ESC + RETURN Self + ENDIF ENDIF - aWatch := {"tp", cExpr, NIL} + cExpr := AllTrim( cExpr ) + IF Empty( cExpr ) + RETURN Self + ENDIF + aWatch := { "tp", cExpr, NIL } ::RestoreAppState() - HB_DBG_AddWatch( ::pInfo, cExpr, .T. ) + hb_DBG_AddWatch( ::pInfo, cExpr, .T. ) ::SaveAppState() - AADD( ::aWatch, aWatch ) + AAdd( ::aWatch, aWatch ) ::WatchpointsShow() -RETURN self + RETURN Self -METHOD VarGetInfo( aVar ) CLASS TDebugger - LOCAL uValue - LOCAL cType := Left( aVar[ VAR_TYPE ], 1 ) +METHOD VarGetInfo( aVar ) CLASS HBDebugger - uValue := ::VarGetValue( aVar ) - do case - case cType == "G" - return ( aVar[ VAR_NAME ] + " : " + ValToStr( uValue ) ) + LOCAL cType := Left( aVar[ VAR_TYPE ], 1 ) + LOCAL uValue := ::VarGetValue( aVar ) - case cType == "L" - return aVar[ VAR_NAME ] + " : " + ValToStr( uValue ) + DO CASE + CASE cType == "G" ; RETURN aVar[ VAR_NAME ] + " : " + __dbgValToStr( uValue ) + CASE cType == "L" ; RETURN aVar[ VAR_NAME ] + " : " + __dbgValToStr( uValue ) + CASE cType == "S" ; RETURN aVar[ VAR_NAME ] + " : " + __dbgValToStr( uValue ) + OTHERWISE ; RETURN aVar[ VAR_NAME ] + " <" + aVar[ VAR_TYPE ] + ", " + ValType( uValue ) + ">: " + __dbgValToStr( uValue ) + ENDCASE - case cType == "S" - return aVar[ VAR_NAME ] + " : " + ValToStr( uValue ) + // ; Never reached - OTHERWISE - return aVar[ VAR_NAME ] + " <" + aVar[ VAR_TYPE ] + ", " + ; - ValType( uValue ) + ; - ">: " + ValToStr( uValue ) - endcase -return "" + RETURN "" -METHOD VarGetValue( aVar ) CLASS TDebugger - LOCAL nProcLevel, uValue - LOCAL cType := Left( aVar[ VAR_TYPE ], 1 ) +METHOD VarGetValue( aVar ) CLASS HBDebugger - IF cType == "G" - uValue = hb_dbg_vmVarGGet( aVar[ VAR_LEVEL ], aVar[ VAR_POS ] ) + LOCAL cType := Left( aVar[ VAR_TYPE ], 1 ) + + DO CASE + CASE cType == "G" ; RETURN hb_dbg_vmVarGGet( aVar[ VAR_LEVEL ], aVar[ VAR_POS ] ) + CASE cType == "L" ; RETURN hb_dbg_vmVarLGet( hb_dbg_procLevel() - aVar[ VAR_LEVEL ], aVar[ VAR_POS ] ) + CASE cType == "S" ; RETURN hb_dbg_vmVarSGet( aVar[ VAR_LEVEL ], aVar[ VAR_POS ] ) + OTHERWISE ; RETURN aVar[ VAR_POS ] // Public or Private + ENDCASE - ELSEIF( cType == "L" ) - nProcLevel := hb_dbg_procLevel() - aVar[ VAR_LEVEL ] - uValue := hb_dbg_vmVarLGet( nProcLevel, aVar[ VAR_POS ] ) + // ; Never reached - ELSEIF( cType == "S" ) - uValue := hb_dbg_vmVarSGet( aVar[ VAR_LEVEL ], aVar[ VAR_POS ] ) - - ELSE - //Public or Private - uValue := aVar[ VAR_POS ] - ENDIF - -RETURN uValue + RETURN NIL -METHOD VarSetValue( aVar, uValue ) CLASS TDebugger - LOCAL nProcLevel - LOCAL cType := Left( aVar[ VAR_TYPE ], 1 ) +METHOD VarSetValue( aVar, uValue ) CLASS HBDebugger - IF cType == "G" - hb_dbg_vmVarGSet( aVar[ VAR_LEVEL ], aVar[ VAR_POS ], uValue ) + LOCAL nProcLevel + LOCAL cType := Left( aVar[ VAR_TYPE ], 1 ) + + IF cType == "G" + hb_dbg_vmVarGSet( aVar[ VAR_LEVEL ], aVar[ VAR_POS ], uValue ) + + ELSEIF cType == "L" + nProcLevel := hb_dbg_procLevel() - aVar[VAR_LEVEL] //skip debugger stack + hb_dbg_vmVarLSet( nProcLevel, aVar[ VAR_POS ], uValue ) + + ELSEIF cType == "S" + hb_dbg_vmVarSSet( aVar[ VAR_LEVEL ], aVar[ VAR_POS ], uValue ) + + ELSE + //Public or Private + aVar[ VAR_POS ] := uValue + &( aVar[ VAR_NAME ] ) := uValue + + ENDIF - ELSEIF( cType == "L" ) - nProcLevel := hb_dbg_procLevel() - aVar[VAR_LEVEL] //skip debugger stack - hb_dbg_vmVarLSet( nProcLevel, aVar[ VAR_POS ], uValue ) - - ELSEIF( cType == "S" ) - hb_dbg_vmVarSSet( aVar[ VAR_LEVEL ], aVar[ VAR_POS ], uValue ) - - ELSE - //Public or Private - aVar[ VAR_POS ] := uValue - &( aVar[ VAR_NAME ] ) := uValue - - ENDIF - -RETURN self + RETURN Self -METHOD ViewSets() CLASS TDebugger +METHOD ViewSets() CLASS HBDebugger - local oWndSets := TDbWindow():New( 1, 8, ::nMaxRow - 2, ::nMaxCol - 8,; + LOCAL oWndSets := HBDbWindow():New( 1, 8, ::nMaxRow - 2, ::nMaxCol - 8,; "System Settings[1..47]", ::ClrModal() ) - local aSets := { "Exact", "Fixed", "Decimals", "DateFormat", "Epoch", "Path",; + LOCAL aSets := { "Exact", "Fixed", "Decimals", "DateFormat", "Epoch", "Path",; "Default", "Exclusive", "SoftSeek", "Unique", "Deleted",; "Cancel", "Debug", "TypeAhead", "Color", "Cursor", "Console",; "Alternate", "AltFile", "Device", "Extra", "ExtraFile",; @@ -2874,25 +2951,25 @@ METHOD ViewSets() CLASS TDebugger "EventMask", "VideoMode", "MBlockSize", "MFileExt",; "StrictRead", "Optimize", "Autopen", "Autorder", "AutoShare" } - local oBrwSets := TBrowseNew( oWndSets:nTop + 1, oWndSets:nLeft + 1,; + LOCAL oBrwSets := TBrowseNew( oWndSets:nTop + 1, oWndSets:nLeft + 1,; oWndSets:nBottom - 1, oWndSets:nRight - 1 ) - local n := 1 - local nWidth := oWndSets:nRight - oWndSets:nLeft - 1 - local oCol - oBrwSets:Cargo :={ 1,{}} // Actual highlighted row - oBrwSets:autolite:=.f. + LOCAL nWidth := oWndSets:nRight - oWndSets:nLeft - 1 + LOCAL oCol + + oBrwSets:Cargo := { 1, {} } // Actual highlighted row + oBrwSets:autolite := .F. oBrwSets:ColorSpec := ::ClrModal() oBrwSets:GOTOPBLOCK := { || oBrwSets:cargo[ 1 ]:= 1 } 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:cargo[ 1 ] + nPos, nPos ) } oBrwSets:AddColumn( ocol := TBColumnNew( "", { || PadR( aSets[ oBrwSets:cargo[ 1 ] ], 12 ) } ) ) - aadd(oBrwSets:Cargo[2],asets) - ocol:defcolor:={1,2} + AAdd( oBrwSets:Cargo[ 2 ], asets ) + ocol:defcolor := { 1, 2 } oBrwSets:AddColumn( oCol := TBColumnNew( "",; - { || PadR( ValToStr( Set( oBrwSets:cargo[ 1 ] ) ), nWidth - 13 ) } ) ) - ocol:defcolor:={1,3} - ocol:width:=40 + { || PadR( __dbgValToStr( Set( oBrwSets:cargo[ 1 ] ) ), nWidth - 13 ) } ) ) + ocol:defcolor := { 1, 3 } + ocol:width := 40 oWndSets:bPainted := { || oBrwSets:ForceStable(),RefreshVarsS(oBrwSets)} oWndSets:bKeyPressed := { | nKey | SetsKeyPressed( nKey, oBrwSets, Len( aSets ),; oWndSets, "System Settings",; @@ -2901,68 +2978,76 @@ METHOD ViewSets() CLASS TDebugger SetCursor( SC_NONE ) oWndSets:ShowModal() -return nil + RETURN NIL -METHOD WatchGetInfo( nWatch ) CLASS TDebugger +METHOD WatchGetInfo( nWatch ) CLASS HBDebugger + LOCAL xVal - LOCAL ctype + LOCAL cType LOCAL lValid LOCAL aWatch := ::aWatch[ nWatch ] ::RestoreAppState() xVal := ::GetExprValue( nWatch, @lValid ) ::SaveAppState() - IF( lValid ) + + IF lValid cType := VALTYPE( xVal ) - xVal := ValToStr( xVal ) + xVal := __dbgValToStr( xVal ) ELSE //xVal contains error description cType := 'U' //xVal := "Undefined" ENDIF -RETURN aWatch[WP_EXPR]+" <"+aWatch[WP_TYPE]+", " +cType+">: " +xVal + RETURN aWatch[ WP_EXPR ] + " <" + aWatch[ WP_TYPE ] + ", " + cType + ">: " + xVal -METHOD WatchpointAdd( cExpr ) CLASS TDebugger +METHOD WatchpointAdd( cExpr ) CLASS HBDebugger + LOCAL aWatch - IF( cExpr == NIL ) - cExpr:=SPACE(255) - cExpr := ALLTRIM( ::InputBox( "Enter Watchpoint", cExpr ) ) - IF( LASTKEY() == K_ESC ) - RETURN self + IF cExpr == NIL + + cExpr := Space( 255 ) + cExpr := AllTrim( ::InputBox( "Enter Watchpoint", cExpr ) ) + + IF LastKey() == K_ESC + RETURN Self ENDIF ENDIF - cExpr := ALLTRIM( cExpr ) - IF( EMPTY(cExpr) ) - RETURN self + + cExpr := AllTrim( cExpr ) + + IF Empty( cExpr ) + RETURN Self ENDIF + aWatch := { "wp", cExpr } - HB_DBG_AddWatch( ::pInfo, cExpr, .F. ) - AADD( ::aWatch, aWatch ) + hb_DBG_AddWatch( ::pInfo, cExpr, .F. ) + AAdd( ::aWatch, aWatch ) ::WatchpointsShow() -RETURN self + RETURN Self -METHOD WatchpointDel( nPos ) CLASS TDebugger +METHOD WatchpointDel( nPos ) CLASS HBDebugger - IF( ::oWndPnt != NIL .AND. ::oWndPnt:lVisible ) - IF( nPos == NIL ) + IF ::oWndPnt != NIL .AND. ::oWndPnt:lVisible + IF nPos == NIL //called from the menu - nPos := ::InputBox( "Enter item number to delete", ::oBrwPnt:cargo[1]-1 ) + nPos := ::InputBox( "Enter item number to delete", ::oBrwPnt:cargo[ 1 ] - 1 ) ELSE nPos-- ENDIF - IF( LastKey() != K_ESC ) - IF( nPos >=0 .AND. nPos < LEN(::aWatch) ) + IF LastKey() != K_ESC + IF nPos >=0 .AND. nPos < Len( ::aWatch ) ::oBrwPnt:gotop() - HB_DBG_DelWatch( ::pInfo, nPos ) - ADEL( ::aWatch, nPos+1 ) - ASIZE( ::aWatch, LEN(::aWatch)-1 ) - IF( LEN(::aWatch) == 0 ) + hb_DBG_DelWatch( ::pInfo, nPos ) + ADel( ::aWatch, nPos + 1 ) + ASize( ::aWatch, Len( ::aWatch ) - 1 ) + IF Len( ::aWatch ) == 0 ::WatchpointsHide() ELSE ::WatchpointsShow() @@ -2971,141 +3056,152 @@ METHOD WatchpointDel( nPos ) CLASS TDebugger ENDIF ENDIF -RETURN self + RETURN Self -METHOD WatchpointEdit( nPos ) CLASS TDebugger +METHOD WatchpointEdit( nPos ) CLASS HBDebugger + LOCAL cExpr LOCAL aWatch - cExpr:=PADR( ::aWatch[nPos][WP_EXPR], 255 ) - cExpr := ALLTRIM( ::InputBox( "Enter Watchpoint", cExpr ) ) - IF( LASTKEY() == K_ESC ) - RETURN self + cExpr := PadR( ::aWatch[ nPos ][ WP_EXPR ], 255 ) + cExpr := AllTrim( ::InputBox( "Enter Watchpoint", cExpr ) ) + + IF LastKey() == K_ESC + RETURN Self ENDIF - cExpr := ALLTRIM( cExpr ) - IF( EMPTY(cExpr) ) - RETURN self + + cExpr := AllTrim( cExpr ) + + IF Empty( cExpr ) + RETURN Self ENDIF + aWatch := { "wp", cExpr } - HB_DBG_SetWatch( ::pInfo, nPos - 1, cExpr, .F. ) + + hb_DBG_SetWatch( ::pInfo, nPos - 1, cExpr, .F. ) ::aWatch[ nPos ] := aWatch ::WatchpointsShow() -RETURN self + RETURN Self -METHOD WatchpointInspect( nPos ) CLASS TDebugger - LOCAL xValue, lValid +METHOD WatchpointInspect( nPos ) CLASS HBDebugger - ::RestoreAppState() - xValue := ::GetExprValue( ::aWatch[ nPos ][ WP_EXPR ], @lValid ) - ::SaveAppState() + LOCAL xValue + LOCAL lValid - ::InputBox( ::aWatch[ nPos ][ WP_EXPR ], xValue, , .F. ) - ::RefreshVars() -RETURN Self + ::RestoreAppState() + xValue := ::GetExprValue( ::aWatch[ nPos ][ WP_EXPR ], @lValid ) + ::SaveAppState() + + ::InputBox( ::aWatch[ nPos ][ WP_EXPR ], xValue, NIL, .F. ) + ::RefreshVars() + + RETURN Self -METHOD WatchpointsHide() CLASS TDebugger +METHOD WatchpointsHide() CLASS HBDebugger ::oWndPnt:Hide() - ::oWndCode:nTop := IIF(::oWndVars!=NIL .AND. ::oWndVars:lVisible, ::oWndVars:nBottom+1,1) - ::oBrwText:Resize( ::oWndCode:nTop+1 ) - if ::aWindows[ ::nCurrentWindow ] == ::oWndPnt + ::oWndCode:nTop := iif( ::oWndVars != NIL .AND. ::oWndVars:lVisible, ::oWndVars:nBottom + 1, 1 ) + ::oBrwText:Resize( ::oWndCode:nTop + 1 ) + IF ::aWindows[ ::nCurrentWindow ] == ::oWndPnt ::NextWindow() ENDIF -return nil + RETURN NIL -METHOD WatchpointsShow() CLASS TDebugger +METHOD WatchpointsShow() CLASS HBDebugger - local nWidth, n := 1 - Local oCol - local lRepaint := .f. - local nTop + LOCAL nWidth + LOCAL oCol + LOCAL lRepaint := .F. + LOCAL nTop - if ::lGo - return nil - endif + IF ::lGo + RETURN NIL + ENDIF - if LEN(::aWatch) == 0 - return nil - endif + IF Len( ::aWatch ) == 0 + RETURN NIL + ENDIF - if ::oWndPnt == nil - nTop := IIF(::oWndVars!=NIL .AND. ::oWndVars:lVisible,::oWndVars:nBottom,0) + 1 - ::oWndPnt := TDbWindow():New( nTop,; + IF ::oWndPnt == NIL + + nTop := iif( ::oWndVars != NIL .AND. ::oWndVars:lVisible, ::oWndVars:nBottom, 0 ) + 1 + + ::oWndPnt := HBDbWindow():New( nTop,; 0, ; nTop +Min( 4, Len( ::aWatch ) ) + 1,; - ::nMaxCol - iif( ::oWndStack != nil, ::oWndStack:nWidth(), 0 ),; + ::nMaxCol - iif( ::oWndStack != NIL, ::oWndStack:nWidth(), 0 ),; "Watch" ) //::oBrwText:Resize( ::oWndPnt:nBottom + 1 ) //::oWndCode:nTop := ::oWndPnt:nBottom + 1 //::oBrwText:Resize( ::oWndCode:nTop + 1 ) //::oBrwText:RefreshAll() - //::oWndCode:SetFocus( .t. ) + //::oWndCode:SetFocus( .T. ) // ::oWndPnt:bLButtonDown := { | nMRow, nMCol | ::WndVarsLButtonDown( nMRow, nMCol ) } // ::oWndPnt:bLDblClick := { | nMRow, nMCol | ::EditVar( ::oBrwPnt:Cargo[ 1 ] ) } - ::oBrwPnt := TDbgBrowser():New( nTop+1, 1, ::oWndPnt:nBottom - 1, ::nMaxCol - iif( ::oWndStack != nil,; + ::oBrwPnt := HBDbBrowser():New( nTop+1, 1, ::oWndPnt:nBottom - 1, ::nMaxCol - iif( ::oWndStack != NIL,; ::oWndStack:nWidth(), 0 ) - 1 ) ::oWndPnt:Browser := ::oBrwPnt - ::oBrwPnt:Cargo :={ 1,{}} // Actual highligthed row + ::oBrwPnt:Cargo :={ 1, {} } // Actual highligthed row ::oBrwPnt:ColorSpec := ::aColors[ 2 ] + "," + ::aColors[ 5 ] + "," + ::aColors[ 3 ] - ::oBrwPnt:GOTOPBLOCK := { || ::oBrwPnt:cargo[ 1 ] := Min( 1, Len(::aWatch) ) } - ::oBrwPnt:GoBottomBlock := { || ::oBrwPnt:cargo[ 1 ] := Len( ::aWatch ) } - ::oBrwPnt:SkipBlock = { | nSkip, nOld | nOld := ::oBrwPnt:Cargo[ 1 ],; + ::oBrwPnt:goTopBlock := { || ::oBrwPnt:cargo[ 1 ] := Min( 1, Len(::aWatch) ) } + ::oBrwPnt:goBottomBlock := { || ::oBrwPnt:cargo[ 1 ] := Len( ::aWatch ) } + ::oBrwPnt:skipBlock := { | nSkip, nOld | nOld := ::oBrwPnt:Cargo[ 1 ],; ::oBrwPnt:Cargo[ 1 ] += nSkip,; ::oBrwPnt:Cargo[ 1 ] := Min( Max( ::oBrwPnt:Cargo[ 1 ], 1 ),; Len( ::aWatch ) ),; - IIF( LEN(::aWatch) > 0, ::oBrwPnt:Cargo[ 1 ] - nOld, 0 ) } + iif( Len(::aWatch) > 0, ::oBrwPnt:Cargo[ 1 ] - nOld, 0 ) } nWidth := ::oWndPnt:nWidth() - 1 oCol := TBColumnNew( "", ; - { || PadR( IIF( LEN( ::aWatch ) > 0, ; - AllTrim( Str( ::oBrwPnt:Cargo[1] -1 ) ) + ") " + ; + { || PadR( iif( Len( ::aWatch ) > 0, ; + LTrim( Str( ::oBrwPnt:Cargo[1] -1 ) ) + ") " + ; ::WatchGetInfo( Max( ::oBrwPnt:Cargo[1], 1 ) ), ; " " ), ; ::oWndPnt:nWidth() - 2 ) } ) ::oBrwPnt:AddColumn( oCol ) - AAdd(::oBrwPnt:Cargo[2], ::aWatch) - oCol:DefColor:={1,2} + AAdd( ::oBrwPnt:Cargo[ 2 ], ::aWatch) + oCol:DefColor := { 1, 2 } - ::oWndPnt:bPainted := { || if(Len(::aWatch) > 0, ( ::oBrwPnt:RefreshAll():ForceStable(),RefreshVarsS(::oBrwPnt)/*, ::RefreshVars()*/ ),) } + ::oWndPnt:bPainted := { || iif(Len(::aWatch) > 0, ( ::oBrwPnt:RefreshAll():ForceStable(),RefreshVarsS(::oBrwPnt)/*, ::RefreshVars()*/ ),) } ::oWndPnt:bKeyPressed := { | nKey | ; - ( iif( nKey == K_DOWN, ::oBrwPnt:Down(), nil ) ; - , iif( nKey == K_UP, ::oBrwPnt:Up(), nil ) ; - , iif( nKey == K_PGDN, ::oBrwPnt:PageDown(), nil ) ; - , iif( nKey == K_PGUP, ::oBrwPnt:PageUp(), nil ) ; - , iif( nKey == K_HOME, ::oBrwPnt:GoTop(), nil ) ; - , iif( nKey == K_END, ::oBrwPnt:GoBottom(), nil ) ; - , iif( nKey == K_DEL, ::WatchpointDel( ::oBrwPnt:Cargo[1] ), nil ) ; - , iif( nKey == K_ENTER, ::WatchpointEdit( ::oBrwPnt:Cargo[1] ), nil ) ; - , iif( nKey == K_CTRL_ENTER, ::WatchpointInspect( ::oBrwPnt:Cargo[ 1 ] ), nil ) ; + ( iif( nKey == K_DOWN, ::oBrwPnt:Down(), NIL ) ; + , iif( nKey == K_UP, ::oBrwPnt:Up(), NIL ) ; + , iif( nKey == K_PGDN, ::oBrwPnt:PageDown(), NIL ) ; + , iif( nKey == K_PGUP, ::oBrwPnt:PageUp(), NIL ) ; + , iif( nKey == K_HOME, ::oBrwPnt:GoTop(), NIL ) ; + , iif( nKey == K_END, ::oBrwPnt:GoBottom(), NIL ) ; + , iif( nKey == K_DEL, ::WatchpointDel( ::oBrwPnt:Cargo[1] ), NIL ) ; + , iif( nKey == K_ENTER, ::WatchpointEdit( ::oBrwPnt:Cargo[1] ), NIL ) ; + , iif( nKey == K_CTRL_ENTER, ::WatchpointInspect( ::oBrwPnt:Cargo[ 1 ] ), NIL ) ; , ::oBrwPnt:ForceStable() ) } AAdd( ::aWindows, ::oWndPnt ) ::oWndPnt:Show() ::ResizeWindows( ::oWndPnt ) else - if( ::oBrwPnt:cargo[1] <= 0 ) + if ::oBrwPnt:cargo[1] <= 0 ::oBrwPnt:cargo[1] := 1 endif DispBegin() if Len( ::aWatch ) > ::oWndPnt:nBottom - ::oWndPnt:nTop - 1 //Resize( top, left, bottom, right ) ::oWndPnt:Resize( ,, ::oWndPnt:nTop + Min( Len( ::aWatch ) + 1, 4 ) ) - lRepaint := .t. + lRepaint := .T. elseif Len( ::aWatch ) < ::oWndPnt:nBottom - ::oWndPnt:nTop - 1 ::oWndPnt:Resize( ,, ::oWndPnt:nTop + Len( ::aWatch ) + 1 ) - lRepaint := .t. + lRepaint := .T. else ::oBrwPnt:RefreshAll():ForceStable() endif @@ -3114,236 +3210,220 @@ METHOD WatchpointsShow() CLASS TDebugger endif DispEnd() endif -return nil + + RETURN NIL -METHOD WndVarsLButtonDown( nMRow, nMCol ) CLASS TDebugger +METHOD WndVarsLButtonDown( nMRow, nMCol ) CLASS HBDebugger - if nMRow > ::oWndVars:nTop .and. ; - nMRow < ::oWndVars:nBottom .and. ; - nMCol > ::oWndVars:nLeft .and. ; + IF nMRow > ::oWndVars:nTop .AND. ; + nMRow < ::oWndVars:nBottom .AND. ; + nMCol > ::oWndVars:nLeft .AND. ; nMCol < ::oWndVars:nRight - if nMRow - ::oWndVars:nTop >= 1 .and. ; + + IF nMRow - ::oWndVars:nTop >= 1 .AND. ; nMRow - ::oWndVars:nTop <= Len( ::aVars ) - while ::oBrwVars:RowPos > nMRow - ::oWndVars:nTop + + DO WHILE ::oBrwVars:RowPos > nMRow - ::oWndVars:nTop ::oBrwVars:Up() ::oBrwVars:ForceStable() - end - while ::oBrwVars:RowPos < nMRow - ::oWndVars:nTop + ENDDO + + DO WHILE ::oBrwVars:RowPos < nMRow - ::oWndVars:nTop ::oBrwVars:Down() ::oBrwVars:ForceStable() - end - endif - endif + ENDDO -return nil + ENDIF + ENDIF + + RETURN NIL -static procedure SetsKeyPressed( nKey, oBrwSets, nSets, oWnd, cCaption, bEdit ) +STATIC PROCEDURE SetsKeyPressed( nKey, oBrwSets, nSets, oWnd, cCaption, bEdit ) - local nSet := oBrwSets:cargo[1] - local cTemp:=str(nSet,4) + DO CASE + CASE nKey == K_UP - do case - case nKey == K_UP - oBrwSets:Up() - case nKey == K_DOWN - oBrwSets:Down() - case nKey == K_HOME .or. (nKey == K_CTRL_PGUP) .or. (nKey == K_CTRL_HOME) - oBrwSets:GoTop() - case nKey == K_END .or. (nkey == K_CTRL_PGDN) .or. (nkey == K_CTRL_END ) - oBrwSets:GoBottom() - Case nKey == K_PGDN - oBrwSets:pageDown() - Case nKey == K_PGUP - OBrwSets:PageUp() + oBrwSets:up() - case nKey == K_ENTER - if bEdit != nil - Eval( bEdit ) - endif - if LastKey() == K_ENTER - KEYBOARD Chr( K_DOWN ) - endif + CASE nKey == K_DOWN - endcase - RefreshVarsS(oBrwSets) + oBrwSets:down() - oWnd:SetCaption( cCaption + "[" + AllTrim( Str( oBrwSets:Cargo[1] ) ) + ; - ".." + AllTrim( Str( nSets ) ) + "]" ) + CASE nKey == K_HOME .OR. nKey == K_CTRL_PGUP .OR. nKey == K_CTRL_HOME -return + oBrwSets:goTop() -static function ValToStr( uVal ) + CASE nKey == K_END .OR. nkey == K_CTRL_PGDN .OR. nkey == K_CTRL_END - local cType := ValType( uVal ) - local cResult := "U" + oBrwSets:goBottom() - do case - case uVal == nil - cResult := "NIL" + CASE nKey == K_PGDN - case cType == "A" - cResult := "{ ... }" + oBrwSets:pageDown() - case cType == "H" - cResult := "Hash of " + AllTrim( Str( Len( uVal ) ) ) + " elements" + CASE nKey == K_PGUP - case cType =="B" - cResult:= "{ || ... }" + oBrwSets:pageUp() - case cType $ "CM" - cResult := '"' + uVal + '"' + CASE nKey == K_ENTER - case cType == "L" - cResult := iif( uVal, ".T.", ".F." ) + IF bEdit != NIL + Eval( bEdit ) + ENDIF - case cType == "D" - cResult := DToC( uVal ) + IF LastKey() == K_ENTER + KEYBOARD Chr( K_DOWN ) + ENDIF - case cType == "N" - cResult := AllTrim( Str( uVal ) ) + ENDCASE - case cType == "O" - cResult := "Class " + uVal:ClassName() + " object" + RefreshVarsS( oBrwSets ) - case cType == "P" - cResult := "Pointer" + oWnd:SetCaption( cCaption + "[" + RTrim( Str( oBrwSets:Cargo[ 1 ] ) ) + ".." + RTrim( Str( nSets ) ) + "]" ) - endcase - -return cResult + RETURN STATIC PROCEDURE StripUntil( pcLine, i, cChar ) - LOCAL j, n - LOCAL nLen:=LEN(pcLine) - n := LEN(cChar) - j := i+n - DO WHILE j<=nLen .AND. SUBSTR(pcLine, j, n) != cChar - j++ - ENDDO - IF j <= nLen - pcLine := LEFT( pcLine, i-1 ) + SUBSTR(pcLine, j+n) - ENDIF + LOCAL j + LOCAL n + LOCAL nLen := Len( pcLine ) + + n := Len( cChar ) + j := i + n + DO WHILE j <= nLen .AND. SubStr( pcLine, j, n ) != cChar + j++ + ENDDO -RETURN + IF j <= nLen + pcLine := Left( pcLine, i - 1 ) + SubStr( pcLine, j + n ) + ENDIF + + RETURN -function __DbgColors() - -return iif( ! s_oDebugger:lMonoDisplay, s_oDebugger:aColors,; - { "W+/N", "W+/N", "N/W", "N/W", "N/W", "N/W", "W+/N",; - "N/W", "W+/W", "W/N", "W+/N" } ) +FUNCTION __DbgColors() + RETURN iif( ! s_oDebugger:lMonoDisplay,; + s_oDebugger:aColors,; + { "W+/N", "W+/N", "N/W", "N/W", "N/W", "N/W", "W+/N", "N/W", "W+/W", "W/N", "W+/N" } ) -function __Dbg() - -return s_oDebugger +FUNCTION __Dbg() + RETURN s_oDebugger -static function myColors( oBrowse, aColColors ) - local i - local nColPos := oBrowse:colpos +STATIC PROCEDURE RefreshVarsS( oBrowse ) - for i := 1 to len( aColColors ) - oBrowse:colpos := aColColors[i] - oBrowse:hilite() - next + LOCAL nLen := oBrowse:colCount - oBrowse:colpos := nColPos + IF nLen == 2 + oBrowse:deHilite():colPos := 2 + ENDIF + oBrowse:deHilite():forceStable() -return nil - - -static procedure RefreshVarsS( oBrowse ) - - local nLen := oBrowse:ColCount - - if ( nLen == 2 ) - oBrowse:dehilite():colpos:=2 - endif - oBrowse:dehilite():forcestable() - if ( nLen == 2 ) - oBrowse:hilite():colpos:=1 - endif + IF nLen == 2 + oBrowse:hilite():colPos := 1 + ENDIF oBrowse:hilite() -return + RETURN -static function ArrayBrowseSkip( nPos, oBrwSets ) - -return iif( oBrwSets:cargo[ 1 ] + nPos < 1, 0 - oBrwSets:cargo[ 1 ] + 1 , ; - iif( oBrwSets:cargo[ 1 ] + nPos > Len(oBrwSets:cargo[ 2 ][ 1 ]), ; - Len(oBrwSets:cargo[ 2 ][ 1 ]) - oBrwSets:cargo[ 1 ], nPos ) ) +STATIC FUNCTION ArrayBrowseSkip( nPos, oBrwSets ) + RETURN iif( oBrwSets:cargo[ 1 ] + nPos < 1, 0 - oBrwSets:cargo[ 1 ] + 1 , ; + iif( oBrwSets:cargo[ 1 ] + nPos > Len( oBrwSets:cargo[ 2 ][ 1 ] ), ; + Len( oBrwSets:cargo[ 2 ][ 1 ] ) - oBrwSets:cargo[ 1 ], nPos ) ) -static function PathToArray( cList ) - local nPos - local aList := {} - local cSep, cDirSep +STATIC FUNCTION PathToArray( cList ) - cSep := HB_OsPathListSeparator() - cDirSep := HB_OsPathDelimiters() + LOCAL aList := {} + LOCAL cSep := hb_OsPathListSeparator() + LOCAL cDirSep := hb_OsPathDelimiters() + LOCAL nPos - if ( cList <> NIL ) + IF cList != NIL - do while ( nPos := at( cSep, cList ) ) <> 0 - aadd( aList, substr( cList, 1, nPos - 1 ) ) // Add a new element - cList := substr( cList, nPos + 1 ) - enddo + DO WHILE ( nPos := At( cSep, cList ) ) != 0 + AAdd( aList, SubStr( cList, 1, nPos - 1 ) ) // Add a new element + cList := SubStr( cList, nPos + 1 ) + ENDDO - aadd( aList, cList ) // Add final element + AAdd( aList, cList ) // Add final element /* Strip ending delimiters */ - //AEval(aList, {|x, i| if( x[-1] $ cDirSep, aList[ i ] := Left( x, Len( x ) - 1 ), ) } ) - endif + //AEval( aList, { | x, i | iif( x[-1] $ cDirSep, aList[ i ] := Left( x, Len( x ) - 1 ), ) } ) + ENDIF -return aList + RETURN aList /* Check if a string starts with another string */ STATIC FUNCTION starts( cLine, cStart ) -RETURN ( cStart == Left( cLine, Len( cStart ) ) ) + RETURN cStart == Left( cLine, Len( cStart ) ) /* Strip path from filename */ STATIC FUNCTION strip_path( cFileName ) - LOCAL cName := "", cExt := "" - DEFAULT cFileName TO "" - HB_FNAMESPLIT( cFileName, NIL, @cName, @cExt ) -RETURN cName + cExt + LOCAL cName + LOCAL cExt + + DEFAULT cFileName TO "" + + hb_FNameSplit( cFileName, NIL, @cName, @cExt ) + + RETURN cName + cExt #ifdef HB_NO_READDBG + STATIC FUNCTION getdbginput( nTop, nLeft, uValue, bValid, cColor ) + + LOCAL nOldCursor := SetCursor( SC_NORMAL ) + LOCAL uTemp := uValue + + IF cColor != NIL + SetColor( cColor ) + ENDIF + + DO WHILE .T. + @ nTop, nLeft SAY Space( Len( uTemp ) ) + @ nTop, nLeft SAY "" - LOCAL nOldCursor - LOCAL uTemp + ACCEPT TO uTemp - nOldCursor := SetCursor( SC_NORMAL ) + IF bValid != NIL .AND. !Eval( bValid, uTemp ) + uTemp := uValue + ELSE + EXIT + ENDIF + ENDDO + + SetCursor( nOldCursor ) - if cColor != nil - setcolor( cColor ) - endif + RETURN uTemp - uTemp := uValue - - do while .t. - @ nTop, nLeft say space( len( uTemp ) ) - @ nTop, nLeft say "" - accept to uTemp - if bValid != nil .and. !eval( bValid, uTemp ) - uTemp := uValue - else - exit - endif - enddo - - setCursor( nOldCursor ) - -RETURN uTemp #endif + +FUNCTION __dbgValToStr( uVal ) + + LOCAL cType := ValType( uVal ) + + DO CASE + CASE uVal == NIL ; RETURN "NIL" + CASE cType == "B" ; RETURN "{ || ... }" + CASE cType == "A" ; RETURN "{ ... }" + CASE cType $ "CM" ; RETURN '"' + uVal + '"' + CASE cType == "L" ; RETURN iif( uVal, ".T.", ".F." ) + CASE cType == "D" ; RETURN DToC( uVal ) + CASE cType == "N" ; RETURN RTrim( Str( uVal ) ) + CASE cType == "O" ; RETURN "Class " + uVal:ClassName() + " object" + CASE cType == "H" ; RETURN "Hash of " + RTrim( Str( Len( uVal ) ) ) + " elements" + CASE cType == "P" ; RETURN "Pointer" + ENDCASE + + RETURN "U" diff --git a/harbour/source/debug/tbrwtext.prg b/harbour/source/debug/tbrwtext.prg index 57e3570c45..0a517ce0a8 100644 --- a/harbour/source/debug/tbrwtext.prg +++ b/harbour/source/debug/tbrwtext.prg @@ -51,229 +51,220 @@ */ #include "hbclass.ch" + #include "common.ch" #include "fileio.ch" #include "inkey.ch" - // Color definitions and positions inside ::cColorSpec #define CLR_CODE 0 // color of code #define CLR_CURSOR 1 // color of highlighted line (the line to be executed) #define CLR_BKPT 2 // color of breakpoint line #define CLR_HIBKPT 3 // color of highlighted breakpoint line +CREATE CLASS HBBrwText FROM HBEditor -CLASS TBrwText FROM HBEditor + VAR cFileName // the name of the browsed file + VAR nActiveLine INIT 1 // Active line inside Code Window (the line to be executed) + VAR aBreakPoints INIT {} // Array with line numbers of active Break Points + VAR lLineNumbers // If .T. source code lines are preceded by their number - DATA cFileName // the name of the browsed file - DATA nActiveLine // Active line inside Code Window (the line to be executed) + ACCESS colorSpec INLINE ::cColorSpec + ASSIGN colorSpec( cClr ) INLINE ::cColorSpec := cClr - DATA aBreakPoints // Array with line numbers of active Break Points + METHOD New( nTop, nLeft, nBottom, nRight, cFileName, cColor ) - DATA lLineNumbers // If .T. source code lines are preceded by their number - - ACCESS colorSpec INLINE ::cColorSpec - ASSIGN colorSpec(cClr) INLINE ::cColorSpec:=cClr - - METHOD New(nTop, nLeft, nBottom, nRight, cFileName, cColor) - - METHOD GoTop() // Methods available on a standard TBrowse, needed to handle a HBEditor like a TBrowse - METHOD GoBottom() - METHOD Up() - METHOD Down() - METHOD Left() - METHOD Right() - METHOD PageUp() - METHOD PageDown() - METHOD RefreshAll() - METHOD RefreshCurrent() - METHOD ForceStable() INLINE NIL - - METHOD GotoLine(n) // Moves active line cursor - METHOD SetActiveLine( n ) // Sets the line to be executed - - METHOD GetLine(nRow) // Redefine HBEditor method to add line number - METHOD LineColor(nRow) // Redefine HBEditor method to handle line coloring - - METHOD ToggleBreakPoint(nRow, lSet) // if lSet is .T. there is a BreakPoint active at nRow, - // if lSet is .F. BreakPoint at nRow has to be removed - METHOD Search( cString, lCaseSensitive, nMode ) // 0 from Begining to end, 1 Forward, 2 Backwards - - METHOD LoadFile(cFileName) + METHOD GoTop() // Methods available on a standard TBrowse, needed to handle a HBEditor like a TBrowse + METHOD GoBottom() + METHOD Up() + METHOD Down() + METHOD Left() + METHOD Right() + METHOD End() + METHOD PageUp() + METHOD PageDown() + METHOD RefreshAll() + METHOD RefreshCurrent() + METHOD ForceStable() INLINE NIL + METHOD GotoLine( n ) // Moves active line cursor + METHOD SetActiveLine( n ) // Sets the line to be executed + METHOD GetLine( nRow ) // Redefine HBEditor method to add line number + METHOD LineColor( nRow ) // Redefine HBEditor method to handle line coloring + METHOD ToggleBreakPoint( nRow, lSet ) // if lSet is .T. there is a BreakPoint active at nRow, if lSet is .F. BreakPoint at nRow has to be removed + METHOD Search( cString, lCaseSensitive, nMode ) // 0 from Begining to end, 1 Forward, 2 Backwards + METHOD LoadFile( cFileName ) ENDCLASS - -METHOD New(nTop, nLeft, nBottom, nRight, cFileName, cColor, lLineNumbers) CLASS TBrwText +METHOD New( nTop, nLeft, nBottom, nRight, cFileName, cColor, lLineNumbers) CLASS HBBrwText DEFAULT cColor TO SetColor() DEFAULT lLineNumbers TO .T. ::cFileName := cFileName - ::nActiveLine := 1 - - ::aBreakPoints := {} - ::lLineNumbers := lLineNumbers - ::Super:New("", nTop, nLeft, nBottom, nRight, .T.) - ::Super:SetColor(cColor) + ::Super:New( "", nTop, nLeft, nBottom, nRight, .T. ) + ::Super:SetColor( cColor ) + ::Super:LoadFile( cFileName ) - ::Super:LoadFile(cFileName) + RETURN Self -return Self +METHOD LoadFile( cFileName ) CLASS HBBrwText + ::Super:LoadFile( cFileName ) -METHOD LoadFile(cFileName) CLASS TBrwText + RETURN Self - ::Super:LoadFile(cFileName) +METHOD GoTop() CLASS HBBrwText -return Self + ::MoveCursor( K_CTRL_PGUP ) + RETURN Self -METHOD GoTop() CLASS TBrwText - ::MoveCursor(K_CTRL_PGUP) -return Self +METHOD GoBottom() CLASS HBBrwText + ::MoveCursor( K_CTRL_PGDN ) -METHOD GoBottom() CLASS TBrwText - ::MoveCursor(K_CTRL_PGDN) -return Self + RETURN Self +METHOD Up() CLASS HBBrwText -METHOD Up() CLASS TBrwText - ::MoveCursor(K_UP) -return Self + ::MoveCursor( K_UP ) + RETURN Self -METHOD Left() CLASS TBrwText - ::MoveCursor(K_LEFT) -return Self +METHOD Left() CLASS HBBrwText + ::MoveCursor( K_LEFT ) -METHOD Right() CLASS TBrwText - ::MoveCursor(K_RIGHT) -return Self + RETURN Self +METHOD Right() CLASS HBBrwText -METHOD Down() CLASS TBrwText - ::MoveCursor(K_DOWN) -return Self + ::MoveCursor( K_RIGHT ) + RETURN Self -METHOD PageUp() CLASS TBrwText - ::MoveCursor(K_PGUP) -return Self +METHOD End() CLASS HBBrwText + ::MoveCursor( K_END ) -METHOD PageDown() CLASS TBrwText - ::MoveCursor(K_PGDN) -return Self + RETURN Self +METHOD Down() CLASS HBBrwText + + ::MoveCursor( K_DOWN ) + + RETURN Self + +METHOD PageUp() CLASS HBBrwText + + ::MoveCursor( K_PGUP ) + + RETURN Self + +METHOD PageDown() CLASS HBBrwText + + ::MoveCursor( K_PGDN ) + + RETURN Self + +METHOD RefreshAll() CLASS HBBrwText -METHOD RefreshAll() CLASS TBrwText ::RefreshWindow() -return Self + RETURN Self + +METHOD RefreshCurrent() CLASS HBBrwText -METHOD RefreshCurrent() CLASS TBrwText ::RefreshLine() -return Self + return Self + +METHOD SetActiveLine( n ) CLASS HBBrwText -METHOD SetActiveLine( n ) CLASS TBrwText ::nActiveLine := n ::RefreshWindow() -return Self + RETURN Self -METHOD GotoLine(n) CLASS TBrwText +METHOD GotoLine( n ) CLASS HBBrwText - ::Super:GotoLine(n) + ::Super:GotoLine( n ) -return Self + RETURN Self +METHOD GetLine( nRow ) CLASS HBBrwText + RETURN iif( ::lLineNumbers, AllTrim( Str( nRow ) ) + ": ", "" ) + ::Super:GetLine( nRow ) -METHOD GetLine(nRow) CLASS TBrwText +METHOD LineColor( nRow ) CLASS HBBrwText -return iif(::lLineNumbers, AllTrim(Str(nRow)) + ": ", "") + ::Super:GetLine(nRow) + LOCAL lHilited := ( nRow == ::nActiveLine ) + LOCAL lBreak := AScan( ::aBreakPoints, nRow ) > 0 + LOCAL nIndex := CLR_CODE + IF lHilited + nIndex += CLR_CURSOR + ENDIF + IF lBreak + nIndex += CLR_BKPT + ENDIF -METHOD LineColor(nRow) CLASS TBrwText + RETURN hb_ColorIndex( ::cColorSpec, nIndex ) - local cColor, lHilited, lBreak, nIndex := CLR_CODE +METHOD ToggleBreakPoint( nRow, lSet ) CLASS HBBrwText - lHilited := (nRow == ::nActiveLine) - lBreak := AScan(::aBreakPoints, nRow) > 0 + LOCAL nAt := AScan( ::aBreakPoints, nRow ) - if lHilited - nIndex += CLR_CURSOR - endif - if lBreak - nIndex += CLR_BKPT - endif - - cColor := hb_ColorIndex(::cColorSpec, nIndex) - -return cColor - - -METHOD ToggleBreakPoint(nRow, lSet) CLASS TBrwText - - local nAt := AScan(::aBreakPoints, nRow) - - if lSet + IF lSet // add it only if not present - if nAt == 0 - AAdd(::aBreakPoints, nRow) - endif + IF nAt == 0 + AAdd( ::aBreakPoints, nRow ) + ENDIF + ELSEIF nAt != 0 + ADel( ::aBreakPoints, nAt ) + ASize( ::aBreakPoints, Len( ::aBreakPoints ) - 1 ) + ENDIF - else - if nAt <> 0 - ADel( ::aBreakPoints, nAt ) - ASize( ::aBreakPoints, Len( ::aBreakPoints ) - 1 ) - endif + RETURN Self - endif +METHOD Search( cString, lCaseSensitive, nMode ) CLASS HBBrwText -return Self + LOCAL nFrom + LOCAL nTo + LOCAL nStep + LOCAL nFor + LOCAL lFound := .F. -METHOD Search( cString, lCaseSensitive, nMode ) CLASS TBrwText + DEFAULT lCaseSensitive TO .F. + DEFAULT nMode TO 0 - local nFrom, nTo, nStep, nFor - local lFound - - DEFAULT lCaseSensitive TO .f., ; - nMode TO 0 - - lFound := .f. - - if !lCaseSensitive + IF !lCaseSensitive cString := Upper( cString ) - endif + ENDIF - do case - case nMode == 0 // From Top + DO CASE + CASE nMode == 0 // From Top nFrom := 1 nTo := ::naTextLen nStep := 1 - case nMode == 1 // Forward + CASE nMode == 1 // Forward nFrom := Min( ::nRow + 1, ::naTextLen ) nTo := ::naTextLen nStep := 1 - case nMode == 2 // Backward + CASE nMode == 2 // Backward nFrom := Max( ::nRow - 1, 1 ) nTo := 1 nStep := -1 - end case + ENDCASE - for nFor := nFrom to nTo Step nStep - if cString $ iif( lCaseSensitive, ::GetLine( nFor ), Upper( ::GetLine( nFor ) ) ) - lFound := .t. + FOR nFor := nFrom TO nTo STEP nStep + IF cString $ iif( lCaseSensitive, ::GetLine( nFor ), Upper( ::GetLine( nFor ) ) ) + lFound := .T. ::GotoLine( nFor ) - exit - endif - next - -return lFound + EXIT + ENDIF + NEXT + RETURN lFound diff --git a/harbour/source/rtl/getsys.prg b/harbour/source/rtl/getsys.prg index 9f2d4b88b1..7161052b4c 100644 --- a/harbour/source/rtl/getsys.prg +++ b/harbour/source/rtl/getsys.prg @@ -64,7 +64,11 @@ #include "common.ch" #ifdef HB_COMPAT_C53 -FUNCTION ReadModal( GetList, nPos, nMsgRow, nMsgLeft, nMsgRight, cMsgColor ) +#include "setcurs.ch" +#endif + +#ifdef HB_COMPAT_C53 +FUNCTION ReadModal( GetList, nPos, oMenu, nMsgRow, nMsgLeft, nMsgRight, cMsgColor ) #else FUNCTION ReadModal( GetList, nPos ) #endif @@ -73,9 +77,9 @@ FUNCTION ReadModal( GetList, nPos ) LOCAL oSaveGetList #ifdef HB_COMPAT_C53 - LOCAL lMsgFlag - LOCAL cOldMsg LOCAL oGet + LOCAL lMsgFlag + LOCAL aMsg #endif IF Empty( GetList ) @@ -84,6 +88,9 @@ FUNCTION ReadModal( GetList, nPos ) ENDIF oGetList := HBGetList():New( GetList ) +#ifdef HB_COMPAT_C53 + oGetList:nSaveCursor := SetCursor( SC_NONE ) +#endif oGetList:cReadProcName := ProcName( 1 ) oGetList:nReadProcLine := ProcLine( 1 ) @@ -91,16 +98,33 @@ FUNCTION ReadModal( GetList, nPos ) __GetListSetActive( oGetList ) __GetListLast( oGetList ) +#ifdef HB_COMPAT_C53 + oGetList:nPos := oGetList:Settle( iif( ISNUMBER( nPos ), nPos, 0 ), .T. ) +#else IF ! ( ISNUMBER( nPos ) .AND. nPos > 0 ) oGetList:nPos := oGetList:Settle( 0 ) ENDIF +#endif #ifdef HB_COMPAT_C53 - if ( lMsgFlag := ISNUMBER( nMsgRow ) .AND. ; + IF ( lMsgFlag := ISNUMBER( nMsgRow ) .AND. ; ISNUMBER( nMsgLeft ) .AND. ; ISNUMBER( nMsgRight ) ) - cOldMsg := SaveScreen( nMsgRow, nMsgLeft, nMsgRow, nMsgRight ) - endif + + IF !ISCHARACTER( cMsgColor ) + cMsgColor := GetClrPair( SetColor(), 1 ) + ENDIF + + Scroll( nMsgRow, nMsgLeft, nMsgRow, nMsgRight ) + + oGetList:cMsgSaveS := SaveScreen( nMsgRow, nMsgLeft, nMsgRow, nMsgRight ) + ENDIF + + oGetList:nNextGet := 0 + oGetList:nHitCode := 0 + oGetList:nMenuID := 0 + + aMsg := { , nMsgRow, nMsgLeft, nMsgRight, cMsgColor, , , , , } #endif DO WHILE oGetList:nPos != 0 @@ -109,43 +133,61 @@ FUNCTION ReadModal( GetList, nPos ) oGetList:PostActiveGet() #ifdef HB_COMPAT_C53 - if lMsgFlag + IF lMsgFlag oGet := oGetList:aGetList[ oGetList:nPos ] DispOutAt( nMsgRow, nMsgLeft, PadC( iif( ISOBJECT( oGet:Control ), oGet:Control:Message, oGet:Message ), nMsgRight - nMsgLeft + 1 ), iif( ISCHARACTER( cMsgColor ), cMsgColor, NIL ) ) - endif -#endif + ENDIF IF ISBLOCK( oGetList:oGet:Reader ) -#ifdef HB_COMPAT_C53 - Eval( oGetList:oGet:Reader, oGetList:oGet, oGetlist) + Eval( oGetList:oGet:Reader, oGetList:oGet, oGetlist, oMenu, aMsg ) + ELSE + oGetList:Reader( aMsg ) + ENDIF + + oGetList:nPos := oGetList:Settle( NIL, .F. ) #else + IF ISBLOCK( oGetList:oGet:Reader ) Eval( oGetList:oGet:Reader, oGetList:oGet ) -#endif ELSE oGetList:Reader() ENDIF oGetList:nPos := oGetList:Settle() +#endif ENDDO #ifdef HB_COMPAT_C53 - if lMsgFlag - RestScreen( nMsgRow, nMsgLeft, nMsgRow, nMsgRight, cOldMsg ) - endif + IF lMsgFlag + RestScreen( nMsgRow, nMsgLeft, nMsgRow, nMsgRight, oGetList:cMsgSaveS ) + ENDIF #endif __GetListSetActive( oSaveGetList ) SetPos( MaxRow() - 1, 0 ) +#ifdef HB_COMPAT_C53 + SetCursor( oGetList:nSaveCursor ) +#endif RETURN oGetList:lUpdated +#ifdef HB_COMPAT_C53 +PROCEDURE GetReader( oGet, oGetList, oMenu, aMsg ) + + HB_SYMBOL_UNUSED( oGetList ) + + oGet:Reader( oMenu, aMsg ) + + RETURN +#else PROCEDURE GetReader( oGet ) + oGet:Reader() RETURN +#endif FUNCTION GetActive( oGet ) LOCAL oGetList := __GetListActive() @@ -172,40 +214,59 @@ PROCEDURE GetDoSetKey( keyBlock, oGet ) RETURN +#ifdef HB_COMPAT_C53 +PROCEDURE GetApplyKey( oGet, nKey, oGetList, oMenu, aMsg ) + IF !ISOBJECT( oGetList ) + oGetList := __GetListActive() + ENDIF +#else PROCEDURE GetApplyKey( oGet, nKey ) LOCAL oGetList := __GetListActive() +#endif IF oGetList != NIL IF oGet != NIL oGetList:oGet := oGet ENDIF +#ifdef HB_COMPAT_C53 + oGetList:GetApplyKey( nKey, oMenu, aMsg ) +#else oGetList:GetApplyKey( nKey ) +#endif ENDIF RETURN +#ifdef HB_COMPAT_C53 +FUNCTION GetPreValidate( oGet, aMsg ) +#else FUNCTION GetPreValidate( oGet ) +#endif LOCAL oGetList := __GetListActive() IF oGetList != NIL - IF oGet != NIL - oGetList:oGet := oGet - ENDIF - - RETURN oGetList:GetPreValidate() +#ifdef HB_COMPAT_C53 + RETURN oGetList:GetPreValidate( oGet, aMsg ) +#else + RETURN oGetList:GetPreValidate( oGet ) +#endif ENDIF RETURN .F. +#ifdef HB_COMPAT_C53 +FUNCTION GetPostValidate( oGet, aMsg ) +#else FUNCTION GetPostValidate( oGet ) +#endif LOCAL oGetList := __GetListActive() IF oGetList != NIL - IF oGet != NIL - oGetList:oGet := oGet - ENDIF - - RETURN oGetList:GetPostValidate() +#ifdef HB_COMPAT_C53 + RETURN oGetList:GetPostValidate( oGet, aMsg ) +#else + RETURN oGetList:GetPostValidate( oGet ) +#endif ENDIF RETURN .F. @@ -451,9 +512,9 @@ FUNCTION ReadStats( nElement, xNewValue ) CASE nElement == SNNEXTGET ; xRetVal := __GetListActive():nNextGet CASE nElement == SNHITCODE ; xRetVal := __GetListActive():nHitCode CASE nElement == SNPOS ; xRetVal := __GetListActive():nPos - CASE nElement == SCSCRSVMSG ; xRetVal := "" - CASE nElement == SNMENUID ; xRetVal := 0 - CASE nElement == SNSVCURSOR ; xRetVal := 0 + CASE nElement == SCSCRSVMSG ; xRetVal := __GetListActive():cMsgSaveS + CASE nElement == SNMENUID ; xRetVal := __GetListActive():nMenuID + CASE nElement == SNSVCURSOR ; xRetVal := __GetListActive():nSaveCursor OTHERWISE ; xRetVal := NIL ENDCASE @@ -474,26 +535,37 @@ FUNCTION ReadStats( nElement, xNewValue ) CASE nElement == SNNEXTGET ; __GetListActive():nNextGet := xNewValue CASE nElement == SNHITCODE ; __GetListActive():nHitCode := xNewValue CASE nElement == SNPOS ; __GetListActive():nPos := xNewValue + CASE nElement == SCSCRSVMSG ; __GetListActive():cMsgSaveS := xNewValue + CASE nElement == SNMENUID ; __GetListActive():nMenuID := xNewValue + CASE nElement == SNSVCURSOR ; __GetListActive():nSaveCursor := xNewValue ENDCASE ENDIF RETURN xRetVal FUNCTION ShowGetMsg( oGet, aMsg ) + LOCAL oGetList := __GetListActive() - /* Dummy function */ - - HB_SYMBOL_UNUSED( oGet ) - HB_SYMBOL_UNUSED( aMsg ) + IF oGetList != NIL + IF oGet != NIL + oGetList:oGet := oGet + ENDIF + + oGetList:ShowGetMsg( aMsg ) + ENDIF RETURN NIL FUNCTION EraseGetMsg( oGet, aMsg ) + LOCAL oGetList := __GetListActive() - /* Dummy function */ - - HB_SYMBOL_UNUSED( oGet ) - HB_SYMBOL_UNUSED( aMsg ) + IF oGetList != NIL + IF oGet != NIL + oGetList:oGet := oGet + ENDIF + + oGetList:EraseGetMsg( aMsg ) + ENDIF RETURN NIL diff --git a/harbour/source/rtl/menusys.prg b/harbour/source/rtl/menusys.prg index b3197733c5..312c30d115 100644 --- a/harbour/source/rtl/menusys.prg +++ b/harbour/source/rtl/menusys.prg @@ -88,31 +88,37 @@ FUNCTION IsShortCut( oMenu, nKey, nID ) // Test for top menu item not a TopBar Menu: IF !( oMenu:ClassName() == "TOPBARMENU" ) + RETURN IsQuick( oMenu, nKey, @nID ) // Test and assign top menu item shortCut, enabled, and !PopUp: // Changed by enclosing assignment before ':Enabled': - ELSEIF ( nShortCut := oMenu:GetShortCt( nKey ) ) > 0 .AND. ; - ( oItem := oMenu:GetItem( nShortcut ) ):Enabled .AND. ; - !oItem:IsPopUp() - oMenu:Select( nShortCut ) - Eval( oItem:Data, oItem ) + ELSEIF ( nShortCut := oMenu:getShortCt( nKey ) ) > 0 .AND. ; + ( oItem := oMenu:getItem( nShortcut ) ):enabled .AND. ; + !oItem:isPopUp() + + oMenu:select( nShortCut ) + Eval( oItem:data, oItem ) nID := oItem:ID + RETURN .T. // Test and assignment for TopBar MenuItem: ELSEIF nShortCut == 0 - nTotal := oMenu:ItemCount() - nItem := oMenu:Current + + nTotal := oMenu:itemCount + nItem := oMenu:current + IF nItem == 0 nItem := 1 ENDIF // Loop to wrap around through TopMenu from Current Item: FOR i := 1 TO nTotal - IF ( oItem := oMenu:GetItem( nItem ) ):Enabled .AND. ; - oItem:IsPopUp() .AND. ; - IsQuick( oItem:Data, nKey, @nID ) + + IF ( oItem := oMenu:getItem( nItem ) ):enabled .AND. ; + oItem:isPopUp() .AND. ; + IsQuick( oItem:data, nKey, @nID ) RETURN .T. ENDIF @@ -138,23 +144,24 @@ FUNCTION IsQuick( oMenu, nKey, nID ) LOCAL nShortCut LOCAL oItem - IF ( nShortCut := oMenu:GetShortCt( nKey ) ) == 0 + IF ( nShortCut := oMenu:getShortCt( nKey ) ) == 0 - nTotal := oMenu:ItemCount() + nTotal := oMenu:itemCount FOR nItem := 1 TO nTotal - IF ( oItem := oMenu:GetItem( nItem ) ):Enabled .AND. ; - oItem:IsPopUp() .AND. ; - IsQuick( oItem:Data, nKey, @nID ) + + IF ( oItem := oMenu:getItem( nItem ) ):enabled .AND. ; + oItem:isPopUp() .AND. ; + IsQuick( oItem:data, nKey, @nID ) RETURN .T. ENDIF NEXT - ELSEIF !( oItem := oMenu:GetItem( nShortCut ) ):IsPopUp() .AND. oItem:Enabled + ELSEIF !( oItem := oMenu:getItem( nShortCut ) ):isPopUp() .AND. oItem:enabled - oMenu:Select( nShortCut ) - Eval( oItem:Data, oItem ) + oMenu:select( nShortCut ) + Eval( oItem:data, oItem ) nID := oItem:ID RETURN .T. diff --git a/harbour/source/rtl/tbcolumn.prg b/harbour/source/rtl/tbcolumn.prg index 6eb6254ba2..9238cfb8a6 100644 --- a/harbour/source/rtl/tbcolumn.prg +++ b/harbour/source/rtl/tbcolumn.prg @@ -58,7 +58,11 @@ and there is no public class function like TBColumn(). There is in XPP though. */ +#if defined(HB_C52_STRICT) && !defined(HB_COMPAT_XPP) +CREATE CLASS TBColumn STATIC +#else CREATE CLASS TBColumn +#endif EXPORT: diff --git a/harbour/source/rtl/tbrowse.prg b/harbour/source/rtl/tbrowse.prg index db78c51aa8..71daffd55f 100644 --- a/harbour/source/rtl/tbrowse.prg +++ b/harbour/source/rtl/tbrowse.prg @@ -117,7 +117,11 @@ and there is no public class function like TBrowse(). There is in XPP though. */ +#if defined(HB_C52_STRICT) && !defined(HB_COMPAT_XPP) +CREATE CLASS TBrowse STATIC +#else CREATE CLASS TBrowse +#endif EXPORT: @@ -223,6 +227,7 @@ CREATE CLASS TBrowse VAR aColumns INIT {} // Array to hold all browse columns VAR aColsWidth INIT {} // Array with width of TBrowse's columns VAR aColsPos INIT {} // Array with position of TBrowse's columns + VAR aColsInfo INIT {} // Array with column data VAR lHeaders INIT .F. // Internal variable which indicates whether there are column footers to paint VAR lFooters INIT .F. // Internal variable which indicates whether there are column footers to paint VAR lRedrawFrame INIT .T. // True if I need to redraw Headers/Footers @@ -252,6 +257,7 @@ CREATE CLASS TBrowse VAR aSetStyle INIT { .F., .F., .F., .F., .F. } /* TBR_APPEND, TBR_APPENDING, TBR_MODIFY, TBR_MOVE, TBR_SIZE */ #endif + METHOD InitColumn( oCol, lAddColumn ) METHOD PosCursor() // Positions the cursor to the beginning of the call, used only when autolite==.F. METHOD LeftDetermine() // Determine leftmost unfrozen column in display METHOD DispCell( nRow, nCol, nMode ) // Displays a single cell and returns cell type as a single letter like Valtype() @@ -324,6 +330,8 @@ METHOD configure( nMode ) CLASS TBrowse // Find out highest header and footer for n := 1 to ::nColumns + // ... + if ::lHeaders .and. ! Empty( ::aColumns[ n ]:Heading ) nHeight := Len( ::aColumns[ n ]:Heading ) - Len( StrTran( ::aColumns[ n ]:Heading, ";" ) ) + 1 @@ -390,6 +398,7 @@ METHOD addColumn( oCol ) CLASS TBrowse AAdd( ::aColumns, oCol ) AAdd( ::aColsWidth, ::SetColumnWidth( oCol ) ) AAdd( ::aColsPos, 0 ) + AAdd( ::aColsInfo, ::InitColumn( oCol, .T. ) ) if ::nColumns == 1 ::leftVisible := 1 @@ -413,7 +422,8 @@ METHOD insColumn( nPos, oCol ) CLASS TBrowse AAdd( ::aColumns, oCol ) AAdd( ::aColsWidth, ::SetColumnWidth( oCol ) ) - AAdd( ::aColsPos, 0 ) + AAdd( ::aColsPos, 100 ) + AAdd( ::aColsInfo, ::InitColumn( oCol, .F. ) ) else @@ -425,6 +435,8 @@ METHOD insColumn( nPos, oCol ) CLASS TBrowse AIns( ::aColsWidth, nPos ) ASize( ::aColsPos, ::nColumns ) AIns( ::aColsPos, nPos ) + ASize( ::aColsInfo, ::nColumns ) + AIns( ::aColsInfo, ::InitColumn( oCol, .F. ) ) ::aColumns[ nPos ] := oCol ::aColsWidth[ nPos ] := ::SetColumnWidth( oCol ) @@ -449,6 +461,7 @@ METHOD setColumn( nPos, oCol ) CLASS TBrowse ::aColumns[ nPos ] := oCol ::aColsWidth[ nPos ] := ::SetColumnWidth( oCol ) ::aColsPos[ nPos ] := 0 + ::aColsInfo[ nPos ] := ::InitColumn( oCol, .F. ) ::Configure( 2 ) ::HowManyCol() @@ -1160,6 +1173,40 @@ METHOD colorRect( aRect, aRectColor ) CLASS TBrowse /* -------------------------------------------- */ +METHOD InitColumn( oCol, lAddColumn ) CLASS TBrowse + + IF !lAddColumn .AND. ISOBJECT( oCol ) .AND. ISBLOCK( oCol:block ) + RETURN {; + oCol ,; // TBCI_OBJ + ValType( Eval( oCol:block ) ) ,; // TBCI_TYPE + ::SetColumnWidth( oCol ) ,; // TBCI_WIDTH + "" ,; // TBCI_HEADING + "" ,; // TBCI_FOOTING + "" ,; // TBCI_PICT + 0 ,; // TBCI_WIDTHCELL + "" ,; // TBCI_COLSEP + 0 ,; // TBCI_SEPWIDTH + oCol:defColor ,; // TBCI_DEFCOLOR + .F. ,; // TBCI_SETWIDTH + .T. ,; // TBCI_LCOLSEP + 0 } // TBCI_SCRCOLPOS + ENDIF + + RETURN {; + oCol ,; // TBCI_OBJ + "" ,; // TBCI_TYPE + 0 ,; // TBCI_WIDTH + "" ,; // TBCI_HEADING + "" ,; // TBCI_FOOTING + "" ,; // TBCI_PICT + 0 ,; // TBCI_WIDTHCELL + "" ,; // TBCI_COLSEP + 0 ,; // TBCI_SEPWIDTH + {} ,; // TBCI_DEFCOLOR + .F. ,; // TBCI_SETWIDTH + .T. ,; // TBCI_LCOLSEP + 0 } // TBCI_SCRCOLPOS + METHOD PosCursor() CLASS TBrowse local nRow := ::n_Top + ::nRowPos + iif( ::lHeaders, ::nHeaderHeight, 0 ) + iif( Empty( ::cHeadSep ) .or. ! ::lHeaders, 0, 1 ) - 1 @@ -1979,7 +2026,7 @@ FUNCTION TBMouse( oBrowse, nMouseRow, nMouseCol ) if oBrowse:hitTest( nMouseRow, nMouseCol ) == HTCELL - n := oBrowse:mRowPos - oBrowse:nRowPos + n := oBrowse:mRowPos - oBrowse:rowPos do while n < 0 n++ @@ -1991,7 +2038,7 @@ FUNCTION TBMouse( oBrowse, nMouseRow, nMouseCol ) oBrowse:down():forceStable() enddo - n := oBrowse:mColPos - oBrowse:nColPos + n := oBrowse:mColPos - oBrowse:colPos if n < oBrowse:leftVisible - oBrowse:colPos .and. oBrowse:freeze + 1 < oBrowse:leftVisible n += oBrowse:freeze + 1 - oBrowse:leftVisible // hidden columns endif diff --git a/harbour/source/rtl/teditor.prg b/harbour/source/rtl/teditor.prg index 95a98e9261..9bf2d28042 100644 --- a/harbour/source/rtl/teditor.prg +++ b/harbour/source/rtl/teditor.prg @@ -100,7 +100,11 @@ CREATE CLASS HBEditor METHOD SetPos( nRow, nCol ) // Updates ::nPhysRow, ::nPhysCol and then calls SetPos() to move hardware cursor METHOD Row() // Same as clipper ones, returns ::nPhysRow value METHOD Col() // Same as clipper ones, returns ::nPhysCol value + METHOD RowPos() // Returns ::nRow value + METHOD ColPos() // Returns ::nCol value METHOD Saved() // Returns saved status + METHOD IsWordWrap() // Returns ::lWordWrap + METHOD WordWrapCol() // Returns ::nWordWrapCol PROTECTED: @@ -910,6 +914,12 @@ METHOD Row() CLASS HBEditor METHOD Col() CLASS HBEditor return ::nPhysCol +METHOD RowPos() CLASS HBEditor + return ::nRow + +METHOD ColPos() CLASS HBEditor + return ::nCol + /* METHOD LineColor( nRow ) CLASS HBEditor return ::cColorSpec @@ -918,6 +928,12 @@ METHOD LineColor( nRow ) CLASS HBEditor METHOD Saved() CLASS HBEditor return ::lSaved +METHOD IsWordWrap() CLASS HBEditor + return ::lWordWrap + +METHOD WordWrapCol() CLASS HBEditor + return ::nWordWrapCol + // Returns EOL char (be it either CR or LF or both) STATIC FUNCTION WhichEOL( cString ) diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 2686c40580..53117d89cc 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -81,7 +81,11 @@ and there is no public class function like Get(). There is in XPP though. */ +#if defined(HB_C52_STRICT) && !defined(HB_COMPAT_XPP) +CREATE CLASS Get STATIC +#else CREATE CLASS Get +#endif EXPORT: @@ -89,7 +93,7 @@ CREATE CLASS Get VAR decPos INIT 0 READONLY /* ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. [vszakats] */ VAR exitState VAR hasFocus INIT .F. READONLY - VAR original READONLY + VAR original READONLY VAR postBlock VAR preBlock VAR reader diff --git a/harbour/source/rtl/tgetlist.prg b/harbour/source/rtl/tgetlist.prg index c003283553..5ef3426f92 100644 --- a/harbour/source/rtl/tgetlist.prg +++ b/harbour/source/rtl/tgetlist.prg @@ -79,17 +79,23 @@ #define K_UNDO K_CTRL_U +#define MSGFLAG 1 +#define MSGROW 2 +#define MSGLEFT 3 +#define MSGRIGHT 4 +#define MSGCOLOR 5 + CREATE CLASS HBGetList EXPORT: VAR HasFocus AS LOGICAL INIT .F. - METHOD Settle( nPos ) - METHOD Reader() - METHOD GetApplyKey( nKey ) - METHOD GetPreValidate() - METHOD GetPostValidate() + METHOD Settle( nPos, lInit ) + METHOD Reader( oMenu, aMsg ) + METHOD GetApplyKey( nKey, oMenu, aMsg ) + METHOD GetPreValidate( oGet, aMsg ) + METHOD GetPostValidate( oGet, aMsg ) METHOD GetDoSetKey( bKeyBlock ) METHOD PostActiveGet() METHOD GetReadVar() @@ -109,10 +115,12 @@ CREATE CLASS HBGetList METHOD GUIApplyKey( oGet, oGUI, nKey, oMenu, aMsg ) METHOD GUIPreValidate( oGUI, aMsg ) METHOD GUIPostValidate( oGUI, aMsg ) - METHOD TBApplyKey( oGet, oTB, nKey, aMsg ) + METHOD TBApplyKey( oGet, oTB, nKey, oMenu, aMsg ) METHOD TBReader( oGet, oMenu, aMsg ) METHOD Accelerator( nKey, aMsg ) METHOD HitTest( nMouseRow, nMouseColumn, aMsg ) + METHOD ShowGetMsg( aMsg ) + METHOD EraseGetMsg( aMsg ) #endif METHOD New( GetList ) @@ -128,20 +136,25 @@ CREATE CLASS HBGetList VAR cVarName VAR cReadProcName AS CHARACTER INIT "" VAR nReadProcLine +#ifdef HB_COMPAT_C53 VAR nNextGet VAR nHitCode AS NUMERIC INIT 0 - VAR nPos AS NUMERIC INIT 1 + VAR cMsgSaveS + VAR nMenuID + VAR nSaveCursor +#endif VAR aGetList VAR oGet + VAR nPos AS NUMERIC INIT 1 ENDCLASS METHOD ReadExit( lNew ) CLASS HBGetList - return iif( ISLOGICAL( lNew ), Set( _SET_EXIT, lNew ), Set( _SET_EXIT ) ) + RETURN iif( ISLOGICAL( lNew ), Set( _SET_EXIT, lNew ), Set( _SET_EXIT ) ) METHOD Updated() CLASS HBGetList - return ::lUpdated + RETURN ::lUpdated METHOD SetFocus() CLASS HBGetList @@ -149,295 +162,345 @@ METHOD SetFocus() CLASS HBGetList __GetListLast( Self ) ::aGetList[ ::nPos ]:SetFocus() - return Self + RETURN Self -METHOD Reader() CLASS HBGetList +METHOD Reader( oMenu, aMsg ) CLASS HBGetList - local oGet := ::oGet + LOCAL oGet := ::oGet + LOCAL nRow + LOCAL nCol +#ifdef HB_COMPAT_53 + LOCAL nOldCursor + LOCAL nKey +#endif - if ::GetPreValidate() +#ifdef HB_COMPAT_53 + IF ::nLastExitState == GE_SHORTCUT .OR.; + ::nLastExitState == GE_MOUSEHIT .OR.; + ::GetPreValidate( oGet, aMsg ) +#else + IF ::GetPreValidate( oGet, aMsg ) +#endif + + ::ShowGetMsg( aMsg ) oGet:SetFocus() - do while oGet:ExitState == GE_NOEXIT - if oGet:typeOut + DO WHILE oGet:ExitState == GE_NOEXIT + IF oGet:typeOut oGet:ExitState := GE_ENTER - endif + ENDIF - if oGet:buffer == NIL + IF oGet:buffer == NIL oGet:ExitState := GE_ENTER - endif + ENDIF - do while oGet:exitState == GE_NOEXIT - ::GetApplyKey( Inkey( 0 ) ) - enddo + DO WHILE oGet:exitState == GE_NOEXIT +#ifdef HB_COMPAT_53 + SetCursor( iif( ::nSaveCursor == SC_NONE, SC_NORMAL, ::nSaveCursor ) ) + nKey := Inkey( 0 ) + SetCursor( SC_NONE ) + ::GetApplyKey( nKey, oMenu, aMsg ) +#else + ::GetApplyKey( Inkey( 0 ), oMenu, aMsg ) +#endif + nRow := Row() + nCol := Col() + ::ShowGetMsg( aMsg ) + SetPos( nRow, nCol ) + ENDDO - if ! ::GetPostValidate() +#ifdef HB_COMPAT_53 + IF !::nLastExitState == GE_SHORTCUT .AND. ; + !::nLastExitState == GE_MOUSEHIT .AND. ; + !::GetPostValidate( oGet, aMsg ) +#else + IF !::GetPostValidate( oGet, aMsg ) +#endif oGet:ExitState := GE_NOEXIT - endif - enddo + ENDIF + ENDDO +#ifdef HB_COMPAT_53 + nRow := Row() + nCol := Col() + nOldCursor := SetCurosr() +#endif oGet:killFocus() - endif +#ifdef HB_COMPAT_53 + SetCursor( nOldCursor ) + SetPos( nRow, nCol ) +#endif - return Self + ::EraseGetMsg( aMsg ) + ENDIF -METHOD GetApplyKey( nKey ) CLASS HBGetList + RETURN Self - local cKey - local bKeyBlock - local oGet := ::oGet - local nMouseRow - local nMouseColumn - local nButton - local nHotItem +METHOD GetApplyKey( nKey, oMenu, aMsg ) CLASS HBGetList - if ( bKeyBlock := Setkey( nKey ) ) != NIL + LOCAL cKey + LOCAL bKeyBlock + LOCAL oGet := ::oGet + LOCAL nMouseRow + LOCAL nMouseColumn + LOCAL nButton + LOCAL nHotItem + + IF ( bKeyBlock := SetKey( nKey ) ) != NIL ::GetDoSetKey( bKeyBlock ) - return Self - endif + RETURN Self + ENDIF - if ::aGetList != NIL .AND. ; - ( nHotItem := ::Accelerator( nKey ) ) != 0 +#ifdef HB_COMPAT_C53 + IF ::aGetList != NIL .AND. ( nHotItem := ::Accelerator( nKey, aMsg ) ) != 0 oGet:ExitState := GE_SHORTCUT ::nNextGet := nHotItem ::nLastExitState := GE_SHORTCUT + ELSEIF !ISOBJECT( oMenu ) + ELSEIF ( nHotItem := oMenu:getAccel( nKey ) ) != 0 + ::nMenuID := MenuModal( oMenu, nHotItem, aMsg[ MSGROW ], aMsg[ MSGLEFT ], aMsg[ MSGRIGHT ], aMsg[ MSGCOLOR ] ) + nKey := 0 + ELSEIF IsShortCut( oMenu, nKey ) + nKey := 0 + ENDIF +#else + HB_SYMBOL_UNUSED( oMenu ) + HB_SYMBOL_UNUSED( aMsg ) +#endif - endif + DO CASE + CASE nKey == K_UP + oGet:ExitState := GE_UP + + CASE nKey == K_SH_TAB + oGet:ExitState := GE_UP + + CASE nKey == K_DOWN + oGet:ExitState := GE_DOWN + + CASE nKey == K_TAB + oGet:ExitState := GE_DOWN + + CASE nKey == K_ENTER + oGet:ExitState := GE_ENTER - do case - case nKey == K_UP - oGet:ExitState := GE_UP - - case nKey == K_SH_TAB - oGet:ExitState := GE_UP - - case nKey == K_DOWN - oGet:ExitState := GE_DOWN - - case nKey == K_TAB - oGet:ExitState := GE_DOWN - - case nKey == K_ENTER - oGet:ExitState := GE_ENTER - - case nKey == K_ESC - if Set( _SET_ESCAPE ) - oGet:Undo() - oGet:ExitState := GE_ESCAPE - endif - - case nKey == K_PGUP - oGet:ExitState := GE_WRITE - - case nKey == K_PGDN - oGet:ExitState := GE_WRITE - - case nKey == K_CTRL_HOME - oGet:ExitState := GE_TOP - - #ifdef CTRL_END_SPECIAL - case nKey == K_CTRL_END - oGet:ExitState := GE_BOTTOM - #else - case nKey == K_CTRL_W - oGet:ExitState := GE_WRITE - #endif - - case nKey == K_INS - Set( _SET_INSERT, ! Set( _SET_INSERT ) ) - ::ShowScoreboard() - - case nKey == K_LBUTTONDOWN .OR. nKey == K_LDBLCLK - nMouseRow := MRow() - nMouseColumn := MCol() - - nButton := 0 - - if ( nButton := oGet:HitTest( nMouseRow, nMouseColumn ) ) == HTCLIENT - - do while oGet:Col + oGet:Pos - 1 > nMouseColumn - oGet:Left() - - // Handle editing buffer if first character is non-editable: - if oGet:typeOut - // reset typeout: - oGet:Home() - exit - endif - - enddo - - do while oGet:Col+oGet:Pos-1 < nMouseColumn - oGet:Right() - - // Handle editing buffer if last character is non-editable: - if oGet:typeOut - // reset typeout: - oGet:End() - exit - endif - - enddo - - elseif nButton != HTNOWHERE - - elseif ::aGetList != NIL .AND. ::HitTest( nMouseRow, nMouseColumn ) != 0 - oGet:ExitState := GE_MOUSEHIT - ::nLastExitState := GE_MOUSEHIT - - else - oGet:ExitState := GE_NOEXIT - - endif - - - case nKey == K_UNDO + CASE nKey == K_ESC + IF Set( _SET_ESCAPE ) oGet:Undo() + oGet:ExitState := GE_ESCAPE + ENDIF - case nKey == K_HOME - oGet:Home() + CASE nKey == K_PGUP + oGet:ExitState := GE_WRITE - case nKey == K_END - oGet:End() + CASE nKey == K_PGDN + oGet:ExitState := GE_WRITE - case nKey == K_RIGHT - oGet:Right() + CASE nKey == K_CTRL_HOME + oGet:ExitState := GE_TOP - case nKey == K_LEFT - oGet:Left() +#ifdef CTRL_END_SPECIAL + CASE nKey == K_CTRL_END + oGet:ExitState := GE_BOTTOM +#else + CASE nKey == K_CTRL_W + oGet:ExitState := GE_WRITE +#endif - case nKey == K_CTRL_RIGHT - oGet:WordRight() + CASE nKey == K_INS + Set( _SET_INSERT, ! Set( _SET_INSERT ) ) + ::ShowScoreboard() - case nKey == K_CTRL_LEFT - oGet:WordLeft() + CASE nKey == K_LBUTTONDOWN .OR. nKey == K_LDBLCLK + nMouseRow := MRow() + nMouseColumn := MCol() - case nKey == K_BS - oGet:BackSpace() + nButton := 0 - case nKey == K_DEL - oGet:Delete() + IF ( nButton := oGet:HitTest( nMouseRow, nMouseColumn ) ) == HTCLIENT - case nKey == K_CTRL_T - oGet:DelWordRight() + DO WHILE oGet:Col + oGet:Pos - 1 > nMouseColumn + oGet:Left() - case nKey == K_CTRL_Y - oGet:DelEnd() + // Handle editing buffer if first character is non-editable: + IF oGet:typeOut + // reset typeout: + oGet:Home() + EXIT + ENDIF - case nKey == K_CTRL_BS - oGet:DelWordLeft() + ENDDO - otherwise + DO WHILE oGet:Col+oGet:Pos-1 < nMouseColumn + oGet:Right() - if nKey >= 32 .and. nKey <= 255 - cKey := Chr( nKey ) + // Handle editing buffer if last character is non-editable: + IF oGet:typeOut + // reset typeout: + oGet:End() + EXIT + ENDIF - if oGet:type == "N" .and. ( cKey == "." .or. cKey == "," ) - oGet:ToDecPos() - else - if Set( _SET_INSERT ) - oGet:Insert( cKey ) - else - oGet:OverStrike( cKey ) - endif + ENDDO - if oGet:TypeOut - if Set( _SET_BELL ) - ?? Chr( 7 ) - endif - if ! Set( _SET_CONFIRM ) - oGet:ExitState := GE_ENTER - endif - endif - endif - endif - endcase + ELSEIF nButton != HTNOWHERE + ELSEIF ::aGetList != NIL .AND. ::HitTest( nMouseRow, nMouseColumn ) != 0 + oGet:ExitState := GE_MOUSEHIT + ::nLastExitState := GE_MOUSEHIT + ELSE + oGet:ExitState := GE_NOEXIT + ENDIF - return Self + CASE nKey == K_UNDO + oGet:Undo() -METHOD GetPreValidate() CLASS HBGetList + CASE nKey == K_HOME + oGet:Home() - local oGet := ::oGet - local lUpdated, lWhen := .T. - local xValue + CASE nKey == K_END + oGet:End() - if oGet:PreBlock != NIL + CASE nKey == K_RIGHT + oGet:Right() + + CASE nKey == K_LEFT + oGet:Left() + + CASE nKey == K_CTRL_RIGHT + oGet:WordRight() + + CASE nKey == K_CTRL_LEFT + oGet:WordLeft() + + CASE nKey == K_BS + oGet:BackSpace() + + CASE nKey == K_DEL + oGet:Delete() + + CASE nKey == K_CTRL_T + oGet:DelWordRight() + + CASE nKey == K_CTRL_Y + oGet:DelEnd() + + CASE nKey == K_CTRL_BS + oGet:DelWordLeft() + + OTHERWISE + + IF nKey >= 32 .AND. nKey <= 255 + cKey := Chr( nKey ) + + IF oGet:type == "N" .AND. ( cKey == "." .OR. cKey == "," ) + oGet:ToDecPos() + ELSE + IF Set( _SET_INSERT ) + oGet:Insert( cKey ) + ELSE + oGet:OverStrike( cKey ) + ENDIF + + IF oGet:TypeOut + IF Set( _SET_BELL ) + ?? Chr( 7 ) + ENDIF + IF ! Set( _SET_CONFIRM ) + oGet:ExitState := GE_ENTER + ENDIF + ENDIF + ENDIF + ENDIF + ENDCASE + + RETURN Self + +METHOD GetPreValidate( oGet, aMsg ) CLASS HBGetList + + LOCAL lUpdated + LOCAL lWhen := .T. + LOCAL xValue + + DEFAULT oGet TO ::oGet + + IF oGet:PreBlock != NIL xValue := oGet:VarGet() lUpdated := ::lUpdated - lWhen := Eval( oGet:PreBlock, oGet ) + lWhen := Eval( oGet:PreBlock, oGet, aMsg ) - if !( ValType( xValue ) == ValType( oGet:VarGet() ) ) .or.; + IF !( ValType( xValue ) == ValType( oGet:VarGet() ) ) .OR.; !( oGet:VarGet() == xValue ) oGet:VarPut( oGet:VarGet() ) - else + ELSE oGet:Display() - endif + ENDIF ::ShowScoreBoard() ::lUpdated := lUpdated /* - if __GetListActive() != Self + IF __GetListActive() != Self __GetListSetActive( Self ) - endif + ENDIF */ __GetListLast( Self ) - endif + ENDIF - if ::lKillRead + IF ::lKillRead lWhen := .F. oGet:ExitState := GE_ESCAPE - elseif ! lWhen + ELSEIF ! lWhen oGet:ExitState := GE_WHEN - else + ELSE oGet:ExitState := GE_NOEXIT - endif + ENDIF - return lWhen + RETURN lWhen -METHOD GetPostValidate() CLASS HBGetList +METHOD GetPostValidate( oGet, aMsg ) CLASS HBGetList - local oGet := ::oGet - local lUpdated - local lValid := .T. - local xValue + LOCAL lUpdated + LOCAL lValid := .T. + LOCAL xValue - if oGet:ExitState == GE_ESCAPE - return .T. - endif + DEFAULT oGet TO ::oGet - if oGet:BadDate + IF oGet:ExitState == GE_ESCAPE + RETURN .T. + ENDIF + + IF oGet:BadDate oGet:home() ::DateMsg() ::ShowScoreboard() - return .F. - endif + RETURN .F. + ENDIF - if oGet:Changed + IF oGet:Changed oGet:Assign() ::lUpdated := .T. - endif + ENDIF oGet:Reset():Display() - if oGet:PostBlock != NIL + IF oGet:PostBlock != NIL xValue := oGet:VarGet() lUpdated := ::lUpdated SetPos( oGet:Row, oGet:Col + iif( oGet:Buffer == NIL, 0, Len( oGet:Buffer ) ) ) - lValid := Eval( oGet:PostBlock, oGet ) + lValid := Eval( oGet:PostBlock, oGet, aMsg ) SetPos( oGet:Row, oGet:Col ) - if !( ValType( xValue ) == ValType( oGet:VarGet() ) ) .or.; + IF !( ValType( xValue ) == ValType( oGet:VarGet() ) ) .OR. ; !( oGet:VarGet() == xValue ) oGet:VarPut( oGet:VarGet() ) - endif + ENDIF oGet:UpdateBuffer() ::ShowScoreBoard() @@ -445,38 +508,40 @@ METHOD GetPostValidate() CLASS HBGetList ::lUpdated := lUpdated /* - if __GetListActive() != Self + IF __GetListActive() != Self __GetListSetActive( Self ) - endif + ENDIF */ __GetListLast( Self ) - if ::lKillRead + IF ::lKillRead oGet:ExitState := GE_ESCAPE lValid := .T. - endif - endif + ENDIF + ENDIF - return lValid + RETURN lValid METHOD GetDoSetKey( bKeyBlock ) CLASS HBGetList - local oGet := ::oGet, lUpdated, xValue + LOCAL oGet := ::oGet + LOCAL lUpdated + LOCAL xValue - if oGet:Changed + IF oGet:Changed oGet:Assign() ::lUpdated := .T. - endif + ENDIF xValue := oGet:VarGet() lUpdated := ::lUpdated Eval( bKeyBlock, ::cReadProcName, ::nReadProcLine, ::ReadVar() ) - if !( ValType( xValue ) == ValType( oGet:VarGet() ) ) .or.; + IF !( ValType( xValue ) == ValType( oGet:VarGet() ) ) .OR.; !( oGet:VarGet() == xValue ) oGet:VarPut( oGet:VarGet() ) - endif + ENDIF ::ShowScoreboard() oGet:UpdateBuffer() @@ -484,103 +549,104 @@ METHOD GetDoSetKey( bKeyBlock ) CLASS HBGetList ::lUpdated := lUpdated /* - if __GetListActive() != Self + IF __GetListActive() != Self __GetListSetActive( Self ) - endif + ENDIF */ __GetListLast( Self ) - if ::lKillRead + IF ::lKillRead oGet:ExitState := GE_ESCAPE - endif + ENDIF - return Self + RETURN Self -METHOD Settle( nPos ) CLASS HBGetList +METHOD Settle( nPos, lInit ) CLASS HBGetList - local nExitState + LOCAL nExitState - if nPos == NIL - nPos := ::nPos - endif + DEFAULT nPos TO ::nPos + DEFAULT lInit TO .F. - if nPos == 0 + IF nPos == 0 nExitState := GE_DOWN - else + ELSEIF nPos > 0 .AND. lInit /* NOTE: Never .T. in C5.2 mode. */ + nExitState := GE_NOEXIT + ELSE nExitState := ::aGetList[ nPos ]:ExitState - endif + ENDIF - if nExitState == GE_ESCAPE .or. nExitState == GE_WRITE - return 0 - endif + IF nExitState == GE_ESCAPE .OR. nExitState == GE_WRITE + RETURN 0 + ENDIF - if nExitState != GE_WHEN + IF nExitState != GE_WHEN ::nLastPos := nPos ::lBumpTop := .F. ::lBumpBot := .F. - else - if ::nLastExitState != 0 + ELSE + IF ::nLastExitState != 0 nExitState := ::nLastExitState - elseif ::nNextGet < ::nLastPos + ELSEIF ::nNextGet < ::nLastPos nExitState := GE_UP - else + ELSE nExitState := GE_DOWN - endif + ENDIF - endif + ENDIF - do case - case nExitState == GE_UP + DO CASE + CASE nExitState == GE_UP nPos-- - case nExitState == GE_DOWN + CASE nExitState == GE_DOWN nPos++ - case nExitState == GE_TOP + CASE nExitState == GE_TOP nPos := 1 ::lBumpTop := .T. nExitState := GE_DOWN - case nExitState == GE_BOTTOM + CASE nExitState == GE_BOTTOM nPos := Len( ::aGetList ) ::lBumpBot := .T. nExitState := GE_UP - case nExitState == GE_ENTER + CASE nExitState == GE_ENTER nPos++ - case nExitState == GE_SHORTCUT - return ::nNextGet + CASE nExitState == GE_SHORTCUT + RETURN ::nNextGet - case nExitState == GE_MOUSEHIT - return ::nNextGet + CASE nExitState == GE_MOUSEHIT + RETURN ::nNextGet - endcase + ENDCASE - if nPos == 0 - if ! ::ReadExit() .and. ! ::lBumpBot + IF nPos == 0 + IF ! ::ReadExit() .AND. ! ::lBumpBot ::lBumpTop := .T. nPos := ::nLastPos nExitState := GE_DOWN - endif + ENDIF - elseif nPos == Len( ::aGetList ) + 1 - if ! ::ReadExit() .and. nExitState != GE_ENTER .and. ! ::lBumpTop + ELSEIF nPos == Len( ::aGetList ) + 1 + IF ! ::ReadExit() .AND. nExitState != GE_ENTER .AND. ! ::lBumpTop ::lBumpBot := .T. nPos := ::nLastPos nExitState := GE_UP - else + ELSE nPos := 0 - endif - endif + ENDIF + ENDIF ::nLastExitState := nExitState - if nPos != 0 + IF nPos != 0 ::aGetList[ nPos ]:ExitState := nExitState - endif + ENDIF - return nPos + RETURN nPos METHOD PostActiveGet() CLASS HBGetList @@ -588,55 +654,57 @@ METHOD PostActiveGet() CLASS HBGetList ::ReadVar( ::GetReadVar() ) ::ShowScoreBoard() - return Self + RETURN Self METHOD GetReadVar() CLASS HBGetList - local oGet := ::oGet - local cName := Upper( oGet:Name ) - local n + LOCAL oGet := ::oGet + LOCAL cName := Upper( oGet:Name ) + LOCAL n - if oGet:Subscript != NIL - for n := 1 TO Len( oGet:Subscript ) + IF oGet:Subscript != NIL + FOR n := 1 TO Len( oGet:Subscript ) cName += "[" + LTrim( Str( oGet:Subscript[ n ] ) ) + "]" - next - endif + NEXT + ENDIF - return cName + RETURN cName METHOD SetFormat( bFormat ) CLASS HBGetList - local bSavFormat := ::bFormat + LOCAL bSavFormat := ::bFormat ::bFormat := bFormat - return bSavFormat + RETURN bSavFormat METHOD KillRead( lKill ) CLASS HBGetList - local lSavKill := ::lKillRead + LOCAL lSavKill := ::lKillRead - if PCount() > 0 + IF PCount() > 0 ::lKillRead := lKill - endif + ENDIF - return lSavKill + RETURN lSavKill METHOD GetActive( oGet ) CLASS HBGetList - local oOldGet := ::oActiveGet + LOCAL oOldGet := ::oActiveGet - if PCount() > 0 + IF PCount() > 0 ::oActiveGet := oGet - endif + ENDIF - return oOldGet + RETURN oOldGet METHOD ShowScoreboard() CLASS HBGetList - local nRow, nCol, nOldCursor + LOCAL nRow + LOCAL nCol + LOCAL nOldCursor - if Set( _SET_SCOREBOARD ) + IF Set( _SET_SCOREBOARD ) nRow := Row() nCol := Col() @@ -648,16 +716,16 @@ METHOD ShowScoreboard() CLASS HBGetList SetCursor( nOldCursor ) - endif + ENDIF - return Self + RETURN Self METHOD DateMsg() CLASS HBGetList - local nRow - local nCol + LOCAL nRow + LOCAL nCol - if Set( _SET_SCOREBOARD ) + IF Set( _SET_SCOREBOARD ) nRow := Row() nCol := Col() @@ -665,288 +733,347 @@ METHOD DateMsg() CLASS HBGetList DispOutAt( SCORE_ROW, SCORE_COL, NationMsg( _GET_INVD_DATE ) ) SetPos( nRow, nCol ) - do while NextKey() == 0 - enddo + DO WHILE NextKey() == 0 + ENDDO DispOutAt( SCORE_ROW, SCORE_COL, Space( Len( NationMsg( _GET_INVD_DATE ) ) ) ) SetPos( nRow, nCol ) - endif + ENDIF - return Self + RETURN Self METHOD ReadVar( cNewVarName ) CLASS HBGetList - local cOldName := ::cVarName + LOCAL cOldName := ::cVarName - if ISCHARACTER( cNewVarName ) + IF ISCHARACTER( cNewVarName ) ::cVarName := cNewVarName - endif + ENDIF - return cOldName + RETURN cOldName METHOD ReadUpdated( lUpdated ) CLASS HBGetList - local lSavUpdated := ::lUpdated + LOCAL lSavUpdated := ::lUpdated - if PCount() > 0 + IF PCount() > 0 ::lUpdated := lUpdated - endif + ENDIF - return lSavUpdated + RETURN lSavUpdated #ifdef HB_COMPAT_C53 METHOD GUIReader( oGet, oMenu, aMsg ) CLASS HBGetList + LOCAL oGUI - HB_SYMBOL_UNUSED( oMenu ) - HB_SYMBOL_UNUSED( aMsg ) + IF ::GUIPreValidate( oGet:Control, aMsg ) .AND. ; + ISOBJECT( oGet:Control ) - if ! ::GUIPreValidate( oGet:Control, aMsg ) - - elseif ISOBJECT( oGet:Control ) + ::ShowGetMsg( aMsg ) // Activate the GET for reading oGUI := oGet:Control oGUI:Select( oGet:VarGet() ) oGUI:setFocus() - do while oGet:exitState == GE_NOEXIT .AND. !::lKillRead + DO WHILE oGet:exitState == GE_NOEXIT .AND. !::lKillRead // Check for initial typeout (no editable positions) - if oGUI:typeOut + IF oGUI:typeOut oGet:exitState := GE_ENTER - endif + ENDIF // Apply keystrokes until exit - do while oGet:exitState == GE_NOEXIT .AND. !::lKillRead - ::GUIApplyKey( oGet, oGUI, Inkey( 0 ) ) - enddo + DO WHILE oGet:exitState == GE_NOEXIT .AND. !::lKillRead + ::GUIApplyKey( oGet, oGUI, Inkey( 0 ), oMenu, aMsg ) + + ::ShowGetMsg( aMsg ) + ENDDO // Disallow exit if the VALID condition is not satisfied - if !::GUIPostValidate( oGUI, aMsg ) + IF !::GUIPostValidate( oGUI, aMsg ) oGet:exitState := GE_NOEXIT - endif - enddo + ENDIF + ENDDO // De-activate the GET oGet:VarPut( oGUI:Buffer ) oGUI:killFocus() - if !( oGUI:ClassName() == "LISTBOX" ) - elseif ! oGUI:DropDown - elseif oGUI:IsOpen + ::EraseGetMsg( aMsg ) + + IF oGUI:ClassName() == "LISTBOX" .AND. ; + oGUI:dropDown .AND. ; + oGUI:isOpen + oGUI:Close() - endif + ENDIF - endif + ENDIF - return Self + RETURN Self METHOD GUIApplyKey( oGet, oGUI, nKey, oMenu, aMsg ) CLASS HBGetList - Local bKeyBlock - Local oTheClass - Local nHotItem - Local lClose - Local nMouseRow, nMouseColumn, nButton - HB_SYMBOL_UNUSED( oMenu ) + LOCAL bKeyBlock + LOCAL oTheClass + LOCAL nHotItem + LOCAL lClose + LOCAL nMouseRow + LOCAL nMouseColumn + LOCAL nButton // Check for SET KEY first - if ( bKeyBlock := SetKey( nKey ) ) != NIL + IF ( bKeyBlock := SetKey( nKey ) ) != NIL ::GetDoSetKey( bKeyBlock, oGet ) - endif + ENDIF - if ( nHotItem := ::Accelerator( nKey, aMsg ) ) != 0 + IF ( nHotItem := ::Accelerator( nKey, aMsg ) ) != 0 oGet:ExitState := GE_SHORTCUT - ::nNextGet := nHotItem - endif + ::nNextGet := nHotItem + ELSEIF !ISOBJECT( oMenu ) + ELSEIF ( nHotItem := oMenu:getAccel( nKey ) ) != 0 + ::nMenuID := MenuModal( oMenu, nHotItem, aMsg[ MSGROW ], aMsg[ MSGLEFT ], aMsg[ MSGRIGHT ], aMsg[ MSGCOLOR ] ) + nKey := 0 + ELSEIF IsShortCut( oMenu, nKey ) + nKey := 0 + ENDIF - if nKey == 0 - elseif ( oTheClass := oGUI:ClassName() ) == "RADIOGROUP" - if nKey == K_UP + IF nKey == 0 + ELSEIF ( oTheClass := oGUI:ClassName() ) == "RADIOGROUP" + IF nKey == K_UP oGUI:PrevItem() nKey := 0 - elseif nKey == K_DOWN + ELSEIF nKey == K_DOWN oGUI:NextItem() nKey := 0 - elseif ( nHotItem := oGUI:GetAccel( nKey ) ) != 0 + ELSEIF ( nHotItem := oGUI:GetAccel( nKey ) ) != 0 oGUI:Select( nHotItem ) - endif + ENDIF - if ISNUMBER( oGet:VarGet() ) + IF ISNUMBER( oGet:VarGet() ) oGet:VarPut( oGUI:Value ) - endif + ENDIF - elseif oTheClass == "CHECKBOX" - if nKey == K_SPACE + ELSEIF oTheClass == "CHECKBOX" + IF nKey == K_SPACE oGUI:Select() - endif + ENDIF - elseif oTheClass == "PUSHBUTTON" - if nKey == K_SPACE + ELSEIF oTheClass == "PUSHBUTTON" + IF nKey == K_SPACE oGUI:Select( K_SPACE ) - elseif nKey == K_ENTER + ELSEIF nKey == K_ENTER oGUI:Select() nKey := 0 - endif + ENDIF - elseif oTheClass == "LISTBOX" - if nKey == K_UP + ELSEIF oTheClass == "LISTBOX" + IF nKey == K_UP oGUI:PrevItem() nKey := 0 - elseif nKey == K_DOWN + ELSEIF nKey == K_DOWN oGUI:NextItem() nKey := 0 - elseif nKey == K_SPACE - if ! oGUI:DropDown - elseif ! oGUI:IsOpen + ELSEIF nKey == K_SPACE + IF ! oGUI:DropDown + ELSEIF ! oGUI:IsOpen oGUI:Open() nKey := 0 - endif + ENDIF - elseif ( nButton := oGUI:FindText( chr(nKey), oGUI:Value+1, .F., .F. ) ) != 0 + ELSEIF ( nButton := oGUI:FindText( chr(nKey), oGUI:Value+1, .F., .F. ) ) != 0 oGUI:Select( nButton ) - endif + ENDIF - if ISNUMBER( oGet:VarGet() ) + IF ISNUMBER( oGet:VarGet() ) oGet:VarPut( oGUI:Value ) - endif + ENDIF - endif + ENDIF - do case - case nKey == K_UP + DO CASE + CASE nKey == K_UP oGet:ExitState := GE_UP - case nKey == K_SH_TAB + CASE nKey == K_SH_TAB oGet:ExitState := GE_UP - case nKey == K_DOWN + CASE nKey == K_DOWN oGet:ExitState := GE_DOWN - case nKey == K_TAB + CASE nKey == K_TAB oGet:ExitState := GE_DOWN - case nKey == K_ENTER + CASE nKey == K_ENTER oGet:ExitState := GE_ENTER - case nKey == K_ESC - if set( _SET_ESCAPE ) + CASE nKey == K_ESC + IF set( _SET_ESCAPE ) oGet:ExitState := GE_ESCAPE - endif + ENDIF - case nKey == K_PGUP + CASE nKey == K_PGUP oGet:ExitState := GE_WRITE - case nKey == K_PGDN + CASE nKey == K_PGDN oGet:ExitState := GE_WRITE - case nKey == K_CTRL_HOME + CASE nKey == K_CTRL_HOME oGet:ExitState := GE_TOP #ifdef CTRL_END_SPECIAL // Both ^W and ^End go to the last GET - case nKey == K_CTRL_END + CASE nKey == K_CTRL_END oGet:ExitState := GE_BOTTOM #else // Both ^W and ^End terminate the READ (the default) - case nKey == K_CTRL_W + CASE nKey == K_CTRL_W oGet:ExitState := GE_WRITE #endif - case nKey == K_LBUTTONDOWN .or. nKey == K_LDBLCLK + CASE nKey == K_LBUTTONDOWN .OR. nKey == K_LDBLCLK nMouseRow := mROW() nMouseColumn := mCOL() lClose := .T. nButton:=0 - if ( nButton := oGUI:HitTest( nMouseRow, nMouseColumn ) ) == HTNOWHERE + IF ( nButton := oGUI:HitTest( nMouseRow, nMouseColumn ) ) == HTNOWHERE // Changed test: - if ::HitTest( nMouseRow, nMouseColumn ) != 0 + IF ::HitTest( nMouseRow, nMouseColumn ) != 0 oGet:ExitState := GE_MOUSEHIT ::nLastExitState := GE_MOUSEHIT - else + ELSE oGet:ExitState := GE_NOEXIT - endif + ENDIF - elseif nButton >= HTCLIENT + ELSEIF nButton >= HTCLIENT oGUI:Select( nButton ) - elseif nButton == HTDROPBUTTON - if !oGUI:IsOpen + ELSEIF nButton == HTDROPBUTTON + IF !oGUI:IsOpen oGUI:Open() lClose := .F. - endif + ENDIF - elseif nButton >= HTSCROLLFIRST .and. nButton <= HTSCROLLLAST + ELSEIF nButton >= HTSCROLLFIRST .AND. nButton <= HTSCROLLLAST oGUI:Scroll( nButton ) lClose := .F. - endif + ENDIF - if ! lClose - elseif ! oTheClass == "LISTBOX" - elseif ! oGUI:DropDown - elseif oGUI:IsOpen + IF ! lClose + ELSEIF ! oTheClass == "LISTBOX" + ELSEIF ! oGUI:DropDown + ELSEIF oGUI:IsOpen oGUI:Close() oGUI:Display() - endif + ENDIF - endcase + ENDCASE - return Self + RETURN Self + +METHOD GUIPreValidate( oGUI, aMsg ) CLASS HBGetList + + LOCAL oGet := ::oGet + LOCAL lUpdated + LOCAL lWhen := .T. + LOCAL xValue + + IF oGet:preBlock != NIL + + xValue := oGet:VarGet() + lUpdated := ::lUpdated + + lWhen := Eval( oGet:preBlock, oGet, aMsg ) + + IF !( ValType( xValue ) == ValType( oGet:VarGet() ) ) .OR.; + !( oGet:VarGet() == xValue ) + oGet:VarPut( oGet:VarGet() ) + ELSEIF !( oGUI:ClassName() == "TBROWSE" ) + oGet:Display() + ENDIF + + ::ShowScoreBoard() + + ::lUpdated := lUpdated + +/* + IF __GetListActive() != Self + __GetListSetActive( Self ) + ENDIF +*/ + __GetListLast( Self ) + ENDIF + + IF ::lKillRead + lWhen := .F. + oGet:ExitState := GE_ESCAPE + + ELSEIF !lWhen + oGet:ExitState := GE_WHEN + + ELSE + oGet:ExitState := GE_NOEXIT + + ENDIF + + RETURN lWhen METHOD GUIPostValidate( oGUI, aMsg ) CLASS HBGetList - Local oGet := ::oGet - Local lUpdated - Local lValid := .T. - Local xValue - if oGet:exitState == GE_ESCAPE - return .T. // NOTE - endif + LOCAL oGet := ::oGet + LOCAL lUpdated + LOCAL lValid := .T. + LOCAL xValue - if oGet:BadDate + IF oGet:exitState == GE_ESCAPE + RETURN .T. // NOTE + ENDIF + + IF oGet:BadDate oGet:home() ::DateMsg() ::ShowScoreboard() - return .F. - endif + RETURN .F. + ENDIF - if oGet:Changed + IF oGet:Changed oGet:UpdateBuffer() ::lUpdated := .T. - endif + ENDIF oGet:Reset():Display() /* // If editing occurred, assign the new value to the variable - if !( uOldData == uNewData ) + IF !( uOldData == uNewData ) oGet:VarPut( uNewData ) ::lUpdated := .T. - endif + ENDIF */ // Check VALID condition if specified - if oGet:postBlock != NIL + IF oGet:postBlock != NIL xValue := oGet:VarGet() lUpdated := ::lUpdated @@ -956,164 +1083,127 @@ METHOD GUIPostValidate( oGUI, aMsg ) CLASS HBGetList // Reset S'87 compatibility cursor position SetPos( oGet:Row, oGet:Col ) - if !( ValType( xValue ) == ValType( oGet:VarGet() ) ) .or.; + IF !( ValType( xValue ) == ValType( oGet:VarGet() ) ) .OR.; !( oGet:VarGet() == xValue ) oGet:VarPut( oGet:VarGet() ) - endif + ENDIF oGet:UpdateBuffer() ::ShowScoreBoard() - if ! ( oGUI:ClassName == "TBROWSE" ) + IF ! ( oGUI:ClassName == "TBROWSE" ) oGUI:Select( oGet:VarGet() ) - endif + ENDIF ::lUpdated := lUpdated /* - if __GetListActive() != Self + IF __GetListActive() != Self __GetListSetActive( Self ) - endif + ENDIF */ __GetListLast( Self ) - if ::lKillRead + IF ::lKillRead oGet:ExitState := GE_ESCAPE // Provokes ReadModal() exit lValid := .T. - endif + ENDIF - endif + ENDIF - return lValid + RETURN lValid -METHOD GUIPreValidate( oGUI, aMsg ) CLASS HBGetList - Local oGet := ::oGet - Local lUpdated - Local lWhen := .T. - Local xValue +METHOD TBApplyKey( oGet, oTB, nKey, oMenu, aMsg ) CLASS HBGetList - HB_SYMBOL_UNUSED( oGUI ) - - if oGet:preBlock != NIL - - xValue := oGet:VarGet() - lUpdated := ::lUpdated - - lWhen := Eval( oGet:preBlock, oGet, aMsg ) - - if !( ValType( xValue ) == ValType( oGet:VarGet() ) ) .or.; - !( oGet:VarGet() == xValue ) - oGet:VarPut( oGet:VarGet() ) - else - oGet:Display() - endif - - ::ShowScoreBoard() - - ::lUpdated := lUpdated - -/* - if __GetListActive() != Self - __GetListSetActive( Self ) - endif -*/ - __GetListLast( Self ) - endif - - if ::lKillRead - lWhen := .F. - oGet:ExitState := GE_ESCAPE - - elseif !lWhen - oGet:ExitState := GE_WHEN - - else - oGet:ExitState := GE_NOEXIT - - endif - - return lWhen - -METHOD TBApplyKey( oGet, oTB, nKey, aMsg ) CLASS HBGetList - - Local bKeyBlock - Local nMouseRow, nMouseColumn - Local nButton - Local nHotItem - Local lSetKey + LOCAL bKeyBlock + LOCAL nMouseRow + LOCAL nMouseColumn + LOCAL nButton + LOCAL nHotItem + LOCAL lSetKey // Check for SET KEY first - if ( bKeyBlock := SETKEY( nKey ) ) != NIL - if lSetKey := ::GetDoSetKey( bKeyBlock, oGet ) - return Self - endif - endif + IF ( bKeyBlock := SetKey( nKey ) ) != NIL + IF lSetKey := ::GetDoSetKey( bKeyBlock, oGet ) + RETURN Self + ENDIF + ENDIF - if ( nHotItem := ::Accelerator( nKey, aMsg ) ) != 0 + IF ( nHotItem := ::Accelerator( nKey, aMsg ) ) != 0 oGet:ExitState := GE_SHORTCUT - endif + ::nNextGet := nHotItem + ELSEIF !ISOBJECT( oMenu ) + ELSEIF ( nHotItem := oMenu:getAccel( nKey ) ) != 0 + ::nMenuID := MenuModal( oMenu, nHotItem, aMsg[ MSGROW ], aMsg[ MSGLEFT ], aMsg[ MSGRIGHT ], aMsg[ MSGCOLOR ] ) + nKey := 0 + ELSEIF IsShortCut( oMenu, nKey ) + nKey := 0 + ENDIF - do case - case nKey == K_TAB + DO CASE + CASE nKey == K_TAB oGet:ExitState := GE_DOWN - case nKey == K_SH_TAB + CASE nKey == K_SH_TAB oGet:ExitState := GE_UP - case nKey == K_ENTER - if !oTb:Stable() + CASE nKey == K_ENTER + IF !oTb:Stable() oTb:ForceStable() - endif + ENDIF oGet:ExitState := GE_ENTER - case nKey == K_ESC - if set( _SET_ESCAPE ) + CASE nKey == K_ESC + IF set( _SET_ESCAPE ) oGet:ExitState := GE_ESCAPE - endif + ENDIF #ifdef CTRL_END_SPECIAL // Both ^W and ^End go to the last GET - case nKey == K_CTRL_END + CASE nKey == K_CTRL_END oGet:ExitState := GE_BOTTOM #else // Both ^W and ^End terminate the READ (the default) - case nKey == K_CTRL_W + CASE nKey == K_CTRL_W oGet:ExitState := GE_WRITE #endif - case nKey == K_LBUTTONDOWN .or. nKey == K_LDBLCLK - nMouseRow := mROW() - nMouseColumn := mCOL() + CASE nKey == K_LBUTTONDOWN .OR. nKey == K_LDBLCLK + nMouseRow := MRow() + nMouseColumn := MCol() nButton := 0 - if ( nButton := oTB:HitTest( nMouseRow, nMouseColumn ) ) == HTNOWHERE - if ::HitTest( nMouseRow, nMouseColumn, aMsg ) != 0 + IF ( nButton := oTB:HitTest( nMouseRow, nMouseColumn ) ) == HTNOWHERE + IF ::HitTest( nMouseRow, nMouseColumn, aMsg ) != 0 oGet:ExitState := GE_MOUSEHIT - else + ELSE oGet:ExitState := GE_NOEXIT - endif - endif + ENDIF + ENDIF - endcase + ENDCASE - return self + RETURN Self METHOD TBReader( oGet, oMenu, aMsg ) CLASS HBGetList - Local oTB, nKey, lAutoLite, nSaveCursor, nProcessed -// Local oGUI := oGet:control - HB_SYMBOL_UNUSED( oMenu ) + LOCAL oTB + LOCAL nKey + LOCAL lAutoLite + LOCAL nSaveCursor + LOCAL nProcessed +// LOCAL oGUI := oGet:control // Read the GET if the WHEN condition is satisfied - if ISOBJECT( oGet:control ) .AND. ; + IF ISOBJECT( oGet:control ) .AND. ; ::nLastExitState == GE_SHORTCUT .OR. ; ::nLastExitState == GE_MOUSEHIT .OR. ; ::GetPreValidate( oGet, aMsg ) -// ShowGetMsg( oGet, aMsg ) + ::ShowGetMsg( aMsg ) ::nLastExitState := 0 nSaveCursor := SetCursor( SC_NONE ) @@ -1125,205 +1215,256 @@ METHOD TBReader( oGet, oMenu, aMsg ) CLASS HBGetList oTB:Autolite := .T. oTB:Hilite() - if oGet:exitState == GE_NOEXIT - if ::nHitcode == HTCELL + IF oGet:exitState == GE_NOEXIT + IF ::nHitcode == HTCELL // Replaces call to TBMouse( oTB, mROW(), mCOL() ): oTB:RowPos := oTb:mRowPos oTB:ColPos := oTb:mColPos oTB:Invalidate() - endif - endif + ENDIF + ENDIF ::nHitcode := 0 - do while oGet:exitState == GE_NOEXIT .AND. !::lKillRead + DO WHILE oGet:exitState == GE_NOEXIT .AND. !::lKillRead // Apply keystrokes until exit - do while oGet:exitState == GE_NOEXIT .AND. !::lKillRead + DO WHILE oGet:exitState == GE_NOEXIT .AND. !::lKillRead nKey := 0 - do while !oTB:Stabilize() .and. nKey == 0 + DO WHILE !oTB:Stabilize() .AND. nKey == 0 nKey := Inkey() - enddo + ENDDO - if nKey == 0 + IF nKey == 0 nKey := Inkey(0) - endif + ENDIF nProcessed := oTB:ApplyKey( nKey ) - if nProcessed == TBR_EXIT + IF nProcessed == TBR_EXIT oGet:exitState := GE_ESCAPE - exit + EXIT - elseif nProcessed == TBR_EXCEPTION - ::TBApplyKey( oGet, oTB, nKey, aMsg ) + ELSEIF nProcessed == TBR_EXCEPTION + ::TBApplyKey( oGet, oTB, nKey, oMenu, aMsg ) - // nRow := ROW() // Commented out. - // nCol := COL() // Commented out. - // ShowGetMsg( oGet, aMsg ) - // SetPos( nRow, nCol ) // Commented out. + ::ShowGetMsg( aMsg ) - endif + ENDIF - enddo + ENDDO // Disallow exit if the VALID condition is not satisfied - if ::nLastExitState == GE_SHORTCUT - elseif ::nLastExitState == GE_MOUSEHIT - elseif !::GetPostValidate( oGet, aMsg ) + IF ::nLastExitState == GE_SHORTCUT + ELSEIF ::nLastExitState == GE_MOUSEHIT + ELSEIF !::GetPostValidate( oGet, aMsg ) oGet:ExitState := GE_NOEXIT - endif + ENDIF - enddo + ENDDO // De-activate the GET oTB:Autolite := lAutoLite oTB:DeHilite() - SetCursor( nSaveCursor ) - endif + ::EraseGetMsg( aMsg ) - return Self + SetCursor( nSaveCursor ) + ENDIF + + RETURN Self METHOD Accelerator( nKey, aMsg ) CLASS HBGetList - local nGet, oGet, nHotPos, cKey, cCaption, nStart, nEnd - local nIteration, lGUI + LOCAL nGet + LOCAL oGet + LOCAL nHotPos + LOCAL cKey + LOCAL cCaption + LOCAL nStart + LOCAL nEnd + LOCAL nIteration + LOCAL lGUI - HB_SYMBOL_UNUSED( aMsg ) - - if nKey >= K_ALT_Q .and. nKey <= K_ALT_P + IF nKey >= K_ALT_Q .AND. nKey <= K_ALT_P cKey := substr( "qwertyuiop", nKey - K_ALT_Q + 1, 1 ) - elseif nKey >= K_ALT_A .and. nKey <= K_ALT_L + ELSEIF nKey >= K_ALT_A .AND. nKey <= K_ALT_L cKey := substr( "asdfghjkl", nKey - K_ALT_A + 1, 1 ) - elseif nKey >= K_ALT_Z .and. nKey <= K_ALT_M + ELSEIF nKey >= K_ALT_Z .AND. nKey <= K_ALT_M cKey := substr( "zxcvbnm", nKey - K_ALT_Z + 1, 1 ) - elseif nKey >= K_ALT_1 .and. nKey <= K_ALT_0 + ELSEIF nKey >= K_ALT_1 .AND. nKey <= K_ALT_0 cKey := substr( "1234567890", nKey - K_ALT_1 + 1, 1 ) - else - return 0 + ELSE + RETURN 0 - endif + ENDIF nStart := ::nPos + 1 nEnd := len( ::aGetList ) - for nIteration := 1 to 2 - for nGet := nStart to nEnd + FOR nIteration := 1 TO 2 + FOR nGet := nStart TO nEnd - oGet := ::aGetList[ nGet ] + oGet := ::aGetList[ nGet ] - if ISOBJECT( oGet:Control ) .and. ; - !( oGet:Control:ClassName() == "TBROWSE" ) + IF ISOBJECT( oGet:Control ) .AND. ; + !( oGet:Control:ClassName() == "TBROWSE" ) - cCaption := oGet:Control:Caption - else - cCaption := oGet:Caption - endif + cCaption := oGet:Control:Caption + ELSE + cCaption := oGet:Caption + ENDIF - if ( nHotPos := at( "&", cCaption ) ) == 0 + IF ( nHotPos := at( "&", cCaption ) ) == 0 - elseif nHotPos == len( cCaption ) + ELSEIF nHotPos == len( cCaption ) - elseif lower( substr( cCaption, nHotPos + 1, 1 ) ) == cKey + ELSEIF lower( substr( cCaption, nHotPos + 1, 1 ) ) == cKey - // Test the current GUI-GET or Get PostValidation: - lGUI := ISOBJECT( ::aGetList[ ::nPos ]:Control ) + // Test the current GUI-GET or Get PostValidation: + lGUI := ISOBJECT( ::aGetList[ ::nPos ]:Control ) - if lGUI .and. !::GUIPostValidate( ::aGetList[ ::nPos ]:Control, aMsg ) - return 0 + IF lGUI .AND. !::GUIPostValidate( ::aGetList[ ::nPos ]:Control, aMsg ) + RETURN 0 - elseif !lGUI .and. !::GetPostValidate( ::aGetList[ ::nPos ], aMsg ) - return 0 + ELSEIF !lGUI .AND. !::GetPostValidate( ::aGetList[ ::nPos ], aMsg ) + RETURN 0 - endif + ENDIF - // Test the next GUI-GET or Get PreValidation: - lGUI := ISOBJECT( oGet:Control ) + // Test the next GUI-GET or Get PreValidation: + lGUI := ISOBJECT( oGet:Control ) - if lGUI .and. !::GUIPreValidate( oGet:Control, aMsg ) - // return 0 // Commented out. - return nGet // Changed. + IF lGUI .AND. !::GUIPreValidate( oGet:Control, aMsg ) + // RETURN 0 // Commented out. + RETURN nGet // Changed. - elseif !lGUI .and. !::GetPreValidate( oGet, aMsg ) - // return 0 // Commented out. - return nGet // Changed. + ELSEIF !lGUI .AND. !::GetPreValidate( oGet, aMsg ) + // RETURN 0 // Commented out. + RETURN nGet // Changed. - endif + ENDIF - return nGet - endif - next + RETURN nGet + ENDIF + NEXT - nStart := 1 - nEnd := ::nPos - 1 - next + nStart := 1 + nEnd := ::nPos - 1 + NEXT - return 0 + RETURN 0 METHOD HitTest( nMouseRow, nMouseCol, aMsg ) CLASS HBGetList - Local nCount, nTotal, lGUI + + LOCAL nCount + LOCAL nTotal + LOCAL lGUI ::nNextGet := 0 - nTotal := len( ::aGetList ) + nTotal := Len( ::aGetList ) - for nCount := 1 to nTotal - if ( ::nHitCode := ::aGetList[ nCount ]:HitTest( nMouseRow, nMouseCol ) ) != HTNOWHERE + FOR nCount := 1 TO nTotal + IF ( ::nHitCode := ::aGetList[ nCount ]:HitTest( nMouseRow, nMouseCol ) ) != HTNOWHERE ::nNextGet := nCount - exit - endif - next + EXIT + ENDIF + NEXT - // do while ::nNextGet != 0 // Commented out. + // DO WHILE ::nNextGet != 0 // Commented out. - if ::nNextGet != 0 // Changed. + IF ::nNextGet != 0 // Changed. // Test the current GUI-GET or Get PostValidation: lGUI := ISOBJECT( ::aGetList[ ::nPos ]:Control ) - if lGUI .and. !::GUIPostValidate( ::aGetList[ ::nPos ]:Control, aMsg ) + IF lGUI .AND. !::GUIPostValidate( ::aGetList[ ::nPos ]:Control, aMsg ) ::nNextGet := 0 - // exit // Commented out. - return 0 // Changed. + // EXIT // Commented out. + RETURN 0 // Changed. - elseif !lGUI .and. !::GetPostValidate( ::aGetList[ ::nPos ], aMsg ) + ELSEIF !lGUI .AND. !::GetPostValidate( ::aGetList[ ::nPos ], aMsg ) ::nNextGet := 0 - // exit // Commented out. - return 0 // Changed. + // EXIT // Commented out. + RETURN 0 // Changed. - endif + ENDIF // Test the next GUI-GET or Get PreValidation: lGUI := ISOBJECT( ::aGetList[ ::nNextGet ]:Control ) - if lGUI .and. !::GUIPreValidate( ::aGetList[ ::nNextGet ]:Control, aMsg ) + IF lGUI .AND. !::GUIPreValidate( ::aGetList[ ::nNextGet ]:Control, aMsg ) ::nNextGet := 0 - // exit // Commented out. - return ::nNextGet // Changed. + // EXIT // Commented out. + RETURN ::nNextGet // Changed. - elseif !lGUI .and. !::GetPreValidate( ::aGetList[ ::nNextGet ], aMsg ) + ELSEIF !lGUI .AND. !::GetPreValidate( ::aGetList[ ::nNextGet ], aMsg ) ::nNextGet := 0 - // exit // Commented out. - return ::nNextGet // Changed. + // EXIT // Commented out. + RETURN ::nNextGet // Changed. - endif + ENDIF - // exit // Commented out. - return ::nNextGet // Changed. - // enddo // Commented out. + // EXIT // Commented out. + RETURN ::nNextGet // Changed. + // ENDDO // Commented out. - endif // Changed. + ENDIF - // return ::nNextGet != 0 // Commented out. - return 0 // Changed. + // RETURN ::nNextGet != 0 // Commented out. + RETURN 0 + +METHOD ShowGetMsg( aMsg ) CLASS HBGetList + +#ifdef HB_COMPAT_C53 + LOCAL oGet + LOCAL cMsg + LOCAL lMOldState + + IF !Empty( aMsg ) .AND. aMsg[ MSGFLAG ] + + oGet := ::oGet + cMsg := iif( ISOBJECT( oGet:control ), oGet:control:message, oGet:message ) + + IF !Empty( cMsg ) + lMOldState := MSetCursor( .F. ) + DispOutAt( aMsg[ MSGROW ], aMsg[ MSGLEFT ], PadC( cMsg, aMsg[ MSGRIGHT ] - aMsg[ MSGLEFT ] + 1 ), aMsg[ MSGCOLOR ] ) + MSetCursor( lMOldState ) + ENDIF + ENDIF +#else + HB_SYMBOL_UNUSED( aMsg ) +#endif + + RETURN NIL + +METHOD EraseGetMsg( aMsg ) CLASS HBGetList + +#ifdef HB_COMPAT_C53 + LOCAL nRow := Row() + LOCAL nCol := Col() + LOCAL lMOldState + + IF !Empty( aMsg ) .AND. aMsg[ MSGFLAG ] + lMOldState := MSetCursor( .F. ) + RestScreen( aMsg[ MSGROW ], aMsg[ MSGLEFT ], aMsg[ MSGROW ], aMsg[ MSGRIGHT ], ::cMsgSaveS ) + MSetCursor( lMOldState ) + ENDIF + + SetPos( nRow, nCol ) +#else + HB_SYMBOL_UNUSED( aMsg ) +#endif + + RETURN NIL #endif @@ -1335,4 +1476,4 @@ METHOD New( GetList ) CLASS HBGetList ::oGet := GetList[ 1 ] ENDIF - return Self + RETURN Self diff --git a/harbour/source/rtl/tmenusys.prg b/harbour/source/rtl/tmenusys.prg index 1e36d3a36c..3d1f9fc544 100644 --- a/harbour/source/rtl/tmenusys.prg +++ b/harbour/source/rtl/tmenusys.prg @@ -145,12 +145,12 @@ METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList ) CLA ENDIF - oTopMenu:Select( nSelection ) + oTopMenu:select( nSelection ) - IF !( oTopMenu:ClassName() == "TOPBARMENU" ) .AND. !oTopMenu:IsOpen - oTopMenu:Open() + IF !( oTopMenu:ClassName() == "TOPBARMENU" ) .AND. !oTopMenu:isOpen + oTopMenu:open() ELSE - oTopMenu:Display() + oTopMenu:display() ENDIF IF nSelection <= 0 @@ -176,12 +176,12 @@ METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList ) CLA ENDDO - oTopMenu:Select( nSelection ) - oTopMenu:Display() + oTopMenu:select( nSelection ) + oTopMenu:display() ENDIF - IF !oTopMenu:GetItem( nSelection ):enabled + IF !oTopMenu:getItem( nSelection ):enabled RETURN 0 ENDIF @@ -272,7 +272,7 @@ METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList ) CLA IF ::oMenu:ClassName() == "TOPBARMENU" nTemp := ::oMenu:getPrev() IF nTemp == 0 - nTemp := ::oMenu:getLast() + nTemp := ::oMenu:getLast() ENDIF ::oMenu:select( nTemp ) ::oMenu:display() @@ -307,7 +307,7 @@ METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList ) CLA ::ShowMsg( .T. ) ELSE ::ShowMsg( .F. ) - nReturn := ::Execute() + nReturn := ::execute() IF nReturn != 0 EXIT ENDIF @@ -360,7 +360,7 @@ METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList ) CLA nMenuItem := ::oMenu:current oMenuItem := ::oMenu:getItem( nMenuItem ) IF ( oMenuItem := ::oMenu:getItem( ::oMenu:Current ) ):isPopUp() - oMenuItem:Data:Close() + oMenuItem:data:close() ENDIF IF nMenuItem != nNewItem @@ -384,7 +384,7 @@ METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList ) CLA IF nNewItem == ::oMenu:current ::ShowMsg( .F. ) - nReturn := ::Execute() + nReturn := ::execute() IF nReturn != 0 EXIT ENDIF @@ -399,7 +399,7 @@ METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList ) CLA IF !::PushMenu() ::ShowMsg( .F. ) - nReturn := ::Execute() + nReturn := ::execute() IF nReturn != 0 EXIT ENDIF @@ -425,17 +425,17 @@ METHOD Modal( nSelection, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, GetList ) CLA nReturn := -1 EXIT - CASE ( nNewItem := oTopMenu:GetAccel( nKey ) ) != 0 // ; check for the top menu item accelerator key + CASE ( nNewItem := oTopMenu:getAccel( nKey ) ) != 0 // ; check for the top menu item accelerator key - IF oTopMenu:GetItem( nNewItem ):enabled + IF oTopMenu:getItem( nNewItem ):enabled ::PopAll() ::oMenu:select( nNewItem ) ::oMenu:display() - IF oTopMenu:GetItem( nNewItem ):isPopUp() + IF oTopMenu:getItem( nNewItem ):isPopUp() ::PushMenu() ELSE ::ShowMsg( .F. ) - nReturn := ::Execute() + nReturn := ::execute() IF nReturn != 0 EXIT ENDIF @@ -469,7 +469,7 @@ METHOD PushMenu() CLASS HBMenuSys IF ISOBJECT( oNewMenu ) .AND. oNewMenu:IsPopUp - ::oMenu := oNewMenu:Data + ::oMenu := oNewMenu:data ::aMenuList[ ++::nMenuLevel ] := ::oMenu ::oMenu:select( ::oMenu:getFirst() ) @@ -510,8 +510,8 @@ METHOD PopChild( nNewLevel ) CLASS HBMenuSys IF ( nCurrent := ::oMenu:current ) != 0 oOldMenuItem := ::oMenu:getItem( nCurrent ) - IF oOldMenuItem:IsPopUp - oOldMenuItem:Data:Close() + IF oOldMenuItem:isPopUp + oOldMenuItem:data:close() ::nMenuLevel := nNewLevel RETURN .T. ENDIF @@ -528,7 +528,7 @@ METHOD PopChild( nNewLevel ) CLASS HBMenuSys METHOD PopAll() CLASS HBMenuSys IF ::aMenuList[ 2 ] != NIL - ::aMenuList[ 2 ]:Close() + ::aMenuList[ 2 ]:close() ENDIF // Set the menu level and position relative to the top menu item: ::nMenuLevel := 1 @@ -551,7 +551,7 @@ METHOD Execute() CLASS HBMenuSys IF ::oMenu:ClassName() $ "TOPBARMENU|POPUPMENU" SetPos( ::nOldRow, ::nOldCol ) SetCursor( ::nOldCursor ) - Eval( oNewMenu:Data, oNewMenu ) + Eval( oNewMenu:data, oNewMenu ) SetCursor( SC_NONE ) lPas := .F. ENDIF @@ -571,7 +571,7 @@ METHOD Execute() CLASS HBMenuSys ::oMenu:close() SetPos( ::nOldRow, ::nOldCol ) SetCursor( ::nOldCursor ) - Eval( oNewMenu:Data, oNewMenu ) + Eval( oNewMenu:data, oNewMenu ) SetCursor( SC_NONE ) ENDIF @@ -590,16 +590,14 @@ METHOD Execute() CLASS HBMenuSys METHOD MHitTest( oNewMenu, nNewLevel, nNewItem ) CLASS HBMenuSys FOR nNewLevel := ::nMenuLevel TO 1 STEP -1 - oNewMenu := ::aMenuList[ nNewLevel ] - nNewItem := oNewMenu:HitTest( MRow(), MCol() ) + + oNewMenu := ::aMenuList[ nNewLevel ] + nNewItem := oNewMenu:hitTest( MRow(), MCol() ) + IF nNewItem < 0 - // Test for the mouse on Menu separator or border - RETURN .F. - - ELSEIF nNewItem > 0 .AND. oNewMenu:GetItem( nNewItem ):enabled - // Test for the mouse on an enabled item in the menu - RETURN .T. - + RETURN .F. // Test for the mouse on Menu separator or border + ELSEIF nNewItem > 0 .AND. oNewMenu:getItem( nNewItem ):enabled + RETURN .T. // Test for the mouse on an enabled item in the menu ENDIF NEXT