From 8b0e8e99b8a9b033cf4f268fe0228f0fd7ddf7f9 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Mon, 3 Apr 2000 17:56:14 +0000 Subject: [PATCH] 20000403-19:57 GMT+1 Victor Szakats --- harbour/ChangeLog | 23 +++ harbour/makefile.bc | 24 +++ harbour/makefile.vc | 3 + harbour/source/rtl/Makefile | 3 + harbour/source/rtl/getlist.prg | 55 +++++++ harbour/source/rtl/getsys.prg | 249 ++++++++++++++++++++++++++++++++ harbour/source/rtl/readvar.prg | 43 ++++++ harbour/source/rtl/tgetlist.prg | 207 +++----------------------- 8 files changed, 421 insertions(+), 186 deletions(-) create mode 100644 harbour/source/rtl/getlist.prg create mode 100644 harbour/source/rtl/getsys.prg create mode 100644 harbour/source/rtl/readvar.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 1da01b7120..4f21423058 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,26 @@ +20000403-19:57 GMT+1 Victor Szakats + + + source/rtl/getlist.prg + + source/rtl/getsys.prg + + source/rtl/readvar.prg + * source/rtl/tgetlist.prg + * source/rtl/Makefile + * makefile.bc + * makefile.vc + + New Harbour internal function __GetListActive() added to provide an + interface between TGETLIST and GETSYS. + + The active getlist holder moved to a separate file GETLIST. + + RANGECHECK() function added to GETSYS. Now the namespace of GETLIST is + is equivalent to CA-Cl*pper. + + READVAR() moved back into separate file. + + TGetList class separated from the GETSYS procedural (compatibility) + interface. This way it's possible to override the GETSYS, READVAR or + TGETLIST modules at link time just like in CA-Clipper. + + * source/rtl/tgetlist.prg + ! GetP*Validate() - Fixed. + + Added lHasFocus data. + 20000403-18:25 GMT+1 Victor Szakats * utils/hbtest/* diff --git a/harbour/makefile.bc b/harbour/makefile.bc index f245f3403e..eec45ea9fa 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -263,11 +263,14 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\dummy.obj \ $(OBJ_DIR)\errorsys.obj \ $(OBJ_DIR)\fieldbl.obj \ + $(OBJ_DIR)\getlist.obj \ + $(OBJ_DIR)\getsys.obj \ $(OBJ_DIR)\input.obj \ $(OBJ_DIR)\memvarbl.obj \ $(OBJ_DIR)\menuto.obj \ $(OBJ_DIR)\objfunc.obj \ $(OBJ_DIR)\readkey.obj \ + $(OBJ_DIR)\readvar.obj \ $(OBJ_DIR)\setfunc.obj \ $(OBJ_DIR)\setkey.obj \ $(OBJ_DIR)\setta.obj \ @@ -1089,6 +1092,20 @@ $(OBJ_DIR)\fieldbl.obj : $(OBJ_DIR)\fieldbl.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\getlist.c : $(RTL_DIR)\getlist.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\getlist.obj : $(OBJ_DIR)\getlist.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + +$(OBJ_DIR)\getsys.c : $(RTL_DIR)\getsys.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\getsys.obj : $(OBJ_DIR)\getsys.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\filesys.obj : $(RTL_DIR)\filesys.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, @@ -1292,6 +1309,13 @@ $(OBJ_DIR)\readkey.obj : $(OBJ_DIR)\readkey.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, +$(OBJ_DIR)\readvar.c : $(RTL_DIR)\readvar.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\readvar.obj : $(OBJ_DIR)\readvar.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) -+$@,, + $(OBJ_DIR)\replic.obj : $(RTL_DIR)\replic.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) -+$@,, diff --git a/harbour/makefile.vc b/harbour/makefile.vc index 17e9d9822e..b6a7ce6c1e 100644 --- a/harbour/makefile.vc +++ b/harbour/makefile.vc @@ -302,11 +302,14 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\dummy.obj \ $(OBJ_DIR)\errorsys.obj \ $(OBJ_DIR)\fieldbl.obj \ + $(OBJ_DIR)\getlist.obj \ + $(OBJ_DIR)\getsys.obj \ $(OBJ_DIR)\input.obj \ $(OBJ_DIR)\memvarbl.obj \ $(OBJ_DIR)\menuto.obj \ $(OBJ_DIR)\objfunc.obj \ $(OBJ_DIR)\readkey.obj \ + $(OBJ_DIR)\readvar.obj \ $(OBJ_DIR)\setfunc.obj \ $(OBJ_DIR)\setkey.obj \ $(OBJ_DIR)\setta.obj \ diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index eb4f66b30b..91bc7d5add 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -122,11 +122,14 @@ PRG_SOURCES=\ dummy.prg \ errorsys.prg \ fieldbl.prg \ + getlist.prg \ + getsys.prg \ input.prg \ memvarbl.prg \ menuto.prg \ objfunc.prg \ readkey.prg \ + readvar.prg \ setfunc.prg \ setkey.prg \ setta.prg \ diff --git a/harbour/source/rtl/getlist.prg b/harbour/source/rtl/getlist.prg new file mode 100644 index 0000000000..d6914ca0b3 --- /dev/null +++ b/harbour/source/rtl/getlist.prg @@ -0,0 +1,55 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * GET system active getlist handler for default TGETLIST/GETSYS/READVAR + * + * Copyright 2000 Victor Szakats + * 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: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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 program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +/* NOTE: Harbour internal function to set and get the active GetList */ + +STATIC s_oGetListActive + +PROCEDURE __GetListSetActive( oGetList ) + + IF s_oGetListActive != NIL + s_oGetListActive:lHasFocus := .F. + ENDIF + + s_oGetListActive := oGetList + s_oGetListActive:lHasFocus := .T. + + RETURN + +/* NOTE: Using a separate function for maximum speed */ + +FUNCTION __GetListActive() + RETURN s_oGetListActive + diff --git a/harbour/source/rtl/getsys.prg b/harbour/source/rtl/getsys.prg new file mode 100644 index 0000000000..53bb445598 --- /dev/null +++ b/harbour/source/rtl/getsys.prg @@ -0,0 +1,249 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * GET system module (default) + * + * Copyright 1999 Antonio Linares + * 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: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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 program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "common.ch" + +FUNCTION ReadModal( GetList, nPos ) + + LOCAL oGetList + + IF Empty( GetList ) + SetPos( MaxRow() - 1, 0 ) + RETURN .F. + ENDIF + + oGetList := TGetList():New( GetList ) + oGetList:cReadProcName := ProcName( 1 ) + oGetList:nReadProcLine := ProcLine( 1 ) + + __GetListSetActive( oGetList ) + + IF ! ( ISNUMBER( nPos ) .AND. nPos > 0 ) + oGetList:nPos := oGetList:Settle( 0 ) + ENDIF + + DO WHILE oGetList:nPos != 0 + + oGetList:oGet := oGetList:aGetList[ oGetList:nPos ] + oGetList:PostActiveGet() + + IF ISBLOCK( oGetList:oGet:Reader ) + Eval( oGetList:oGet:Reader, oGetList:oGet ) + ELSE + oGetList:Reader() + ENDIF + + oGetList:nPos := oGetList:Settle() + + ENDDO + + SetPos( MaxRow() - 1, 0 ) + + RETURN oGetList:lUpdated + +PROCEDURE GetReader( oGet ) + + oGet:Reader() + + RETURN + +FUNCTION GetActive( oGet ) + + IF __GetListActive() != NIL + IF PCount() > 0 + RETURN __GetListActive():GetActive( oGet ) + ELSE + RETURN __GetListActive():GetActive() + ENDIF + ENDIF + + RETURN NIL + +PROCEDURE GetDoSetKey( keyBlock, oGet ) + + IF __GetListActive() != NIL + IF oGet != NIL + __GetListActive():oGet := oGet + ENDIF + __GetListActive():GetDoSetKey( keyBlock ) + ENDIF + + RETURN + +PROCEDURE GetApplyKey( oGet, nKey ) + + IF __GetListActive() != NIL + __GetListActive():oGet := oGet + __GetListActive():GetApplyKey( nKey ) + ENDIF + + RETURN + +FUNCTION GetPreValidate( oGet ) + + IF __GetListActive() != NIL + IF oGet != NIL + __GetListActive():oGet := oGet + ENDIF + + RETURN __GetListActive():GetPreValidate() + ENDIF + + RETURN .F. + +FUNCTION GetPostValidate( oGet ) + + IF __GetListActive() != NIL + IF oGet != NIL + __GetListActive():oGet := oGet + ENDIF + + RETURN __GetListActive():GetPostValidate() + ENDIF + + RETURN .F. + +FUNCTION ReadExit( lExit ) + RETURN Set( _SET_EXIT, lExit ) + +FUNCTION ReadInsert( lInsert ) + RETURN Set( _SET_INSERT, lInsert ) + +FUNCTION ReadUpdated( lUpdated ) + + IF __GetListActive() != NIL + IF PCount() > 0 + RETURN __GetListActive():ReadUpdated( lUpdated ) + ELSE + RETURN __GetListActive():ReadUpdated() + ENDIF + ENDIF + + RETURN .F. + +FUNCTION Updated() + + IF __GetListActive() != NIL + RETURN __GetListActive():lUpdated + ENDIF + + RETURN .F. + +FUNCTION ReadKill( lKill ) + + IF __GetListActive() != NIL + IF PCount() > 0 + RETURN __GetListActive():KillRead( lKill ) + ELSE + RETURN __GetListActive():KillRead() + ENDIF + ENDIF + + RETURN .F. + +PROCEDURE __KillRead() + + IF __GetListActive() != NIL + __GetListActive():KillRead( .T. ) + ENDIF + + RETURN + +PROCEDURE __SetFormat( bFormat ) + + IF __GetListActive() != NIL + IF ISBLOCK( bFormat ) + __GetListActive():SetFormat( bFormat ) + ELSE + __GetListActive():SetFormat() + ENDIF + ENDIF + + RETURN + +FUNCTION ReadFormat( bFormat ) + + IF __GetListActive() != NIL + IF PCount() > 0 + RETURN __GetListActive():SetFormat( bFormat ) + ELSE + RETURN __GetListActive():SetFormat() + ENDIF + ENDIF + + RETURN NIL + +#define SCORE_ROW 0 +#define SCORE_COL 60 + +#define _GET_RANGE_FROM 10 +#define _GET_RANGE_TO 11 + +FUNCTION RangeCheck( oGet, xDummy, xLow, xHigh ) + LOCAL xValue + LOCAL cMessage + LOCAL nOldRow, nOldCol + + IF !oGet:changed + RETURN .T. + ENDIF + + xValue := oGet:varGet() + + IF xValue >= xLow .AND. xValue <= xHigh + RETURN .T. + ENDIF + + IF Set( _SET_SCOREBOARD ) + + cMessage := Left( NationMsg( _GET_RANGE_FROM ) + LTrim( hb_ValToStr( xLow ) ) + ; + NationMsg( _GET_RANGE_TO ) + LTrim( hb_ValToStr( xHigh ) ), MaxCol() ) + + nOldRow := Row() + nOldCol := Col() + + DispOutAt( SCORE_ROW, Min( 60, MaxCol() - Len( cMessage ) ), cMessage ) + SetPos( nOldRow, nOldCol ) + + DO WHILE NextKey() == 0 + ENDDO + + DispOutAt( SCORE_ROW, Min( 60, MaxCol() - Len( cMessage ) ), Space( Len( cMessage ) ) ) + SetPos( nOldRow, nOldCol ) + + ENDIF + + RETURN .F. + diff --git a/harbour/source/rtl/readvar.prg b/harbour/source/rtl/readvar.prg new file mode 100644 index 0000000000..54b38a59ab --- /dev/null +++ b/harbour/source/rtl/readvar.prg @@ -0,0 +1,43 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * READVAR() function + * + * Copyright 2000 Victor Szakats + * 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: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) 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 HRL + * and/or HVM code into it. + * + * 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 program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +FUNCTION ReadVar( cNewVarName ) + + IF __GetListActive() != NIL + RETURN __GetListActive():ReadVar( cNewVarName ) + ENDIF + + RETURN "" + diff --git a/harbour/source/rtl/tgetlist.prg b/harbour/source/rtl/tgetlist.prg index 21de85d507..e5dc0dd7b3 100644 --- a/harbour/source/rtl/tgetlist.prg +++ b/harbour/source/rtl/tgetlist.prg @@ -4,7 +4,7 @@ /* * Harbour Project source code: - * GetList Class + * TGetList Class * * Copyright 1999 Antonio Linares * www - http://www.harbour-project.org @@ -40,46 +40,10 @@ #include "setcurs.ch" #define SCORE_ROW 0 -#define SCORE_COL 60 +#define SCORE_COL 60 #define K_UNDO K_CTRL_U -static s_oGetListActive - -function ReadModal( GetList, nPos ) - - local oGetList - - if Empty( GetList ) - SetPos( MaxRow() - 1, 0 ) - return .f. - endif - - oGetList := TGetList():New( GetList ) - oGetList:cReadProcName := ProcName( 1 ) - oGetList:nReadProcLine := ProcLine( 1 ) - s_oGetListActive := oGetList - - if ! ( ISNUMBER( nPos ) .and. nPos > 0 ) - oGetList:nPos := oGetList:Settle( 0 ) - endif - - while oGetList:nPos != 0 - oGetList:oGet := oGetList:aGetList[ oGetList:nPos ] - oGetList:PostActiveGet() - - if ISBLOCK( oGetList:oGet:Reader ) - Eval( oGetList:oGet:Reader, oGetList:oGet ) - else - oGetList:Reader() - endif - - oGetList:nPos := oGetList:Settle() - end - SetPos( MaxRow() - 1, 0 ) - -return oGetList:lUpdated - CLASS TGetList DATA aGetList @@ -93,6 +57,7 @@ CLASS TGetList DATA oActiveGet DATA cReadProcName, nReadProcLine DATA cVarName + DATA lHasFocus METHOD New( GetList ) METHOD Settle( nPos ) @@ -111,29 +76,34 @@ CLASS TGetList METHOD ReadUpdated( lUpdated ) METHOD ReadVar( cNewVarName ) METHOD ReadExit( lNew ) INLINE Set( _SET_EXIT, lNew ) - - METHOD SetFocus() INLINE s_oGetListActive := Self,; - ::aGetList[ ::nPos ]:SetFocus() - + METHOD SetFocus() METHOD Updated() INLINE ::lUpdated ENDCLASS METHOD New( GetList ) CLASS TGetList - ::aGetList := GetList - ::lKillRead := .f. - ::lBumpTop := .f. - ::lBumpBot := .f. + ::aGetList := GetList + ::lKillRead := .f. + ::lBumpTop := .f. + ::lBumpBot := .f. ::nLastExitState := 0 - ::nLastPos := 0 - ::cReadProcName := "" - ::lUpdated := .f. - ::nPos := 1 - ::oGet := GetList[ 1 ] + ::nLastPos := 0 + ::cReadProcName := "" + ::lUpdated := .f. + ::nPos := 1 + ::oGet := GetList[ 1 ] + ::lHasFocus := .F. return Self +METHOD SetFocus() CLASS TGetList + + __GetListSetActive( Self ) + ::aGetList[ ::nPos ]:SetFocus() + + return Self + METHOD Reader() CLASS TGetList local oGet := ::oGet @@ -301,14 +271,6 @@ METHOD GetPreValidate() CLASS TGetList return lWhen -function GetPreValidate( oGet ) - - if oGet != nil - s_oGetListActive:oGet := oGet - endif - -return s_oGetListActive:GetPreValidate() - METHOD GetPostValidate() CLASS TGetList local oGet := ::oGet @@ -350,14 +312,6 @@ METHOD GetPostValidate() CLASS TGetList return lValid -function GetPostValidate( oGet ) - - if oGet != nil - s_oGetListActive:oGet := oGet - endif - -return s_oGetListActive:GetPostValidate() - METHOD GetDoSetKey( bKeyBlock ) CLASS TGetList local oGet := ::oGet, lUpdated @@ -476,18 +430,6 @@ METHOD GetReadVar() CLASS TGetList return cName -function ReadFormat( bFormat ) - - if s_oGetListActive != NIL - if PCount() > 0 - return s_oGetListActive:SetFormat( bFormat ) - else - return s_oGetListActive:SetFormat() - endif - endif - -return nil - METHOD SetFormat( bFormat ) CLASS TGetList local bSavFormat := ::bFormat @@ -573,110 +515,3 @@ METHOD ReadUpdated( lUpdated ) CLASS TGetList endif return lSavUpdated - -/* ------------------ Global functions ------------------- */ - -PROCEDURE GetReader( oGet ) - - oGet:Reader() - - RETURN - -FUNCTION GetActive( oGet ) - - if s_oGetListActive != NIL - if PCount() > 0 - RETURN s_oGetListActive:GetActive( oGet ) - else - RETURN s_oGetListActive:GetActive() - endif - endif - - RETURN NIL - -PROCEDURE GetDoSetKey( keyBlock, oGet ) - - if s_oGetListActive != NIL - if oGet != NIL - s_oGetListActive:oGet := oGet - endif - s_oGetListActive:GetDoSetKey( keyBlock ) - endif - - RETURN - -PROCEDURE GetApplyKey( oGet, nKey ) - - if s_oGetListActive != NIL - s_oGetListActive:oGet := oGet - s_oGetListActive:GetApplyKey( nKey ) - endif - - RETURN - -FUNCTION ReadVar( cNewVarName ) - - if s_oGetListActive != NIL - RETURN s_oGetListActive:ReadVar( cNewVarName ) - endif - - RETURN "" - -FUNCTION ReadExit( lExit ) - RETURN Set( _SET_EXIT, lExit ) - -FUNCTION ReadInsert( lInsert ) - RETURN Set( _SET_INSERT, lInsert ) - -FUNCTION ReadUpdated( lUpdated ) - - if s_oGetListActive != NIL - if PCount() > 0 - RETURN s_oGetListActive:ReadUpdated( lUpdated ) - else - RETURN s_oGetListActive:ReadUpdated() - endif - endif - - RETURN .F. - -FUNCTION Updated() - - if s_oGetListActive != NIL - RETURN s_oGetListActive:lUpdated - endif - - RETURN .F. - -FUNCTION ReadKill( lKill ) - - if s_oGetListActive != NIL - if PCount() > 0 - RETURN s_oGetListActive:KillRead( lKill ) - else - RETURN s_oGetListActive:KillRead() - endif - endif - - RETURN .F. - -PROCEDURE __KillRead() - - IF s_oGetListActive != NIL - s_oGetListActive:KillRead( .T. ) - ENDIF - - RETURN - -PROCEDURE __SetFormat( bFormat ) - - if s_oGetListActive != NIL - if ValType( bFormat ) == "B" - s_oGetListActive:SetFormat( bFormat ) - else - s_oGetListActive:SetFormat() - endif - endif - - RETURN -