fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2008-10-27 14:47 UTC+0200 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* 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]
This commit is contained in:
Viktor Szakats
2008-10-27 13:48:01 +00:00
parent d1dc70f971
commit d7af644364
4 changed files with 155 additions and 68 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
harbour/ChangeLog
View File

@@ -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

2
harbour/include/hbextern.ch
View File

@@ -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

12
harbour/source/rtl/philes.c
View File

@@ -39,6 +39,8 @@
*
* Copyright 1999-2001 Viktor Szakats <viktor.szakats@syenar.hu>
* CURDIR()
* HB_FLOCK()
* HB_FUNLOCK()
*
* Copyright 2000 David G. Holm <dholm@jsd-llc.com>
* 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() );

190
harbour/source/rtl/tget.prg
View File

@@ -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