diff --git a/harbour/ChangeLog b/harbour/ChangeLog index a1452bfa81..349a9b38c0 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,18 @@ 2002-12-01 13:30 UTC+0100 Foo Bar */ +2007-09-12 08:29 UTC+0100 Viktor Szakats (harbour.01 syenar.hu) + * source/rtl/getsys.prg + ! Fix for crash in TGetList():ShowGetMsg() reported by Lorenzo. + + * contrib/libct/blank.prg + * source/rtl/menuto.prg + * source/rtl/valtoexp.prg + * source/rtl/readkey.prg + * source/rtl/browse.prg + * source/debug/debugger.prg + + Replaced END with ENDSWITCH and ENDWITH + 2007-09-12 02:10 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl) * harbour/include/std.ch * cover ENDSEQUENCE translation with HB_C52_STRICT macro diff --git a/harbour/contrib/libct/blank.prg b/harbour/contrib/libct/blank.prg index aede7c228a..c558ddde1d 100644 --- a/harbour/contrib/libct/blank.prg +++ b/harbour/contrib/libct/blank.prg @@ -87,6 +87,7 @@ FUNCTION BLANK( xItem, xMode ) OTHERWISE xRet:=.F. - END + + ENDSWITCH RETURN xRet diff --git a/harbour/source/debug/debugger.prg b/harbour/source/debug/debugger.prg index 59966b0efa..de80a19ccc 100644 --- a/harbour/source/debug/debugger.prg +++ b/harbour/source/debug/debugger.prg @@ -1046,7 +1046,7 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger ENDIF :Resize( Val( cParam1 ), n, ; :nBottom + Val( cParam1 ) - :nTop, :nRight + n - :nLeft ) - END + ENDWITH CASE starts( "NEXT", cParam ) ::NextWindow() CASE starts( "SIZE", cParam ) @@ -1056,7 +1056,7 @@ METHOD DoCommand( cCommand ) CLASS HBDebugger :Resize( :nTop, :nLeft, Val( cParam1 ) - 1 + :nTop, ; Val( SubStr( cParam1, n ) ) - 1 + :nLeft ) ENDIF - END + ENDWITH ENDCASE CASE starts( "WP", cCommand ) diff --git a/harbour/source/rtl/browse.prg b/harbour/source/rtl/browse.prg index 58d000501d..4cde0bfa6f 100644 --- a/harbour/source/rtl/browse.prg +++ b/harbour/source/rtl/browse.prg @@ -273,7 +273,7 @@ FUNCTION Browse( nTop, nLeft, nBottom, nRight ) lKeyPressed := .T. ENDIF EXIT - END + ENDSWITCH IF lRefresh lRefresh := lAppend := .F. @@ -390,7 +390,7 @@ STATIC FUNCTION ExitKey( lAppend ) nKey := IIF( nKey == 13 .OR. ; ( nKey >= 32 .AND. nKey <= 255 ), K_RIGHT, 0 ) EXIT - END + ENDSWITCH RETURN nKey diff --git a/harbour/source/rtl/getsys.prg b/harbour/source/rtl/getsys.prg index 7161052b4c..c3eedb7de7 100644 --- a/harbour/source/rtl/getsys.prg +++ b/harbour/source/rtl/getsys.prg @@ -124,7 +124,7 @@ FUNCTION ReadModal( GetList, nPos ) oGetList:nHitCode := 0 oGetList:nMenuID := 0 - aMsg := { , nMsgRow, nMsgLeft, nMsgRight, cMsgColor, , , , , } + aMsg := { lMsgFlag, nMsgRow, nMsgLeft, nMsgRight, cMsgColor, , , , , } #endif DO WHILE oGetList:nPos != 0 diff --git a/harbour/source/rtl/menuto.prg b/harbour/source/rtl/menuto.prg index 1a31775ce6..bb811eaa16 100644 --- a/harbour/source/rtl/menuto.prg +++ b/harbour/source/rtl/menuto.prg @@ -18,138 +18,139 @@ #include "inkey.ch" #include "hbmemvar.ch" #include "setcurs.ch" -#xtranslate COLORARRAY() => &( '{"' + strtran(, ',', '","') + '"}' ) + +#xtranslate COLORARRAY( ) => &( '{"' + StrTran( , ',', '","' ) + '"}' ) STATIC s_aLevel := {} STATIC s_nPointer := 1 FUNCTION __AtPrompt( nRow, nCol, cPrompt, cMsg, cColor ) - if s_nPointer < 1 + IF s_nPointer < 1 s_nPointer := 1 - endif + ENDIF // add the current level empty array. - do while len( s_aLevel ) < s_nPointer - aadd( s_aLevel, {} ) - enddo + DO WHILE Len( s_aLevel ) < s_nPointer + AAdd( s_aLevel, {} ) + ENDDO // add to the static array - aadd( s_aLevel[ s_nPointer ], { nRow, nCol, cPrompt, cMsg, cColor} ) + AAdd( s_aLevel[ s_nPointer ], { nRow, nCol, cPrompt, cMsg, cColor } ) // put this prompt on the screen right now DispOutAt( nRow, nCol, cPrompt, cColor ) -RETURN .f. + RETURN .F. FUNCTION __MenuTo( bBlock, cVariable ) - local nKey - local y - local q - local n - local lExit - local nArrLen - local xMsg - local nMsgCol - local nMsgRow - local lMsgCenter - local nSaveCursor - local cSaveReadVar + LOCAL nKey + LOCAL y + LOCAL q + LOCAL n + LOCAL lExit + LOCAL nArrLen + LOCAL xMsg + LOCAL nMsgCol + LOCAL nMsgRow + LOCAL lMsgCenter + LOCAL nSaveCursor + LOCAL cSaveReadVar - local lDeclared - local bAction - local nMouseClik + LOCAL lDeclared + LOCAL bAction + LOCAL nMouseClik - local nPointer - Local aColor - local cBackColor - local cFrontColor + LOCAL nPointer + LOCAL aColor + LOCAL cBackColor + LOCAL cFrontColor // Detect if a memvar was passed lDeclared := !__mvEXIST( cVariable ) - if lDeclared + IF lDeclared __mvPUBLIC( cVariable ) - endif + ENDIF - n := eval( bBlock ) + n := Eval( bBlock ) // if no prompts were defined, exit with 0 - if s_nPointer < 1 .or. s_nPointer > len( s_aLevel ) + IF s_nPointer < 1 .OR. s_nPointer > Len( s_aLevel ) n := 0 - else + ELSE s_nPointer ++ nPointer := s_nPointer - nArrLen := len( s_aLevel[ nPointer - 1 ] ) + nArrLen := Len( s_aLevel[ nPointer - 1 ] ) // put choice in a valid range - if !ISNUMBER( n ) .OR. n < 1 + IF !ISNUMBER( n ) .OR. n < 1 n := 1 - endif + ENDIF - if n > nArrLen + IF n > nArrLen n := nArrLen - endif + ENDIF // - nSaveCursor := setcursor( iif( Set( _SET_INTENSITY ), SC_NONE, NIL ) ) - cSaveReadVar := ReadVar( upper( cVariable ) ) + nSaveCursor := SetCursor( iif( Set( _SET_INTENSITY ), SC_NONE, NIL ) ) + cSaveReadVar := ReadVar( Upper( cVariable ) ) xMsg := "" nMsgCol := 0 - nMsgRow := set( _SET_MESSAGE ) - lMsgCenter := set( _SET_MCENTER ) + nMsgRow := Set( _SET_MESSAGE ) + lMsgCenter := Set( _SET_MCENTER ) lExit := .F. - do while n <> 0 + DO WHILE n != 0 // should we display messages? - if nMsgRow > 0 + IF nMsgRow > 0 - if ! Empty( xMsg ) + IF ! Empty( xMsg ) DispOutAt( nMsgRow, nMsgCol, Space( Len( xMsg ) ) ) - endif + ENDIF xMsg := s_aLevel[ nPointer - 1, n, 4 ] // Code Block messages ( yes, they are documented! ) - if ISBLOCK( xMsg ) - xMsg := eval( xMsg ) - endif + IF ISBLOCK( xMsg ) + xMsg := Eval( xMsg ) + ENDIF - if !ISCHARACTER( xMsg ) + IF !ISCHARACTER( xMsg ) xMsg := "" - endif + ENDIF - if lMsgCenter - nMsgCol := int( ( maxcol() - len( xMsg ) ) / 2 ) - endif + IF lMsgCenter + nMsgCol := Int( ( MaxCol() - Len( xMsg ) ) / 2 ) + ENDIF DispOutAt( nMsgRow, nMsgCol, xMsg ) - endif + ENDIF // save the current row q := n - if s_aLevel[ s_nPointer - 1, n, 5 ] <> nil + IF s_aLevel[ s_nPointer - 1, n, 5 ] != NIL aColor := COLORARRAY( s_aLevel[ s_nPointer - 1, n, 5 ] ) - cFrontColor := IIF( EMPTY( aColor[ 1 ] ) , NIL , aColor[ 1 ] ) - cBackColor := IIF( LEN( aColor ) > 1 , aColor[2], NIL ) - endif + cFrontColor := iif( Empty( aColor[ 1 ] ), NIL, aColor[ 1 ] ) + cBackColor := iif( Len( aColor ) > 1, aColor[ 2 ], NIL ) + ENDIF - if Set( _SET_INTENSITY ) - if cBackColor == Nil // Only select Color Enhace if no color was passed + IF Set( _SET_INTENSITY ) + IF cBackColor == NIL // Only select Color Enhace if no color was passed ColorSelect( CLR_ENHANCED ) - endif - endif + ENDIF + ENDIF // highlight the prompt DispOutAt( s_aLevel[ nPointer - 1, n, 1 ],; @@ -157,119 +158,119 @@ FUNCTION __MenuTo( bBlock, cVariable ) s_aLevel[ nPointer - 1, n, 3 ],; cBackColor ) - if Set( _SET_INTENSITY ) - if cFrontColor == NIL // Only select Color Enhace if no color was passed + IF Set( _SET_INTENSITY ) + IF cFrontColor == NIL // Only select Color Enhace if no color was passed ColorSelect( CLR_STANDARD ) - endif - endif + ENDIF + ENDIF - if lExit - exit - endif + IF lExit + EXIT + ENDIF nKey := 0 - do while nKey == 0 + DO WHILE nKey == 0 // wait for a keystroke - nKey := inkey( 0 ) + nKey := Inkey( 0 ) - if ( bAction := setkey( nKey ) ) <> NIL + IF ( bAction := SetKey( nKey ) ) != NIL - eval( bBlock, n ) - eval( bAction, procname( 1 ), procline( 1 ), upper( cVariable ) ) - n := eval( bBlock ) + Eval( bBlock, n ) + Eval( bAction, ProcName( 1 ), ProcLine( 1 ), Upper( cVariable ) ) + n := Eval( bBlock ) - if n < 1 + IF n < 1 n := 1 - elseif n > nArrLen + ELSEIF n > nArrLen n := nArrLen - endif + ENDIF nKey := 0 - endif - enddo + ENDIF + ENDDO // check for keystrokes SWITCH nKey - case K_MOUSEMOVE + CASE K_MOUSEMOVE EXIT - case K_LBUTTONDOWN - case K_LDBLCLK - if ( nMouseClik := hittest( s_aLevel[ nPointer - 1 ], ; - mrow(), mcol() ) ) > 0 + CASE K_LBUTTONDOWN + CASE K_LDBLCLK + IF ( nMouseClik := HitTest( s_aLevel[ nPointer - 1 ], ; + MRow(), MCol() ) ) > 0 n := nMouseClik - endif - if nKey == K_LDBLCLK + ENDIF + IF nKey == K_LDBLCLK lExit := .T. - endif + ENDIF EXIT - case K_DOWN - case K_RIGHT - if ++n > nArrLen + CASE K_DOWN + CASE K_RIGHT + IF ++n > nArrLen n := iif( Set( _SET_WRAP ), 1, nArrLen ) - endif + ENDIF EXIT - case K_UP - case K_LEFT - if --n < 1 + CASE K_UP + CASE K_LEFT + IF --n < 1 n := iif( Set( _SET_WRAP ), nArrLen, 1 ) - endif + ENDIF EXIT - case K_HOME + CASE K_HOME n := 1 EXIT - case K_END + CASE K_END n := nArrLen EXIT - case K_ENTER - case K_PGUP - case K_PGDN + CASE K_ENTER + CASE K_PGUP + CASE K_PGDN lExit := .T. EXIT - case K_ESC + CASE K_ESC n := 0 EXIT - otherwise + OTHERWISE // did user hit a hot key? - for y := 1 to nArrLen - if upper( left( ltrim( s_aLevel[ nPointer - 1, y, 3 ] ), 1 ) ) == upper( chr( nKey ) ) + FOR y := 1 TO nArrLen + IF Upper( Left( LTrim( s_aLevel[ nPointer - 1, y, 3 ] ), 1 ) ) == Upper( Chr( nKey ) ) n := y lExit := .T. - exit - endif - next - end + EXIT + ENDIF + NEXT + ENDSWITCH - if n <> 0 + IF n != 0 DispOutAt( s_aLevel[ nPointer - 1, q, 1 ],; s_aLevel[ nPointer - 1, q, 2 ],; s_aLevel[ nPointer - 1, q, 3 ],; cFrontColor ) - endif + ENDIF - enddo + ENDDO ReadVar( cSaveReadVar ) SetCursor( nSaveCursor ) s_nPointer := nPointer s_nPointer -- - asize( s_aLevel, s_nPointer - 1 ) + ASize( s_aLevel, s_nPointer - 1 ) - endif + ENDIF - eval( bBlock, n ) + Eval( bBlock, n ) - if lDeclared + IF lDeclared __mvXRELEASE( cVariable ) - endif + ENDIF - SetPos( MaxRow() - 1, 0) + SetPos( MaxRow() - 1, 0 ) -RETURN n + RETURN n -STATIC FUNCTION HITTEST( aMenu, nMouseRow, nMouseCol ) +STATIC FUNCTION HitTest( aMenu, nMouseRow, nMouseCol ) LOCAL aMenuItem @@ -282,4 +283,4 @@ STATIC FUNCTION HITTEST( aMenu, nMouseRow, nMouseCol ) ENDIF NEXT -RETURN 0 + RETURN 0 diff --git a/harbour/source/rtl/readkey.prg b/harbour/source/rtl/readkey.prg index 9657c21e5a..8be8bd6e3c 100644 --- a/harbour/source/rtl/readkey.prg +++ b/harbour/source/rtl/readkey.prg @@ -69,10 +69,10 @@ FUNCTION ReadKey() IF nKey >= K_SPACE ; nKey := 15 ELSE ; RETURN 0 ENDIF - END + ENDSWITCH IF Updated() nKey += 256 ENDIF -RETURN nKey + RETURN nKey diff --git a/harbour/source/rtl/valtoexp.prg b/harbour/source/rtl/valtoexp.prg index 6be71b4c29..b210ae1d21 100644 --- a/harbour/source/rtl/valtoexp.prg +++ b/harbour/source/rtl/valtoexp.prg @@ -50,10 +50,10 @@ * */ -FUNCTION HB_VALTOEXP( xVal ) - LOCAL cVal, v +FUNCTION hb_VALTOEXP( xVal ) + LOCAL cVal + LOCAL v := VALTYPE( xVal ) - v := VALTYPE( xVal ) SWITCH v CASE "C" CASE "M" @@ -103,14 +103,13 @@ FUNCTION HB_VALTOEXP( xVal ) ELSE cVal := "???:" + v ENDIF - END + ENDSWITCH RETURN cVal -FUNCTION HB_CSTR( xVal ) - LOCAL v +FUNCTION hb_CSTR( xVal ) + LOCAL v := VALTYPE( xVal ) - v := VALTYPE( xVal ) SWITCH v CASE "C" CASE "M" @@ -128,15 +127,15 @@ FUNCTION HB_CSTR( xVal ) CASE "O" RETURN "{ " + xVal:className + " Object }" CASE "A" - RETURN "{ Array of " + LTRIM( STR( LEN( xVal ) ) ) + " Items }" + RETURN "{ Array of " + LTRIM( STR( LEN( xVal ) ) ) + " Items }" CASE "H" - RETURN "{ Hash of " + LTRIM( STR( LEN( xVal ) ) ) + " Items }" + RETURN "{ Hash of " + LTRIM( STR( LEN( xVal ) ) ) + " Items }" CASE "P" RETURN "" OTHERWISE IF xVal == NIL RETURN "NIL" ENDIF - END + ENDSWITCH RETURN "???:" + v