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

2009-10-09 16:53 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
- source
  + src
  * src/Makefile
  * src/dynlib/mt/Makefile
  * src/dynlib/Makefile
  * INSTALL
  * Makefile
  * ChangeLog
  * harbour.spec
  * mpkg_tgz.sh
    * Renamed 'source' dir to 'src' to move closer to other FOSS 
      projects. It's also easier to type, plus it has the side 
      effect that some cmdlines will be shorter in the 
      build process.
This commit is contained in:
Viktor Szakats
2009-10-09 14:54:14 +00:00
parent 5111d79ff6
commit 1b080a03f9
717 changed files with 56 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
harbour/src/debug/Makefile Normal file
View 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

268
harbour/src/debug/dbgbrwsr.prg Normal file
View File

@@ -0,0 +1,268 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Debugger Browser
*
* Copyright 2004 Ryszard Glab <rglab@imid.med.pl>
* www - http://www.harbour-project.org
* Copyright 2007 Phil Krylov <phil a t newstar.rinet.ru>
* www - http://xharbour.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. 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 DEBUGINFO=OFF
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
#include "hbclass.ch"
#include "common.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
ASize( ::aRowState, ::rowCount )
::lConfigured := .T.
RETURN Self
METHOD SetColorSpec( cColors )
IF ISCHARACTER( 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
FOR nRow := 1 TO ::rowCount
IF Empty( ::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 ISARRAY( aClr )
nClr := aClr[ nClr ]
ELSE
nClr := oCol:defColor[ nClr ]
ENDIF
IF oCol:width == NIL
nWid := Len( xData )
ELSE
nWid := oCol:width
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 )
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 )

1732
harbour/src/debug/dbgentry.c Normal file
View File

File diff suppressed because it is too large Load Diff

955
harbour/src/debug/dbghelp.prg Normal file
View File

