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

2013-03-06 12:17 UTC+0100 Viktor Szakats (harbour syenar.net)

Browse Source 
* src/vm/hashfunc.c
    + HB_HAUTOADD() extended, now it accepts 3rd parameter to
      set the default value used when autoadding a hash item,
      making separate HB_HDEFAULT() call unnecessary:
         hb_HAutoAdd( <hash>, [<nAutoAdd>|<lAutoAdd>], [<xDefault>] ) -> <nOldAutoAdd>

  * contrib/xhb/hbcompat.ch
  * doc/en/hashes.txt
  * src/vm/hashfunc.c
    * deprecated following Harbour core functions with HB_LEGACY_LEVEL5:
         hb_HSetCaseMatch(), hb_HSetAutoAdd(), hb_HSetBinary(), hb_HSetOrder()
      use these alternatives:
         hb_HCaseMatch(), hb_HAutoAdd(), hb_HBinary(), hb_HKeepOrder()
      they return the previous setting instead of the hash itself.

  * contrib/hbct/token1.c
    ! marked hidden/dirty Harbour extensions with HB_EXTENSION tag

  * src/debug/dbgtobj.prg
  + tests/dbgcls.prg
    ! ACCESS var is implemented using a full METHOD syntax, which can
      contain debug information. HVM sees this information while displaying
      ACCESS var value, the debugger gets reinvoked and confused.
      Patch and test code (hbformatted)
      by Aleksander Czajczynski. Thanks for the nice patch.
         https://groups.google.com/d/topic/harbour-devel/43hoC7GV7C4/discussion

  * src/rtl/alert.prg
    ! Alert()/hb_Alert(): fixed display colors when color parameter
      contained multiple color items.
      Reported by Tony Quick
         https://groups.google.com/d/topic/harbour-devel/20vFUGGtx9c/discussion
    * formatted 2 long lines for better readability

  * tests/altd.prg
    + light testing of custom Alert() colors

  * src/rtl/menuto.prg
    % added logic to avoid flicker when moving around the mouse.
      Protected by HB_CLP_STRICT, because Clipper flickers the same
      way, but it's something that seems possible to fix w/o adverse
      side effects on user level or breaking documented C5.3 behavior.
      Report if you think otherwise.
      Original patch provided by Miso Pucko in #3500627
         https://sourceforge.net/tracker/?func=detail&aid=3500627&group_id=681&atid=100681
    ; Checkme

  * tests/browse.prg
  * tests/menuto.prg
    + enabled mouse
    * minor cleanups

  * contrib/hbgd/gdchart.prg
  * contrib/hbgd/tests/cgi.prg
  * contrib/hbtip/cgi.prg
  * extras/httpsrv/cgifunc.prg
  * extras/httpsrv/uhttpd.prg
  * src/rdd/usrrdd/rdds/arrayrdd.prg
    * use 'h[ k ] := v' instead of 'hb_HSet( h, k, v )'
    * use 'h[ k ]' instead of 'hb_HGet( h, k )'
    ; do not use above function in Harbour sources

  * contrib/hbtip/mail.prg
  * contrib/hbtip/tests/loadhtml.prg
  * contrib/hbtip/thtml.prg
  * contrib/hbwin/tests/olesrv2.prg
  * contrib/xhb/hbcompat.ch
  * contrib/xhb/xhbhash.c
  * extras/httpsrv/cgifunc.prg
  * extras/httpsrv/uhttpd.prg
    * avoid deprecated hash functions in Harbour sources
This commit is contained in:
Viktor Szakats
2013-03-06 11:19:44 +00:00
parent 530a410e87
commit 50cfaab12f
23 changed files with 317 additions and 282 deletions
Download Patch File Download Diff File Expand all files Collapse all files

78
harbour/ChangeLog.txt
View File

@@ -10,8 +10,80 @@
* Change, ! Fix, % Optimization, + Addition, - Removal, ; Comment
*/
2013-03-06 03:18 UTC+0100 Tamas TEVESZ (ice extreme.hu)
2013-03-06 12:17 UTC+0100 Viktor Szakats (harbour syenar.net)
* src/vm/hashfunc.c
+ HB_HAUTOADD() extended, now it accepts 3rd parameter to
set the default value used when autoadding a hash item,
making separate HB_HDEFAULT() call unnecessary:
hb_HAutoAdd( <hash>, [<nAutoAdd>|<lAutoAdd>], [<xDefault>] ) -> <nOldAutoAdd>
* contrib/xhb/hbcompat.ch
* doc/en/hashes.txt
* src/vm/hashfunc.c
* deprecated following Harbour core functions with HB_LEGACY_LEVEL5:
hb_HSetCaseMatch(), hb_HSetAutoAdd(), hb_HSetBinary(), hb_HSetOrder()
use these alternatives:
hb_HCaseMatch(), hb_HAutoAdd(), hb_HBinary(), hb_HKeepOrder()
they return the previous setting instead of the hash itself.
* contrib/hbct/token1.c
! marked hidden/dirty Harbour extensions with HB_EXTENSION tag
* src/debug/dbgtobj.prg
+ tests/dbgcls.prg
! ACCESS var is implemented using a full METHOD syntax, which can
contain debug information. HVM sees this information while displaying
ACCESS var value, the debugger gets reinvoked and confused.
Patch and test code (hbformatted)
by Aleksander Czajczynski. Thanks for the nice patch.
https://groups.google.com/d/topic/harbour-devel/43hoC7GV7C4/discussion
* src/rtl/alert.prg
! Alert()/hb_Alert(): fixed display colors when color parameter
contained multiple color items.
Reported by Tony Quick
https://groups.google.com/d/topic/harbour-devel/20vFUGGtx9c/discussion
* formatted 2 long lines for better readability
* tests/altd.prg
+ light testing of custom Alert() colors
* src/rtl/menuto.prg
% added logic to avoid flicker when moving around the mouse.
Protected by HB_CLP_STRICT, because Clipper flickers the same
way, but it's something that seems possible to fix w/o adverse
side effects on user level or breaking documented C5.3 behavior.
Report if you think otherwise.
Original patch provided by Miso Pucko in #3500627
https://sourceforge.net/tracker/?func=detail&aid=3500627&group_id=681&atid=100681
; Checkme
* tests/browse.prg
* tests/menuto.prg
+ enabled mouse
* minor cleanups
* contrib/hbgd/gdchart.prg
* contrib/hbgd/tests/cgi.prg
* contrib/hbtip/cgi.prg
* extras/httpsrv/cgifunc.prg
* extras/httpsrv/uhttpd.prg
* src/rdd/usrrdd/rdds/arrayrdd.prg
* use 'h[ k ] := v' instead of 'hb_HSet( h, k, v )'
* use 'h[ k ]' instead of 'hb_HGet( h, k )'
; do not use above function in Harbour sources
* contrib/hbtip/mail.prg
* contrib/hbtip/tests/loadhtml.prg
* contrib/hbtip/thtml.prg
* contrib/hbwin/tests/olesrv2.prg
* contrib/xhb/hbcompat.ch
* contrib/xhb/xhbhash.c
* extras/httpsrv/cgifunc.prg
* extras/httpsrv/uhttpd.prg
* avoid deprecated hash functions in Harbour sources
2013-03-06 03:18 UTC+0100 Tamas TEVESZ (ice extreme.hu)
* config/minix/clang.mk
* config/minix/gcc.mk
! Actually add dyn rules, missed in the previous step
@@ -22,8 +94,8 @@
2013-03-05 19:41 UTC+0100 Viktor Szakats (harbour syenar.net)
* src/vm/dynsym.c
! __DYNSGETINDEX() fixed to return 1-based indexes in sync
with rest of API class, also fixing the issue that zero
! __DYNSGETINDEX() fixed to return 1-based index in sync
with rest of __DYNS* API, also fixing the issue that zero
value was used to indicate error (name not found) as well.
Fixes #3606911 by Kevin Carmody
https://sourceforge.net/tracker/?func=detail&aid=3606911&group_id=681&atid=100681

