diff --git a/harbour/ChangeLog b/harbour/ChangeLog index eaff204412..9cc576c60e 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -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 diff --git a/harbour/include/hbextern.ch b/harbour/include/hbextern.ch index e4a374f452..2a354a457b 100644 --- a/harbour/include/hbextern.ch +++ b/harbour/include/hbextern.ch @@ -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 diff --git a/harbour/source/rtl/Makefile b/harbour/source/rtl/Makefile index 47310650b7..a0a763101e 100644 --- a/harbour/source/rtl/Makefile +++ b/harbour/source/rtl/Makefile @@ -67,6 +67,7 @@ C_SOURCES := \ gx.c \ hardcr.c \ hbadler.c \ + hbascii.c \ hbbit.c \ hbbyte.c \ hbcrc.c \ diff --git a/harbour/source/rtl/hbascii.c b/harbour/source/rtl/hbascii.c new file mode 100644 index 0000000000..bb69138618 --- /dev/null +++ b/harbour/source/rtl/hbascii.c @@ -0,0 +1,143 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * HB_ASCII*() functions + * + * Copyright 2009 Przemyslaw Czerpak + * 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 ) ); +} diff --git a/harbour/source/rtl/memoedit.prg b/harbour/source/rtl/memoedit.prg index 02217c14e5..426ebf12d9 100644 --- a/harbour/source/rtl/memoedit.prg +++ b/harbour/source/rtl/memoedit.prg @@ -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 diff --git a/harbour/source/rtl/menuto.prg b/harbour/source/rtl/menuto.prg index d235a23eb6..08052db26b 100644 --- a/harbour/source/rtl/menuto.prg +++ b/harbour/source/rtl/menuto.prg @@ -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 diff --git a/harbour/source/rtl/objfunc.prg b/harbour/source/rtl/objfunc.prg index 9865262b97..7c27115329 100644 --- a/harbour/source/rtl/objfunc.prg +++ b/harbour/source/rtl/objfunc.prg @@ -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 diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index 67d66fc492..3589421258 100644 --- a/harbour/source/rtl/tclass.prg +++ b/harbour/source/rtl/tclass.prg @@ -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 diff --git a/harbour/source/rtl/tget.prg b/harbour/source/rtl/tget.prg index cfb6df3ef8..e18e32dd00 100644 --- a/harbour/source/rtl/tget.prg +++ b/harbour/source/rtl/tget.prg @@ -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 diff --git a/harbour/source/rtl/tgetlist.prg b/harbour/source/rtl/tgetlist.prg index 6e0e097109..c2049b8ebe 100644 --- a/harbour/source/rtl/tgetlist.prg +++ b/harbour/source/rtl/tgetlist.prg @@ -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 diff --git a/harbour/source/rtl/tpersist.prg b/harbour/source/rtl/tpersist.prg index 76d1209e1b..71484476f3 100644 --- a/harbour/source/rtl/tpersist.prg +++ b/harbour/source/rtl/tpersist.prg @@ -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:" ) diff --git a/harbour/source/rtl/treport.prg b/harbour/source/rtl/treport.prg index a6f13a0e0d..1e2447071b 100644 --- a/harbour/source/rtl/treport.prg +++ b/harbour/source/rtl/treport.prg @@ -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