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

2009-10-07 00:27 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)

Browse Source 
* harbour/source/rtl/Makefile
  + harbour/source/rtl/hbascii.c
  * harbour/include/hbextern.ch
    + added new .prg functions which operates on pure ASCII strings:
      hb_asciiUpper(), hb_asciiLower(), hb_asciiIsAlpha(),
      hb_asciiIsUpper(), hb_asciiIsLower(), hb_asciiIsDigit()

  * harbour/source/rtl/objfunc.prg
  * harbour/source/rtl/tget.prg
  * harbour/source/rtl/treport.prg
  * harbour/source/rtl/tpersist.prg
  * harbour/source/rtl/memoedit.prg
  * harbour/source/rtl/menuto.prg
  * harbour/source/rtl/tgetlist.prg
  * harbour/source/rtl/tclass.prg
    ! use hb_asciiUpper() instead of Upper() to convert identifiers
      and pictures
This commit is contained in:
Przemyslaw Czerpak
2009-10-06 22:28:23 +00:00
parent a4b39cada1
commit fd6e8558c0
12 changed files with 248 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
harbour/ChangeLog
View File

@@ -17,6 +17,25 @@
past entries belonging to author(s): Viktor Szakats.
*/
2009-10-07 00:27 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/source/rtl/Makefile
+ harbour/source/rtl/hbascii.c
* harbour/include/hbextern.ch
+ added new .prg functions which operates on pure ASCII strings:
hb_asciiUpper(), hb_asciiLower(), hb_asciiIsAlpha(),
hb_asciiIsUpper(), hb_asciiIsLower(), hb_asciiIsDigit()
* harbour/source/rtl/objfunc.prg
* harbour/source/rtl/tget.prg
* harbour/source/rtl/treport.prg
* harbour/source/rtl/tpersist.prg
* harbour/source/rtl/memoedit.prg
* harbour/source/rtl/menuto.prg
* harbour/source/rtl/tgetlist.prg
* harbour/source/rtl/tclass.prg
! use hb_asciiUpper() instead of Upper() to convert identifiers
and pictures
2009-10-06 21:14 UTC+0200 Przemyslaw Czerpak (druzus/at/priv.onet.pl)
* harbour/harbour-win-spec
* harbour/harbour-wce-spec

6
harbour/include/hbextern.ch
View File

@@ -854,6 +854,12 @@ EXTERNAL HB_UTF8SUBSTR
EXTERNAL HB_UTF8STRTRAN
EXTERNAL HB_UTF8CHR
#endif
EXTERNAL HB_ASCIIUPPER
EXTERNAL HB_ASCIILOWER
EXTERNAL HB_ASCIIISALPHA
EXTERNAL HB_ASCIIISUPPER
EXTERNAL HB_ASCIIISLOWER
EXTERNAL HB_ASCIIISDIGIT
EXTERNAL HB_ISARRAY
EXTERNAL HB_ISBLOCK
EXTERNAL HB_ISCHAR

1
harbour/source/rtl/Makefile
View File

@@ -67,6 +67,7 @@ C_SOURCES := \
gx.c \
hardcr.c \
hbadler.c \
hbascii.c \
hbbit.c \
hbbyte.c \
hbcrc.c \

143
harbour/source/rtl/hbascii.c Normal file
View File