@@ -0,0 +1,955 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Debugger Help
*
* Copyright 2002 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* 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. 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 DEBUGINFO=OFF
/* 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 "common.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()
DEFAULT nTopic TO 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, B_SINGLE, oDlg:cColor )
hb_dispOutAt( oDlg:nTop , oDlg:nLeft + 13 , Chr( 194 ), oDlg:cColor )
hb_dispOutAt( oDlg:nBottom , oDlg:nLeft + 13 , Chr( 193 ), 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
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 ) + Chr( 25 ) + " 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",;
"",;
" DOS Access",;
" Shell to the DOS 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
harbour/src/debug/dbgmenu.prg Normal file
View File

@@ -0,0 +1,210 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Debugger Menu
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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. 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 DEBUGINFO=OFF
#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

278
harbour/src/debug/dbgtarr.prg Normal file
View File

@@ -0,0 +1,278 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Debugger Array Inspector
*
* Copyright 2001 Luiz Rafael Culik <culik@sl.conex.net>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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. 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 DEBUGINFO=OFF
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
#include "hbclass.ch"
#include "common.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
DEFAULT lEditable TO .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.." + LTrim( Str( nSize, 6 ) ) + "]", "N/W" )
ELSE
oWndSets := HBDbWindow():New( 1, 5, 2 + nSize, MaxCol() - 5, ::arrayName + "[1.." + LTrim( Str( nSize, 6 ) ) + "]", "N/W" )
ENDIF
ELSE
oWndSets := HBDbWindow():New( 1, 5, MaxRow() - 2, MaxCol() - 5, ::arrayName + "[1.." + LTrim( Str( nSize, 6 ) ) + "]", "N/W" )
ENDIF
::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 + "[" + LTrim( Str( oBrwSets:cargo[ 1 ], 6 ) ) + "]" } ) )
oCol:width := Len( ::arrayName + "[" + LTrim( Str( Len( aArray ), 6 ) ) + "]" )
oCol:DefColor := { 1, 2 }
nColWidth := oCol:Width
oBrwSets:AddColumn( oCol := HBDbColumnNew( "", { || PadR( __dbgValToStr( aArray[ oBrwSets:cargo[ 1 ] ] ), nWidth - nColWidth - 1 ) } ) )
/* 09/08/2004 - <maurilio.longo@libero.it>
Setting a fixed width like it is done in the next line of code wich I've
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 ISARRAY( aArray[ nSet ] )
IF Len( aArray[ nSet ] ) == 0
__dbgAlert( "Array is empty" )
ELSE
SetPos( oWnd:nBottom, oWnd:nLeft )
::aWindows[ ::nCurWindow ]:lFocused := .F.
::arrayname := ::arrayname + "[" + LTrim( Str( nSet, 4 ) ) + "]"
::AddWindows( aArray[ nSet ], oBrwSets:RowPos + oBrwSets:nTop )
::arrayname := cOldName
ADel( ::aWindows, ::nCurWindow )
ASize( ::aWindows, Len( ::aWindows ) - 1 )
IF ::nCurWindow == 0
::nCurWindow := 1
ELSE
::nCurWindow--
ENDIF
ENDIF
ELSEIF ISBLOCK( aArray[ nSet ] ) .OR. hb_isPointer( aArray[ nSet ] )
__dbgAlert( "Value cannot be edited" )
ELSE
IF ::lEditable
oBrwSets:RefreshCurrent()
IF 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 ) )

302
harbour/src/debug/dbgthsh.prg Normal file
View File

@@ -0,0 +1,302 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Debugger Hash Inspector
*
* Copyright 2006 Francesco Saverio Giudice <info / at / fsgiudice / dot / com>
* www - http://www.xharbour.org
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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. 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 DEBUGINFO=OFF
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
#include "hbclass.ch"
#include "common.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
DEFAULT lEditable TO .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.." + LTrim( Str( nSize, 6 ) ) + "]", "N/W" )
ELSE
oWndSets := HBDbWindow():New( 1, 5, 2 + nSize, MaxCol() - 5, ::hashName + "[1.." + LTrim( Str( nSize, 6 ) ) + "]", "N/W" )
ENDIF
ELSE
oWndSets := HBDbWindow():New( 1, 5, MaxRow() - 2, MaxCol() - 5, ::hashName + "[1.." + LTrim( Str( nSize, 6 ) ) + "]", "N/W" )
ENDIF
::nCurWindow++
oWndSets:lFocused := .T.
AAdd( ::aWindows, oWndSets )
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 ) } ) )
/* 09/08/2004 - <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
ADel( ::aWindows, ::nCurWindow )
ASize( ::awindows, Len( ::awindows ) - 1 )
IF ::nCurwindow == 0
::nCurwindow := 1
ELSE
::nCurwindow--
ENDIF
ENDIF
ELSEIF ISBLOCK( uValue ) .OR. hb_isPointer( uValue )
__dbgAlert( "Value cannot be edited" )
ELSE
IF ::lEditable
oBrwSets:RefreshCurrent()
IF ISOBJECT( uValue )
__DbgObject( uValue, cName + "[" + HashKeyString( hHash, nSet ) + "]" )
ELSEIF ISARRAY( uValue )
__DbgArrays( uValue, cName + "[" + HashKeyString( hHash, nSet ) + "]" )
ELSE
::doGet( oBrwSets, hHash, nSet )
ENDIF
oBrwSets:RefreshCurrent()
oBrwSets:ForceStable()
ELSE
__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 ) )

218
harbour/src/debug/dbgtinp.prg Normal file
View File

@@ -0,0 +1,218 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* User input class for debugger
*
* Copyright 2008 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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. 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 DEBUGINFO=OFF
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
#include "hbclass.ch"
#include "inkey.ch"
#include "color.ch"
#include "setcurs.ch"
#include "common.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, 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( ISNUMBER( 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 nKey >= 32 .AND. nKey <= 255
IF Set( _SET_INSERT )
::cValue := Left( Stuff( ::cValue, ::nPos, 0, Chr( nKey ) ), ::nSize )
ELSE
::cValue := Stuff( ::cValue, ::nPos, 1, Chr( nKey ) )
ENDIF
IF ::nPos < ::nSize
::nPos++
ENDIF
ELSE
lUpdate := .F.
ENDIF
ENDSWITCH
IF lUpdate
::display()
ENDIF
RETURN Self

505
harbour/src/debug/dbgtmenu.prg Normal file
View File

@@ -0,0 +1,505 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Debugger (HBDbMenu class)
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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. 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 DEBUGINFO=OFF
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
#include "hbclass.ch"
#include "hbmemvar.ch"
#include "box.ch"
#include "common.ch"
#include "inkey.ch"
#include "setcurs.ch"
CREATE CLASS HBDbMenu
CLASSDATA aMenus
VAR nTop
VAR nLeft
VAR nBottom
VAR nRight
VAR aItems
VAR cClrHilite
VAR cClrHotKey
VAR cClrHotFocus
VAR cClrPopup
VAR nOpenPopup // zero if no popup is shown
VAR lPopup
VAR cBackImage
METHOD New( aItems )
METHOD AddItem( oMenuItem )
METHOD Build()
METHOD ClosePopup()
METHOD Close() INLINE ::ClosePopup( ::nOpenPopup ), ::nOpenPopup := 0
METHOD DeHilite()
METHOD Display()
METHOD EvalAction()
METHOD GetHotKeyPos( nKey )
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 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 ::aItems[ n ]:cPrompt != "-"
::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 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, B_SINGLE )
hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight )
ENDIF
FOR n := 1 TO Len( ::aItems )
IF ::aItems[ n ]:cPrompt == "-" // Separator
hb_dispOutAt( ::aItems[ n ]:nRow, ::nLeft,;
Chr( 195 ) + Replicate( Chr( 196 ), ::nRight - ::nLeft - 1 ) + Chr( 180 ) )
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 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 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 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( Chr( nKey ) )
oPopup := ::aItems[ ::nOpenPopup ]:bAction
nPopup := oPopup:GetHotKeyPos( Upper( Chr( 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 ), "" )

105
harbour/src/debug/dbgtmitm.prg Normal file
View File

@@ -0,0 +1,105 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Debugger (HBDbMenuItem Class)
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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. 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 DEBUGINFO=OFF
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
#include "hbclass.ch"
#include "common.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
DEFAULT lChecked TO .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_dispOutAt( ::nRow, ::nCol, iif( ::lChecked, Chr( 251 ), "" ), cClrText )
RETURN Self

353
harbour/src/debug/dbgtobj.prg Normal file
View File

@@ -0,0 +1,353 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Debugger Object Inspector
*
* Copyright 2001 Luiz Rafael Culik <culik@sl.conex.net>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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. 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 DEBUGINFO=OFF
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
#include "hbclass.ch"
#include "common.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
DEFAULT lEditable TO .T.
/* 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( ISCHARACTER( ::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 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 ISOBJECT( aArray[ nSet, 2 ] )
HBDbObject():New( aArray[ nSet, 2 ], ::pitems[ nSet, 1 ] )
ELSEIF ( ISCHARACTER( aArray[ nSet, 2 ] ) .AND. ;
!aArray[ nSet, 3 ] ) .OR. ;
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
harbour/src/debug/dbgtwin.prg Normal file
View File

@@ -0,0 +1,401 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Debugger
*
* Copyright 1999 Antonio Linares <alinares@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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. 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://www.harbour-project.org
*
* Copyright 2000 Luiz Rafael Culik <culik@sl.conex.net>
* :Move()
*
* See COPYING 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 DEBUGINFO=OFF
#define HB_CLS_NOTOBJECT /* do not inherit from HBObject calss */
#include "hbclass.ch"
#include "hbmemvar.ch"
#include "box.ch"
#include "common.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()
ENDCLASS
METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) CLASS HBDbWindow
DEFAULT cColor TO __DbgColors()[ 1 ]
::nTop := nTop
::nLeft := nLeft
::nBottom := nBottom
::nRight := nRight
::cCaption := cCaption
::cColor := cColor
RETURN Self
METHOD Clear() CLASS HBDbWindow
SetColor( ::cColor )
Scroll( ::nTop + 1, ::nLeft + 1, ::nBottom - 1, ::nRight - 1 )
RETURN NIL
METHOD Hide() CLASS HBDbWindow
RestScreen( ::nTop, ::nLeft, ::nBottom + iif( ::lShadow, 1, 0 ),;
::nRight + iif( ::lShadow, 2, 0 ), ::cBackImage )
::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
DEFAULT nLines TO 1
SetColor( ::cColor )
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, B_DOUBLE, B_SINGLE ), ::cColor )
hb_dispOutAt( ::nTop, ::nLeft + 1, "[" + Chr( 254 ) + "]", ::cColor )
::ShowCaption( ::cCaption )
IF ::bPainted != NIL
Eval( ::bPainted, Self )
ENDIF
DispEnd()
RETURN NIL
METHOD Show( lFocused ) CLASS HBDbWindow
LOCAL nRow := Row()
LOCAL nCol := Col()
DEFAULT lFocused TO ::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( Chr( 176 ), 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
// __Keyboard( Chr( 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

369
harbour/src/debug/dbgwa.prg Normal file
View File

@@ -0,0 +1,369 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* The Debugger Work Area Inspector
*
* Copyright 2001-2002 Ignacio Ortiz de Zuniga <ignacio@fivetech.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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. 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 DEBUGINFO=OFF
#include "box.ch"
#include "common.ch"
#include "setcurs.ch"
#include "inkey.ch"
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, B_SINGLE, oDlg:cColor )
hb_dispOutAt( oDlg:nTop, oDlg:nLeft + 12, Chr( 194 ), oDlg:cColor )
hb_dispOutAt( oDlg:nBottom, oDlg:nLeft + 12, Chr( 193 ), oDlg:cColor )
hb_dispBox( oDlg:nTop + 1, oDlg:nLeft + 51, oDlg:nBottom - 1, oDlg:nLeft + 51, B_SINGLE, oDlg:cColor )
hb_dispOutAt( oDlg:nTop, oDlg:nLeft + 51, Chr( 194 ), oDlg:cColor )
hb_dispOutAt( oDlg:nBottom, oDlg:nLeft + 51, Chr( 193 ), oDlg:cColor )
hb_dispBox( oDlg:nTop + 6, oDlg:nLeft + 13, oDlg:nTop + 6, oDlg:nLeft + 50, B_SINGLE, oDlg:cColor )
hb_dispOutAt( oDlg:nTop + 6, oDlg:nLeft + 12, Chr( 195 ), oDlg:cColor )
hb_dispOutAt( oDlg:nTop + 6, oDlg:nLeft + 51, Chr( 180 ), 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 )
DO CASE
CASE xType $ "CM" ; cValue := xValue
CASE xType == "N" ; cValue := hb_NToS( xValue )
CASE xType == "D" ; cValue := DToC( xValue )
CASE xType == "L" ; cValue := iif( xValue, ".T.", ".F." )
CASE xType == "A" ; cValue := "Array"
OTHERWISE ; cValue := "Error"
ENDCASE
AAdd( aInfo, Space( 8 ) + PadR( FieldName( nFor ), 10) + " = " + PadR( cValue, 17 ) )
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

3442
harbour/src/debug/debugger.prg Normal file
View File

File diff suppressed because it is too large Load Diff

360
harbour/src/debug/tbrwtext.prg Normal file
View File

@@ -0,0 +1,360 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Text file browser class
*
* Copyright 2008 Lorenzo Fiorini <lorenzo.fiorini@gmail.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, 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. 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 DEBUGINFO=OFF
#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( n )
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
ADel( ::aBreakPoints, nAt )
ASize( ::aBreakPoints, Len( ::aBreakPoints ) - 1 )
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
MemoLine( cLine, ::nWidth, 1, ::nTabWidth, .f. )
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
DO WHILE nSkipped != n .AND. ::GoNext()
nSkipped++
ENDDO
ELSE
DO WHILE nSkipped != n .AND. ::GoPrev()
nSkipped--
ENDDO
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_OSNewLine()
STATIC FUNCTION Text2Array( cString )
RETURN hb_aTokens( cString, WhichEOL( cString ) )