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

2007-09-12 08:29 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* 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
This commit is contained in:
Viktor Szakats
2007-09-12 06:31:13 +00:00
parent 08a3551742
commit 767c5d849f
8 changed files with 152 additions and 139 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
harbour/ChangeLog
View File

@@ -8,6 +8,18 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
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

3
harbour/contrib/libct/blank.prg
View File

@@ -87,6 +87,7 @@ FUNCTION BLANK( xItem, xMode )
OTHERWISE
xRet:=.F.
END
ENDSWITCH
RETURN xRet

4
harbour/source/debug/debugger.prg
View File

@@ -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 )

4
harbour/source/rtl/browse.prg
View File

@@ -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

2
harbour/source/rtl/getsys.prg
View File

@@ -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

243
harbour/source/rtl/menuto.prg
View File

@@ -18,138 +18,139 @@
#include "inkey.ch"
#include "hbmemvar.ch"
#include "setcurs.ch"
#xtranslate COLORARRAY(<x>) => &( '{"' + strtran(<x>, ',', '","') + '"}' )
#xtranslate COLORARRAY( <x> ) => &( '{"' + StrTran( <x>, ',', '","' ) + '"}' )
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

4
harbour/source/rtl/readkey.prg
View File

@@ -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

19
harbour/source/rtl/valtoexp.prg
View File

@@ -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 "<pointer>"
OTHERWISE
IF xVal == NIL
RETURN "NIL"
ENDIF
END
ENDSWITCH
RETURN "???:" + v