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

2008-10-17 00:07 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/common.mak
  * harbour/source/debug/Makefile
  + harbour/source/debug/dbgtinp.prg
    + added HbDbInput class for simple user input (GET)

  * harbour/source/debug/debugger.prg
    ! changed __dbgInput() to use HbDbInput() class instead of ACCEPT
      It fixes all bad visual end edit bad effects caused by ACCEPT.
      TODO: replace all GET references in debugger code with HbDbInput class.
This commit is contained in:
Przemyslaw Czerpak
2008-10-16 22:08:10 +00:00
parent 126b02960f
commit d16d2b1e34
5 changed files with 275 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
harbour/ChangeLog
View File

@@ -8,6 +8,17 @@
2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org)
*/
2008-10-17 00:07 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/common.mak
* harbour/source/debug/Makefile
+ harbour/source/debug/dbgtinp.prg
+ added HbDbInput class for simple user input (GET)
* harbour/source/debug/debugger.prg
! changed __dbgInput() to use HbDbInput() class instead of ACCEPT
It fixes all bad visual end edit bad effects caused by ACCEPT.
TODO: replace all GET references in debugger code with HbDbInput class.
2008-10-16 14:33 UTC+0200 Viktor Szakats (harbour.01 syenar hu)
* common.mak
* make_b32.bat

1
harbour/common.mak
View File

@@ -679,6 +679,7 @@ DEBUG_LIB_OBJS = \
$(OBJ_DIR)\dbgbrwsr$(OBJEXT) \
$(OBJ_DIR)\dbghelp$(OBJEXT) \
$(OBJ_DIR)\dbgmenu$(OBJEXT) \
$(OBJ_DIR)\dbgtinp$(OBJEXT) \
$(OBJ_DIR)\dbgtmenu$(OBJEXT) \
$(OBJ_DIR)\dbgtmitm$(OBJEXT) \
$(OBJ_DIR)\dbgtwin$(OBJEXT) \

1
harbour/source/debug/Makefile
View File

@@ -10,6 +10,7 @@ C_SOURCES=\
PRG_SOURCES=\
dbgmenu.prg \
dbghelp.prg \
dbgtinp.prg \
dbgtmenu.prg \
dbgtmitm.prg \
dbgtwin.prg \

206
harbour/source/debug/dbgtinp.prg Normal file
View File

