From c6a878051b8979d53570a2b99cab108f7a5b6fdb Mon Sep 17 00:00:00 2001 From: Przemyslaw Czerpak Date: Wed, 10 Mar 2010 09:04:23 +0000 Subject: [PATCH] 2010-03-10 10:04 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/hbapirdd.h * harbour/src/rdd/wacore.c + added hb_rddDetachedList() C function * harbour/contrib/hbxpp/Makefile + harbour/contrib/hbxpp/dmlb.ch + harbour/contrib/hbxpp/wafuncx.c + added xBase++ compatible PRG function: WorkSpaceList( [] ) -> --- harbour/ChangeLog | 11 +++++ harbour/contrib/hbxpp/Makefile | 1 + harbour/contrib/hbxpp/dmlb.ch | 59 +++++++++++++++++++++++ harbour/contrib/hbxpp/wafuncx.c | 84 +++++++++++++++++++++++++++++++++ harbour/include/hbapirdd.h | 1 + harbour/src/rdd/wacore.c | 44 +++++++++++++++-- 6 files changed, 195 insertions(+), 5 deletions(-) create mode 100644 harbour/contrib/hbxpp/dmlb.ch create mode 100644 harbour/contrib/hbxpp/wafuncx.c diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 664a40ef9a..b1eed47d80 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -17,6 +17,17 @@ past entries belonging to author(s): Viktor Szakats. */ +2010-03-10 10:04 UTC+0100 Przemyslaw Czerpak (druzus/at/priv.onet.pl) + * harbour/include/hbapirdd.h + * harbour/src/rdd/wacore.c + + added hb_rddDetachedList() C function + + * harbour/contrib/hbxpp/Makefile + + harbour/contrib/hbxpp/dmlb.ch + + harbour/contrib/hbxpp/wafuncx.c + + added xBase++ compatible PRG function: + WorkSpaceList( [] ) -> + 2010-03-09 18:24 UTC-0800 Pritpal Bedi (pritpal@vouchcac.com) * contrib/hbide/resources/funclist.ui * contrib/hbide/resources/funclist.uic diff --git a/harbour/contrib/hbxpp/Makefile b/harbour/contrib/hbxpp/Makefile index 2598348b83..d86dc2eec0 100644 --- a/harbour/contrib/hbxpp/Makefile +++ b/harbour/contrib/hbxpp/Makefile @@ -18,6 +18,7 @@ C_SOURCES := \ oemansix.c \ philesx.c \ pvalue.c \ + wafuncx.c \ xppopc.c \ PRG_SOURCES := \ diff --git a/harbour/contrib/hbxpp/dmlb.ch b/harbour/contrib/hbxpp/dmlb.ch new file mode 100644 index 0000000000..25481e33b6 --- /dev/null +++ b/harbour/contrib/hbxpp/dmlb.ch @@ -0,0 +1,59 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * XBASE++ compatibility header + * + * Copyright 2010 Przemyslaw Czerpak + * 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, or (at your option) + * any later version. + * + * 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 software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries 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 Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#ifndef _DMLB_CH +#define _DMLB_CH + +#define DB_WORKSPACE 1 +#define DB_ZEROSPACE 2 + +#endif diff --git a/harbour/contrib/hbxpp/wafuncx.c b/harbour/contrib/hbxpp/wafuncx.c new file mode 100644 index 0000000000..9d2f1369d8 --- /dev/null +++ b/harbour/contrib/hbxpp/wafuncx.c @@ -0,0 +1,84 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * XBASE++ compatible workarea functions + * + * Copyright 2010 Przemyslaw Czerpak + * 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, or (at your option) + * any later version. + * + * 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 software; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, + * Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/). + * + * As a special exception, the Harbour Project gives permission for + * additional uses of the text contained in its release of Harbour. + * + * The exception is that, if you link the Harbour libraries 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 Harbour library code into it. + * + * This exception does not however invalidate any other reasons why + * the executable file might be covered by the GNU General Public License. + * + * This exception applies only to the code released by the Harbour + * Project under the name Harbour. If you copy code from other + * Harbour Project or Free Software Foundation releases into a copy of + * Harbour, as the General Public License permits, the exception does + * not apply to the code that you add in this way. To avoid misleading + * anyone as to the status of such modified files, you must delete + * this exception notice from them. + * + * If you write modifications of your own for Harbour, it is your choice + * whether to permit this exception to apply to your modifications. + * If you do not wish that, delete this exception notice. + * + */ + +#include "hbapi.h" +#include "hbapiitm.h" +#include "hbapirdd.h" + +#include "dmlb.ch" + +static HB_ERRCODE s_waList( AREAP pArea, void * Cargo ) +{ + PHB_ITEM pArray = ( PHB_ITEM ) Cargo; + HB_SIZE nLen = hb_arrayLen( pArray ) + 1; + + hb_arraySize( pArray, nLen ); + hb_arraySetC( pArray, nLen, hb_dynsymName( ( PHB_DYNS ) pArea->atomAlias ) ); + + return HB_SUCCESS; +} + +HB_FUNC( WORKSPACELIST ) +{ + PHB_ITEM pArray; + + if( hb_parni( 1 ) == DB_ZEROSPACE ) + { + pArray = hb_rddDetachedList(); + } + else + { + pArray = hb_itemArrayNew( 0 ); + hb_rddIterateWorkAreas( s_waList, pArray ); + } + hb_itemReturnRelease( pArray ); +} diff --git a/harbour/include/hbapirdd.h b/harbour/include/hbapirdd.h index 1057fdc2ee..fd78c156bd 100644 --- a/harbour/include/hbapirdd.h +++ b/harbour/include/hbapirdd.h @@ -1231,6 +1231,7 @@ extern HB_EXPORT HB_ERRCODE hb_rddEvalWA( PHB_ITEM pBlock ); extern HB_EXPORT HB_ERRCODE hb_rddDetachArea( AREAP pArea, PHB_ITEM pCargo ); extern HB_EXPORT AREAP hb_rddRequestArea( const char * szAlias, PHB_ITEM pCargo, HB_BOOL fNewArea, HB_BOOL fWait ); +extern HB_EXPORT PHB_ITEM hb_rddDetachedList( void ); typedef HB_ERRCODE ( * WACALLBACK )( AREAP, void * ); extern HB_EXPORT HB_ERRCODE hb_rddIterateWorkAreas( WACALLBACK pCallBack, void * cargo ); diff --git a/harbour/src/rdd/wacore.c b/harbour/src/rdd/wacore.c index 3fd4c2136d..62695933ba 100644 --- a/harbour/src/rdd/wacore.c +++ b/harbour/src/rdd/wacore.c @@ -529,8 +529,8 @@ HB_ERRCODE hb_rddDetachArea( AREAP pArea, PHB_ITEM pCargo ) /* tests shows that Xbase++ does not remove locks */ /* SELF_UNLOCK( pArea, NULL ); */ - /* Xbase++ documentation says that child area are also detached but - * but tests shows that it's not true and chilled and parent relations + /* Xbase++ documentation says that child areas are also detached but + * but tests shows that it's not true and either child or parent relations * are still active and corresponding WA are not detached together. * Harbour clears all child and parent relations. */ @@ -623,7 +623,8 @@ AREAP hb_rddRequestArea( const char * szAlias, PHB_ITEM pCargo, for( ulPos = 1; ulPos <= ulLen; ++ulPos ) { AREAP * pDetachedArea = ( AREAP * ) - hb_arrayGetPtr( hb_arrayGetItemPtr( s_pDetachedAreas, ulPos ), 1 ); + hb_arrayGetPtrGC( hb_arrayGetItemPtr( s_pDetachedAreas, ulPos ), + 1, &s_gcWAFuncs ); if( pSymAlias == ( PHB_DYNS ) ( *pDetachedArea )->atomAlias ) break; } @@ -631,7 +632,8 @@ AREAP hb_rddRequestArea( const char * szAlias, PHB_ITEM pCargo, if( ulPos <= ulLen ) { PHB_ITEM pArray = hb_arrayGetItemPtr( s_pDetachedAreas, ulPos ); - AREAP * pDetachedArea = ( AREAP * ) hb_arrayGetPtr( pArray, 1 ); + AREAP * pDetachedArea = ( AREAP * ) + hb_arrayGetPtrGC( pArray, 1, &s_gcWAFuncs ); pArea = *pDetachedArea; *pDetachedArea = NULL; @@ -660,8 +662,40 @@ AREAP hb_rddRequestArea( const char * szAlias, PHB_ITEM pCargo, { hb_waNodeInsert( hb_stackRDD(), pArea ); if( pArea->atomAlias ) - hb_dynsymSetAreaHandle( ( PHB_DYNS ) pArea->atomAlias, pArea->uiArea ); + { + if( hb_dynsymAreaHandle( ( PHB_DYNS ) pArea->atomAlias ) == 0 ) + hb_dynsymSetAreaHandle( ( PHB_DYNS ) pArea->atomAlias, pArea->uiArea ); + } } return pArea; } + +PHB_ITEM hb_rddDetachedList( void ) +{ + PHB_ITEM pArray; + + HB_TRACE(HB_TR_DEBUG, ("hb_rddDetachedList()")); + + pArray = hb_itemArrayNew( 0 ); + /* protect by critical section access to s_pDetachedAreas array */ + hb_threadEnterCriticalSection( &s_waMtx ); + if( s_pDetachedAreas ) + { + HB_SIZE nLen = hb_arrayLen( s_pDetachedAreas ), nPos; + + hb_arraySize( pArray, nLen ); + for( nPos = 1; nPos <= nLen; ++nPos ) + { + AREAP * pDetachedArea = ( AREAP * ) + hb_arrayGetPtrGC( hb_arrayGetItemPtr( s_pDetachedAreas, nPos ), + 1, &s_gcWAFuncs ); + PHB_DYNS pAlias = ( PHB_DYNS ) ( *pDetachedArea )->atomAlias; + hb_arraySetC( pArray, nPos, hb_dynsymName( pAlias ) ); + } + } + /* leave critical section */ + hb_threadLeaveCriticalSection( &s_waMtx ); + + return pArray; +}