From d16d2b1e344528359b158ab72778a736c4e93b31 Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Thu, 16 Oct 2008 22:08:10 +0000 Subject: [PATCH] 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. --- harbour/ChangeLog | 11 ++ harbour/common.mak | 1 + harbour/source/debug/Makefile | 1 + harbour/source/debug/dbgtinp.prg | 206 ++++++++++++++++++++++++++++++ harbour/source/debug/debugger.prg | 99 +++++++------- 5 files changed, 275 insertions(+), 43 deletions(-) create mode 100644 harbour/source/debug/dbgtinp.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 6a992724d7..88e8fc0491 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -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 diff --git a/harbour/common.mak b/harbour/common.mak index cece7d7729..3cfea92b3c 100644 --- a/harbour/common.mak +++ b/harbour/common.mak @@ -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) \ diff --git a/harbour/source/debug/Makefile b/harbour/source/debug/Makefile index f8421fdfc4..ffd09badc6 100644 --- a/harbour/source/debug/Makefile +++ b/harbour/source/debug/Makefile @@ -10,6 +10,7 @@ C_SOURCES=\ PRG_SOURCES=\ dbgmenu.prg \ dbghelp.prg \ + dbgtinp.prg \ dbgtmenu.prg \ dbgtmitm.prg \ dbgtwin.prg \ diff --git a/harbour/source/debug/dbgtinp.prg b/harbour/source/debug/dbgtinp.prg new file mode 100644 index 0000000000..a656c2f7ff --- /dev/null +++ b/harbour/source/debug/dbgtinp.prg @@ -0,0 +1,206 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * User input class for debugger + * + * Copyright 2008 Przemyslaw Czerpak + * 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 diff --git a/harbour/source/debug/debugger.prg b/harbour/source/debug/debugger.prg index 55172fb4f5..10ee1a6178 100644 --- a/harbour/source/debug/debugger.prg +++ b/harbour/source/debug/debugger.prg @@ -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 )