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

2008-07-11 17:33 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/include/dbedit.ch
  * harbour/source/rtl/dbedit.prg
    + added support for undocumented Clipper DE_APPEND mode - code
      covered by HB_C52_UNDOC
    % ignore K_MOUSEMOVE events to avoid flickering just like CA-Cl*pper
      does
    + added support for cell positioning with mouse left key - CL53
      compatible behavior covered by HB_COMPAT_C53 macro
    * changed static function name dbEditCallUser() to CallUser() for
      strict Clipper compatibility - some user function code may check
      PROCNAME()
    * some minor optimizations and fixes

  * harbour/contrib/hbmzip/hbmzip.c
    * indenting

  * harbour/source/vm/hvm.c
    * formatting
This commit is contained in:
Przemyslaw Czerpak
2008-07-11 15:33:41 +00:00
parent ee2b31438d
commit 38fd033e77
5 changed files with 266 additions and 209 deletions
Download Patch File Download Diff File Expand all files Collapse all files

20
harbour/ChangeLog
View File

@@ -8,6 +8,26 @@
2008-12-31 13:59 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2008-07-11 17:33 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/include/dbedit.ch
* harbour/source/rtl/dbedit.prg
+ added support for undocumented Clipper DE_APPEND mode - code
covered by HB_C52_UNDOC
% ignore K_MOUSEMOVE events to avoid flickering just like CA-Cl*pper
does
+ added support for cell positioning with mouse left key - CL53
compatible behavior covered by HB_COMPAT_C53 macro
* changed static function name dbEditCallUser() to CallUser() for
strict Clipper compatibility - some user function code may check
PROCNAME()
* some minor optimizations and fixes
* harbour/contrib/hbmzip/hbmzip.c
* indenting
* harbour/source/vm/hvm.c
* formatting
2008-07-10 20:59 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/source/vm/macro.c
! fixed RT error when invalid symbol string is precompiled

2
harbour/contrib/hbmzip/hbmzip.c
View File

