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

2007-09-09 19:38 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* 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.
This commit is contained in:
Viktor Szakats
2007-09-09 17:42:53 +00:00
parent 5bc389f293
commit 7ace63cd2e
24 changed files with 4125 additions and 3812 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
harbour/ChangeLog
View File

@@ -8,6 +8,69 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
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

8
harbour/include/hbapigt.h
View File

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

38
harbour/include/hbcompat.ch
View File

@@ -83,7 +83,17 @@
#xtranslate HB_RASCAN([<x,...>]) => RASCAN(<x>)
#xtranslate HB_ISPOINTER( <xValue> ) => ISPOINTER( <xValue> )
#xtranslate HB_ISPOINTER( <xValue> )=> ISPOINTER( <xValue> )
#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*>] => } <x>
/* xHarbour operators: IN, HAS, LIKE, >>, <<, |, &, ^^ */
#translate ( <exp1> IN <exp2> ) => ( (<exp1>) $ (<exp2>) )
#translate ( <exp1> HAS <exp2> ) => ( HB_REGEXHAS( (<exp2>), (<exp1>) ) )
#translate ( <exp1> LIKE <exp2> ) => ( HB_REGEXLIKE( (<exp2>), (<exp1>) ) )
#translate ( <exp1> \<\< <exp2> ) => ( HB_BITSHIFT( (<exp1>), (<exp2>) ) )
#translate ( <exp1> >> <exp2> ) => ( HB_BITSHIFT( (<exp1>), -(<exp2>) ) )
#translate ( <exp1> | <exp2> ) => ( HB_BITOR( (<exp1>), (<exp2>) ) )
#translate ( <exp1> & <exp2> ) => ( HB_BITAND( (<exp1>), (<exp2>) ) )
#translate ( <exp1> ^^ <exp2> ) => ( HB_BITXOR( (<exp1>), (<exp2>) ) )
#translate ( <exp1> IN <exp2> ) => ( (<exp1>) $ (<exp2>) )
#translate ( <exp1> HAS <exp2> ) => ( HB_REGEXHAS( (<exp2>), (<exp1>) ) )
#translate ( <exp1> LIKE <exp2> ) => ( HB_REGEXLIKE( (<exp2>), (<exp1>) ) )
#translate ( <exp1> \<\< <exp2> ) => ( HB_BITSHIFT( (<exp1>), (<exp2>) ) )
#translate ( <exp1> >> <exp2> ) => ( HB_BITSHIFT( (<exp1>), -(<exp2>) ) )
#translate ( <exp1> | <exp2> ) => ( HB_BITOR( (<exp1>), (<exp2>) ) )
#translate ( <exp1> & <exp2> ) => ( HB_BITAND( (<exp1>), (<exp2>) ) )
#translate ( <exp1> ^^ <exp2> ) => ( HB_BITXOR( (<exp1>), (<exp2>) ) )
#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

1
harbour/include/setcurs.ch
View File

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

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

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

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

@@ -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,",;
" <Enter> 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 <exp> as a Watchpoint. <exp> 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

14
harbour/source/debug/dbgmenu.prg
View File

