diff --git a/harbour/ChangeLog b/harbour/ChangeLog index ae5d047d8f..69e5f8c18a 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,38 @@ +20000515-20:22 GMT+4 April White + + * source\rtl\makefile + - setkey.prg from PRG_SOURCES section + + setkey.c to C_SOURCES section + + * makefile.bc + - removed setkey.prg rule (?) + * changed (OBJ_DIR)\setkey.c to (RTL_DIR)\setkey.c + + * makefile.vc + * moved the setkey.obj rule from PRG section to C section + + * source\rtl\console.c + + added hb_setkeyInit() to hb_conInit() + + added hb_setkeyExit() to hb_conRelease() + + * include\hbapigt.h + + added declaration for hb_setkeyInit() and hb_setkeyExit() + + + source\rtl\setkey.prg + + C implimentation of setkey + + * tests\setkeys.prg + * added code to disable (and later restore) F8 hot key while + inside it's action block - prevents recursion + * changed condition block on F10 hot-key to use getactive():VarGet() vs + getactive():buffer - this prevented testing non-character gets + + * tests\gnu_test.bat + * added % to end of hb_architecture & hb_compiler where needed + + * include\hbextern.ch + * changed 'rtl\setkey.prg' to 'rtl\setkey.c' + 20000516-03:59 GMT+1 Victor Szakats * source/lang/Makefile diff --git a/harbour/include/hbapigt.h b/harbour/include/hbapigt.h index 79d83f0188..c3a08f0047 100644 --- a/harbour/include/hbapigt.h +++ b/harbour/include/hbapigt.h @@ -235,6 +235,18 @@ extern int hb_mouse_CountButton( void ); extern void hb_mouse_SetBounds( int iTop, int iLeft, int iBottom, int iRight ); extern void hb_mouse_GetBounds( int * piTop, int * piLeft, int * piBottom, int * piRight ); +/* SetKey related declarations */ + +/* Public interface. These should never change, only be added to. */ + +extern void hb_setkeyInit( void ); +extern void hb_setkeyExit( void ); + +/* Private interface listed below. these are common to all platforms */ + +/* none as of yet */ + + #if defined(HB_EXTERN_C) } #endif diff --git a/harbour/include/hbextern.ch b/harbour/include/hbextern.ch index a7d57c0f49..f756140de5 100644 --- a/harbour/include/hbextern.ch +++ b/harbour/include/hbextern.ch @@ -647,7 +647,7 @@ EXTERNAL __OBJDELDATA // EXTERNAL READKEY // -//symbols from file: rtl\setkey.prg +//symbols from file: rtl\setkey.c // EXTERNAL SETKEY #ifdef HB_EXTENSION diff --git a/harbour/makefile.bc b/harbour/makefile.bc index 9369376048..d8f5a0541f 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -1374,10 +1374,7 @@ $(OBJ_DIR)\setfunc.obj : $(OBJ_DIR)\setfunc.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, -$(OBJ_DIR)\setkey.c : $(RTL_DIR)\setkey.prg - $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ - -$(OBJ_DIR)\setkey.obj : $(OBJ_DIR)\setkey.c +$(OBJ_DIR)\setkey.obj : $(RTL_DIR)\setkey.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/makefile.vc b/harbour/makefile.vc index ec7e90f2d7..55cd0cf211 100644 --- a/harbour/makefile.vc +++ b/harbour/makefile.vc @@ -265,6 +265,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\set.obj \ $(OBJ_DIR)\setcolor.obj \ $(OBJ_DIR)\setcurs.obj \ + $(OBJ_DIR)\setkey.obj \ $(OBJ_DIR)\setpos.obj \ $(OBJ_DIR)\setposbs.obj \ $(OBJ_DIR)\shadow.obj \ @@ -314,7 +315,6 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\readkey.obj \ $(OBJ_DIR)\readvar.obj \ $(OBJ_DIR)\setfunc.obj \ - $(OBJ_DIR)\setkey.obj \ $(OBJ_DIR)\setta.obj \ $(OBJ_DIR)\tbcolumn.obj \ $(OBJ_DIR)\tbrowse.obj \ diff --git a/harbour/source/rtl/console.c b/harbour/source/rtl/console.c index 4f0295c8f0..ccca7e2bb3 100644 --- a/harbour/source/rtl/console.c +++ b/harbour/source/rtl/console.c @@ -39,7 +39,7 @@ * * Copyright 1999 David G. Holm * hb_conOutAlt(), hb_conOutDev(), DEVOUT(), hb_conDevPos(), - * DEVPOS(), __EJECT(), + * DEVPOS(), __EJECT(), * hb_conOut(), hb_conOutErr(), OUTERR(), * hb_conOutStd(), OUTSTD(), PCOL(), PROW(), * SETPRC(), and hb_conInit() @@ -123,6 +123,8 @@ void hb_conInit( void ) hb_mouseInit(); hb_gtInit( s_iFilenoStdin, s_iFilenoStdout, s_iFilenoStderr ); + + hb_setkeyInit(); /* April White, May 6, 2000 */ } void hb_conRelease( void ) @@ -136,6 +138,8 @@ void hb_conRelease( void ) s_szCrLf[ 0 ] = HB_CHAR_LF; s_szCrLf[ 1 ] = '\0'; + hb_setkeyExit(); /* April White, May 6, 2000 */ + hb_gtExit(); hb_mouseExit(); diff --git a/harbour/source/rtl/setkey.c b/harbour/source/rtl/setkey.c new file mode 100644 index 0000000000..b1d30ed97b --- /dev/null +++ b/harbour/source/rtl/setkey.c @@ -0,0 +1,471 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * SETKEY() and related functions + * + * Copyright 1999 A White + * 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/). + * + */ + +/* + Either way you have to clean up the memory on exit. The best way to + do this is to add a hb_setkeyInit() and hb_setkeyExit() function + and call them from CONSOLE.C Init/Exit functions. +*/ + +#include "hbvm.h" +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapierr.h" + +#define SK_NO_RETURN FALSE + +#define SETKEY_ERRORS + +typedef struct SetKey_S +{ + SHORT keycode; + PHB_ITEM Action; +#if defined( HB_EXTENSION ) + PHB_ITEM IsActive; +#endif + struct SetKey_S *next; +} SetKey_T, *pSetKey_T; + +pSetKey_T sk_list; + +#if defined( SETKEY_ERRORS ) + +#define SK_ERR_NOARGS 3101 +#define SK_ERR_ARGTYPE_KEY 3102 +#define SK_ERR_ARGTYPE_KEYN 3103 +#define SK_ERR_ARGTYPE_ACTION 3104 +#define SK_ERR_ARGTYPE_ACTIVE 3105 +#define SK_ERR_ARGTYPE_SKSAVE 3106 +#define SK_ERR_ACTIVE_RESULTS 3107 + +static void sk_error( ULONG ulSubCode ) +{ + PHB_ITEM pResult; + char *szDescription; + + switch ( ulSubCode ) { + case SK_ERR_NOARGS : szDescription = "Missing parameter(s)"; break; + case SK_ERR_ARGTYPE_KEY : szDescription = "anKey non-numeric"; break; + case SK_ERR_ARGTYPE_KEYN : szDescription = "anKey non-numeric and non-array of numbers"; break; + case SK_ERR_ARGTYPE_ACTION: szDescription = "bAction is not a code-block"; break; + case SK_ERR_ARGTYPE_ACTIVE: szDescription = "bCondition is not a code-block"; break; + case SK_ERR_ARGTYPE_SKSAVE: szDescription = "OldKeys must be return value from previous hb_SetKeySave(), or NIL"; break; + case SK_ERR_ACTIVE_RESULTS: szDescription = "bCondition returns non-logical"; break; + } + + pResult = hb_errRT_BASE_Subst( EG_ARG, ulSubCode, szDescription, "SETKEY" ); + if ( pResult ) + { + hb_itemReturn( pResult ); + hb_itemRelease( pResult ); + } +} + +#else + +#define sk_error( n ) + +#endif + +void hb_setkeyInit( void ) +{ + sk_list = NULL; +} + +void hb_setkeyExit( void ) +{ + pSetKey_T sk_list_tmp; + + while ( sk_list != NULL ) + { + hb_itemRelease( sk_list->Action ); + +#if defined( HB_EXTENSION ) + if ( sk_list->IsActive ) + hb_itemRelease( sk_list->IsActive ); +#endif + + sk_list_tmp = sk_list->next; + hb_xfree( ( void * )sk_list ); + sk_list = sk_list_tmp; + } + sk_list = NULL; +} + + +static pSetKey_T sk_findkey( SHORT key, pSetKey_T *sk_list_end ) +{ + pSetKey_T sk_list_tmp; + + *sk_list_end = NULL; + for ( sk_list_tmp = sk_list; + sk_list_tmp && sk_list_tmp->keycode != key; + sk_list_tmp = sk_list_tmp->next ) + { + *sk_list_end = sk_list_tmp; + } + + return sk_list_tmp; +} + +static void sk_get( void ) +{ + pSetKey_T sk_list_tmp, sk_list_end; + PHB_ITEM pKeyCode = hb_param( 1, HB_IT_NUMERIC ); + + if ( pKeyCode ) + { + /* sk_list_end is not used in this context */ + sk_list_tmp = sk_findkey( hb_itemGetNI( pKeyCode ), &sk_list_end ); + if ( sk_list_tmp ) + { +#if defined( HB_EXTENSION ) + PHB_ITEM pIsActiveResults; + + if ( sk_list_tmp->IsActive != NULL ) + { + pIsActiveResults = hb_vmEvalBlockV( sk_list_tmp->IsActive, 1, pKeyCode ); + if ( !HB_IS_LOGICAL( pIsActiveResults ) ) + sk_error( SK_ERR_ACTIVE_RESULTS ); + } + else + pIsActiveResults = NULL; + + if ( pIsActiveResults == NULL || + hb_itemGetL( pIsActiveResults ) ) + { +#endif +PHB_ITEM pAction = hb_itemNew( sk_list_tmp->Action ); + hb_itemReturn( pAction ); + hb_itemRelease( pAction ); + +#if defined( HB_EXTENSION ) + } + else + hb_ret(); +#endif + } + } + else + { + hb_ret(); + sk_error( SK_ERR_ARGTYPE_KEYN ); + } +} + + +#if defined( HB_EXTENSION ) + #define sk_addkey( r, k, a, i ) sk_add( r, k, a, i ) +#else + #define sk_addkey( r, k, a, i ) sk_add( r, k, a ) +#endif + +static void sk_add( BOOL bReturn, SHORT nkeycode, PHB_ITEM pAction, PHB_ITEM pIsActive ) +{ + pSetKey_T sk_list_tmp, sk_list_end; + + sk_list_tmp = sk_findkey( nkeycode, &sk_list_end ); + if ( sk_list_tmp == NULL ) + { + if ( bReturn ) + hb_ret(); /* return a NIL */ + + /* if the action param is nil, and nothing found, no need to do anything */ + if ( HB_IS_NIL( pAction ) ) + return; + + sk_list_tmp = ( pSetKey_T )hb_xgrab( sizeof( SetKey_T ) ); + sk_list_tmp->next = NULL; + sk_list_tmp->keycode = nkeycode; + + if ( sk_list_end == NULL ) + sk_list = sk_list_tmp; + else + sk_list_end->next = sk_list_tmp; + } + else + { + if ( bReturn ) + hb_itemReturn( sk_list_tmp->Action ); + hb_itemRelease( sk_list_tmp->Action ); + +#if defined( HB_EXTENSION ) + if ( sk_list_tmp->IsActive ) + hb_itemRelease( sk_list_tmp->IsActive ); +#endif + + if ( HB_IS_NIL( pAction ) ) + { + /* if this is true, then the key found is the first key in the list */ + if ( sk_list_end == NULL ) + { + sk_list_tmp = sk_list->next; + hb_xfree( sk_list ); + sk_list = sk_list_tmp; + } + else + { + sk_list_end->next = sk_list_tmp->next; + hb_xfree( sk_list_tmp ); + } + return; + } + } + + sk_list_tmp->Action = hb_itemNew( pAction ); + +#if defined( HB_EXTENSION ) + if ( pIsActive ) + sk_list_tmp->IsActive = hb_itemNew( pIsActive ); + else + sk_list_tmp->IsActive = NULL; +#endif +} + +static void sk_set( void ) +{ + PHB_ITEM pKeyCode = hb_param( 1, HB_IT_ANY ); + PHB_ITEM pAction = hb_param( 2, HB_IT_ANY ); +#if defined( HB_EXTENSION ) + PHB_ITEM pIsActive = hb_param( 3, HB_IT_BLOCK ); +#endif + int nitem, nupper, nlower; + SHORT nkeycode; + + if ( !HB_IS_NUMERIC( pKeyCode ) && !HB_IS_ARRAY( pKeyCode ) ) + { + sk_error( SK_ERR_ARGTYPE_KEY ); + return; + } + + if ( !( HB_IS_NIL( pAction ) || HB_IS_BLOCK( pAction ) ) ) + { + sk_error( SK_ERR_ARGTYPE_ACTION ); + return; + } + +#if defined( HB_EXTENSION ) + if ( hb_pcount() >= 3 && pIsActive == NULL ) + { + sk_error( SK_ERR_ARGTYPE_ACTIVE ); + return; + } +#endif + + if ( HB_IS_ARRAY( pKeyCode ) ) + { + nlower = 1; + nupper = hb_arrayLen( pKeyCode ); + } + else + nlower = nupper = 0; + + /* use a loop to assign hot-keys - this will execute + only once if anKey [pKeyCode] is a number */ + + for ( nitem = nlower; nitem <= nupper; nitem++ ) + { + if ( HB_IS_ARRAY( pKeyCode ) ) + nkeycode = hb_itemGetNI( hb_arrayGetItemPtr( pKeyCode, nitem ) ); + else + nkeycode = hb_itemGetNI( pKeyCode ); + + sk_addkey( ( BOOL )( nitem == nupper ), nkeycode, pAction, pIsActive ); + } +} + +HB_FUNC( SETKEY ) +{ + switch( hb_pcount() ) { + case 0: + sk_error( SK_ERR_NOARGS ); + break; + + case 1: + sk_get(); + break; + + default: + sk_set(); + break; + } +} + +#if defined( HB_EXTENSION ) + +HB_FUNC( HB_SETKEYGET ) +{ + pSetKey_T sk_list_tmp, sk_list_end; + PHB_ITEM pKeyCode = hb_param( 1, HB_IT_NUMERIC ); + PHB_ITEM pIsActive = hb_param( 2, HB_IT_ANY );//HB_IT_BYREF ); + + if ( pKeyCode ) + { + /* sk_list_end is not used in this context */ + sk_list_tmp = sk_findkey( hb_itemGetNI( pKeyCode ), &sk_list_end ); + if ( sk_list_tmp ) + { + hb_itemReturn( sk_list_tmp->Action ); + if ( pIsActive ) + hb_itemCopy( pIsActive, sk_list_tmp->IsActive ); + } + } + else + { + hb_ret(); + sk_error( SK_ERR_ARGTYPE_KEYN ); + } +} + +HB_FUNC( HB_SETKEYSAVE ) +{ + PHB_ITEM pKeys, pParam; + pSetKey_T sk_list_tmp; + ULONG itemcount, nitem; + + /* build an multi-dimensional array from existing hot-keys, and return it */ + + /* count the number of items in the list */ + for ( itemcount = 0, sk_list_tmp = sk_list; + sk_list_tmp; + itemcount++, sk_list_tmp = sk_list_tmp->next ) + ; + + pKeys = hb_itemArrayNew( itemcount ); + + for ( nitem = 1, sk_list_tmp = sk_list; + nitem <= itemcount; + nitem++, sk_list_tmp = sk_list_tmp->next ) + { + PHB_ITEM pKeyElements, pTmp; + + pKeyElements = hb_itemArrayNew( 3 ); + + pTmp = hb_itemPutNI( NULL, sk_list_tmp->keycode ); + hb_itemArrayPut( pKeyElements, 1, pTmp ); + hb_itemRelease( pTmp ); + + pTmp = hb_itemNew( sk_list_tmp->Action ); + hb_itemArrayPut( pKeyElements, 2, pTmp ); + hb_itemRelease( pTmp ); + + if ( sk_list_tmp->IsActive ) + { + pTmp = hb_itemNew( sk_list_tmp->IsActive ); + hb_itemArrayPut( pKeyElements, 3, pTmp ); + hb_itemRelease( pTmp ); + } + + hb_itemArrayPut( pKeys, nitem, pKeyElements ); + hb_itemRelease( pKeyElements ); + } + + hb_itemReturn( pKeys ); + hb_itemRelease( pKeys ); + + pParam = hb_param( 1, HB_IT_ANY ); + if ( pParam != NULL ) + { + hb_setkeyExit(); /* destroy the internal list */ + + if ( HB_IS_ARRAY( pParam ) ) + { + itemcount = hb_arrayLen( pParam ); + + for ( nitem = 1; nitem <= itemcount; nitem++ ) + { + PHB_ITEM itmKeyElements, itmKeyCode, itmAction, itmIsActive; + + itmKeyElements = hb_arrayGetItemPtr( pParam, nitem ); + + itmKeyCode = hb_arrayGetItemPtr( itmKeyElements, 1 ); + itmAction = hb_arrayGetItemPtr( itmKeyElements, 2 ); + itmIsActive = hb_arrayGetItemPtr( itmKeyElements, 3 ); + + sk_addkey( SK_NO_RETURN, ( SHORT )hb_itemGetNI( itmKeyCode ), itmAction, itmIsActive ); + } + } + else if ( !HB_IS_NIL( pParam ) ) + sk_error( SK_ERR_ARGTYPE_SKSAVE ); + } +} + +HB_FUNC( HB_SETKEYCHECK ) +{ + pSetKey_T sk_list_tmp, sk_list_end; + PHB_ITEM pKeyCode = hb_param( 1, HB_IT_NUMERIC ), pIsActiveResults; + BOOL IsKeySet = FALSE; + + if ( pKeyCode ) + { + /* sk_list_end is not used in this context */ + sk_list_tmp = sk_findkey( hb_itemGetNI( pKeyCode ), &sk_list_end ); + if ( sk_list_tmp ) + { + if ( sk_list_tmp->IsActive == NULL ) + IsKeySet = TRUE; + else + { + pIsActiveResults = hb_vmEvalBlockV( sk_list_tmp->IsActive, 1, pKeyCode ); + if ( HB_IS_LOGICAL( pIsActiveResults ) ) + IsKeySet = hb_itemGetL( pIsActiveResults ); + else + sk_error( SK_ERR_ACTIVE_RESULTS ); + } + } + } + else + sk_error( SK_ERR_ARGTYPE_KEYN ); + + if ( IsKeySet ) + { + PHB_ITEM p2 = hb_param( 2, HB_IT_ANY ); + PHB_ITEM p3 = hb_param( 3, HB_IT_ANY ); + PHB_ITEM p4 = hb_param( 4, HB_IT_ANY ); +// PHB_ITEM pAction = hb_itemNew( sk_list_tmp->Action ); + + switch( hb_pcount() ) { + case 1: hb_vmEvalBlockV( sk_list_tmp->Action /*pAction*/, 1, pKeyCode ); break; + case 2: hb_vmEvalBlockV( sk_list_tmp->Action /*pAction*/, 2, p2, pKeyCode ); break; + case 3: hb_vmEvalBlockV( sk_list_tmp->Action /*pAction*/, 3, p2, p3, pKeyCode ); break; + default: hb_vmEvalBlockV( sk_list_tmp->Action /*pAction*/, 4, p2, p3, p4, pKeyCode ); break; + } +// hb_itemRelease( pAction ); + } + + hb_retl( IsKeySet ); +} + +#endif diff --git a/harbour/source/rtl/setkey.prg b/harbour/source/rtl/setkey.prg deleted file mode 100644 index 82b9895714..0000000000 --- a/harbour/source/rtl/setkey.prg +++ /dev/null @@ -1,151 +0,0 @@ -/* - * $Id$ - */ - -/* - * Harbour Project source code: - * SETKEY() and related functions - * - * Copyright 1999 A White - * 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 "hbsetup.ch" - -#include "common.ch" - -// macro substitutions to access sub-array elements of aSetKeys[] -#define KEY 1 -#define BLOCK 2 -#define CONDITION 3 - -// holds array of hot-key id, code-block, activation-block -static s_aSetKeys := {} - -Function SetKey( anKey, bBlock, bCondition ) - local nFound - local bReturn - local aKey - - if ISARRAY( anKey ) - aEval( anKey, {|x| setKey( x, bBlock, bCondition ) } ) - - elseif ISNUMBER( anKey ) .and. anKey <> 0 - if ( nFound := aScan( s_aSetKeys, {|x| x[ KEY ] == anKey } ) ) == 0 - if ISBLOCK( bBlock ) - aAdd( s_aSetKeys, { anKey, bBlock, bCondition } ) - - endif - - else - aKey := s_aSetKeys[ nFound ] - - if aKey[ CONDITION ] == NIL .or. eval( aKey[ CONDITION ], anKey ) - bReturn := aKey[ BLOCK ] - - endif - - if ISBLOCK( bBlock ) - aKey[ BLOCK ] := bBlock - aKey[ CONDITION ] := bCondition - - elseif pcount() > 1 .and. bBlock == NIL - aSize( aDel( s_aSetKeys, nFound ), len( s_aSetKeys ) - 1 ) - - endif - - endif - - endif - -return bReturn - -#ifdef HB_EXTENSION - -Function HB_SetKeyGet( nKey, bCondition ) - local nFound - - if ISNUMBER( nKey ) .and. nKey <> 0 - if ( nFound := aScan( s_aSetKeys, {|x| x[ KEY ] == nKey } ) ) == 0 - bCondition := NIL - - else - bCondition := s_aSetKeys[ nFound, CONDITION ] - return s_aSetKeys[ nFound, BLOCK ] - - endif - - endif - -return NIL - -Function HB_SetKeySave( OldKeys ) - local aReturn := aClone( s_aSetKeys ) - - if pcount() != 0 .or. ISARRAY( OldKeys ) - if OldKeys == NIL - s_aSetKeys := {} - - else - s_aSetKeys := aClone( OldKeys ) - - endif - - endif - -return aReturn - -Function HB_SetKeyCheck( nKey, p1, p2, p3 ) - local nFound - local aKey - local bBlock - - if ( nFound := aScan( s_aSetKeys, {|x| x[ KEY ] == nKey } ) ) > 0 - aKey := s_aSetKeys[ nFound ] - bBLock := aKey[ BLOCK ] - - if aKey[ CONDITION ] == NIL .or. eval( aKey[ CONDITION ], nKey ) - - // is this overkill? if a code-block checks its own pcount(), - // passing nil parameters would skew the count! - - do case - case pcount() == 1 ; eval( bBlock, nKey ) - case pcount() == 2 ; eval( bBlock, p1, nKey ) - case pcount() == 3 ; eval( bBlock, p1, p2, nKey ) - otherwise ; eval( bBlock, p1, p2, p3, nKey ) - end case - - return .t. - - endif - - endif - -return .f. - -#endif - diff --git a/harbour/tests/setkeys.prg b/harbour/tests/setkeys.prg index 4fe2acc46b..5c16eedf2b 100644 --- a/harbour/tests/setkeys.prg +++ b/harbour/tests/setkeys.prg @@ -36,13 +36,15 @@ #include "inkey.ch" Procedure Main() local GetList := {} - local alpha, bravo, charlie, k + local alpha, bravo, charlie, k, l + local F8Active := .t. cls @ 2, 2 say "Press F10 to popup alert box of current get, not active if empty" @ 3, 2 say "Press F9 to disable all setkeys, except F9 to restore (uses SetKeySave())" - @ 4, 2 say "Press F8 to test setkey w/ array, and SetKeyCheck()" + @ 4, 2 say "Press F8 to test setkey w/ array, SetKeyCheck(), and SetKeyGet()" + @ 5, 2 say "Press F7 to active/deactive F8" alpha := "alpha " bravo := 123 @@ -61,10 +63,12 @@ #endif - setKey( K_F10, {|| Alert( transform( getactive():varGet(), NIL ) ) }, {|| !empty( getactive():buffer ) } ) + setKey( K_F10, {|| Alert( transform( getactive():varGet(), NIL ) ) }, ; + {|| !empty( getactive():VarGet() ) } ) /* :buffer */ setKey( K_F9 , {|| k := hb_SetKeySave( NIL ), ; SetKey( K_F9, {|| hb_SetKeySave( k ) } ) } ) - SetKey( K_F8 , {|| SubMain() } ) + SetKey( K_F8 , {|| SubMain() }, {|| F8Active } ) + SetKey( K_F7 , {|| F8Active := .not. F8Active } ) read ? alpha, bravo, charlie @@ -72,6 +76,11 @@ static Procedure SubMain() local n + local bF8Action, bF8Active + + bF8Action := hb_SetKeyGet( K_F8, @bF8Active ) + SetKey( K_F8, NIL ) + SetKey( { 49, 50, 52, 53 }, {|x| qout( chr( x ) ) } ) do while ( n := inkey( 0 ) ) != K_ESC if hb_SetKeyCheck( n ) @@ -81,4 +90,6 @@ qqout( " hit cold" ) endif end + SetKey( { 49, 50, 52, 53 }, NIL ) + SetKey( K_F8, bF8Action, bF8Active )