@@ -0,0 +1,206 @@
/*
* $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 setFocus()
METHOD killFocus()
METHOD display()
METHOD newPos( nRow, nCol )
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
::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 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

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

@@ -1133,8 +1133,8 @@ METHOD EditColor( nColor, oBrwColors ) CLASS HBDebugger
READ
SetCursor( SC_NONE )
#else
cColor := __dbgInput( Row(), Col() + 15, cColor, ;
{ | cColor | iif( Type( cColor ) != "C", ;
cColor := __dbgInput( Row(), Col() + 15,, cColor, ;
{ | cColor | iif( Type( cColor ) != "C", ;
( __dbgAlert( "Must be string" ), .F. ), .T. ) }, ;
SubStr( ::ClrModal(), 5 ) )
#endif
@@ -1170,7 +1170,7 @@ METHOD EditSet( nSet, oBrwSets ) CLASS HBDebugger
READ
SetCursor( SC_NONE )
#else
cSet := __dbgInput( Row(), Col() + 13, cSet, ;
cSet := __dbgInput( Row(), Col() + 13,, cSet, ;
{ | cSet | iif( Type( cSet ) != cType, ;
( __dbgAlert( "Must be of type '" + cType + "'" ), .F. ), .T. ) }, ;
SubStr( ::ClrModal(), 5 ) )
@@ -1555,33 +1555,40 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger
LOCAL nRight := nLeft + 50
LOCAL cType := ValType( uValue )
LOCAL nWidth := nRight - nLeft - 1
LOCAL cPicture
LOCAL uTemp
LOCAL nOldCursor
LOCAL lScoreBoard := Set( _SET_SCOREBOARD, .F. )
LOCAL nOldRow
LOCAL nOldCol
LOCAL lExit
LOCAL oWndInput := HBDbWindow():New( nTop, nLeft, nBottom, nRight, cMsg,;
::oPullDown:cClrPopup )
#ifndef HB_NO_READDBG
LOCAL lScoreBoard := Set( _SET_SCOREBOARD, .F. )
LOCAL GetList := {}
LOCAL bMouseSave
LOCAL oGet
LOCAL cPicture
#endif
DEFAULT lEditable TO .T.
IF cType == "C" .AND. Len( uValue ) > nWidth
uTemp := uValue
cPicture := "@s" + LTrim( Str( nWidth ) )
ELSE
uTemp := PadR( uValue, nWidth )
ENDIF
oWndInput:lShadow := .T.
oWndInput:Show()
nOldCursor := SetCursor()
nOldRow := Row()
nOldCol := Col()
uTemp := uValue
IF lEditable
#ifndef HB_NO_READDBG
IF cType == "C" .AND. Len( uValue ) > nWidth
cPicture := "@s" + LTrim( Str( nWidth ) )
ELSE
uTemp := PadR( uValue, nWidth )
ENDIF
IF bValid == NIL
@ nTop + 1, nLeft + 1 GET uTemp PICTURE cPicture COLOR "," + __DbgColors()[ 5 ]
ELSE
@@ -1589,20 +1596,32 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger
COLOR "," + __DbgColors()[ 5 ]
ENDIF
nOldCursor := SetCursor( SC_NORMAL )
SetCursor( SC_NORMAL )
oGet := ATail( GetList )
bMouseSave := SetKey( K_LBUTTONDOWN, { || iif( MRow() == nTop .AND. MCol() == nLeft + 2,;
( oGet:undo(), oGet:exitState := GE_ESCAPE, .T. ), .F. ) } )
READ
IF LastKey() == K_ESC
uTemp := uValue
ENDIF
SetKey( K_LBUTTONDOWN, bMouseSave)
SetCursor( nOldCursor )
#else
uTemp := __dbgInput( nTop + 1, nLeft + 1, uTemp, bValid, __DbgColors()[ 5 ] )
IF cType != "C" .OR. Len( uValue ) < nWidth
uTemp := PadR( uValue, nWidth )
ENDIF
uTemp := __dbgInput( nTop + 1, nLeft + 1, nWidth, uTemp, bValid, ;
__DbgColors()[ 5 ], Max( Max( nWidth, Len( uTemp ) ), 256 ) )
#endif
SWITCH cType
CASE "C" ; uTemp := AllTrim( uTemp ) ; EXIT
CASE "D" ; uTemp := CToD( uTemp ) ; EXIT
CASE "N" ; uTemp := Val( uTemp ) ; EXIT
ENDSWITCH
ELSE
hb_dispOutAt( nTop + 1, nLeft + 1, __dbgValToStr( uValue ), "," + __DbgColors()[ 5 ] )
SetPos( nTop + 1, nLeft + 1 )
nOldCursor := SetCursor( SC_NONE )
lExit := .F.
@@ -1640,25 +1659,14 @@ METHOD InputBox( cMsg, uValue, bValid, lEditable ) CLASS HBDebugger
ENDCASE
ENDDO
SetCursor( nOldCursor )
ENDIF
#ifndef HB_NO_READDBG
nOldCursor := SetCursor( SC_NORMAL )
READ
SetCursor( nOldCursor )
#endif
SetPos( nOldRow, nOldCol )
oWndInput:Hide()
Set( _SET_SCOREBOARD, lScoreBoard )
DO CASE
CASE cType == "C" ; uTemp := AllTrim( uTemp )
CASE cType == "D" ; uTemp := CToD( uTemp )
CASE cType == "N" ; uTemp := Val( uTemp )
ENDCASE
RETURN iif( LastKey() != K_ESC, uTemp, uValue )
RETURN uTemp
METHOD Inspect( uValue, cValueName ) CLASS HBDebugger
@@ -3393,31 +3401,36 @@ STATIC FUNCTION strip_path( cFileName )
RETURN cName + cExt
STATIC FUNCTION __dbgInput( nTop, nLeft, uValue, bValid, cColor )
STATIC FUNCTION __dbgInput( nRow, nCol, nWidth, cValue, bValid, cColor, nSize )
LOCAL nOldCursor := SetCursor( SC_NORMAL )
LOCAL uTemp := uValue
LOCAL cTemp := cValue
LOCAL nKey
LOCAL oGet
IF cColor != NIL
SetColor( cColor )
IF !ISNUMBER( nWidth )
nWidth := Len( cValue )
ENDIF
oGet := HbDbInput():new( nRow, nCol, nWidth, cValue, cColor, nSize )
oGet:setFocus()
DO WHILE .T.
hb_dispOutAt( nTop, nLeft, Space( Len( uTemp ) ), cColor )
SetPos( nTop, nLeft )
ACCEPT TO uTemp
IF bValid != NIL .AND. !Eval( bValid, uTemp )
uTemp := uValue
ELSE
WHILE .T.
nKey := Inkey( 0 )
IF nKey == K_ESC
EXIT
ELSEIF nKey == K_ENTER
IF bValid == NIL .OR. Eval( bValid, oGet:getValue() )
cTemp := oGet:getValue()
EXIT
ENDIF
ELSE
oGet:applyKey( nKey )
ENDIF
ENDDO
SetCursor( nOldCursor )
RETURN uTemp
RETURN cTemp
FUNCTION __dbgAchoice( nTop, nLeft, nBottom, nRight, aItems, cColors )