2013-03-15 11:12 UTC+0100 Viktor Szakats (harbour syenar.net)
* /harbour/* -> /*
* moved whole Harbour source tree one level up to
avoid single 'harbour' top dir
This commit is contained in:
vszakats
27
src/debug/Makefile
Normal file
27
src/debug/Makefile
Normal file
@@ -0,0 +1,27 @@
|
||||
#
|
||||
# $Id$
|
||||
#
|
||||
|
||||
ROOT := ../../
|
||||
|
||||
C_SOURCES := \
|
||||
dbgentry.c \
|
||||
|
||||
PRG_SOURCES := \
|
||||
dbgmenu.prg \
|
||||
dbghelp.prg \
|
||||
dbgtinp.prg \
|
||||
dbgtmenu.prg \
|
||||
dbgtmitm.prg \
|
||||
dbgtwin.prg \
|
||||
debugger.prg \
|
||||
dbgtarr.prg \
|
||||
dbgthsh.prg \
|
||||
dbgtobj.prg \
|
||||
tbrwtext.prg \
|
||||
dbgwa.prg \
|
||||
dbgbrwsr.prg \
|
||||
|
||||
LIBNAME := hbdebug
|
||||
|
||||
include $(TOP)$(ROOT)config/lib.mk
|
||||
279
src/debug/dbgbrwsr.prg
Normal file
279
src/debug/dbgbrwsr.prg
Normal file
@@ -0,0 +1,279 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* The Debugger Browser
|
||||
*
|
||||
* Copyright 2004 Ryszard Glab <rglab@imid.med.pl>
|
||||
* Copyright 2007 Phil Krylov <phil a t newstar.rinet.ru>
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING.txt. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
#pragma -b-
|
||||
|
||||
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
|
||||
#include "hbclass.ch"
|
||||
|
||||
/* HBDbBrowser
|
||||
*
|
||||
* A minimalistic TBrowse implementation just enough for use in
|
||||
* the debugger instead of the HBBrowse monster
|
||||
*/
|
||||
CREATE CLASS HBDbBrowser
|
||||
|
||||
VAR Window
|
||||
VAR cargo
|
||||
|
||||
VAR nTop
|
||||
VAR nLeft
|
||||
VAR nBottom
|
||||
VAR nRight
|
||||
VAR cColorSpec
|
||||
VAR autoLite INIT .T.
|
||||
|
||||
VAR goTopBlock
|
||||
VAR goBottomBlock
|
||||
VAR skipBlock
|
||||
|
||||
VAR stable INIT .F.
|
||||
VAR rowCount INIT 0
|
||||
VAR rowPos INIT 1
|
||||
VAR colCount INIT 0
|
||||
VAR colPos INIT 1
|
||||
VAR hitBottom INIT .F.
|
||||
VAR freeze INIT 0
|
||||
|
||||
VAR aColumns INIT {}
|
||||
VAR aRowState INIT {}
|
||||
VAR aColorSpec INIT {}
|
||||
VAR nFirstVisible INIT 1
|
||||
VAR lConfigured INIT .F.
|
||||
|
||||
METHOD New( nTop, nLeft, nBottom, nRight, oParentWindow )
|
||||
METHOD AddColumn( oCol ) INLINE AAdd( ::aColumns, oCol ), ::colCount++, Self
|
||||
METHOD Resize( nTop, nLeft, nBottom, nRight )
|
||||
ACCESS ColorSpec INLINE ::cColorSpec
|
||||
ASSIGN ColorSpec( cColors ) METHOD SetColorSpec( cColors )
|
||||
METHOD Configure()
|
||||
METHOD DeHiLite() INLINE Self
|
||||
METHOD HiLite() INLINE Self
|
||||
METHOD MoveCursor( nSkip )
|
||||
METHOD GoTo( nRow )
|
||||
METHOD GoTop() INLINE ::GoTo( 1 ), ::rowPos := 1, ::nFirstVisible := 1, ::RefreshAll()
|
||||
METHOD GoBottom()
|
||||
METHOD Down() INLINE ::MoveCursor( 1 )
|
||||
METHOD Up() INLINE ::MoveCursor( -1 )
|
||||
METHOD PageDown() INLINE ::MoveCursor( ::rowCount )
|
||||
METHOD PageUp() INLINE ::MoveCursor( -::rowCount )
|
||||
METHOD GetColumn( nColumn ) INLINE ::aColumns[ nColumn ]
|
||||
METHOD RefreshAll() INLINE AFill( ::aRowState, .F. ), Self
|
||||
METHOD RefreshCurrent() INLINE iif( ::rowCount > 0 .AND. ::rowPos <= Len( ::aRowState ), ::aRowState[ ::rowPos ] := .F., ), Self
|
||||
METHOD Invalidate() INLINE ::RefreshAll()
|
||||
METHOD Stabilize() INLINE ::ForceStable()
|
||||
METHOD ForceStable()
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New( nTop, nLeft, nBottom, nRight, oParentWindow ) CLASS HBDbBrowser
|
||||
|
||||
::Window := oParentWindow
|
||||
::nTop := nTop
|
||||
::nLeft := nLeft
|
||||
::nBottom := nBottom
|
||||
::nRight := nRight
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD Configure()
|
||||
|
||||
::rowCount := ::nBottom - ::nTop + 1
|
||||
AFill( ASize( ::aRowState, ::rowCount ), .F. )
|
||||
::lConfigured := .T.
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD SetColorSpec( cColors )
|
||||
|
||||
IF HB_ISSTRING( cColors )
|
||||
::cColorSpec := cColors
|
||||
::aColorSpec := hb_ATokens( ::cColorSpec, "," )
|
||||
ENDIF
|
||||
|
||||
RETURN ::cColorSpec
|
||||
|
||||
METHOD MoveCursor( nSkip )
|
||||
|
||||
LOCAL nSkipped
|
||||
|
||||
nSkipped := ::GoTo( ::rowPos + ::nFirstVisible - 1 + nSkip )
|
||||
IF ! ::hitBottom .OR. Abs( nSkipped ) > 0
|
||||
IF iif( nSkipped > 0, ::rowPos + nSkipped <= ::rowCount, ::rowPos + nSkipped >= 1 )
|
||||
::RefreshCurrent()
|
||||
::rowPos += nSkipped
|
||||
::RefreshCurrent()
|
||||
ELSE
|
||||
::nFirstVisible := Max( 1, nSkipped + ::nFirstVisible )
|
||||
::RefreshAll()
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD ForceStable()
|
||||
|
||||
LOCAL nRow, nCol, xData, oCol, nColX, nWid, aClr, nClr
|
||||
|
||||
IF ! ::lConfigured
|
||||
::Configure()
|
||||
ENDIF
|
||||
DispBegin()
|
||||
FOR nRow := 1 TO ::rowCount
|
||||
IF ! ::aRowState[ nRow ]
|
||||
::GoTo( ::nFirstVisible + nRow - 1 )
|
||||
IF ::hitBottom
|
||||
hb_DispOutAt( ::nTop + nRow - 1, ::nLeft, Space( ::nRight - ::nLeft + 1 ), ::aColorSpec[ 1 ] )
|
||||
ELSE
|
||||
nColX := ::nLeft
|
||||
FOR nCol := 1 TO Len( ::aColumns )
|
||||
IF nColX <= ::nRight
|
||||
oCol := ::aColumns[ nCol ]
|
||||
xData := Eval( oCol:block )
|
||||
nClr := iif( nRow == ::rowPos, 2, 1 )
|
||||
aClr := Eval( oCol:colorBlock, xData )
|
||||
IF HB_ISARRAY( aClr )
|
||||
nClr := aClr[ nClr ]
|
||||
ELSE
|
||||
nClr := oCol:defColor[ nClr ]
|
||||
ENDIF
|
||||
nWid := oCol:width
|
||||
IF nWid == NIL
|
||||
nWid := Len( xData )
|
||||
ENDIF
|
||||
hb_DispOutAt( ::nTop + nRow - 1, nColX, PadR( xData, nWid ) + iif( nCol < Len( ::aColumns ), " ", "" ), ::aColorSpec[ nClr ] )
|
||||
nColX += nWid + 1
|
||||
ENDIF
|
||||
NEXT
|
||||
ENDIF
|
||||
::aRowState[ nRow ] := .T.
|
||||
ENDIF
|
||||
NEXT
|
||||
::GoTo( ::nFirstVisible + ::rowPos - 1 )
|
||||
SetPos( ::nTop + ::rowPos - 1, ::nLeft )
|
||||
DispEnd()
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD GoTo( nRow )
|
||||
|
||||
LOCAL nOldRow := ::nFirstVisible + ::rowPos - 1
|
||||
LOCAL nSkipped := 0
|
||||
|
||||
Eval( ::goTopBlock )
|
||||
IF nRow == 1
|
||||
::hitBottom := .F.
|
||||
ELSE
|
||||
nSkipped := Eval( ::skipBlock, nRow - 1 )
|
||||
::hitBottom := ( nSkipped != nRow - 1 )
|
||||
ENDIF
|
||||
|
||||
RETURN nSkipped - nOldRow + 1
|
||||
|
||||
METHOD GoBottom()
|
||||
|
||||
DO WHILE ! ::hitBottom
|
||||
::PageDown()
|
||||
ENDDO
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD Resize( nTop, nLeft, nBottom, nRight )
|
||||
|
||||
LOCAL lResize := .F.
|
||||
|
||||
IF nTop != NIL .AND. nTop != ::nTop
|
||||
::nTop := nTop
|
||||
lResize := .T.
|
||||
ENDIF
|
||||
IF nLeft != NIL .AND. nLeft != ::nLeft
|
||||
::nLeft := nLeft
|
||||
lResize := .T.
|
||||
ENDIF
|
||||
IF nBottom != NIL .AND. nBottom != ::nBottom
|
||||
::nBottom := nBottom
|
||||
lResize := .T.
|
||||
ENDIF
|
||||
IF nRight != NIL .AND. nRight != ::nRight
|
||||
::nRight := nRight
|
||||
lResize := .T.
|
||||
ENDIF
|
||||
|
||||
IF lResize
|
||||
::Configure():ForceStable()
|
||||
ENDIF
|
||||
|
||||
RETURN self
|
||||
|
||||
CREATE CLASS HBDbColumn
|
||||
|
||||
EXPORTED:
|
||||
|
||||
VAR block AS CODEBLOCK /* Code block to retrieve data for the column */
|
||||
VAR colorBlock AS CODEBLOCK INIT {|| NIL } /* column color block */
|
||||
VAR defColor AS ARRAY INIT { 1, 2 } /* Array of numeric indexes into the color table */
|
||||
VAR width AS USUAL /* Column display width */
|
||||
|
||||
METHOD New( cHeading, bBlock ) /* NOTE: This method is a Harbour extension [vszakats] */
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New( cHeading, bBlock ) CLASS HBDbColumn
|
||||
|
||||
HB_SYMBOL_UNUSED( cHeading )
|
||||
::block := bBlock
|
||||
|
||||
RETURN Self
|
||||
|
||||
FUNCTION HBDbColumnNew( cHeading, bBlock )
|
||||
RETURN HBDbColumn():New( cHeading, bBlock )
|
||||
1782
src/debug/dbgentry.c
Normal file
1782
src/debug/dbgentry.c
Normal file
File diff suppressed because it is too large
Load Diff
956
src/debug/dbghelp.prg
Normal file
956
src/debug/dbghelp.prg
Normal file
@@ -0,0 +1,956 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* The Debugger Help
|
||||
*
|
||||
* Copyright 2002 Antonio Linares <alinares@fivetech.com>
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version, with one exception:
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING.txt. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
#pragma -b-
|
||||
|
||||
/* 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 "box.ch"
|
||||
#include "inkey.ch"
|
||||
|
||||
PROCEDURE __dbgHelp( nTopic )
|
||||
|
||||
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()
|
||||
|
||||
hb_default( @nTopic, 1 )
|
||||
|
||||
oDlg := HBDbWindow():New( 2, 2, MaxRow() - 2, MaxCol() - 2, "Help", cColor )
|
||||
|
||||
oBrw := HBDbBrowser():New( oDlg:nTop + 1, oDlg:nLeft + 1, oDlg:nBottom - 1, oDlg:nLeft + 12 )
|
||||
oBrw:Cargo := 1
|
||||
oBrw:AddColumn( HBDbColumnNew( "", {|| aTopics[ oBrw:Cargo ][ 1 ] }, 12 ) )
|
||||
oBrw:ColorSpec := StrTran( __Dbg():ClrModal(), ", R/W" )
|
||||
oBrw:SkipBlock := {| nSkip, nOld | nOld := oBrw:Cargo, oBrw:Cargo += nSkip, ;
|
||||
oBrw:Cargo := Min( Max( oBrw:Cargo, 1 ), Len( aTopics ) ), ;
|
||||
oBrw:Cargo - nOld }
|
||||
oBrw:GoTopBlock := {|| oBrw:Cargo := 1 }
|
||||
oBrw:GoBottomBlock := {|| oBrw:Cargo := Len( aTopics ) }
|
||||
|
||||
IF nTopic > 1
|
||||
Eval( oBrw:SkipBlock, nTopic - 1 )
|
||||
ENDIF
|
||||
|
||||
oDlg:bPainted := {|| PaintWindow( oDlg, oBrw, aTopics ) }
|
||||
oDlg:bKeyPressed := {| nKey | ProcessKey( nKey, oDlg, oBrw, aTopics, oDlg:cColor ) }
|
||||
|
||||
oDlg:ShowModal()
|
||||
|
||||
RETURN
|
||||
|
||||
STATIC PROCEDURE PaintWindow( oDlg, oBrw, aTopics )
|
||||
|
||||
hb_DispBox( oDlg:nTop + 1, oDlg:nLeft + 13, oDlg:nBottom - 1, oDlg:nLeft + 13, HB_B_SINGLE_UNI, oDlg:cColor )
|
||||
hb_DispOutAtBox( oDlg:nTop, oDlg:nLeft + 13, hb_UTF8ToStrBox( "┬" ), oDlg:cColor )
|
||||
hb_DispOutAtBox( oDlg:nBottom, oDlg:nLeft + 13, hb_UTF8ToStrBox( "┴" ), oDlg:cColor )
|
||||
|
||||
oBrw:ForceStable()
|
||||
ShowTopic( oDlg, aTopics, oBrw:Cargo, 0 ) // Start on page 1
|
||||
|
||||
RETURN
|
||||
|
||||
STATIC PROCEDURE ProcessKey( nKey, oDlg, oBrw, aTopics )
|
||||
|
||||
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
|
||||
|
||||
CASE nKey == K_DOWN
|
||||
|
||||
IF oBrw:Cargo < Len( aTopics )
|
||||
oBrw:Down()
|
||||
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_END
|
||||
|
||||
IF oBrw:Cargo < Len( aTopics )
|
||||
oBrw:GoBottom()
|
||||
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_PGDN .OR. nKey == K_CTRL_F .OR. nKey == K_SPACE
|
||||
|
||||
ShowTopic( oDlg, aTopics, oBrw:Cargo, 1 ) // Skip to next page
|
||||
|
||||
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
|
||||
|
||||
RETURN
|
||||
|
||||
STATIC PROCEDURE ShowTopic( oDlg, aTopics, nTopic, nPageOp )
|
||||
|
||||
LOCAL oDebug := __Dbg()
|
||||
LOCAL nRows := oDlg:nBottom - oDlg:nTop - 1
|
||||
LOCAL nPages := Len( aTopics[ nTopic ][ 2 ] ) / nRows
|
||||
LOCAL nRowsToPaint
|
||||
LOCAL n
|
||||
|
||||
IF nPages > 1 .AND. Int( nPages ) < nPages
|
||||
nPages := Int( nPages ) + 1
|
||||
ENDIF
|
||||
|
||||
IF nPages == 1
|
||||
IF nPageOp == -1 .OR. nPageOp == 1
|
||||
RETURN
|
||||
ENDIF
|
||||
oDebug:nHelpPage := 1
|
||||
ELSE
|
||||
DO CASE
|
||||
CASE nPageOp == 0 // Show first page
|
||||
|
||||
oDebug:nHelpPage := 1
|
||||
|
||||
CASE nPageOp == 1 // Show next page
|
||||
|
||||
IF oDebug:nHelpPage < nPages
|
||||
oDebug:nHelpPage++
|
||||
ELSE
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
CASE nPageOp == -1 // Show prev page
|
||||
|
||||
IF oDebug:nHelpPage > 1
|
||||
oDebug:nHelpPage--
|
||||
ELSE
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
ENDCASE
|
||||
ENDIF
|
||||
|
||||
hb_Scroll( oDlg:nTop + 1, oDlg:nLeft + 14, oDlg:nBottom - 1, oDlg:nRight - 1 )
|
||||
|
||||
nRowsToPaint := Min( nRows, Len( aTopics[ nTopic ][ 2 ] ) - ( ( oDebug:nHelpPage - 1 ) * nRows ) )
|
||||
|
||||
FOR n := 1 TO nRowsToPaint
|
||||
hb_DispOutAt( 2 + n, 16, aTopics[ nTopic ][ 2 ][ ( ( oDebug:nHelpPage - 1 ) * nRows ) + n ] )
|
||||
NEXT
|
||||
|
||||
IF Len( aTopics[ nTopic ][ 2 ] ) <= nRows
|
||||
hb_DispOutAt( oDlg:nBottom, oDlg:nRight - 16, " Page 1 of 1 " )
|
||||
ELSE
|
||||
hb_DispOutAt( oDlg:nBottom, oDlg:nRight - 16, " Page " + Str( oDebug:nHelpPage, 1 ) + " of " + Str( nPages, 1 ) + " " )
|
||||
ENDIF
|
||||
|
||||
RETURN
|
||||
|
||||
STATIC FUNCTION GetTopics()
|
||||
|
||||
LOCAL aTopics := { ;
|
||||
{ "About Help ", }, ;
|
||||
{ "Keys ", }, ;
|
||||
{ " Function ", }, ;
|
||||
{ " Window ", }, ;
|
||||
{ " Other ", }, ;
|
||||
{ "Windows ", }, ;
|
||||
{ " Command ", }, ;
|
||||
{ " Code ", }, ;
|
||||
{ " Watch ", }, ;
|
||||
{ " Monitor ", }, ;
|
||||
{ " CallStack", }, ;
|
||||
{ "Menus ", }, ;
|
||||
{ " File ", }, ;
|
||||
{ " Locate ", }, ;
|
||||
{ " View ", }, ;
|
||||
{ " Run ", }, ;
|
||||
{ " Point ", }, ;
|
||||
{ " Monitor ", }, ;
|
||||
{ " Options ", }, ;
|
||||
{ " Window ", }, ;
|
||||
{ "Commands ", }, ;
|
||||
{ "Script files", } }
|
||||
|
||||
aTopics[ 1 ][ 2 ] := { ;
|
||||
" " + Chr( 24 ) /* LOW-ASCII "↑" */ + Chr( 25 ) /* LOW-ASCII "↓" */ +;
|
||||
" Select help topic.", ;
|
||||
" PageUp Page help text down.", ;
|
||||
" PageDn Page help text down.", ;
|
||||
" Esc Returns to debugger." }
|
||||
|
||||
aTopics[ 2 ][ 2 ] := { ;
|
||||
"Special debugger keys fall into the following", ;
|
||||
"categories:", ;
|
||||
"", ;
|
||||
" Function Keys", ;
|
||||
" Keys that execute debugger functions", ;
|
||||
"", ;
|
||||
" Window keys", ;
|
||||
" Keys that operate on the active window", ;
|
||||
"", ;
|
||||
" Others", ;
|
||||
" Keys for window navigation and sizing", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"Other keys (typeable characters) are sent to", ;
|
||||
"the Command window and treated as input text." }
|
||||
|
||||
aTopics[ 3 ][ 2 ] := { ;
|
||||
"F1 Help", ;
|
||||
"F2 Zoom active window", ;
|
||||
"", ;
|
||||
"F3 Retype last command", ;
|
||||
"F4 View Application (User) screen", ;
|
||||
"", ;
|
||||
"F5 Go (Run application)", ;
|
||||
"F6 View Workareas screen", ;
|
||||
"", ;
|
||||
"F7 Run to cursor line", ;
|
||||
"F8 Step", ;
|
||||
"", ;
|
||||
"F9 Set breakpoint on cursor line", ;
|
||||
"F10 Trace" }
|
||||
|
||||
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", ;
|
||||
" Monitor or Watch window is active, ENTER will", ;
|
||||
" inspect the selected window item.", ;
|
||||
"", ;
|
||||
"Up In Code window, moves cursor line up.", ;
|
||||
" In Command window, recalls previous command.", ;
|
||||
" In other windows, moves selected item up.", ;
|
||||
"", ;
|
||||
"Down In Code window, moves cursor line down.", ;
|
||||
" In Command window, recalls previous command.", ;
|
||||
" In other windows, moves selected item down.", ;
|
||||
"", ;
|
||||
"PageUp In Code window, pages source up.", ;
|
||||
" In Command window, does nothing.", ;
|
||||
" In other windows, pages item list up.", ;
|
||||
"", ;
|
||||
"PageDn In Code window, pages source down.", ;
|
||||
" In Command window, does nothing.", ;
|
||||
" In other windows, pages item list down.", ;
|
||||
"", ;
|
||||
"Ctrl PageUp In Code window, moves cursor line to top.", ;
|
||||
" of source.", ;
|
||||
" In Command window, does nothing.", ;
|
||||
" In other windows, selects first item on list.", ;
|
||||
"", ;
|
||||
"Ctrl PageDn In Code window, moves cursor line to bottom.", ;
|
||||
" of source.", ;
|
||||
" In Command window, does nothing", ;
|
||||
" In other windows, selects last item on list.", ;
|
||||
"", ;
|
||||
"Left In Code window, scrolls left 1 column.", ;
|
||||
" In Command window, moves cursor left.", ;
|
||||
" In other windows, does nothing", ;
|
||||
"", ;
|
||||
"Right In Code window, scrolls right 1 column.", ;
|
||||
" In Command window, moves cursor right.", ;
|
||||
" In other windows, does nothing.", ;
|
||||
"", ;
|
||||
"Home In Code window, scrolls hard left.", ;
|
||||
" In Command window, moves cursor to beginning", ;
|
||||
" of line.", ;
|
||||
" In other windows, does nothing.", ;
|
||||
"", ;
|
||||
"End In Code window, scrolls hard right.", ;
|
||||
" In Command window, moves cursor to end", ;
|
||||
" of line.", ;
|
||||
" In other windows, does nothing.", ;
|
||||
"", ;
|
||||
"Esc In Command window, clears command line.", ;
|
||||
" In other windows, does nothing." }
|
||||
|
||||
aTopics[ 5 ][ 2 ] := { ;
|
||||
"TAB Next window", ;
|
||||
"", ;
|
||||
"SHIFT-TAB Previous window", ;
|
||||
"", ;
|
||||
"ALT-G Grow active window", ;
|
||||
"", ;
|
||||
"ALT-S Shrink active window", ;
|
||||
"", ;
|
||||
"ALT-U Move the border between Command and Code", ;
|
||||
" windows Up", ;
|
||||
"", ;
|
||||
"ALT-D Move the border between Command and Code", ;
|
||||
" windows Down", ;
|
||||
"", ;
|
||||
"ALT-X Exit" }
|
||||
|
||||
aTopics[ 6 ][ 2 ] := { ;
|
||||
"The Debugger display consists of the following five", ;
|
||||
"windows:", ;
|
||||
"", ;
|
||||
" Command Window", ;
|
||||
" Accepts and displays debugger commands.", ;
|
||||
" Always open.", ;
|
||||
"", ;
|
||||
" Code Window", ;
|
||||
" Displays program source code.", ;
|
||||
" Always open.", ;
|
||||
"", ;
|
||||
" Watch Window", ;
|
||||
" Displays Watchpoints and Tracepoints, and inspects", ;
|
||||
" their values.", ;
|
||||
" Open when any Watchpoints or Tracepoints are", ;
|
||||
" defined. These are set and deleted via the", ;
|
||||
" Point menu.", ;
|
||||
"", ;
|
||||
" Monitor Window", ;
|
||||
" Displays monitored variables, and inspects their", ;
|
||||
" values.", ;
|
||||
" Open when any classes of variables are being", ;
|
||||
" monitored, via commands in the Monitor menu.", ;
|
||||
"", ;
|
||||
" CallStack Window", ;
|
||||
" Displays program call stack.", ;
|
||||
" Opened via the View:CallStack menu option.", ;
|
||||
"", ;
|
||||
" If this window is active, the Code, Watch and", ;
|
||||
" Monitor windows will display information pertaining", ;
|
||||
" to the selected call on the CallStack.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"One debugger window is active at a time. The active window", ;
|
||||
"is displayed with a hilighted border. TAB and SHIFT-TAB", ;
|
||||
"navigate among open windows.", ;
|
||||
"", ;
|
||||
"The Window menu contains options to Move, Size, Zoom and", ;
|
||||
"Iconize the active window.", ;
|
||||
"", ;
|
||||
"After a long session of moving and sizing, the Window:Tile", ;
|
||||
"menu option will restore the windows to their original", ;
|
||||
"size and location." }
|
||||
|
||||
aTopics[ 7 ][ 2 ] := { ;
|
||||
"The Command window accepts debugger commands as line", ;
|
||||
"input, and displays the response from an executed", ;
|
||||
"command, if any.", ;
|
||||
"", ;
|
||||
"Commands are entered simply by typing in the command", ;
|
||||
"text, then pressing ENTER.", ;
|
||||
"", ;
|
||||
"Commands may be entered and executed while any", ;
|
||||
"window is active. However, the entry cursor is", ;
|
||||
"only visible within the Command window when it is", ;
|
||||
"active.", ;
|
||||
"", ;
|
||||
"When the Command window is active, the UP and DOWN", ;
|
||||
"arrow keys can be used to recall previous commands." }
|
||||
|
||||
aTopics[ 8 ][ 2 ] := { ;
|
||||
"The Code window displays Clipper source code for", ;
|
||||
"the program being debugged.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"What file the Code window displays may be controlled", ;
|
||||
"in the following ways:", ;
|
||||
"", ;
|
||||
" 1. By default, the Code window will contain the line", ;
|
||||
" of Clipper code currently being executed.", ;
|
||||
"", ;
|
||||
" 2. If the CallStack window is open, the code being", ;
|
||||
" viewed is that of the selected call in the CallStack", ;
|
||||
" window.", ;
|
||||
"", ;
|
||||
" NOTE: By default this will be the same code as 1,", ;
|
||||
" but code for the other calls may be viewed by", ;
|
||||
" making the CallStack window active and using UP", ;
|
||||
" and DOWN to traverse the call stack.", ;
|
||||
"", ;
|
||||
" 3. A specific file may be viewed by issuing a VIEW", ;
|
||||
" command, or selecting the File:View menu option.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"If the Code window contains the line of Clipper code", ;
|
||||
"currently being executed, that line will be hilighted.", ;
|
||||
"Any lines which have Breakpoints set on them will also", ;
|
||||
"be marked.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"In addition to standard navigation keys, you can search", ;
|
||||
"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 ] := { ;
|
||||
"The Watch window displays Watchpoint and Tracepoint", ;
|
||||
"expressions, and their current values.", ;
|
||||
"", ;
|
||||
"Watchpoints and Tracepoints may be defined and deleted via", ;
|
||||
"options on the Point menu. You can edit a Watchpoint or", ;
|
||||
"Tracepoint expression by selecting it in the Watch window", ;
|
||||
"and pressing CTRL-ENTER.", ;
|
||||
"", ;
|
||||
"If the Watch window is active, pressing ENTER will inspect", ;
|
||||
"the value of the selected expression. The navigation keys", ;
|
||||
"described in 'Window Keys' may be used to change the", ;
|
||||
"selected item.", ;
|
||||
"", ;
|
||||
"If the CallStack window is active, the Watch window will", ;
|
||||
"display the values for Watchpoints and Tracepoints at the", ;
|
||||
"activation level represented by the selected call in the", ;
|
||||
"CallStack window." }
|
||||
|
||||
aTopics[ 10 ][ 2 ] := { ;
|
||||
"The Monitor window displays monitored variables.", ;
|
||||
"", ;
|
||||
"Classes of variables may be monitored via options in the", ;
|
||||
"Monitor menu.", ;
|
||||
"", ;
|
||||
"If the Monitor window is active, pressing ENTER will", ;
|
||||
"inspect the value of the selected variable. The navigation", ;
|
||||
"keys described in 'Window Keys' may be used to change the", ;
|
||||
"selected item.", ;
|
||||
"", ;
|
||||
"If the CallStack window is active, the Monitor window will", ;
|
||||
"display the values of variables at the point of the", ;
|
||||
"activation level represented by the selected call in the", ;
|
||||
"CallStack window." }
|
||||
|
||||
aTopics[ 11 ][ 2 ] := { ;
|
||||
"The CallStack window displays the program's call stack.", ;
|
||||
"It is opened and closed via the View:CallStack menu", ;
|
||||
"option.", ;
|
||||
"", ;
|
||||
"By default, the selected call within the CallStack window", ;
|
||||
"is the top one -- i.e., the call currently being executed.", ;
|
||||
"When the CallStack window is active, the other call levels", ;
|
||||
"may be selected using the navigation keys described in", ;
|
||||
"'Window Keys'.", ;
|
||||
"", ;
|
||||
"All other windows except the Command window are synchronized", ;
|
||||
"with the CallStack window. The code viewed in the Code", ;
|
||||
"window, the values of Watchpoints and Tracepoints in the", ;
|
||||
"Watch window, and the values of variables in the Monitor", ;
|
||||
"window are all in the context of the activation level", ;
|
||||
"selected in the CallStack window." }
|
||||
|
||||
aTopics[ 12 ][ 2 ] := { ;
|
||||
"The debugger menus contain various debugger functions.", ;
|
||||
"", ;
|
||||
"Each menu may be accessed at any time by pressing the", ;
|
||||
"ALT key, and the first letter in the menu's name.", ;
|
||||
"", ;
|
||||
"Once in a menu, the UP and DOWN arrow keys navigate", ;
|
||||
"the list of options. An option may be selected by", ;
|
||||
"pressing ENTER, or by typing the first uppercase", ;
|
||||
"letter within the name of the desired option.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"Some menu options toggle a debugger setting. These", ;
|
||||
"options will have a checkmark displayed to their left", ;
|
||||
"if the setting they refer to is currently ON.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"Each menu option is also available as a command,", ;
|
||||
"made up of the Menu name, followed by the first", ;
|
||||
"word of the option name. For instance, the", ;
|
||||
"View:CallStack menu option may also be accessed via", ;
|
||||
"the command:", ;
|
||||
"", ;
|
||||
" View Call", ;
|
||||
"", ;
|
||||
"Words within these commands may be shortened in most", ;
|
||||
"cases to one letter.", ;
|
||||
"", ;
|
||||
"For more information on this class of commands, see", ;
|
||||
"the 'Commands' section of this help." }
|
||||
|
||||
aTopics[ 13 ][ 2 ] := { ;
|
||||
"Options:", ;
|
||||
"", ;
|
||||
" Open...", ;
|
||||
" Specify a file to be opened in the Code window", ;
|
||||
"", ;
|
||||
" OS Access", ;
|
||||
" Shell to the OS environment", ;
|
||||
"", ;
|
||||
" Exit Alt-X", ;
|
||||
" Exit the debugger" }
|
||||
|
||||
aTopics[ 14 ][ 2 ] := { ;
|
||||
"Facilites for navigating the file in the Code window", ;
|
||||
"", ;
|
||||
"Options:", ;
|
||||
"", ;
|
||||
" Find...", ;
|
||||
" Search for a specified string, from the beginning", ;
|
||||
" of the file onward.", ;
|
||||
"", ;
|
||||
" Next", ;
|
||||
" Search for the next occurence of the Find string,", ;
|
||||
" from the cursor line onward.", ;
|
||||
"", ;
|
||||
" Prev", ;
|
||||
" Search for the previous occurence of the Find string,", ;
|
||||
" from the cursor line backward.", ;
|
||||
"", ;
|
||||
" Goto Line...", ;
|
||||
" Go to a specific line in the file being viewed.", ;
|
||||
"", ;
|
||||
" Case Sensitivity", ;
|
||||
" Toggles case sensitivity in searches. Default is", ;
|
||||
" OFF." }
|
||||
|
||||
aTopics[ 15 ][ 2 ] := { ;
|
||||
"Options:", ;
|
||||
"", ;
|
||||
" Sets", ;
|
||||
" View Set status information", ;
|
||||
"", ;
|
||||
" Work Areas F6", ;
|
||||
" View Database status information", ;
|
||||
"", ;
|
||||
" App. screen F4", ;
|
||||
" Displays application screen, until key is pressed", ;
|
||||
"", ;
|
||||
" CallStack", ;
|
||||
" Toggles the CallStack window. Default is OFF" }
|
||||
|
||||
aTopics[ 16 ][ 2 ] := { ;
|
||||
"Options:", ;
|
||||
"", ;
|
||||
" Restart", ;
|
||||
" Terminate program and re-execute, leaving debugger", ;
|
||||
" settings in place", ;
|
||||
"", ;
|
||||
" Animate", ;
|
||||
" Execute program in Animate mode", ;
|
||||
"", ;
|
||||
" Step F8", ;
|
||||
" Execute one line of program code", ;
|
||||
"", ;
|
||||
" Trace F10", ;
|
||||
" Trace over function call in program code", ;
|
||||
"", ;
|
||||
" Go F5", ;
|
||||
" Execute program", ;
|
||||
"", ;
|
||||
" to Cursor F7", ;
|
||||
" Execute program, breaking at the current cursor", ;
|
||||
" line in Code window", ;
|
||||
"", ;
|
||||
" Next routine Ctrl-F5", ;
|
||||
" Execute program, breaking at line 1 of the next", ;
|
||||
" procedure or function call.,", ;
|
||||
"", ;
|
||||
" sPeed...", ;
|
||||
" Set step speed for Animate mode execution" }
|
||||
|
||||
aTopics[ 17 ][ 2 ] := { ;
|
||||
"Options:", ;
|
||||
"", ;
|
||||
" Watchpoint...", ;
|
||||
"", ;
|
||||
" Add Watchpoint. A Watchpoint is an expression which", ;
|
||||
" the debugger tracks during program execution -- the", ;
|
||||
" current value of a Watchpoint is displayed in the", ;
|
||||
" Watch window during debugging.", ;
|
||||
"", ;
|
||||
" A Watchpoint may be any valid Clipper expression,", ;
|
||||
" i.e.:", ;
|
||||
"", ;
|
||||
" s // variable", ;
|
||||
" a[n] // array element", ;
|
||||
" g:buffer // object instance variable", ;
|
||||
" At(s, t) // return value of function call", ;
|
||||
" ValType(s) == 'C' // value of expression", ;
|
||||
"", ;
|
||||
"", ;
|
||||
" Tracepoint...", ;
|
||||
"", ;
|
||||
" Add Tracepoint. A Tracepoint is similar to a Watchpoint,", ;
|
||||
" with the additional property that if the value of a", ;
|
||||
" Tracepoint expression changes, the debugger will be", ;
|
||||
" invoked as if a Breakpoint had been hit.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
" Breakpoint F9", ;
|
||||
"", ;
|
||||
" Set Breakpoint on current cursor line in", ;
|
||||
" Code window", ;
|
||||
"", ;
|
||||
"", ;
|
||||
" Delete", ;
|
||||
"", ;
|
||||
" Delete Tracepoint or Watchpoint." }
|
||||
|
||||
aTopics[ 18 ][ 2 ] := { ;
|
||||
"Options:", ;
|
||||
"", ;
|
||||
" Public", ;
|
||||
" Monitor Public variables.", ;
|
||||
"", ;
|
||||
" Private", ;
|
||||
" Monitor Private variables.", ;
|
||||
"", ;
|
||||
" Local", ;
|
||||
" Monitor Local variables.", ;
|
||||
"", ;
|
||||
" Static", ;
|
||||
" Monitor Static variables.", ;
|
||||
"", ;
|
||||
" Global", ;
|
||||
" Monitor Global variables.", ;
|
||||
"", ;
|
||||
" All", ;
|
||||
" Monitor All variables.", ;
|
||||
"", ;
|
||||
" Sort", ;
|
||||
" Toggles whether monitored variables are sorted by", ;
|
||||
" name. Default is OFF." }
|
||||
|
||||
aTopics[ 19 ][ 2 ] := { ;
|
||||
"Options:", ;
|
||||
"", ;
|
||||
" Preprocessed code", ;
|
||||
" Toggles the display of preprocessed code (from", ;
|
||||
" PPO file) within the Code window. Default is OFF.", ;
|
||||
"", ;
|
||||
" Line numbers", ;
|
||||
" Toggles the display of line numbers in the Code", ;
|
||||
" window. Default is OFF.", ;
|
||||
"", ;
|
||||
" Exchange screens", ;
|
||||
" Toggles whether debugger screen is swapped with", ;
|
||||
" application screen during debugger execution.", ;
|
||||
" Default is ON.", ;
|
||||
"", ;
|
||||
" Swap on Input", ;
|
||||
" Toggles whether debugger screen is swapped with", ;
|
||||
" application screen when the program being debugged", ;
|
||||
" is waiting for input. Default is ON.", ;
|
||||
" This setting is only meaningful when the Exchange", ;
|
||||
" Screens setting is OFF.", ;
|
||||
"", ;
|
||||
" Codeblock Trace", ;
|
||||
" Toggles whether the debugger will trace into", ;
|
||||
" code blocks when tracing (i.e., when in Trace", ;
|
||||
" mode). Defaults to ON.", ;
|
||||
"", ;
|
||||
" Menu Bar", ;
|
||||
" Toggles display of the debugger menu bar.", ;
|
||||
" Default is ON.", ;
|
||||
"", ;
|
||||
" mono Display", ;
|
||||
" Toggles display between monochrome and color.", ;
|
||||
" Default is OFF.", ;
|
||||
"", ;
|
||||
" Colors...", ;
|
||||
" Inspects debugger colors.", ;
|
||||
"", ;
|
||||
" Tab width...", ;
|
||||
" Set tab width in Code window. Default is 4.", ;
|
||||
"", ;
|
||||
" pAth for Files...", ;
|
||||
" Specify search path for source files.", ;
|
||||
" The debugger will use this path to search for", ;
|
||||
" files, if not found in the current directory.", ;
|
||||
" NOTE: If not found in the debugger path, the", ;
|
||||
" directories specified in the environment's PATH", ;
|
||||
" will be searched.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
" Save Settings", ;
|
||||
" Save debugger settings to a script file.", ;
|
||||
"", ;
|
||||
" Restore Settings", ;
|
||||
" Restore debugger settings from a previously", ;
|
||||
" saved script file." }
|
||||
|
||||
aTopics[ 20 ][ 2 ] := { ;
|
||||
"Options:", ;
|
||||
"", ;
|
||||
" Next Tab", ;
|
||||
" Make next window active.", ;
|
||||
"", ;
|
||||
" Prev Sh-Tab", ;
|
||||
" Make previous window active.", ;
|
||||
"", ;
|
||||
" Move", ;
|
||||
" Move active window. UP, DOWN, LEFT, RIGHT,", ;
|
||||
" PGUP, PGDN, HOME, END move ENTER finishes,", ;
|
||||
" While Moving, top left corner of window is marked.", ;
|
||||
"", ;
|
||||
" Size", ;
|
||||
" Size active window. UP, DOWN, LEFT, RIGHT,", ;
|
||||
" PGUP, PGDN, HOME, END size ENTER finishes,", ;
|
||||
" While Sizing, bottom right corner of window is marked.", ;
|
||||
"", ;
|
||||
" Zoom F2", ;
|
||||
" Toggles whether active window is Zoomed. When", ;
|
||||
" Zoomed, window will fill entire display area.", ;
|
||||
"", ;
|
||||
" Iconize", ;
|
||||
" Toggles whether active window is Iconized. When", ;
|
||||
" Iconized, window will be one row high and a few", ;
|
||||
" columns wide.", ;
|
||||
"", ;
|
||||
" Tile", ;
|
||||
" Restore all windows to original size and position." }
|
||||
|
||||
aTopics[ 21 ][ 2 ] := { ;
|
||||
"There are two sets of debugger commands:", ;
|
||||
"", ;
|
||||
"1. Menu option commands. These commands are formed", ;
|
||||
"from the menu name, followed by the (first word of)", ;
|
||||
"the option name. For instance, the Monitor:Public", ;
|
||||
"menu option may be invoked via the command:", ;
|
||||
"", ;
|
||||
" Monitor Public", ;
|
||||
"", ;
|
||||
"These commands may be abbreviated down to one letter", ;
|
||||
"per word. However in some cases a second letter will", ;
|
||||
"be required in the second word, as in the case of", ;
|
||||
"Monitor Private:", ;
|
||||
"", ;
|
||||
" M P // invokes Monitor Public", ;
|
||||
" M Pr // invokes Monitor Private", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"2. Other commands. Listed below.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"? <exp>", ;
|
||||
" Display the value of a variable or expression.", ;
|
||||
"", ;
|
||||
"?? <exp>", ;
|
||||
" Inspect the value of a variable or expression.", ;
|
||||
"", ;
|
||||
"ANIMATE", ;
|
||||
" Execute application in Animate Mode.", ;
|
||||
"", ;
|
||||
"BP [<nLineNum> [ <cFileName> ]]|[<cFuncName>]", ;
|
||||
"", ;
|
||||
" BP", ;
|
||||
" Toggle breakpoint at current line in current", ;
|
||||
" source file.", ;
|
||||
"", ;
|
||||
" BP <nLineNum>", ;
|
||||
" Toggle breakpoint at <nLineNum> in current source", ;
|
||||
" file.", ;
|
||||
"", ;
|
||||
" BP <nLineNum> <cFileName>", ;
|
||||
" Toggle breakpoint at <nLineNum> in <cFileName>", ;
|
||||
" source file.", ;
|
||||
" BP <cFuncName>", ;
|
||||
" Toggle breakpoint on function.", ;
|
||||
"", ;
|
||||
"CALLSTACK on|OFF", ;
|
||||
" Toggle display of CallStack window", ;
|
||||
"", ;
|
||||
"DELETE ALL [WP|TP|BP]", ;
|
||||
"DELETE WP|TP|BP <nNumber>", ;
|
||||
" Delete all or particular Watchpoint, Tracepoint", ;
|
||||
" or Breakpoint.", ;
|
||||
"", ;
|
||||
"DOS", ;
|
||||
" Visit the operating system.", ;
|
||||
"", ;
|
||||
"FIND <cSearchString>", ;
|
||||
" Search currently viewed file for specified", ;
|
||||
" character string.", ;
|
||||
"", ;
|
||||
"GO", ;
|
||||
" Execute application in Run Mode.", ;
|
||||
"", ;
|
||||
"GOTO <nLineNum>", ;
|
||||
" Move cursor to specified line in currently viewed", ;
|
||||
" file.", ;
|
||||
"", ;
|
||||
"HELP", ;
|
||||
" Get advice in the form of the Help window.", ;
|
||||
"", ;
|
||||
"INPUT <cFileName>", ;
|
||||
" Read commands from specified Script File.", ;
|
||||
"", ;
|
||||
"LIST BP|WP|TP", ;
|
||||
" List Breakpoints, Watchpoints or Tracepoints in", ;
|
||||
" the Command Window.", ;
|
||||
"", ;
|
||||
"NEXT", ;
|
||||
" Search for next occurence of FIND string.", ;
|
||||
"", ;
|
||||
"NUM ON|off", ;
|
||||
" Toggle display of line numbers in Code window.", ;
|
||||
"", ;
|
||||
"OUTPUT", ;
|
||||
" View application screen.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"PREV", ;
|
||||
" Search for previous occurence of FIND string.", ;
|
||||
"", ;
|
||||
"QUIT", ;
|
||||
" Quit.", ;
|
||||
"", ;
|
||||
"RESTART", ;
|
||||
" Restart application", ;
|
||||
"", ;
|
||||
"RESUME", ;
|
||||
" Resume viewing the currently executing program", ;
|
||||
" code in the Code Window, after VIEWing another", ;
|
||||
" file.", ;
|
||||
"", ;
|
||||
"SPEED <nSpeed>", ;
|
||||
" Set Animate mode step speed. <nSpeed> designates", ;
|
||||
" the number of tenths of a second to delay.", ;
|
||||
" <nSpeed> must be greater than or equal to 0.", ;
|
||||
"", ;
|
||||
"STEP", ;
|
||||
" Execute one line of program code.", ;
|
||||
"", ;
|
||||
"TP <exp>", ;
|
||||
" Establish <exp> as a Tracepoint. <exp> may be a", ;
|
||||
" variable or expression.", ;
|
||||
"", ;
|
||||
"VIEW <cFileName>", ;
|
||||
" View specified file in Code window.", ;
|
||||
"", ;
|
||||
"WP <exp>", ;
|
||||
" Establish <exp> as a Watchpoint. <exp> may be a", ;
|
||||
" variable or expression." }
|
||||
|
||||
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", ;
|
||||
"'myscript.cld'.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"Creating a script file:", ;
|
||||
"", ;
|
||||
"A script file containing all the debugger's current", ;
|
||||
"settings may be created via the Options:Save menu", ;
|
||||
"option. A script file may also be written by hand,", ;
|
||||
"in a text editor.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"Reading a script file:", ;
|
||||
"", ;
|
||||
"A script file may be read into the debugger at any", ;
|
||||
"time using the Options:Restore menu option.", ;
|
||||
"", ;
|
||||
"When using CLD.EXE, a script file may also be", ;
|
||||
"specified on the command line, before the name of", ;
|
||||
"the program to be debugged, i.e.:", ;
|
||||
"", ;
|
||||
" CLD @<ScriptName> <ProgName>", ;
|
||||
"", ;
|
||||
"In both of these, the extension '.cld' will be assumed", ;
|
||||
"if no extension is supplied.", ;
|
||||
"", ;
|
||||
"When reading a script file, the debugger will look", ;
|
||||
"for the file in the current directory first. If the", ;
|
||||
"script is not found there, the debugger will search", ;
|
||||
"all directories in the PATH environment variable.", ;
|
||||
"", ;
|
||||
"", ;
|
||||
"init.cld:", ;
|
||||
"", ;
|
||||
"On startup (or, if it is linked into a program, when", ;
|
||||
"it is first invoked), the debugger will look for a", ;
|
||||
"script file called init.cld, in the current directory", ;
|
||||
"and then, if not found, in the directories specified", ;
|
||||
"by the PATH environment variable.", ;
|
||||
"", ;
|
||||
"If init.cld is found, the debugger will read it", ;
|
||||
"automatically. It is useful to place general", ;
|
||||
"preferences in init.cld -- specifying colors,", ;
|
||||
"turning on the CallStack window, and so on." }
|
||||
|
||||
RETURN aTopics
|
||||
210
src/debug/dbgmenu.prg
Normal file
210
src/debug/dbgmenu.prg
Normal file
@@ -0,0 +1,210 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* The Debugger Menu
|
||||
*
|
||||
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING.txt. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
#pragma -b-
|
||||
|
||||
#xcommand MENU [<oMenu>] => [ <oMenu> := ] HBDbMenu():New()
|
||||
#xcommand MENUITEM [ <oMenuItem> PROMPT ] <cPrompt> ;
|
||||
[ IDENT <nIdent> ] [ ACTION <uAction,...> ] ;
|
||||
[ CHECKED <bChecked> ] => ;
|
||||
[ <oMenuItem> := ] HBDbMenu():AddItem( HBDbMenuItem():New( <cPrompt>,;
|
||||
[{||<uAction>}], [<bChecked>], [<nIdent>] ) )
|
||||
#xcommand SEPARATOR => HBDbMenu():AddItem( HBDbMenuItem():New( "-" ) )
|
||||
#xcommand ENDMENU => ATail( HBDbMenu():aMenus ):Build()
|
||||
|
||||
FUNCTION __dbgBuildMenu( oDebugger ) // Builds the debugger pulldown menu
|
||||
|
||||
LOCAL oMenu
|
||||
|
||||
MENU oMenu
|
||||
MENUITEM " ~File "
|
||||
MENU
|
||||
MENUITEM " ~Open..." ACTION oDebugger:Open()
|
||||
MENUITEM " ~Resume" ACTION oDebugger:Resume()
|
||||
MENUITEM " O~S Shell" ACTION oDebugger:OSShell()
|
||||
SEPARATOR
|
||||
MENUITEM " e~Xit Alt-X " ACTION oDebugger:Quit()
|
||||
ENDMENU
|
||||
|
||||
MENUITEM " ~Locate "
|
||||
MENU
|
||||
MENUITEM " ~Find" ACTION oDebugger:Locate()
|
||||
MENUITEM " ~Next" ACTION oDebugger:FindNext()
|
||||
MENUITEM " ~Previous" ACTION oDebugger:FindPrevious()
|
||||
MENUITEM " ~Goto line..." ACTION oDebugger:SearchLine()
|
||||
SEPARATOR
|
||||
MENUITEM " ~Case sensitive " IDENT "CASE" ;
|
||||
ACTION oDebugger:ToggleCaseSensitive() ;
|
||||
CHECKED oDebugger:lCaseSensitive
|
||||
ENDMENU
|
||||
|
||||
MENUITEM " ~View "
|
||||
MENU
|
||||
MENUITEM " ~Sets" ACTION oDebugger:ViewSets()
|
||||
MENUITEM " ~WorkAreas F6" ACTION oDebugger:ShowWorkAreas()
|
||||
MENUITEM " ~App Screen F4 " ACTION oDebugger:ShowAppScreen()
|
||||
SEPARATOR
|
||||
MENUITEM " ~CallStack" IDENT "CALLSTACK";
|
||||
ACTION oDebugger:Stack() ;
|
||||
CHECKED oDebugger:lShowCallStack
|
||||
ENDMENU
|
||||
|
||||
MENUITEM " ~Run "
|
||||
MENU
|
||||
MENUITEM " ~Animate" IDENT "ANIMATE" ;
|
||||
ACTION ( oDebugger:ToggleAnimate(), oDebugger:Animate() ) ;
|
||||
CHECKED oDebugger:lAnimate
|
||||
MENUITEM " ~Step F8 " ACTION oDebugger:Step()
|
||||
MENUITEM " ~Trace F10" ACTION oDebugger:Trace()
|
||||
MENUITEM " ~Go F5" ACTION oDebugger:Go()
|
||||
MENUITEM " to ~Cursor F7" ACTION oDebugger:ToCursor()
|
||||
MENUITEM " ~Next routine Ctrl-F5" ACTION oDebugger:NextRoutine()
|
||||
SEPARATOR
|
||||
MENUITEM " s~Peed..." ACTION oDebugger:Speed()
|
||||
ENDMENU
|
||||
|
||||
MENUITEM " ~Point "
|
||||
MENU
|
||||
MENUITEM " ~Watchpoint..." ACTION oDebugger:WatchPointAdd()
|
||||
MENUITEM " ~Tracepoint..." ACTION oDebugger:TracePointAdd()
|
||||
MENUITEM " ~Breakpoint F9 " ACTION oDebugger:ToggleBreakPoint()
|
||||
MENUITEM " ~Delete..." ACTION oDebugger:WatchPointDel()
|
||||
ENDMENU
|
||||
|
||||
MENUITEM " ~Monitor "
|
||||
MENU
|
||||
MENUITEM " ~Public" IDENT "PUBLIC" ;
|
||||
ACTION oDebugger:Public() ;
|
||||
CHECKED oDebugger:lShowPublics
|
||||
|
||||
MENUITEM " pri~Vate " IDENT "PRIVATE" ;
|
||||
ACTION oDebugger:Private() ;
|
||||
CHECKED oDebugger:lShowPrivates
|
||||
|
||||
MENUITEM " ~Static" IDENT "STATIC" ;
|
||||
ACTION oDebugger:Static() ;
|
||||
CHECKED oDebugger:lShowStatics
|
||||
|
||||
MENUITEM " ~Local" IDENT "LOCAL" ;
|
||||
ACTION oDebugger:Local() ;
|
||||
CHECKED oDebugger:lShowLocals
|
||||
|
||||
MENUITEM " ~Global" IDENT "GLOBAL" ;
|
||||
ACTION oDebugger:Global() ;
|
||||
CHECKED oDebugger:lShowGlobals
|
||||
|
||||
SEPARATOR
|
||||
|
||||
MENUITEM " ~All" IDENT "ALL" ;
|
||||
ACTION oDebugger:All() ;
|
||||
CHECKED oDebugger:lAll
|
||||
|
||||
MENUITEM " S~how all Globals" IDENT "SHOWALLGLOBALS" ;
|
||||
ACTION oDebugger:ShowAllGlobals() ;
|
||||
CHECKED oDebugger:lShowAllGlobals
|
||||
|
||||
MENUITEM " s~Ort" ACTION oDebugger:Sort()
|
||||
ENDMENU
|
||||
|
||||
MENUITEM " ~Options "
|
||||
MENU
|
||||
MENUITEM " ~Preprocessed Code" IDENT "PPO" ;
|
||||
ACTION oDebugger:OpenPPO() ;
|
||||
CHECKED oDebugger:lPPO
|
||||
MENUITEM " ~Line Numbers" IDENT "LINE" ;
|
||||
ACTION oDebugger:LineNumbers() ;
|
||||
CHECKED oDebugger:lLineNumbers
|
||||
MENUITEM " ~Exchange Screens" ACTION oDebugger:NotSupported()
|
||||
MENUITEM " swap on ~Input" ACTION oDebugger:NotSupported()
|
||||
MENUITEM " code~Block Trace" IDENT "CODEBLOCK" ;
|
||||
ACTION oDebugger:CodeblockTrace() ;
|
||||
CHECKED oDebugger:lCBTrace
|
||||
MENUITEM " ~Menu Bar" ACTION oDebugger:NotSupported()
|
||||
MENUITEM " mono ~Display" IDENT "MONO";
|
||||
ACTION oDebugger:MonoDisplay() ;
|
||||
CHECKED oDebugger:lMonoDisplay
|
||||
MENUITEM " ~Colors..." ACTION oDebugger:Colors()
|
||||
MENUITEM " ~Tab Width..." ACTION oDebugger:TabWidth()
|
||||
MENUITEM " path for ~Files..." ACTION oDebugger:PathForFiles()
|
||||
MENUITEM " R~un at startup" IDENT "ALTD" ;
|
||||
ACTION oDebugger:RunAtStartup() ;
|
||||
CHECKED oDebugger:lRunAtStartup
|
||||
SEPARATOR
|
||||
MENUITEM " ~Save Settings..." ACTION oDebugger:SaveSettings()
|
||||
MENUITEM " ~Restore Settings... " ACTION oDebugger:RestoreSettings()
|
||||
ENDMENU
|
||||
|
||||
MENUITEM " ~Window "
|
||||
MENU
|
||||
MENUITEM " ~Next Tab " ACTION oDebugger:NextWindow()
|
||||
MENUITEM " ~Prev Sh-Tab" ACTION oDebugger:PrevWindow()
|
||||
MENUITEM " ~Move" ACTION oDebugger:NotSupported()
|
||||
MENUITEM " ~Size" ACTION oDebugger:NotSupported()
|
||||
MENUITEM " ~Zoom F2" ACTION oDebugger:NotSupported()
|
||||
MENUITEM " ~Iconize" ACTION oDebugger:NotSupported()
|
||||
SEPARATOR
|
||||
MENUITEM " ~Tile" ACTION oDebugger:NotSupported()
|
||||
ENDMENU
|
||||
|
||||
MENUITEM " ~Help "
|
||||
MENU
|
||||
MENUITEM " ~About Help " ACTION oDebugger:ShowHelp( 0 )
|
||||
SEPARATOR
|
||||
MENUITEM " ~Keys" ACTION oDebugger:ShowHelp( 2 )
|
||||
MENUITEM " ~Windows" ACTION oDebugger:ShowHelp( 6 )
|
||||
MENUITEM " ~Menus" ACTION oDebugger:ShowHelp( 12 )
|
||||
MENUITEM " ~Commands" ACTION oDebugger:ShowHelp( 21 )
|
||||
ENDMENU
|
||||
|
||||
ENDMENU
|
||||
|
||||
RETURN oMenu
|
||||
277
src/debug/dbgtarr.prg
Normal file
277
src/debug/dbgtarr.prg
Normal file
@@ -0,0 +1,277 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* The Debugger Array Inspector
|
||||
*
|
||||
* Copyright 2001 Luiz Rafael Culik <culik@sl.conex.net>
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING.txt. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
#pragma -b-
|
||||
|
||||
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
|
||||
#include "hbclass.ch"
|
||||
|
||||
#include "inkey.ch"
|
||||
#include "setcurs.ch"
|
||||
|
||||
CREATE CLASS HBDbArray
|
||||
|
||||
VAR aWindows INIT {}
|
||||
VAR TheArray
|
||||
VAR arrayname
|
||||
VAR nCurWindow INIT 0
|
||||
VAR lEditable
|
||||
|
||||
METHOD New( aArray, cVarName, lEditable )
|
||||
|
||||
METHOD addWindows( aArray, nRow )
|
||||
METHOD doGet( oBrowse, pItem, nSet )
|
||||
METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, aArray )
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New( aArray, cVarName, lEditable ) CLASS HBDbArray
|
||||
|
||||
hb_default( @lEditable, .T. )
|
||||
|
||||
::arrayName := cVarName
|
||||
::TheArray := aArray
|
||||
::lEditable := lEditable
|
||||
|
||||
::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.." + hb_ntos( nSize ) + "]", "N/W" )
|
||||
ELSE
|
||||
oWndSets := HBDbWindow():New( 1, 5, 2 + nSize, MaxCol() - 5, ::arrayName + "[1.." + hb_ntos( nSize ) + "]", "N/W" )
|
||||
ENDIF
|
||||
ELSE
|
||||
oWndSets := HBDbWindow():New( 1, 5, MaxRow() - 2, MaxCol() - 5, ::arrayName + "[1.." + hb_ntos( nSize ) + "]", "N/W" )
|
||||
ENDIF
|
||||
|
||||
::nCurWindow++
|
||||
oWndSets:lFocused := .T.
|
||||
AAdd( ::aWindows, oWndSets )
|
||||
|
||||
nWidth := oWndSets:nRight - oWndSets:nLeft - 1
|
||||
oBrwSets := HBDbBrowser():New( 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:AddColumn( oCol := HBDbColumnNew( "", {|| ::arrayName + "[" + hb_ntos( oBrwSets:cargo[ 1 ] ) + "]" } ) )
|
||||
oCol:width := Len( ::arrayName + "[" + hb_ntos( Len( aArray ) ) + "]" )
|
||||
oCol:DefColor := { 1, 2 }
|
||||
nColWidth := oCol:Width
|
||||
|
||||
oBrwSets:AddColumn( oCol := HBDbColumnNew( "", {|| PadR( __dbgValToStr( aArray[ oBrwSets:cargo[ 1 ] ] ), nWidth - nColWidth - 1 ) } ) )
|
||||
|
||||
/* 2004-08-09 - <maurilio.longo@libero.it>
|
||||
Setting a fixed width like it is done in the next line of code wich I've
|
||||
commented exploits a bug of current tbrowse, that is, if every column is
|
||||
narrower than tbrowse but the sum of them is wider tbrowse paints
|
||||
one above the other if code like the one inside RefreshVarsS() is called.
|
||||
(That code is used to have current row fully highlighted and not only
|
||||
current cell). Reproducing this situation on a smaller sample with
|
||||
clipper causes that only column two is visible after first stabilization.
|
||||
|
||||
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: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 ) }
|
||||
|
||||
::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
|
||||
|
||||
METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbArray
|
||||
|
||||
LOCAL oErr
|
||||
LOCAL cValue := PadR( __dbgValToStr( pItem[ nSet ] ), ;
|
||||
oBrowse:nRight - oBrowse:nLeft - oBrowse:GetColumn( 1 ):width )
|
||||
|
||||
// make sure browse is stable
|
||||
oBrowse:forceStable()
|
||||
// if confirming new record, append blank
|
||||
|
||||
IF __dbgInput( Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1,, @cValue, ;
|
||||
{| cValue | iif( Type( cValue ) == "UE", ( __dbgAlert( "Expression error" ), .F. ), .T. ) } )
|
||||
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
|
||||
pItem[ nSet ] := &cValue
|
||||
RECOVER USING oErr
|
||||
__dbgAlert( oErr:description )
|
||||
END SEQUENCE
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, aArray ) CLASS HBDbArray
|
||||
|
||||
LOCAL nSet := oBrwSets:cargo[ 1 ]
|
||||
LOCAL cOldName := ::arrayName
|
||||
|
||||
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 HB_ISARRAY( aArray[ nSet ] )
|
||||
IF Len( aArray[ nSet ] ) == 0
|
||||
__dbgAlert( "Array is empty" )
|
||||
ELSE
|
||||
SetPos( oWnd:nBottom, oWnd:nLeft )
|
||||
::aWindows[ ::nCurWindow ]:lFocused := .F.
|
||||
::arrayname := ::arrayname + "[" + hb_ntos( nSet ) + "]"
|
||||
::AddWindows( aArray[ nSet ], oBrwSets:RowPos + oBrwSets:nTop )
|
||||
::arrayname := cOldName
|
||||
|
||||
hb_ADel( ::aWindows, ::nCurWindow, .T. )
|
||||
IF ::nCurWindow == 0
|
||||
::nCurWindow := 1
|
||||
ELSE
|
||||
::nCurWindow--
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSEIF HB_ISBLOCK( aArray[ nSet ] ) .OR. HB_ISPOINTER( aArray[ nSet ] )
|
||||
__dbgAlert( "Value cannot be edited" )
|
||||
ELSE
|
||||
IF ::lEditable
|
||||
oBrwSets:RefreshCurrent()
|
||||
IF HB_ISOBJECT( aArray[ nSet ] )
|
||||
__DbgObject( aArray[ nSet ], cName + "[" + hb_ntos( nSet ) + "]" )
|
||||
ELSEIF HB_ISHASH( aArray[ nSet ] )
|
||||
__DbgHashes( aArray[ nSet ], cName + "[" + hb_ntos( nSet ) + "]" )
|
||||
ELSE
|
||||
::doGet( oBrwsets, aArray, nSet )
|
||||
ENDIF
|
||||
oBrwSets:RefreshCurrent()
|
||||
oBrwSets:ForceStable()
|
||||
ELSE
|
||||
__dbgAlert( "Value cannot be edited" )
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
ENDCASE
|
||||
|
||||
RefreshVarsS( oBrwSets )
|
||||
|
||||
::aWindows[ ::nCurWindow ]:SetCaption( cName + "[" + hb_ntos( oBrwSets:cargo[ 1 ] ) + ".." + ;
|
||||
hb_ntos( 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 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 ) )
|
||||
300
src/debug/dbgthsh.prg
Normal file
300
src/debug/dbgthsh.prg
Normal file
@@ -0,0 +1,300 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* The Debugger Hash Inspector
|
||||
*
|
||||
* Copyright 2006 Francesco Saverio Giudice <info / at / fsgiudice / dot / com>
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING.txt. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
#pragma -b-
|
||||
|
||||
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
|
||||
#include "hbclass.ch"
|
||||
|
||||
#include "inkey.ch"
|
||||
#include "setcurs.ch"
|
||||
|
||||
CREATE CLASS HBDbHash
|
||||
|
||||
VAR aWindows INIT {}
|
||||
VAR TheHash
|
||||
VAR hashName
|
||||
VAR nCurWindow INIT 0
|
||||
VAR lEditable
|
||||
|
||||
METHOD New( hHash, cVarName, lEditable )
|
||||
|
||||
METHOD addWindows( hHash, nRow )
|
||||
METHOD doGet( oBrowse, pItem, nSet )
|
||||
METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, hHash )
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New( hHash, cVarName, lEditable ) CLASS HBDbHash
|
||||
|
||||
hb_default( @lEditable, .T. )
|
||||
|
||||
::hashName := cVarName
|
||||
::TheHash := hHash
|
||||
::lEditable := lEditable
|
||||
|
||||
::addWindows( ::TheHash )
|
||||
|
||||
RETURN Self
|
||||
|
||||
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 := HBDbWindow():New( GetTopPos( nRow ), 5, getBottomPos( nRow + nSize + 1 ), MaxCol() - 5, ::hashName + "[1.." + hb_ntos( nSize ) + "]", "N/W" )
|
||||
ELSE
|
||||
oWndSets := HBDbWindow():New( 1, 5, 2 + nSize, MaxCol() - 5, ::hashName + "[1.." + hb_ntos( nSize ) + "]", "N/W" )
|
||||
ENDIF
|
||||
ELSE
|
||||
oWndSets := HBDbWindow():New( 1, 5, MaxRow() - 2, MaxCol() - 5, ::hashName + "[1.." + hb_ntos( nSize ) + "]", "N/W" )
|
||||
ENDIF
|
||||
::nCurWindow++
|
||||
oWndSets:lFocused := .T.
|
||||
AAdd( ::aWindows, oWndSets )
|
||||
|
||||
nWidth := oWndSets:nRight - oWndSets:nLeft - 1
|
||||
oBrwSets := HBDbBrowser():New( 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:AddColumn( oCol := HBDbColumnNew( "", {|| ::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 ) + "]" ) ) } )
|
||||
oCol:width := nKeyLen
|
||||
oCol:DefColor := { 1, 2 }
|
||||
nColWidth := oCol:Width
|
||||
|
||||
oBrwSets:AddColumn( oCol := HBDbColumnNew( "", {|| PadR( __dbgValToStr( hb_HValueAt( hHash, oBrwSets:cargo[ 1 ] ) ), nWidth - nColWidth - 1 ) } ) )
|
||||
|
||||
/* 2004-08-09 - <maurilio.longo@libero.it>
|
||||
Setting a fixed width like it is done in the next line of code wich I've
|
||||
commented exploits a bug of current tbrowse, that is, if every column is
|
||||
narrower than tbrowse but the sum of them is wider tbrowse paints
|
||||
one above the other if code like the one inside RefreshVarsS() is called.
|
||||
(That code is used to have current row fully highlighted and not only
|
||||
current cell). Reproducing this situation on a smaller sample with
|
||||
clipper causes that only column two is visible after first stabilization.
|
||||
|
||||
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: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 ) }
|
||||
|
||||
::aWindows[ ::nCurWindow ]:bPainted := {|| ( oBrwSets:forcestable(), RefreshVarsS( oBrwSets ) ) }
|
||||
::aWindows[ ::nCurWindow ]:bKeyPressed := {| nKey | ::SetsKeyPressed( nKey, oBrwSets, ;
|
||||
::aWindows[ ::nCurWindow ], ::hashName, hHash ) }
|
||||
|
||||
SetCursor( SC_NONE )
|
||||
|
||||
::aWindows[ ::nCurWindow ]:ShowModal()
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbHash
|
||||
|
||||
LOCAL oErr
|
||||
LOCAL cValue := PadR( __dbgValToStr( hb_HValueAt( pItem, nSet ) ), ;
|
||||
oBrowse:nRight - oBrowse:nLeft - oBrowse:GetColumn( 1 ):width )
|
||||
|
||||
// make sure browse is stable
|
||||
oBrowse:forceStable()
|
||||
// if confirming new record, append blank
|
||||
|
||||
IF __dbgInput( Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1,, @cValue, ;
|
||||
{| cValue | iif( Type( cValue ) == "UE", ( __dbgAlert( "Expression error" ), .F. ), .T. ) } )
|
||||
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
|
||||
hb_HValueAt( pItem, nSet, &cValue )
|
||||
RECOVER USING oErr
|
||||
__dbgAlert( oErr:description )
|
||||
END SEQUENCE
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD SetsKeyPressed( nKey, oBrwSets, oWnd, cName, hHash ) CLASS HBDbHash
|
||||
|
||||
LOCAL nSet := oBrwSets:cargo[ 1 ]
|
||||
LOCAL cOldname := ::hashName
|
||||
LOCAL uValue
|
||||
|
||||
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 HB_ISHASH( uValue )
|
||||
|
||||
IF Len( uValue ) == 0
|
||||
__dbgAlert( "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
|
||||
|
||||
hb_ADel( ::aWindows, ::nCurWindow, .T. )
|
||||
IF ::nCurwindow == 0
|
||||
::nCurwindow := 1
|
||||
ELSE
|
||||
::nCurwindow--
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSEIF HB_ISBLOCK( uValue ) .OR. HB_ISPOINTER( uValue )
|
||||
__dbgAlert( "Value cannot be edited" )
|
||||
ELSE
|
||||
IF ::lEditable
|
||||
oBrwSets:RefreshCurrent()
|
||||
IF HB_ISOBJECT( uValue )
|
||||
__DbgObject( uValue, cName + "[" + HashKeyString( hHash, nSet ) + "]" )
|
||||
ELSEIF HB_ISARRAY( uValue )
|
||||
__DbgArrays( uValue, cName + "[" + HashKeyString( hHash, nSet ) + "]" )
|
||||
ELSE
|
||||
::doGet( oBrwSets, hHash, nSet )
|
||||
ENDIF
|
||||
oBrwSets:RefreshCurrent()
|
||||
oBrwSets:ForceStable()
|
||||
ELSE
|
||||
__dbgAlert( "Value cannot be edited" )
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
ENDCASE
|
||||
|
||||
RefreshVarsS( oBrwSets )
|
||||
|
||||
::aWindows[ ::nCurwindow ]:SetCaption( cName + "[" + hb_ntos( oBrwSets:cargo[ 1 ] ) + ".." + ;
|
||||
hb_ntos( 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 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 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 hb_ntos( xVal )
|
||||
ENDCASE
|
||||
|
||||
RETURN AllTrim( __dbgCStr( xVal ) )
|
||||
230
src/debug/dbgtinp.prg
Normal file
230
src/debug/dbgtinp.prg
Normal file
@@ -0,0 +1,230 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* User input class for debugger
|
||||
*
|
||||
* Copyright 2008 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING.txt. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
#pragma -b-
|
||||
|
||||
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
|
||||
#include "hbclass.ch"
|
||||
|
||||
#include "inkey.ch"
|
||||
#include "color.ch"
|
||||
#include "setcurs.ch"
|
||||
|
||||
|
||||
CREATE CLASS HbDbInput
|
||||
|
||||
HIDDEN:
|
||||
|
||||
VAR nRow AS INTEGER
|
||||
VAR nCol AS INTEGER
|
||||
VAR nWidth AS INTEGER
|
||||
VAR nPos AS INTEGER INIT 1
|
||||
VAR nFirst AS INTEGER INIT 1
|
||||
VAR nSize AS INTEGER
|
||||
VAR cValue AS CHARACTER
|
||||
VAR acColor AS ARRAY
|
||||
VAR lFocus AS LOGICAL INIT .F.
|
||||
|
||||
EXPORTED:
|
||||
|
||||
METHOD new( nRow, nCol, nWidth, cValue, cColor, nSize )
|
||||
METHOD applyKey( nKey )
|
||||
METHOD getValue()
|
||||
METHOD setValue( cValue )
|
||||
METHOD setFocus()
|
||||
METHOD killFocus()
|
||||
METHOD display()
|
||||
METHOD newPos( nRow, nCol )
|
||||
METHOD setColor( cColor )
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD new( nRow, nCol, nWidth, cValue, cColor, nSize ) CLASS HbDbInput
|
||||
|
||||
::nRow := nRow
|
||||
::nCol := nCol
|
||||
::nWidth := nWidth
|
||||
::nSize := iif( HB_ISNUMERIC( nSize ), nSize, nWidth )
|
||||
::cValue := PadR( cValue, ::nSize )
|
||||
::nRow := nRow
|
||||
|
||||
::setColor( cColor )
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD SetColor( cColor ) CLASS HbDbInput
|
||||
|
||||
::acColor := { ;
|
||||
hb_ColorIndex( cColor, CLR_STANDARD ), ;
|
||||
hb_ColorIndex( cColor, CLR_ENHANCED ) }
|
||||
IF hb_ColorToN( ::acColor[ 2 ] ) == -1
|
||||
::acColor[ 2 ] := iif( hb_ColorToN( ::acColor[ 1 ] ) != -1, ;
|
||||
::acColor[ 1 ], ;
|
||||
hb_ColorIndex( SetColor(), CLR_ENHANCED ) )
|
||||
ENDIF
|
||||
IF hb_ColorToN( ::acColor[ 1 ] ) == -1
|
||||
::acColor[ 1 ] := hb_ColorIndex( SetColor(), CLR_STANDARD )
|
||||
ENDIF
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD newPos( nRow, nCol ) CLASS HbDbInput
|
||||
|
||||
::nRow := nRow
|
||||
::nCol := nCol
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD setFocus() CLASS HbDbInput
|
||||
|
||||
IF ! ::lFocus
|
||||
::lFocus := .T.
|
||||
::display()
|
||||
ENDIF
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD killFocus() CLASS HbDbInput
|
||||
|
||||
IF ::lFocus
|
||||
::lFocus := .F.
|
||||
::display()
|
||||
ENDIF
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD getValue() CLASS HbDbInput
|
||||
RETURN ::cValue
|
||||
|
||||
METHOD setValue( cValue ) CLASS HbDbInput
|
||||
|
||||
::cValue := PadR( cValue, ::nSize )
|
||||
::nPos := Min( ::nSize, Len( RTrim( ::cValue ) ) + 1 )
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD display() CLASS HbDbInput
|
||||
|
||||
IF ::nPos < ::nFirst
|
||||
::nFirst := ::nPos
|
||||
ELSEIF ::nPos - ::nFirst >= ::nWidth
|
||||
::nFirst := ::nPos - ::nWidth + 1
|
||||
ENDIF
|
||||
hb_DispOutAt( ::nRow, ::nCol, SubStr( ::cValue, ::nFirst, ::nWidth ), ;
|
||||
::acColor[ iif( ::lFocus, 2, 1 ) ] )
|
||||
IF ::lFocus
|
||||
SetPos( ::nRow, ::nCol + ::nPos - ::nFirst )
|
||||
SetCursor( iif( Set( _SET_INSERT ), SC_INSERT, SC_NORMAL ) )
|
||||
ENDIF
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD applyKey( nKey ) CLASS HbDbInput
|
||||
|
||||
LOCAL lUpdate := .T.
|
||||
|
||||
SWITCH nKey
|
||||
CASE K_HOME
|
||||
::nPos := 1
|
||||
EXIT
|
||||
CASE K_END
|
||||
::nPos := Len( RTrim( ::cValue ) ) + 1
|
||||
IF ::nPos > ::nSize
|
||||
::nPos := ::nSize
|
||||
ENDIF
|
||||
EXIT
|
||||
CASE K_LEFT
|
||||
IF ::nPos > 1
|
||||
::nPos--
|
||||
ENDIF
|
||||
EXIT
|
||||
CASE K_RIGHT
|
||||
IF ::nPos < ::nSize
|
||||
::nPos++
|
||||
ENDIF
|
||||
EXIT
|
||||
CASE K_DEL
|
||||
::cValue := Stuff( ::cValue, ::nPos, 1, "" ) + " "
|
||||
EXIT
|
||||
CASE K_BS
|
||||
IF ::nPos > 1
|
||||
::cValue := Stuff( ::cValue, --::nPos, 1, "" ) + " "
|
||||
ENDIF
|
||||
EXIT
|
||||
CASE K_CTRL_Y
|
||||
CASE K_CTRL_DEL
|
||||
::cValue := Space( ::nSize )
|
||||
::nPos := 1
|
||||
EXIT
|
||||
CASE K_INS
|
||||
Set( _SET_INSERT, ! Set( _SET_INSERT ) )
|
||||
EXIT
|
||||
OTHERWISE
|
||||
IF !( hb_keyChar( nKey ) == "" )
|
||||
IF Set( _SET_INSERT )
|
||||
::cValue := Left( Stuff( ::cValue, ::nPos, 0, hb_keyChar( nKey ) ), ::nSize )
|
||||
ELSE
|
||||
::cValue := Stuff( ::cValue, ::nPos, 1, hb_keyChar( nKey ) )
|
||||
ENDIF
|
||||
IF ::nPos < ::nSize
|
||||
::nPos++
|
||||
ENDIF
|
||||
ELSE
|
||||
lUpdate := .F.
|
||||
ENDIF
|
||||
ENDSWITCH
|
||||
|
||||
IF lUpdate
|
||||
::display()
|
||||
ENDIF
|
||||
|
||||
RETURN Self
|
||||
515
src/debug/dbgtmenu.prg
Normal file
515
src/debug/dbgtmenu.prg
Normal file
@@ -0,0 +1,515 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* The Debugger (HBDbMenu class)
|
||||
*
|
||||
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING.txt. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
/* 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] */
|
||||
|
||||
#pragma -b-
|
||||
|
||||
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
|
||||
#include "hbclass.ch"
|
||||
|
||||
#include "hbmemvar.ch"
|
||||
|
||||
#include "box.ch"
|
||||
#include "inkey.ch"
|
||||
#include "setcurs.ch"
|
||||
|
||||
CREATE CLASS HBDbMenu
|
||||
|
||||
METHOD aMenus SETGET
|
||||
|
||||
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()
|
||||
METHOD AddItem( oMenuItem )
|
||||
METHOD Build()
|
||||
METHOD ClosePopup( nPopup )
|
||||
METHOD CLOSE() INLINE ::ClosePopup( ::nOpenPopup ), ::nOpenPopup := 0
|
||||
METHOD DeHilite()
|
||||
METHOD DISPLAY()
|
||||
METHOD EvalAction()
|
||||
METHOD GetHotKeyPos( cKey )
|
||||
METHOD GetItemByIdent( uIdent )
|
||||
METHOD GetItemOrdByCoors( nRow, nCol )
|
||||
METHOD GoBottom()
|
||||
METHOD GoDown() INLINE ::aItems[ ::nOpenPopup ]:bAction:GoRight()
|
||||
METHOD GoLeft()
|
||||
METHOD GoRight()
|
||||
METHOD GoTop()
|
||||
METHOD GoUp() INLINE ::aItems[ ::nOpenPopup ]:bAction:GoLeft()
|
||||
METHOD IsOpen() INLINE ::nOpenPopup != 0
|
||||
METHOD LoadColors() // Load current debugger colors settings
|
||||
METHOD ProcessKey( nKey )
|
||||
METHOD Refresh() // Repaints the top bar
|
||||
METHOD ShowPopup( nPopup )
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD aMenus( xNewVal ) CLASS HBDbMenu
|
||||
|
||||
THREAD STATIC t_aMenus
|
||||
|
||||
IF PCount() > 0
|
||||
t_aMenus := xNewVal
|
||||
ENDIF
|
||||
|
||||
RETURN t_aMenus
|
||||
|
||||
METHOD New() CLASS HBDbMenu
|
||||
|
||||
IF ::aMenus == NIL
|
||||
::aMenus := {}
|
||||
::lPopup := .F.
|
||||
ELSE
|
||||
::lPopup := .T.
|
||||
ENDIF
|
||||
|
||||
::nTop := 0
|
||||
::nLeft := 0
|
||||
::nBottom := 0
|
||||
::nRight := 0
|
||||
::aItems := {}
|
||||
::LoadColors()
|
||||
::nOpenPopup := 0
|
||||
|
||||
AAdd( ::aMenus, Self )
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD AddItem( oMenuItem ) CLASS HBDbMenu
|
||||
|
||||
LOCAL oLastMenu := ATail( ::aMenus )
|
||||
LOCAL oLastMenuItem
|
||||
|
||||
IF oLastMenu:lPopup
|
||||
oMenuItem:nRow := Len( oLastMenu:aItems )
|
||||
oMenuItem:nCol := oLastMenu:nLeft + 1
|
||||
ELSE
|
||||
oMenuItem:nRow := 0
|
||||
IF Len( oLastMenu:aItems ) > 0
|
||||
oLastMenuItem := ATail( oLastMenu:aItems )
|
||||
oMenuItem:nCol := oLastMenuItem:nCol + ;
|
||||
Len( StrTran( oLastMenuItem:cPrompt, "~" ) )
|
||||
ELSE
|
||||
oMenuItem:nCol := 0
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
AAdd( ATail( ::aMenus ):aItems, oMenuItem )
|
||||
|
||||
RETURN oMenuItem
|
||||
|
||||
METHOD Build() CLASS HBDbMenu
|
||||
|
||||
LOCAL n
|
||||
LOCAL nPos := 0
|
||||
LOCAL oMenuItem
|
||||
|
||||
IF Len( ::aMenus ) == 1 // pulldown menu
|
||||
FOR n := 1 TO Len( ::aItems )
|
||||
::aItems[ n ]:nRow := 0
|
||||
::aItems[ n ]:nCol := nPos
|
||||
nPos += Len( StrTran( ::aItems[ n ]:cPrompt, "~" ) )
|
||||
NEXT
|
||||
ELSE
|
||||
oMenuItem := ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems )
|
||||
::nTop := oMenuItem:nRow + 1
|
||||
::nLeft := oMenuItem:nCol
|
||||
nPos := ::nLeft
|
||||
FOR n := 1 TO Len( ::aItems )
|
||||
::aItems[ n ]:nRow := ::nTop + n
|
||||
::aItems[ n ]:nCol := ::nLeft + 1
|
||||
nPos := Max( nPos, ::nLeft + Len( StrTran( ::aItems[ n ]:cPrompt, "~" ) ) + 1 )
|
||||
NEXT
|
||||
::nRight := nPos + 1
|
||||
::nBottom := ::nTop + Len( ::aItems ) + 1
|
||||
FOR n := 1 TO Len( ::aItems )
|
||||
IF !( Left( ::aItems[ n ]:cPrompt, 1 ) == "-" )
|
||||
::aItems[ n ]:cPrompt := " " + PadR( ::aItems[ n ]:cPrompt, ::nRight - ::nLeft - 1 )
|
||||
ENDIF
|
||||
NEXT
|
||||
ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ):bAction := ATail( ::aMenus )
|
||||
::aMenus := ASize( ::aMenus, Len( ::aMenus ) - 1 )
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD ClosePopup( nPopup ) CLASS HBDbMenu
|
||||
|
||||
LOCAL oPopup
|
||||
|
||||
IF nPopup != 0
|
||||
oPopup := ::aItems[ nPopup ]:bAction
|
||||
IF HB_ISOBJECT( oPopup )
|
||||
RestScreen( oPopup:nTop, oPopup:nLeft, oPopup:nBottom + 1, oPopup:nRight + 2, ;
|
||||
oPopup:cBackImage )
|
||||
oPopup:cBackImage := NIL
|
||||
ENDIF
|
||||
::aItems[ nPopup ]:Display( ::cClrPopup, ::cClrHotKey )
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD DeHilite() CLASS HBDbMenu
|
||||
|
||||
LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]
|
||||
|
||||
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD Display() CLASS HBDbMenu
|
||||
|
||||
LOCAL n
|
||||
|
||||
SetColor( ::cClrPopup )
|
||||
|
||||
IF ! ::lPopup
|
||||
hb_DispOutAt( 0, 0, Space( MaxCol() + 1 ), ::cClrPopup )
|
||||
SetPos( 0, 0 )
|
||||
ELSE
|
||||
::cBackImage := SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 2 )
|
||||
hb_DispBox( ::nTop, ::nLeft, ::nBottom, ::nRight, HB_B_SINGLE_UNI )
|
||||
hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight )
|
||||
ENDIF
|
||||
|
||||
FOR n := 1 TO Len( ::aItems )
|
||||
IF ::aItems[ n ]:cPrompt == "-" // Separator
|
||||
hb_DispOutAtBox( ::aItems[ n ]:nRow, ::nLeft, ;
|
||||
hb_UTF8ToStrBox( "├" + Replicate( "─", ::nRight - ::nLeft - 1 ) + "┤" ) )
|
||||
ELSE
|
||||
::aItems[ n ]:Display( ::cClrPopup, ::cClrHotKey )
|
||||
ENDIF
|
||||
NEXT
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD EvalAction() CLASS HBDbMenu
|
||||
|
||||
LOCAL oPopup, oMenuItem
|
||||
|
||||
oPopup := ::aItems[ ::nOpenPopup ]:bAction
|
||||
oMenuItem := oPopup:aItems[ oPopup:nOpenPopup ]
|
||||
|
||||
IF oMenuItem:bAction != NIL
|
||||
::Close()
|
||||
Eval( oMenuItem:bAction, oMenuItem )
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD GetHotKeyPos( cKey ) CLASS HBDbMenu
|
||||
|
||||
LOCAL n
|
||||
|
||||
FOR n := 1 TO Len( ::aItems )
|
||||
IF Upper( SubStr( ::aItems[ n ]:cPrompt, ;
|
||||
At( "~", ::aItems[ n ]:cPrompt ) + 1, 1 ) ) == cKey
|
||||
RETURN n
|
||||
ENDIF
|
||||
NEXT
|
||||
|
||||
RETURN 0
|
||||
|
||||
METHOD GetItemOrdByCoors( nRow, nCol ) CLASS HBDbMenu
|
||||
|
||||
LOCAL n
|
||||
|
||||
FOR n := 1 TO Len( ::aItems )
|
||||
IF ::aItems[ n ]:nRow == nRow .AND. nCol >= ::aItems[ n ]:nCol .AND. ;
|
||||
nCol <= ::aItems[ n ]:nCol + Len( ::aItems[ n ]:cPrompt ) - 2
|
||||
RETURN n
|
||||
ENDIF
|
||||
NEXT
|
||||
|
||||
RETURN 0
|
||||
|
||||
METHOD GetItemByIdent( uIdent ) CLASS HBDbMenu
|
||||
|
||||
LOCAL n
|
||||
LOCAL oItem
|
||||
|
||||
FOR n := 1 TO Len( ::aItems )
|
||||
IF HB_ISOBJECT( ::aItems[ n ]:bAction )
|
||||
oItem := ::aItems[ n ]:bAction:GetItemByIdent( uIdent )
|
||||
IF oItem != NIL
|
||||
RETURN oItem
|
||||
ENDIF
|
||||
ELSE
|
||||
IF ValType( ::aItems[ n ]:Ident ) == ValType( uIdent ) .AND. ;
|
||||
::aItems[ n ]:Ident == uIdent
|
||||
RETURN ::aItems[ n ]
|
||||
ENDIF
|
||||
ENDIF
|
||||
NEXT
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD GoBottom() CLASS HBDbMenu
|
||||
|
||||
LOCAL oPopup
|
||||
|
||||
IF ::IsOpen()
|
||||
oPopup := ::aItems[ ::nOpenPopup ]:bAction
|
||||
oPopup:DeHilite()
|
||||
oPopup:ShowPopup( Len( oPopup:aItems ) )
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD GoLeft() CLASS HBDbMenu
|
||||
|
||||
LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]
|
||||
|
||||
IF ::nOpenPopup != 0
|
||||
IF ! ::lPopup
|
||||
::ClosePopup( ::nOpenPopup )
|
||||
ELSE
|
||||
oMenuItem:Display( ::cClrPopup, ::CClrHotKey )
|
||||
ENDIF
|
||||
IF ::nOpenPopup > 1
|
||||
--::nOpenPopup
|
||||
DO WHILE ::nOpenPopup > 1 .AND. ;
|
||||
SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-"
|
||||
--::nOpenPopup
|
||||
ENDDO
|
||||
::ShowPopup( ::nOpenPopup )
|
||||
ELSE
|
||||
::ShowPopup( ::nOpenPopup := Len( ::aItems ) )
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD GoRight() CLASS HBDbMenu
|
||||
|
||||
LOCAL oMenuItem := ::aItems[ ::nOpenPopup ]
|
||||
|
||||
IF ::nOpenPopup != 0
|
||||
IF ! ::lPopup
|
||||
::ClosePopup( ::nOpenPopup )
|
||||
ELSE
|
||||
oMenuItem:Display( ::cClrPopup, ::cClrHotKey )
|
||||
ENDIF
|
||||
IF ::nOpenPopup < Len( ::aItems )
|
||||
++::nOpenPopup
|
||||
DO WHILE ::nOpenPopup < Len( ::aItems ) .AND. ;
|
||||
SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-"
|
||||
++::nOpenPopup
|
||||
ENDDO
|
||||
::ShowPopup( ::nOpenPopup )
|
||||
ELSE
|
||||
::ShowPopup( ::nOpenPopup := 1 )
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD GoTop() CLASS HBDbMenu
|
||||
|
||||
LOCAL oPopup
|
||||
|
||||
IF ::IsOpen()
|
||||
oPopup := ::aItems[ ::nOpenPopup ]:bAction
|
||||
oPopup:DeHilite()
|
||||
oPopup:ShowPopup( 1 )
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD LoadColors() CLASS HBDbMenu
|
||||
|
||||
LOCAL aColors := __DbgColors()
|
||||
LOCAL n
|
||||
|
||||
::cClrPopup := aColors[ 8 ]
|
||||
::cClrHotKey := aColors[ 9 ]
|
||||
::cClrHilite := aColors[ 10 ]
|
||||
::cClrHotFocus := aColors[ 11 ]
|
||||
|
||||
FOR n := 1 TO Len( ::aItems )
|
||||
IF HB_ISOBJECT( ::aItems[ n ]:bAction )
|
||||
::aItems[ n ]:bAction:LoadColors()
|
||||
ENDIF
|
||||
NEXT
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD Refresh() CLASS HBDbMenu
|
||||
|
||||
LOCAL n
|
||||
|
||||
DispBegin()
|
||||
|
||||
IF ! ::lPopup
|
||||
hb_DispOutAt( 0, 0, Space( MaxCol() + 1 ), ::cClrPopup )
|
||||
SetPos( 0, 0 )
|
||||
ENDIF
|
||||
|
||||
FOR n := 1 TO Len( ::aItems )
|
||||
::aItems[ n ]:Display( ::cClrPopup, ::cClrHotKey )
|
||||
NEXT
|
||||
|
||||
DispEnd()
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD ShowPopup( nPopup ) CLASS HBDbMenu
|
||||
|
||||
::aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus )
|
||||
::nOpenPopup := nPopup
|
||||
|
||||
IF HB_ISOBJECT( ::aItems[ nPopup ]:bAction )
|
||||
::aItems[ nPopup ]:bAction:Display()
|
||||
::aItems[ nPopup ]:bAction:ShowPopup( 1 )
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD ProcessKey( nKey ) CLASS HBDbMenu
|
||||
|
||||
LOCAL nPopup
|
||||
LOCAL oPopup
|
||||
|
||||
DO CASE
|
||||
CASE nKey == K_LBUTTONDOWN
|
||||
IF MRow() == 0
|
||||
IF ( nPopup := ::GetItemOrdByCoors( 0, MCol() ) ) != 0
|
||||
IF nPopup != ::nOpenPopup
|
||||
::ClosePopup( ::nOpenPopup )
|
||||
::ShowPopup( nPopup )
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSE
|
||||
oPopup := ::aItems[ ::nOpenPopup ]:bAction
|
||||
IF ( nPopup := oPopup:GetItemOrdByCoors( MRow(), MCol() ) ) == 0
|
||||
::Close()
|
||||
ELSE
|
||||
oPopup:DeHilite()
|
||||
oPopup:nOpenPopup := nPopup
|
||||
oPopup:aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus )
|
||||
::EvalAction()
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
CASE nKey == K_ESC
|
||||
::Close()
|
||||
|
||||
CASE nKey == K_LEFT
|
||||
::GoLeft()
|
||||
|
||||
CASE nKey == K_RIGHT
|
||||
::GoRight()
|
||||
|
||||
CASE nKey == K_DOWN
|
||||
::GoDown()
|
||||
|
||||
CASE nKey == K_UP
|
||||
::GoUp()
|
||||
|
||||
CASE nKey == K_ENTER
|
||||
::EvalAction()
|
||||
|
||||
CASE nKey == K_HOME
|
||||
::GoTop()
|
||||
|
||||
CASE nKey == K_END
|
||||
::GoBottom()
|
||||
|
||||
OTHERWISE
|
||||
|
||||
IF ::nOpenPopup > 0
|
||||
IF IsAlpha( hb_keyChar( nKey ) )
|
||||
oPopup := ::aItems[ ::nOpenPopup ]:bAction
|
||||
nPopup := oPopup:GetHotKeyPos( Upper( hb_keyChar( nKey ) ) )
|
||||
IF nPopup > 0 .AND. oPopup:nOpenPopup != nPopup
|
||||
oPopup:DeHilite()
|
||||
oPopup:ShowPopup( nPopup )
|
||||
::EvalAction()
|
||||
ENDIF
|
||||
ENDIF
|
||||
ELSE
|
||||
nPopup := ::GetHotKeyPos( __dbgAltToKey( nKey ) )
|
||||
IF nPopup != ::nOpenPopup
|
||||
::Close()
|
||||
::ShowPopup( nPopup )
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
ENDCASE
|
||||
|
||||
RETURN NIL
|
||||
|
||||
FUNCTION __dbgAltToKey( nKey )
|
||||
|
||||
LOCAL nIndex := AScan( { ;
|
||||
K_ALT_A, K_ALT_B, K_ALT_C, K_ALT_D, K_ALT_E, K_ALT_F, ;
|
||||
K_ALT_G, K_ALT_H, K_ALT_I, K_ALT_J, K_ALT_K, K_ALT_L, ;
|
||||
K_ALT_M, K_ALT_N, K_ALT_O, K_ALT_P, K_ALT_Q, K_ALT_R, ;
|
||||
K_ALT_S, K_ALT_T, K_ALT_U, K_ALT_V, K_ALT_W, K_ALT_X, ;
|
||||
K_ALT_Y, K_ALT_Z, K_ALT_1, K_ALT_2, K_ALT_3, K_ALT_4, ;
|
||||
K_ALT_5, K_ALT_6, K_ALT_7, K_ALT_8, K_ALT_9, K_ALT_0 }, nKey )
|
||||
|
||||
RETURN iif( nIndex > 0, SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890", nIndex, 1 ), "" )
|
||||
103
src/debug/dbgtmitm.prg
Normal file
103
src/debug/dbgtmitm.prg
Normal file
@@ -0,0 +1,103 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* The Debugger (HBDbMenuItem Class)
|
||||
*
|
||||
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING.txt. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
/* 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] */
|
||||
|
||||
#pragma -b-
|
||||
|
||||
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
|
||||
#include "hbclass.ch"
|
||||
|
||||
CREATE CLASS HBDbMenuItem
|
||||
|
||||
VAR nRow
|
||||
VAR nCol
|
||||
VAR cPrompt
|
||||
VAR bAction
|
||||
VAR lChecked
|
||||
VAR Ident
|
||||
|
||||
ACCESS Checked() INLINE ::lChecked
|
||||
ASSIGN Checked( lChecked ) INLINE ::lChecked := lChecked
|
||||
|
||||
METHOD New( cPrompt, bAction, lChecked, xIdent )
|
||||
METHOD Display( cClrText, cClrHotKey )
|
||||
METHOD Toggle() INLINE ::lChecked := ! ::lChecked
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New( cPrompt, bAction, lChecked, xIdent ) CLASS HBDbMenuItem
|
||||
|
||||
hb_default( @lChecked, .F. )
|
||||
|
||||
::cPrompt := cPrompt
|
||||
::bAction := bAction
|
||||
::lChecked := lChecked
|
||||
::Ident := xIdent
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD Display( cClrText, cClrHotKey ) CLASS HBDbMenuItem
|
||||
|
||||
LOCAL nAt
|
||||
|
||||
hb_DispOutAt( ::nRow, ::nCol, StrTran( ::cPrompt, "~" ), cClrText )
|
||||
|
||||
hb_DispOutAt( ::nRow, ::nCol + ;
|
||||
( nAt := At( "~", ::cPrompt ) ) - 1, ;
|
||||
SubStr( ::cPrompt, nAt + 1, 1 ), cClrHotKey )
|
||||
|
||||
hb_DispOutAtBox( ::nRow, ::nCol, iif( ::lChecked, hb_UTF8ToStrBox( "√" ), "" ), cClrText )
|
||||
|
||||
RETURN Self
|
||||
354
src/debug/dbgtobj.prg
Normal file
354
src/debug/dbgtobj.prg
Normal file
@@ -0,0 +1,354 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* The Debugger Object Inspector
|
||||
*
|
||||
* Copyright 2001 Luiz Rafael Culik <culik@sl.conex.net>
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING.txt. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
#pragma -b-
|
||||
|
||||
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
|
||||
#include "hbclass.ch"
|
||||
|
||||
#include "inkey.ch"
|
||||
#include "setcurs.ch"
|
||||
|
||||
CREATE CLASS HBDbObject
|
||||
|
||||
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( oObject, cVarName, lEditable )
|
||||
METHOD addWindows( aArray, nRow )
|
||||
METHOD doGet( oBrowse, pItem, nSet )
|
||||
METHOD SetsKeyPressed( nKey, oBrwSets, nSets, aArray )
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New( oObject, cVarName, lEditable ) CLASS HBDbObject
|
||||
|
||||
LOCAL cMsg, cMsgAcc
|
||||
LOCAL aMessages, aMethods
|
||||
LOCAL xValue
|
||||
|
||||
hb_default( @lEditable, .T. )
|
||||
|
||||
__dbgSetGo( __Dbg():pInfo )
|
||||
|
||||
/* create list of object messages */
|
||||
aMessages := oObject:classSel()
|
||||
ASort( aMessages,,, {| x, y | PadR( x, 64 ) <= PadR( y, 64 ) } )
|
||||
aMethods := {}
|
||||
FOR EACH cMsg IN aMessages
|
||||
IF Left( cMsg, 1 ) == "_" .AND. ;
|
||||
hb_AScan( aMessages, cMsgAcc := SubStr( cMsg, 2 ),,, .T. ) != 0
|
||||
xValue := __dbgObjGetValue( oObject, cMsgAcc )
|
||||
AAdd( ::pItems, { cMsgAcc, xValue, .T. } )
|
||||
AAdd( ::AllNames, cMsgAcc )
|
||||
ELSEIF hb_AScan( aMessages, "_" + cMsg,,, .T. ) == 0
|
||||
AAdd( aMethods, cMsg )
|
||||
ENDIF
|
||||
NEXT
|
||||
FOR EACH cMsg IN aMethods
|
||||
AAdd( ::pItems, { Lower( cMsg ), "Method", .F. } )
|
||||
AAdd( ::AllNames, cMsg )
|
||||
NEXT
|
||||
|
||||
::objname := cVarName
|
||||
::TheObj := oObject
|
||||
::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 )
|
||||
|
||||
nWidth := oWndSets:nRight - oWndSets:nLeft - 1
|
||||
|
||||
oBrwSets := HBDbBrowser():New( oWndSets:nTop + 1, oWndSets:nLeft + 1, oWndSets:nBottom - 1, oWndSets:nRight - 1 )
|
||||
::ArrayReference := aArray
|
||||
|
||||
oBrwSets:autolite := .T.
|
||||
oBrwSets:ColorSpec := __Dbg():ClrModal()
|
||||
oBrwSets:GoTopBlock := {|| ::Arrayindex := 1 }
|
||||
oBrwSets:GoBottomBlock := {|| ::arrayindex := Len( ::ArrayReference ) }
|
||||
oBrwSets:SkipBlock := {| nSkip, nPos | nPos := ::arrayindex, ;
|
||||
::arrayindex := iif( nSkip > 0, Min( ::arrayindex + nSkip, Len( ::arrayReference ) ), ;
|
||||
Max( 1, ::arrayindex + nSkip ) ), ::arrayindex - nPos }
|
||||
|
||||
nMaxLen := ArrayMaxLen( ::AllNames )
|
||||
oBrwSets:AddColumn( oCol := HBDbColumnNew( "", ;
|
||||
{|| PadR( ::ArrayReference[ ::arrayindex, 1 ], nMaxLen ) } ) )
|
||||
oCol:width := nMaxLen
|
||||
oCol:ColorBlock := {|| { iif( ::Arrayindex == oBrwSets:Cargo, 2, 1 ), 2 } }
|
||||
oBrwSets:Freeze := 1
|
||||
|
||||
oBrwSets:AddColumn( oCol := HBDbColumnNew( "", {|| iif( HB_ISSTRING( ::ArrayReference[ ::ArrayIndex, 2 ] ) .AND. ! ::ArrayReference[ ::ArrayIndex, 3 ], ;
|
||||
::ArrayReference[ ::ArrayIndex, 2 ], ;
|
||||
PadR( __dbgValToStr( __dbgObjGetValue( ::TheObj, ::ArrayReference[ ::arrayindex, 1 ] ) ), nWidth - 12 ) ) } ) )
|
||||
|
||||
oBrwSets:Cargo := 1 // Actual highlighted row
|
||||
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 ), ::ArrayReference ) }
|
||||
::aWindows[ ::nCurwindow ]:cCaption := ::objname + " is of class: " + ::TheObj:ClassName()
|
||||
|
||||
SetCursor( SC_NONE )
|
||||
|
||||
::aWindows[ ::nCurWindow ]:ShowModal()
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbObject
|
||||
|
||||
LOCAL column
|
||||
LOCAL cValue
|
||||
LOCAL lCanAcc
|
||||
LOCAL oErr
|
||||
|
||||
// make sure browse is stable
|
||||
oBrowse:forceStable()
|
||||
// if confirming new record, append blank
|
||||
|
||||
// get column object from browse
|
||||
column := oBrowse:getColumn( oBrowse:colPos )
|
||||
|
||||
// create a corresponding GET
|
||||
cValue := __dbgObjGetValue( ::TheObj, pitem[ nSet, 1 ], @lCanAcc )
|
||||
IF ! lCanAcc
|
||||
__dbgAlert( cValue )
|
||||
RETURN NIL
|
||||
ENDIF
|
||||
cValue := PadR( __dbgValToStr( cValue ), column:Width )
|
||||
|
||||
IF __dbgInput( Row(), oBrowse:nLeft + oBrowse:GetColumn( 1 ):width + 1,, @cValue, ;
|
||||
{| cValue | iif( Type( cValue ) == "UE", ( __dbgAlert( "Expression error" ), .F. ), .T. ) } )
|
||||
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
|
||||
__dbgObjSetValue( ::TheObj, pitem[ nSet, 1 ], &cValue )
|
||||
RECOVER USING oErr
|
||||
__dbgAlert( oErr:description )
|
||||
END SEQUENCE
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD SetsKeyPressed( nKey, oBrwSets, nSets, aArray ) CLASS HBDbObject
|
||||
|
||||
LOCAL nSet := oBrwSets:Cargo
|
||||
|
||||
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 .OR. nKey == K_CTRL_PGUP .OR. nKey == K_CTRL_HOME
|
||||
|
||||
IF oBrwSets:Cargo > 1
|
||||
oBrwSets:Cargo := 1
|
||||
oBrwSets:GoTop()
|
||||
oBrwSets:ForceStable()
|
||||
ENDIF
|
||||
|
||||
CASE nKey == K_END .OR. nKey == K_CTRL_PGDN .OR. nKey == K_CTRL_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 HB_ISARRAY( aArray[ nSet, 2 ] )
|
||||
IF Len( aArray[ nSet, 2 ] ) > 0
|
||||
HBDbArray():New( aArray[ nSet, 2 ], ::pitems[ nSet, 1 ] )
|
||||
ENDIF
|
||||
ELSEIF HB_ISHASH( aArray[ nSet, 2 ] )
|
||||
IF Len( aArray[ nSet, 2 ] ) > 0
|
||||
HBDbHash():New( aArray[ nSet, 2 ], ::pitems[ nSet, 1 ] )
|
||||
ENDIF
|
||||
ELSEIF HB_ISOBJECT( aArray[ nSet, 2 ] )
|
||||
HBDbObject():New( aArray[ nSet, 2 ], ::pitems[ nSet, 1 ] )
|
||||
ELSEIF ( HB_ISSTRING( aArray[ nSet, 2 ] ) .AND. ;
|
||||
! aArray[ nSet, 3 ] ) .OR. ;
|
||||
HB_ISBLOCK( aArray[ nSet, 2 ] ) .OR. ;
|
||||
HB_ISPOINTER( aArray[ nSet, 2 ] )
|
||||
__dbgAlert( "Value cannot be edited" )
|
||||
ELSE
|
||||
IF ::lEditable
|
||||
oBrwSets:RefreshCurrent()
|
||||
::doGet( oBrwSets, ::arrayReference, nSet )
|
||||
oBrwSets:RefreshCurrent()
|
||||
oBrwSets:ForceStable()
|
||||
ELSE
|
||||
__dbgAlert( "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 nMaxLen
|
||||
|
||||
STATIC FUNCTION __dbgObjGetValue( oObject, cVar, lCanAcc )
|
||||
|
||||
LOCAL nProcLevel := __Dbg():nProcLevel
|
||||
LOCAL xResult
|
||||
LOCAL oErr
|
||||
|
||||
BEGIN SEQUENCE WITH {|| Break() }
|
||||
xResult := __dbgSENDMSG( nProcLevel, oObject, cVar )
|
||||
lCanAcc := .T.
|
||||
RECOVER
|
||||
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
|
||||
/* Try to access variables using class code level */
|
||||
xResult := __dbgSENDMSG( 0, oObject, cVar )
|
||||
lCanAcc := .T.
|
||||
RECOVER USING oErr
|
||||
xResult := oErr:description
|
||||
lCanAcc := .F.
|
||||
END SEQUENCE
|
||||
END SEQUENCE
|
||||
|
||||
RETURN xResult
|
||||
|
||||
STATIC FUNCTION __dbgObjSetValue( oObject, cVar, xValue )
|
||||
|
||||
LOCAL nProcLevel := __Dbg():nProcLevel
|
||||
LOCAL oErr
|
||||
|
||||
BEGIN SEQUENCE WITH {|| Break() }
|
||||
__dbgSENDMSG( nProcLevel, oObject, "_" + cVar, xValue )
|
||||
RECOVER
|
||||
BEGIN SEQUENCE WITH {| oErr | Break( oErr ) }
|
||||
/* Try to access variables using class code level */
|
||||
__dbgSENDMSG( 0, oObject, "_" + cVar, xValue )
|
||||
RECOVER USING oErr
|
||||
__dbgAlert( oErr:description )
|
||||
END SEQUENCE
|
||||
END SEQUENCE
|
||||
|
||||
RETURN xValue
|
||||
401
src/debug/dbgtwin.prg
Normal file
401
src/debug/dbgtwin.prg
Normal file
@@ -0,0 +1,401 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* The Debugger
|
||||
*
|
||||
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING.txt. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
/*
|
||||
* The following parts are Copyright of the individual authors.
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* Copyright 2000 Luiz Rafael Culik <culik@sl.conex.net>
|
||||
* :Move()
|
||||
*
|
||||
* See COPYING.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] */
|
||||
|
||||
#pragma -b-
|
||||
|
||||
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
|
||||
#include "hbclass.ch"
|
||||
|
||||
#include "hbmemvar.ch"
|
||||
|
||||
#include "box.ch"
|
||||
#include "inkey.ch"
|
||||
#include "setcurs.ch"
|
||||
|
||||
CREATE CLASS HBDbWindow // Debugger windows and dialogs
|
||||
|
||||
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
|
||||
METHOD Clear()
|
||||
METHOD ScrollUp( nLines )
|
||||
METHOD SetCaption( cCaption )
|
||||
METHOD ShowCaption()
|
||||
METHOD SetFocus( lOnOff )
|
||||
METHOD Show( lFocused )
|
||||
METHOD ShowModal()
|
||||
METHOD LButtonDown( nMRow, nMCol )
|
||||
METHOD LDblClick( nMRow, nMCol )
|
||||
METHOD LoadColors()
|
||||
|
||||
METHOD Move()
|
||||
METHOD KeyPressed( nKey )
|
||||
METHOD Refresh()
|
||||
METHOD Resize( nTop, nLeft, nBottom, nRight )
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) CLASS HBDbWindow
|
||||
|
||||
hb_default( @cColor, __DbgColors()[ 1 ] )
|
||||
|
||||
::nTop := nTop
|
||||
::nLeft := nLeft
|
||||
::nBottom := nBottom
|
||||
::nRight := nRight
|
||||
::cCaption := cCaption
|
||||
::cColor := cColor
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD Clear() CLASS HBDbWindow
|
||||
|
||||
SetColor( ::cColor )
|
||||
hb_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 )
|
||||
::cBackImage := NIL
|
||||
::lVisible := .F.
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD IsOver( nRow, nCol ) CLASS HBDbWindow
|
||||
|
||||
RETURN nRow >= ::nTop .AND. nRow <= ::nBottom .AND. ;
|
||||
nCol >= ::nLeft .AND. nCol <= ::nRight
|
||||
|
||||
METHOD ScrollUp( nLines ) CLASS HBDbWindow
|
||||
|
||||
hb_default( @nLines, 1 )
|
||||
|
||||
SetColor( ::cColor )
|
||||
hb_Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1, nLines )
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD SetCaption( cCaption ) CLASS HBDbWindow
|
||||
|
||||
::cCaption := cCaption
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD ShowCaption() CLASS HBDbWindow
|
||||
|
||||
IF ! Empty( ::cCaption )
|
||||
hb_DispOutAt( ::nTop, ::nLeft + ( ( ::nRight - ::nLeft ) / 2 ) - ;
|
||||
( ( Len( ::cCaption ) + 2 ) / 2 ), ;
|
||||
" " + ::cCaption + " ", ::cColor )
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD SetFocus( lOnOff ) CLASS HBDbWindow
|
||||
|
||||
IF ! lOnOff .AND. ::bLostFocus != NIL
|
||||
Eval( ::bLostFocus, Self )
|
||||
ENDIF
|
||||
|
||||
::lFocused := lOnOff
|
||||
|
||||
IF lOnOff .AND. ::bGotFocus != NIL
|
||||
Eval( ::bGotFocus, Self )
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD Refresh() CLASS HBDbWindow
|
||||
|
||||
DispBegin()
|
||||
|
||||
hb_DispBox( ::nTop, ::nLeft, ::nBottom, ::nRight, iif( ::lFocused, HB_B_DOUBLE_UNI, HB_B_SINGLE_UNI ), ::cColor )
|
||||
hb_DispOutAtBox( ::nTop, ::nLeft + 1, hb_UTF8ToStrBox( "[■]" ), ::cColor )
|
||||
|
||||
::ShowCaption( ::cCaption )
|
||||
|
||||
IF ::bPainted != NIL
|
||||
Eval( ::bPainted, Self )
|
||||
ENDIF
|
||||
|
||||
DispEnd()
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD Show( lFocused ) CLASS HBDbWindow
|
||||
|
||||
LOCAL nRow := Row()
|
||||
LOCAL nCol := Col()
|
||||
|
||||
hb_default( @lFocused, ::lFocused )
|
||||
|
||||
::cBackImage := SaveScreen( ::nTop, ::nLeft, ::nBottom + iif( ::lShadow, 1, 0 ), ;
|
||||
::nRight + iif( ::lShadow, 2, 0 ) )
|
||||
SetColor( ::cColor )
|
||||
hb_Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight )
|
||||
::SetFocus( lFocused )
|
||||
|
||||
IF ::lShadow
|
||||
hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight )
|
||||
ENDIF
|
||||
|
||||
::Refresh()
|
||||
::lVisible := .T.
|
||||
|
||||
SetPos( nRow, nCol )
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD ShowModal() CLASS HBDbWindow
|
||||
|
||||
LOCAL lExit := .F.
|
||||
LOCAL nKey
|
||||
|
||||
::lShadow := .T.
|
||||
::Show()
|
||||
|
||||
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_LBUTTONDOWN
|
||||
IF MRow() == ::nTop .AND. MCol() >= ::nLeft + 1 .AND. ;
|
||||
MCol() <= ::nLeft + 3
|
||||
lExit := .T.
|
||||
ENDIF
|
||||
ENDCASE
|
||||
ENDDO
|
||||
|
||||
::Hide()
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD LButtonDown( nMRow, nMCol ) CLASS HBDbWindow
|
||||
|
||||
IF ::bLButtonDown != NIL
|
||||
Eval( ::bLButtonDown, nMRow, nMCol )
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD LDblClick( nMRow, nMCol ) CLASS HBDbWindow
|
||||
|
||||
IF ::bLDblClick != NIL
|
||||
Eval( ::bLDblClick, nMRow, nMCol )
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD Move() CLASS HBDbWindow
|
||||
|
||||
LOCAL nOldTop := ::nTop
|
||||
LOCAL nOldLeft := ::nLeft
|
||||
LOCAL nOldBottom := ::nbottom
|
||||
LOCAL nOldRight := ::nright
|
||||
LOCAL nKey
|
||||
|
||||
DO WHILE .T.
|
||||
RestScreen( ,,,, ::cBackImage )
|
||||
hb_DispBox( ::nTop, ::nLeft, ::nRight, ::nBottom, Replicate( hb_UTF8ToStrBox( "░" ), 8 ) + " " )
|
||||
|
||||
nKey := Inkey( 0 )
|
||||
|
||||
DO CASE
|
||||
CASE nKey == K_UP
|
||||
|
||||
IF ::nTop != 0
|
||||
::nTop--
|
||||
::nBottom--
|
||||
ENDIF
|
||||
|
||||
CASE nKey == K_DOWN
|
||||
|
||||
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
|
||||
|
||||
ENDCASE
|
||||
|
||||
IF nKey == K_ESC .OR. nKey == K_ENTER
|
||||
EXIT
|
||||
ENDIF
|
||||
ENDDO
|
||||
|
||||
// hb_keyPut( 0 ); Inkey()
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD KeyPressed( nKey ) CLASS HBDbWindow
|
||||
|
||||
IF ::bKeyPressed != NIL
|
||||
Eval( ::bKeyPressed, nKey, Self )
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD LoadColors() CLASS HBDbWindow
|
||||
|
||||
LOCAL aClr := __DbgColors()
|
||||
|
||||
::cColor := aClr[ 1 ]
|
||||
|
||||
IF ::Browser != NIL
|
||||
::Browser:ColorSpec := aClr[ 2 ] + "," + aClr[ 5 ] + "," + aClr[ 3 ] + "," + aClr[ 6 ]
|
||||
ENDIF
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD Resize( nTop, nLeft, nBottom, nRight ) CLASS HBDbWindow
|
||||
|
||||
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 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
|
||||
|
||||
RETURN self
|
||||
391
src/debug/dbgwa.prg
Normal file
391
src/debug/dbgwa.prg
Normal file
@@ -0,0 +1,391 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* The Debugger Work Area Inspector
|
||||
*
|
||||
* Copyright 2001-2002 Ignacio Ortiz de Zuniga <ignacio@fivetech.com>
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING.txt. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
#pragma -b-
|
||||
|
||||
#include "box.ch"
|
||||
#include "setcurs.ch"
|
||||
#include "inkey.ch"
|
||||
|
||||
REQUEST FieldGet
|
||||
|
||||
PROCEDURE __dbgShowWorkAreas()
|
||||
|
||||
LOCAL oDlg
|
||||
LOCAL oCol
|
||||
|
||||
LOCAL aAlias := {}
|
||||
LOCAL aBrw[ 3 ]
|
||||
LOCAL aStruc
|
||||
LOCAL aInfo
|
||||
|
||||
LOCAL cColor := iif( __Dbg():lMonoDisplay, "N/W, W/N, W+/W, W+/N", "N/W, N/BG, R/W, R/BG" )
|
||||
|
||||
LOCAL 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 ) } )
|
||||
IF n1 == nOldArea
|
||||
cur_id := Len( aAlias )
|
||||
ENDIF
|
||||
ENDIF
|
||||
NEXT
|
||||
|
||||
IF Len( aAlias ) == 0
|
||||
__dbgAlert( "No workareas in use" )
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
IF ! Used()
|
||||
dbSelectArea( aAlias[ 1 ][ 1 ] )
|
||||
ENDIF
|
||||
|
||||
/* Window creation */
|
||||
|
||||
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 */
|
||||
|
||||
aBrw[ 1 ] := HBDbBrowser():new( 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 := {|| aBrw[ 1 ]:Cargo := n1 := 1 }
|
||||
aBrw[ 1 ]:GoBottomBlock := {|| aBrw[ 1 ]:Cargo := n1 := Len( aAlias ) }
|
||||
aBrw[ 1 ]:SkipBlock := {| nSkip, nPos | nPos := n1, ;
|
||||
aBrw[ 1 ]:Cargo := n1 := iif( nSkip > 0, Min( Len( aAlias ), n1 + nSkip ), ;
|
||||
Max( 1, n1 + nSkip ) ), ;
|
||||
n1 - nPos }
|
||||
|
||||
aBrw[ 1 ]:AddColumn( oCol := HBDbColumnNew( "", {|| PadR( aAlias[ n1 ][ 2 ], 11 ) } ) )
|
||||
|
||||
oCol:ColorBlock := {|| iif( aAlias[ n1 ][ 1 ] == Select(), { 3, 4 }, { 1, 2 } ) }
|
||||
|
||||
/* Info Browse */
|
||||
|
||||
aInfo := ( aAlias[ n1 ][ 1 ] )->( DbfInfo() )
|
||||
|
||||
aBrw[ 2 ] := HBDbBrowser():new( 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 := {|| aBrw[ 2 ]:Cargo := n2 := Len( aInfo ) }
|
||||
aBrw[ 2 ]:SkipBlock := {| nSkip, nPos | nPos := n2, ;
|
||||
aBrw[ 2 ]:Cargo := n2 := iif( nSkip > 0, Min( Len( aInfo ), n2 + nSkip ), ;
|
||||
Max( 1, n2 + nSkip ) ), ;
|
||||
n2 - nPos }
|
||||
|
||||
aBrw[ 2 ]:AddColumn( oCol := HBDbColumnNew( "", {|| PadR( aInfo[ n2 ], 38 ) } ) )
|
||||
|
||||
oCol:ColorBlock := {|| iif( aAlias[ n1 ][ 1 ] == Select() .AND. n2 == 1, { 3, 4 }, { 1, 2 } ) }
|
||||
|
||||
/* Struc browse */
|
||||
|
||||
aStruc := ( aAlias[ n1 ][ 1 ] )->( dbStruct() )
|
||||
|
||||
aBrw[ 3 ] := HBDbBrowser():new( oDlg:nTop + 1, oDlg:nLeft + 52, oDlg:nBottom - 1, oDlg:nLeft + 70 )
|
||||
|
||||
aBrw[ 3 ]:Cargo := n3 := 1
|
||||
aBrw[ 3 ]:ColorSpec := oDlg:cColor
|
||||
aBrw[ 3 ]:GoTopBlock := {|| aBrw[ 3 ]:Cargo := n3 := 1 }
|
||||
aBrw[ 3 ]:GoBottomBlock := {|| aBrw[ 3 ]:Cargo := n3 := Len( aStruc ) }
|
||||
aBrw[ 3 ]:SkipBlock := {| nSkip, nPos | nPos := n3, ;
|
||||
aBrw[ 3 ]:Cargo := n3 := iif( nSkip > 0, Min( Len( aStruc ), n3 + nSkip ), ;
|
||||
Max( 1, n3 + nSkip ) ), n3 - nPos }
|
||||
|
||||
aBrw[ 3 ]:AddColumn( HBDbColumnNew( "", {|| PadR( aStruc[ n3, 1 ], 11 ) + ;
|
||||
aStruc[ n3, 2 ] + ;
|
||||
Str( aStruc[ n3, 3 ], 4 ) + ;
|
||||
Str( aStruc[ n3, 4 ], 3 ) } ) )
|
||||
|
||||
/* Show dialog */
|
||||
|
||||
oDlg:ShowModal()
|
||||
|
||||
dbSelectArea( nOldArea )
|
||||
|
||||
RETURN
|
||||
|
||||
STATIC PROCEDURE DlgWorkAreaPaint( oDlg, aBrw )
|
||||
|
||||
/* Display captions */
|
||||
|
||||
hb_DispOutAt( oDlg:nTop, oDlg:nLeft + 5, " Area ", oDlg:cColor )
|
||||
hb_DispOutAt( oDlg:nTop, oDlg:nLeft + 28, " Status ", oDlg:cColor )
|
||||
hb_DispOutAt( oDlg:nTop, oDlg:nLeft + 56, " Structure ", oDlg:cColor )
|
||||
|
||||
/* Display separator lines */
|
||||
|
||||
hb_DispBox( oDlg:nTop + 1, oDlg:nLeft + 12, oDlg:nBottom - 1, oDlg:nLeft + 12, HB_B_SINGLE_UNI, oDlg:cColor )
|
||||
hb_DispOutAtBox( oDlg:nTop, oDlg:nLeft + 12, hb_UTF8ToStrBox( "┬" ), oDlg:cColor )
|
||||
hb_DispOutAtBox( oDlg:nBottom, oDlg:nLeft + 12, hb_UTF8ToStrBox( "┴" ), oDlg:cColor )
|
||||
|
||||
hb_DispBox( oDlg:nTop + 1, oDlg:nLeft + 51, oDlg:nBottom - 1, oDlg:nLeft + 51, HB_B_SINGLE_UNI, oDlg:cColor )
|
||||
hb_DispOutAtBox( oDlg:nTop, oDlg:nLeft + 51, hb_UTF8ToStrBox( "┬" ), oDlg:cColor )
|
||||
hb_DispOutAtBox( oDlg:nBottom, oDlg:nLeft + 51, hb_UTF8ToStrBox( "┴" ), oDlg:cColor )
|
||||
|
||||
hb_DispBox( oDlg:nTop + 6, oDlg:nLeft + 13, oDlg:nTop + 6, oDlg:nLeft + 50, HB_B_SINGLE_UNI, oDlg:cColor )
|
||||
hb_DispOutAtBox( oDlg:nTop + 6, oDlg:nLeft + 12, hb_UTF8ToStrBox( "├" ), oDlg:cColor )
|
||||
hb_DispOutAtBox( oDlg:nTop + 6, oDlg:nLeft + 51, hb_UTF8ToStrBox( "┤" ), oDlg:cColor )
|
||||
|
||||
/* Display labels */
|
||||
|
||||
hb_DispOutAt( oDlg:nTop + 1, oDlg:nLeft + 13, "Alias: Record: ", oDlg:cColor )
|
||||
hb_DispOutAt( oDlg:nTop + 2, oDlg:nLeft + 13, " BOF: Deleted: ", oDlg:cColor )
|
||||
hb_DispOutAt( oDlg:nTop + 3, oDlg:nLeft + 13, " EOF: Found: ", oDlg:cColor )
|
||||
hb_DispOutAt( oDlg:nTop + 4, oDlg:nLeft + 13, "Filter: ", oDlg:cColor )
|
||||
hb_DispOutAt( oDlg:nTop + 5, oDlg:nLeft + 13, " Key: ", oDlg:cColor )
|
||||
|
||||
/* Stabilize browse */
|
||||
|
||||
aBrw[ 1 ]:ForceStable()
|
||||
aBrw[ 2 ]:ForceStable()
|
||||
aBrw[ 3 ]:ForceStable()
|
||||
aBrw[ 2 ]:Dehilite()
|
||||
aBrw[ 3 ]:Dehilite()
|
||||
|
||||
UpdateInfo( oDlg, Alias() )
|
||||
|
||||
RETURN
|
||||
|
||||
STATIC PROCEDURE DlgWorkAreaKey( nKey, oDlg, aBrw, aAlias, aStruc, aInfo )
|
||||
|
||||
LOCAL oDebug := __Dbg()
|
||||
LOCAL nAlias
|
||||
|
||||
IF nKey == K_TAB .OR. nKey == K_SH_TAB
|
||||
aBrw[ oDebug:nWaFocus ]:Dehilite()
|
||||
oDebug:nWaFocus += iif( nKey == K_TAB, 1, -1 )
|
||||
IF oDebug:nWaFocus < 1
|
||||
oDebug:nWaFocus := 3
|
||||
ENDIF
|
||||
IF oDebug:nWaFocus > 3
|
||||
oDebug:nWaFocus := 1
|
||||
ENDIF
|
||||
aBrw[ oDebug:nWaFocus ]:Hilite()
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
DO CASE
|
||||
CASE oDebug:nWaFocus == 1
|
||||
nAlias := aBrw[ 1 ]:Cargo
|
||||
WorkAreasKeyPressed( nKey, aBrw[ 1 ], 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 oDebug:nWaFocus == 2
|
||||
WorkAreasKeyPressed( nKey, aBrw[ 2 ], Len( aInfo ) )
|
||||
CASE oDebug:nWaFocus == 3
|
||||
WorkAreasKeyPressed( nKey, aBrw[ 3 ], Len( aStruc ) )
|
||||
ENDCASE
|
||||
|
||||
RETURN
|
||||
|
||||
STATIC PROCEDURE WorkAreasKeyPressed( nKey, oBrw, nTotal )
|
||||
|
||||
DO CASE
|
||||
CASE nKey == K_UP
|
||||
|
||||
IF oBrw:Cargo > 1
|
||||
oBrw:Cargo--
|
||||
oBrw:RefreshCurrent()
|
||||
oBrw:Up()
|
||||
oBrw:ForceStable()
|
||||
ENDIF
|
||||
|
||||
CASE nKey == K_DOWN
|
||||
|
||||
IF oBrw:Cargo < nTotal
|
||||
oBrw:Cargo++
|
||||
oBrw:RefreshCurrent()
|
||||
oBrw:Down()
|
||||
oBrw:ForceStable()
|
||||
ENDIF
|
||||
|
||||
CASE nKey == K_HOME .OR. nKey == K_CTRL_PGUP .OR. nKey == K_CTRL_HOME
|
||||
|
||||
IF oBrw:Cargo > 1
|
||||
oBrw:Cargo := 1
|
||||
oBrw:GoTop()
|
||||
oBrw:ForceStable()
|
||||
ENDIF
|
||||
|
||||
CASE nKey == K_END .OR. nKey == K_CTRL_PGDN .OR. nKey == K_CTRL_END
|
||||
|
||||
IF oBrw:Cargo < nTotal
|
||||
oBrw:Cargo := nTotal
|
||||
oBrw:GoBottom()
|
||||
oBrw:ForceStable()
|
||||
ENDIF
|
||||
|
||||
ENDCASE
|
||||
|
||||
RETURN
|
||||
|
||||
STATIC FUNCTION DbfInfo( aInfo )
|
||||
|
||||
LOCAL nFor
|
||||
LOCAL xType
|
||||
LOCAL xValue
|
||||
LOCAL cValue
|
||||
|
||||
aInfo := {}
|
||||
|
||||
AAdd( aInfo, "[" + hb_ntos( 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: " + hb_ntos( Select() ) )
|
||||
AAdd( aInfo, Space( 8 ) + "Record Size: " + hb_ntos( RecSize() ) )
|
||||
AAdd( aInfo, Space( 8 ) + "Header Size: " + hb_ntos( Header() ) )
|
||||
AAdd( aInfo, Space( 8 ) + "Field Count: " + hb_ntos( FCount() ) )
|
||||
AAdd( aInfo, Space( 8 ) + "Last Update: " + DToC( LUpdate() ) )
|
||||
AAdd( aInfo, Space( 8 ) + "Index order: " + hb_ntos( IndexOrd() ) )
|
||||
AAdd( aInfo, Space( 4 ) + "Current Record" )
|
||||
|
||||
FOR nFor := 1 TO FCount()
|
||||
|
||||
xValue := __Dbg():GetExprValue( "FieldGet(" + hb_ntos( nFor ) + ")" )
|
||||
xType := ValType( xValue )
|
||||
|
||||
SWITCH xType
|
||||
CASE "C"
|
||||
CASE "M"
|
||||
cValue := xValue
|
||||
EXIT
|
||||
CASE "N"
|
||||
cValue := hb_ntos( xValue )
|
||||
EXIT
|
||||
CASE "D"
|
||||
cValue := DToC( xValue )
|
||||
EXIT
|
||||
CASE "T"
|
||||
cValue := hb_TSToStr( xValue )
|
||||
EXIT
|
||||
CASE "L"
|
||||
cValue := iif( xValue, ".T.", ".F." )
|
||||
EXIT
|
||||
CASE "A"
|
||||
cValue := "Array"
|
||||
EXIT
|
||||
CASE "H"
|
||||
cValue := "Hash"
|
||||
EXIT
|
||||
CASE "U"
|
||||
cValue := "NIL"
|
||||
EXIT
|
||||
OTHERWISE
|
||||
cValue := "Error"
|
||||
ENDSWITCH
|
||||
|
||||
AAdd( aInfo, Space( 8 ) + PadR( FieldName( nFor ), 10 ) + " = " + PadR( cValue, 17 ) )
|
||||
|
||||
NEXT
|
||||
|
||||
RETURN aInfo
|
||||
|
||||
STATIC PROCEDURE UpdateInfo( oDlg, cAlias )
|
||||
|
||||
LOCAL nOldArea
|
||||
|
||||
IF Empty( cAlias )
|
||||
RETURN
|
||||
ENDIF
|
||||
|
||||
nOldArea := Select()
|
||||
|
||||
dbSelectArea( cAlias )
|
||||
|
||||
hb_DispOutAt( oDlg:nTop + 1, oDlg:nLeft + 20, PadR( cAlias, 11 ), oDlg:cColor )
|
||||
hb_DispOutAt( oDlg:nTop + 1, oDlg:nLeft + 42, ;
|
||||
PadR( hb_ntos( RecNo() ) + "/" + hb_ntos( LastRec() ), 9 ), ;
|
||||
oDlg:cColor )
|
||||
|
||||
hb_DispOutAt( oDlg:nTop + 2, oDlg:nLeft + 21, iif( Bof(), "Yes", "No " ), oDlg:cColor )
|
||||
hb_DispOutAt( oDlg:nTop + 2, oDlg:nLeft + 38, iif( Deleted(), "Yes", "No " ), oDlg:cColor )
|
||||
hb_DispOutAt( oDlg:nTop + 3, oDlg:nLeft + 21, iif( Eof(), "Yes", "No " ), oDlg:cColor )
|
||||
hb_DispOutAt( oDlg:nTop + 3, oDlg:nLeft + 38, iif( Found(), "Yes", "No " ), oDlg:cColor )
|
||||
hb_DispOutAt( oDlg:nTop + 4, oDlg:nLeft + 21, PadR( dbFilter(), 29 ), oDlg:cColor )
|
||||
hb_DispOutAt( oDlg:nTop + 5, oDlg:nLeft + 21, PadR( ordKey(), 29 ), oDlg:cColor )
|
||||
|
||||
dbSelectArea( nOldArea )
|
||||
|
||||
RETURN
|
||||
3422
src/debug/debugger.prg
Normal file
3422
src/debug/debugger.prg
Normal file
File diff suppressed because it is too large
Load Diff
360
src/debug/tbrwtext.prg
Normal file
360
src/debug/tbrwtext.prg
Normal file
@@ -0,0 +1,360 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* Text file browser class
|
||||
*
|
||||
* Copyright 2008 Lorenzo Fiorini <lorenzo.fiorini@gmail.com>
|
||||
* www - http://harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING.txt. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
#pragma -b-
|
||||
|
||||
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
|
||||
#include "hbclass.ch"
|
||||
|
||||
CREATE CLASS HBBrwText
|
||||
|
||||
VAR cFileName
|
||||
VAR aRows
|
||||
VAR nRows
|
||||
VAR nActiveLine
|
||||
VAR aBreakPoints INIT {}
|
||||
VAR lLineNumbers
|
||||
VAR nRow
|
||||
VAR nFirstCol
|
||||
VAR nCol
|
||||
|
||||
VAR oBrw
|
||||
|
||||
VAR cCurLine
|
||||
VAR nLineOffset INIT 1
|
||||
VAR nMaxLineLen
|
||||
VAR nTabWidth INIT 4
|
||||
|
||||
VAR nTop
|
||||
VAR nLeft
|
||||
VAR nBottom
|
||||
VAR nRight
|
||||
|
||||
VAR nWidth
|
||||
VAR nHeight
|
||||
|
||||
METHOD New( nTop, nLeft, nBottom, nRight, cFileName, cColors, lLineNumbers )
|
||||
|
||||
METHOD RefreshAll() INLINE ::oBrw:ForceStable():RefreshAll(), Self
|
||||
METHOD ForceStable() INLINE ::oBrw:ForceStable(), Self
|
||||
METHOD RefreshCurrent() INLINE ::oBrw:RefreshCurrent(), Self
|
||||
METHOD GotoLine( n )
|
||||
METHOD SetActiveLine( n )
|
||||
METHOD GetLine()
|
||||
METHOD ToggleBreakPoint( nRow, lSet )
|
||||
METHOD Search( cString, lCaseSensitive, nMode )
|
||||
|
||||
METHOD GoFirst()
|
||||
METHOD GoLast()
|
||||
METHOD Skip( n )
|
||||
METHOD GoNext()
|
||||
METHOD GoPrev()
|
||||
|
||||
METHOD Resize( nTop, nLeft, nBottom, nRight )
|
||||
METHOD GetLineColor()
|
||||
|
||||
METHOD Up() INLINE ::oBrw:Up():ForceStable(), Self
|
||||
METHOD Down() INLINE ::oBrw:Down():ForceStable(), Self
|
||||
METHOD PageUp() INLINE ::oBrw:PageUp():ForceStable(), Self
|
||||
METHOD PageDown() INLINE ::oBrw:PageDown():ForceStable(), Self
|
||||
METHOD GoTop() INLINE ::oBrw:GoTop():ForceStable(), Self
|
||||
METHOD GoBottom() INLINE ::oBrw:GoBottom():ForceStable(), Self
|
||||
|
||||
METHOD Right() INLINE iif( ::nLineOffset < ::nMaxLineLen, ( ::nLineOffset++, ::oBrw:RefreshAll():ForceStable() ), ), Self
|
||||
METHOD Left() INLINE iif( ::nLineOffset > 1, ( ::nLineOffset--, ::oBrw:RefreshAll():ForceStable() ), ), Self
|
||||
|
||||
METHOD RowPos() INLINE ::nRow
|
||||
|
||||
METHOD LoadFile( cFileName )
|
||||
|
||||
VAR colorSpec IS colorSpec IN oBrw
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New( nTop, nLeft, nBottom, nRight, cFileName, cColors, lLineNumbers ) CLASS HBBrwText
|
||||
|
||||
LOCAL oCol
|
||||
|
||||
::nTop := nTop
|
||||
::nLeft := nLeft
|
||||
::nBottom := nBottom
|
||||
::nRight := nRight
|
||||
|
||||
::nWidth := nRight - nLeft + 1
|
||||
::nHeight := nBottom - nTop
|
||||
|
||||
::lLineNumbers := lLineNumbers
|
||||
|
||||
::oBrw := HBDbBrowser():New( ::nTop, ::nLeft, ::nBottom, ::nRight )
|
||||
|
||||
::oBrw:colorSpec := cColors
|
||||
|
||||
oCol := HBDbColumnNew( "", {|| ::GetLine() } )
|
||||
|
||||
oCol:colorBlock := {|| ::GetLineColor() }
|
||||
|
||||
::oBrw:AddColumn( oCol )
|
||||
|
||||
::oBrw:goTopBlock := {|| ::nRow := 1 }
|
||||
::oBrw:goBottomBlock := {|| ::nRow := ::nRows }
|
||||
::oBrw:skipBlock := {| n | ::Skip( n ) }
|
||||
|
||||
IF ! Empty( cFileName )
|
||||
::LoadFile( cFileName )
|
||||
ENDIF
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD GotoLine( n ) CLASS HBBrwText
|
||||
|
||||
::oBrw:MoveCursor( n - ::nRow )
|
||||
::RefreshAll()
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD SetActiveLine( n ) CLASS HBBrwText
|
||||
|
||||
::nActiveLine := n
|
||||
::RefreshAll()
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD GetLine() CLASS HBBrwText
|
||||
|
||||
RETURN PadR( hb_ntos( ::nRow ) + ": " + SubStr( ;
|
||||
MemoLine( ::aRows[ ::nRow ], ::nWidth + ::nLineOffset, 1, ::nTabWidth, .F. ), ;
|
||||
::nLineOffset ), ::nWidth )
|
||||
|
||||
METHOD ToggleBreakPoint( nRow, lSet ) CLASS HBBrwText
|
||||
|
||||
LOCAL nAt := AScan( ::aBreakPoints, nRow )
|
||||
|
||||
IF lSet
|
||||
// add it only if not present
|
||||
IF nAt == 0
|
||||
AAdd( ::aBreakPoints, nRow )
|
||||
ENDIF
|
||||
ELSE
|
||||
IF nAt != 0
|
||||
hb_ADel( ::aBreakPoints, nAt, .T. )
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD LoadFile( cFileName ) CLASS HBBrwText
|
||||
|
||||
LOCAL nMaxLineLen := 0
|
||||
LOCAL cLine
|
||||
|
||||
::cFileName := cFileName
|
||||
::aRows := Text2Array( MemoRead( cFileName ) )
|
||||
::nRows := Len( ::aRows )
|
||||
|
||||
FOR EACH cLine in ::aRows
|
||||
nMaxLineLen := Max( nMaxLineLen, ;
|
||||
Len( RTrim( MemoLine( cLine, Len( cLine ) + 256, 1, ::nTabWidth, .F. ) ) ) )
|
||||
NEXT
|
||||
::nMaxLineLen := nMaxLineLen
|
||||
::nLineOffset := 1
|
||||
|
||||
RETURN NIL
|
||||
|
||||
METHOD Resize( nTop, nLeft, nBottom, nRight ) CLASS HBBrwText
|
||||
|
||||
LOCAL lResize := .F.
|
||||
|
||||
IF nTop != NIL .AND. nTop != ::nTop
|
||||
::nTop := nTop
|
||||
lResize := .T.
|
||||
ENDIF
|
||||
IF nLeft != NIL .AND. nLeft != ::nLeft
|
||||
::nLeft := nLeft
|
||||
lResize := .T.
|
||||
ENDIF
|
||||
IF nBottom != NIL .AND. nBottom != ::nBottom
|
||||
::nBottom := nBottom
|
||||
lResize := .T.
|
||||
ENDIF
|
||||
IF nRight != NIL .AND. nRight != ::nRight
|
||||
::nRight := nRight
|
||||
lResize := .T.
|
||||
ENDIF
|
||||
IF lResize
|
||||
::oBrw:Resize( nTop, nLeft, nBottom, nRight )
|
||||
::nWidth := ::nRight - ::nLeft + 1
|
||||
ENDIF
|
||||
|
||||
RETURN Self
|
||||
|
||||
METHOD GetLineColor() CLASS HBBrwText
|
||||
|
||||
LOCAL aColor
|
||||
LOCAL lBreak
|
||||
|
||||
lBreak := AScan( ::aBreakPoints, ::nRow ) > 0
|
||||
|
||||
IF lBreak .AND. ::nRow == ::nActiveLine
|
||||
aColor := { 4, 4 }
|
||||
ELSEIF lBreak
|
||||
aColor := { 3, 3 }
|
||||
ELSEIF ::nRow == ::nActiveLine
|
||||
aColor := { 2, 2 }
|
||||
ELSE
|
||||
aColor := { 1, 1 }
|
||||
ENDIF
|
||||
|
||||
RETURN aColor
|
||||
|
||||
METHOD Search( cString, lCaseSensitive, nMode ) CLASS HBBrwText
|
||||
|
||||
LOCAL bMove
|
||||
LOCAL lFound := .F.
|
||||
LOCAL n
|
||||
|
||||
IF ! lCaseSensitive
|
||||
cString := Upper( cString )
|
||||
ENDIF
|
||||
|
||||
DO CASE
|
||||
CASE nMode == 0 // From Top
|
||||
::GoTop()
|
||||
bMove := {|| ::Skip( 1 ) }
|
||||
CASE nMode == 1 // Forward
|
||||
bMove := {|| ::Skip( 1 ) }
|
||||
CASE nMode == 2 // Backward
|
||||
bMove := {|| ::Skip( -1 ) }
|
||||
ENDCASE
|
||||
|
||||
n := ::nRow
|
||||
|
||||
DO WHILE Eval( bMove ) != 0
|
||||
IF cString $ iif( lCaseSensitive, ::aRows[ ::nRow ], Upper( ::aRows[ ::nRow ] ) )
|
||||
lFound := .T.
|
||||
::oBrw:MoveCursor( ::nRow - n )
|
||||
::RefreshAll()
|
||||
EXIT
|
||||
ENDIF
|
||||
ENDDO
|
||||
|
||||
RETURN lFound
|
||||
|
||||
METHOD GoFirst() CLASS HBBrwText
|
||||
|
||||
::nRow := 1
|
||||
|
||||
RETURN .T.
|
||||
|
||||
METHOD GoLast() CLASS HBBrwText
|
||||
|
||||
::nRow := ::nRows
|
||||
|
||||
RETURN .T.
|
||||
|
||||
METHOD Skip( n ) CLASS HBBrwText
|
||||
|
||||
LOCAL nSkipped := 0
|
||||
|
||||
IF n > 0
|
||||
IF ::nRow < ::nRows
|
||||
nSkipped := Min( ::nRows - ::nRow, n )
|
||||
::nRow += nSkipped
|
||||
ENDIF
|
||||
ELSEIF n < 0
|
||||
IF ::nRow > 1
|
||||
nSkipped := Max( 1 - ::nRow, n )
|
||||
::nRow += nSkipped
|
||||
ENDIF
|
||||
ENDIF
|
||||
|
||||
RETURN nSkipped
|
||||
|
||||
METHOD GoPrev() CLASS HBBrwText
|
||||
|
||||
LOCAL lMoved := .F.
|
||||
|
||||
IF ::nRow > 1
|
||||
::nRow--
|
||||
lMoved := .T.
|
||||
ENDIF
|
||||
|
||||
RETURN lMoved
|
||||
|
||||
METHOD GoNext() CLASS HBBrwText
|
||||
|
||||
LOCAL lMoved := .F.
|
||||
|
||||
IF ::nRow < ::nRows
|
||||
::nRow++
|
||||
lMoved := .T.
|
||||
ENDIF
|
||||
|
||||
RETURN lMoved
|
||||
|
||||
STATIC FUNCTION WhichEOL( cString )
|
||||
|
||||
LOCAL nCRPos := At( Chr( 13 ), cString )
|
||||
LOCAL nLFPos := At( Chr( 10 ), cString )
|
||||
|
||||
IF nCRPos > 0 .AND. nLFPos == 0
|
||||
RETURN Chr( 13 )
|
||||
ELSEIF nCRPos == 0 .AND. nLFPos > 0
|
||||
RETURN Chr( 10 )
|
||||
ELSEIF nCRPos > 0 .AND. nLFPos == nCRPos + 1
|
||||
RETURN Chr( 13 ) + Chr( 10 )
|
||||
ENDIF
|
||||
|
||||
RETURN hb_eol()
|
||||
|
||||
STATIC FUNCTION Text2Array( cString )
|
||||
|
||||
RETURN hb_ATokens( cString, WhichEOL( cString ) )
|
||||
Reference in New Issue
Block a user