From ee24175dc08e628299406dcb678f14602f58f426 Mon Sep 17 00:00:00 2001 From: Ron Pinkas Date: Thu, 2 Nov 2000 01:28:51 +0000 Subject: [PATCH] 2000-11-01 17:25 UTC+0800 Ron Pinkas * source/compiler/harbour.sly ! Optimized _GET_ support. + Added support for GET of ObjectData and ObjectData ArrayIndex. * source/rtl/tget.prg + Added method ParsePict() and logic to support dynamic modification of the picture by altering :Picture as in Clipper. * tests/testread.prg + Added line to demonstrate GET of ObjectData and dynamic modification of a PICTURE clause. --- harbour/ChangeLog | 11 +++++++ harbour/source/compiler/harbour.sly | 45 +++++++++++------------------ harbour/source/rtl/tget.prg | 40 +++++++++++++++---------- harbour/tests/testread.prg | 5 ++-- 4 files changed, 56 insertions(+), 45 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 786bace3ea..424a25db07 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,14 @@ +2000-11-01 17:25 UTC+0800 Ron Pinkas + + * source/compiler/harbour.sly + ! Optimized _GET_ support. + + Added support for GET of ObjectData and ObjectData ArrayIndex. + + * source/rtl/tget.prg + + Added method ParsePict() and logic to support dynamic modification of the picture by altering :Picture as in Clipper. + + * tests/testread.prg + + Added line to demonstrate GET of ObjectData and dynamic modification of a PICTURE clause. 2000-11-01 15:00 UTC+0800 Brian Hays * contrib/rdd_ads/ads1.c diff --git a/harbour/source/compiler/harbour.sly b/harbour/source/compiler/harbour.sly index 3535c16c5f..fa0aa19a2b 100644 --- a/harbour/source/compiler/harbour.sly +++ b/harbour/source/compiler/harbour.sly @@ -117,6 +117,8 @@ char * hb_comp_buffer; /* yacc input buffer */ static PTR_LOOPEXIT hb_comp_pLoops = NULL; static HB_RTVAR_PTR hb_comp_rtvars = NULL; +static HB_EXPR_PTR pArrayIndexAsList = NULL, pArrayIndexAsArray = NULL; + char * hb_comp_szAnnounce = NULL; /* ANNOUNCEd procedure */ static void hb_compDebugStart( void ) { }; @@ -229,7 +231,7 @@ static void hb_compDebugStart( void ) { }; %type DimIndex DimList %type FieldAlias FieldVarAlias %type PostOp -%type Get GetA GetBlock GetArrayIndex GetIndexList GetAliasVar +%type Get GetA GetBlock %% @@ -959,9 +961,9 @@ ArrayIndex : IndexList ']' { $$ = $1; } /* NOTE: $0 represents the expression before ArrayIndex * Don't use ArrayIndex in other context than as an array index! */ -IndexList : '[' Expression { $$ = hb_compExprNewArrayAt( $0, $2 ); } - | IndexList ',' Expression { $$ = hb_compExprNewArrayAt( $1, $3 ); } - | IndexList ']' '[' Expression { $$ = hb_compExprNewArrayAt( $1, $4 ); } +IndexList : '[' Expression { $$ = hb_compExprNewArrayAt( $0, $2 ); pArrayIndexAsList = hb_compExprNewList( $2 ); } + | IndexList ',' Expression { $$ = hb_compExprNewArrayAt( $1, $3 ) ; pArrayIndexAsList = hb_compExprAddListExpr( pArrayIndexAsList, $3 ); } + | IndexList ']' '[' Expression { $$ = hb_compExprNewArrayAt( $1, $4 ) ; pArrayIndexAsList = hb_compExprAddListExpr( pArrayIndexAsList, $4 ); } ; ElemList : Argument { $$ = hb_compExprNewList( $1 ); } @@ -976,41 +978,28 @@ CodeBlock : '{' '|' { $$ = hb_compExprNewCodeBlock(); } BlockNoVar Get : GET Variable ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $4 ), $6 ), $8 ), $10 ), $12 ) ); } - | GET GetAliasVar ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' + | GET AliasVar ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $4 ), $6 ), $8 ), $10 ), $12 ) ); } + | GET ObjectData ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $4 ), $6 ), $8 ), $10 ), $12 ) ); } + | GET ObjectData ArrayIndex ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $3 ), $5 ), $7 ), $9 ), $11 ), $13 ) ); } | GET MacroVar ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GET" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $4 ), $6 ), $8 ), $10 ), $12 ) ); } ; -GetA : GET Variable GetArrayIndex ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' - { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $5 ), $7 ), $9 ), $11 ), $13 ), $3 ) ); } - | GET GetAliasVar GetArrayIndex ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' - { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $5 ), $7 ), $9 ), $11 ), $13 ), $3 ) ); } - | GET MacroVar GetArrayIndex ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' - { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $5 ), $7 ), $9 ), $11 ), $13 ), $3 ) ); } +GetA : GET Variable ArrayIndex { pArrayIndexAsArray = hb_compExprNewArray( pArrayIndexAsList ); pArrayIndexAsList = NULL; } ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $6 ), $8 ), $10 ), $12 ), $14 ), pArrayIndexAsArray ) ) } + | GET AliasVar ArrayIndex { pArrayIndexAsArray = hb_compExprNewArray( pArrayIndexAsList ); pArrayIndexAsList = NULL; } ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $6 ), $8 ), $10 ), $12 ), $14 ), pArrayIndexAsArray ) ) } + | GET MacroVar ArrayIndex { pArrayIndexAsArray = hb_compExprNewArray( pArrayIndexAsList ); pArrayIndexAsList = NULL; } ',' LiteralValue ',' EmptyExpression ',' GetBlock ',' GetBlock ',' GetBlock ')' + { $$ = hb_compExprNewFunCall( hb_compExprNewFunName( "__GETA" ), hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprAddListExpr( hb_compExprNewArgList( $2 ), $6 ), $8 ), $10 ), $12 ), $14 ), pArrayIndexAsArray ) ) } ; -GetAliasVar: NumAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } - | MacroVarAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } - | MacroExprAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } - | PareExpListAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } - | VarAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } - | FieldAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } - | FieldVarAlias AliasId { $$ = hb_compExprNewAliasVar( $1, $2 ); } - ; - GetBlock : /* nothing => nil */ { $$ = hb_compExprNewEmpty(); } | CodeBlock ; -GetArrayIndex : GetIndexList ']' { $$ = hb_compExprNewArray( $1 ); } - ; - -GetIndexList : '[' Expression { $$ = hb_compExprNewList( $2 ); } - | GetIndexList ',' Expression { $$ = hb_compExprAddListExpr( $1, $3 ); } - | GetIndexList ']' '[' Expression { $$ = hb_compExprAddListExpr( $1, $4 ); } - ; - /* NOTE: This uses $-2 then don't use BlockExpList in other context */ BlockExpList : Expression { $$ = hb_compExprAddListExpr( $-2, $1 ); } diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index b90d1e5e2f..7c906bec34 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -91,6 +91,7 @@ CLASS Get METHOD Display() METHOD ColorDisp( cColorSpec ) INLINE ::ColorSpec := cColorSpec, ::Display(), Self METHOD KillFocus() + METHOD ParsePict( cPicture ) METHOD Reset() METHOD SetFocus() METHOD Undo() @@ -139,13 +140,6 @@ ENDCLASS METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS Get - local cChar - local nAt - local nFor - local cNum - - cNum := "" - DEFAULT nRow TO Row() DEFAULT nCol TO Col() DEFAULT cVarName TO "" @@ -180,6 +174,28 @@ METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS Get // Existe function en picture + ::ParsePict( cPicture ) + + ::buffer := ::PutMask( ::Original, .f. ) + ::nMaxLen := Len( ::buffer ) + + if ::nDispLen == NIL + ::nDispLen := ::nMaxLen + endif + +return Self + +//---------------------------------------------------------------------------// + +METHOD ParsePict( cPicture ) CLASS Get + + local cChar + local nAt + local nFor + local cNum + + cNum := "" + if Left( cPicture, 1 ) == "@" nAt := At( " ", cPicture ) if nAt == 0 @@ -255,14 +271,7 @@ METHOD New( nRow, nCol, bVarBlock, cVarName, cPicture, cColorSpec ) CLASS Get Next endif - ::buffer := ::PutMask( ::Original, .f. ) - ::nMaxLen := Len( ::buffer ) - - if ::nDispLen == NIL - ::nDispLen := ::nMaxLen - endif - -return Self +return ::cPicFunc + ' ' + ::cPicMask //---------------------------------------------------------------------------// @@ -361,6 +370,7 @@ METHOD SetFocus() CLASS Get ::hasfocus := .t. ::rejected := .f. ::typeout := .f. + ::ParsePict( :: Picture ) ::buffer := ::PutMask( ::VarGet(), .f. ) ::changed := .f. ::clear := ( "K" $ ::cPicFunc .or. ::type == "N") diff --git a/harbour/tests/testread.prg b/harbour/tests/testread.prg index a616dd5dd1..dc8bcda031 100644 --- a/harbour/tests/testread.prg +++ b/harbour/tests/testread.prg @@ -18,9 +18,10 @@ function Main() SET KEY -1 TO ShowVar() - @ 2, 2 SAY " Enter your name:" GET cName - @ 4, 2 SAY " Enter your wish:" GET cWish + @ 2, 2 SAY "Enter your name :" GET cName PICTURE "@K!" + @ 4, 2 SAY "Enter your wish :" GET cWish @ 6, 2 SAY "Enter your effort:" GET cEffort + @ 8, 2 SAY "Object Data :" GET GetList[1]:Picture FOR Counter := 1 TO Len( acVars ) @ Row() + 2, 2 SAY "Array Element [" + Str( Counter, 1 ) + "]: " GET acVars[ Counter ]