diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 812da0fa00..4bafb9637c 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,45 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-09-14 13:53 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * source/rtl/tbrowse.prg + ! Color handling made fully C5.x compatible. Pls test. + + One C5.3 bug replicated where no special header/footer + colors are being used if there is not header/footer separator + sepcified. + ! Fixed compile error (because of unused var warning) when + HB_COMPAT_C53 is not defined. + + * source/rtl/numeric.prg + * source/rtl/memoedit.prg + * source/rtl/typefile.prg + * source/rtl/block.prg + * source/rtl/symbol.prg + * source/rtl/errorsys.prg + * source/rtl/scalar.prg + * source/rtl/nil.prg + * source/rtl/radiogrp.prg + * source/rtl/logical.prg + * source/rtl/array.prg + * source/rtl/listbox.prg + * source/rtl/browse.prg + * source/rtl/characte.prg + * source/rtl/pushbtn.prg + * source/rtl/ttextlin.prg + * source/rtl/profiler.prg + * source/rtl/date.prg + * source/rtl/persist.prg + * source/debug/dbgbrwsr.prg + * source/debug/tbrwtext.prg + * source/debug/dbgtmenu.prg + + Enabled "PROTECTED:" keyword in profiler.prg + * Finished CLASS declarations to use a more or less consistent syntax + inside Harbour (Class(y) compatible except SETGET and the METHOD + parameter lists, maybe some more). + * Finished WHILE, iif(), END, string quotation to be consistent along Harbour. + ! Fixed some indentations. + * Some other minor cleanups. + 2007-09-14 18:46 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) * harbour/source/rtl/tbrowse.prg ! Fixed cell color. This was needed because the oCol:colorBlock() diff --git a/harbour/source/debug/dbgbrwsr.prg b/harbour/source/debug/dbgbrwsr.prg index 62324c239d..22cf1c6a95 100644 --- a/harbour/source/debug/dbgbrwsr.prg +++ b/harbour/source/debug/dbgbrwsr.prg @@ -52,7 +52,7 @@ #include "hbclass.ch" -CREATE CLASS HBDbBrowser FROM TBrowse // Debugger browser +CREATE CLASS HBDbBrowser INHERIT TBrowse // Debugger browser VAR Window diff --git a/harbour/source/debug/dbgtmenu.prg b/harbour/source/debug/dbgtmenu.prg index 0dd90c785e..174f5f9ead 100644 --- a/harbour/source/debug/dbgtmenu.prg +++ b/harbour/source/debug/dbgtmenu.prg @@ -281,14 +281,14 @@ METHOD GetItemByIdent( uIdent ) CLASS HBDbMenu local oItem for n := 1 to Len( ::aItems ) - IF( VALTYPE(::aItems[n]:bAction) == 'O' ) - oItem := ::aItems[n]:bAction:GetItemByIdent( uIdent ) - IF( oItem != NIL ) + IF ISOBJECT( ::aItems[ n ]:bAction ) + oItem := ::aItems[ n ]:bAction:GetItemByIdent( uIdent ) + IF oItem != NIL RETURN oItem ENDIF ELSE - if VALTYPE(::aItems[ n ]:Ident) == VALTYPE(uIdent) .AND.; - ::aItems[n]:Ident == uIdent + if VALTYPE( ::aItems[ n ]:Ident ) == VALTYPE( uIdent ) .AND.; + ::aItems[ n ]:Ident == uIdent return ::aItems[ n ] ENDIF endif @@ -320,10 +320,10 @@ METHOD GoLeft() CLASS HBDbMenu endif if ::nOpenPopup > 1 --::nOpenPopup - while ::nOpenPopup > 1 .and. ; + do while ::nOpenPopup > 1 .and. ; SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-" --::nOpenPopup - end + enddo ::ShowPopup( ::nOpenPopup ) else ::ShowPopup( ::nOpenPopup := Len( ::aItems ) ) @@ -344,10 +344,10 @@ METHOD GoRight() CLASS HBDbMenu endif if ::nOpenPopup < Len( ::aItems ) ++::nOpenPopup - while ::nOpenPopup < Len( ::aItems ) .and. ; + do while ::nOpenPopup < Len( ::aItems ) .and. ; SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-" ++::nOpenPopup - end + enddo ::ShowPopup( ::nOpenPopup ) else ::ShowPopup( ::nOpenPopup := 1 ) diff --git a/harbour/source/debug/tbrwtext.prg b/harbour/source/debug/tbrwtext.prg index 994b2f0563..40c7f37970 100644 --- a/harbour/source/debug/tbrwtext.prg +++ b/harbour/source/debug/tbrwtext.prg @@ -62,7 +62,7 @@ #define CLR_BKPT 2 // color of breakpoint line #define CLR_HIBKPT 3 // color of highlighted breakpoint line -CREATE CLASS HBBrwText FROM HBEditor +CREATE CLASS HBBrwText INHERIT HBEditor VAR cFileName // the name of the browsed file VAR nActiveLine INIT 1 // Active line inside Code Window (the line to be executed) diff --git a/harbour/source/rtl/array.prg b/harbour/source/rtl/array.prg index 9edf803f58..5f666b6bd1 100644 --- a/harbour/source/rtl/array.prg +++ b/harbour/source/rtl/array.prg @@ -52,7 +52,7 @@ #include "hbclass.ch" -CLASS Array FROM ScalarObject FUNCTION _Array +CREATE CLASS Array INHERIT ScalarObject FUNCTION HBArray METHOD Init() @@ -73,17 +73,17 @@ CLASS Array FROM ScalarObject FUNCTION _Array METHOD Scan() METHOD _Size // assignment method -END CLASS +ENDCLASS METHOD Init( nElements ) CLASS Array - ::size := If( nElements == nil, 0, nElements ) + ::size := iif( nElements == NIL, 0, nElements ) return Self METHOD AddAll( aOtherCollection ) CLASS Array - aOtherCollection:Do( { |e| ::Add( e ) } ) + aOtherCollection:Do( {| e | ::Add( e ) } ) return Self @@ -115,7 +115,7 @@ METHOD Collect( b ) CLASS Array currElem := Self[ i ] if Eval( b, currElem ) AAdd( result, currElem ) - end + endif next return result @@ -129,7 +129,7 @@ METHOD DeleteAt( n ) CLASS Array if n > 0 .and. n <= Len( Self ) ADel( Self, n ) ASize( Self, Len( Self ) - 1 ) - end + endif return Self @@ -138,11 +138,11 @@ METHOD InsertAt( n, x ) CLASS Array if n > Len( Self ) ASize( Self, n ) Self[ n ] := x - elseif n > 0 + elseif n > 0 ASize( Self, Len( Self ) + 1 ) AIns( Self, n ) Self[ n ] := x - end + endif return Self @@ -168,7 +168,7 @@ METHOD IndexOf( x ) CLASS Array for i := 1 to nElems if Self[ i ] == x return i - end + endif next return 0 @@ -177,7 +177,7 @@ METHOD Remove( e ) CLASS Array ::DeleteAt( ::IndexOf( e ) ) -return nil +return NIL METHOD Scan( b ) CLASS Array @@ -188,4 +188,3 @@ METHOD _Size( newSize ) CLASS Array ASize( Self, newSize ) return newSize // so that assignment works according to standard rules - diff --git a/harbour/source/rtl/block.prg b/harbour/source/rtl/block.prg index fc13d8b0cf..49db6c8867 100644 --- a/harbour/source/rtl/block.prg +++ b/harbour/source/rtl/block.prg @@ -52,7 +52,7 @@ #include "hbclass.ch" -CLASS Block FROM ScalarObject +CREATE CLASS Block INHERIT ScalarObject METHOD AsString() diff --git a/harbour/source/rtl/browse.prg b/harbour/source/rtl/browse.prg index 4cde0bfa6f..482248e651 100644 --- a/harbour/source/rtl/browse.prg +++ b/harbour/source/rtl/browse.prg @@ -106,9 +106,9 @@ FUNCTION Browse( nTop, nLeft, nBottom, nRight ) lKeyPressed := .T. ENDIF - WHILE ! lExit + DO WHILE ! lExit - WHILE ! lKeyPressed .AND. ! oBrw:Stabilize() + DO WHILE ! lKeyPressed .AND. ! oBrw:Stabilize() lKeyPressed := ( nKey := Inkey() ) != 0 ENDDO @@ -402,7 +402,7 @@ STATIC FUNCTION FreshOrder( oBrw ) oBrw:ForceStable() IF nRec != LastRec() + 1 - WHILE RecNo() != nRec .AND. !BOF() + DO WHILE RecNo() != nRec .AND. !BOF() oBrw:Up() oBrw:ForceStable() ENDDO diff --git a/harbour/source/rtl/characte.prg b/harbour/source/rtl/characte.prg index c2b6e7aa8f..2e29d9e832 100644 --- a/harbour/source/rtl/characte.prg +++ b/harbour/source/rtl/characte.prg @@ -52,7 +52,7 @@ #include "hbclass.ch" -CLASS Character FROM ScalarObject +CREATE CLASS Character INHERIT ScalarObject METHOD AsString() METHOD AsExpStr() diff --git a/harbour/source/rtl/date.prg b/harbour/source/rtl/date.prg index fbe3cb6e84..1b56398812 100644 --- a/harbour/source/rtl/date.prg +++ b/harbour/source/rtl/date.prg @@ -52,7 +52,7 @@ #include "hbclass.ch" -CLASS Date FROM ScalarObject FUNCTION _Date +CREATE CLASS Date INHERIT ScalarObject FUNCTION HBDate METHOD AsString() METHOD AsExpStr() diff --git a/harbour/source/rtl/errorsys.prg b/harbour/source/rtl/errorsys.prg index ebc64e37f1..420c6f1d4f 100644 --- a/harbour/source/rtl/errorsys.prg +++ b/harbour/source/rtl/errorsys.prg @@ -105,7 +105,6 @@ STATIC FUNCTION DefError( oError ) aOptions := {} -// AAdd( aOptions, "Break" ) AAdd( aOptions, "Quit" ) IF oError:canRetry @@ -119,7 +118,7 @@ STATIC FUNCTION DefError( oError ) // Show alert box nChoice := 0 - WHILE nChoice == 0 + DO WHILE nChoice == 0 IF ISNIL( cDOSError ) nChoice := Alert( cMessage, aOptions ) @@ -150,7 +149,7 @@ STATIC FUNCTION DefError( oError ) OutErr( cMessage ) n := 1 - WHILE ! Empty( ProcName( ++n ) ) + DO WHILE ! Empty( ProcName( ++n ) ) OutErr( hb_OSNewLine() ) OutErr( "Called from " + ProcName( n ) + ; @@ -158,17 +157,11 @@ STATIC FUNCTION DefError( oError ) ENDDO -/// For some strange reason, the DOS prompt gets written on the first line -/// *of* the message instead of on the first line *after* the message after -/// the program quits, unless the screen has scrolled. - dgh - ErrorLevel( 1 ) QUIT RETURN .F. -// [vszakats] - STATIC FUNCTION ErrorMessage( oError ) LOCAL cMessage diff --git a/harbour/source/rtl/listbox.prg b/harbour/source/rtl/listbox.prg index e3a6152721..df483b3eb6 100644 --- a/harbour/source/rtl/listbox.prg +++ b/harbour/source/rtl/listbox.prg @@ -435,7 +435,7 @@ METHOD hitTest( nMRow, nMCol ) CLASS LISTBOX /* Check hit on the scrollbar */ IF ::lIsOpen .AND. ; ::oVScroll != NIL .AND. ; - ( nHit := ::oVScroll:hittest( nMRow, nMCol ) ) != 0 + ( nHit := ::oVScroll:hitTest( nMRow, nMCol ) ) != 0 RETURN nHit ENDIF @@ -532,7 +532,7 @@ METHOD insItem( nPos, cText, cData ) RETURN Self METHOD killFocus() CLASS LISTBOX - LOCAL nCurMCur + LOCAL nOldMCur IF ::lHasFocus ::lHasFocus := .F. @@ -541,7 +541,7 @@ METHOD killFocus() CLASS LISTBOX Eval( ::bFBlock ) ENDIF - nCurMCur := MSetCursor( .F. ) + nOldMCur := MSetCursor( .F. ) DispBegin() IF ::lDropDown .AND. ::lIsOpen @@ -550,7 +550,7 @@ METHOD killFocus() CLASS LISTBOX ::display() DispEnd() - MSetCursor( nCurMCur ) + MSetCursor( nOldMCur ) SetCursor( ::nCursor ) ENDIF @@ -719,7 +719,7 @@ METHOD select( xPos ) CLASS LISTBOX RETURN ::nValue CASE xPos == ::nValue RETURN ::nValue - Otherwise + OTHERWISE nPos := xPos IF Valtype( ::xBuffer ) $ "NU" ::xBuffer := nPos diff --git a/harbour/source/rtl/logical.prg b/harbour/source/rtl/logical.prg index 6e1f63ac50..44e176de8d 100644 --- a/harbour/source/rtl/logical.prg +++ b/harbour/source/rtl/logical.prg @@ -52,7 +52,7 @@ #include "hbclass.ch" -CLASS Logical FROM ScalarObject +CREATE CLASS Logical INHERIT ScalarObject METHOD AsString() @@ -60,5 +60,5 @@ ENDCLASS METHOD AsString() CLASS Logical -return If( Self, ".T.", ".F." ) +return iif( Self, ".T.", ".F." ) diff --git a/harbour/source/rtl/memoedit.prg b/harbour/source/rtl/memoedit.prg index 0521297846..6274322257 100644 --- a/harbour/source/rtl/memoedit.prg +++ b/harbour/source/rtl/memoedit.prg @@ -57,7 +57,7 @@ #include "memoedit.ch" // A specialized HBEditor which can simulate MemoEdit() behaviour -CREATE CLASS HBMemoEditor FROM HBEditor +CREATE CLASS HBMemoEditor INHERIT HBEditor VAR xUserFunction // User Function called to change default MemoEdit() behaviour @@ -80,18 +80,18 @@ METHOD MemoInit( xUserFunction ) CLASS HBMemoEditor // Save/Init object internal representation of user function ::xUserFunction := xUserFunction - if ISCHARACTER( ::xUserFunction ) + IF ISCHARACTER( ::xUserFunction ) // Keep calling user function until it returns 0 - do while ( nKey := ::xDo( ME_INIT ) ) != ME_DEFAULT + DO WHILE ( nKey := ::xDo( ME_INIT ) ) != ME_DEFAULT // At this time there is no input from user of MemoEdit() only handling // of values returned by ::xUserFunction, so I pass these value on both // parameters of ::HandleUserKey() ::HandleUserKey( nKey, nKey ) - enddo + ENDDO - endif + ENDIF RETURN Self @@ -106,35 +106,35 @@ METHOD Edit() CLASS HBMemoEditor // If I have an user function I need to trap configurable keys and ask to // user function if handle them the standard way or not - if ::lEditAllow .AND. ISCHARACTER( ::xUserFunction ) + IF ::lEditAllow .AND. ISCHARACTER( ::xUserFunction ) - do while ! ::lExitEdit + DO WHILE ! ::lExitEdit // I need to test this condition here since I never block inside HBEditor:Edit() // if there is an user function - if NextKey() == 0 + IF NextKey() == 0 ::IdleHook() - endif + ENDIF nKey := Inkey( 0 ) - if ( bKeyBlock := SetKey( nKey ) ) != NIL + IF ( bKeyBlock := SetKey( nKey ) ) != NIL Eval( bKeyBlock ) - loop - endif + LOOP + ENDIF // Is it a configurable key ? - if AScan( aConfigurableKeys, nKey ) > 0 + IF AScan( aConfigurableKeys, nKey ) > 0 ::HandleUserKey( nKey, ::xDo( iif( ::lDirty, ME_UNKEYX, ME_UNKEY ) ) ) - else + ELSE ::super:Edit( nKey ) - endif - enddo - else + ENDIF + ENDDO + ELSE // If I can't edit text buffer or there is not a user function enter standard HBEditor // ::Edit() method which is able to handle everything ::super:Edit() - endif + ENDIF RETURN Self @@ -147,9 +147,9 @@ METHOD KeyboardHook( nKey ) CLASS HBMemoEditor LOCAL nRow LOCAL nCol - if nKey == K_ESC + IF nKey == K_ESC - if ::lDirty + IF ::lDirty cBackScr := SaveScreen( ::nTop, ::nRight - 18, ::nTop, ::nRight ) nRow := Row() @@ -161,26 +161,26 @@ METHOD KeyboardHook( nKey ) CLASS HBMemoEditor RestScreen( ::nTop, ::nRight - 18, ::nTop, ::nRight, cBackScr ) SetPos( nRow, nCol ) - if Upper( Chr( nYesNoKey ) ) == "Y" + IF Upper( Chr( nYesNoKey ) ) == "Y" ::lSaved := .F. ::lExitEdit := .T. - endif - else + ENDIF + ELSE ::lExitEdit := .T. - endif - endif + ENDIF + ENDIF - if ISCHARACTER( ::xUserFunction ) + IF ISCHARACTER( ::xUserFunction ) ::HandleUserKey( nKey, ::xDo( iif( ::lDirty, ME_UNKEYX, ME_UNKEY ) ) ) - endif + ENDIF RETURN Self METHOD IdleHook() CLASS HBMemoEditor - if ISCHARACTER( ::xUserFunction ) + IF ISCHARACTER( ::xUserFunction ) ::xDo( ME_IDLE ) - endif + ENDIF RETURN Self @@ -190,42 +190,42 @@ METHOD HandleUserKey( nKey, nUserKey ) CLASS HBMemoEditor LOCAL aUnHandledKeys := { K_CTRL_J, K_CTRL_K, K_CTRL_L, K_CTRL_N, K_CTRL_O,; K_CTRL_P, K_CTRL_Q, K_CTRL_T, K_CTRL_U, K_F1 } - do case + DO CASE // I won't reach this point during ME_INIT since ME_DEFAULT ends initialization phase of MemoEdit() - case nUserKey == ME_DEFAULT + CASE nUserKey == ME_DEFAULT // HBEditor is not able to handle keys with a value higher than 256, but I have to tell him // that user wants to save text - if ( nKey <= 256 .OR. nKey == K_ALT_W ) .AND. AScan( aUnHandledKeys, nKey ) == 0 + IF ( nKey <= 256 .OR. nKey == K_ALT_W ) .AND. AScan( aUnHandledKeys, nKey ) == 0 ::super:Edit( nKey ) - endif + ENDIF // TOFIX: Not clipper compatible, see teditor.prg - case ( nUserKey >= 1 .AND. nUserKey <= 31 ) .OR. nUserKey == K_ALT_W - if AScan( aUnHandledKeys, nUserKey ) == 0 + CASE ( nUserKey >= 1 .AND. nUserKey <= 31 ) .OR. nUserKey == K_ALT_W + IF AScan( aUnHandledKeys, nUserKey ) == 0 ::super:Edit( nUserKey ) - endif + ENDIF - case nUserKey == ME_DATA - if nKey <= 256 .AND. AScan( aUnHandledKeys, nKey ) == 0 + CASE nUserKey == ME_DATA + IF nKey <= 256 .AND. AScan( aUnHandledKeys, nKey ) == 0 ::super:Edit( nKey ) - endif + ENDIF - case nUserKey == ME_TOGGLEWRAP + CASE nUserKey == ME_TOGGLEWRAP ::lWordWrap := !::lWordWrap - case nUserKey == ME_TOGGLESCROLL + CASE nUserKey == ME_TOGGLESCROLL // TODO: HBEditor does not support vertical scrolling of text inside window without moving cursor position - case nUserKey == ME_WORDRIGHT + CASE nUserKey == ME_WORDRIGHT ::MoveCursor( K_CTRL_RIGHT ) - case nUserKey == ME_BOTTOMRIGHT + CASE nUserKey == ME_BOTTOMRIGHT ::MoveCursor( K_CTRL_END ) - otherwise + OTHERWISE // Do nothing - endcase + ENDCASE RETURN Self @@ -244,12 +244,12 @@ METHOD xDo( nStatus ) CLASS HBMemoEditor METHOD MoveCursor( nKey ) CLASS HBMemoEditor - if nKey == K_CTRL_END // same value as CTRL-W + IF nKey == K_CTRL_END // same value as CTRL-W ::lSaved := .T. ::lExitEdit := .T. - else + ELSE RETURN ::Super:MoveCursor( nKey ) - endif + ENDIF RETURN .f. @@ -287,14 +287,14 @@ FUNCTION MemoEdit( cString,; oEd:MemoInit( xUserFunction ) oEd:display() - if ! ISLOGICAL( xUserFunction ) .OR. xUserFunction == .T. + IF ! ISLOGICAL( xUserFunction ) .OR. xUserFunction == .T. oEd:Edit() - if oEd:Changed() + IF oEd:Changed() cString := oEd:GetText() // dbu tests for LastKey() == K_CTRL_END, so I try to make it happy KEYBOARD Chr( K_CTRL_END ) Inkey() - endif - endif + ENDIF + ENDIF RETURN cString diff --git a/harbour/source/rtl/nil.prg b/harbour/source/rtl/nil.prg index a035d2b50a..4806976c6c 100644 --- a/harbour/source/rtl/nil.prg +++ b/harbour/source/rtl/nil.prg @@ -52,7 +52,7 @@ #include "hbclass.ch" -CLASS _Nil FROM ScalarObject +CREATE CLASS _Nil INHERIT ScalarObject METHOD AsString() diff --git a/harbour/source/rtl/numeric.prg b/harbour/source/rtl/numeric.prg index a4d62a47c4..d91f2e5c22 100644 --- a/harbour/source/rtl/numeric.prg +++ b/harbour/source/rtl/numeric.prg @@ -52,7 +52,7 @@ #include "hbclass.ch" -CLASS Numeric FROM ScalarObject +CREATE CLASS Numeric INHERIT ScalarObject METHOD AsString() diff --git a/harbour/source/rtl/persist.prg b/harbour/source/rtl/persist.prg index 11d2287037..f304573d31 100644 --- a/harbour/source/rtl/persist.prg +++ b/harbour/source/rtl/persist.prg @@ -55,16 +55,12 @@ extern HB_STOD -CLASS HBPersistent +CREATE CLASS HBPersistent METHOD CreateNew() INLINE Self - METHOD LoadFromFile( cFileName ) INLINE ::LoadFromText( MemoRead( cFileName ) ) - METHOD LoadFromText( cObjectText ) - METHOD SaveToText( cObjectName ) - METHOD SaveToFile( cFileName ) INLINE MemoWrit( cFileName, ::SaveToText() ) ENDCLASS @@ -79,10 +75,10 @@ METHOD LoadFromText( cObjectText ) CLASS HBPersistent return .F. endif - while Empty( ExtractLine( cObjectText, @nFrom ) ) // We skip the first empty lines - end + do while Empty( ExtractLine( cObjectText, @nFrom ) ) // We skip the first empty lines + enddo - while nFrom <= Len( cObjectText ) + do while nFrom <= Len( cObjectText ) cLine := ExtractLine( cObjectText, @nFrom ) do case @@ -108,7 +104,7 @@ METHOD LoadFromText( cObjectText ) CLASS HBPersistent endcase - end + enddo return .T. @@ -122,9 +118,9 @@ METHOD SaveToText( cObjectName ) CLASS HBPersistent DEFAULT cObjectName TO "o" + ::ClassName() nIndent += 3 - cObject := iif( nIndent > 0, hb_OsNewLine(), "" ) + Space( nIndent ) + ; + cObject := iif( nIndent > 0, hb_OSNewLine(), "" ) + Space( nIndent ) + ; "OBJECT " + iif( nIndent != 0, "::", "" ) + cObjectName + " AS " + ; - ::ClassName() + hb_OsNewLine() + ::ClassName() + hb_OSNewLine() aProperties := __ClsGetProperties( ::ClassH ) @@ -141,7 +137,7 @@ METHOD SaveToText( cObjectName ) CLASS HBPersistent cObject += ArrayToText( uValue, aProperties[ n ], nIndent ) nIndent -= 3 if n < Len( aProperties ) - cObject += hb_OsNewLine() + cObject += hb_OSNewLine() endif case cType == "O" @@ -149,31 +145,31 @@ METHOD SaveToText( cObjectName ) CLASS HBPersistent cObject += uValue:SaveToText( aProperties[ n ] ) endif if n < Len( aProperties ) - cObject += hb_OsNewLine() + cObject += hb_OSNewLine() endif otherwise if n == 1 - cObject += hb_OsNewLine() + cObject += hb_OSNewLine() endif cObject += Space( nIndent ) + " ::" + ; aProperties[ n ] + " = " + ValToText( uValue ) + ; - hb_OsNewLine() + hb_OSNewLine() endcase endif next - cObject += hb_OsNewLine() + Space( nIndent ) + "ENDOBJECT" + hb_OsNewLine() + cObject += hb_OSNewLine() + Space( nIndent ) + "ENDOBJECT" + hb_OSNewLine() nIndent -= 3 return cObject static function ArrayToText( aArray, cName, nIndent ) - local cArray := hb_OsNewLine() + Space( nIndent ) + "ARRAY ::" + cName + ; - " LEN " + AllTrim( Str( Len( aArray ) ) ) + hb_OsNewLine() + local cArray := hb_OSNewLine() + Space( nIndent ) + "ARRAY ::" + cName + ; + " LEN " + AllTrim( Str( Len( aArray ) ) ) + hb_OSNewLine() local n, uValue, cType for n := 1 to Len( aArray ) @@ -184,7 +180,7 @@ static function ArrayToText( aArray, cName, nIndent ) case cType == "A" nIndent += 3 cArray += ArrayToText( uValue, cName + "[ " + ; - AllTrim( Str( n ) ) + " ]", nIndent ) + hb_OsNewLine() + AllTrim( Str( n ) ) + " ]", nIndent ) + hb_OSNewLine() nIndent -= 3 case cType == "O" @@ -195,15 +191,15 @@ static function ArrayToText( aArray, cName, nIndent ) otherwise if n == 1 - cArray += hb_OsNewLine() + cArray += hb_OSNewLine() endif cArray += Space( nIndent ) + " ::" + cName + ; + "[ " + AllTrim( Str( n ) ) + " ]" + " = " + ; - ValToText( uValue ) + hb_OsNewLine() + ValToText( uValue ) + hb_OSNewLine() endcase next - cArray += hb_OsNewLine() + Space( nIndent ) + "ENDARRAY" + hb_OsNewLine() + cArray += hb_OSNewLine() + Space( nIndent ) + "ENDARRAY" + hb_OSNewLine() return cArray @@ -214,7 +210,7 @@ static function ValToText( uValue ) do case case cType == "C" - cText := HB_StrToExp( uValue ) + cText := hb_StrToExp( uValue ) case cType == "N" cText := AllTrim( Str( uValue ) ) @@ -224,7 +220,7 @@ static function ValToText( uValue ) cText := "0d" + iif( Empty( cText ), "00000000", cText ) otherwise - cText := HB_ValToStr( uValue ) + cText := hb_ValToStr( uValue ) endcase return cText @@ -233,14 +229,14 @@ return cText static function ExtractLine( cText, nFrom ) - local nAt := At( hb_OsNewLine(), cText, nFrom ) - - if nAt > 0 - cText := Substr( cText, nFrom, nAt - nFrom ) - nFrom := nAt + 2 - else - cText := Substr( cText, nFrom ) - nFrom := Len( cText ) + 1 - endif + local nAt := At( hb_OSNewLine(), cText, nFrom ) + + if nAt > 0 + cText := Substr( cText, nFrom, nAt - nFrom ) + nFrom := nAt + 2 + else + cText := Substr( cText, nFrom ) + nFrom := Len( cText ) + 1 + endif return cText diff --git a/harbour/source/rtl/profiler.prg b/harbour/source/rtl/profiler.prg index 3fd8b81962..86e3c29d60 100644 --- a/harbour/source/rtl/profiler.prg +++ b/harbour/source/rtl/profiler.prg @@ -127,19 +127,19 @@ Local n // Report on calls greater than 0 DrawScreen( "All methods/functions called one or more times" ) - memoedit( HBProfileReportToString():new( oProfile:callSort() ):generate( {|o| o:nCalls > 0 } ), 1,,,, .F. ) + memoedit( HBProfileReportToString():new( oProfile:callSort() ):generate( {| o | o:nCalls > 0 } ), 1,,,, .F. ) // Sorted by name DrawScreen( "All methods/functions called one or more times, sorted by name" ) - memoedit( HBProfileReportToString():new( oProfile:nameSort() ):generate( {|o| o:nCalls > 0 } ), 1,,,, .F. ) + memoedit( HBProfileReportToString():new( oProfile:nameSort() ):generate( {| o | o:nCalls > 0 } ), 1,,,, .F. ) // Sorted by time DrawScreen( "All methods/functions taking measurable time, sorted by time" ) - memoedit( HBProfileReportToString():new( oProfile:timeSort() ):generate( {|o| o:nTicks > 0 } ), 1,,,, .F. ) + memoedit( HBProfileReportToString():new( oProfile:timeSort() ):generate( {| o | o:nTicks > 0 } ), 1,,,, .F. ) // TBrowse all calls greater than 0 DrawScreen( "TBrowse all methods/functions called one or more times" ) - Browser( HBProfileReportToTBrowse():new( oProfile:callSort() ):generate( {|o| o:nCalls > 0 }, 1 ) ) + Browser( HBProfileReportToTBrowse():new( oProfile:callSort() ):generate( {| o | o:nCalls > 0 }, 1 ) ) // Some closing stats DrawScreen( "Totals" ) @@ -147,24 +147,24 @@ Local n @ 3, 0 Say " Total Ticks: " + str( oProfile:totalTicks() ) @ 4, 0 Say "Total Seconds: " + str( oProfile:totalSeconds() ) -Return( NIL ) +Return NIL Static Function DrawScreen( cTitle ) - scroll() + Scroll() - @ 0, 0 Say padr( cTitle, maxcol() + 1 ) Color "n/w" + @ 0, 0 SAY PadR( cTitle, MaxCol() + 1 ) COLOR "N/W" -Return( NIL ) +Return NIL Function DoNothingForTwoSeconds() - inkey( 2 ) + Inkey( 2 ) -Return( NIL ) +Return NIL Function CallMe500Times() -Return( NIL ) +Return NIL Static Function Browser( oBrowse ) Local lBrowsing := .T. @@ -174,7 +174,7 @@ Local nKey oBrowse:forceStable() - nKey := inkey( 0 ) + nKey := Inkey( 0 ) Do Case @@ -205,7 +205,7 @@ Local nKey EndDo -Return( NIL ) +Return NIL #endif @@ -227,7 +227,7 @@ Create Class HBProfileEntity Method init Method describe -End Class +Endclass ///// @@ -237,27 +237,27 @@ Method init( cName, aInfo ) Class HBProfileEntity ::nCalls := aInfo[ 1 ] ::nTicks := aInfo[ 2 ] -Return( self ) +Return Self ///// Access nSeconds Class HBProfileEntity -Return( HB_Clocks2Secs( ::nTicks ) ) +Return HB_Clocks2Secs( ::nTicks ) ///// Access nMeanTicks Class HBProfileEntity -Return( if( ::nCalls == 0, 0, ::nTicks / ::nCalls ) ) +Return iif( ::nCalls == 0, 0, ::nTicks / ::nCalls ) ///// Access nMeanSeconds Class HBProfileEntity -Return( if( ::nCalls == 0, 0, ::nSeconds / ::nCalls ) ) +Return iif( ::nCalls == 0, 0, ::nSeconds / ::nCalls ) ///// Method describe Class HBProfileEntity -Return( "Base Entity" ) +Return "Base Entity" //////////////////////////////////////////////////////////////////////////// // Class: HBProfileFunction @@ -268,12 +268,12 @@ Create Class HBProfileFunction Inherit HBProfileEntity Method describe -End Class +Endclass ///// Method describe Class HBProfileFunction -Return( "Function" ) +Return "Function" //////////////////////////////////////////////////////////////////////////// // Class: HBProfileMethod @@ -284,12 +284,12 @@ Create Class HBProfileMethod Inherit HBProfileEntity Method describe -End Class +Endclass ///// Method describe Class HBProfileMethod -Return( "Method" ) +Return "Method" //////////////////////////////////////////////////////////////////////////// // Class: HBProfileOPCode @@ -300,12 +300,12 @@ Create Class HBProfileOPCode Inherit HBProfileEntity Method describe -End Class +Endclass ///// Method describe Class HBProfileOPCode -Return( "OPCode" ) +Return "OPCode" //////////////////////////////////////////////////////////////////////////// // Class: HBProfile @@ -334,7 +334,7 @@ Create Class HBProfile Method reset Method ignoreSymbol -End Class +Endclass ///// @@ -345,7 +345,7 @@ Local lProfile := __setProfiler( .F. ) __setProfiler( lProfile ) -Return( self ) +Return Self ///// @@ -353,13 +353,13 @@ 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" ) ) +Return Left( cSymbol, Len( cProfPrefix ) ) == cProfPrefix .Or. cSymbol == "__SETPROFILER" ///// @@ -380,7 +380,7 @@ Local n // If we're not ignoring the symbol... If !::ignoreSymbol( cName := __DynSGetName( n ) ) // Yes, it is, add it to the profile. - aadd( ::aProfile, HBProfileFunction():new( cName, __DynSGetPrf( n ) ) ) + AAdd( ::aProfile, HBProfileFunction():new( cName, __DynSGetPrf( n ) ) ) EndIf EndIf @@ -389,7 +389,7 @@ Local n __setProfiler( lProfile ) -Return( self ) +Return Self ///// @@ -402,20 +402,20 @@ 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 ) // Collect class members. - nMembers := len( aMembers := __classSel( n ) ) + nMembers := Len( aMembers := __classSel( n ) ) For nMember := 1 To nMembers // If we've got a member name... If !empty( aMembers[ nMember ] ) // Add it to the profile. - aadd( ::aProfile, HBProfileMethod():new( cClass + ":" + aMembers[ nMember ], __GetMsgPrf( n, aMembers[ nMember ] ) ) ) + AAdd( ::aProfile, HBProfileMethod():new( cClass + ":" + aMembers[ nMember ], __GetMsgPrf( n, aMembers[ nMember ] ) ) ) EndIf Next @@ -428,7 +428,7 @@ Local nMember __setProfiler( lProfile ) -Return( self ) +Return Self ///// @@ -446,62 +446,62 @@ Local lProfile := __setProfiler( .F. ) __setProfiler( lProfile ) -Return( self ) +Return Self ///// Method forEach( b ) Class HBProfile Local lProfile := __setProfiler( .F. ) - aeval( ::aProfile, b ) + AEval( ::aProfile, b ) __setProfiler( lProfile ) -Return( self ) +Return Self ///// Method sort( b ) Class HBProfile Local lProfile := __setProfiler( .F. ) - asort( ::aProfile,,, b ) + ASort( ::aProfile,,, b ) __setProfiler( lProfile ) -Return( self ) +Return Self ///// Method nameSort Class HBProfile Local lProfile := __setProfiler( .F. ) - ::sort( {|oX, oY| oX:cName < oY:cName } ) + ::sort( {| oX, oY | oX:cName < oY:cName } ) __setProfiler( lProfile ) -Return( self ) +Return Self ///// Method callSort Class HBProfile Local lProfile := __setProfiler( .F. ) - ::sort( {|oX, oY| oX:nCalls > oY:nCalls } ) + ::sort( {| oX, oY | oX:nCalls > oY:nCalls } ) __setProfiler( lProfile ) -Return( self ) +Return Self ///// Method timeSort Class HBProfile Local lProfile := __setProfiler( .F. ) - ::sort( {|oX, oY| oX:nTicks > oY:nTicks } ) + ::sort( {| oX, oY | oX:nTicks > oY:nTicks } ) __setProfiler( lProfile ) -Return( self ) +Return Self ///// @@ -509,11 +509,11 @@ Method totalCalls Class HBProfile Local lProfile := __setProfiler( .F. ) Local nCalls := 0 - ::forEach( {|o| nCalls += o:nCalls } ) + ::forEach( {| o | nCalls += o:nCalls } ) __setProfiler( lProfile ) -Return( nCalls ) +Return nCalls ///// @@ -521,11 +521,11 @@ Method totalTicks Class HBProfile Local lProfile := __setProfiler( .F. ) Local nTicks := 0 - ::forEach( {|o| nTicks += o:nTicks } ) + ::forEach( {| o | nTicks += o:nTicks } ) __setProfiler( lProfile ) -Return( nTicks ) +Return nTicks ///// @@ -533,11 +533,11 @@ Method totalSeconds Class HBProfile Local lProfile := __setProfiler( .F. ) Local nSeconds := 0 - ::forEach( {|o| nSeconds += o:nSeconds } ) + ::forEach( {| o | nSeconds += o:nSeconds } ) __setProfiler( lProfile ) -Return( nSeconds ) +Return nSeconds //////////////////////////////////////////////////////////////////////////// // Class: HBProfileLowLevel @@ -552,7 +552,7 @@ Create Class HBProfileLowLevel Inherit HBProfile Method gatherOPCodes -End Class +Endclass ///// @@ -567,7 +567,7 @@ Local lProfile := __setProfiler( .F. ) __setProfiler( lProfile ) -Return( self ) +Return Self ///// @@ -579,20 +579,20 @@ Local nOP // Loop over all the harbour OP codes. Note that they start at 0. 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 ) ) ) + AAdd( ::aProfile, HBProfileOPCode():new( cName, __OpGetPrf( nOP ) ) ) EndIf Next -Return( self ) +Return Self //////////////////////////////////////////////////////////////////////////// // Class: HBProfileReport Create Class HBProfileReport -// Protected: + Protected: Var oProfile @@ -607,7 +607,7 @@ Create Class HBProfileReport Method init Method generate -End Class +Endclass ///// @@ -618,21 +618,21 @@ Local lProfile := __setProfiler( .F. ) __setProfiler( lProfile ) -Return( self ) +Return Self ///// Method writeLines( aLines ) Class HBProfileReport - aeval( aLines, {|c| qout( c ) } ) + AEval( aLines, {| c | QOut( c ) } ) -Return( self ) +Return Self ///// Method header Class HBProfileReport -Return( { "Name Type Calls Ticks Seconds",; - "=================================== ========== ======== =========== ===========" } ) +Return { "Name Type Calls Ticks Seconds",; + "=================================== ========== ======== =========== ===========" } ///// @@ -640,16 +640,16 @@ 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 ) } ) +Return { PadR( oEntity:cName, 35 ) + " " + ; + PadR( oEntity:describe(), 8 ) + " " + ; + PadL( oEntity:nCalls, 10 ) + " " + ; + PadL( oEntity:nTicks, 11 ) + " " + ; + Str( oEntity:nSeconds, 11, 2 ) } ///// @@ -657,7 +657,7 @@ Method emitLine( oEntity ) Class HBProfileReport ::writeLines( ::line( oEntity ) ) -Return( self ) +Return Self ///// @@ -666,18 +666,18 @@ Local lProfile := __setProfiler( .F. ) Default bFilter To {|| .T. } - ::emitHeader():oProfile:forEach( {|o| if( eval( bFilter, o ), ::emitLine( o ), NIL ) } ) + ::emitHeader():oProfile:forEach( {| o | iif( Eval( bFilter, o ), ::emitLine( o ), NIL ) } ) __setProfiler( lProfile ) -Return( self ) +Return Self //////////////////////////////////////////////////////////////////////////// // Class: HBProfileReportToFile Create Class HBProfileReportToFile Inherit HBProfileReport -// Protected: + Protected: Var hFile @@ -687,17 +687,17 @@ Create Class HBProfileReportToFile Inherit HBProfileReport Method generate -End Class +Endclass ///// Method writeLines( aLines ) Class HBProfileReportToFile If ::hFile != F_ERROR - aeval( aLines, {|c| fwrite( ::hFile, c + HB_OSNewLine() ) } ) + AEval( aLines, {| c | FWrite( ::hFile, c + HB_OSNewLine() ) } ) EndIf -Return( self ) +Return Self ///// @@ -715,14 +715,14 @@ Local lProfile := __setProfiler( .F. ) __setProfiler( lProfile ) -Return( self ) +Return Self //////////////////////////////////////////////////////////////////////////// // Class: HBProfileReportToArray Create Class HBProfileReportToArray Inherit HBProfileReport -// Protected: + Protected: Var aReport @@ -732,15 +732,15 @@ Create Class HBProfileReportToArray Inherit HBProfileReport Method generate -End Class +Endclass ///// Method writeLines( aLines ) Class HBProfileReportToArray - aeval( aLines, {|c| aadd( ::aReport, c ) } ) + AEval( aLines, {| c | AAdd( ::aReport, c ) } ) -Return( self ) +Return Self ///// @@ -749,7 +749,7 @@ Method generate( bFilter ) Class HBProfileReportToArray ::aReport := {} ::super:generate( bFilter ) -Return( ::aReport ) +Return ::aReport //////////////////////////////////////////////////////////////////////////// // Class: HBProfileReportToString @@ -760,16 +760,16 @@ Create Class HBProfileReportToString Inherit HBProfileReportToArray Method generate -End Class +Endclass ///// Method generate( bFilter ) Class HBProfileReportToString Local cReport := "" - aeval( ::super:generate( bFilter ), {|c| cReport += c + HB_OSNewLine() } ) + AEval( ::super:generate( bFilter ), {| c | cReport += c + HB_OSNewLine() } ) -Return( cReport ) +Return cReport //////////////////////////////////////////////////////////////////////////// // Class: HBProfileReportToTBrowse @@ -777,7 +777,7 @@ Return( cReport ) Create Class HBProfileReportToTBrowse Inherit HBProfileReportToArray -// Protected: + Protected: Var nEntity @@ -790,7 +790,7 @@ Create Class HBProfileReportToTBrowse Inherit HBProfileReportToArray Method generate Method currentEntity -End Class +Endclass ///// @@ -798,16 +798,16 @@ Method emitHeader Class HBProfileReportToTBrowse // No header required. -Return( self ) +Return Self ///// Method emitLine( oEntity ) Class HBProfileReportToTBrowse // Don't "emit" anything, simply add the entity to the array. - aadd( ::aReport, oEntity ) + AAdd( ::aReport, oEntity ) -Return( self ) +Return Self ///// @@ -822,39 +822,39 @@ Local oBrowse ::super:generate( bFilter ) // Build the browse. - oBrowse := tbrowsenew( nTop, nLeft, nBottom, nRight ) + oBrowse := TBrowseNew( nTop, nLeft, nBottom, nRight ) oBrowse:goTopBlock := {|| ::nEntity := 1 } - oBrowse:goBottomBlock := {|| ::nEntity := len( ::aReport ) } - oBrowse:skipBlock := {|nSkip, nPos| nPos := ::nEntity, ; - ::nEntity := if( nSkip > 0, ; - min( len( ::aReport ), ::nEntity + nSkip ), ; - max( 1, ::nEntity + nSkip ) ), ::nEntity - nPos } + oBrowse:goBottomBlock := {|| ::nEntity := Len( ::aReport ) } + oBrowse:skipBlock := {| nSkip, nPos | nPos := ::nEntity, ; + ::nEntity := iif( nSkip > 0, ; + Min( Len( ::aReport ), ::nEntity + nSkip ), ; + Max( 1, ::nEntity + nSkip ) ), ::nEntity - nPos } ::addColumns( oBrowse ) __setProfiler( lProfile ) -Return( oBrowse ) +Return oBrowse ///// Method addColumns( oBrowse ) Class HBProfileReportToTBrowse - oBrowse:addColumn( tbcolumnnew( "Name", {|| padr( ::currentEntity():cName, 35 ) } ) ) - oBrowse:addColumn( tbcolumnnew( "Type", {|| padr( ::currentEntity():describe(), 8 ) } ) ) - oBrowse:addColumn( tbcolumnnew( "Calls", {|| padl( ::currentEntity():nCalls, 10 ) } ) ) - oBrowse:addColumn( tbcolumnnew( "Ticks", {|| padl( ::currentEntity():nTicks, 11 ) } ) ) - oBrowse:addColumn( tbcolumnnew( "Seconds", {|| str( ::currentEntity():nSeconds, 11, 2 ) } ) ) - oBrowse:addColumn( tbcolumnnew( "Mean;Ticks", {|| str( ::currentEntity():nMeanTicks, 11, 2 ) } ) ) - oBrowse:addColumn( tbcolumnnew( "Mean;Seconds", {|| str( ::currentEntity():nMeanSeconds, 11, 2 ) } ) ) + oBrowse:addColumn( TBColumnNew( "Name", {|| PadR( ::currentEntity():cName, 35 ) } ) ) + oBrowse:addColumn( TBColumnNew( "Type", {|| PadR( ::currentEntity():describe(), 8 ) } ) ) + oBrowse:addColumn( TBColumnNew( "Calls", {|| PadL( ::currentEntity():nCalls, 10 ) } ) ) + oBrowse:addColumn( TBColumnNew( "Ticks", {|| PadL( ::currentEntity():nTicks, 11 ) } ) ) + oBrowse:addColumn( TBColumnNew( "Seconds", {|| Str( ::currentEntity():nSeconds, 11, 2 ) } ) ) + 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 ] ) +Return ::aReport[ ::nEntity ] /* * profiler.prg ends here. diff --git a/harbour/source/rtl/pushbtn.prg b/harbour/source/rtl/pushbtn.prg index 982d2f3a7e..3c7f8b0a45 100644 --- a/harbour/source/rtl/pushbtn.prg +++ b/harbour/source/rtl/pushbtn.prg @@ -50,7 +50,7 @@ * */ -#include 'hbclass.ch' +#include "hbclass.ch" #include "button.ch" #include "color.ch" diff --git a/harbour/source/rtl/radiogrp.prg b/harbour/source/rtl/radiogrp.prg index 1ff816591a..db28c70b48 100644 --- a/harbour/source/rtl/radiogrp.prg +++ b/harbour/source/rtl/radiogrp.prg @@ -321,7 +321,7 @@ METHOD killFocus() CLASS RADIOGROUP LOCAL nLen LOCAL aItems - LOCAL nCurMCur + LOCAL nOldMCur IF ::lHasFocus @@ -334,7 +334,7 @@ METHOD killFocus() CLASS RADIOGROUP aItems := ::aItems nLen := ::nItemCount - nCurMCur := MSetCursor( .F. ) + nOldMCur := MSetCursor( .F. ) DispBegin() @@ -346,7 +346,7 @@ METHOD killFocus() CLASS RADIOGROUP DispEnd() - MSetCursor( nCurMCur ) + MSetCursor( nOldMCur ) SetCursor( ::nCursor ) ENDIF @@ -359,7 +359,7 @@ METHOD setFocus() CLASS RADIOGROUP LOCAL nLen LOCAL aItems - LOCAL nCurMCur + LOCAL nOldMCur IF !::lHasFocus @@ -369,7 +369,7 @@ METHOD setFocus() CLASS RADIOGROUP aItems := ::aItems nLen := ::nItemCount - nCurMCur := MSetCursor( .F. ) + nOldMCur := MSetCursor( .F. ) DispBegin() @@ -381,7 +381,7 @@ METHOD setFocus() CLASS RADIOGROUP DispEnd() - MSetCursor( nCurMCur ) + MSetCursor( nOldMCur ) IF ISBLOCK( ::bFBlock ) Eval( ::bFBlock ) @@ -477,7 +477,7 @@ METHOD setStyle( cStyle ) CLASS RADIOGROUP RETURN Self METHOD changeButton( nUnselect, nSelect ) CLASS RADIOGROUP - LOCAL nCurMCur := MSetCursor( .F. ) + LOCAL nOldMCur := MSetCursor( .F. ) IF nUnselect != nSelect @@ -500,7 +500,7 @@ METHOD changeButton( nUnselect, nSelect ) CLASS RADIOGROUP ENDIF - MSetCursor( nCurMCur ) + MSetCursor( nOldMCur ) RETURN Self diff --git a/harbour/source/rtl/scalar.prg b/harbour/source/rtl/scalar.prg index 9a6b7e502a..56369813ec 100644 --- a/harbour/source/rtl/scalar.prg +++ b/harbour/source/rtl/scalar.prg @@ -55,7 +55,7 @@ #include "hbclass.ch" -CLASS ScalarObject +CREATE CLASS ScalarObject MESSAGE Become METHOD BecomeErr() // a scalar cannot "become" another object METHOD Copy() @@ -79,22 +79,22 @@ METHOD AsString() CLASS ScalarObject local cType := ValType( Self ) do case - case cType == 'B' + case cType == "B" return "{ || ... }" - case cType == 'C' + case cType == "C" return Self - case cType == 'D' + case cType == "D" return DToC( Self ) - case cType == 'L' - return If( Self, ".T.", ".F." ) + case cType == "L" + return iif( Self, ".T.", ".F." ) - case cType == 'N' + case cType == "N" return LTrim( Str( Self ) ) - case cType == 'U' + case cType == "U" return "NIL" endcase @@ -104,16 +104,15 @@ METHOD AsExpStr() CLASS ScalarObject local cType := ValType( Self ) - if cType == 'C' + if cType == "C" return ["] + Self + ["] - - elseif cType == 'D' + elseif cType == "D" return [CToD("] + DToC( Self ) + [")] - end + endif return ::AsString() METHOD BecomeErr() CLASS ScalarObject // Not implemented yet - // ::error(CSYERR_BECOME, "Message 'become' illegally sent to scalar", ::className) -return nil + // ::error( CSYERR_BECOME, "Message 'become' illegally sent to scalar", ::ClassName() ) +return NIL diff --git a/harbour/source/rtl/symbol.prg b/harbour/source/rtl/symbol.prg index 1c59365008..db221d8e8f 100644 --- a/harbour/source/rtl/symbol.prg +++ b/harbour/source/rtl/symbol.prg @@ -52,17 +52,18 @@ #include "hbclass.ch" -CLASS Symbol +CREATE CLASS Symbol - DATA nSym HIDDEN // internal pointer to the Symbols table symbol + PROTECTED: + + VAR nSym // internal pointer to the Symbols table symbol + + EXPORT: METHOD New( cSymName ) // Constructor. cSymName may already exists or not - - METHOD Name() // retrieves the symbol name - - METHOD IsEqual( oSymbol ) // Compares two symbol objects - - METHOD Exec() // Executes the function referred to by the + METHOD name() // retrieves the symbol name + METHOD isEqual( oSymbol ) // Compares two symbol objects + METHOD exec() // Executes the function referred to by the // Symbol object, with an optional parameters list ENDCLASS @@ -71,11 +72,11 @@ METHOD New( cSymName ) CLASS Symbol ::nSym := __DynSN2Sym( cSymName ) return Self -METHOD Name() CLASS Symbol +METHOD name() CLASS Symbol return ::nSym:Name -METHOD IsEqual( oSymbol ) CLASS Symbol +METHOD isEqual( oSymbol ) CLASS Symbol return ::ClassH == oSymbol:ClassH .AND. ::nSym:Name == oSymbol:nSym:Name -METHOD Exec( ... ) CLASS Symbol +METHOD exec( ... ) CLASS Symbol return ::nSym:exec( ... ) diff --git a/harbour/source/rtl/tbrowse.prg b/harbour/source/rtl/tbrowse.prg index 9ecf4cb271..23a8b77759 100644 --- a/harbour/source/rtl/tbrowse.prg +++ b/harbour/source/rtl/tbrowse.prg @@ -63,9 +63,13 @@ * Copyright 2001 Manu Exposito * Activate data PICTURE DispCell( nColumn, nColor ) * + * Copyright 2007 Viktor Szakats + * tbr_CookColor(), tbr_GetColor() + * + * See doc/license.txt for licensing terms. + * */ - /* NOTE: Don't use SAY in this module, use DispOut(), DispOutAt() instead, otherwise it will not be CA-Cl*pper compatible. ADDITION: Same goes for DevPos(), always use SetPos() instead. @@ -212,6 +216,7 @@ CREATE CLASS TBrowse VAR n_Bottom INIT 0 // Bottom row number for the TBrowse display VAR n_Right INIT 0 // Rightmost column for the TBrowse display VAR cColorSpec // Color table for the TBrowse display + VAR aColorSpec // Color table for the TBrowse display (preprocessed) VAR cColSep INIT " " // Column separator character VAR cFootSep INIT "" // Footing separator character VAR cHeadSep INIT "" // Heading separator character @@ -302,8 +307,10 @@ METHOD configure( nMode ) CLASS TBrowse local n local nHeight +#ifdef HB_COMPAT_C53 local nLeft local nRight +#endif ::lHeaders := .F. ::lFooters := .F. @@ -1070,7 +1077,7 @@ METHOD stabilize() CLASS TBrowse if ::aRedraw[ nRow ] DispOutAt( ::n_Top + nRow + iif( ::lHeaders, ::nHeaderHeight, 0 ) + iif( Empty( ::cHeadSep ) .or. !::lHeaders, 0, 1 ) - 1, ::n_Left,; - Space( ( nWidth - ::nColsWidth ) / 2 ), ::cColorSpec ) + Space( ( nWidth - ::nColsWidth ) / 2 ), ::aColorSpec[ 1 ] ) for n := iif( ::nFrozenCols > 0, 1, ::leftVisible ) to ::rightVisible @@ -1097,21 +1104,21 @@ METHOD stabilize() CLASS TBrowse ::DispCell( nRow, n, TBC_CLR_STANDARD ) else // Clear cell - DispOut( Space( ::aColsWidth[ n ] ), tbr_GetColor( ::cColorSpec, ::aColumns[ n ]:defColor, TBC_CLR_STANDARD ) ) + DispOut( Space( ::aColsWidth[ n ] ), tbr_GetColor( ::aColorSpec, ::aColumns[ n ]:defColor, TBC_CLR_STANDARD ) ) endif if n < ::rightVisible if ::aColumns[ n + 1 ]:ColSep != NIL - DispOut( ::aColumns[ n + 1 ]:ColSep, ::cColorSpec ) + DispOut( ::aColumns[ n + 1 ]:ColSep, ::aColorSpec[ 1 ] ) elseif ::cColSep != NIL - DispOut( ::cColSep, ::cColorSpec ) + DispOut( ::cColSep, ::aColorSpec[ 1 ] ) endif endif next - DispOut( Space( Int( Round( ( nWidth - ::nColsWidth ) / 2, 0 ) ) ), ::cColorSpec ) + DispOut( Space( Int( Round( ( nWidth - ::nColsWidth ) / 2, 0 ) ) ), ::aColorSpec[ 1 ] ) // doesn't need to be redrawn ::aRedraw[ nRow ] := .F. @@ -1470,14 +1477,14 @@ METHOD DispCell( nRow, nCol, nMode ) CLASS TBrowse nRow >= ::aRect[ 1 ] .and. ; nRow <= ::aRect[ 3 ] .and. ; ! Empty( ::aRectColor ) - cColor := tbr_GetColor( ::cColorSpec, ::aRectColor, nMode ) + cColor := tbr_GetColor( ::aColorSpec, ::aRectColor, nMode ) else /* NOTE: Not very optimal that we're evaluating this block all the time. But CA-Cl*pper always has a block here, and there is no other way to tell if the code in it is NIL (the default) or something valuable. [vszakats] */ aDefColor := Eval( oCol:colorBlock, ftmp ) - cColor := tbr_GetColor( ::cColorSpec, iif( ISARRAY( aDefColor ), aDefColor, oCol:defColor ), nMode ) + cColor := tbr_GetColor( ::aColorSpec, iif( ISARRAY( aDefColor ), aDefColor, oCol:defColor ), nMode ) endif do case @@ -1518,7 +1525,7 @@ METHOD WriteMLineText( cStr, nPadLen, lHeader, cColor ) CLASS TBrowse DispOut( PadR( cStr, nPadLen ), cColor ) else // Headers are aligned to bottom - cStr := Replicate( ";", ::nHeaderHeight - hb_TokenCount( cStr, ";" ) + 1 ) + cStr + cStr := Replicate( ";", ::nHeaderHeight - hb_TokenCount( cStr, ";" ) ) + cStr for n := ::nHeaderHeight to 1 step -1 SetPos( nRow + n - 1, nCol ) @@ -1592,11 +1599,22 @@ METHOD redrawHeaders() CLASS TBrowse local nScreenRowB local nLCS // Len( ColSep ) local nWidth := ::n_Right - ::n_Left + 1 + local nColor - if ::lHeaders // Drawing headers + if ::lHeaders // Drawing headers // Clear area of screen occupied by headers - DispBox( ::n_Top, ::n_Left, ::n_Top + ::nHeaderHeight - 1, ::n_Right, cBlankBox, ::cColorSpec ) + DispBox( ::n_Top, ::n_Left, ::n_Top + ::nHeaderHeight - 1, ::n_Right, cBlankBox, ::aColorSpec[ 1 ] ) + + if Empty( ::cHeadSep ) // Draw horizontal heading separator line + nScreenRowT := NIL + /* ; NOTE: This is a bug in CA-Cl*pper 5.3. [vszakats] */ + nColor := TBC_CLR_STANDARD + else + DispOutAt( ( nScreenRowT := ::n_Top + ::nHeaderHeight ), ::n_Left,; + Replicate( Right( ::cHeadSep, 1 ), nWidth ), ::aColorSpec[ 1 ] ) + nColor := TBC_CLR_HEADING + endif // Set cursor at first field start of description SetPos( ::n_Top, ::n_Left + ( ( nWidth - ::nColsWidth ) / 2 ) ) @@ -1606,7 +1624,7 @@ METHOD redrawHeaders() CLASS TBrowse n := ::leftVisible endif - ::WriteMLineText( ::aColumns[ n ]:Heading, ::aColsWidth[ n ], .T., tbr_GetColor( ::cColorSpec, ::aColumns[ n ]:defColor, TBC_CLR_HEADING ) ) + ::WriteMLineText( ::aColumns[ n ]:Heading, ::aColsWidth[ n ], .T., tbr_GetColor( ::aColorSpec, ::aColumns[ n ]:defColor, nColor ) ) if n < ::rightVisible // Set cursor at start of next field description @@ -1615,49 +1633,20 @@ METHOD redrawHeaders() CLASS TBrowse next endif - if ! Empty( ::cHeadSep ) .and. ::lHeaders // Draw horizontal heading separator line - DispOutAt( ( nScreenRowT := ::n_Top + ::nHeaderHeight ), ::n_Left,; - Replicate( Right( ::cHeadSep, 1 ), nWidth ), ::cColorSpec ) - else - nScreenRowT := NIL - endif - - if ! Empty( ::cFootSep ) .and. ::lFooters // Draw horizontal footing separator line - DispOutAt( ( nScreenRowB := ::n_Bottom - ::nFooterHeight ), ::n_Left,; - Replicate( Right( ::cFootSep, 1 ), nWidth ), ::cColorSpec ) - else - nScreenRowB := NIL - endif - - nTPos := nBPos := ::n_Left + ( ( nWidth - ::nColsWidth ) / 2 ) - - // Draw headin/footing column separator - for n := iif( ::nFrozenCols > 0, 1, ::leftVisible ) to ::rightVisible - if ::nFrozenCols > 0 .and. n == ::nFrozenCols + 1 - n := ::leftVisible - endif - - if n < ::rightVisible - - nLCS := iif( ::aColumns[ n + 1 ]:ColSep != NIL, Len( ::aColumns[ n + 1 ]:ColSep ), Len( ::cColSep ) ) - - if nScreenRowT != NIL - DispOutAt( nScreenRowT, ( nTPos += ::aColsWidth[ n ] ), Left( ::cHeadSep, nLCS ), ::cColorSpec ) - nTPos += nLCS - endif - - if nScreenRowB != NIL - DispOutAt( nScreenRowB, ( nBPos += ::aColsWidth[ n ] ), Left( ::cFootSep, nLCS ), ::cColorSpec ) - nBPos += nLCS - endif - - endif - next - - if ::lFooters // Drawing footers + if ::lFooters // Drawing footers // Clear area of screen occupied by footers - DispBox( ::n_Bottom - ::nFooterHeight + 1, ::n_Left, ::n_Bottom, ::n_Right, cBlankBox, ::cColorSpec ) + DispBox( ::n_Bottom - ::nFooterHeight + 1, ::n_Left, ::n_Bottom, ::n_Right, cBlankBox, ::aColorSpec[ 1 ] ) + + if Empty( ::cFootSep ) // Draw horizontal footing separator line + nScreenRowB := NIL + /* ; NOTE: This is a bug in CA-Cl*pper 5.3. [vszakats] */ + nColor := TBC_CLR_STANDARD + else + DispOutAt( ( nScreenRowB := ::n_Bottom - ::nFooterHeight ), ::n_Left,; + Replicate( Right( ::cFootSep, 1 ), nWidth ), ::aColorSpec[ 1 ] ) + nColor := TBC_CLR_FOOTING + endif // Set cursor at first field start of description SetPos( ::n_Bottom, ::n_Left + ( ( nWidth - ::nColsWidth ) / 2 ) ) @@ -1667,7 +1656,7 @@ METHOD redrawHeaders() CLASS TBrowse n := ::leftVisible endif - ::WriteMLineText( ::aColumns[ n ]:Footing, ::aColsWidth[ n ], .F., tbr_GetColor( ::cColorSpec, ::aColumns[ n ]:defColor, TBC_CLR_FOOTING ) ) + ::WriteMLineText( ::aColumns[ n ]:Footing, ::aColsWidth[ n ], .F., tbr_GetColor( ::aColorSpec, ::aColumns[ n ]:defColor, nColor ) ) if n < ::rightVisible // Set cursor at start of next field description @@ -1676,6 +1665,32 @@ METHOD redrawHeaders() CLASS TBrowse next endif + nTPos := nBPos := ::n_Left + ( ( nWidth - ::nColsWidth ) / 2 ) + + // Draw headin/footing column separator + for n := iif( ::nFrozenCols > 0, 1, ::leftVisible ) to ::rightVisible + + if ::nFrozenCols > 0 .and. n == ::nFrozenCols + 1 + n := ::leftVisible + endif + + if n < ::rightVisible + + nLCS := iif( ::aColumns[ n + 1 ]:ColSep != NIL, Len( ::aColumns[ n + 1 ]:ColSep ), Len( ::cColSep ) ) + + if nScreenRowT != NIL + DispOutAt( nScreenRowT, ( nTPos += ::aColsWidth[ n ] ), Left( ::cHeadSep, nLCS ), ::aColorSpec[ 1 ] ) + nTPos += nLCS + endif + + if nScreenRowB != NIL + DispOutAt( nScreenRowB, ( nBPos += ::aColsWidth[ n ] ), Left( ::cFootSep, nLCS ), ::aColorSpec[ 1 ] ) + nBPos += nLCS + endif + + endif + next + return Self // NOTE: Not tested, could be broken @@ -1692,10 +1707,10 @@ METHOD MGotoYX( nRow, nCol ) CLASS TBrowse // if not stable force repositioning of data source; maybe this is not first Stabilize() call after // TBrowse became unstable, but we need to call Stabilize() al least one time before moving again to be sure // data source is under cursor position - if ! ::lStable - ::Stabilize() - else + if ::lStable ::Moved() + else + ::stabilize() endif // Set new row position @@ -1788,6 +1803,7 @@ METHOD colorSpec( cColorSpec ) CLASS TBrowse if cColorSpec != NIL ::cColorSpec := _eInstVar( Self, "COLORSPEC", cColorSpec, "C", 1001 ) + ::aColorSpec := tbr_CookColor( ::cColorSpec ) ::Configure( 1 ) endif @@ -2096,6 +2112,7 @@ METHOD New( nTop, nLeft, nBottom, nRight ) CLASS TBrowse ::nRight := nRight ::cColorSpec := SetColor() + ::aColorSpec := tbr_CookColor( ::cColorSpec ) #ifdef HB_COMPAT_C53 ::rect := { ::n_Top, ::n_Left, ::n_Bottom, ::n_Right } @@ -2108,9 +2125,53 @@ FUNCTION TBrowseNew( nTop, nLeft, nBottom, nRight ) /* -------------------------------------------- */ +/* NOTE: Preprocess user-supplied colorstring for internal usage. This is + needed to keep full C5.x compatibility while maintaining performace. + C5.x would always have at least two items, defaulted to the + current SetColor() values, the rest of the items are defaulted + to "N/N". [vszakats] */ +STATIC FUNCTION tbr_CookColor( cColorSpec ) + + local nCount := Max( hb_TokenCount( cColorSpec, "," ), 2 ) + local aColorSpec := Array( nCount ) + local cColor + local nPos + + for nPos := 1 TO nCount + cColor := hb_TokenGet( @cColorSpec, nPos, "," ) + if nPos <= 2 + aColorSpec[ nPos ] := iif( hb_ColorToN( cColor ) == 0 .AND. !( Upper( StrTran( cColor, " ", "" ) ) == "N/N" ), hb_ColorIndex( SetColor( "" ), nPos - 1 ), cColor ) + else + aColorSpec[ nPos ] := iif( hb_ColorToN( cColor ) == 0, "N/N", cColor ) + endif + next + + return aColorSpec + /* NOTE: nMode can be 1/2 or 1/2/3/4 when compiled with HB_COMPAT_C53 (default) [vszakats] */ -STATIC FUNCTION tbr_GetColor( cColorSpec, aDefColor, nMode ) - return hb_ColorIndex( cColorSpec, iif( ISARRAY( aDefColor ) .and. nMode <= Len( aDefColor ), aDefColor, { 1, 2, 1, 1 } )[ nMode ] - 1 ) +STATIC FUNCTION tbr_GetColor( aColorSpec, aDefColor, nMode ) + + /* NOTE: This is what C5.x does when the specified index is out of range + in the color items sepcified in ::cColorSpec. See in tbr_CookColor() + that we always have at least two color items. [vszakats] */ + #define _COLORPOS_COOK( nPos ) iif( nPos > Len( aColorSpec ), 2 - ( nPos % 2 ), nPos ) + + if !ISARRAY( aDefColor ) + /* NOTE: This fits both C5.2 and C5.3. In C5.2 nMode is 1 or 2. [vszakats] */ + return aColorSpec[ { 1, 2, 1, 1 }[ nMode ] ] + elseif nMode > Len( aDefColor ) + /* NOTE: C5.3 and C5.2 compatible method. To be backwards compatible, + C5.3 will fall back to C5.2 colors if the extra HEADING/FOOTING + positions are not specified. [vszakats] */ + switch nMode + case TBC_CLR_STANDARD ; return aColorSpec[ 1 ] + case TBC_CLR_ENHANCED ; return aColorSpec[ 2 ] + case TBC_CLR_HEADING ; return aColorSpec[ iif( Len( aDefColor ) >= 1, _COLORPOS_COOK( aDefColor[ 1 ] ), 1 ) ] + case TBC_CLR_FOOTING ; return aColorSpec[ iif( Len( aDefColor ) >= 1, _COLORPOS_COOK( aDefColor[ 1 ] ), 1 ) ] + endswitch + endif + + return aColorSpec[ _COLORPOS_COOK( aDefColor[ nMode ] ) ] STATIC FUNCTION tbr_CalcWidth( xValue, cType, cPicture ) diff --git a/harbour/source/rtl/ttextlin.prg b/harbour/source/rtl/ttextlin.prg index adf6d53dc4..fcf8c620d5 100644 --- a/harbour/source/rtl/ttextlin.prg +++ b/harbour/source/rtl/ttextlin.prg @@ -52,10 +52,10 @@ #include "hbclass.ch" -CLASS HBTextLine +CREATE CLASS HBTextLine - DATA cText // A line of text - DATA 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 ) @@ -68,4 +68,3 @@ METHOD New( cLine, lSoftCR ) CLASS HBTextLine ::lSoftCR := iif( Empty( lSoftCR ), .F., lSoftCR ) RETURN Self - diff --git a/harbour/source/rtl/typefile.prg b/harbour/source/rtl/typefile.prg index 2f6febfbe4..dd5e29669c 100644 --- a/harbour/source/rtl/typefile.prg +++ b/harbour/source/rtl/typefile.prg @@ -83,7 +83,7 @@ PROCEDURE __TypeFile( cFile, lPrint ) cTmp := SET( _SET_DEFAULT ) + ";" + SET( _SET_PATH ) cTmp := StrTran( cTmp, ",", ";" ) i := Len( cTmp ) - WHILE SubStr( cTmp, i, 1 ) == ";" // remove last ";" + DO WHILE SubStr( cTmp, i, 1 ) == ";" // remove last ";" cTmp := LEFT( cTmp, --i ) ENDDO aPath := HB_ATOKENS( cTmp, ";" )