@@ -52,18 +52,18 @@
#include "hbclass.ch"
#xcommand MENU [<oMenu>] => [ <oMenu> := ] TDbMenu():New()
#xcommand MENU [<oMenu>] => [ <oMenu> := ] HBDbMenu():New()
#xcommand MENUITEM [ <oMenuItem> PROMPT ] <cPrompt> ;
[ IDENT <nIdent> ] [ ACTION <uAction,...> ] ;
[ CHECKED <bChecked> ] => ;
[ <oMenuItem> := ] TDbMenu():AddItem( TDbMenuItem():New( <cPrompt>,;
[ <oMenuItem> := ] HBDbMenu():AddItem( HBDbMenuItem():New( <cPrompt>,;
[{||<uAction>}], [<bChecked>], [<nIdent>] ) )
#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

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

@@ -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<maxrow()-2)
if nRow <> 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 - <maurilio.longo@libero.it>
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<maxrow()-2,nPos ,maxrow()-2)
return nReturn
CASE nKey == K_DOWN
oBrwSets:Down()
static procedure RefreshVarsS( oBrowse )
CASE nKey == K_HOME .OR. nKey == K_CTRL_PGUP .OR. nKey == K_CTRL_HOME
oBrwSets:GoTop()
local nLen := oBrowse:ColCount
CASE nKey == K_END .OR. nkey == K_CTRL_PGDN .OR. nkey == K_CTRL_END
oBrwSets:GoBottom()
if ( nLen == 2 )
oBrowse:dehilite():colpos:=2
endif
oBrowse:dehilite():forcestable()
if ( nLen == 2 )
oBrowse:hilite():colpos:=1
endif
CASE nKey == K_PGDN
oBrwSets:pageDown()
CASE nKey == K_PGUP
oBrwSets:PageUp()
CASE nKey == K_ENTER
IF ISARRAY( aArray[ nSet ] )
IF Len( aArray[ nSet ] ) == 0
Alert( "Array is empty" )
ELSE
SetPos( oWnd:nBottom, oWnd:nLeft )
::aWindows[ ::nCurWindow ]:lFocused := .F.
::arrayname := ::arrayname + "[" + LTrim( Str( nSet, 4 ) ) + "]"
::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 ISBLOCK( aArray[ nSet ] ) .OR. Valtype( aArray[ nSet ] ) == "P"
Alert( "Value cannot be edited" )
ELSE
IF ::lEditable
oBrwSets:RefreshCurrent()
IF ISOBJECT( aArray[ nSet ] )
__DbgObject( aArray[ nSet ], cName + "[" + LTrim( Str( nSet ) ) + "]" )
ELSEIF ValType( aArray[ nSet ] ) == "H"
__DbgHashes( aArray[ nSet ], cName + "[" + LTrim( 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 + "[" + LTrim( Str( oBrwSets:cargo[ 1 ] ) ) + ".." + ;
LTrim( Str( Len( aArray ) ) ) + "]" )
RETURN self
FUNCTION __dbgArrays( aArray, cVarName, lEditable )
RETURN HBDbArray():New( aArray, cVarName, lEditable )
STATIC FUNCTION GetTopPos( nPos )
RETURN iif( ( MaxRow() - nPos ) < 5, MaxRow() - nPos, nPos )
STATIC FUNCTION GetBottomPos( nPos )
RETURN iif( nPos < MaxRow() - 2, nPos, MaxRow() - 2 )
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
oBrowse:hilite()
return
static function ArrayBrowseSkip( nPos, oBrwSets )
RETURN
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 ) )

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

@@ -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 - <maurilio.longo@libero.it>
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<maxrow()-2,nPos ,maxrow()-2)
return nReturn
CASE nKey == K_DOWN
oBrwSets:Down()
static procedure RefreshVarsS( oBrowse )
CASE nKey == K_HOME .OR. nKey == K_CTRL_PGUP .OR. nKey == K_CTRL_HOME
oBrwSets:GoTop()
local nLen := oBrowse:ColCount
CASE nKey == K_END .OR. nkey == K_CTRL_PGDN .OR. nkey == K_CTRL_END
oBrwSets:GoBottom()
if ( nLen == 2 )
oBrowse:dehilite():colpos:=2
endif
oBrowse:dehilite():forcestable()
if ( nLen == 2 )
oBrowse:hilite():colpos:=1
endif
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 ISBLOCK( uValue ) .OR. ValType( uValue ) == "P"
Alert( "Value cannot be edited" )
ELSE
IF ::lEditable
oBrwSets:RefreshCurrent()
IF ISOBJECT( uValue )
__DbgObject( uValue, cName + "[" + HashKeyString( hHash, nSet ) + "]" )
ELSEIF ISARRAY( uValue )
__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 + "[" + LTrim( Str( oBrwSets:cargo[ 1 ] ) ) + ".." + ;
LTrim( Str( Len( hHash ) ) ) + "]" )
RETURN self
FUNCTION __dbgHashes( hHash, cVarName, lEditable )
RETURN HBDbHash():New( hHash, cVarName, lEditable )
STATIC FUNCTION GetTopPos( nPos )
RETURN iif( ( MaxRow() - nPos ) < 5, MaxRow() - nPos, nPos )
STATIC FUNCTION GetBottomPos( nPos )
RETURN iif( nPos < MaxRow() - 2, nPos, MaxRow()-2 )
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
oBrowse:hilite()
return
static function HashBrowseSkip( nPos, oBrwSets )
RETURN
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 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 ) )

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

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* The Debugger (TDbMenu class)
* The Debugger (HBDbMenu class)
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* 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 ), "" )