@@ -543,7 +543,7 @@ static int hb_zipStoreFile( zipFile hZip, char* szFileName, char* szName, char*
#else
memcpy( &st, localtime( &statbuf.st_mtime ), sizeof( st ) );
#endif
zfi.tmz_date.tm_sec = st.tm_sec;
zfi.tmz_date.tm_min = st.tm_min;
zfi.tmz_date.tm_hour = st.tm_hour;

3
harbour/include/dbedit.ch
View File

@@ -64,5 +64,8 @@
#define DE_ABORT 0 /* Abort DBEDIT() */
#define DE_CONT 1 /* Continue DBEDIT() */
#define DE_REFRESH 2 /* Force reread/redisplay of all data rows */
#ifdef HB_C52_UNDOC
#define DE_APPEND 3 /* Undocumented CA-Cl*pper append mode in DBEdit */
#endif
#endif /* _DBEDIT_CH */

370
harbour/source/rtl/dbedit.prg
View File

@@ -55,58 +55,35 @@
#include "inkey.ch"
#include "setcurs.ch"
#define HB_DBEMPTY() ( LastRec() == 0 .OR. ( ( Eof() .OR. RecNo() == LastRec() + 1 ) .AND. Bof() ) )
/* NOTE: Extension: Harbour supports codeblocks as the xUserFunc parameter
[vszakats] */
/* NOTE: Clipper is buggy and will throw an error if the number of
columns is zero. (Check: dbEdit(0,0,20,20,{})) [vszakats] */
/* NOTE: Clipper will throw an error if there's no database open [vszakats] */
/* NOTE: The NG says that the return value is NIL, but it's not. [vszakats] */
/* NOTE: There's an undocumented result code in Clipper (3), which is not
supported in Harbour. [vszakats] */
/* NOTE: Harbour is multithreading ready/reentrant, Clipper is not.
/* NOTE: Harbour is multithreading ready and Clipper only reentrant safe
[vszakats] */
FUNCTION dbEdit(;
nTop,;
nLeft,;
nBottom,;
nRight,;
acColumns,;
xUserFunc,;
xColumnSayPictures,;
xColumnHeaders,;
xHeadingSeparators,;
xColumnSeparators,;
xFootingSeparators,;
xColumnFootings )
FUNCTION DBEDIT( nTop, nLeft, nBottom, nRight, ;
acColumns, xUserFunc, ;
xColumnSayPictures, xColumnHeaders, ;
xHeadingSeparators, xColumnSeparators, ;
xFootingSeparators, xColumnFootings )
LOCAL oBrowse
LOCAL nKey
LOCAL bAction
LOCAL lException
LOCAL nOldCursor
LOCAL nPos
LOCAL nColCount
LOCAL oColumn
LOCAL nAliasPos
LOCAL cAlias
LOCAL cFieldName
LOCAL cHeading
LOCAL cBlock
LOCAL nOldCUrsor, nKey, nMode, nPos, nAliasPos, nColCount
LOCAL lDoIdleCall, lAppend
LOCAL cHeading, cBlock
LOCAL bBlock
LOCAL oBrowse
LOCAL oColumn
LOCAL aCol
IF !Used()
RETURN .F.
ELSEIF EOF()
dbGoBottom()
ENDIF
/* ------------------------------------------------------ */
/* Set up the environment, evaluate the passed parameters */
/* ------------------------------------------------------ */
IF !ISNUMBER( nTop ) .OR. nTop < 0
nTop := 0
ENDIF
@@ -120,44 +97,41 @@ FUNCTION dbEdit(;
nRight := MaxCol()
ENDIF
oBrowse := TBrowseDB( nTop, nLeft, nBottom, nRight )
oBrowse:SkipBlock := {| nRecs | dbEditSkipped( nRecs ) }
oBrowse:HeadSep := iif( ISCHARACTER( xHeadingSeparators ), xHeadingSeparators, Chr( 205 ) + Chr( 209 ) + Chr( 205 ) )
oBrowse:ColSep := iif( ISCHARACTER( xColumnSeparators ), xColumnSeparators, " " + Chr( 179 ) + " " )
oBrowse:FootSep := iif( ISCHARACTER( xFootingSeparators ), xFootingSeparators, "" )
oBrowse:AutoLite := .F. /* Set to .F. just like in CA-Cl*pper. [vszakats] */
// Calculate the number of columns
oBrowse := TBrowseDb( nTop, nLeft, nBottom, nRight )
oBrowse:headSep := iif( ISCHARACTER( xHeadingSeparators ), xHeadingSeparators, Chr( 205 ) + Chr( 209 ) + Chr( 205 ) )
oBrowse:colSep := iif( ISCHARACTER( xColumnSeparators ), xColumnSeparators, " " + Chr( 179 ) + " " )
oBrowse:footSep := iif( ISCHARACTER( xFootingSeparators ), xFootingSeparators, "" )
oBrowse:autoLite := .F. /* Set to .F. just like in CA-Cl*pper. [vszakats] */
IF ISARRAY( acColumns )
nColCount := Len( acColumns )
nPos := 1
DO WHILE nPos <= nColCount .AND. ISCHARACTER( acColumns[ nPos ] ) .AND. !Empty( acColumns[ nPos ] )
nPos++
ENDDO
nColCount := nPos - 1
IF nColCount == 0
RETURN .F.
ENDIF
nColCount := 0
FOR EACH aCol IN acColumns
IF ISCHARACTER( aCol ) .AND. !Empty( aCol )
nColCount++
ELSE
EXIT
ENDIF
NEXT
ELSE
nColCount := FCount()
ENDIF
// Generate the TBrowse columns
IF nColCount == 0
RETURN .F.
ENDIF
/* Generate the TBrowse columns */
FOR nPos := 1 TO nColCount
IF ISARRAY( acColumns )
IF ( nAliasPos := At( "->", acColumns[ nPos ] ) ) > 0
cAlias := SubStr( acColumns[ nPos ], 1, nAliasPos - 1 )
cFieldName := SubStr( acColumns[ nPos ], nAliasPos + 2 )
cHeading := cAlias + "->;" + cFieldName
ELSE
cHeading := acColumns[ nPos ]
ENDIF
cBlock := acColumns[ nPos ]
IF ( nAliasPos := At( "->", cBlock ) ) > 0
cHeading := SubStr( cBlock, 1, nAliasPos - 1 ) + "->;" + ;
SubStr( cBlock, nAliasPos + 2 )
ELSE
cHeading := cBlock
ENDIF
ELSE
cBlock := FieldName( nPos )
cHeading := cBlock
@@ -185,162 +159,218 @@ FUNCTION dbEdit(;
oColumn := TBColumnNew( cHeading, bBlock )
IF ISARRAY( xColumnSayPictures ) .AND. nPos <= Len( xColumnSayPictures ) .AND. ISCHARACTER( xColumnSayPictures[ nPos ] ) .AND. !Empty( xColumnSayPictures[ nPos ] )
oColumn:Picture := xColumnSayPictures[ nPos ]
oColumn:picture := xColumnSayPictures[ nPos ]
ELSEIF ISCHARACTER( xColumnSayPictures ) .AND. !Empty( xColumnSayPictures )
oColumn:Picture := xColumnSayPictures
oColumn:picture := xColumnSayPictures
ENDIF
IF ISARRAY( xColumnFootings ) .AND. nPos <= Len( xColumnFootings ) .AND. ISCHARACTER( xColumnFootings[ nPos ] )
oColumn:Footing := xColumnFootings[ nPos ]
oColumn:footing := xColumnFootings[ nPos ]
ELSEIF ISCHARACTER( xColumnFootings )
oColumn:Footing := xColumnFootings
oColumn:footing := xColumnFootings
ENDIF
IF ISARRAY( xHeadingSeparators ) .AND. nPos <= Len( xHeadingSeparators ) .AND. ISCHARACTER( xHeadingSeparators[ nPos ] )
oColumn:HeadSep := xHeadingSeparators[ nPos ]
oColumn:headSep := xHeadingSeparators[ nPos ]
ENDIF
IF ISARRAY( xColumnSeparators ) .AND. nPos <= Len( xColumnSeparators ) .AND. ISCHARACTER( xColumnSeparators[ nPos ] )
oColumn:ColSep := xColumnSeparators[ nPos ]
oColumn:colSep := xColumnSeparators[ nPos ]
ENDIF
IF ISARRAY( xFootingSeparators ) .AND. nPos <= Len( xFootingSeparators ) .AND. ISCHARACTER( xFootingSeparators[ nPos ] )
oColumn:FootSep := xFootingSeparators[ nPos ]
oColumn:footSep := xFootingSeparators[ nPos ]
ENDIF
oBrowse:AddColumn( oColumn )
oBrowse:addColumn( oColumn )
NEXT
nOldCUrsor := SetCursor( SC_NONE )
/* --------------------------- */
/* Go into the processing loop */
/* --------------------------- */
IF Eof()
dbGoBottom()
ENDIF
lAppend := .F.
lDoIdleCall := .T.
nMode := DE_CONT
nOldCursor := SetCursor( SC_NONE )
lException := .F.
WHILE nMode != DE_ABORT
DO WHILE .T.
DO WHILE !oBrowse:Stabilize() .AND. NextKey() == 0
ENDDO
IF ( nKey := InKey() ) == 0
IF !lException
IF !dbEditCallUser( oBrowse, xUserFunc, 0 )
oBrowse:forceStable()
EXIT
ENDIF
oBrowse:forceStable()
ENDIF
oBrowse:Hilite()
nKey := InKey( 0 )
oBrowse:DeHilite()
IF ( bAction := SetKey( nKey ) ) != NIL
Eval( bAction, ProcName( 1 ), ProcLine( 1 ), "" )
LOOP
ENDIF
ENDIF
lException := .F.
DO CASE
CASE nKey == K_DOWN ; oBrowse:Down()
CASE nKey == K_UP ; oBrowse:Up()
CASE nKey == K_PGDN ; oBrowse:PageDown()
CASE nKey == K_PGUP ; oBrowse:PageUp()
CASE nKey == K_CTRL_PGUP ; oBrowse:GoTop()
CASE nKey == K_CTRL_PGDN ; oBrowse:GoBottom()
CASE nKey == K_RIGHT ; oBrowse:Right()
CASE nKey == K_LEFT ; oBrowse:Left()
CASE nKey == K_HOME ; oBrowse:Home()
CASE nKey == K_END ; oBrowse:End()
CASE nKey == K_CTRL_LEFT ; oBrowse:PanLeft()
CASE nKey == K_CTRL_RIGHT ; oBrowse:PanRight()
CASE nKey == K_CTRL_HOME ; oBrowse:PanHome()
CASE nKey == K_CTRL_END ; oBrowse:PanEnd()
OTHERWISE
IF !dbEditCallUser( oBrowse, xUserFunc, nKey )
WHILE .T.
nKey := InKey()
IF oBrowse:stabilize() .OR. ( nKey != 0 .AND. nKey != K_MOUSEMOVE )
EXIT
ENDIF
lException := .T.
ENDCASE
ENDDO
IF nKey == 0
IF lDoIdleCall
nMode := CallUser( oBrowse, xUserFunc, 0, @lAppend )
oBrowse:forceStable()
IF nMode == DE_ABORT
EXIT
ENDIF
ENDIF
IF nMode == DE_CONT
oBrowse:hiLite()
WHILE ( nKey := Inkey( 0 ) ) == K_MOUSEMOVE
ENDDO
oBrowse:deHilite()
IF ( bBlock := SetKey( nKey ) ) != NIL
Eval( bBlock, ProcName( 1 ), ProcLine( 1 ), "" )
LOOP
ENDIF
ELSE
nMode := DE_CONT
ENDIF
ENDIF
lDoIdleCall := .T.
IF nKey != 0
#ifdef HB_C52_UNDOC
IF lAppend
SWITCH nKey
CASE K_DOWN
CASE K_PGDN
CASE K_CTRL_PGDN
oBrowse:hitBottom := .T.
LOOP
CASE K_UP
CASE K_PGUP
CASE K_CTRL_PGUP
oBrowse:hitTop := .T.
LOOP
ENDSWITCH
ENDIF
#endif
SWITCH nKey
#ifdef HB_COMPAT_C53
CASE K_LBUTTONDOWN
CASE K_LDBLCLK
TBMouse( oBrowse, MRow(), MCol() )
EXIT
#endif
CASE K_DOWN ; oBrowse:down() ; EXIT
CASE K_UP ; oBrowse:up() ; EXIT
CASE K_PGDN ; oBrowse:pageDown() ; EXIT
CASE K_PGUP ; oBrowse:pageUp() ; EXIT
CASE K_CTRL_PGUP ; oBrowse:goTop() ; EXIT
CASE K_CTRL_PGDN ; oBrowse:goBottom() ; EXIT
CASE K_RIGHT ; oBrowse:right() ; EXIT
CASE K_LEFT ; oBrowse:left() ; EXIT
CASE K_HOME ; oBrowse:home() ; EXIT
CASE K_END ; oBrowse:end() ; EXIT
CASE K_CTRL_LEFT ; oBrowse:panLeft() ; EXIT
CASE K_CTRL_RIGHT ; oBrowse:panRight() ; EXIT
CASE K_CTRL_HOME ; oBrowse:panHome() ; EXIT
CASE K_CTRL_END ; oBrowse:panEnd() ; EXIT
OTHERWISE
nMode := CallUser( oBrowse, xUserFunc, nKey, @lAppend )
lDoIdleCall := .F.
EXIT
ENDSWITCH
ENDIF
ENDDO
SetCursor( nOldCursor )
SetCursor( nOldCUrsor )
RETURN .T.
STATIC FUNCTION dbEditCallUser( oBrowse, xUserFunc, nKey )
LOCAL nMode
LOCAL nResult
LOCAL nPrevRecNo
DO CASE
CASE nKey != 0 ; nMode := DE_EXCEPT
CASE HB_DBEMPTY() ; nMode := DE_EMPTY
CASE oBrowse:hitBottom() ; nMode := DE_HITBOTTOM
CASE oBrowse:hitTop() ; nMode := DE_HITTOP
OTHERWISE ; nMode := DE_IDLE
ENDCASE
/* NOTE: CA-Cl*pper uses intermediate function CALLUSER()
* to execute user function. We're replicating this behavior
* for code which may check ProcName() results in user function
*/
STATIC FUNCTION CallUser( oBrowse, xUserFunc, nKey, lAppend )
LOCAL nMode, nPrevRecNo
nMode := IIF( nKey != 0, DE_EXCEPT, ;
IIF( !lAppend .AND. IsDbEmpty(), DE_EMPTY, ;
IIF( oBrowse:hitBottom, DE_HITBOTTOM, ;
IIF( oBrowse:hitTop, DE_HITTOP, DE_IDLE ) ) ) )
oBrowse:forceStable()
nPrevRecNo := RecNo()
IF ( ISCHARACTER( xUserFunc ) .AND. !Empty( xUserFunc ) ) .OR. ISBLOCK( xUserFunc )
/* NOTE: CA-Cl*pper won't check the type of the return value here,
and will crash if it's a non-NIL, non-numeric type. We're
replicating this behavior. */
nResult := Do( xUserFunc, nMode, oBrowse:ColPos() )
ELSE
nResult := iif( nKey == K_ENTER .OR. nKey == K_ESC, DE_ABORT, DE_CONT )
ENDIF
/* NOTE: CA-Cl*pper won't check the type of the return value here,
and will crash if it's a non-NIL, non-numeric type. We're
replicating this behavior. */
nMode := IIF( ISBLOCK( xUserFunc ), ;
Eval( xUserFunc, nMode, oBrowse:colPos ), ;
IIF( ISCHARACTER( xUserFunc ) .AND. !Empty( xUserFunc ), ;
&xUserFunc( nMode, oBrowse:colPos ), ;
IIF( nKey == K_ENTER .OR. nKey == K_ESC, DE_ABORT, DE_CONT ) ) )
IF Eof() .AND. !HB_DBEMPTY()
IF !lAppend .AND. EOF() .AND. !IsDbEmpty()
dbSkip( -1 )
ENDIF
IF nResult == DE_REFRESH .OR. nPrevRecNo != RecNo()
#ifdef HB_C52_UNDOC
IF nMode == DE_APPEND
IF nResult != DE_ABORT
IF ( lAppend := !( lAppend .AND. EOF() ) )
dbGoBottom()
oBrowse:down()
ELSE
oBrowse:refreshCurrent()
ENDIF
RETURN DE_APPEND
ENDIF
#endif
IF Set( _SET_DELETED ) .AND. Deleted() .OR. !Empty( dbFilter() ) .AND. ! &( dbFilter() )
dbSkip( 1 )
ENDIF
IF Eof()
dbGoBottom()
ENDIF
nPrevRecNo := RecNo()
oBrowse:RefreshAll():forceStable()
DO WHILE nPrevRecNo != RecNo()
oBrowse:Up():forceStable()
ENDDO
IF nMode != DE_REFRESH .AND. nPrevRecNo == RecNo()
oBrowse:refreshCurrent()
IF nMode != DE_ABORT
nMode := DE_CONT
ENDIF
ELSE
oBrowse:Refreshcurrent()
ELSEIF nMode != DE_ABORT
IF ( Set( _SET_DELETED ) .AND. Deleted() ) .OR. ;
( !Empty( dbfilter() ) .AND. !&( dbFilter() ) )
dbSkip()
ENDIF
IF EOF()
dbGoBottom()
ENDIF
nPrevRecNo := RecNo()
oBrowse:refreshAll():forceStable()
WHILE nPrevRecNo != RecNo()
oBrowse:Up():forceStable()
ENDDO
lAppend := .F.
nMode := DE_REFRESH
ENDIF
RETURN nResult != DE_ABORT
RETURN nMode
/* helper function to detect empty tables. It's not perfect but
* it functionally uses the same conditions as CA-Cl*pper
*/
STATIC FUNCTION IsDbEmpty()
RETURN LastRec() == 0 .OR. ;
( BOF() .AND. ( EOF() .OR. RecNo() == LastRec() + 1 ) )
/* Helpr function: TBrowse skipBlock */
STATIC FUNCTION Skipped( nRecs, lAppend )
STATIC FUNCTION dbEditSkipped( nRecs )
LOCAL nSkipped := 0
IF LastRec() != 0
IF nRecs == 0
IF Eof()
IF EOF() .AND. !lAppend
dbSkip( -1 )
nSkipped := -1
ELSE
@@ -348,9 +378,13 @@ STATIC FUNCTION dbEditSkipped( nRecs )
ENDIF
ELSEIF nRecs > 0 .AND. RecNo() != LastRec() + 1
DO WHILE nSkipped < nRecs
dbSkip( 1 )
dbSkip()
IF Eof()
dbSkip( -1 )
IF lAppend
nSkipped++
ELSE
dbSkip( -1 )
ENDIF
EXIT
ENDIF
nSkipped++

80
harbour/source/vm/hvm.c
View File

@@ -6660,46 +6660,6 @@ static void hb_vmDoInitStatics( void )
}
}
static void hb_vmDoExitFunctions( void )
{
PHB_SYMBOLS pLastSymbols = s_pSymbols;
HB_TRACE(HB_TR_DEBUG, ("hb_vmDoExitFunctions()"));
/* EXIT procedures should be processed? */
if( s_fDoExitProc )
{
s_fDoExitProc = FALSE;
hb_stackSetActionRequest( 0 );
while( pLastSymbols )
{
/* only if module contains some EXIT functions */
if( pLastSymbols->fActive && pLastSymbols->hScope & HB_FS_EXIT )
{
USHORT ui;
for( ui = 0; ui < pLastSymbols->uiModuleSymbols; ui++ )
{
HB_SYMBOLSCOPE scope = ( pLastSymbols->pModuleSymbols + ui )->scope.value & ( HB_FS_EXIT | HB_FS_INIT );
if( scope == HB_FS_EXIT )
{
hb_vmPushSymbol( pLastSymbols->pModuleSymbols + ui );
hb_vmPushNil();
hb_vmDo( 0 );
if( hb_stackGetActionRequest() )
/* QUIT or BREAK was issued - stop processing
*/
return;
}
}
}
pLastSymbols = pLastSymbols->pNext;
}
}
}
static void hb_vmDoInitFunctions( void )
{
PHB_SYMBOLS pLastSymbols = s_pSymbols;
@@ -6747,6 +6707,46 @@ static void hb_vmDoInitFunctions( void )
}
}
static void hb_vmDoExitFunctions( void )
{
PHB_SYMBOLS pLastSymbols = s_pSymbols;
HB_TRACE(HB_TR_DEBUG, ("hb_vmDoExitFunctions()"));
/* EXIT procedures should be processed? */
if( s_fDoExitProc )
{
s_fDoExitProc = FALSE;
hb_stackSetActionRequest( 0 );
while( pLastSymbols )
{
/* only if module contains some EXIT functions */
if( pLastSymbols->fActive && pLastSymbols->hScope & HB_FS_EXIT )
{
USHORT ui;
for( ui = 0; ui < pLastSymbols->uiModuleSymbols; ui++ )
{
HB_SYMBOLSCOPE scope = ( pLastSymbols->pModuleSymbols + ui )->scope.value & ( HB_FS_EXIT | HB_FS_INIT );
if( scope == HB_FS_EXIT )
{
hb_vmPushSymbol( pLastSymbols->pModuleSymbols + ui );
hb_vmPushNil();
hb_vmDo( 0 );
if( hb_stackGetActionRequest() )
/* QUIT or BREAK was issued - stop processing
*/
return;
}
}
}
pLastSymbols = pLastSymbols->pNext;
}
}
}
/* ------------------------------- */
/* Extended references */
/* ------------------------------- */