@@ -0,0 +1,143 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* HB_ASCII*() functions
*
* Copyright 2009 Przemyslaw Czerpak <druzus / at / priv.onet.pl>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*
*/
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
HB_FUNC( HB_ASCIIUPPER )
{
PHB_ITEM pText = hb_param( 1, HB_IT_STRING );
if( pText )
{
const char * pszText = hb_itemGetCPtr( pText );
ULONG ulLen = hb_itemGetCLen( pText ), u;
for( u = 0; u < ulLen; u++ )
{
if( HB_ISLOWER( pszText[ u ] ) )
{
char * pszBuff = hb_itemGetC( pText );
do
{
pszBuff[ u ] = HB_TOUPPER( pszBuff[ u ] );
}
while( ++u < ulLen );
hb_retclen_buffer( hb_strUpper( pszBuff, ulLen ), ulLen );
return;
}
}
hb_itemReturn( pText );
}
else
hb_errRT_BASE_SubstR( EG_ARG, 1102, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}
HB_FUNC( HB_ASCIILOWER )
{
PHB_ITEM pText = hb_param( 1, HB_IT_STRING );
if( pText )
{
const char * pszText = hb_itemGetCPtr( pText );
ULONG ulLen = hb_itemGetCLen( pText ), u;
for( u = 0; u < ulLen; u++ )
{
if( HB_ISUPPER( pszText[ u ] ) )
{
char * pszBuff = hb_itemGetC( pText );
do
{
pszBuff[ u ] = HB_TOLOWER( pszBuff[ u ] );
}
while( ++u < ulLen );
hb_retclen_buffer( hb_strUpper( pszBuff, ulLen ), ulLen );
return;
}
}
hb_itemReturn( pText );
}
else
hb_errRT_BASE_SubstR( EG_ARG, 1103, NULL, HB_ERR_FUNCNAME, HB_ERR_ARGS_BASEPARAMS );
}
HB_FUNC( HB_ASCIIISALPHA )
{
const char * pszText = hb_parc( 1 );
hb_retl( pszText && HB_ISALPHA( ( unsigned char ) *pszText ) );
}
HB_FUNC( HB_ASCIIISUPPER )
{
const char * pszText = hb_parc( 1 );
hb_retl( pszText && HB_ISUPPER( ( unsigned char ) *pszText ) );
}
HB_FUNC( HB_ASCIIISLOWER )
{
const char * pszText = hb_parc( 1 );
hb_retl( pszText && HB_ISLOWER( ( unsigned char ) *pszText ) );
}
HB_FUNC( HB_ASCIIISDIGIT )
{
const char * pszText = hb_parc( 1 );
hb_retl( pszText && HB_ISDIGIT( ( unsigned char ) *pszText ) );
}

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

@@ -171,7 +171,7 @@ METHOD KeyboardHook( nKey ) CLASS HBMemoEditor
RestScreen( ::nTop, ::nRight - 18, ::nTop, ::nRight, cBackScr )
SetPos( nRow, nCol )
IF Upper( Chr( nYesNoKey ) ) == "Y"
IF nYesNoKey == Asc( "Y" ) .or. nYesNoKey == Asc( "y" )
::lSaved := .F.
::lExitEdit := .T.
ENDIF

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

@@ -105,7 +105,7 @@ FUNCTION __MenuTo( bBlock, cVariable )
//
nSaveCursor := SetCursor( iif( Set( _SET_INTENSITY ), SC_NONE, NIL ) )
cSaveReadVar := ReadVar( Upper( cVariable ) )
cSaveReadVar := ReadVar( hb_asciiUpper( cVariable ) )
xMsg := ""
nMsgCol := 0
nMsgRow := Set( _SET_MESSAGE )
@@ -181,7 +181,7 @@ FUNCTION __MenuTo( bBlock, cVariable )
IF ( bAction := SetKey( nKey ) ) != NIL
Eval( bBlock, n )
Eval( bAction, ProcName( 1 ), ProcLine( 1 ), Upper( cVariable ) )
Eval( bAction, ProcName( 1 ), ProcLine( 1 ), hb_asciiUpper( cVariable ) )
n := Eval( bBlock )
IF n < 1

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

@@ -272,7 +272,7 @@ FUNCTION __objDerivedFrom( oObject, xSuper )
IF ISOBJECT( xSuper )
cClassName := xSuper:ClassName()
ELSEIF ISCHARACTER( xSuper )
cClassName := Upper( xSuper )
cClassName := hb_asciiUpper( xSuper )
ELSE
__errRT_BASE( EG_ARG, 3101, NIL, ProcName( 0 ) )
ENDIF

68
harbour/source/rtl/tclass.prg
View File

@@ -191,7 +191,7 @@ STATIC FUNCTION New( cClassName, xSuper, sClassFunc, lModuleFriendly )
NEXT
ENDIF
::cName := Upper( cClassName )
::cName := hb_asciiUpper( cClassName )
::sClassFunc := sClassFunc
::lModFriendly := lModuleFriendly
@@ -305,20 +305,25 @@ STATIC PROCEDURE AddData( cData, xInit, cType, nScope, lNoinit )
/* Default Init for Logical and numeric */
IF ! lNoInit .AND. cType != NIL .AND. xInit == NIL
SWITCH Upper( Left( cType, 1 ) )
CASE "L" /* Logical */
xInit := .F.
EXIT
CASE "I" /* Numeric or Integer */
CASE "N" /* Numeric or Integer */
xInit := 0
EXIT
CASE "D" /* Date */
xInit := hb_SToD()
EXIT
CASE "T" /* Timestamp */
xInit := hb_SToT()
EXIT
SWITCH Asc( cType )
CASE Asc( "L" ) /* Logical */
CASE Asc( "l" ) /* Logical */
xInit := .F.
EXIT
CASE Asc( "I" ) /* Numeric or Integer */
CASE Asc( "i" ) /* Numeric or Integer */
CASE Asc( "N" ) /* Numeric or Integer */
CASE Asc( "n" ) /* Numeric or Integer */
xInit := 0
EXIT
CASE Asc( "D" ) /* Date */
CASE Asc( "d" ) /* Date */
xInit := hb_SToD()
EXIT
CASE Asc( "T" ) /* Timestamp */
CASE Asc( "t" ) /* Timestamp */
xInit := hb_SToT()
EXIT
ENDSWITCH
ENDIF
@@ -347,20 +352,25 @@ STATIC PROCEDURE AddClassData( cData, xInit, cType, nScope, lNoInit )
/* Default Init for Logical and numeric */
IF ! lNoInit .AND. cType != NIL .AND. xInit == NIL
SWITCH Upper( Left( cType, 1 ) )
CASE "L" /* Logical */
xInit := .F.
EXIT
CASE "I" /* Numeric or Integer */
CASE "N" /* Numeric or Integer */
xInit := 0
EXIT
CASE "D" /* Date */
xInit := hb_SToD()
EXIT
CASE "T" /* Timestamp */
xInit := hb_SToT()
EXIT
SWITCH Asc( cType )
CASE Asc( "L" ) /* Logical */
CASE Asc( "l" ) /* Logical */
xInit := .F.
EXIT
CASE Asc( "I" ) /* Numeric or Integer */
CASE Asc( "i" ) /* Numeric or Integer */
CASE Asc( "N" ) /* Numeric or Integer */
CASE Asc( "n" ) /* Numeric or Integer */
xInit := 0
EXIT
CASE Asc( "D" ) /* Date */
CASE Asc( "d" ) /* Date */
xInit := hb_SToD()
EXIT
CASE Asc( "T" ) /* Timestamp */
CASE Asc( "t" ) /* Timestamp */
xInit := hb_SToT()
EXIT
ENDSWITCH
ENDIF

14
harbour/source/rtl/tget.prg
View File

@@ -1052,10 +1052,10 @@ METHOD picture( cPicture ) CLASS GET
nAt := At( " ", cPicture )
IF nAt == 0
::cPicFunc := Upper( cPicture )
::cPicFunc := hb_asciiUpper( cPicture )
::cPicMask := ""
ELSE
::cPicFunc := Upper( SubStr( cPicture, 1, nAt - 1 ) )
::cPicFunc := hb_asciiUpper( SubStr( cPicture, 1, nAt - 1 ) )
::cPicMask := SubStr( cPicture, nAt + 1 )
ENDIF
@@ -1155,7 +1155,7 @@ METHOD picture( cPicture ) CLASS GET
::lPicComplex := .F.
IF ! Empty( ::cPicMask )
FOR EACH cChar IN Upper( ::cPicMask )
FOR EACH cChar IN hb_asciiUpper( ::cPicMask )
IF !( cChar $ "!ANX9#" )
::lPicComplex := .T.
EXIT
@@ -1268,7 +1268,7 @@ METHOD unTransform() CLASS GET
IF "R" $ ::cPicFunc
xValue := ""
FOR nFor := 1 TO Len( ::cPicMask )
IF Upper( SubStr( ::cPicMask, nFor, 1 ) ) $ "ANX9#!LY"
IF hb_asciiUpper( SubStr( ::cPicMask, nFor, 1 ) ) $ "ANX9#!LY"
xValue += SubStr( cBuffer, nFor, 1 )
ENDIF
NEXT
@@ -1711,11 +1711,11 @@ METHOD IsEditable( nPos ) CLASS GET
IF ::cType != NIL
SWITCH ::cType
CASE "C" ; RETURN Upper( cChar ) $ "!ANX9#LY"
CASE "C" ; RETURN hb_asciiUpper( cChar ) $ "!ANX9#LY"
CASE "N" ; RETURN cChar $ "9#$*"
CASE "D"
CASE "T" ; RETURN cChar == "9"
CASE "L" ; RETURN Upper( cChar ) $ "LY#" /* CA-Cl*pper 5.2 undocumented: # allow T,F,Y,N for Logical [ckedem] */
CASE "L" ; RETURN hb_asciiUpper( cChar ) $ "LY#" /* CA-Cl*pper 5.2 undocumented: # allow T,F,Y,N for Logical [ckedem] */
ENDSWITCH
ENDIF
@@ -1773,7 +1773,7 @@ METHOD Input( cChar ) CLASS GET
ENDIF
IF ! Empty( ::cPicMask )
cPic := Upper( SubStr( ::cPicMask, ::nPos, 1 ) )
cPic := hb_asciiUpper( SubStr( ::cPicMask, ::nPos, 1 ) )
// cChar := Transform( cChar, cPic )
// Above line eliminated because some get picture template symbols for

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

@@ -748,7 +748,7 @@ METHOD PostActiveGet() CLASS HBGetList
METHOD GetReadVar() CLASS HBGetList
LOCAL oGet := ::oGet
LOCAL cName := Upper( oGet:Name )
LOCAL cName := hb_asciiUpper( oGet:Name )
LOCAL n
IF oGet:Subscript != NIL

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

@@ -83,12 +83,12 @@ METHOD LoadFromText( cObjectText ) CLASS HBPersistent
cLine := ExtractLine( cObjectText, @nFrom )
DO CASE
CASE Upper( LTrim( hb_TokenGet( cLine, 1 ) ) ) == "OBJECT"
CASE hb_asciiUpper( LTrim( hb_TokenGet( cLine, 1 ) ) ) == "OBJECT"
IF lStart
lStart := .F.
ENDIF
CASE Upper( LTrim( hb_TokenGet( cLine, 1 ) ) ) == "ARRAY"
CASE hb_asciiUpper( LTrim( hb_TokenGet( cLine, 1 ) ) ) == "ARRAY"
cLine := SubStr( cLine, At( "::", cLine ) )
MEMVAR->oSelf := Self
cLine := StrTran( cLine, "::", "oSelf:" )

40
harbour/source/rtl/treport.prg
View File

@@ -1376,20 +1376,32 @@ STATIC FUNCTION ListAsArray( cList, cDelimiter )
STATIC FUNCTION MakeAStr( uVar, cType )
LOCAL cString
DO CASE
CASE Upper( cType ) == "D"
cString := DToC( uVar )
CASE Upper( cType ) == "T"
cString := hb_TToC( uVar )
CASE Upper( cType ) == "L"
cString := iif( uVar, "T", "F" )
CASE Upper( cType ) == "N"
cString := Str( uVar )
CASE Upper( cType ) == "C"
cString := uVar
OTHERWISE
cString := "INVALID EXPRESSION"
ENDCASE
SWITCH Asc( cType )
CASE Asc( "D" )
CASE Asc( "d" )
cString := DToC( uVar )
EXIT
CASE Asc( "T" )
CASE Asc( "t" )
cString := hb_TToC( uVar )
EXIT
CASE Asc( "L" )
CASE Asc( "l" )
cString := iif( uVar, "T", "F" )
EXIT
CASE Asc( "N" )
CASE Asc( "n" )
cString := Str( uVar )
EXIT
CASE Asc( "C" )
CASE Asc( "c" )
CASE Asc( "M" )
CASE Asc( "m" )
cString := uVar
EXIT
OTHERWISE
cString := "INVALID EXPRESSION"
ENDSWITCH
RETURN cString