35
harbour/source/debug/dbgtmitm.prg
View File

@@ -4,7 +4,7 @@
/*
* Harbour Project source code:
* The Debugger (TDbMenuItem Class)
* The Debugger (HBDbMenuItem Class)
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* 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

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

@@ -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<maxrow()-2)
if nRow <> nil
owndsets:=TDbWindow():New( nRow, 5, if(nRow+nsize+1<maxrow()-2,nRow+nsize+1,maxrow()-2), maxcol()-5, ::objname +" is of class: " +::TheObj:classname() ,"N/W" )
else
owndsets:=TDbWindow():New( 1, 5, 2+nsize, maxcol()-5, ::objname +" is of class: " +::TheObj:classname() ,"N/W")
endif
else
owndsets:=TDbWindow():New( 1, 5, maxrow()-2, maxcol()-5, ::objname +" is of class: " +::TheObj:classname() ,"N/W")
endif
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
::objname := cVarName
::TheObj := aArray
::lEditable := lEditable
::addWindows( ::pItems )
RETURN Self
METHOD addWindows( aArray, nRow ) CLASS HBDbObject
LOCAL oBrwSets
LOCAL nSize := Len( aArray )
LOCAL oWndSets
LOCAL nWidth
LOCAL oCol
LOCAL nMaxLen
IF nSize < MaxRow()-2
IF nRow != NIL
oWndSets := HBDbWindow():New( nRow, 5, iif( nRow + nSize + 1 < MaxRow() - 2, nRow + nSize + 1, MaxRow() - 2 ), MaxCol() - 5, ::objname + " is of class: " + ::TheObj:ClassName(), "N/W" )
ELSE
oWndSets := HBDbWindow():New( 1, 5, 2 + nSize, MaxCol() - 5, ::objname + " is of class: " + ::TheObj:ClassName(), "N/W" )
ENDIF
ELSE
oWndSets := HBDbWindow():New( 1, 5, MaxRow() - 2, MaxCol() - 5, ::objname + " is of class: " + ::TheObj:ClassName(), "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)
::ArrayReference:=aarray
oBrwSets := TBrowseNew( oWndSets:nTop + 1, oWndSets:nLeft + 1, oWndSets:nBottom - 1, oWndSets:nRight - 1 )
::ArrayReference := aarray
oBrwSets:ColorSpec := __Dbg():ClrModal()
oBrwSets:GoTopBlock := { || ::Arrayindex := 1 }
oBrwSets:GoBottomBlock := { || ::arrayindex := Len( ::ArrayReference) }
oBrwSets:GoBottomBlock := { || ::arrayindex := Len( ::ArrayReference ) }
oBrwSets:SkipBlock := { | nSkip, nPos | nPos := ::arrayindex,;
::arrayindex := iif( nSkip > 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

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

@@ -50,29 +50,52 @@
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 2000 Luiz Rafael Culik <culik@sl.conex.net>
* :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

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

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

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

File diff suppressed because it is too large Load Diff

267
harbour/source/debug/tbrwtext.prg
View File

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

144
harbour/source/rtl/getsys.prg
View File

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

43
harbour/source/rtl/menusys.prg
View File

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

4
harbour/source/rtl/tbcolumn.prg
View File

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

53
harbour/source/rtl/tbrowse.prg
View File

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

16
harbour/source/rtl/teditor.prg
View File

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

6
harbour/source/rtl/tget.prg
View File

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

1355
harbour/source/rtl/tgetlist.prg
View File

File diff suppressed because it is too large Load Diff

60
harbour/source/rtl/tmenusys.prg
View File

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