From ed672c29c9c41aa82d6d561d6acd1e02e630d2bd Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Sun, 5 Oct 2008 13:57:35 +0000 Subject: [PATCH] 2008-10-05 15:56 UTC+0200 Viktor Szakats (harbour.01 syenar hu) * include/hbpers.ch * source/rtl/perfuncs.prg * source/rtl/objfunc.prg * source/rtl/tlabel.prg * source/rtl/setta.prg * source/rtl/dirscan.prg * source/rtl/tthreadx.prg * source/rtl/setfunc.prg * source/rtl/readvar.prg * source/rtl/tclass.prg * source/rtl/ttextlin.prg * source/rtl/profiler.prg * source/rtl/treport.prg * source/rtl/tgetint.prg * source/rtl/persist.prg * source/rtl/altd.prg * source/rtl/devoutp.prg * source/rdd/usrrdd/example/exmemo.prg * source/rdd/usrrdd/example/exhsx.prg * source/rdd/usrrdd/example/exfcm.prg * source/rdd/usrrdd/example/exrlx.prg * source/rdd/usrrdd/rdds/dbtcdx.prg * source/rdd/usrrdd/rdds/fptcdx.prg * source/rdd/usrrdd/rdds/arrayrdd.prg * source/rdd/usrrdd/rdds/hscdx.prg * source/rdd/usrrdd/rdds/rlcdx.prg * source/rdd/usrrdd/rdds/fcomma.prg * source/rdd/usrrdd/rdds/smtcdx.prg * Formatting. Basically finished. * include/hbextern.ch ! Added two missing functions. --- harbour/ChangeLog | 34 + harbour/include/hbextern.ch | 3 + harbour/include/hbpers.ch | 4 +- harbour/source/rdd/usrrdd/example/exfcm.prg | 4 +- harbour/source/rdd/usrrdd/example/exhsx.prg | 4 +- harbour/source/rdd/usrrdd/example/exmemo.prg | 4 +- harbour/source/rdd/usrrdd/example/exrlx.prg | 4 +- harbour/source/rdd/usrrdd/rdds/arrayrdd.prg | 127 ++-- harbour/source/rdd/usrrdd/rdds/dbtcdx.prg | 12 +- harbour/source/rdd/usrrdd/rdds/fcomma.prg | 42 +- harbour/source/rdd/usrrdd/rdds/fptcdx.prg | 8 +- harbour/source/rdd/usrrdd/rdds/hscdx.prg | 37 +- harbour/source/rdd/usrrdd/rdds/rlcdx.prg | 16 +- harbour/source/rdd/usrrdd/rdds/smtcdx.prg | 8 +- harbour/source/rtl/altd.prg | 10 +- harbour/source/rtl/devoutp.prg | 2 +- harbour/source/rtl/dirscan.prg | 12 +- harbour/source/rtl/objfunc.prg | 1 - harbour/source/rtl/perfuncs.prg | 26 +- harbour/source/rtl/persist.prg | 238 +++---- harbour/source/rtl/profiler.prg | 620 ++++++++----------- harbour/source/rtl/readvar.prg | 2 +- harbour/source/rtl/setfunc.prg | 2 +- harbour/source/rtl/setta.prg | 1 - harbour/source/rtl/tclass.prg | 37 +- harbour/source/rtl/tgetint.prg | 4 - harbour/source/rtl/tlabel.prg | 88 +-- harbour/source/rtl/treport.prg | 303 +++++---- harbour/source/rtl/ttextlin.prg | 6 +- harbour/source/rtl/tthreadx.prg | 14 +- 30 files changed, 809 insertions(+), 864 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index d0557fcb37..28374b30b3 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,40 @@ 2008-12-31 13:59 UTC+0100 Foo Bar (foo.bar foobar.org) */ +2008-10-05 15:56 UTC+0200 Viktor Szakats (harbour.01 syenar hu) + * include/hbpers.ch + * source/rtl/perfuncs.prg + * source/rtl/objfunc.prg + * source/rtl/tlabel.prg + * source/rtl/setta.prg + * source/rtl/dirscan.prg + * source/rtl/tthreadx.prg + * source/rtl/setfunc.prg + * source/rtl/readvar.prg + * source/rtl/tclass.prg + * source/rtl/ttextlin.prg + * source/rtl/profiler.prg + * source/rtl/treport.prg + * source/rtl/tgetint.prg + * source/rtl/persist.prg + * source/rtl/altd.prg + * source/rtl/devoutp.prg + * source/rdd/usrrdd/example/exmemo.prg + * source/rdd/usrrdd/example/exhsx.prg + * source/rdd/usrrdd/example/exfcm.prg + * source/rdd/usrrdd/example/exrlx.prg + * source/rdd/usrrdd/rdds/dbtcdx.prg + * source/rdd/usrrdd/rdds/fptcdx.prg + * source/rdd/usrrdd/rdds/arrayrdd.prg + * source/rdd/usrrdd/rdds/hscdx.prg + * source/rdd/usrrdd/rdds/rlcdx.prg + * source/rdd/usrrdd/rdds/fcomma.prg + * source/rdd/usrrdd/rdds/smtcdx.prg + * Formatting. Basically finished. + + * include/hbextern.ch + ! Added two missing functions. + 2008-10-05 15:53 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/source/vm/thread.c ! fixed hb_mutexSubscribe*() in ST mode diff --git a/harbour/include/hbextern.ch b/harbour/include/hbextern.ch index 988738be13..ec4b3929da 100644 --- a/harbour/include/hbextern.ch +++ b/harbour/include/hbextern.ch @@ -925,6 +925,9 @@ EXTERNAL HB_FIELDTYPE EXTERNAL HB_SCRMAXROW EXTERNAL HB_SCRMAXCOL +EXTERNAL HB_SETOBJECT +EXTERNAL HB_ENDOBJECT + EXTERNAL HB_MTVM EXTERNAL HB_THREADSTART diff --git a/harbour/include/hbpers.ch b/harbour/include/hbpers.ch index da44789945..2682f93f47 100644 --- a/harbour/include/hbpers.ch +++ b/harbour/include/hbpers.ch @@ -54,9 +54,9 @@ #define HB_PERS_CH_ #xcommand OBJECT AS => ; - Self := HB_SetObject( Self, { || ():New() } ) + Self := hb_SetObject( Self, { || ():New() } ) -#xcommand ENDOBJECT => Self := HB_EndObject() +#xcommand ENDOBJECT => Self := hb_EndObject() #xcommand ARRAY LEN => := Array( ) diff --git a/harbour/source/rdd/usrrdd/example/exfcm.prg b/harbour/source/rdd/usrrdd/example/exfcm.prg index d7c5d001c1..bfcc9f1da9 100644 --- a/harbour/source/rdd/usrrdd/example/exfcm.prg +++ b/harbour/source/rdd/usrrdd/example/exfcm.prg @@ -4,7 +4,7 @@ REQUEST FCOMMA -PROC MAIN() +PROCEDURE MAIN() USE test.csv VIA "FCOMMA" ? "ALIAS", ALIAS(), "RECNO", RECNO(), ; @@ -41,4 +41,4 @@ PROC MAIN() WAIT BROWSE() -RETURN + RETURN diff --git a/harbour/source/rdd/usrrdd/example/exhsx.prg b/harbour/source/rdd/usrrdd/example/exhsx.prg index e4c22d1da6..e7255eeebf 100644 --- a/harbour/source/rdd/usrrdd/example/exhsx.prg +++ b/harbour/source/rdd/usrrdd/example/exhsx.prg @@ -6,7 +6,7 @@ REQUEST HSXRDD -PROC MAIN() +PROCEDURE MAIN() FIELD FIRST, LAST, STREET, CITY LOCAL n, hs @@ -45,4 +45,4 @@ PROC MAIN() DBGOTOP() BROWSE() ENDIF -RETURN + RETURN diff --git a/harbour/source/rdd/usrrdd/example/exmemo.prg b/harbour/source/rdd/usrrdd/example/exmemo.prg index 9c93cf78df..e898625734 100644 --- a/harbour/source/rdd/usrrdd/example/exmemo.prg +++ b/harbour/source/rdd/usrrdd/example/exmemo.prg @@ -6,10 +6,10 @@ REQUEST DBTCDX REQUEST FPTCDX REQUEST SMTCDX -PROC MAIN() +PROCEDURE MAIN() DBCREATE("table1", {{"F1","M",4,0}}, "DBTCDX") DBCREATE("table2", {{"F1","M",4,0}}, "FPTCDX") DBCREATE("table3", {{"F1","M",4,0}}, "SMTCDX") -RETURN + RETURN diff --git a/harbour/source/rdd/usrrdd/example/exrlx.prg b/harbour/source/rdd/usrrdd/example/exrlx.prg index 83d35af06b..b0dbef804c 100644 --- a/harbour/source/rdd/usrrdd/example/exrlx.prg +++ b/harbour/source/rdd/usrrdd/example/exrlx.prg @@ -4,7 +4,7 @@ REQUEST RLCDX -PROC MAIN() +PROCEDURE MAIN() DBCREATE( "_tst", {{"F1","C",10,0}}, "RLCDX" ) USE _tst VIA "RLCDX" SHARED @@ -47,4 +47,4 @@ PROC MAIN() CLOSE -RETURN + RETURN diff --git a/harbour/source/rdd/usrrdd/rdds/arrayrdd.prg b/harbour/source/rdd/usrrdd/rdds/arrayrdd.prg index 874d3b8bad..8bdd0c8441 100644 --- a/harbour/source/rdd/usrrdd/rdds/arrayrdd.prg +++ b/harbour/source/rdd/usrrdd/rdds/arrayrdd.prg @@ -65,7 +65,7 @@ #include "dbstruct.ch" #include "common.ch" -#xtranslate THROW() => (Eval(ErrorBlock(), ), Break()) +#xtranslate THROW( ) => ( Eval( ErrorBlock(), ), Break( ) ) ANNOUNCE ARRAYRDD @@ -108,42 +108,42 @@ STATIC FUNCTION AR_INIT( nRDD ) /* Init DBF Hash */ USRRDD_RDDDATA( nRDD, hb_Hash() ) -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION AR_RDDDATAINIT() -RETURN { ; - NIL ; // RDDDATA_DATABASE - } + RETURN { ; + NIL ; // RDDDATA_DATABASE + } STATIC FUNCTION AR_DATABASEINIT() -RETURN { ; - NIL ,; // DATABASE_FILENAME - {} ,; // DATABASE_RECORDS - {} ,; // DATABASE_RECINFO - 0 ,; // DATABASE_OPENNUMBER - FALSE ,; // DATABASE_LOCKED - NIL ; // DATABASE_STRUCT - aStruct - } + RETURN { ; + NIL ,; // DATABASE_FILENAME + {} ,; // DATABASE_RECORDS + {} ,; // DATABASE_RECINFO + 0 ,; // DATABASE_OPENNUMBER + FALSE ,; // DATABASE_LOCKED + NIL ; // DATABASE_STRUCT - aStruct + } STATIC FUNCTION AR_WADATAINIT() -RETURN { ; - NIL ,; // WADATA_DATABASE - 0 ,; // WADATA_WORKAREA - NIL ,; // WADATA_OPENINFO - 0 ,; // WADATA_RECNO - FALSE ,; // WADATA_BOF - FALSE ,; // WADATA_FORCEBOF // to solve an hack in dbf1.c - FALSE ,; // WADATA_EOF - FALSE ,; // WADATA_TOP - FALSE ,; // WADATA_BOTTOM - FALSE ,; // WADATA_FOUND - {} ; // WADATA_LOCKS - } + RETURN { ; + NIL ,; // WADATA_DATABASE + 0 ,; // WADATA_WORKAREA + NIL ,; // WADATA_OPENINFO + 0 ,; // WADATA_RECNO + FALSE ,; // WADATA_BOF + FALSE ,; // WADATA_FORCEBOF // to solve an hack in dbf1.c + FALSE ,; // WADATA_EOF + FALSE ,; // WADATA_TOP + FALSE ,; // WADATA_BOTTOM + FALSE ,; // WADATA_FOUND + {} ; // WADATA_LOCKS + } STATIC FUNCTION AR_RECDATAINIT() -RETURN { ; - FALSE ; // RECDATA_DELETED - } + RETURN { ; + FALSE ; // RECDATA_DELETED + } /* * methods: NEW and RELEASE receive pointer to work area structure @@ -162,7 +162,7 @@ STATIC FUNCTION AR_NEW( pWA ) */ USRRDD_AREADATA( pWA, AR_WADATAINIT() ) -RETURN SUCCESS + RETURN SUCCESS // Creating fields for new DBF - dbCreate() in current workarea STATIC FUNCTION AR_CREATEFIELDS( nWA, aStruct ) @@ -194,7 +194,7 @@ STATIC FUNCTION AR_CREATEFIELDS( nWA, aStruct ) NEXT -RETURN nResult + RETURN nResult // Create database from current WA fields definition STATIC FUNCTION AR_CREATE( nWA, aOpenInfo ) @@ -250,7 +250,7 @@ STATIC FUNCTION AR_CREATE( nWA, aOpenInfo ) // increase open number aDBFData[ DATABASE_OPENNUMBER ]++ -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION AR_OPEN( nWA, aOpenInfo ) LOCAL cFullName, cName, hRDDData, aWAData, aDBFData @@ -351,7 +351,7 @@ STATIC FUNCTION AR_OPEN( nWA, aOpenInfo ) AR_GOTOP( nWA ) ENDIF -RETURN nResult + RETURN nResult STATIC FUNCTION AR_CLOSE( nWA ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -363,7 +363,7 @@ STATIC FUNCTION AR_CLOSE( nWA ) // unlock file aDBFData[ DATABASE_LOCKED ] := FALSE // Exclusive mode -RETURN UR_SUPER_CLOSE( nWA ) + RETURN UR_SUPER_CLOSE( nWA ) STATIC FUNCTION AR_GETVALUE( nWA, nField, xValue ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -385,7 +385,7 @@ STATIC FUNCTION AR_GETVALUE( nWA, nField, xValue ) ENDIF -RETURN FAILURE + RETURN FAILURE STATIC FUNCTION AR_PUTVALUE( nWA, nField, xValue ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -410,7 +410,7 @@ STATIC FUNCTION AR_PUTVALUE( nWA, nField, xValue ) ENDIF -RETURN FAILURE + RETURN FAILURE STATIC FUNCTION AR_GOTO( nWA, nRecord ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -461,10 +461,10 @@ STATIC FUNCTION AR_GOTO( nWA, nRecord ) ENDIF -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION AR_GOTOID( nWA, nRecord ) -RETURN AR_GOTO( nWA, nRecord ) + RETURN AR_GOTO( nWA, nRecord ) STATIC FUNCTION AR_GOTOP( nWA ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -489,7 +489,7 @@ STATIC FUNCTION AR_GOTOP( nWA ) ENDIF ENDIF -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION AR_GOBOTTOM( nWA ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -514,7 +514,8 @@ STATIC FUNCTION AR_GOBOTTOM( nWA ) ENDIF ENDIF -RETURN SUCCESS + + RETURN SUCCESS STATIC FUNCTION AR_SKIPFILTER( nWA, nRecords ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -553,7 +554,7 @@ STATIC FUNCTION AR_SKIPFILTER( nWA, nRecords ) ENDIF -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION AR_SKIPRAW( nWA, nRecords ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -588,7 +589,7 @@ STATIC FUNCTION AR_SKIPRAW( nWA, nRecords ) ENDIF -RETURN nResult // SUCCESS + RETURN nResult // SUCCESS STATIC FUNCTION AR_BOF( nWA, lBof ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -600,12 +601,15 @@ STATIC FUNCTION AR_BOF( nWA, lBof ) ELSE lBof := aWAData[ WADATA_BOF ] ENDIF -RETURN SUCCESS + + RETURN SUCCESS STATIC FUNCTION AR_EOF( nWA, lEof ) LOCAL aWAData := USRRDD_AREADATA( nWA ) + lEof := aWAData[ WADATA_EOF ] -RETURN SUCCESS + + RETURN SUCCESS STATIC FUNCTION AR_DELETE( nWA ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -642,7 +646,7 @@ STATIC FUNCTION AR_DELETE( nWA ) aRecInfo[ aWAData[ WADATA_RECNO ] ][ RECDATA_DELETED ] := .T. ENDIF -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION AR_DELETED( nWA, lDeleted ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -655,7 +659,8 @@ STATIC FUNCTION AR_DELETED( nWA, lDeleted ) ELSE lDeleted := .F. ENDIF -RETURN SUCCESS + + RETURN SUCCESS STATIC FUNCTION AR_APPEND( nWA, nRecords ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -688,7 +693,7 @@ STATIC FUNCTION AR_APPEND( nWA, nRecords ) /* TODO: SHARED ACCESS */ -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION AR_RECID( nWA, nRecNo ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -701,14 +706,17 @@ STATIC FUNCTION AR_RECID( nWA, nRecNo ) ELSE nRecNo := aWAData[ WADATA_RECNO ] ENDIF -RETURN SUCCESS + + RETURN SUCCESS STATIC FUNCTION AR_RECCOUNT( nWA, nRecords ) LOCAL aWAData := USRRDD_AREADATA( nWA ) LOCAL aDBFData := aWAData[ WADATA_DATABASE ] LOCAL aRecords := aDBFData[ DATABASE_RECORDS ] + nRecords := Len( aRecords ) -RETURN SUCCESS + + RETURN SUCCESS STATIC FUNCTION AR_ZAP( nWA ) LOCAL aWAData := USRRDD_AREADATA( nWA ) @@ -747,7 +755,7 @@ STATIC FUNCTION AR_ZAP( nWA ) // move to 0 recno AR_GOTO( nWA, 0 ) -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION AR_ORDINFO( nWA, xMsg, xValue ) /* @@ -786,7 +794,8 @@ STATIC FUNCTION AR_ORDINFO( nWA, xMsg, xValue ) aWAData[ ARRAY_RECINFO ] := {} AR_GOTO( nWA, 0 ) */ -RETURN SUCCESS + + RETURN SUCCESS /* * This function have to exist in all RDD and then name have to be in @@ -820,12 +829,12 @@ FUNCTION ARRAYRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID ) aMyFunc[ UR_ZAP ] := ( @AR_ZAP() ) aMyFunc[ UR_ORDINFO ] := ( @AR_ORDINFO() ) -RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - cSuperRDD, aMyFunc ) + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + cSuperRDD, aMyFunc ) -INIT PROC ARRAYRDD_INIT() +INIT PROCEDURE ARRAYRDD_INIT() rddRegister( "ARRAYRDD", RDT_FULL ) -RETURN + RETURN /* -------------------------------------------------- */ /* UTILITY FUNCTIONS */ @@ -919,7 +928,8 @@ FUNCTION EraseArrayRdd( cFullName ) nReturn := FAILURE ENDIF -RETURN nReturn + + RETURN nReturn STATIC FUNCTION BlankRecord( aStruct ) LOCAL nLenStruct := Len( aStruct ) @@ -929,7 +939,8 @@ STATIC FUNCTION BlankRecord( aStruct ) FOR nField := 1 TO nLenStruct aRecord[ nField ] := EmptyValue( aStruct[ nField ][ DBS_TYPE ], aStruct[ nField ][ DBS_LEN ], aStruct[ nField ][ DBS_DEC ] ) NEXT -RETURN aRecord + + RETURN aRecord STATIC FUNCTION PutValue( xValue, cType, nLen, nDec ) LOCAL xVal @@ -943,7 +954,7 @@ STATIC FUNCTION PutValue( xValue, cType, nLen, nDec ) xVal := xValue ENDCASE -RETURN xVal + RETURN xVal STATIC FUNCTION EmptyValue( cType, nLen, nDec ) diff --git a/harbour/source/rdd/usrrdd/rdds/dbtcdx.prg b/harbour/source/rdd/usrrdd/rdds/dbtcdx.prg index e646ef341f..0de036715f 100644 --- a/harbour/source/rdd/usrrdd/rdds/dbtcdx.prg +++ b/harbour/source/rdd/usrrdd/rdds/dbtcdx.prg @@ -64,16 +64,14 @@ REQUEST DBFCDX REQUEST DBFFPT -/* Announce our RDD for forign REQUESTs */ +/* Announce our RDD for foreign REQUESTs */ ANNOUNCE DBTCDX -PROC DBTCDX(); RETURN - FUNCTION DBTCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID ) -RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - "DBFCDX", {} ) /* We are inheriting from DBFCDX */ + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + "DBFCDX", {} ) /* We are inheriting from DBFCDX */ -INIT PROC DBTCDX_INIT() +INIT PROCEDURE DBTCDX_INIT() rddRegister( "DBTCDX", RDT_FULL ) rddInfo( RDDI_MEMOTYPE, DB_MEMO_DBT, "DBTCDX" ) -RETURN + RETURN diff --git a/harbour/source/rdd/usrrdd/rdds/fcomma.prg b/harbour/source/rdd/usrrdd/rdds/fcomma.prg index 13be449fa7..84a47cdac8 100644 --- a/harbour/source/rdd/usrrdd/rdds/fcomma.prg +++ b/harbour/source/rdd/usrrdd/rdds/fcomma.prg @@ -50,8 +50,6 @@ * */ - - /* * A simple RDD which uses HB_F*() functions from MISC library * to access CSV files. It allow to open an CSV file and navigate @@ -82,7 +80,7 @@ STATIC FUNCTION FCM_INIT( nRDD ) AFILL( aRData, -1 ) USRRDD_RDDDATA( nRDD, aRData ) -RETURN SUCCESS + RETURN SUCCESS /* * methods: NEW and RELEASE receive pointer to work area structure @@ -102,7 +100,7 @@ STATIC FUNCTION FCM_NEW( pWA ) */ USRRDD_AREADATA( pWA, aWData ) -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION FCM_CREATE( nWA, aOpenInfo ) LOCAL oError := ErrorNew() @@ -114,7 +112,7 @@ STATIC FUNCTION FCM_CREATE( nWA, aOpenInfo ) oError:FileName := aOpenInfo[ UR_OI_NAME ] oError:CanDefault := .T. UR_SUPER_ERROR( nWA, oError ) -RETURN FAILURE + RETURN FAILURE STATIC FUNCTION FCM_OPEN( nWA, aOpenInfo ) LOCAL cName, nMode, nSlot, nHandle, aRData, aWData, aField, oError, nResult @@ -178,7 +176,7 @@ STATIC FUNCTION FCM_OPEN( nWA, aOpenInfo ) FCM_GOTOP( nWA ) ENDIF -RETURN nResult + RETURN nResult STATIC FUNCTION FCM_CLOSE( nWA ) LOCAL aRData, nSlot := USRRDD_AREADATA( nWA )[ 1 ] @@ -189,7 +187,7 @@ STATIC FUNCTION FCM_CLOSE( nWA ) aRData := USRRDD_RDDDATA( USRRDD_ID( nWA ) ) aRData[ nSlot ] := -1 ENDIF -RETURN UR_SUPER_CLOSE( nWA ) + RETURN UR_SUPER_CLOSE( nWA ) STATIC FUNCTION FCM_GETVALUE( nWA, nField, xValue ) LOCAL aWData := USRRDD_AREADATA( nWA ) @@ -204,7 +202,7 @@ STATIC FUNCTION FCM_GETVALUE( nWA, nField, xValue ) ENDIF RETURN SUCCESS ENDIF -RETURN FAILURE + RETURN FAILURE STATIC FUNCTION FCM_GOTO( nWA, nRecord ) LOCAL aWData := USRRDD_AREADATA( nWA ) @@ -221,17 +219,17 @@ STATIC FUNCTION FCM_GOTO( nWA, nRecord ) aWData[ 2 ] := HB_FRECNO() == 0 aWData[ 3 ] := HB_FEOF() ENDIF -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION FCM_GOTOID( nWA, nRecord ) -RETURN FCM_GOTO( nWA, nRecord ) + RETURN FCM_GOTO( nWA, nRecord ) STATIC FUNCTION FCM_GOTOP( nWA ) LOCAL aWData := USRRDD_AREADATA( nWA ) HB_FSELECT( aWData[ 1 ] ) HB_FGOTOP() aWData[ 2 ] := aWData[ 3 ] := HB_FEOF() -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION FCM_GOBOTTOM( nWA ) LOCAL aWData := USRRDD_AREADATA( nWA ) @@ -244,7 +242,7 @@ STATIC FUNCTION FCM_GOBOTTOM( nWA ) HB_FGOBOTTOM() aWData[ 2 ] := aWData[ 3 ] := .F. ENDIF -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION FCM_SKIPRAW( nWA, nRecords ) LOCAL aWData @@ -269,21 +267,21 @@ STATIC FUNCTION FCM_SKIPRAW( nWA, nRecords ) aWData[ 3 ] := HB_FEOF() ENDIF ENDIF -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION FCM_BOF( nWA, lBof ) LOCAL aWData := USRRDD_AREADATA( nWA ) lBof := aWData[ 2 ] -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION FCM_EOF( nWA, lEof ) LOCAL aWData := USRRDD_AREADATA( nWA ) lEof := aWData[ 3 ] -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION FCM_DELETED( nWA, lDeleted ) lDeleted := .F. -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION FCM_RECID( nWA, nRecNo ) LOCAL aWData := USRRDD_AREADATA( nWA ) @@ -293,12 +291,12 @@ STATIC FUNCTION FCM_RECID( nWA, nRecNo ) ELSE nRecNo := HB_FRECNO() ENDIF -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION FCM_RECCOUNT( nWA, nRecords ) HB_FSELECT( USRRDD_AREADATA( nWA )[ 1 ] ) nRecords := HB_FLASTREC() -RETURN SUCCESS + RETURN SUCCESS /* * This function have to exist in all RDD and then name have to be in @@ -325,9 +323,9 @@ FUNCTION FCOMMA_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID ) aMyFunc[ UR_RECCOUNT ] := ( @FCM_RECCOUNT() ) aMyFunc[ UR_GETVALUE ] := ( @FCM_GETVALUE() ) -RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - cSuperRDD, aMyFunc ) + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + cSuperRDD, aMyFunc ) -INIT PROC FCOMMA_INIT() +INIT PROCEDURE FCOMMA_INIT() rddRegister( "FCOMMA", RDT_FULL ) -RETURN + RETURN diff --git a/harbour/source/rdd/usrrdd/rdds/fptcdx.prg b/harbour/source/rdd/usrrdd/rdds/fptcdx.prg index 8c2e4fa9e8..a6cf97104b 100644 --- a/harbour/source/rdd/usrrdd/rdds/fptcdx.prg +++ b/harbour/source/rdd/usrrdd/rdds/fptcdx.prg @@ -68,10 +68,10 @@ REQUEST DBFFPT ANNOUNCE FPTCDX FUNCTION FPTCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID ) -RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - "DBFCDX", {} ) /* We are inheriting from DBFCDX */ + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + "DBFCDX", {} ) /* We are inheriting from DBFCDX */ -INIT PROC FPTCDX_INIT() +INIT PROCEDURE FPTCDX_INIT() rddRegister( "FPTCDX", RDT_FULL ) rddInfo( RDDI_MEMOTYPE, DB_MEMO_FPT, "FPTCDX" ) -RETURN + RETURN diff --git a/harbour/source/rdd/usrrdd/rdds/hscdx.prg b/harbour/source/rdd/usrrdd/rdds/hscdx.prg index f272d340cc..dc4e76d794 100644 --- a/harbour/source/rdd/usrrdd/rdds/hscdx.prg +++ b/harbour/source/rdd/usrrdd/rdds/hscdx.prg @@ -50,7 +50,6 @@ * */ - /* * A simple RDD which adds automatically update HSX indexes to DBFCDX * To create new HSX index for current work area use: HSX_CREATE() @@ -82,7 +81,7 @@ STATIC FUNCTION _HSX_NEW( pWA ) */ USRRDD_AREADATA( pWA, aWData ) -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION _HSX_CLOSE( nWA ) LOCAL aWData:= USRRDD_AREADATA( nWA ), nHSX @@ -97,7 +96,7 @@ STATIC FUNCTION _HSX_CLOSE( nWA ) ASIZE( aWData[ 3 ], 0 ) /* call SUPER CLOSE method to close parent RDD */ -RETURN UR_SUPER_CLOSE( nWA ) + RETURN UR_SUPER_CLOSE( nWA ) STATIC FUNCTION _HSX_GOCOLD( nWA ) LOCAL nResult, aWData, nHSX, nRecNo, nKeyNo @@ -122,7 +121,8 @@ STATIC FUNCTION _HSX_GOCOLD( nWA ) aWData[ 1 ] := .F. ENDIF ENDIF -RETURN nResult + + RETURN nResult STATIC FUNCTION _HSX_GOHOT( nWA ) LOCAL nResult, aWData @@ -132,7 +132,8 @@ STATIC FUNCTION _HSX_GOHOT( nWA ) aWData:= USRRDD_AREADATA( nWA ) aWData[ 1 ] := .T. ENDIF -RETURN nResult + + RETURN nResult STATIC FUNCTION _HSX_APPEND( nWA, lUnlockAll ) LOCAL nResult, aWData @@ -142,7 +143,8 @@ STATIC FUNCTION _HSX_APPEND( nWA, lUnlockAll ) aWData:= USRRDD_AREADATA( nWA ) aWData[ 1 ] := .T. ENDIF -RETURN nResult + + RETURN nResult /* * Three public functions for CREATE, OPEN and CLOSE HSX indexes bound @@ -165,7 +167,7 @@ FUNCTION HSX_CREATE( cFile, cExpr, nKeySize, nBufSize, lCase, nFiltSet ) ENDIF ENDIF -RETURN nHsx + RETURN nHsx FUNCTION HSX_OPEN( cFile, nBufSize ) LOCAL aWData, nHsx := -1, nOpenMode @@ -183,7 +185,7 @@ FUNCTION HSX_OPEN( cFile, nBufSize ) ENDIF ENDIF -RETURN NIL + RETURN NIL FUNCTION HSX_CLOSE( xHSX ) LOCAL aWData, nSlot @@ -204,10 +206,12 @@ FUNCTION HSX_CLOSE( xHSX ) ASIZE( aWData[ 3 ], LEN( aWData[ 3 ] ) - 1 ) ENDIF ENDIF -RETURN NIL + + RETURN NIL FUNCTION HSX_HANDLE( cFile ) LOCAL aWData, nSlot + IF USED() .AND. RDDNAME() == "HSCDX" aWData:= USRRDD_AREADATA( SELECT() ) nSlot := ASCAN( aWData[ 3 ], { |_1| _1 == cFile } ) @@ -215,7 +219,8 @@ FUNCTION HSX_HANDLE( cFile ) RETURN aWData[ 2, nSlot ] ENDIF ENDIF -RETURN -1 + + RETURN -1 FUNCTION HSX_FILE( nHsx ) LOCAL aWData, nSlot @@ -226,7 +231,7 @@ FUNCTION HSX_FILE( nHsx ) RETURN aWData[ 3, nSlot ] ENDIF ENDIF -RETURN "" + RETURN "" FUNCTION HSX_GET( nSlot ) LOCAL aWData @@ -236,7 +241,7 @@ FUNCTION HSX_GET( nSlot ) RETURN aWData[ 2, nSlot ] ENDIF ENDIF -RETURN -1 + RETURN -1 /* Force linking DBFCDX from which our RDD inherits */ REQUEST DBFCDX @@ -255,12 +260,12 @@ FUNCTION HSCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID ) aMyFunc[ UR_GOHOT ] := ( @_HSX_GOHOT() ) aMyFunc[ UR_APPEND ] := ( @_HSX_APPEND() ) -RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - cSuperRDD, aMyFunc ) + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + cSuperRDD, aMyFunc ) /* * Register our HSCDX at program startup */ -INIT PROC HSCDX_INIT() +INIT PROCEDURE HSCDX_INIT() rddRegister( "HSCDX", RDT_FULL ) -RETURN + RETURN diff --git a/harbour/source/rdd/usrrdd/rdds/rlcdx.prg b/harbour/source/rdd/usrrdd/rdds/rlcdx.prg index 84d85cdf85..96a26ee19e 100644 --- a/harbour/source/rdd/usrrdd/rdds/rlcdx.prg +++ b/harbour/source/rdd/usrrdd/rdds/rlcdx.prg @@ -80,7 +80,7 @@ STATIC FUNCTION RLCDX_NEW( pWA ) USRRDD_AREADATA( pWA, aWData ) -RETURN SUCCESS + RETURN SUCCESS STATIC FUNCTION RLCDX_LOCK( nWA, aLockInfo ) LOCAL aWData, nResult, xRecId, i @@ -149,7 +149,7 @@ STATIC FUNCTION RLCDX_LOCK( nWA, aLockInfo ) aLockInfo[ UR_LI_RESULT ] := .F. -RETURN FAILURE + RETURN FAILURE STATIC FUNCTION RLCDX_UNLOCK( nWA, xRecID ) LOCAL aWData := USRRDD_AREADATA( nWA ), i @@ -173,7 +173,7 @@ STATIC FUNCTION RLCDX_UNLOCK( nWA, xRecID ) ASIZE( aWData[ 2 ], 0 ) ENDIF -RETURN UR_SUPER_UNLOCK( nWA, xRecID ) + RETURN UR_SUPER_UNLOCK( nWA, xRecID ) STATIC FUNCTION RLCDX_APPEND( nWA, lUnlockAll ) LOCAL aWData, nResult, xRecId, i @@ -197,7 +197,7 @@ STATIC FUNCTION RLCDX_APPEND( nWA, lUnlockAll ) ENDIF ENDIF -RETURN nResult + RETURN nResult /* Force linking DBFCDX from which our RDD inherits */ REQUEST DBFCDX @@ -216,9 +216,9 @@ FUNCTION RLCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID ) aMethods[ UR_UNLOCK ] := ( @RLCDX_UNLOCK() ) aMethods[ UR_APPEND ] := ( @RLCDX_APPEND() ) -RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - cSuperRDD, aMethods ) + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + cSuperRDD, aMethods ) -INIT PROC RLCDX_INIT() +INIT PROCEDURE RLCDX_INIT() rddRegister( "RLCDX", RDT_FULL ) -RETURN + RETURN diff --git a/harbour/source/rdd/usrrdd/rdds/smtcdx.prg b/harbour/source/rdd/usrrdd/rdds/smtcdx.prg index 5751c43f74..f1e6c1a053 100644 --- a/harbour/source/rdd/usrrdd/rdds/smtcdx.prg +++ b/harbour/source/rdd/usrrdd/rdds/smtcdx.prg @@ -68,10 +68,10 @@ REQUEST DBFFPT ANNOUNCE SMTCDX FUNCTION SMTCDX_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID ) -RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; - "DBFCDX", {} ) /* We are inheriting from DBFCDX */ + RETURN USRRDD_GETFUNCTABLE( pFuncCount, pFuncTable, pSuperTable, nRddID, ; + "DBFCDX", {} ) /* We are inheriting from DBFCDX */ -INIT PROC SMTCDX_INIT() +INIT PROCEDURE SMTCDX_INIT() rddRegister( "SMTCDX", RDT_FULL ) rddInfo( RDDI_MEMOTYPE, DB_MEMO_SMT, "SMTCDX" ) -RETURN + RETURN diff --git a/harbour/source/rtl/altd.prg b/harbour/source/rtl/altd.prg index 039d38e5e9..a8b9b9d7c2 100644 --- a/harbour/source/rtl/altd.prg +++ b/harbour/source/rtl/altd.prg @@ -60,22 +60,22 @@ PROCEDURE AltD( nAction ) - IF PCOUNT() == 0 + IF PCount() == 0 /* do not activate the debugger imediatelly because the module where ALTD() was called can have no debugger info - stop on first LINE with debugged info */ - __dbgINVOKEDEBUG( SET( _SET_DEBUG ) ) + __dbgINVOKEDEBUG( Set( _SET_DEBUG ) ) ELSEIF HB_ISNUMERIC( nAction ) IF nAction == ALTD_DISABLE - SET( _SET_DEBUG, .F. ) + Set( _SET_DEBUG, .F. ) ELSEIF nAction == ALTD_ENABLE - SET( _SET_DEBUG, .T. ) + Set( _SET_DEBUG, .T. ) ENDIF ENDIF -RETURN + RETURN diff --git a/harbour/source/rtl/devoutp.prg b/harbour/source/rtl/devoutp.prg index 05ff5d7813..cf9e5e4715 100644 --- a/harbour/source/rtl/devoutp.prg +++ b/harbour/source/rtl/devoutp.prg @@ -56,4 +56,4 @@ PROCEDURE DevOutPict( xValue, cPicture, cColor ) DevOut( Transform( xValue, cPicture ), cColor ) ENDIF -RETURN + RETURN diff --git a/harbour/source/rtl/dirscan.prg b/harbour/source/rtl/dirscan.prg index 2585f1cea8..3d7d094ab6 100644 --- a/harbour/source/rtl/dirscan.prg +++ b/harbour/source/rtl/dirscan.prg @@ -50,20 +50,20 @@ * */ -STATIC FUNCTION HB_doScan( cPath, cMask, cAttr, cPathSep ) +STATIC FUNCTION hb_doScan( cPath, cMask, cAttr, cPathSep ) LOCAL aFile LOCAL lMatch LOCAL aResult := {} FOR EACH aFile IN Directory( cPath + hb_osFileMask(), cAttr + "D" ) - lMatch = HB_FileMatch( aFile[ 1 ], cMask ) + lMatch := hb_FileMatch( aFile[ 1 ], cMask ) IF "D" $ aFile[ 5 ] IF lMatch .AND. "D" $ cAttr AAdd( aResult, aFile ) ENDIF IF !( aFile[ 1 ] == "." .OR. aFile[ 1 ] == ".." .OR. aFile[ 1 ] == "" ) - AEval( HB_DoScan( cPath + aFile[ 1 ] + cPathSep, cMask, cAttr, cPathSep ), ; + AEval( hb_DoScan( cPath + aFile[ 1 ] + cPathSep, cMask, cAttr, cPathSep ), ; { |x| x[ 1 ] := aFile[ 1 ] + cPathSep + x[ 1 ], ; AAdd( aResult, x ) } ) ENDIF @@ -74,7 +74,7 @@ STATIC FUNCTION HB_doScan( cPath, cMask, cAttr, cPathSep ) RETURN aResult -FUNCTION HB_DirScan( cPath, cFileMask, cAttr ) +FUNCTION hb_DirScan( cPath, cFileMask, cAttr ) LOCAL cFilePath LOCAL cPathSep := hb_osPathSeparator() @@ -89,6 +89,6 @@ FUNCTION HB_DirScan( cPath, cFileMask, cAttr ) ENDIF RETURN HB_DoScan( cFilePath, ; - IIF( Empty( cFileMask ), hb_osFileMask(), cFileMask ), ; - IIF( ValType( cAttr ) $ "CM", cAttr, "" ), ; + iif( Empty( cFileMask ), hb_osFileMask(), cFileMask ), ; + iif( ValType( cAttr ) $ "CM", cAttr, "" ), ; cPathSep ) diff --git a/harbour/source/rtl/objfunc.prg b/harbour/source/rtl/objfunc.prg index 15b5ebfeba..0755d9a396 100644 --- a/harbour/source/rtl/objfunc.prg +++ b/harbour/source/rtl/objfunc.prg @@ -279,7 +279,6 @@ FUNCTION __objDerivedFrom( oObject, xSuper ) RETURN __clsParent( oObject:ClassH, cClassName ) - FUNCTION __objGetProperties( oObject, lAllExported ) LOCAL msg LOCAL aMsgList := __clsGetProperties( oObject:classH, lAllExported ) diff --git a/harbour/source/rtl/perfuncs.prg b/harbour/source/rtl/perfuncs.prg index 31e1d69304..23ac07ffe9 100644 --- a/harbour/source/rtl/perfuncs.prg +++ b/harbour/source/rtl/perfuncs.prg @@ -50,29 +50,29 @@ * */ -thread static s_aObjects +THREAD STATIC s_aObjects -function HB_SetObject( oSelf, bConstructor ) +FUNCTION hb_SetObject( oSelf, bConstructor ) - if s_aObjects == nil + IF s_aObjects == NIL s_aObjects := {} AAdd( s_aObjects, oSelf ) - else + ELSE AAdd( s_aObjects, oSelf := Eval( bConstructor ) ) - endif + ENDIF -return oSelf + RETURN oSelf -function HB_EndObject() +FUNCTION hb_EndObject() - local oSelf + LOCAL oSelf - if Len( s_aObjects ) > 1 + IF Len( s_aObjects ) > 1 ASize( s_aObjects, Len( s_aObjects ) - 1 ) oSelf := ATail( s_aObjects ) - else + ELSE oSelf := s_aObjects[ 1 ] - s_aObjects := nil - endif + s_aObjects := NIL + ENDIF -return oSelf + RETURN oSelf diff --git a/harbour/source/rtl/persist.prg b/harbour/source/rtl/persist.prg index 1f281617d1..8a7bf1e265 100644 --- a/harbour/source/rtl/persist.prg +++ b/harbour/source/rtl/persist.prg @@ -65,59 +65,67 @@ ENDCLASS METHOD LoadFromText( cObjectText ) CLASS HBPersistent - local nFrom := 1, cLine, cToken - local lStart := .t. - private oSelf + LOCAL nFrom := 1 + LOCAL cLine + LOCAL cToken + LOCAL lStart := .t. - if empty( cObjectText ) - return .F. - endif + PRIVATE oSelf - do while Empty( ExtractLine( cObjectText, @nFrom ) ) // We skip the first empty lines - enddo + IF Empty( cObjectText ) + RETURN .F. + ENDIF - do while nFrom <= Len( cObjectText ) - cLine := ExtractLine( cObjectText, @nFrom ) + // We skip the first empty lines + DO WHILE Empty( ExtractLine( cObjectText, @nFrom ) ) + ENDDO - do case - case Upper( LTrim( hb_TokenGet( cLine, 1 ) ) ) == "OBJECT" - if lStart - lStart := .f. - else - endif + DO WHILE nFrom <= Len( cObjectText ) + cLine := ExtractLine( cObjectText, @nFrom ) - case Upper( LTrim( hb_TokenGet( cLine, 1 ) ) ) == "ARRAY" - cLine := SubStr( cLine, At( "::", cLine ) ) - M->oSelf := Self - cLine := StrTran( cLine, "::", "oSelf:" ) - cLine := StrTran( cLine, " LEN ", " = Array( " ) - cLine := RTrim( StrTran( cLine, "=", ":=", , 1 ) ) + " )" - cLine := &( cLine ) + DO CASE + CASE Upper( LTrim( hb_TokenGet( cLine, 1 ) ) ) == "OBJECT" + IF lStart + lStart := .F. + ENDIF - case Left( cToken := LTrim( hb_TokenGet( cLine, 1, "=" ) ), 2 ) == "::" - M->oSelf := Self - cLine := StrTran( cLine, "::", "oSelf:" ) - cLine := StrTran( cLine, "=", ":=", , 1 ) - cLine := &( cLine ) + CASE Upper( LTrim( hb_TokenGet( cLine, 1 ) ) ) == "ARRAY" + cLine := SubStr( cLine, At( "::", cLine ) ) + M->oSelf := Self + cLine := StrTran( cLine, "::", "oSelf:" ) + cLine := StrTran( cLine, " LEN ", " = Array( " ) + cLine := RTrim( StrTran( cLine, "=", ":=", , 1 ) ) + " )" + cLine := &( cLine ) - endcase + CASE Left( cToken := LTrim( hb_TokenGet( cLine, 1, "=" ) ), 2 ) == "::" + M->oSelf := Self + cLine := StrTran( cLine, "::", "oSelf:" ) + cLine := StrTran( cLine, "=", ":=", , 1 ) + cLine := &( cLine ) - enddo + ENDCASE -return .T. + ENDDO + + RETURN .T. METHOD SaveToText( cObjectName, nIndent ) CLASS HBPersistent - local oNew := &( ::ClassName() + "()" ):CreateNew() - local aProperties, n, uValue, uNewValue, cObject, cType + LOCAL oNew := &( ::ClassName() + "()" ):CreateNew() + LOCAL aProperties + LOCAL n + LOCAL uValue + LOCAL uNewValue + LOCAL cObject + LOCAL cType DEFAULT cObjectName TO "o" + ::ClassName() - if nIndent == NIL + IF nIndent == NIL nIndent := 0 - else + ELSE nIndent += 3 - endif + ENDIF cObject := iif( nIndent > 0, hb_OSNewLine(), "" ) + Space( nIndent ) + ; "OBJECT " + iif( nIndent != 0, "::", "" ) + cObjectName + " AS " + ; @@ -125,124 +133,126 @@ METHOD SaveToText( cObjectName, nIndent ) CLASS HBPersistent aProperties := __ClsGetProperties( ::ClassH ) - for n := 1 to Len( aProperties ) + FOR n := 1 TO Len( aProperties ) uValue := __objSendMsg( Self, aProperties[ n ] ) uNewValue := __objSendMsg( oNew, aProperties[ n ] ) cType := ValType( uValue ) - if !( cType == ValType( uNewValue ) ) .OR. ! uValue == uNewValue + IF !( cType == ValType( uNewValue ) ) .OR. !( uValue == uNewValue ) - do case - case cType == "A" - nIndent += 3 - cObject += ArrayToText( uValue, aProperties[ n ], nIndent ) - nIndent -= 3 - if n < Len( aProperties ) - cObject += hb_OSNewLine() - endif + DO CASE + CASE cType == "A" + nIndent += 3 + cObject += ArrayToText( uValue, aProperties[ n ], nIndent ) + nIndent -= 3 + IF n < Len( aProperties ) + cObject += hb_OSNewLine() + ENDIF - case cType == "O" - if __objDerivedFrom( uValue, "HBPERSISTENT" ) - cObject += uValue:SaveToText( aProperties[ n ], nIndent ) - endif - if n < Len( aProperties ) - cObject += hb_OSNewLine() - endif + CASE cType == "O" + IF __objDerivedFrom( uValue, "HBPERSISTENT" ) + cObject += uValue:SaveToText( aProperties[ n ], nIndent ) + ENDIF + IF n < Len( aProperties ) + cObject += hb_OSNewLine() + ENDIF - otherwise - if n == 1 - cObject += hb_OSNewLine() - endif - cObject += Space( nIndent ) + " ::" + ; - aProperties[ n ] + " = " + ValToText( uValue ) + ; - hb_OSNewLine() - endcase + OTHERWISE + IF n == 1 + cObject += hb_OSNewLine() + ENDIF + cObject += Space( nIndent ) + " ::" + ; + aProperties[ n ] + " = " + ValToText( uValue ) + ; + hb_OSNewLine() + ENDCASE - endif + ENDIF - next + NEXT cObject += hb_OSNewLine() + Space( nIndent ) + "ENDOBJECT" + hb_OSNewLine() -return cObject + RETURN cObject -static function ArrayToText( aArray, cName, nIndent ) +STATIC FUNCTION ArrayToText( aArray, cName, nIndent ) - local cArray := hb_OSNewLine() + Space( nIndent ) + "ARRAY ::" + cName + ; + LOCAL cArray := hb_OSNewLine() + Space( nIndent ) + "ARRAY ::" + cName + ; " LEN " + AllTrim( Str( Len( aArray ) ) ) + hb_OSNewLine() - local n, uValue, cType + LOCAL n + LOCAL uValue + LOCAL cType - for n := 1 to Len( aArray ) + FOR n := 1 TO Len( aArray ) uValue := aArray[ n ] cType := ValType( uValue ) - do case - case cType == "A" - nIndent += 3 - cArray += ArrayToText( uValue, cName + "[ " + ; - AllTrim( Str( n ) ) + " ]", nIndent ) + hb_OSNewLine() - nIndent -= 3 + DO CASE + CASE cType == "A" + nIndent += 3 + cArray += ArrayToText( uValue, cName + "[ " + ; + AllTrim( Str( n ) ) + " ]", nIndent ) + hb_OSNewLine() + nIndent -= 3 - case cType == "O" - if __objDerivedFrom( uValue, "HBPERSISTENT" ) - cArray += uValue:SaveToText( cName + "[ " + AllTrim( Str( n ) ) + ; - " ]", nIndent ) - endif + CASE cType == "O" + IF __objDerivedFrom( uValue, "HBPERSISTENT" ) + cArray += uValue:SaveToText( cName + "[ " + AllTrim( Str( n ) ) + ; + " ]", nIndent ) + ENDIF - otherwise - if n == 1 - cArray += hb_OSNewLine() - endif - cArray += Space( nIndent ) + " ::" + cName + ; - + "[ " + AllTrim( Str( n ) ) + " ]" + " = " + ; - ValToText( uValue ) + hb_OSNewLine() - endcase - next + OTHERWISE + IF n == 1 + cArray += hb_OSNewLine() + ENDIF + cArray += Space( nIndent ) + " ::" + cName + ; + + "[ " + AllTrim( Str( n ) ) + " ]" + " = " + ; + ValToText( uValue ) + hb_OSNewLine() + ENDCASE + NEXT cArray += hb_OSNewLine() + Space( nIndent ) + "ENDARRAY" + hb_OSNewLine() -return cArray + RETURN cArray -static function ValToText( uValue ) +STATIC FUNCTION ValToText( uValue ) - local cType := ValType( uValue ) - local cText + LOCAL cType := ValType( uValue ) + LOCAL cText - do case - case cType == "C" - cText := hb_StrToExp( uValue ) + DO CASE + CASE cType == "C" + cText := hb_StrToExp( uValue ) - case cType == "N" - cText := AllTrim( Str( uValue ) ) + CASE cType == "N" + cText := AllTrim( Str( uValue ) ) - case cType == "D" - cText := DToS( uValue ) - cText := "0d" + iif( Empty( cText ), "00000000", cText ) + CASE cType == "D" + cText := DToS( uValue ) + cText := "0d" + iif( Empty( cText ), "00000000", cText ) - otherwise - cText := hb_ValToStr( uValue ) - endcase + OTHERWISE + cText := hb_ValToStr( uValue ) + ENDCASE -return cText + RETURN cText // Notice: nFrom must be supplied by reference -static function ExtractLine( cText, nFrom ) +STATIC FUNCTION ExtractLine( cText, nFrom ) - local nAt := hb_At( Chr( 10 ), cText, nFrom ) + LOCAL nAt := hb_At( Chr( 10 ), cText, nFrom ) - if nAt > 0 + IF nAt > 0 cText := SubStr( cText, nFrom, nAt - nFrom ) - if Right( cText, 1 ) == Chr( 13 ) + IF Right( cText, 1 ) == Chr( 13 ) cText := hb_StrShrink( cText, 1 ) - endif + ENDIF nFrom := nAt + 1 - else + ELSE cText := SubStr( cText, nFrom ) - if Right( cText, 1 ) == Chr( 13 ) + IF Right( cText, 1 ) == Chr( 13 ) cText := hb_StrShrink( cText, 1 ) - endif + ENDIF nFrom += Len( cText ) + 1 - endif + ENDIF -return cText + RETURN cText diff --git a/harbour/source/rtl/profiler.prg b/harbour/source/rtl/profiler.prg index dcb3d7988d..5bd33938ec 100644 --- a/harbour/source/rtl/profiler.prg +++ b/harbour/source/rtl/profiler.prg @@ -55,9 +55,7 @@ * There are three aspects to profiling: * * 1) Gathering profile information. - * * 2) Taking a snapshot of an application's profile information. - * * 3) Reporting on the data gathered in the snapshot. * * Point 1 is handled in harbour's virtual machine. This source aims to @@ -79,7 +77,7 @@ * Heisenberg effect. In other words, we don't want the profiler showing up * in the profiler. * - * Many of the "Protected:" scope specifiers in the source have been + * Many of the "PROTECTED:" scope specifiers in the source have been * commented out where there's a problem with scope in harbour's class * system. Note that those comments will be removed when the bug is fixed. * @@ -106,9 +104,9 @@ #include "inkey.ch" -Procedure Main() -Local oProfile := HBProfile():new() -Local n +PROCEDURE Main() + LOCAL oProfile := HBProfile():new() + LOCAL n // Turn on profiling. __setProfiler( .T. ) @@ -118,9 +116,9 @@ Local n DoNothingForTwoSeconds() // Make sure we've got something to see callwise. - For n := 1 To 500 + FOR n := 1 TO 500 CallMe500Times() - Next + NEXT // Take a profile snapshot. oProfile:gather() @@ -143,297 +141,272 @@ Local n // Some closing stats DrawScreen( "Totals" ) - @ 2, 0 Say " Total Calls: " + str( oProfile:totalCalls() ) - @ 3, 0 Say " Total Ticks: " + str( oProfile:totalTicks() ) - @ 4, 0 Say "Total Seconds: " + str( oProfile:totalSeconds() ) + @ 2, 0 Say " Total Calls: " + Str( oProfile:totalCalls() ) + @ 3, 0 Say " Total Ticks: " + Str( oProfile:totalTicks() ) + @ 4, 0 Say "Total Seconds: " + Str( oProfile:totalSeconds() ) -Return + RETURN -Static Procedure DrawScreen( cTitle ) +STATIC PROCEDURE DrawScreen( cTitle ) Scroll() @ 0, 0 SAY PadR( cTitle, MaxCol() + 1 ) COLOR "N/W" -Return + RETURN -Procedure DoNothingForTwoSeconds() +PROCEDURE DoNothingForTwoSeconds() Inkey( 2 ) -Return + RETURN -Procedure CallMe500Times() -Return +PROCEDURE CallMe500Times() + RETURN -Static Procedure Browser( oBrowse ) -Local lBrowsing := .T. -Local nKey +STATIC PROCEDURE Browser( oBrowse ) + LOCAL lBrowsing := .T. + LOCAL nKey - Do While lBrowsing + DO WHILE lBrowsing oBrowse:forceStable() nKey := Inkey( 0 ) - Do Case + DO CASE + CASE nKey == K_ESC + lBrowsing := .F. + CASE nKey == K_DOWN + oBrowse:down() + CASE nKey == K_UP + oBrowse:up() + CASE nKey == K_LEFT + oBrowse:left() + CASE nKey == K_RIGHT + oBrowse:right() + CASE nKey == K_PGDN + oBrowse:pageDown() + CASE nKey == K_PGUP + oBrowse:pageUp() - Case nKey == K_ESC - lBrowsing := .F. + // And so on.... (not really necessary for this test) - Case nKey == K_DOWN - oBrowse:down() + ENDCASE - Case nKey == K_UP - oBrowse:up() + ENDDO - Case nKey == K_LEFT - oBrowse:left() - - Case nKey == K_RIGHT - oBrowse:right() - - Case nKey == K_PGDN - oBrowse:pageDown() - - Case nKey == K_PGUP - oBrowse:pageUp() - - // And so on.... (not really necessary for this test) - - EndCase - - EndDo - -Return + RETURN #endif //////////////////////////////////////////////////////////////////////////// // Class: HBProfileEntity -Create Class HBProfileEntity +CREATE CLASS HBProfileEntity - Exported: + EXPORTED: - Var cName ReadOnly - Var nCalls ReadOnly - Var nTicks ReadOnly + VAR cName ReadOnly + VAR nCalls ReadOnly + VAR nTicks ReadOnly - Access nSeconds - Access nMeanTicks - Access nMeanSeconds + ACCESS nSeconds + ACCESS nMeanTicks + ACCESS nMeanSeconds - Method init - Method describe + METHOD init + METHOD describe -Endclass +ENDCLASS ///// -Method init( cName, aInfo ) Class HBProfileEntity +METHOD init( cName, aInfo ) CLASS HBProfileEntity ::cName := cName ::nCalls := aInfo[ 1 ] ::nTicks := aInfo[ 2 ] -Return Self + RETURN Self -///// +ACCESS nSeconds CLASS HBProfileEntity + RETURN HB_Clocks2Secs( ::nTicks ) -Access nSeconds Class HBProfileEntity -Return HB_Clocks2Secs( ::nTicks ) +ACCESS nMeanTicks CLASS HBProfileEntity + RETURN iif( ::nCalls == 0, 0, ::nTicks / ::nCalls ) -///// +ACCESS nMeanSeconds CLASS HBProfileEntity + RETURN iif( ::nCalls == 0, 0, ::nSeconds / ::nCalls ) -Access nMeanTicks Class HBProfileEntity -Return iif( ::nCalls == 0, 0, ::nTicks / ::nCalls ) - -///// - -Access nMeanSeconds Class HBProfileEntity -Return iif( ::nCalls == 0, 0, ::nSeconds / ::nCalls ) - -///// - -Method describe Class HBProfileEntity -Return "Base Entity" +METHOD describe CLASS HBProfileEntity + RETURN "Base Entity" //////////////////////////////////////////////////////////////////////////// // Class: HBProfileFunction -Create Class HBProfileFunction Inherit HBProfileEntity +CREATE CLASS HBProfileFunction INHERIT HBProfileEntity - Exported: + EXPORTED: - Method describe + METHOD describe -Endclass +ENDCLASS ///// -Method describe Class HBProfileFunction -Return "Function" +METHOD describe CLASS HBProfileFunction + RETURN "Function" //////////////////////////////////////////////////////////////////////////// // Class: HBProfileMethod -Create Class HBProfileMethod Inherit HBProfileEntity +CREATE CLASS HBProfileMethod INHERIT HBProfileEntity - Exported: + EXPORTED: - Method describe + METHOD describe -Endclass +ENDCLASS ///// -Method describe Class HBProfileMethod -Return "Method" +METHOD describe CLASS HBProfileMethod + RETURN "Method" //////////////////////////////////////////////////////////////////////////// // Class: HBProfileOPCode -Create Class HBProfileOPCode Inherit HBProfileEntity +CREATE CLASS HBProfileOPCode INHERIT HBProfileEntity - Exported: + EXPORTED: - Method describe + METHOD describe -Endclass +ENDCLASS ///// -Method describe Class HBProfileOPCode -Return "OPCode" +METHOD describe CLASS HBProfileOPCode + RETURN "OPCode" //////////////////////////////////////////////////////////////////////////// // Class: HBProfile -Create Class HBProfile +CREATE CLASS HBProfile - Exported: + EXPORTED: - Var aProfile + VAR aProfile - Method init - Method gather - Method forEach - Method sort - Method nameSort - Method callSort - Method timeSort - Method totalCalls - Method totalTicks - Method totalSeconds + METHOD init + METHOD gather + METHOD forEach + METHOD sort + METHOD nameSort + METHOD callSort + METHOD timeSort + METHOD totalCalls + METHOD totalTicks + METHOD totalSeconds - Protected: + PROTECTED: - Method gatherFunctions - Method gatherMethods - Method reset - Method ignoreSymbol + METHOD gatherFunctions + METHOD gatherMethods + METHOD reset + METHOD ignoreSymbol -Endclass +ENDCLASS ///// -Method init Class HBProfile -Local lProfile := __setProfiler( .F. ) +METHOD init CLASS HBProfile + LOCAL lProfile := __setProfiler( .F. ) ::reset() __setProfiler( lProfile ) -Return Self + RETURN Self -///// - -Method reset Class HBProfile +METHOD reset CLASS HBProfile ::aProfile := {} -Return Self + RETURN Self -///// +METHOD ignoreSymbol( cSymbol ) CLASS HBProfile + LOCAL cProfPrefix := "HBPROFILE" + RETURN Left( cSymbol, Len( cProfPrefix ) ) == cProfPrefix .OR. cSymbol == "__SETPROFILER" -Method ignoreSymbol( cSymbol ) Class HBProfile -Local cProfPrefix := "HBPROFILE" -Return Left( cSymbol, Len( cProfPrefix ) ) == cProfPrefix .Or. cSymbol == "__SETPROFILER" - -///// - -Method gatherFunctions Class HBProfile -Local lProfile := __setProfiler( .F. ) -Local nSymCount := __DynSCount() -Local cName -Local n +METHOD gatherFunctions CLASS HBProfile + LOCAL lProfile := __setProfiler( .F. ) + LOCAL nSymCount := __DynSCount() + LOCAL cName + LOCAL n // For each known symbol. // TODO: Question: Will the symbol count have changed because // we've created variables? - For n := 1 To nSymCount + FOR n := 1 TO nSymCount // Is the symbol a function? - If __DynSIsFun( n ) + IF __DynSIsFun( n ) // If we're not ignoring the symbol... - If !::ignoreSymbol( cName := __DynSGetName( n ) ) + IF !::ignoreSymbol( cName := __DynSGetName( n ) ) // Yes, it is, add it to the profile. AAdd( ::aProfile, HBProfileFunction():new( cName, __DynSGetPrf( n ) ) ) - EndIf + ENDIF - EndIf + ENDIF - Next + NEXT __setProfiler( lProfile ) -Return Self + RETURN Self -///// - -Method gatherMethods Class HBProfile -Local lProfile := __setProfiler( .F. ) -Local n := 1 -Local cClass -Local nMembers -Local aMembers -Local nMember +METHOD gatherMethods CLASS HBProfile + LOCAL lProfile := __setProfiler( .F. ) + LOCAL n := 1 + LOCAL cClass + LOCAL nMembers + LOCAL aMembers + LOCAL nMember // For each class in the environment... - Do While !Empty( cClass := __className( n ) ) + DO WHILE !Empty( cClass := __className( n ) ) // If we're not ignoring the class' methods... - If !::ignoreSymbol( cClass ) + IF !::ignoreSymbol( cClass ) // Collect class members. nMembers := Len( aMembers := __classSel( n ) ) - For nMember := 1 To nMembers + FOR nMember := 1 TO nMembers // If we've got a member name... - If !empty( aMembers[ nMember ] ) + IF !empty( aMembers[ nMember ] ) // Add it to the profile. AAdd( ::aProfile, HBProfileMethod():new( cClass + ":" + aMembers[ nMember ], __GetMsgPrf( n, aMembers[ nMember ] ) ) ) - EndIf + ENDIF - Next + NEXT - EndIf + ENDIF ++n - EndDo + ENDDO __setProfiler( lProfile ) -Return Self + RETURN Self -///// - -Method gather Class HBProfile -Local lProfile := __setProfiler( .F. ) +METHOD gather CLASS HBProfile + LOCAL lProfile := __setProfiler( .F. ) // Reset the profile. ::reset() @@ -446,118 +419,102 @@ Local lProfile := __setProfiler( .F. ) __setProfiler( lProfile ) -Return Self + RETURN Self -///// - -Method forEach( b ) Class HBProfile -Local lProfile := __setProfiler( .F. ) +METHOD forEach( b ) CLASS HBProfile + LOCAL lProfile := __setProfiler( .F. ) AEval( ::aProfile, b ) __setProfiler( lProfile ) -Return Self + RETURN Self -///// - -Method sort( b ) Class HBProfile -Local lProfile := __setProfiler( .F. ) +METHOD sort( b ) CLASS HBProfile + LOCAL lProfile := __setProfiler( .F. ) ASort( ::aProfile,,, b ) __setProfiler( lProfile ) -Return Self + RETURN Self -///// - -Method nameSort Class HBProfile -Local lProfile := __setProfiler( .F. ) +METHOD nameSort CLASS HBProfile + LOCAL lProfile := __setProfiler( .F. ) ::sort( {| oX, oY | oX:cName < oY:cName } ) __setProfiler( lProfile ) -Return Self + RETURN Self -///// - -Method callSort Class HBProfile -Local lProfile := __setProfiler( .F. ) +METHOD callSort CLASS HBProfile + LOCAL lProfile := __setProfiler( .F. ) ::sort( {| oX, oY | oX:nCalls > oY:nCalls } ) __setProfiler( lProfile ) -Return Self + RETURN Self -///// - -Method timeSort Class HBProfile -Local lProfile := __setProfiler( .F. ) +METHOD timeSort CLASS HBProfile + LOCAL lProfile := __setProfiler( .F. ) ::sort( {| oX, oY | oX:nTicks > oY:nTicks } ) __setProfiler( lProfile ) -Return Self + RETURN Self -///// - -Method totalCalls Class HBProfile -Local lProfile := __setProfiler( .F. ) -Local nCalls := 0 +METHOD totalCalls CLASS HBProfile + LOCAL lProfile := __setProfiler( .F. ) + LOCAL nCalls := 0 ::forEach( {| o | nCalls += o:nCalls } ) __setProfiler( lProfile ) -Return nCalls + RETURN nCalls -///// - -Method totalTicks Class HBProfile -Local lProfile := __setProfiler( .F. ) -Local nTicks := 0 +METHOD totalTicks CLASS HBProfile + LOCAL lProfile := __setProfiler( .F. ) + LOCAL nTicks := 0 ::forEach( {| o | nTicks += o:nTicks } ) __setProfiler( lProfile ) -Return nTicks + RETURN nTicks -///// - -Method totalSeconds Class HBProfile -Local lProfile := __setProfiler( .F. ) -Local nSeconds := 0 +METHOD totalSeconds CLASS HBProfile + LOCAL lProfile := __setProfiler( .F. ) + LOCAL nSeconds := 0 ::forEach( {| o | nSeconds += o:nSeconds } ) __setProfiler( lProfile ) -Return nSeconds + RETURN nSeconds //////////////////////////////////////////////////////////////////////////// // Class: HBProfileLowLevel -Create Class HBProfileLowLevel Inherit HBProfile +CREATE CLASS HBProfileLowLevel INHERIT HBProfile - Exported: + EXPORTED: - Method gather + METHOD gather - Protected: + PROTECTED: - Method gatherOPCodes + METHOD gatherOPCodes -Endclass +ENDCLASS ///// -Method gather Class HBProfileLowLevel -Local lProfile := __setProfiler( .F. ) +METHOD gather CLASS HBProfileLowLevel + LOCAL lProfile := __setProfiler( .F. ) // Gather functions and methods. ::super:gather() @@ -567,253 +524,230 @@ Local lProfile := __setProfiler( .F. ) __setProfiler( lProfile ) -Return Self + RETURN Self -///// - -Method gatherOPCodes Class HBProfileLowLevel -Local nMax := __opcount() -Local cName -Local nOP +METHOD gatherOPCodes CLASS HBProfileLowLevel + LOCAL nMax := __opcount() + LOCAL cName + LOCAL nOP // Loop over all the harbour OP codes. Note that they start at 0. - For nOP := 0 To ( nMax - 1 ) + FOR nOP := 0 TO ( nMax - 1 ) // If we're not ignoring this opcode. - If !::ignoreSymbol( cName := "OPCODE( " + PadL( nOP, 3 ) + " )" ) + IF !::ignoreSymbol( cName := "OPCODE( " + PadL( nOP, 3 ) + " )" ) // Add it to the profile. AAdd( ::aProfile, HBProfileOPCode():new( cName, __OpGetPrf( nOP ) ) ) - EndIf - Next + ENDIF + NEXT -Return Self + RETURN Self //////////////////////////////////////////////////////////////////////////// // Class: HBProfileReport -Create Class HBProfileReport +CREATE CLASS HBProfileReport - Protected: + PROTECTED: - Var oProfile + VAR oProfile - Method writeLines - Method header - Method emitHeader - Method line - Method emitLine + METHOD writeLines + METHOD header + METHOD emitHeader + METHOD line + METHOD emitLine - Exported: + EXPORTED: - Method init - Method generate + METHOD init + METHOD generate -Endclass +ENDCLASS ///// -Method init( oProfile ) Class HBProfileReport -Local lProfile := __setProfiler( .F. ) +METHOD init( oProfile ) CLASS HBProfileReport + LOCAL lProfile := __setProfiler( .F. ) ::oProfile := oProfile __setProfiler( lProfile ) -Return Self + RETURN Self -///// - -Method writeLines( aLines ) Class HBProfileReport +METHOD writeLines( aLines ) CLASS HBProfileReport AEval( aLines, {| c | QOut( c ) } ) -Return Self + RETURN Self -///// +METHOD header CLASS HBProfileReport + RETURN { "Name Type Calls Ticks Seconds",; + "=================================== ========== ======== =========== ===========" } -Method header Class HBProfileReport -Return { "Name Type Calls Ticks Seconds",; - "=================================== ========== ======== =========== ===========" } - -///// - -Method emitHeader Class HBProfileReport +METHOD emitHeader CLASS HBProfileReport ::writeLines( ::header() ) -Return Self + RETURN Self -///// +METHOD line( oEntity ) CLASS HBProfileReport + RETURN { PadR( oEntity:cName, 35 ) + " " + ; + PadR( oEntity:describe(), 8 ) + " " + ; + PadL( oEntity:nCalls, 10 ) + " " + ; + PadL( oEntity:nTicks, 11 ) + " " + ; + Str( oEntity:nSeconds, 11, 2 ) } -Method line( oEntity ) Class HBProfileReport -Return { PadR( oEntity:cName, 35 ) + " " + ; - PadR( oEntity:describe(), 8 ) + " " + ; - PadL( oEntity:nCalls, 10 ) + " " + ; - PadL( oEntity:nTicks, 11 ) + " " + ; - Str( oEntity:nSeconds, 11, 2 ) } - -///// - -Method emitLine( oEntity ) Class HBProfileReport +METHOD emitLine( oEntity ) CLASS HBProfileReport ::writeLines( ::line( oEntity ) ) -Return Self + RETURN Self -///// +METHOD generate( bFilter ) CLASS HBProfileReport + LOCAL lProfile := __setProfiler( .F. ) -Method generate( bFilter ) Class HBProfileReport -Local lProfile := __setProfiler( .F. ) - - Default bFilter To {|| .T. } + DEFAULT bFilter TO {|| .T. } ::emitHeader():oProfile:forEach( {| o | iif( Eval( bFilter, o ), ::emitLine( o ), NIL ) } ) __setProfiler( lProfile ) -Return Self + RETURN Self //////////////////////////////////////////////////////////////////////////// // Class: HBProfileReportToFile -Create Class HBProfileReportToFile Inherit HBProfileReport +CREATE CLASS HBProfileReportToFile INHERIT HBProfileReport - Protected: + PROTECTED: - Var hFile + VAR hFile - Method writeLines + METHOD writeLines - Exported: + EXPORTED: - Method generate + METHOD generate -Endclass +ENDCLASS ///// -Method writeLines( aLines ) Class HBProfileReportToFile +METHOD writeLines( aLines ) CLASS HBProfileReportToFile - If ::hFile != F_ERROR + IF ::hFile != F_ERROR AEval( aLines, {| c | FWrite( ::hFile, c + HB_OSNewLine() ) } ) - EndIf + ENDIF -Return Self + RETURN Self -///// +METHOD generate( bFilter, cFile ) CLASS HBProfileReportToFile + LOCAL lProfile := __setProfiler( .F. ) -Method generate( bFilter, cFile ) Class HBProfileReportToFile -Local lProfile := __setProfiler( .F. ) + DEFAULT cFile TO "hbprof.txt" - Default cFile To "hbprof.txt" - - If ( ::hFile := fcreate( cFile ) ) != F_ERROR + IF ( ::hFile := fcreate( cFile ) ) != F_ERROR ::super:generate( bFilter ) fclose( ::hFile ) - Else + ELSE // TODO: Throw an error - EndIf + ENDIF __setProfiler( lProfile ) -Return Self + RETURN Self //////////////////////////////////////////////////////////////////////////// // Class: HBProfileReportToArray -Create Class HBProfileReportToArray Inherit HBProfileReport +CREATE CLASS HBProfileReportToArray INHERIT HBProfileReport - Protected: + PROTECTED: - Var aReport + VAR aReport - Method writeLines + METHOD writeLines - Exported: + EXPORTED: - Method generate + METHOD generate -Endclass +ENDCLASS ///// -Method writeLines( aLines ) Class HBProfileReportToArray +METHOD writeLines( aLines ) CLASS HBProfileReportToArray AEval( aLines, {| c | AAdd( ::aReport, c ) } ) -Return Self + RETURN Self -///// - -Method generate( bFilter ) Class HBProfileReportToArray +METHOD generate( bFilter ) CLASS HBProfileReportToArray ::aReport := {} ::super:generate( bFilter ) -Return ::aReport + RETURN ::aReport //////////////////////////////////////////////////////////////////////////// // Class: HBProfileReportToString -Create Class HBProfileReportToString Inherit HBProfileReportToArray +CREATE CLASS HBProfileReportToString INHERIT HBProfileReportToArray - Exported: + EXPORTED: - Method generate + METHOD generate -Endclass +ENDCLASS ///// -Method generate( bFilter ) Class HBProfileReportToString -Local cReport := "" +METHOD generate( bFilter ) CLASS HBProfileReportToString + LOCAL cReport := "" AEval( ::super:generate( bFilter ), {| c | cReport += c + HB_OSNewLine() } ) -Return cReport + RETURN cReport //////////////////////////////////////////////////////////////////////////// // Class: HBProfileReportToTBrowse +CREATE CLASS HBProfileReportToTBrowse INHERIT HBProfileReportToArray -Create Class HBProfileReportToTBrowse Inherit HBProfileReportToArray + PROTECTED: - Protected: + VAR nEntity - Var nEntity + METHOD emitHeader + METHOD emitLine + METHOD addColumns - Method emitHeader - Method emitLine - Method addColumns + EXPORTED: - Exported: + METHOD generate + METHOD currentEntity - Method generate - Method currentEntity - -Endclass +ENDCLASS ///// -Method emitHeader Class HBProfileReportToTBrowse +METHOD emitHeader CLASS HBProfileReportToTBrowse // No header required. -Return Self + RETURN Self -///// - -Method emitLine( oEntity ) Class HBProfileReportToTBrowse +METHOD emitLine( oEntity ) CLASS HBProfileReportToTBrowse // Don't "emit" anything, simply add the entity to the array. AAdd( ::aReport, oEntity ) -Return Self + RETURN Self -///// - -Method generate( bFilter, nTop, nLeft, nBottom, nRight ) Class HBProfileReportToTBrowse -Local lProfile := __setProfiler( .F. ) -Local oBrowse +METHOD generate( bFilter, nTop, nLeft, nBottom, nRight ) CLASS HBProfileReportToTBrowse + LOCAL lProfile := __setProfiler( .F. ) + LOCAL oBrowse // Start with the first entity. ::nEntity := 1 @@ -835,11 +769,9 @@ Local oBrowse __setProfiler( lProfile ) -Return oBrowse + RETURN oBrowse -///// - -Method addColumns( oBrowse ) Class HBProfileReportToTBrowse +METHOD addColumns( oBrowse ) CLASS HBProfileReportToTBrowse oBrowse:addColumn( TBColumnNew( "Name", {|| PadR( ::currentEntity():cName, 35 ) } ) ) oBrowse:addColumn( TBColumnNew( "Type", {|| PadR( ::currentEntity():describe(), 8 ) } ) ) @@ -849,13 +781,7 @@ Method addColumns( oBrowse ) Class HBProfileReportToTBrowse oBrowse:addColumn( TBColumnNew( "Mean;Ticks", {|| Str( ::currentEntity():nMeanTicks, 11, 2 ) } ) ) oBrowse:addColumn( TBColumnNew( "Mean;Seconds", {|| Str( ::currentEntity():nMeanSeconds, 11, 2 ) } ) ) -Return Self + RETURN Self -///// - -Method currentEntity Class HBProfileReportToTBrowse -Return ::aReport[ ::nEntity ] - -/* - * profiler.prg ends here. - */ +METHOD currentEntity CLASS HBProfileReportToTBrowse + RETURN ::aReport[ ::nEntity ] diff --git a/harbour/source/rtl/readvar.prg b/harbour/source/rtl/readvar.prg index 8cb0260262..45cd92919b 100644 --- a/harbour/source/rtl/readvar.prg +++ b/harbour/source/rtl/readvar.prg @@ -68,4 +68,4 @@ FUNCTION ReadVar( cVarName ) s_cVarName := cVarName ENDIF -RETURN cOldVarName + RETURN cOldVarName diff --git a/harbour/source/rtl/setfunc.prg b/harbour/source/rtl/setfunc.prg index db41ee81af..01e4765905 100644 --- a/harbour/source/rtl/setfunc.prg +++ b/harbour/source/rtl/setfunc.prg @@ -77,4 +77,4 @@ PROCEDURE __SetFunction( nFunctionKey, xKeySeq ) SetKey( nFunctionKey, NIL ) ENDIF -RETURN + RETURN diff --git a/harbour/source/rtl/setta.prg b/harbour/source/rtl/setta.prg index f99f50aa0d..170155e5b5 100644 --- a/harbour/source/rtl/setta.prg +++ b/harbour/source/rtl/setta.prg @@ -56,4 +56,3 @@ FUNCTION SetTypeahead( nSize ) RETURN Set( _SET_TYPEAHEAD, nSize ) #endif - diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index 4843ed9d31..9cd0563af1 100644 --- a/harbour/source/rtl/tclass.prg +++ b/harbour/source/rtl/tclass.prg @@ -71,7 +71,7 @@ * */ -// Harbour Class HBClass to build classes +/* Harbour Class HBClass to build classes */ #include "common.ch" #include "hboo.ch" @@ -144,8 +144,6 @@ FUNCTION HBClass() RETURN __clsInst( s_hClass ) -//----------------------------------------------------------------------------// - // xSuper is used here as the new preprocessor file (hbclass.ch) send here // always an array (if no superclass, this will be an empty one) // In case of direct class creation (without the help of preprocessor) xSuper can be @@ -194,9 +192,7 @@ STATIC FUNCTION New( cClassName, xSuper, sClassFunc, lModuleFriendly ) RETURN QSelf() -//----------------------------------------------------------------------------// - -/* STATIC PROCEDURE Create(MetaClass) */ +/* STATIC PROCEDURE Create( MetaClass ) */ STATIC PROCEDURE Create() LOCAL Self := QSelf() @@ -292,8 +288,6 @@ STATIC PROCEDURE Create() RETURN -//----------------------------------------------------------------------------// - STATIC FUNCTION Instance() LOCAL Self := QSelf() LOCAL oInstance := __clsInst( ::hClass ) @@ -302,8 +296,6 @@ STATIC FUNCTION Instance() RETURN oInstance -//----------------------------------------------------------------------------// - STATIC PROCEDURE AddData( cData, xInit, cType, nScope, lNoinit ) LOCAL c @@ -327,8 +319,6 @@ STATIC PROCEDURE AddData( cData, xInit, cType, nScope, lNoinit ) RETURN -//----------------------------------------------------------------------------// - STATIC PROCEDURE AddMultiData( cType, xInit, nScope, aData, lNoInit ) LOCAL i @@ -342,8 +332,6 @@ STATIC PROCEDURE AddMultiData( cType, xInit, nScope, aData, lNoInit ) RETURN -//----------------------------------------------------------------------------// - STATIC PROCEDURE AddClassData( cData, xInit, cType, nScope, lNoInit ) LOCAL c @@ -366,8 +354,6 @@ STATIC PROCEDURE AddClassData( cData, xInit, cType, nScope, lNoInit ) RETURN -//----------------------------------------------------------------------------// - STATIC PROCEDURE AddMultiClsData( cType, xInit, nScope, aData, lNoInit ) LOCAL i @@ -381,8 +367,6 @@ STATIC PROCEDURE AddMultiClsData( cType, xInit, nScope, aData, lNoInit ) RETURN -//----------------------------------------------------------------------------// - STATIC PROCEDURE AddInline( cMethod, bCode, nScope ) DEFAULT nScope TO HB_OO_CLSTP_EXPORTED @@ -391,8 +375,6 @@ STATIC PROCEDURE AddInline( cMethod, bCode, nScope ) RETURN -//----------------------------------------------------------------------------// - STATIC PROCEDURE AddMethod( cMethod, nFuncPtr, nScope ) DEFAULT nScope TO HB_OO_CLSTP_EXPORTED @@ -401,16 +383,12 @@ STATIC PROCEDURE AddMethod( cMethod, nFuncPtr, nScope ) RETURN -//----------------------------------------------------------------------------// - STATIC PROCEDURE AddClsMethod( cMethod, nFuncPtr, nScope ) AAdd( QSelf():aClsMethods, { cMethod, nFuncPtr, nScope } ) RETURN -//----------------------------------------------------------------------------// - STATIC PROCEDURE AddVirtual( cMethod ) AAdd( QSelf():aVirtuals, cMethod ) @@ -431,8 +409,6 @@ STATIC PROCEDURE AddDelegate( xMethod, nAccScope, nAsgScope, cType, cDelegMsg, c RETURN -//----------------------------------------------------------------------------// - STATIC PROCEDURE AddFriendClass( ... ) LOCAL Self := QSelf() @@ -441,8 +417,6 @@ STATIC PROCEDURE AddFriendClass( ... ) RETURN -//----------------------------------------------------------------------------// - STATIC PROCEDURE AddFriendFunc( ... ) LOCAL Self := QSelf() @@ -451,8 +425,6 @@ STATIC PROCEDURE AddFriendFunc( ... ) RETURN -//----------------------------------------------------------------------------// - STATIC PROCEDURE SetOnError( nFuncPtr ) QSelf():nOnError := nFuncPtr @@ -465,10 +437,5 @@ STATIC PROCEDURE SetDestructor( nFuncPtr ) RETURN -//----------------------------------------------------------------------------// - STATIC FUNCTION InitClass() - RETURN QSelf() - -//----------------------------------------------------------------------------// diff --git a/harbour/source/rtl/tgetint.prg b/harbour/source/rtl/tgetint.prg index 7a11438799..88e40d4cdb 100644 --- a/harbour/source/rtl/tgetint.prg +++ b/harbour/source/rtl/tgetint.prg @@ -62,13 +62,9 @@ REQUEST HB_PVALUE REQUEST PCOUNT -//---------------------------------------------------------------------------// - FUNCTION GetNew( nRow, nCol, bVarBlock, cVarName, cPicture, cColor ) RETURN Get():New( nRow, nCol, bVarBlock, cVarName, cPicture, cColor ) -//---------------------------------------------------------------------------// - FUNCTION __GET( bSetGet, cVarName, cPicture, bValid, bWhen ) LOCAL oGet diff --git a/harbour/source/rtl/tlabel.prg b/harbour/source/rtl/tlabel.prg index 856d49c1ff..42a5127bf4 100644 --- a/harbour/source/rtl/tlabel.prg +++ b/harbour/source/rtl/tlabel.prg @@ -173,11 +173,11 @@ METHOD New( cLBLName, lPrinter, cAltFile, lNoConsole, bFor, ; // Add to the left margin if a SET MARGIN has been defined ::aLabelData[ LBL_LMARGIN ] := ::aLabelData[ LBL_LMARGIN ] + OldMargin - ASIZE( ::aBandToPrint, LEN( ::aLabelData[ LBL_FIELDS ])) - AFILL( ::aBandToPrint, SPACE( ::aLabelData[ LBL_LMARGIN ] ) ) + ASize( ::aBandToPrint, Len( ::aLabelData[ LBL_FIELDS ])) + AFill( ::aBandToPrint, Space( ::aLabelData[ LBL_LMARGIN ] ) ) // Create enough space for a blank record - ::cBlank := SPACE( ::aLabelData[ LBL_WIDTH ] + ::aLabelData[ LBL_SPACES ] ) + ::cBlank := Space( ::aLabelData[ LBL_WIDTH ] + ::aLabelData[ LBL_SPACES ] ) // Handle sample labels IF lSample @@ -228,7 +228,7 @@ METHOD ExecuteLabel() CLASS HBLabelForm LOCAL v // Load the current record into aBuffer - FOR nField := 1 TO LEN( ::aLabelData[ LBL_FIELDS ] ) + FOR nField := 1 TO Len( ::aLabelData[ LBL_FIELDS ] ) if ::aLabelData[ LBL_FIELDS, nField ] != NIL @@ -239,24 +239,24 @@ METHOD ExecuteLabel() CLASS HBLabelForm if ( ::aLabelData[ LBL_FIELDS, nField, LF_BLANK ] ) if ( !Empty( cBuffer ) ) - AADD( aBuffer, cBuffer ) + AAdd( aBuffer, cBuffer ) endif else - AADD( aBuffer, cBuffer ) + AAdd( aBuffer, cBuffer ) endif else - AADD( aBuffer, NIL ) + AAdd( aBuffer, NIL ) endif NEXT - ASIZE( aBuffer, LEN( ::aLabelData[ LBL_FIELDS ] ) ) + ASize( aBuffer, Len( ::aLabelData[ LBL_FIELDS ] ) ) // Add aBuffer to ::aBandToPrint - FOR nField := 1 TO LEN( ::aLabelData[ LBL_FIELDS ] ) + FOR nField := 1 TO Len( ::aLabelData[ LBL_FIELDS ] ) IF aBuffer[ nField ] == NIL ::aBandToPrint[ nField ] := ::aBandToPrint[ nField ] + ::cBlank ELSE @@ -267,7 +267,7 @@ METHOD ExecuteLabel() CLASS HBLabelForm IF ::nCurrentCol == ::aLabelData[ LBL_ACROSS ] // trim - FOR nField := 1 TO LEN( ::aBandToPrint ) + FOR nField := 1 TO Len( ::aBandToPrint ) ::aBandToPrint[ nField ] := Trim( ::aBandToPrint[ nField ] ) NEXT @@ -278,7 +278,7 @@ METHOD ExecuteLabel() CLASS HBLabelForm // Print the band AEVAL( ::aBandToPrint, { | BandLine | PrintIt( BandLine ) } ) - nMoreLines := ::aLabelData[ LBL_HEIGHT ] - LEN( ::aBandToPrint ) + nMoreLines := ::aLabelData[ LBL_HEIGHT ] - Len( ::aBandToPrint ) IF nMoreLines > 0 FOR nField := 1 TO nMoreLines PrintIt() @@ -294,7 +294,7 @@ METHOD ExecuteLabel() CLASS HBLabelForm ENDIF // Clear out the band - AFILL( ::aBandToPrint, SPACE( ::aLabelData[ LBL_LMARGIN ] ) ) + AFill( ::aBandToPrint, Space( ::aLabelData[ LBL_LMARGIN ] ) ) ELSE ::lOneMoreBand := .T. ::nCurrentCol := ::nCurrentCol + 1 @@ -307,11 +307,11 @@ METHOD SampleLabels() CLASS HBLabelForm LOCAL aBand := {} // Create the sample label row - ASIZE( aBand, ::aLabelData[ LBL_HEIGHT ] ) - AFILL( aBand, SPACE( ::aLabelData[ LBL_LMARGIN ] ) +; - REPLICATE( REPLICATE( "*", ; + ASize( aBand, ::aLabelData[ LBL_HEIGHT ] ) + AFill( aBand, Space( ::aLabelData[ LBL_LMARGIN ] ) +; + Replicate( Replicate( "*", ; ::aLabelData[ LBL_WIDTH ] ) + ; - SPACE( ::aLabelData[ LBL_SPACES ] ), ; + Space( ::aLabelData[ LBL_SPACES ] ), ; ::aLabelData[ LBL_ACROSS ] ) ) // Prints sample labels @@ -329,7 +329,7 @@ METHOD SampleLabels() CLASS HBLabelForm // Prompt for more @ ROW(), 0 SAY __NatMsg(_LF_SAMPLES)+" ("+__NatMsg(_LF_YN)+")" - nGetKey := INKEY(0) + nGetKey := Inkey( 0 ) @ ROW(), COL() SAY CHR(nGetKey) IF ROW() == MAXROW() SCROLL( 0, 0, MAXROW(), MAXCOL(), 1 ) @@ -346,7 +346,7 @@ METHOD SampleLabels() CLASS HBLabelForm METHOD LoadLabel( cLblFile ) CLASS HBLabelForm LOCAL i, j := 0 // Counters - LOCAL cBuff := SPACE(BUFFSIZE) // File buffer + LOCAL cBuff := Space(BUFFSIZE) // File buffer LOCAL nHandle := 0 // File handle LOCAL nReadCount := 0 // Bytes read from file LOCAL lStatus := .F. // Status @@ -361,7 +361,7 @@ METHOD LoadLabel( cLblFile ) CLASS HBLabelForm // Create and initialize default label array LOCAL aLabel[ LBL_COUNT ] - aLabel[ LBL_REMARK ] := SPACE(60) // Label remark + aLabel[ LBL_REMARK ] := Space( 60 ) // Label remark aLabel[ LBL_HEIGHT ] := 5 // Label height aLabel[ LBL_WIDTH ] := 35 // Label width aLabel[ LBL_LMARGIN ] := 0 // Left margin @@ -373,17 +373,17 @@ METHOD LoadLabel( cLblFile ) CLASS HBLabelForm // Open the label file nHandle := FOPEN( cLblFile ) - IF ! EMPTY( nFileError := FERROR() ) .AND. !( "\" $ cLblFile .OR. ":" $ cLblFile ) + IF ! Empty( nFileError := FERROR() ) .AND. !( "\" $ cLblFile .OR. ":" $ cLblFile ) // Search through default path; attempt to open label file cDefPath := SET( _SET_DEFAULT ) cDefPath := STRTRAN( cDefPath, ",", ";" ) aPaths := ListAsArray( cDefPath, ";" ) - FOR nPathIndex := 1 TO LEN( aPaths ) + FOR nPathIndex := 1 TO Len( aPaths ) nHandle := FOPEN( aPaths[ nPathIndex ] + "\" + cLblFile ) // if no error is reported, we have our label file - IF EMPTY( nFileError := FERROR() ) + IF Empty( nFileError := FERROR() ) EXIT ENDIF @@ -417,36 +417,36 @@ METHOD LoadLabel( cLblFile ) CLASS HBLabelForm IF nFileError == 0 // Load label dimension into aLabel - aLabel[ LBL_REMARK ] := SUBSTR(cBuff, REMARKOFFSET, REMARKSIZE) - aLabel[ LBL_HEIGHT ] := BIN2W(SUBSTR(cBuff, HEIGHTOFFSET, HEIGHTSIZE)) - aLabel[ LBL_WIDTH ] := BIN2W(SUBSTR(cBuff, WIDTHOFFSET, WIDTHSIZE)) - aLabel[ LBL_LMARGIN] := BIN2W(SUBSTR(cBuff, LMARGINOFFSET, LMARGINSIZE)) - aLabel[ LBL_LINES ] := BIN2W(SUBSTR(cBuff, LINESOFFSET, LINESSIZE)) - aLabel[ LBL_SPACES ] := BIN2W(SUBSTR(cBuff, SPACESOFFSET, SPACESSIZE)) - aLabel[ LBL_ACROSS ] := BIN2W(SUBSTR(cBuff, ACROSSOFFSET, ACROSSSIZE)) + aLabel[ LBL_REMARK ] := SubStr(cBuff, REMARKOFFSET, REMARKSIZE) + aLabel[ LBL_HEIGHT ] := BIN2W(SubStr(cBuff, HEIGHTOFFSET, HEIGHTSIZE)) + aLabel[ LBL_WIDTH ] := BIN2W(SubStr(cBuff, WIDTHOFFSET, WIDTHSIZE)) + aLabel[ LBL_LMARGIN] := BIN2W(SubStr(cBuff, LMARGINOFFSET, LMARGINSIZE)) + aLabel[ LBL_LINES ] := BIN2W(SubStr(cBuff, LINESOFFSET, LINESSIZE)) + aLabel[ LBL_SPACES ] := BIN2W(SubStr(cBuff, SPACESOFFSET, SPACESSIZE)) + aLabel[ LBL_ACROSS ] := BIN2W(SubStr(cBuff, ACROSSOFFSET, ACROSSSIZE)) FOR i := 1 TO aLabel[ LBL_HEIGHT ] // Get the text of the expression - cFieldText := TRIM( SUBSTR( cBuff, nOffset, FIELDSIZE ) ) + cFieldText := TRIM( SubStr( cBuff, nOffset, FIELDSIZE ) ) nOffset :=nOffSet + 60 - IF !EMPTY( cFieldText ) + IF !Empty( cFieldText ) - AADD( aLabel[ LBL_FIELDS ], {} ) + AAdd( aLabel[ LBL_FIELDS ], {} ) // Field expression - AADD( aLabel[ LBL_FIELDS, i ], &( "{ || " + cFieldText + "}" ) ) + AAdd( aLabel[ LBL_FIELDS, i ], &( "{ || " + cFieldText + "}" ) ) // Text of field - AADD( aLabel[ LBL_FIELDS, i ], cFieldText ) + AAdd( aLabel[ LBL_FIELDS, i ], cFieldText ) // Compression option - AADD( aLabel[ LBL_FIELDS, i ], .T. ) + AAdd( aLabel[ LBL_FIELDS, i ], .T. ) ELSE - AADD( aLabel[ LBL_FIELDS ], NIL ) + AAdd( aLabel[ LBL_FIELDS ], NIL ) ENDIF @@ -484,28 +484,28 @@ STATIC FUNCTION ListAsArray( cList, cDelimiter ) DEFAULT cDelimiter TO "," - DO WHILE LEN(cList) != 0 + DO WHILE Len( cList ) != 0 - nPos := AT(cDelimiter, cList) + nPos := AT( cDelimiter, cList ) IF nPos == 0 - nPos := LEN(cList) + nPos := Len( cList ) ENDIF - IF SUBSTR( cList, nPos, 1 ) == cDelimiter + IF SubStr( cList, nPos, 1 ) == cDelimiter lDelimLast := .T. - AADD(aList, SUBSTR(cList, 1, nPos - 1)) // Add a new element + AAdd(aList, SubStr( cList, 1, nPos - 1 ) ) // Add a new element ELSE lDelimLast := .F. - AADD(aList, SUBSTR(cList, 1, nPos)) // Add a new element + AAdd(aList, SubStr( cList, 1, nPos ) ) // Add a new element ENDIF - cList := SUBSTR(cList, nPos + 1) + cList := SubStr( cList, nPos + 1 ) ENDDO IF lDelimLast - AADD(aList, "") + AAdd( aList, "" ) ENDIF RETURN aList // Return the array diff --git a/harbour/source/rtl/treport.prg b/harbour/source/rtl/treport.prg index 628d2d25bd..4c58164332 100644 --- a/harbour/source/rtl/treport.prg +++ b/harbour/source/rtl/treport.prg @@ -207,10 +207,10 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco err:severity := ES_ERROR err:genCode := EG_ARG err:subSystem := "FRMLBL" - Eval(ErrorBlock(), err) + Eval( ErrorBlock(), err ) ELSE /* NOTE: CA-Cl*pper does an RTrim() on the filename here, - but in Harbour we're using _SET_TRIMFILENAME. [vszakats] */ + but in Harbour we're using _SET_TRIMFILENAME. */ IF Set( _SET_DEFEXTENSIONS ) hb_FNameSplit( cFRMName, NIL, NIL, @cExt ) IF Empty( cExt ) @@ -228,7 +228,7 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco lPrintOn := iif( lPrinter, SET( _SET_PRINTER, lPrinter ), SET( _SET_PRINTER ) ) - lConsoleOn := iif( lNoConsole, SET( _SET_CONSOLE, .F.), SET( _SET_CONSOLE ) ) + lConsoleOn := iif( lNoConsole, SET( _SET_CONSOLE, .F. ), SET( _SET_CONSOLE ) ) IF lPrinter // To the printer ::lFormFeeds := .T. @@ -275,7 +275,6 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco // Check to see if a "before report" eject, or TO FILE has been specified IF ::aReportData[ RPT_BEJECT ] ::EjectPage() - ENDIF // Generate the initial report header manually (in case there are no @@ -285,32 +284,32 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco // Initialize ::aReportTotals to track both group and report totals, then // set the column total elements to 0 if they are to be totaled, otherwise // leave them NIL - ::aReportTotals := ARRAY( LEN(::aReportData[RPT_GROUPS]) + 1, ; - LEN(::aReportData[RPT_COLUMNS]) ) + ::aReportTotals := ARRAY( Len( ::aReportData[RPT_GROUPS] ) + 1, ; + Len( ::aReportData[RPT_COLUMNS] ) ) // Column total elements - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) - IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] - FOR nGroup := 1 TO LEN(::aReportTotals) - ::aReportTotals[nGroup,nCol] := 0 + FOR nCol := 1 TO Len( ::aReportData[ RPT_COLUMNS ] ) + IF ::aReportData[ RPT_COLUMNS, nCol, RCT_TOTAL ] + FOR nGroup := 1 TO Len( ::aReportTotals ) + ::aReportTotals[ nGroup, nCol ] := 0 NEXT ENDIF NEXT // Initialize ::aGroupTotals as an array - ::aGroupTotals := ARRAY( LEN(::aReportData[RPT_GROUPS]) ) + ::aGroupTotals := ARRAY( Len(::aReportData[RPT_GROUPS]) ) // Execute the actual report based on matching records DBEval( { || ::ExecuteReport() }, bFor, bWhile, nNext, nRecord, lRest ) // Generate any totals that may have been identified // Make a pass through all the groups - FOR nGroup := LEN(::aReportData[RPT_GROUPS]) TO 1 STEP -1 + FOR nGroup := Len(::aReportData[RPT_GROUPS]) TO 1 STEP -1 // make sure group has subtotals lAnySubTotals := .F. - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) + FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS]) IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] lAnySubTotals := .T. EXIT // NOTE @@ -333,13 +332,13 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco ENDIF // Print the first line - ::PrintIt( SPACE( ::aReportData[RPT_LMARGIN] ) + ; + ::PrintIt( Space( ::aReportData[RPT_LMARGIN] ) + ; iif( nGroup == 1, __NatMsg( _RFRM_SUBTOTAL ),; __NatMsg( _RFRM_SUBSUBTOTAL ) ) ) // Print the second line - QQOUT( SPACE(::aReportData[RPT_LMARGIN]) ) - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) + QQOUT( Space(::aReportData[RPT_LMARGIN]) ) + FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS]) IF nCol > 1 QQOUT( " " ) ENDIF @@ -347,7 +346,7 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco QQOUT( TRANSFORM(::aReportTotals[nGroup+1,nCol], ; ::aReportData[RPT_COLUMNS,nCol,RCT_PICT]) ) ELSE - QQOUT( SPACE(::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH]) ) + QQOUT( Space(::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH]) ) ENDIF NEXT @@ -358,7 +357,7 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco // Any report totals? lAnyTotals := .F. - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) + FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS]) IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] lAnyTotals := .T. EXIT @@ -379,11 +378,11 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco ENDIF // Print the first line - ::PrintIt( SPACE(::aReportData[RPT_LMARGIN]) + __NatMsg(_RFRM_TOTAL ) ) + ::PrintIt( Space(::aReportData[RPT_LMARGIN]) + __NatMsg(_RFRM_TOTAL ) ) // Print the second line - QQOUT( SPACE(::aReportData[RPT_LMARGIN]) ) - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) + QQOUT( Space(::aReportData[RPT_LMARGIN]) ) + FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS]) IF nCol > 1 QQOUT( " " ) ENDIF @@ -391,7 +390,7 @@ METHOD New( cFrmName, lPrinter, cAltFile, lNoConsole, bFor, bWhile, nNext, nReco QQOUT( TRANSFORM(::aReportTotals[1,nCol], ; ::aReportData[RPT_COLUMNS,nCol,RCT_PICT]) ) ELSE - QQOUT( SPACE(::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH]) ) + QQOUT( Space(::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH]) ) ENDIF NEXT nCol @@ -471,18 +470,18 @@ METHOD ReportHeader() CLASS HBReportForm IF !::aReportData[RPT_PLAIN] IF ::aReportData[RPT_HEADING] == "" - AADD( aPageHeader,__NatMsg(_RFRM_PAGENO) + STR(::nPageNumber,6)) + AAdd( aPageHeader,__NatMsg(_RFRM_PAGENO) + STR(::nPageNumber,6)) ELSE aTempPgHeader:=ParseHeader( ::aReportData[RPT_HEADING],; Occurs(";",::aReportData[RPT_HEADING]) +1 ) - FOR nLine := 1 to LEN( aTempPgHeader) + FOR nLine := 1 to Len( aTempPgHeader) nLinesInHeader:=MAX( XMLCOUNT( LTRIM( aTempPgHeader[ nLine ] ) , ; nHeadingLength),1) FOR nHeadLine := 1 to nLinesInHeader - AADD( aPageHeader, SPACE( 15 ) + ; + AAdd( aPageHeader, Space( 15 ) + ; PADC( TRIM( XMEMOLINE( LTRIM( aTempPgHeader[ nLine ]),; nHeadingLength,nHeadLine)), nHeadingLength)) @@ -492,10 +491,10 @@ METHOD ReportHeader() CLASS HBReportForm __NatMsg(_RFRM_PAGENO)+STR(::nPageNumber,6)) ENDIF - AADD( aPageHeader, DTOC(DATE()) ) + AAdd( aPageHeader, DTOC(DATE()) ) ENDIF - FOR nLine := 1 TO LEN( ::aReportData[ RPT_HEADER]) + FOR nLine := 1 TO Len( ::aReportData[ RPT_HEADER]) nLinesInHeader := MAX( XMLCOUNT(LTRIM( ::aReportData[RPT_HEADER,; nLine ] ), nHeadSize),1 ) @@ -503,34 +502,34 @@ METHOD ReportHeader() CLASS HBReportForm cHeader:=TRIM( XMEMOLINE( LTRIM( ::aReportData[RPT_HEADER, nLine ]),; nHeadSize,nHeadLine)) - AADD( aPageHeader, SPACE((nRPageSize - ::aReportData[ RPT_LMARGIN ] -; - LEN( cHeader ) ) / 2 ) + cHeader ) + AAdd( aPageHeader, Space((nRPageSize - ::aReportData[ RPT_LMARGIN ] -; + Len( cHeader ) ) / 2 ) + cHeader ) NEXT nHeadLine NEXT nLine - nLinesInHeader := LEN( aPageHeader) + nLinesInHeader := Len( aPageHeader) nMaxColLength :=0 - FOR nCol := 1 TO LEN( ::aReportData[RPT_COLUMNS] ) - nMaxColLength := MAX(LEN(::aReportData[RPT_COLUMNS,nCol,RCT_HEADER]), ; + FOR nCol := 1 TO Len( ::aReportData[RPT_COLUMNS] ) + nMaxColLength := MAX(Len(::aReportData[RPT_COLUMNS,nCol,RCT_HEADER]), ; nMaxColLength) NEXT - FOR nCol := 1 to LEN( ::aReportData[RPT_COLUMNS] ) - ASIZE( ::aReportData[RPT_COLUMNS,nCol,RCT_HEADER] ,nMaxColLength) + FOR nCol := 1 to Len( ::aReportData[RPT_COLUMNS] ) + ASize( ::aReportData[RPT_COLUMNS,nCol,RCT_HEADER] ,nMaxColLength) NEXT FOR nLine:=1 TO nMaxColLength - AADD( aPageHeader, "") + AAdd( aPageHeader, "") NEXT - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) // Cycle through the columns + FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS]) // Cycle through the columns FOR nLine := 1 TO nMaxColLength IF nCol > 1 aPageHeader[ nLinesInHeader + nLine ] += " " ENDIF IF ::aReportData[RPT_COLUMNS,nCol,RCT_HEADER,nLine] == NIL aPageHeader[ nLinesInHeader + nLine ] += ; - SPACE( ::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH] ) + Space( ::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH] ) ELSE IF ::aReportData[RPT_COLUMNS,nCol,RCT_TYPE] == "N" aPageHeader[ nLinesInHeader + nLine ] += ; @@ -546,17 +545,17 @@ METHOD ReportHeader() CLASS HBReportForm NEXT // Insert the two blank lines between the heading and the actual data - AADD( aPageHeader, "" ) - AADD( aPageHeader, "" ) + AAdd( aPageHeader, "" ) + AAdd( aPageHeader, "" ) AEVAL( aPageHeader, { | HeaderLine | ; - ::PrintIt( SPACE(::aReportData[RPT_LMARGIN])+ HeaderLine ) } ) + ::PrintIt( Space(::aReportData[RPT_LMARGIN])+ HeaderLine ) } ) // Set the page number and number of available lines ::nPageNumber++ // adjust the line count to account for Summer '87 behavior - ::nLinesLeft := ::aReportData[RPT_LINES] - LEN( aPageHeader ) - ::nMaxLinesAvail := ::aReportData[RPT_LINES] - LEN( aPageHeader ) + ::nLinesLeft := ::aReportData[RPT_LINES] - Len( aPageHeader ) + ::nMaxLinesAvail := ::aReportData[RPT_LINES] - Len( aPageHeader ) RETURN SELF @@ -575,7 +574,7 @@ METHOD ExecuteReport() CLASS HBReportForm LOCAL lAnySubTotals // Add to the main column totals - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) + FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS]) IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] // If this column should be totaled, do it ::aReportTotals[ 1 ,nCol] += ; @@ -588,12 +587,12 @@ METHOD ExecuteReport() CLASS HBReportForm IF !::lFirstPass // Don't bother first time through // Make a pass through all the groups - FOR nGroup := LEN(::aReportData[RPT_GROUPS]) TO 1 STEP -1 + FOR nGroup := Len(::aReportData[RPT_GROUPS]) TO 1 STEP -1 // make sure group has subtotals lAnySubTotals := .F. - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) + FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS]) IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] lAnySubTotals := .T. EXIT // NOTE @@ -619,39 +618,39 @@ METHOD ExecuteReport() CLASS HBReportForm IF lGroupChanged .OR. MakeAStr(EVAL(::aReportData[RPT_GROUPS,nGroup,RGT_EXP]),; ::aReportData[RPT_GROUPS,nGroup,RGT_TYPE]) != ::aGroupTotals[nGroup] - AADD( aRecordHeader, iif( nGroup == 1, __NatMsg(_RFRM_SUBTOTAL),; + AAdd( aRecordHeader, iif( nGroup == 1, __NatMsg(_RFRM_SUBTOTAL),; __NatMsg(_RFRM_SUBSUBTOTAL) ) ) - AADD( aRecordHeader, "" ) + AAdd( aRecordHeader, "" ) // Cycle through the columns, adding either the group // amount from ::aReportTotals or spaces wide enough for // the non-totaled columns - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) + FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS]) IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] - aRecordHeader[ LEN(aRecordHeader) ] += ; + aRecordHeader[ Len(aRecordHeader) ] += ; TRANSFORM(::aReportTotals[nGroup+1,nCol], ; ::aReportData[RPT_COLUMNS,nCol,RCT_PICT]) // Zero out the group totals column from aReportTotals ::aReportTotals[nGroup+1,nCol] := 0 ELSE - aRecordHeader[ LEN(aRecordHeader) ] += ; - SPACE(::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH]) + aRecordHeader[ Len(aRecordHeader) ] += ; + Space(::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH]) ENDIF - aRecordHeader[ LEN(aRecordHeader) ] += " " + aRecordHeader[ Len(aRecordHeader) ] += " " NEXT // Get rid of the extra space from the last column - aRecordHeader[LEN(aRecordHeader)] := ; - LEFT( aRecordHeader[LEN(aRecordHeader)], ; - LEN(aRecordHeader[LEN(aRecordHeader)]) - 1 ) + aRecordHeader[Len(aRecordHeader)] := ; + LEFT( aRecordHeader[Len(aRecordHeader)], ; + Len(aRecordHeader[Len(aRecordHeader)]) - 1 ) ENDIF NEXT ENDIF - IF LEN( aRecordHeader ) > 0 .AND. lEjectGrp .AND. lGroupChanged - IF LEN( aRecordHeader ) > ::nLinesLeft + IF Len( aRecordHeader ) > 0 .AND. lEjectGrp .AND. lGroupChanged + IF Len( aRecordHeader ) > ::nLinesLeft ::EjectPage() IF ::aReportData[ RPT_PLAIN ] @@ -663,7 +662,7 @@ METHOD ExecuteReport() CLASS HBReportForm ENDIF AEVAL( aRecordHeader, { | HeaderLine | ; - ::PrintIt( SPACE( ::aReportData[ RPT_LMARGIN ] ) + HeaderLine ) } ) + ::PrintIt( Space( ::aReportData[ RPT_LMARGIN ] ) + HeaderLine ) } ) aRecordHeader := {} @@ -683,12 +682,12 @@ METHOD ExecuteReport() CLASS HBReportForm // new group headers need to be generated // Cycle through the groups - FOR nGroup := 1 TO LEN(::aReportData[RPT_GROUPS]) + FOR nGroup := 1 TO Len(::aReportData[RPT_GROUPS]) // If the group has changed IF MakeAStr(EVAL(::aReportData[RPT_GROUPS,nGroup,RGT_EXP]),; ::aReportData[RPT_GROUPS,nGroup,RGT_TYPE]) == ::aGroupTotals[nGroup] ELSE - AADD( aRecordHeader, "" ) // The blank line + AAdd( aRecordHeader, "" ) // The blank line // page eject after group @@ -700,7 +699,7 @@ METHOD ExecuteReport() CLASS HBReportForm ENDIF - AADD( aRecordHeader, iif( nGroup == 1, "** ", "* " ) +; + AAdd( aRecordHeader, iif( nGroup == 1, "** ", "* " ) +; ::aReportData[RPT_GROUPS,nGroup,RGT_HEADER] + " " +; MakeAStr(EVAL(::aReportData[RPT_GROUPS,nGroup,RGT_EXP]), ; ::aReportData[RPT_GROUPS,nGroup,RGT_TYPE]) ) @@ -710,10 +709,10 @@ METHOD ExecuteReport() CLASS HBReportForm ::lFirstPass := .F. // Is there anything in the record header? - IF LEN( aRecordHeader ) > 0 + IF Len( aRecordHeader ) > 0 // Determine if aRecordHeader will fit on the current page. If not, // start a new header - IF LEN( aRecordHeader ) > ::nLinesLeft + IF Len( aRecordHeader ) > ::nLinesLeft ::EjectPage() IF ::aReportData[ RPT_PLAIN ] ::nLinesLeft := 1000 @@ -724,9 +723,9 @@ METHOD ExecuteReport() CLASS HBReportForm // Send aRecordHeader to the output device, resetting nLinesLeft AEVAL( aRecordHeader, { | HeaderLine | ; - ::PrintIt( SPACE(::aReportData[RPT_LMARGIN])+ HeaderLine ) } ) + ::PrintIt( Space(::aReportData[RPT_LMARGIN])+ HeaderLine ) } ) - ::nLinesLeft -= LEN( aRecordHeader ) + ::nLinesLeft -= Len( aRecordHeader ) // Make sure it didn't hit the bottom margin IF ::nLinesLeft == 0 @@ -740,11 +739,11 @@ METHOD ExecuteReport() CLASS HBReportForm ENDIF // Add to the group totals - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) + FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS]) // If this column should be totaled, do it IF ::aReportData[RPT_COLUMNS,nCol,RCT_TOTAL] // Cycle through the groups - FOR nGroup := 1 TO LEN( ::aReportTotals ) - 1 + FOR nGroup := 1 TO Len( ::aReportTotals ) - 1 ::aReportTotals[nGroup+1,nCol] += ; EVAL( ::aReportData[RPT_COLUMNS,nCol,RCT_EXP] ) NEXT @@ -752,7 +751,7 @@ METHOD ExecuteReport() CLASS HBReportForm NEXT // Reset the group expressions in aGroupTotals - FOR nGroup := 1 TO LEN(::aReportData[RPT_GROUPS]) + FOR nGroup := 1 TO Len(::aReportData[RPT_GROUPS]) ::aGroupTotals[nGroup] := MakeAStr(EVAL(::aReportData[RPT_GROUPS,nGroup,RGT_EXP]),; ::aReportData[RPT_GROUPS,nGroup,RGT_TYPE]) NEXT @@ -761,7 +760,7 @@ METHOD ExecuteReport() CLASS HBReportForm IF !::aReportData[ RPT_SUMMARY ] // Determine the max number of lines needed by each expression nMaxLines := 1 - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) + FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS]) IF ::aReportData[RPT_COLUMNS,nCol,RCT_TYPE] $ "M" nMaxLines := MAX(XMLCOUNT(EVAL(::aReportData[RPT_COLUMNS,nCol,RCT_EXP]),; @@ -775,11 +774,11 @@ METHOD ExecuteReport() CLASS HBReportForm // Size aRecordToPrint to the maximum number of lines it will need, then // fill it with nulls - ASIZE( aRecordToPrint, nMaxLines ) - AFILL( aRecordToPrint, "" ) + ASize( aRecordToPrint, nMaxLines ) + AFill( aRecordToPrint, "" ) // Load the current record into aRecordToPrint - FOR nCol := 1 TO LEN(::aReportData[RPT_COLUMNS]) + FOR nCol := 1 TO Len(::aReportData[RPT_COLUMNS]) FOR nLine := 1 TO nMaxLines // Check to see if it's a memo or character IF ::aReportData[RPT_COLUMNS,nCol,RCT_TYPE] $ "CM" @@ -800,7 +799,7 @@ METHOD ExecuteReport() CLASS HBReportForm ::aReportData[RPT_COLUMNS,nCol,RCT_PICT]) cLine := PADR( cLine, ::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH] ) ELSE - cLine := SPACE( ::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH]) + cLine := Space( ::aReportData[RPT_COLUMNS,nCol,RCT_WIDTH]) ENDIF ENDIF // Add it to the existing report line @@ -812,14 +811,14 @@ METHOD ExecuteReport() CLASS HBReportForm NEXT // Determine if aRecordToPrint will fit on the current page - IF LEN( aRecordToPrint ) > ::nLinesLeft + IF Len( aRecordToPrint ) > ::nLinesLeft // The record will not fit on the current page - will it fit on // a full page? If not, break it up and print it. - IF LEN( aRecordToPrint ) > ::nMaxLinesAvail + IF Len( aRecordToPrint ) > ::nMaxLinesAvail // This record is HUGE! Break it up... nLine := 1 - DO WHILE nLine < LEN( aRecordToPrint ) - ::PrintIt( SPACE(::aReportData[RPT_LMARGIN]) + aRecordToPrint[nLine] ) + DO WHILE nLine < Len( aRecordToPrint ) + ::PrintIt( Space(::aReportData[RPT_LMARGIN]) + aRecordToPrint[nLine] ) nLine++ ::nLinesLeft-- IF ::nLinesLeft == 0 @@ -840,19 +839,19 @@ METHOD ExecuteReport() CLASS HBReportForm ENDIF AEVAL( aRecordToPrint, ; { | RecordLine | ; - ::PrintIt( SPACE(::aReportData[RPT_LMARGIN])+ RecordLine ) ; + ::PrintIt( Space(::aReportData[RPT_LMARGIN])+ RecordLine ) ; } ; ) - ::nLinesLeft -= LEN( aRecordToPrint ) + ::nLinesLeft -= Len( aRecordToPrint ) ENDIF ELSE // Send aRecordToPrint to the output device, resetting ::nLinesLeft AEVAL( aRecordToPrint, ; { | RecordLine | ; - ::PrintIt( SPACE(::aReportData[RPT_LMARGIN])+ RecordLine ) ; + ::PrintIt( Space(::aReportData[RPT_LMARGIN])+ RecordLine ) ; } ; ) - ::nLinesLeft -= LEN( aRecordToPrint ) + ::nLinesLeft -= Len( aRecordToPrint ) ENDIF @@ -877,9 +876,9 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm LOCAL cFieldsBuff LOCAL cParamsBuff LOCAL nFieldOffset := 0 - LOCAL cFileBuff := SPACE(SIZE_FILE_BUFF) - LOCAL cGroupExp := SPACE(200) - LOCAL cSubGroupExp := SPACE(200) + LOCAL cFileBuff := Space( SIZE_FILE_BUFF ) + LOCAL cGroupExp := Space( 200 ) + LOCAL cSubGroupExp := Space( 200 ) LOCAL nColCount := 0 // Number of columns in report LOCAL nCount LOCAL nFrmHandle // (.frm) file handle @@ -921,17 +920,17 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm // Open the report file nFrmHandle := FOPEN( cFrmFile ) - IF !EMPTY( nFileError := FERROR() ) .AND. !( "\" $ cFrmFile .OR. ":" $ cFrmFile ) + IF !Empty( nFileError := FERROR() ) .AND. !( "\" $ cFrmFile .OR. ":" $ cFrmFile ) // Search through default path; attempt to open report file cDefPath := SET( _SET_DEFAULT ) + ";" + SET( _SET_PATH ) cDefPath := STRTRAN( cDefPath, ",", ";" ) aPaths := ListAsArray( cDefPath, ";" ) - FOR nPathIndex := 1 TO LEN( aPaths ) + FOR nPathIndex := 1 TO Len( aPaths ) nFrmHandle := FOPEN( aPaths[ nPathIndex ] + "\" + cFrmFile ) // if no error is reported, we have our report file - IF EMPTY( nFileError := FERROR() ) + IF Empty( nFileError := FERROR() ) EXIT ENDIF @@ -974,8 +973,8 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm IF nFileError == F_OK // Is this a .FRM type file (2 at start and end of file) - IF BIN2W(SUBSTR(cFileBuff, 1, 2)) == 2 .AND.; - BIN2W(SUBSTR(cFileBuff, SIZE_FILE_BUFF - 1, 2)) == 2 + IF BIN2W(SubStr(cFileBuff, 1, 2)) == 2 .AND.; + BIN2W(SubStr(cFileBuff, SIZE_FILE_BUFF - 1, 2)) == 2 nFileError := F_OK ELSE @@ -997,39 +996,39 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm IF nFileError == F_OK // Fill processing buffers - ::cLengthsBuff := SUBSTR(cFileBuff, LENGTHS_OFFSET, SIZE_LENGTHS_BUFF) - ::cOffSetsBuff := SUBSTR(cFileBuff, OFFSETS_OFFSET, SIZE_OFFSETS_BUFF) - ::cExprBuff := SUBSTR(cFileBuff, EXPR_OFFSET, SIZE_EXPR_BUFF) - cFieldsBuff := SUBSTR(cFileBuff, FIELDS_OFFSET, SIZE_FIELDS_BUFF) - cParamsBuff := SUBSTR(cFileBuff, PARAMS_OFFSET, SIZE_PARAMS_BUFF) + ::cLengthsBuff := SubStr(cFileBuff, LENGTHS_OFFSET, SIZE_LENGTHS_BUFF) + ::cOffSetsBuff := SubStr(cFileBuff, OFFSETS_OFFSET, SIZE_OFFSETS_BUFF) + ::cExprBuff := SubStr(cFileBuff, EXPR_OFFSET, SIZE_EXPR_BUFF) + cFieldsBuff := SubStr(cFileBuff, FIELDS_OFFSET, SIZE_FIELDS_BUFF) + cParamsBuff := SubStr(cFileBuff, PARAMS_OFFSET, SIZE_PARAMS_BUFF) // Process report attributes // Report width - aReport[ RPT_WIDTH ] := BIN2W(SUBSTR(cParamsBuff, PAGE_WIDTH_OFFSET, 2)) + aReport[ RPT_WIDTH ] := BIN2W(SubStr(cParamsBuff, PAGE_WIDTH_OFFSET, 2)) // Lines per page - aReport[ RPT_LINES ] := BIN2W(SUBSTR(cParamsBuff, LNS_PER_PAGE_OFFSET, 2)) + aReport[ RPT_LINES ] := BIN2W(SubStr(cParamsBuff, LNS_PER_PAGE_OFFSET, 2)) // Page offset (left margin) - aReport[ RPT_LMARGIN ] := BIN2W(SUBSTR(cParamsBuff, LEFT_MRGN_OFFSET, 2)) + aReport[ RPT_LMARGIN ] := BIN2W(SubStr(cParamsBuff, LEFT_MRGN_OFFSET, 2)) // Page right margin (not used) - aReport[ RPT_RMARGIN ] := BIN2W(SUBSTR(cParamsBuff, RIGHT_MGRN_OFFSET, 2)) + aReport[ RPT_RMARGIN ] := BIN2W(SubStr(cParamsBuff, RIGHT_MGRN_OFFSET, 2)) - nColCount := BIN2W(SUBSTR(cParamsBuff, COL_COUNT_OFFSET, 2)) + nColCount := BIN2W(SubStr(cParamsBuff, COL_COUNT_OFFSET, 2)) // Line spacing // Spacing is 1, 2, or 3 - aReport[ RPT_SPACING ] := iif( SUBSTR( cParamsBuff, ; + aReport[ RPT_SPACING ] := iif( SubStr( cParamsBuff, ; DBL_SPACE_OFFSET, 1) $ "YyTt", 2, 1) // Summary report flag - aReport[ RPT_SUMMARY ] := iif( SUBSTR( cParamsBuff, ; + aReport[ RPT_SUMMARY ] := iif( SubStr( cParamsBuff, ; SUMMARY_RPT_OFFSET, 1) $ "YyTt", .T., .F.) // Process report eject and plain attributes option byte - cOptionByte := ASC(SUBSTR(cParamsBuff, OPTION_OFFSET, 1)) + cOptionByte := ASC(SubStr(cParamsBuff, OPTION_OFFSET, 1)) IF INT(cOptionByte / 4) == 1 aReport[ RPT_PLAIN ] := .T. // Plain page @@ -1047,7 +1046,7 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm ENDIF // Page heading, report title - nPointer := BIN2W(SUBSTR(cParamsBuff, PAGE_HDR_OFFSET, 2)) + nPointer := BIN2W(SubStr(cParamsBuff, PAGE_HDR_OFFSET, 2)) // Retrieve the header stored in the .FRM file nHeaderIndex := 4 @@ -1056,23 +1055,23 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm // certain that we have retrieved all heading entries from the .FRM file, we // now retract the empty headings DO WHILE ( nHeaderIndex > 0 ) - IF ! EMPTY( aHeader[ nHeaderIndex ] ) + IF ! Empty( aHeader[ nHeaderIndex ] ) EXIT ENDIF nHeaderIndex-- ENDDO - aReport[ RPT_HEADER ] := iif( EMPTY( nHeaderIndex ) , {}, ; - ASIZE( aHeader, nHeaderIndex ) ) + aReport[ RPT_HEADER ] := iif( Empty( nHeaderIndex ) , {}, ; + ASize( aHeader, nHeaderIndex ) ) // Process Groups // Group - nPointer := BIN2W(SUBSTR(cParamsBuff, GRP_EXPR_OFFSET, 2)) + nPointer := BIN2W(SubStr(cParamsBuff, GRP_EXPR_OFFSET, 2)) - IF !EMPTY(cGroupExp := ::GetExpr( nPointer )) + IF !Empty(cGroupExp := ::GetExpr( nPointer )) // Add a new group array - AADD( aReport[ RPT_GROUPS ], ARRAY( RGT_COUNT )) + AAdd( aReport[ RPT_GROUPS ], ARRAY( RGT_COUNT )) // Group expression aReport[ RPT_GROUPS ][1][ RGT_TEXT ] := cGroupExp @@ -1083,22 +1082,22 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm ENDIF // Group header - nPointer := BIN2W(SUBSTR(cParamsBuff, GRP_HDR_OFFSET, 2)) + nPointer := BIN2W(SubStr(cParamsBuff, GRP_HDR_OFFSET, 2)) aReport[ RPT_GROUPS ][1][ RGT_HEADER ] := ::GetExpr( nPointer ) // Page eject after group - aReport[ RPT_GROUPS ][1][ RGT_AEJECT ] := iif( SUBSTR( cParamsBuff, ; + aReport[ RPT_GROUPS ][1][ RGT_AEJECT ] := iif( SubStr( cParamsBuff, ; PE_OFFSET, 1) $ "YyTt", .T., .F.) ENDIF // Subgroup - nPointer := BIN2W(SUBSTR(cParamsBuff, SUB_EXPR_OFFSET, 2)) + nPointer := BIN2W(SubStr(cParamsBuff, SUB_EXPR_OFFSET, 2)) - IF !EMPTY(cSubGroupExp := ::GetExpr( nPointer )) + IF !Empty(cSubGroupExp := ::GetExpr( nPointer )) // Add new group array - AADD( aReport[ RPT_GROUPS ], ARRAY( RGT_COUNT )) + AAdd( aReport[ RPT_GROUPS ], ARRAY( RGT_COUNT )) // Subgroup expression aReport[ RPT_GROUPS ][2][ RGT_TEXT ] := cSubGroupExp @@ -1109,7 +1108,7 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm ENDIF // Subgroup header - nPointer := BIN2W(SUBSTR(cParamsBuff, SUB_HDR_OFFSET, 2)) + nPointer := BIN2W(SubStr(cParamsBuff, SUB_HDR_OFFSET, 2)) aReport[ RPT_GROUPS ][2][ RGT_HEADER ] := ::GetExpr( nPointer ) // Page eject after subgroup @@ -1121,7 +1120,7 @@ METHOD LoadReportFile( cFrmFile ) CLASS HBReportForm nFieldOffset := 12 // dBASE skips first 12 byte fields block. FOR nCount := 1 to nColCount - AADD( aReport[ RPT_COLUMNS ], ::GetColumn( cFieldsBuff, @nFieldOffset ) ) + AAdd( aReport[ RPT_COLUMNS ], ::GetColumn( cFieldsBuff, @nFieldOffset ) ) NEXT nCount @@ -1161,8 +1160,8 @@ METHOD GetExpr( nPointer ) CLASS HBReportForm nOffsetOffset := (nPointer * 2) - 1 ENDIF - nExprOffset := BIN2W(SUBSTR(::cOffsetsBuff, nOffsetOffset, 2)) - nExprLength := BIN2W(SUBSTR(::cLengthsBuff, nOffsetOffset, 2)) + nExprOffset := BIN2W(SubStr(::cOffsetsBuff, nOffsetOffset, 2)) + nExprLength := BIN2W(SubStr(::cLengthsBuff, nOffsetOffset, 2)) // EXPR_OFFSET points to a NULL, so add one (+1) to get the string // and subtract one (-1) from EXPR_LENGTH for correct length @@ -1171,11 +1170,11 @@ METHOD GetExpr( nPointer ) CLASS HBReportForm nExprLength-- // Extract string - cString := SUBSTR(::cExprBuff, nExprOffset, nExprLength) + cString := SubStr(::cExprBuff, nExprOffset, nExprLength) // dBASE does this so we must do it too // Character following character pointed to by pointer is NULL - IF CHR(0) == SUBSTR(cString, 1, 1) .AND. LEN(SUBSTR(cString,1,1)) == 1 + IF CHR(0) == SubStr(cString, 1, 1) .AND. Len(SubStr(cString,1,1)) == 1 cString := "" ENDIF ENDIF @@ -1185,10 +1184,10 @@ METHOD GetExpr( nPointer ) CLASS HBReportForm STATIC FUNCTION Occurs( cSearch, cTarget ) LOCAL nPos, nCount := 0 - DO WHILE !EMPTY( cTarget ) + DO WHILE !Empty( cTarget ) IF (nPos := AT( cSearch, cTarget )) != 0 nCount++ - cTarget := SUBSTR( cTarget, nPos + 1 ) + cTarget := SubStr( cTarget, nPos + 1 ) ELSE // End of string cTarget := "" @@ -1237,28 +1236,28 @@ STATIC FUNCTION ParseHeader( cHeaderString, nFields ) DO WHILE ++nItemCount <= nFields - cItem := SUBSTR( cHeaderString, 1, nHeaderLen ) + cItem := SubStr( cHeaderString, 1, nHeaderLen ) // check for explicit delimiter nPos := AT( ";", cItem ) - IF ! EMPTY( nPos ) + IF ! Empty( nPos ) // delimiter present - AADD( aPageHeader, SUBSTR( cItem, 1, nPos - 1 ) ) + AAdd( aPageHeader, SubStr( cItem, 1, nPos - 1 ) ) ELSE - IF EMPTY( cItem ) + IF Empty( cItem ) // empty string for S87 and 5.0 compatibility - AADD( aPageHeader, "" ) + AAdd( aPageHeader, "" ) ELSE // exception - AADD( aPageHeader, cItem ) + AAdd( aPageHeader, cItem ) ENDIF // empty or not, we jump past the field nPos := nHeaderLen ENDIF - cHeaderString := SUBSTR( cHeaderString, nPos + 1 ) + cHeaderString := SubStr( cHeaderString, nPos + 1 ) ENDDO @@ -1280,29 +1279,29 @@ METHOD GetColumn( cFieldsBuffer, nOffset ) CLASS HBReportForm LOCAL nPointer := 0, nNumber := 0, aColumn[ RCT_COUNT ], cType, cExpr // Column width - aColumn[ RCT_WIDTH ] := BIN2W(SUBSTR(cFieldsBuffer, nOffset + ; + aColumn[ RCT_WIDTH ] := BIN2W(SubStr(cFieldsBuffer, nOffset + ; FIELD_WIDTH_OFFSET, 2)) // Total column? - aColumn[ RCT_TOTAL ] := iif(SUBSTR(cFieldsBuffer, nOffset + ; + aColumn[ RCT_TOTAL ] := iif(SubStr(cFieldsBuffer, nOffset + ; FIELD_TOTALS_OFFSET, 1) $ "YyTt", .T., .F.) // Decimals width - aColumn[ RCT_DECIMALS ] := BIN2W(SUBSTR(cFieldsBuffer, nOffset + ; + aColumn[ RCT_DECIMALS ] := BIN2W(SubStr(cFieldsBuffer, nOffset + ; FIELD_DECIMALS_OFFSET, 2)) // Offset (relative to FIELDS_OFFSET), 'point' to // expression area via array OFFSETS[] // Content expression - nPointer := BIN2W(SUBSTR(cFieldsBuffer, nOffset +; + nPointer := BIN2W(SubStr(cFieldsBuffer, nOffset +; FIELD_CONTENT_EXPR_OFFSET, 2)) aColumn[ RCT_TEXT ] := ::GetExpr( nPointer ) cExpr := aColumn[ RCT_TEXT ] aColumn[ RCT_EXP ] := &( "{ || " + cExpr + "}" ) // Header expression - nPointer := BIN2W(SUBSTR(cFieldsBuffer, nOffset +; + nPointer := BIN2W(SubStr(cFieldsBuffer, nOffset +; FIELD_HEADER_EXPR_OFFSET, 2)) aColumn[ RCT_HEADER ] := ListAsArray(::GetExpr( nPointer ), ";") @@ -1310,22 +1309,22 @@ METHOD GetColumn( cFieldsBuffer, nOffset ) CLASS HBReportForm // Column picture // Setup picture only if a database file is open IF USED() - cType := VALTYPE( EVAL(aColumn[ RCT_EXP ]) ) + cType := VALTYPE( EVAL( aColumn[ RCT_EXP ] ) ) aColumn[ RCT_TYPE ] := cType DO CASE CASE cType == "C" .OR. cType == "M" - aColumn[ RCT_PICT ] := REPLICATE("X", aColumn[ RCT_WIDTH ]) + aColumn[ RCT_PICT ] := Replicate("X", aColumn[ RCT_WIDTH ]) CASE cType == "D" aColumn[ RCT_PICT ] := "@D" CASE cType == "N" IF aColumn[ RCT_DECIMALS ] != 0 - aColumn[ RCT_PICT ] := REPLICATE("9", aColumn[ RCT_WIDTH ] - aColumn[ RCT_DECIMALS ] -1) + "." + ; - REPLICATE("9", aColumn[ RCT_DECIMALS ]) + aColumn[ RCT_PICT ] := Replicate("9", aColumn[ RCT_WIDTH ] - aColumn[ RCT_DECIMALS ] -1) + "." + ; + Replicate("9", aColumn[ RCT_DECIMALS ]) ELSE - aColumn[ RCT_PICT ] := REPLICATE("9", aColumn[ RCT_WIDTH ]) + aColumn[ RCT_PICT ] := Replicate("9", aColumn[ RCT_WIDTH ]) ENDIF CASE cType == "L" - aColumn[ RCT_PICT ] := "@L" + REPLICATE("X",aColumn[ RCT_WIDTH ]-1) + aColumn[ RCT_PICT ] := "@L" + Replicate("X",aColumn[ RCT_WIDTH ]-1) ENDCASE ENDIF @@ -1348,28 +1347,28 @@ STATIC FUNCTION ListAsArray( cList, cDelimiter ) DEFAULT cDelimiter TO "," - DO WHILE LEN(cList) != 0 + DO WHILE Len( cList ) != 0 - nPos := AT(cDelimiter, cList) + nPos := AT( cDelimiter, cList ) IF nPos == 0 - nPos := LEN(cList) + nPos := Len( cList ) ENDIF - IF SUBSTR( cList, nPos, 1 ) == cDelimiter + IF SubStr( cList, nPos, 1 ) == cDelimiter lDelimLast := .T. - AADD(aList, SUBSTR(cList, 1, nPos - 1)) // Add a new element + AAdd( aList, SubStr( cList, 1, nPos - 1 ) ) // Add a new element ELSE lDelimLast := .F. - AADD(aList, SUBSTR(cList, 1, nPos)) // Add a new element + AAdd( aList, SubStr( cList, 1, nPos ) ) // Add a new element ENDIF - cList := SUBSTR(cList, nPos + 1) + cList := SubStr( cList, nPos + 1 ) ENDDO IF lDelimLast - AADD(aList, "") + AAdd( aList, "" ) ENDIF RETURN aList // Return the array @@ -1378,13 +1377,13 @@ STATIC FUNCTION MakeAStr( uVar, cType ) LOCAL cString DO CASE - CASE UPPER(cType) == "D" + CASE Upper( cType ) == "D" cString := DTOC( uVar ) - CASE UPPER(cType) == "L" + CASE Upper( cType ) == "L" cString := iif( uVar, "T", "F" ) - CASE UPPER(cType) == "N" + CASE Upper( cType ) == "N" cString := STR( uVar ) - CASE UPPER(cType) == "C" + CASE Upper( cType ) == "C" cString := uVar OTHERWISE cString := "INVALID EXPRESSION" diff --git a/harbour/source/rtl/ttextlin.prg b/harbour/source/rtl/ttextlin.prg index fcf8c620d5..89878e28a1 100644 --- a/harbour/source/rtl/ttextlin.prg +++ b/harbour/source/rtl/ttextlin.prg @@ -54,14 +54,14 @@ CREATE CLASS HBTextLine - VAR cText // A line of text - VAR lSoftCR // true if line doesn't end with a hb_OSNewLine() char (word wrapping) + VAR cText /* A line of text */ + VAR lSoftCR /* true if line doesn't end with a hb_OSNewLine() char (word wrapping) */ METHOD New( cLine, lSoftCR ) ENDCLASS -// Creates a new line of text +/* Creates a new line of text */ METHOD New( cLine, lSoftCR ) CLASS HBTextLine ::cText := iif( Empty( cLine ), "", cLine ) diff --git a/harbour/source/rtl/tthreadx.prg b/harbour/source/rtl/tthreadx.prg index e9b7a82121..259bd1954b 100644 --- a/harbour/source/rtl/tthreadx.prg +++ b/harbour/source/rtl/tthreadx.prg @@ -65,17 +65,17 @@ ENDCLASS METHOD new() CLASS TSIGNAL ::mutex := hb_mutexCreate() -RETURN Self + RETURN Self METHOD wait( nTimeOut ) CLASS TSIGNAL -/* TOCHECK: I do not know if strict xbase++ compatibility needs - * hb_mutexSubscribe() or hb_mutexSubscribeNow() - * Please change it if necessary - */ -RETURN hb_mutexSubscribe( ::mutex, nTimeOut ) + /* TOCHECK: I do not know if strict xbase++ compatibility needs + * hb_mutexSubscribe() or hb_mutexSubscribeNow() + * Please change it if necessary + */ + RETURN hb_mutexSubscribe( ::mutex, nTimeOut ) METHOD signal() CLASS TSIGNAL hb_mutexNotify( ::mutex ) -RETURN Self + RETURN Self #endif