18
harbour/contrib/hbct/token1.c
View File

@@ -110,7 +110,7 @@ static void do_token1( int iSwitch )
case DO_TOKEN1_NUMTOKEN:
case DO_TOKEN1_TOKENLOWER:
case DO_TOKEN1_TOKENUPPER:
iParamCheck = ( HB_ISCHAR( 1 ) );
iParamCheck = HB_ISCHAR( 1 );
break;
}
@@ -156,7 +156,7 @@ static void do_token1( int iSwitch )
}
else
{
if( HB_ISNUM( 4 ) )
if( HB_ISNUM( 4 ) ) /* HB_EXTENSION for ATTOKEN()/TOKENLOWER()/TOKENUPPER() */
nSkip = hb_parns( 4 );
else
nSkip = HB_SIZE_MAX;
@@ -164,7 +164,7 @@ static void do_token1( int iSwitch )
if( nSkip == 0 )
nSkip = HB_SIZE_MAX;
/* prepare return value for TOKENUPPER/TOKENLOWER */
/* prepare return value for TOKENUPPER()/TOKENLOWER() */
if( iSwitch == DO_TOKEN1_TOKENLOWER || iSwitch == DO_TOKEN1_TOKENUPPER )
{
if( sStrLen == 0 )
@@ -222,12 +222,12 @@ static void do_token1( int iSwitch )
char cRet;
hb_retc_null();
if( HB_ISBYREF( 5 ) )
if( HB_ISBYREF( 5 ) ) /* HB_EXTENSION */
{
cRet = ( char ) ct_token->iPreSeparator;
hb_storclen( &cRet, ( ct_token->iPreSeparator != -1 ? 1 : 0 ), 5 );
}
if( HB_ISBYREF( 6 ) )
if( HB_ISBYREF( 6 ) ) /* HB_EXTENSION */
{
cRet = ( char ) ct_token->iPostSeparator;
hb_storclen( &cRet, ( ct_token->iPostSeparator != -1 ? 1 : 0 ), 6 );
@@ -330,12 +330,12 @@ static void do_token1( int iSwitch )
else
hb_retc_null();
if( HB_ISBYREF( 5 ) )
if( HB_ISBYREF( 5 ) ) /* HB_EXTENSION */
{
cRet = ( char ) ct_token->iPreSeparator;
hb_storclen( &cRet, ( ct_token->iPreSeparator != -1 ? 1 : 0 ), 5 );
}
if( HB_ISBYREF( 6 ) )
if( HB_ISBYREF( 6 ) ) /* HB_EXTENSION */
{
cRet = ( char ) ct_token->iPostSeparator;
hb_storclen( &cRet, ( ct_token->iPostSeparator != -1 ? 1 : 0 ), 6 );
@@ -378,12 +378,12 @@ static void do_token1( int iSwitch )
int iArgErrorMode = ct_getargerrormode();
char cRet;
if( HB_ISBYREF( 5 ) )
if( HB_ISBYREF( 5 ) ) /* HB_EXTENSION */
{
cRet = ( char ) ct_token->iPreSeparator;
hb_storclen( &cRet, ( ct_token->iPreSeparator != -1 ? 1 : 0 ), 5 );
}
if( HB_ISBYREF( 6 ) )
if( HB_ISBYREF( 6 ) ) /* HB_EXTENSION */
{
cRet = ( char ) ct_token->iPostSeparator;
hb_storclen( &cRet, ( ct_token->iPostSeparator != -1 ? 1 : 0 ), 6 );

2
harbour/contrib/hbgd/gdchart.prg
View File

@@ -120,7 +120,7 @@ METHOD SetData( aData ) CLASS GDChart
METHOD AddDef( cDefKey, xDefVal ) CLASS GDChart
IF HB_ISSTRING( cDefKey )
hb_HSet( ::hDefs, Upper( cDefKey ), xDefVal )
::hDefs[ Upper( cDefKey ) ] := xDefVal
ENDIF
RETURN Self

12
harbour/contrib/hbgd/tests/cgi.prg
View File

@@ -40,22 +40,22 @@ PROCEDURE Main( ... )
DO CASE
CASE cPar == "txt"
// cText := hb_HGet( hParams, cPar )
// cText := hParams[ cPar ]
CASE cPar == "img"
cImg := hb_HGet( hParams, cPar )
cImg := hParams[ cPar ]
CASE cPar == "photo"
cPhoto := hb_HGet( hParams, cPar )
cPhoto := hParams[ cPar ]
CASE cPar == "width"
nWidth := Val( hb_HGet( hParams, cPar ) )
nWidth := Val( hParams[ cPar ] )
CASE cPar == "height"
nHeight := Val( hb_HGet( hParams, cPar ) )
nHeight := Val( hParams[ cPar ] )
CASE cPar == "pt"
nPt := Val( hb_HGet( hParams, cPar ) )
nPt := Val( hParams[ cPar ] )
ENDCASE
NEXT

6
harbour/contrib/hbtip/cgi.prg
View File

@@ -423,7 +423,7 @@ STATIC FUNCTION HtmlTag( xVal, cKey, cDefault )
IF ! Empty( xVal ) .AND. ! Empty( cKey )
IF hb_HHasKey( xVal, cKey )
cVal := hb_HGet( xVal, cKey )
cVal := xVal[ cKey ]
hb_HDel( xVal, cKey )
ENDIF
ENDIF
@@ -458,7 +458,7 @@ STATIC FUNCTION HtmlOption( xVal, cKey, cPre, cPost, lScan )
IF Empty( cKey )
cVal := xVal
ELSEIF hb_HHasKey( xVal, cKey )
cVal := hb_HGet( xVal, cKey )
cVal := xVal[ cKey ]
IF Empty( lScan )
hb_HDel( xVal, cKey )
ENDIF
@@ -495,7 +495,7 @@ STATIC FUNCTION HtmlValue( xVal, cKey, cDefault )
IF ! Empty( xVal ) .AND. ! Empty( cKey )
IF hb_HHasKey( xVal, cKey )
cVal := hb_HGet( xVal, cKey )
cVal := xVal[ cKey ]
hb_HDel( xVal, cKey )
ENDIF
ENDIF

7
harbour/contrib/hbtip/mail.prg
View File

@@ -121,9 +121,11 @@ ENDCLASS
METHOD New( cBody, oEncoder ) CLASS TIPMail
// Set header fileds to non-sensitive
::hHeaders := hb_HSetCaseMatch( { => }, .F. )
::hHeaders := { => }
::aAttachments := {}
hb_HCaseMatch( ::hHeaders, .F. )
IF ValType( oEncoder ) $ "CO"
::setEncoder( oEncoder )
ENDIF
@@ -390,7 +392,8 @@ METHOD FromString( cMail, cBoundary, nPos ) CLASS TIPMail
ENDIF
IF Len( ::hHeaders ) > 0
::hHeaders := hb_HSetCaseMatch( { => }, .F. )
::hHeaders := { => }
hb_HCaseMatch( ::hHeaders, .F. )
ENDIF
IF Len( ::aReceived ) > 0

2
harbour/contrib/hbtip/tests/loadhtml.prg
View File

@@ -16,7 +16,7 @@ PROCEDURE Main()
/* build the Google query */
hQUery := { => }
hb_HSetCaseMatch( hQuery, .F. )
hb_HCaseMatch( hQuery, .F. )
hQuery[ "q" ] := "Harbour"
hQuery[ "hl" ] := "en"

4
harbour/contrib/hbtip/thtml.prg
View File

@@ -1297,7 +1297,7 @@ STATIC FUNCTION __ParseAttr( parser )
LOCAL nStart, nEnd
LOCAL lIsQuoted := .F.
hb_HSetCaseMatch( hHash, .F. )
hb_HCaseMatch( hHash, .F. )
DO WHILE ! ( cChr := P_NEXT( parser ) ) == ""
@@ -1727,7 +1727,7 @@ STATIC PROCEDURE _Init_Html_TagTypes
t_hTagTypes := { => }
hb_HSetCaseMatch( t_hTagTypes, .F. )
hb_HCaseMatch( t_hTagTypes, .F. )
t_hTagTypes[ "_root_" ] := { NIL , ( CM_INLINE ) }
t_hTagTypes[ "_text_" ] := { NIL , ( CM_INLINE ) }

2
harbour/contrib/hbwin/tests/olesrv2.prg
View File

@@ -21,7 +21,7 @@ PROCEDURE DllMain()
hAction := { => }
hb_HKeepOrder( hAction, .T. )
hb_HSetCaseMatch( hAction, .F. )
hb_HCaseMatch( hAction, .F. )
hAction[ "DATE" ] := @Date() // DISPID=1
hAction[ "TIME" ] := @Time() // DISPID=2
hAction[ "DATETIME" ] := @hb_DateTime() // DISPID=3

10
harbour/contrib/xhb/hbcompat.ch
View File

@@ -190,12 +190,14 @@
#xtranslate hb_HMerge( [<x,...>] ) => HMerge( <x> )
#xtranslate hb_HEval( [<x,...>] ) => HEval( <x> )
#xtranslate hb_HScan( [<x,...>] ) => HScan( <x> )
#xtranslate hb_HSetCaseMatch( [<x,...>] ) => HSetCaseMatch( <x> )
#xtranslate hb_HCaseMatch( [<x,...>] ) => HGetCaseMatch( <x> )
#xtranslate hb_HSetAutoAdd( [<x,...>] ) => HSetAutoAdd( <x> )
#xtranslate hb_HAutoAdd( [<x,...>] ) => HGetAutoAdd( <x> )
#xtranslate hb_HAllocate( [<x,...>] ) => HAllocate( <x> )
#xtranslate hb_HDefault( [<x,...>] ) => HDefault( <x> )
#if defined( HB_LEGACY_LEVEL5 )
#xtranslate hb_HSetCaseMatch( [<x,...>] ) => HSetCaseMatch( <x> )
#xtranslate hb_HSetAutoAdd( [<x,...>] ) => HSetAutoAdd( <x> )
#endif
/* Inet functions */
#xtranslate hb_inetInit( [<x,...>] ) => inetInit( <x> )
@@ -488,9 +490,9 @@
#xtranslate HMerge( [<x,...>] ) => hb_HMerge( <x> )
#xtranslate HEval( [<x,...>] ) => hb_HEval( <x> )
#xtranslate HScan( [<x,...>] ) => hb_HScan( <x> )
#xtranslate HSetCaseMatch( [<x,...>] ) => hb_HSetCaseMatch( <x> )
#xtranslate HSetCaseMatch( <x>[, <z>] ) => ( hb_HCaseMatch( <x>[, <z>] ), <x> )
#xtranslate HGetCaseMatch( [<x,...>] ) => hb_HCaseMatch( <x> )
#xtranslate HSetAutoAdd( [<x,...>] ) => hb_HSetAutoAdd( <x> )
#xtranslate HSetAutoAdd( <x>[, <z>] ) => ( hb_HAutoAdd( <x>[, <z>] ), <x> )
#xtranslate HGetAutoAdd( [<x,...>] ) => hb_HAutoAdd( <x> )
#xtranslate HAllocate( [<x,...>] ) => hb_HAllocate( <x> )
#xtranslate HDefault( [<x,...>] ) => hb_HDefault( <x> )

6
harbour/contrib/xhb/xhbhash.c
View File

@@ -74,7 +74,7 @@ HB_FUNC_TRANSLATE( HSCAN , HB_HSCAN )
HB_FUNC_TRANSLATE( HALLOCATE , HB_HALLOCATE )
HB_FUNC_TRANSLATE( HDEFAULT , HB_HDEFAULT )
HB_FUNC_TRANSLATE( HGETCASEMATCH , HB_HCASEMATCH )
HB_FUNC_TRANSLATE( HSETCASEMATCH , HB_HSETCASEMATCH )
HB_FUNC_TRANSLATE( HSETAUTOADD , HB_HSETAUTOADD )
HB_FUNC_EXTERN( HB_HAUTOADD ) ; HB_FUNC( HGETAUTOADD ) { HB_FUNC_EXEC( HB_HAUTOADD ); hb_retl( hb_parni( -1 ) == HB_HASH_AUTOADD_ALWAYS ); }
HB_FUNC_EXTERN( HB_HCASEMATCH ); HB_FUNC( HSETCASEMATCH ) { HB_FUNC_EXEC( HB_HCASEMATCH ); hb_itemReturn( hb_param( 1, HB_IT_HASH ) ); }
HB_FUNC_EXTERN( HB_HAUTOADD ); HB_FUNC( HSETAUTOADD ) { HB_FUNC_EXEC( HB_HAUTOADD ); hb_itemReturn( hb_param( 1, HB_IT_HASH ) ); }
HB_FUNC_EXTERN( HB_HAUTOADD ); HB_FUNC( HGETAUTOADD ) { HB_FUNC_EXEC( HB_HAUTOADD ); hb_retl( hb_parni( -1 ) == HB_HASH_AUTOADD_ALWAYS ); }

126
harbour/doc/en/hashes.txt
View File

@@ -841,8 +841,7 @@
$RETURNS$
The previous value of the 'case match' flag
$DESCRIPTION$
This function is equivalent to hb_HSetCaseMatch() but it returns
the old flag value rather than the hash table
This function returns the old flag value
$EXAMPLES$
LOCAL hsTable, lFlag
hsTable := { "one" => 1, "two" => 2 }
@@ -857,7 +856,6 @@
$FILES$
$SEEALSO$
hb_HSetCaseMatch()
$END$
*/
@@ -898,7 +896,6 @@
$FILES$
$SEEALSO$
hb_HSetBinary()
$END$
*/
@@ -939,7 +936,6 @@
$FILES$
$SEEALSO$
hb_HSetAutoAdd()
$END$
*/
@@ -1012,123 +1008,3 @@
TODO: locate and list those methods that use this feature
$END$
*/
/* $DOC$
$TEMPLATE$
Function
$NAME$
hb_HSetAutoAdd()
$CATEGORY$
API
$SUBCATEGORY$
Hash table
$ONELINER$
Sets the 'auto add' flag for the hash table
$SYNTAX$
hb_HSetAutoAdd( <hsTable>, [<lFlag>] ) -> <hsTable>
$ARGUMENTS$
<hsTable> a hash table, created by hb_Hash()
<lFlag> a logical value indicating to turn on or off
the 'auto add' flag of the hash table
$RETURNS$
The hash table
$DESCRIPTION$
This function is equivalent to hb_HAutoAdd() but it returns
the passed hash table rather than the old flag value
$EXAMPLES$
LOCAL hsTable
// turn 'auto add' on for a new hash table
hsTable := hb_HSetAutoAdd( { "one" => 1, "two" => 2 }, .T. )
$STATUS$
R
$COMPLIANCE$
H
$PLATFORMS$
$FILES$
$SEEALSO$
hb_HAutoAdd(),hb_HSetBinary(),hb_HSetCaseMatch()
$END$
*/
/* $DOC$
$TEMPLATE$
Function
$NAME$
hb_HSetCaseMatch()
$CATEGORY$
API
$SUBCATEGORY$
Hash table
$ONELINER$
Sets the 'case match' flag for the hash table
$SYNTAX$
hb_HSetCaseMatch( <hsTable>, [<lFlag>] ) -> <hsTable>
$ARGUMENTS$
<hsTable> a hash table, created by hb_Hash()
<lFlag> a logical value indicating to turn on or off
the 'case match' flag of the hash table
$RETURNS$
The hash table
$DESCRIPTION$
This function is equivalent to hb_HCaseMatch() but it returns
the passed hash table rather than the old flag value
$EXAMPLES$
LOCAL hsTable
// turn 'case match' on for a new hash table
hsTable := hb_HSetCaseMatch( { "one" => 1, "two" => 2 }, .T. )
$STATUS$
R
$COMPLIANCE$
H
$PLATFORMS$
$FILES$
$SEEALSO$
hb_HCaseMatch(),hb_HSetAutoAdd(),hb_HSetBinary()
$END$
*/
/* $DOC$
$TEMPLATE$
Function
$NAME$
hb_HSetBinary()
$CATEGORY$
API
$SUBCATEGORY$
Hash table
$ONELINER$
Sets the 'binary' flag for the hash table
$SYNTAX$
hb_HSetBinary( <hsTable>, [<lFlag>] ) -> <hsTable>
$ARGUMENTS$
<hsTable> a hash table, created by hb_Hash()
<lFlag> a logical value indicating to turn on or off
the 'binary' flag of the hash table
$RETURNS$
The hash table
$DESCRIPTION$
This function is equivalent to hb_HBinary() but it returns
the passed hash table rather than the old flag value
$EXAMPLES$
LOCAL hsTable
// turn 'binary' on for a new hash table
hsTable := hb_HSetBinary( { "one" => 1, "two" => 2 }, .T. )
$STATUS$
R
$COMPLIANCE$
H
$PLATFORMS$
$FILES$
$SEEALSO$
hb_HBinary(),hb_HSetAutoAdd(),hb_HSetCaseMatch()
$END$
*/

23
harbour/extras/httpsrv/cgifunc.prg
View File

@@ -57,7 +57,6 @@
#define CRLF ( Chr( 13 ) + Chr( 10 ) )
#xtranslate Throw( <oErr> ) => ( Eval( ErrorBlock(), <oErr> ), Break( <oErr> ) )
#define HB_IHASH() hb_HSetCaseMatch( { => }, .F. )
MEMVAR _SERVER, _GET, _POST, _COOKIE, _REQUEST, _HTTP_REQUEST
@@ -138,7 +137,7 @@ FUNCTION uhttpd_SplitUrl( cUrl )
LOCAL cUri
// Prevents case matching
hb_HSetCaseMatch( hUrl, .F. )
hb_HCaseMatch( hUrl, .F. )
cTemp := cUrl
cUri := ""
@@ -248,18 +247,18 @@ FUNCTION uhttpd_SplitUrl( cUrl )
ENDIF
// Assemble hash
hb_HSet( hUrl, "SCHEME" , cProto )
hb_HSet( hUrl, "HOST" , cHost )
hb_HSet( hUrl, "PORT" , nPort )
hb_HSet( hUrl, "USER" , cUser )
hb_HSet( hUrl, "PASS" , cPass )
hb_HSet( hUrl, "PATH" , cPath )
hb_HSet( hUrl, "QUERY" , cQuery )
hb_HSet( hUrl, "FRAGMENT", cFragment )
hb_HSet( hUrl, "URI" , cURI )
hUrl[ "SCHEME" ] := cProto
hUrl[ "HOST" ] := cHost
hUrl[ "PORT" ] := nPort
hUrl[ "USER" ] := cUser
hUrl[ "PASS" ] := cPass
hUrl[ "PATH" ] := cPath
hUrl[ "QUERY" ] := cQuery
hUrl[ "FRAGMENT" ] := cFragment
hUrl[ "URI" ] := cURI
// Prevents externals to add something else to this Hash
hb_HSetAutoAdd( hUrl, .F. )
hb_HAutoAdd( hUrl, .F. )
RETURN hUrl

81
harbour/extras/httpsrv/uhttpd.prg
View File

@@ -139,7 +139,6 @@ REQUEST GDIMAGE, GDIMAGECHAR, GDCHART
#define HRB_ACTIVATE_CACHE .F. // if .T. caching of HRB modules will be enabled. (NOTE: changes of files will not be loaded until server is active)
#define CR_LF ( Chr( 13 ) + Chr( 10 ) )
#define HB_IHASH() hb_HSetCaseMatch( { => }, .F. )
#ifdef __PLATFORM__WINDOWS
REQUEST HB_GT_WVT_DEFAULT
@@ -246,7 +245,7 @@ PROCEDURE Main( ... )
ENDIF
// TOCHECK: now not force case insensitive
// hb_HSetCaseMatch( s_hScriptAliases, .F. )
// hb_HCaseMatch( s_hScriptAliases, .F. )
// ----------------- Line command parameters checking ----------------------
@@ -334,7 +333,7 @@ PROCEDURE Main( ... )
// i.e. we can have /info or /Info that will be different unless lScriptAliasMixedCase will be .F.
FOR EACH xVal IN hDefault[ "SCRIPTALIASES" ]
IF HB_ISSTRING( xVal )
hb_HSet( s_hScriptAliases, iif( lScriptAliasMixedCase, xVal:__enumKey(), Upper( xVal:__enumKey() ) ), xVal )
s_hScriptAliases[ iif( lScriptAliasMixedCase, xVal:__enumKey(), Upper( xVal:__enumKey() ) ) ] := xVal
ENDIF
NEXT
@@ -342,7 +341,7 @@ PROCEDURE Main( ... )
// i.e. we can have /info or /Info that will be different
FOR EACH xVal IN hDefault[ "ALIASES" ]
IF HB_ISSTRING( xVal )
hb_HSet( s_hAliases, xVal:__enumKey(), xVal )
s_hAliases[ xVal:__enumKey() ] := xVal
ENDIF
NEXT
@@ -916,8 +915,8 @@ STATIC FUNCTION ProcessConnection()
// hb_ToOutDebug( "cRequest -- BEGIN --\n\r%s\n\rcRequest -- END --\n\r", cRequest )
_SERVER := HB_IHASH(); _GET := HB_IHASH(); _POST := HB_IHASH(); _COOKIE := HB_IHASH()
_SESSION := HB_IHASH(); _REQUEST := HB_IHASH(); _HTTP_REQUEST := HB_IHASH(); _HTTP_RESPONSE := HB_IHASH()
_SERVER := HB_HASHI(); _GET := HB_HASHI(); _POST := HB_HASHI(); _COOKIE := HB_HASHI()
_SESSION := HB_HASHI(); _REQUEST := HB_HASHI(); _HTTP_REQUEST := HB_HASHI(); _HTTP_RESPONSE := HB_HASHI()
m_cPost := NIL
t_cResult := ""
// t_aHeader := {}
@@ -1065,8 +1064,8 @@ STATIC FUNCTION ServiceConnection()
// hb_ToOutDebug( "cRequest -- INIZIO --\n\r%s\n\rcRequest -- FINE --\n\r", cRequest )
_SERVER := HB_IHASH(); _GET := HB_IHASH(); _POST := HB_IHASH(); _COOKIE := HB_IHASH()
_SESSION := HB_IHASH(); _REQUEST := HB_IHASH(); _HTTP_REQUEST := HB_IHASH(); _HTTP_RESPONSE := HB_IHASH()
_SERVER := HB_HASHI(); _GET := HB_HASHI(); _POST := HB_HASHI(); _COOKIE := HB_HASHI()
_SESSION := HB_HASHI(); _REQUEST := HB_HASHI(); _HTTP_REQUEST := HB_HASHI(); _HTTP_RESPONSE := HB_HASHI()
m_cPost := NIL
t_cResult := ""
// t_aHeader := {}
@@ -1202,12 +1201,12 @@ STATIC FUNCTION ParseRequest( cRequest )
// Load _HTTP_REQUEST
FOR EACH cReq IN aRequest
IF cReq:__enumIndex() == 1 // GET request
hb_HSet( _HTTP_REQUEST, "HTTP Request", cReq )
_HTTP_REQUEST[ "HTTP Request" ] := cReq
ELSEIF Empty( cReq )
EXIT
ELSE
aVal := uhttpd_split( ":", cReq, 1 )
hb_HSet( _HTTP_REQUEST, aVal[ 1 ], iif( Len( aVal ) == 2, AllTrim( aVal[ 2 ] ), NIL ) )
_HTTP_REQUEST[ aVal[ 1 ] ] := iif( Len( aVal ) == 2, AllTrim( aVal[ 2 ] ), NIL )
ENDIF
NEXT
@@ -1666,15 +1665,15 @@ PROCEDURE uhttpd_SetHeader( cType, cValue )
// // Needed from SetCookie()
// __defaultNIL( @lReplace, .T. )
hb_HSet( _HTTP_RESPONSE, cType, cValue )
_HTTP_RESPONSE[ cType ] := cValue
/*
#if 0
IF lReplace .AND. ( nI := AScan( t_aHeader, {| x | Upper( x[ 1 ] ) == Upper( cType ) } ) ) > 0
t_aHeader[ nI, 2 ] := cValue
ELSE
AAdd( t_aHeader, { cType, cValue } )
ENDIF
*/
#endif
RETURN
@@ -2288,31 +2287,25 @@ STATIC FUNCTION ParseIni( cConfig )
// Define here what attributes we can have in ini config file and their defaults
// Please add all keys in uppercase. hDefaults is Case Insensitive
hDefault := hb_HSetCaseMatch( ;
{ ;
"MAIN" => { ;
"PORT" => LISTEN_PORT ,;
"APPLICATION_ROOT" => EXE_Path() ,;
"DOCUMENT_ROOT" => EXE_Path() + hb_ps() + "home" ,;
"SHOW_INDEXES" => .F. ,;
"SCRIPTALIASMIXEDCASE" => .T. ,;
"SESSIONPATH" => EXE_Path() + hb_ps() + "sessions" ,;
"DIRECTORYINDEX" => DIRECTORYINDEX_ARRAY ,;
"CONSOLE-ROWS" => MaxRow() + 1 ,;
"CONSOLE-COLS" => MaxCol() + 1 ;
},;
"LOGFILES" => { ;
"ACCESS" => FILE_ACCESS_LOG ,;
"ERROR" => FILE_ERROR_LOG ;
},;
"THREADS" => { ;
"MAX_WAIT" => THREAD_MAX_WAIT ,;
"START_NUM" => START_RUNNING_THREADS ,;
"MAX_NUM" => MAX_RUNNING_THREADS ;
},;
"SCRIPTALIASES" => { => } ,;
"ALIASES" => { => } ;
}, .F. )
hDefault := { ;
"MAIN" => { "PORT" => LISTEN_PORT , ;
"APPLICATION_ROOT" => EXE_Path() , ;
"DOCUMENT_ROOT" => EXE_Path() + hb_ps() + "home", ;
"SHOW_INDEXES" => .F. , ;
"SCRIPTALIASMIXEDCASE" => .T. , ;
"SESSIONPATH" => EXE_Path() + hb_ps() + "sessions" , ;
"DIRECTORYINDEX" => DIRECTORYINDEX_ARRAY , ;
"CONSOLE-ROWS" => MaxRow() + 1 , ;
"CONSOLE-COLS" => MaxCol() + 1 }, ;
"LOGFILES" => { "ACCESS" => FILE_ACCESS_LOG , ;
"ERROR" => FILE_ERROR_LOG }, ;
"THREADS" => { "MAX_WAIT" => THREAD_MAX_WAIT , ;
"START_NUM" => START_RUNNING_THREADS , ;
"MAX_NUM" => MAX_RUNNING_THREADS }, ;
"SCRIPTALIASES" => { => } , ;
"ALIASES" => { => } }
hb_HCaseMatch( hDefault, .F. )
// hb_ToOutDebug( "hDefault = %s\n\r", hb_ValToExp( hDefault ) )
@@ -2434,7 +2427,7 @@ STATIC FUNCTION FileUnAlias( cScript )
// Checking if the request contains a Script Alias
IF hb_HHasKey( s_hScriptAliases, cScript )
// in this case I have to substitute the alias with the real file name
cFileName := hb_HGet( s_hScriptAliases, cScript )
cFileName := s_hScriptAliases[ cScript ]
// substitute macros
cFileName := StrTran( cFileName, "$(DOCROOT_DIR)", _SERVER[ "DOCUMENT_ROOT" ] )
@@ -2724,7 +2717,7 @@ STATIC FUNCTION Handler_HrbScript( cFileName )
IF HRB_ACTIVATE_CACHE
// caching modules
IF ! hb_HHasKey( s_hHRBModules, cFileName )
hb_HSet( s_hHRBModules, cFileName, HRB_LoadFromFile( uhttpd_OSFileName( cFileName ) ) )
s_hHRBModules[ cFileName ] := HRB_LoadFromFile( uhttpd_OSFileName( cFileName ) )
ENDIF
cHRBBody := s_hHRBModules[ cFileName ]
ENDIF
@@ -2884,3 +2877,11 @@ STATIC FUNCTION UHTTPD_UTCOFFSET()
RETURN iif( nOffset < 0, "-", "+" ) + ;
StrZero( nOffset / 3600, 2, 0 ) + ;
StrZero( ( nOffset % 3600 ) / 60, 2, 0 )
STATIC FUNCTION HB_HASHI()
LOCAL h := { => }
hb_HCaseMatch( h, .F. )
RETURN h

2
harbour/src/debug/dbgtobj.prg
View File

@@ -85,6 +85,8 @@ METHOD New( oObject, cVarName, lEditable ) CLASS HBDbObject
hb_default( @lEditable, .T. )
__dbgSetGo( __Dbg():pInfo )
/* create list of object messages */
aMessages := oObject:classSel()
ASort( aMessages,,, {| x, y | PadR( x, 64 ) <= PadR( y, 64 ) } )

98
harbour/src/rdd/usrrdd/rdds/arrayrdd.prg
View File

@@ -233,8 +233,8 @@ STATIC FUNCTION AR_NEW( pWA )
STATIC FUNCTION AR_CREATEFIELDS( nWA, aStruct )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL nResult := HB_SUCCESS
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL nResult := HB_SUCCESS
LOCAL aFieldStruct, aField
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d, aStruct = %2$s", nWA, hb_ValToExp( aStruct ) ) )
@@ -271,15 +271,15 @@ STATIC FUNCTION AR_CREATEFIELDS( nWA, aStruct )
STATIC FUNCTION AR_CREATE( nWA, aOpenInfo )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL hRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL hRDDData := USRRDD_RDDDATA( USRRDD_ID( nWA ) )
LOCAL cName
LOCAL cFullName, aDBFData, nResult /*, aFieldStruct, aField, aStruct */
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d, aOpenInfo = %2$s", nWA, hb_ValToExp( aOpenInfo ) ) )
/* getting database infos from current workarea */
aDBFData := aWAData[ WADATA_DATABASE ]
aDBFData := aWAData[ WADATA_DATABASE ]
/* setting in uppercase chars to avoid differences */
cFullName := Upper( aOpenInfo[ UR_OI_NAME ] )
@@ -305,7 +305,7 @@ STATIC FUNCTION AR_CREATE( nWA, aOpenInfo )
aDBFData[ DATABASE_LOCKED ] := .T. /* I need Exclusive mode in creation */
/* Adding new database in RDD memory slots using filename as key */
hb_HSet( hRDDData, cFullName, aDBFData )
hRDDData[ cFullName ] := aDBFData
/* Set WorkArea Info */
aWAData[ WADATA_WORKAREA ] := nWA
@@ -363,7 +363,7 @@ STATIC FUNCTION AR_OPEN( nWA, aOpenInfo )
ENDIF
/* Set WorkArea Infos */
aWAData := USRRDD_AREADATA( nWA )
aWAData := USRRDD_AREADATA( nWA )
aWAData[ WADATA_DATABASE ] := aDBFData /* Put a reference to database */
aWAData[ WADATA_WORKAREA ] := nWA
aWAData[ WADATA_OPENINFO ] := aOpenInfo /* Put open informations */
@@ -433,8 +433,8 @@ STATIC FUNCTION AR_OPEN( nWA, aOpenInfo )
STATIC FUNCTION AR_CLOSE( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d", nWA ) )
@@ -450,11 +450,11 @@ STATIC FUNCTION AR_CLOSE( nWA )
STATIC FUNCTION AR_GETVALUE( nWA, nField, xValue )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aRecords := aDBFData[ DATABASE_RECORDS ]
LOCAL aStruct := aDBFData[ DATABASE_STRUCT ]
LOCAL nRecNo := aWAData[ WADATA_RECNO ]
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aRecords := aDBFData[ DATABASE_RECORDS ]
LOCAL aStruct := aDBFData[ DATABASE_STRUCT ]
LOCAL nRecNo := aWAData[ WADATA_RECNO ]
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d, nField = %2$d, xValue = %3$s", nWA, nField, hb_ValToExp( xValue ) ) )
@@ -472,12 +472,12 @@ STATIC FUNCTION AR_GETVALUE( nWA, nField, xValue )
STATIC FUNCTION AR_PUTVALUE( nWA, nField, xValue )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aRecords := aDBFData[ DATABASE_RECORDS ]
LOCAL aStruct := aDBFData[ DATABASE_STRUCT ]
LOCAL nRecNo := aWAData[ WADATA_RECNO ]
LOCAL aIndexes := aDBFData[ DATABASE_INDEX ]
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aRecords := aDBFData[ DATABASE_RECORDS ]
LOCAL aStruct := aDBFData[ DATABASE_STRUCT ]
LOCAL nRecNo := aWAData[ WADATA_RECNO ]
LOCAL aIndexes := aDBFData[ DATABASE_INDEX ]
LOCAL aKeys[ Len( aIndexes ) ]
LOCAL xVal
@@ -589,13 +589,13 @@ STATIC FUNCTION AR_GOTOP( nWA )
STATIC FUNCTION AR_GOBOTTOM( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aRecords := aDBFData[ DATABASE_RECORDS ]
LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ]
LOCAL aIndexes := aDBFData[ DATABASE_INDEX ]
LOCAL nIndex := aWAData[ WADATA_INDEX ]
LOCAL nResult := HB_SUCCESS
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aRecords := aDBFData[ DATABASE_RECORDS ]
LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ]
LOCAL aIndexes := aDBFData[ DATABASE_INDEX ]
LOCAL nIndex := aWAData[ WADATA_INDEX ]
LOCAL nResult := HB_SUCCESS
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d", nWA ) )
@@ -648,9 +648,9 @@ STATIC FUNCTION AR_CLEARFILTER( nWA )
STATIC FUNCTION AR_SKIPFILTER( nWA, nRecords )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ]
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ]
LOCAL lBof, nToSkip
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d, nRecords = %2$d", nWA, nRecords ) )
@@ -757,7 +757,7 @@ STATIC FUNCTION AR_SKIPRAW( nWA, nRecords )
ELSEIF nRecords < 0 .AND. -nRecords >= aWAData[ WADATA_RECNO ]
nResult := AR_GOTO( nWA, 1 )
aWAData[ WADATA_BOF ] := .T.
aWAData[ WADATA_BOF ] := .T.
ELSE
nResult := AR_GOTO( nWA, aWAData[ WADATA_RECNO ] + nRecords )
ENDIF
@@ -766,7 +766,7 @@ STATIC FUNCTION AR_SKIPRAW( nWA, nRecords )
STATIC FUNCTION AR_BOF( nWA, lBof )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d, lBof = %2$s", nWA, hb_ValToExp( lBof ) ) )
@@ -782,7 +782,7 @@ STATIC FUNCTION AR_BOF( nWA, lBof )
STATIC FUNCTION AR_EOF( nWA, lEof )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aWAData := USRRDD_AREADATA( nWA )
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d, lEof = %2$s", nWA, hb_ValToExp( lEof ) ) )
@@ -840,9 +840,9 @@ STATIC FUNCTION AR_DELETE( nWA )
STATIC FUNCTION AR_DELETED( nWA, lDeleted )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ]
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aRecInfo := aDBFData[ DATABASE_RECINFO ]
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d, lDeleted = %2$s", nWA, hb_ValToExp( lDeleted ) ) )
@@ -947,8 +947,8 @@ STATIC FUNCTION AR_APPEND( nWA, nRecords )
STATIC FUNCTION AR_LOCK( nWA, aLock )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL nRec := iif( aLock[ UR_LI_RECORD ] == NIL, aWAData[ WADATA_RECNO ], aLock[ UR_LI_RECORD ] )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL nRec := iif( aLock[ UR_LI_RECORD ] == NIL, aWAData[ WADATA_RECNO ], aLock[ UR_LI_RECORD ] )
LOCAL aRecInfo
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d, aLock = %2$s", nWA, hb_ValToExp( aLock ) ) )
@@ -1020,9 +1020,9 @@ STATIC FUNCTION AR_RECID( nWA, nRecNo )
STATIC FUNCTION AR_RECCOUNT( nWA, nRecords )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aRecords := aDBFData[ DATABASE_RECORDS ]
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aDBFData := aWAData[ WADATA_DATABASE ]
LOCAL aRecords := aDBFData[ DATABASE_RECORDS ]
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d, nRecords = %2$s", nWA, hb_ValToExp( nRecords ) ) )
@@ -1140,7 +1140,7 @@ STATIC FUNCTION AR_SEEK( nWa, lSoftSeek, xSeek, lLast )
LOCAL aWAData := USRRDD_AREADATA( nWA )
LOCAL aIndexes := aWAData[ WADATA_DATABASE, DATABASE_INDEX ]
LOCAL nIndex := aWAData[ WADATA_INDEX ]
LOCAL nResult /*:= HB_SUCCESS */
LOCAL nResult /* := HB_SUCCESS */
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d, lSoftSeek = %2$s, xSeek = %3$s, lLast = %4$s", nWa, hb_ValToExp( lSoftSeek ), hb_ValToExp( xSeek ), hb_ValToExp( lLast ) ) )
@@ -1229,13 +1229,13 @@ STATIC FUNCTION AR_ORDCREATE( nWA, aOrderCreate )
HB_TRACE( HB_TR_DEBUG, hb_StrFormat( "nWA = %1$d, aOrderCreate = %2$s", nWA, hb_ValToExp( aOrderCreate ) ) )
aWAData := USRRDD_AREADATA( nWA )
aDBFData := aWAData[ WADATA_DATABASE ]
aWAData := USRRDD_AREADATA( nWA )
aDBFData := aWAData[ WADATA_DATABASE ]
IF HB_ISARRAY( aOrderCreate[ UR_ORCR_CONDINFO ] )
aOCInfo := aOrderCreate[ UR_ORCR_CONDINFO ]
aOCInfo := aOrderCreate[ UR_ORCR_CONDINFO ]
ELSE
aOCInfo := aOrderCreate[ UR_ORCR_CONDINFO ] := { ;
aOCInfo := aOrderCreate[ UR_ORCR_CONDINFO ] := { ;
.F., ; /* #define UR_ORC_ACTIVE 1 */
"", ; /* #define UR_ORC_CFOR 2 */
"", ; /* #define UR_ORC_CWHILE 3 */
@@ -1272,8 +1272,8 @@ STATIC FUNCTION AR_ORDCREATE( nWA, aOrderCreate )
ENDIF
cIndex := aOrderCreate[ UR_ORCR_TAGNAME ] := Upper( aOrderCreate[ UR_ORCR_TAGNAME ] )
aIndex := AR_INDEXINIT()
aIndex[ INDEX_TAG ] := cIndex
aIndex[ INDEX_ORCR ] := aOrderCreate
aIndex[ INDEX_TAG ] := cIndex
aIndex[ INDEX_ORCR ] := aOrderCreate
nIndex := AScan( aIndexes, {| x | x[ INDEX_TAG ] == cIndex } )
IF nIndex > 0
ADel( aIndexes, nIndex )
@@ -1348,7 +1348,7 @@ STATIC FUNCTION AR_ORDINFO( nWA, nMsg, aOrderInfo )
nIndex := aOrderInfo[ UR_ORI_TAG ]
EXIT
OTHERWISE
nIndex := aWAData[ WADATA_INDEX ]
nIndex := aWAData[ WADATA_INDEX ]
ENDSWITCH
SWITCH nMsg

9
harbour/src/rtl/alert.prg
View File

@@ -24,6 +24,7 @@
*/
#include "box.ch"
#include "color.ch"
#include "inkey.ch"
#include "setcurs.ch"
#include "hbgtinfo.ch"
@@ -70,7 +71,9 @@ FUNCTION Alert( cMessage, aOptions, cColorNorm )
cColorNorm := "W+/R" // first pair color (Box line and Text)
cColorHigh := "W+/B" // second pair color (Options buttons)
ELSE
cColorHigh := StrTran( StrTran( iif( At( "/", cColorNorm ) == 0, "N", SubStr( cColorNorm, At( "/", cColorNorm ) + 1 ) ) + "/" + ;
cColorNorm := hb_ColorIndex( cColorNorm, CLR_STANDARD )
cColorHigh := StrTran( StrTran( ;
iif( At( "/", cColorNorm ) == 0, "N", SubStr( cColorNorm, At( "/", cColorNorm ) + 1 ) ) + "/" + ;
iif( At( "/", cColorNorm ) == 0, cColorNorm, Left( cColorNorm, At( "/", cColorNorm ) - 1 ) ), "+", "" ), "*", "" )
ENDIF
@@ -135,7 +138,9 @@ FUNCTION hb_Alert( xMessage, aOptions, cColorNorm, nDelay )
cColorNorm := "W+/R" // first pair color (Box line and Text)
cColorHigh := "W+/B" // second pair color (Options buttons)
ELSE
cColorHigh := StrTran( StrTran( iif( At( "/", cColorNorm ) == 0, "N", SubStr( cColorNorm, At( "/", cColorNorm ) + 1 ) ) + "/" + ;
cColorNorm := hb_ColorIndex( cColorNorm, CLR_STANDARD )
cColorHigh := StrTran( StrTran( ;
iif( At( "/", cColorNorm ) == 0, "N", SubStr( cColorNorm, At( "/", cColorNorm ) + 1 ) ) + "/" + ;
iif( At( "/", cColorNorm ) == 0, cColorNorm, Left( cColorNorm, At( "/", cColorNorm ) - 1 ) ), "+", "" ), "*", "" )
ENDIF

49
harbour/src/rtl/menuto.prg
View File

@@ -68,6 +68,9 @@ FUNCTION __MenuTo( bBlock, cVariable )
LOCAL cColor
LOCAL cColorSelect
LOCAL cColorNormal
#ifndef HB_CLP_STRICT
LOCAL nHiLited
#endif
// Detect if a memvar was passed
lDeclared := ! __mvExist( cVariable )
@@ -86,7 +89,7 @@ FUNCTION __MenuTo( bBlock, cVariable )
ELSE
t_nPointer ++
t_nPointer++
nPointer := t_nPointer
nArrLen := Len( t_aLevel[ nPointer - 1 ] )
@@ -103,6 +106,10 @@ FUNCTION __MenuTo( bBlock, cVariable )
//
#ifndef HB_CLP_STRICT
nHiLited := 0
#endif
nSaveCursor := SetCursor( iif( Set( _SET_INTENSITY ), SC_NONE, NIL ) )
cSaveReadVar := ReadVar( hb_asciiUpper( cVariable ) )
xMsg := ""
@@ -148,12 +155,20 @@ FUNCTION __MenuTo( bBlock, cVariable )
cColorSelect := cColorNormal
ENDIF
// highlight the prompt
DispOutAt( ;
t_aLevel[ nPointer - 1, n, 1 ], ;
t_aLevel[ nPointer - 1, n, 2 ], ;
t_aLevel[ nPointer - 1, n, 3 ], ;
cColorSelect )
#ifndef HB_CLP_STRICT
// avoid flicker
IF nHiLited != n
nHiLited := n
#endif
// highlight the prompt
DispOutAt( ;
t_aLevel[ nPointer - 1, n, 1 ], ;
t_aLevel[ nPointer - 1, n, 2 ], ;
t_aLevel[ nPointer - 1, n, 3 ], ;
cColorSelect )
#ifndef HB_CLP_STRICT
ENDIF
#endif
IF lExit
EXIT
@@ -193,6 +208,8 @@ FUNCTION __MenuTo( bBlock, cVariable )
MRow(), MCol() ) ) > 0
n := nMouseClik
ENDIF
/* QUESTION: Clipper does this, but shouldn't we only
exit when HitTest() was successful? */
IF nKey == K_LDBLCLK
lExit := .T.
ENDIF
@@ -238,11 +255,19 @@ FUNCTION __MenuTo( bBlock, cVariable )
ENDSWITCH
IF n != 0
DispOutAt( ;
t_aLevel[ nPointer - 1, q, 1 ], ;
t_aLevel[ nPointer - 1, q, 2 ], ;
t_aLevel[ nPointer - 1, q, 3 ], ;
cColorNormal )
#ifndef HB_CLP_STRICT
// avoid flicker
IF nHiLited != n
nHiLited := 0
#endif
DispOutAt( ;
t_aLevel[ nPointer - 1, q, 1 ], ;
t_aLevel[ nPointer - 1, q, 2 ], ;
t_aLevel[ nPointer - 1, q, 3 ], ;
cColorNormal )
#ifndef HB_CLP_STRICT
ENDIF
#endif
ENDIF
ENDDO

4
harbour/src/vm/hashfunc.c
View File

@@ -746,6 +746,8 @@ HB_FUNC( HB_HAUTOADD )
hb_hashSetFlags( pHash, iNewFlags );
}
}
if( hb_pcount() >= 3 )
hb_hashSetDefault( pHash, hb_param( 3, HB_IT_ANY ) );
}
else
hb_errRT_BASE( EG_ARG, 2017, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
@@ -807,7 +809,9 @@ HB_FUNC( HB_HDEFAULT )
hb_errRT_BASE( EG_ARG, 2017, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}
#if defined( HB_LEGACY_LEVEL5 )
HB_FUNC( HB_HSETAUTOADD ) { HB_FUNC_EXEC( HB_HAUTOADD ); hb_itemReturn( hb_param( 1, HB_IT_HASH ) ); }
HB_FUNC( HB_HSETCASEMATCH ) { HB_FUNC_EXEC( HB_HCASEMATCH ); hb_itemReturn( hb_param( 1, HB_IT_HASH ) ); }
HB_FUNC( HB_HSETBINARY ) { HB_FUNC_EXEC( HB_HBINARY ); hb_itemReturn( hb_param( 1, HB_IT_HASH ) ); }
HB_FUNC( HB_HSETORDER ) { HB_FUNC_EXEC( HB_HKEEPORDER ); hb_itemReturn( hb_param( 1, HB_IT_HASH ) ); }
#endif

8
harbour/tests/altd.prg
View File

@@ -2,7 +2,7 @@
* $Id$
*/
// Testing AltD()
// Testing AltD() and Alert() coloring
// Notice you have to compile it using /b
PROCEDURE Main()
@@ -11,10 +11,12 @@ PROCEDURE Main()
AltD( 1 ) // Enables the debugger. Press <F5> to go
Alert( "debugger enabled" )
Alert( "debugger enabled",, "GR+/B" )
AltD() // Invokes the debugger
Alert( "debugger invoked" )
Alert( "debugger invoked",, "GR+" )
Alert( "finished",, "GR+/B,W+/R" )
RETURN

7
harbour/tests/browse.prg
View File

@@ -4,10 +4,17 @@
// Testing Browse()
#include "inkey.ch"
PROCEDURE Main()
LOCAL cColor := SetColor( "W+/B" )
#ifdef _SET_EVENTMASK
Set( _SET_EVENTMASK, INKEY_ALL )
MSetCursor( .T. )
#endif
CLS
USE test

32
harbour/tests/dbgcls.prg Normal file
View File

@@ -0,0 +1,32 @@
/*
* $Id$
*/
#pragma -b+
#include "hbclass.ch"
PROCEDURE Main
LOCAL o := Some():New()
AltD()
? o:Test()
RETURN
CREATE CLASS Some
ACCESS Test
ASSIGN Test() INLINE ::Test()
END CLASS
METHOD Test()
LOCAL a := 1
a++
RETURN a

13
harbour/tests/menuto.prg
View File

@@ -10,10 +10,15 @@
PROCEDURE Main()
MEMVAR ptestvar
MEMVAR m_testvar
LOCAL testvar
#ifdef _SET_EVENTMASK
Set( _SET_EVENTMASK, INKEY_ALL )
MSetCursor( .T. )
#endif
SET KEY K_F8 TO RECURSE()
CLS
@@ -44,9 +49,9 @@ PROCEDURE Main()
@ 6, 10 SAY "Testing with MEMVAR parameter"
@ 7, 10 SAY "Press F8 to recurse into MENU TO"
MENU TO ptestvar
MENU TO m_testvar
@ 9, 10 SAY "Your Choice = " + hb_ntos( ptestvar )
@ 9, 10 SAY "Your Choice = " + hb_ntos( m_testvar )
RETURN
@@ -56,7 +61,7 @@ PROCEDURE RECURSE()
SET KEY K_F8 TO
@ 6, 10 SAY " "
@ 6, 10 SAY Space( Len( "Press F8 to recurse into MENU TO" ) )
@ 1, 50 PROMPT "Menu Item 1" MESSAGE "Menu Message 1"
@ 2, 50 PROMPT "Menu Item 2" MESSAGE "Menu Message 2"