diff --git a/harbour/ChangeLog b/harbour/ChangeLog index dc0f680fe1..fd942a3125 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,25 @@ 2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org) */ +2008-10-27 14:47 UTC+0200 Viktor Szakats (harbour.01 syenar hu) + * include/hbextern.ch + * source/rtl/philes.c + + Added HB_FLOCK() / HB_FUNLOCK() file locking + functions. + [TOMERGE 1.0] + + * source/rtl/tget.prg + ! Accessing of Get() variables below made + C5.x compatible when a new value was + assigned to them as function call, rather + then normal assigment. + :buffer, :changed, :clear, :col, :colorSpec + :minus, :pos, :row, :subScript, :postBlock, + :preBlock, :cargo, :exitState, :reader. + ; NOTE: Please report if any of the side cases + still don't work. + [TOMERGE 1.0] + 2008-10-27 12:03 UTC+0200 Viktor Szakats (harbour.01 syenar hu) * make_vc.mak * contrib/mtpl_vc.mak diff --git a/harbour/include/hbextern.ch b/harbour/include/hbextern.ch index d9fff0ac76..125b74cc38 100644 --- a/harbour/include/hbextern.ch +++ b/harbour/include/hbextern.ch @@ -1090,6 +1090,8 @@ EXTERNAL HB_FCREATE EXTERNAL HB_FSIZE EXTERNAL HB_FEOF EXTERNAL HB_FCOMMIT +EXTERNAL HB_FLOCK +EXTERNAL HB_FUNLOCK EXTERNAL HB_FTEMPCREATE EXTERNAL HB_GCALL EXTERNAL HB_KEYCLEAR diff --git a/harbour/source/rtl/philes.c b/harbour/source/rtl/philes.c index 328eca96ea..51aea0348b 100644 --- a/harbour/source/rtl/philes.c +++ b/harbour/source/rtl/philes.c @@ -39,6 +39,8 @@ * * Copyright 1999-2001 Viktor Szakats * CURDIR() + * HB_FLOCK() + * HB_FUNLOCK() * * Copyright 2000 David G. Holm * HB_FEOF() @@ -290,6 +292,16 @@ HB_FUNC( HB_FCOMMIT ) hb_fsSetFError( uiError ); } +HB_FUNC( HB_FLOCK ) +{ + hb_retl( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) ? hb_fsLockLarge( hb_numToHandle( hb_parnint( 1 ) ), ( HB_FOFFSET ) hb_parnint( 2 ), ( HB_FOFFSET ) hb_parnint( 3 ), FL_LOCK ) : FALSE ); +} + +HB_FUNC( HB_FUNLOCK ) +{ + hb_retl( ISNUM( 1 ) && ISNUM( 2 ) && ISNUM( 3 ) ? hb_fsLockLarge( hb_numToHandle( hb_parnint( 1 ) ), ( HB_FOFFSET ) hb_parnint( 2 ), ( HB_FOFFSET ) hb_parnint( 3 ), FL_UNLOCK ) : FALSE ); +} + HB_FUNC( HB_OSERROR ) { hb_retni( hb_fsOsError() ); diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index 05645f95db..350f2f29da 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -78,32 +78,34 @@ CREATE CLASS Get STATIC CREATE CLASS Get #endif - EXPORTED: + PROTECTED: /* === Start of CA-Cl*pper compatible TGet instance area === */ - VAR bBlock PROTECTED /* 01. */ - VAR subScript /* 02. */ - VAR cPicture PROTECTED /* 03. */ - VAR postBlock /* 04. */ - VAR preBlock /* 05. */ - VAR cargo /* 06. */ - VAR cName PROTECTED /* 07. */ + VAR bBlock /* 01. */ + VAR xSubScript /* 02. */ + VAR cPicture /* 03. */ + VAR bPostBlock /* 04. */ + VAR bPreBlock /* 05. */ + VAR xCargo /* 06. */ + VAR cName /* 07. */ VAR cInternal1 HIDDEN /* 08. U2Bin( ::nRow ) + U2Bin( ::nCol ) + trash. Not implemented in Harbour. */ - VAR exitState /* 09. */ - VAR reader /* 10. */ + VAR xExitState /* 09. */ + VAR bReader /* 10. */ #ifdef HB_COMPAT_C53 - VAR oControl PROTECTED /* 11. CA-Cl*pper 5.3 only. */ - VAR cCaption PROTECTED INIT "" /* 12. CA-Cl*pper 5.3 only. */ - VAR nCapCol PROTECTED INIT 0 /* 13. CA-Cl*pper 5.3 only. */ - VAR nCapRow PROTECTED INIT 0 /* 14. CA-Cl*pper 5.3 only. */ - VAR cMessage PROTECTED INIT "" /* 15. CA-Cl*pper 5.3 only. */ - VAR nDispLen PROTECTED /* 16. CA-Cl*pper 5.3 places it here. */ + VAR oControl /* 11. CA-Cl*pper 5.3 only. */ + VAR cCaption INIT "" /* 12. CA-Cl*pper 5.3 only. */ + VAR nCapCol INIT 0 /* 13. CA-Cl*pper 5.3 only. */ + VAR nCapRow INIT 0 /* 14. CA-Cl*pper 5.3 only. */ + VAR cMessage INIT "" /* 15. CA-Cl*pper 5.3 only. */ + VAR nDispLen /* 16. CA-Cl*pper 5.3 places it here. */ #endif - VAR cType PROTECTED /* +1. Only accessible in CA-Cl*pper when ::hasFocus == .T. In CA-Cl*pper the field may contain random chars after the first one, which is the type. */ - VAR cBuffer PROTECTED /* +2. Only accessible in CA-Cl*pper when ::hasFocus == .T. */ - VAR xVarGet PROTECTED /* +3. Only accessible in CA-Cl*pper when ::hasFocus == .T. */ + VAR cType /* +1. Only accessible in CA-Cl*pper when ::hasFocus == .T. In CA-Cl*pper the field may contain random chars after the first one, which is the type. */ + VAR cBuffer /* +2. Only accessible in CA-Cl*pper when ::hasFocus == .T. */ + VAR xVarGet /* +3. Only accessible in CA-Cl*pper when ::hasFocus == .T. */ /* === End of CA-Cl*pper compatible TGet instance area === */ + EXPORTED: + VAR decPos INIT 0 READONLY /* ; CA-Cl*pper NG says that it contains NIL, but in fact it contains zero. [vszakats] */ VAR hasFocus INIT .F. READONLY VAR original READONLY @@ -115,12 +117,17 @@ CREATE CLASS Get METHOD assign() METHOD badDate() METHOD block( bBlock ) SETGET - METHOD buffer( cBuffer ) SETGET - METHOD changed( lChanged ) SETGET - METHOD clear( lClear ) SETGET - METHOD col( nCol ) SETGET + ACCESS buffer METHOD getBuffer() + ASSIGN buffer METHOD setBuffer( cBuffer ) + ACCESS changed METHOD getChanged() + ASSIGN changed METHOD setChanged( lChanged ) + ACCESS clear METHOD getClear() + ASSIGN clear METHOD setClear( lClear ) + ACCESS col METHOD getCol() + ASSIGN col METHOD setCol( nCol ) METHOD colorDisp( cColorSpec ) - METHOD colorSpec( cColorSpec ) SETGET + ACCESS colorSpec METHOD getColorSpec() + ASSIGN colorSpec METHOD setColorSpec( cColorSpec ) METHOD display() #ifdef HB_COMPAT_C53 METHOD hitTest( nMRow, nMCol ) @@ -131,10 +138,12 @@ CREATE CLASS Get METHOD capCol( nCapCol ) SETGET /* NOTE: Undocumented CA-Cl*pper 5.3 method. */ #endif METHOD killFocus() - METHOD minus( lMinus ) SETGET + ACCESS minus METHOD getMinus() + ASSIGN minus METHOD setMinus( lMinus ) METHOD name( cName ) SETGET METHOD picture( cPicture ) SETGET - METHOD pos( nPos ) SETGET + ACCESS pos METHOD getPos() + ASSIGN pos METHOD setPos( nPos ) #ifdef HB_COMPAT_XPP METHOD posInBuffer( nRow, nCol ) #endif @@ -142,7 +151,8 @@ CREATE CLASS Get METHOD reform() #endif METHOD reset() - METHOD row( nRow ) SETGET + ACCESS row METHOD getRow() + ASSIGN row METHOD setRow( nRow ) METHOD setFocus() METHOD type() METHOD undo() @@ -170,6 +180,13 @@ CREATE CLASS Get METHOD insert( cChar ) METHOD overStrike( cChar ) + METHOD subScript( xValue ) SETGET + METHOD postBlock( xValue ) SETGET + METHOD preBlock( xValue ) SETGET + METHOD cargo( xValue ) SETGET + METHOD exitState( xValue ) SETGET + METHOD reader( xValue ) SETGET + #ifdef HB_EXTENSION METHOD hideInput( lHideInput ) SETGET METHOD style( cStyle ) SETGET @@ -509,7 +526,7 @@ METHOD varPut( xValue ) CLASS Get LOCAL aValue IF ISBLOCK( ::bBlock ) .AND. ValType( xValue ) $ "CNDLU" - aSubs := ::subScript + aSubs := ::xSubScript IF ISARRAY( aSubs ) .AND. ! Empty( aSubs ) nLen := Len( aSubs ) aValue := Eval( ::bBlock ) @@ -540,7 +557,7 @@ METHOD varGet() CLASS Get LOCAL xValue IF ISBLOCK( ::bBlock ) - aSubs := ::subScript + aSubs := ::xSubScript IF ISARRAY( aSubs ) .AND. ! Empty( aSubs ) nLen := Len( aSubs ) xValue := Eval( ::bBlock ) @@ -926,16 +943,15 @@ METHOD delWordRight() CLASS Get * be used for GET_CLR_UNSELECTED and GET_CLR_ENHANCED. */ -METHOD colorSpec( cColorSpec ) CLASS Get +METHOD getColorSpec() CLASS Get + RETURN ::cColorSpec + +METHOD setColorSpec( cColorSpec ) CLASS Get LOCAL nClrUns LOCAL nClrOth LOCAL cClrOth - IF PCount() == 0 - RETURN ::cColorSpec - ENDIF - IF ISCHARACTER( cColorSpec ) #ifdef HB_COMPAT_C53 @@ -973,14 +989,13 @@ METHOD colorSpec( cColorSpec ) CLASS Get RETURN cColorSpec -METHOD pos( nPos ) CLASS Get +METHOD getPos() CLASS Get + RETURN ::nPos + +METHOD setPos( nPos ) CLASS Get LOCAL tmp - IF PCount() == 0 - RETURN ::nPos - ENDIF - IF ISNUMBER( nPos ) nPos := Int( nPos ) @@ -1807,21 +1822,18 @@ METHOD Input( cChar ) CLASS Get /* ------------------------------------------------------------------------- */ -METHOD buffer( cBuffer ) CLASS Get - - IF PCount() == 0 - RETURN ::cBuffer - ENDIF +METHOD getBuffer() CLASS Get + RETURN ::cBuffer +METHOD setBuffer( cBuffer ) CLASS Get RETURN iif( ::hasFocus, ::cBuffer := cBuffer, cBuffer ) /* NOTE: In contrary to CA-Cl*pper docs, this var is assignable. [vszakats] */ -METHOD changed( lChanged ) CLASS Get +METHOD getChanged() CLASS Get + RETURN ::lChanged - IF PCount() == 0 - RETURN ::lChanged - ENDIF +METHOD setChanged( lChanged ) CLASS Get IF ISLOGICAL( lChanged ) RETURN iif( ::hasFocus, ::lChanged := lChanged, lChanged ) @@ -1829,11 +1841,10 @@ METHOD changed( lChanged ) CLASS Get RETURN .F. -METHOD clear( lClear ) CLASS Get +METHOD getClear() CLASS Get + RETURN ::lClear - IF PCount() == 0 - RETURN ::lClear - ENDIF +METHOD setClear( lClear ) CLASS Get IF ISLOGICAL( lClear ) RETURN iif( ::hasFocus, ::lClear := lClear, lClear ) @@ -1841,11 +1852,10 @@ METHOD clear( lClear ) CLASS Get RETURN .F. -METHOD minus( lMinus ) CLASS Get +METHOD getMinus() CLASS Get + RETURN ::lMinus - IF PCount() == 0 - RETURN ::lMinus - ENDIF +METHOD setMinus( lMinus ) CLASS Get IF ISLOGICAL( lMinus ) RETURN iif( ::hasFocus, ::lMinus := lMinus, lMinus ) @@ -1856,25 +1866,21 @@ METHOD minus( lMinus ) CLASS Get /* NOTE: CA-Cl*pper has a bug where negative nRow value will be translated to 16bit unsigned int, so the behaviour will be different in this case. [vszakats] */ -METHOD row( nRow ) CLASS Get - - IF PCount() > 0 - ::nRow := iif( ISNUMBER( nRow ), Int( nRow ), 0 ) - ENDIF - +METHOD getRow() CLASS Get RETURN ::nRow +METHOD setRow( nRow ) CLASS Get + RETURN ::nRow := iif( ISNUMBER( nRow ), Int( nRow ), 0 ) + /* NOTE: CA-Cl*pper has a bug where negative nCol value will be translated to 16bit unsigned int, so the behaviour will be different in this case. [vszakats] */ -METHOD col( nCol ) CLASS Get - - IF PCount() > 0 - ::nCol := iif( ISNUMBER( nCol ), Int( nCol ), 0 ) - ENDIF - +METHOD getCol() CLASS Get RETURN ::nCol +METHOD setCol( nCol ) CLASS Get + RETURN ::nCol := iif( ISNUMBER( nCol ), Int( nCol ), 0 ) + METHOD name( cName ) CLASS Get IF PCount() > 0 .AND. cName != NIL @@ -1883,6 +1889,54 @@ METHOD name( cName ) CLASS Get RETURN ::cName +METHOD SubScript( xValue ) CLASS Get + + IF xValue != NIL + ::xSubScript := xValue + ENDIF + + RETURN ::xSubScript + +METHOD PostBlock( xValue ) CLASS Get + + IF xValue != NIL + ::bPostBlock := xValue + ENDIF + + RETURN ::bPostBlock + +METHOD PreBlock( xValue ) CLASS Get + + IF xValue != NIL + ::bPreBlock := xValue + ENDIF + + RETURN ::bPreBlock + +METHOD Cargo( xValue ) CLASS Get + + IF xValue != NIL + ::xCargo := xValue + ENDIF + + RETURN ::xCargo + +METHOD ExitState( xValue ) CLASS Get + + IF xValue != NIL + ::xExitState := xValue + ENDIF + + RETURN ::xExitState + +METHOD Reader( xValue ) CLASS Get + + IF xValue != NIL + ::bReader := xValue + ENDIF + + RETURN ::bReader + #ifdef HB_EXTENSION METHOD hideInput( lHideInput ) CLASS Get