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

2012-10-11 00:43 UTC+0200 Viktor Szakats (harbour syenar.net)

Browse Source 
* src/rtl/teditor.prg
    + added three TODOs, related to Ctrl+B and Ctrl+T missing
      key implementations

  * contrib/xhb/cstruct.prg
  * contrib/xhb/hblognet.prg
  * contrib/xhb/trpc.prg
  * contrib/xhb/trpccli.prg
  * contrib/xhb/ttable.prg
  * contrib/xhb/xhberr.prg
  * contrib/xhb/xhbmemo.prg
    ! random unicode fixes where I stumbled into incompatible code
    ! fixed two 'ValType( x ) == "NI"' expressions which were never
      true. I assumed it was meant to check for numeric and replaced
      with HB_ISNUMERIC() calls.
    % ADel()/ASize() pairs replaced with hb_ADel( ,, .T. ) calls
    * removed some unnecessary parantheses and minor formatting
    ! fixed one [] operator on a string (possibly used with the
      intention to preallocate a 255 byte long string)
    * replaced K_TAB used a character constant with 9
    ! fixed one -1 array index to use ATail() instead
    ; only build-tested

  * doc/xhb-diff.txt
    ! typo regarding the meaning of a[ -1 ] in xhb

  * contrib/xhb/hbcrypt.c
    * formatted

  * contrib/xhb/xhbtedit.prg
    ! :ReformParagraph() fixed for unicode (untested)
    * :ReformParagraph() code cleaned
    * replaced all Chr( 141 ) + Chr( 10 ) references for
      a local function returning it. This code sequence
      is not unicode (UTF-8) compatible, so something
      will have to be done with it in the future.
    * minor formatting, typos in comment
    ; only build-tested
This commit is contained in:
Viktor Szakats
2012-10-10 22:45:32 +00:00
parent 7e1f4e65fc
commit ccd39d057c
12 changed files with 198 additions and 160 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
harbour/ChangeLog
View File

@@ -16,6 +16,46 @@
The license applies to all entries newer than 2009-04-28.
*/
2012-10-11 00:43 UTC+0200 Viktor Szakats (harbour syenar.net)
* src/rtl/teditor.prg
+ added three TODOs, related to Ctrl+B and Ctrl+T missing
key implementations
* contrib/xhb/cstruct.prg
* contrib/xhb/hblognet.prg
* contrib/xhb/trpc.prg
* contrib/xhb/trpccli.prg
* contrib/xhb/ttable.prg
* contrib/xhb/xhberr.prg
* contrib/xhb/xhbmemo.prg
! random unicode fixes where I stumbled into incompatible code
! fixed two 'ValType( x ) == "NI"' expressions which were never
true. I assumed it was meant to check for numeric and replaced
with HB_ISNUMERIC() calls.
% ADel()/ASize() pairs replaced with hb_ADel( ,, .T. ) calls
* removed some unnecessary parantheses and minor formatting
! fixed one [] operator on a string (possibly used with the
intention to preallocate a 255 byte long string)
* replaced K_TAB used a character constant with 9
! fixed one -1 array index to use ATail() instead
; only build-tested
* doc/xhb-diff.txt
! typo regarding the meaning of a[ -1 ] in xhb
* contrib/xhb/hbcrypt.c
* formatted
* contrib/xhb/xhbtedit.prg
! :ReformParagraph() fixed for unicode (untested)
* :ReformParagraph() code cleaned
* replaced all Chr( 141 ) + Chr( 10 ) references for
a local function returning it. This code sequence
is not unicode (UTF-8) compatible, so something
will have to be done with it in the future.
* minor formatting, typos in comment
; only build-tested
2012-10-11 00:01 UTC+0200 Przemyslaw Czerpak (druzus/at/poczta.onet.pl)
* harbour/contrib/hbfbird/firebird.c
% some small optimizations

6
harbour/contrib/xhb/cstruct.prg
View File

@@ -114,7 +114,7 @@ FUNCTION __ActiveStructure( cStructure, nAlign )
ENDIF
AAdd( s_aClasses, { cStructure, NIL, {}, {}, iif( HB_ISNUMERIC( nAlign ), nAlign, 8 ) } )
//TraceLog( "Registered: " + cStructure, s_aClasses[ -1 ][ 5 ] )
//TraceLog( "Registered: " + cStructure, ATail( s_aClasses )[ 5 ] )
t_aActiveStructure := ATail( s_aClasses )
ELSE
@@ -261,7 +261,7 @@ PROCEDURE HB_CStructureCSyntax( cStructure, aDefinitions, cTag, cSynonList, nAli
IF ! Empty( cTag )
AAdd( s_aSynonyms, { Upper( cTag ), nID + CTYPE_STRUCTURE } )
//Tracelog( s_aSynonyms[ -1 ][ 1 ], s_aSynonyms[ -1 ][ 2 ] )
//Tracelog( ATail( s_aSynonyms )[ 1 ], ATail( s_aSynonyms )[ 2 ] )
ENDIF
IF ! Empty( cSynonList )
@@ -272,7 +272,7 @@ PROCEDURE HB_CStructureCSyntax( cStructure, aDefinitions, cTag, cSynonList, nAli
AAdd( s_aSynonyms, { Upper( cSynon ), nID + CTYPE_STRUCTURE } )
ENDIF
//Tracelog( s_aSynonyms[ -1 ][ 1 ], s_aSynonyms[ -1 ][ 2 ] )
//Tracelog( ATail( s_aSynonyms )[ 1 ], ATail( s_aSynonyms )[ 2 ] )
NEXT
ENDIF

88
harbour/contrib/xhb/hbcrypt.c
View File

@@ -80,9 +80,9 @@
*/
void nxs_crypt(
const unsigned char *source, HB_SIZE srclen,
const unsigned char *key, HB_SIZE keylen,
unsigned char *cipher )
const unsigned char * source, HB_SIZE srclen,
const unsigned char * key, HB_SIZE keylen,
unsigned char * cipher )
{
if( keylen > NXS_MAX_KEYLEN )
@@ -106,9 +106,9 @@ void nxs_crypt(
/*decrypting the buffer */
void nxs_decrypt(
const unsigned char *cipher, HB_SIZE cipherlen,
const unsigned char *key, HB_SIZE keylen,
unsigned char *result )
const unsigned char * cipher, HB_SIZE cipherlen,
const unsigned char * key, HB_SIZE keylen,
unsigned char * result )
{
if( keylen > NXS_MAX_KEYLEN )
keylen = NXS_MAX_KEYLEN;
@@ -129,9 +129,9 @@ void nxs_decrypt(
/* This function scrambles the source using the letter ordering in the
* key. */
void nxs_scramble(
const unsigned char *source, HB_SIZE srclen,
const unsigned char *key, HB_SIZE keylen,
unsigned char *cipher )
const unsigned char * source, HB_SIZE srclen,
const unsigned char * key, HB_SIZE keylen,
unsigned char * cipher )
{
HB_ISIZ scramble[ NXS_MAX_KEYLEN ];
HB_SIZE len;
@@ -163,7 +163,7 @@ void nxs_partial_scramble(
HB_SIZE pos;
HB_USHORT kpos;
pos = 0l;
pos = 0;
kpos = 0;
while( pos + kpos < len )
{
@@ -195,12 +195,12 @@ void nxs_unscramble(
nxs_make_scramble( scramble, key, keylen );
/* Leave alone the last block */
len = keylen > 0 ? (cipherlen / keylen) * keylen : 0;
len = keylen > 0 ? ( cipherlen / keylen ) * keylen : 0;
nxs_partial_unscramble( cipher, scramble, len, keylen );
keylen = cipherlen - len;
nxs_make_scramble( scramble, key, keylen );
nxs_partial_unscramble( cipher+len, scramble, keylen, keylen );
nxs_partial_unscramble( cipher + len, scramble, keylen, keylen );
}
@@ -213,11 +213,11 @@ void nxs_partial_unscramble(
HB_USHORT kpos;
unsigned char buf[ NXS_MAX_KEYLEN ];
pos = 0l;
pos = 0;
kpos = 0;
while( pos + kpos < len )
{
buf[ kpos ] = cipher[ pos + scramble[ kpos ] ];
buf[ kpos ] = cipher[ pos + scramble[ kpos ] ];
kpos++;
if( kpos >= ( HB_USHORT ) keylen )
{
@@ -234,29 +234,29 @@ void nxs_xorcode(
unsigned char * cipher, HB_SIZE cipherlen,
const unsigned char * key, HB_SIZE keylen )
{
HB_SIZE pos = 0l;
HB_SIZE pos = 0;
HB_USHORT keypos = 0;
unsigned char c_bitrest;
c_bitrest = cipher[ 0 ] >>5;
c_bitrest = cipher[ 0 ] >> 5;
while( pos < cipherlen )
{
cipher[pos] <<= 3;
cipher[ pos ] <<= 3;
if(keypos == ( HB_USHORT ) keylen-1 || pos == cipherlen -1 )
cipher[pos] |= c_bitrest;
if( keypos == ( HB_USHORT ) keylen - 1 || pos == cipherlen - 1 )
cipher[ pos ] |= c_bitrest;
else
cipher[pos] |= cipher[pos+1] >> 5;
cipher[ pos ] |= cipher[ pos + 1 ] >> 5;
cipher[pos] ^= key[ keypos ];
keypos ++;
cipher[ pos ] ^= key[ keypos ];
keypos++;
pos++;
if(keypos == ( HB_USHORT ) keylen )
if( keypos == ( HB_USHORT ) keylen )
{
keypos = 0;
c_bitrest = cipher[ pos ] >>5;
c_bitrest = cipher[ pos ] >> 5;
}
}
}
@@ -265,7 +265,7 @@ void nxs_xordecode(
unsigned char * cipher, HB_SIZE cipherlen,
const unsigned char * key, HB_SIZE keylen )
{
HB_SIZE pos = 0l;
HB_SIZE pos = 0;
HB_USHORT keypos = 0;
unsigned char c_bitrest, c_bitleft;
@@ -273,30 +273,30 @@ void nxs_xordecode(
if( keylen > cipherlen - pos )
keylen = ( HB_USHORT ) ( cipherlen - pos );
c_bitleft = ( cipher[ keylen -1 ] ^ key[ keylen -1 ] ) << 5;
c_bitleft = ( cipher[ keylen - 1 ] ^ key[ keylen - 1 ] ) << 5;
while( pos < cipherlen )
{
cipher[pos] ^= key[ keypos ];
cipher[ pos ] ^= key[ keypos ];
c_bitrest = cipher[ pos ] <<5;
c_bitrest = cipher[ pos ] << 5;
cipher[ pos ] >>= 3;
cipher[ pos ] |= c_bitleft;
c_bitleft = c_bitrest;
keypos ++;
pos ++;
keypos++;
pos++;
if(keypos == ( HB_USHORT ) keylen )
if( keypos == ( HB_USHORT ) keylen )
{
keypos = 0;
/* last block */
if( keylen > cipherlen - pos )
{
keylen = ( HB_USHORT ) (cipherlen - pos);
keylen = ( HB_USHORT ) ( cipherlen - pos );
}
c_bitleft = ( cipher[ pos + keylen -1 ] ^ key[ keylen -1 ] ) << 5;
c_bitleft = ( cipher[ pos + keylen - 1 ] ^ key[ keylen - 1 ] ) << 5;
}
}
}
@@ -306,7 +306,7 @@ void nxs_xorcyclic(
unsigned char * cipher, HB_SIZE cipherlen,
const unsigned char * key, HB_SIZE keylen )
{
HB_SIZE pos = 0l, crcpos = 0l;
HB_SIZE pos = 0, crcpos = 0;
HB_U32 crc1, crc2, crc3;
HB_U32 crc1l, crc2l, crc3l;
@@ -324,18 +324,18 @@ void nxs_xorcyclic(
if( crcpos < 4 )
{
/* this ensures portability across platforms */
cipher[ pos ] ^= (unsigned char) (crc1l % 256 );
crc1l /= 256l;
cipher[ pos ] ^= ( unsigned char ) ( crc1l % 256 );
crc1l /= 256L;
}
else if( crcpos < 8 )
{
cipher[ pos ] ^= (unsigned char) (crc2l % 256 );
crc2l /= 256l;
cipher[ pos ] ^= ( unsigned char ) ( crc2l % 256 );
crc2l /= 256L;
}
else
{
cipher[ pos ] ^= (unsigned char) (crc3l % 256 );
crc3l /= 256l;
cipher[ pos ] ^= ( unsigned char ) ( crc3l % 256 );
crc3l /= 256L;
}
crcpos++;
pos++;
@@ -355,7 +355,7 @@ HB_U32 nxs_cyclic_sequence( HB_U32 input )
HB_U32 first = input & 0xffff;
HB_U32 second = input >> 16;
HB_U32 ret = ( ( second * BASE * BASE ) & 0xffff ) |
( (first * BASE * BASE) &0xffff0000);
( ( first * BASE * BASE ) & 0xffff0000 );
return ret;
}
@@ -365,12 +365,12 @@ void nxs_make_scramble( HB_ISIZ * scramble, const unsigned char * key, HB_SIZE k
{
HB_SIZE i, j, tmp;
for( i = 0; i < keylen; i ++ )
for( i = 0; i < keylen; ++i )
scramble[ i ] = i;
for( i = 0; i < keylen; i ++ )
for( i = 0; i < keylen; ++i )
{
for( j = i + 1; j < keylen; j ++ )
for( j = i + 1; j < keylen; ++j )
{
if( key[ scramble[ j ] ] < key[ scramble[ i ] ] )
{

21
harbour/contrib/xhb/hblognet.prg
View File

@@ -80,7 +80,7 @@ CLASS HB_LogEmail FROM HB_LogChannel
ENDCLASS
METHOD New( nLevel, cHelo, cServer, cSendTo, cSubject, cFrom ) CLASS HB_LogEmail
METHOD New( nLevel, cHelo, cServer, cSendTo, cSubject, cFrom ) CLASS HB_LogEmail
LOCAL nPos
@@ -272,8 +272,8 @@ METHOD Open( cName ) CLASS HB_LogInetPort
::mtxBusy := hb_mutexCreate()
::nThread := hb_threadStart( Self, "AcceptCon" )
#else
// If we have not threads, we have to sync accept incoming connection
// when we log a message
// If we have not threads, we have to sync accept incoming connection
// when we log a message
hb_inetTimeout( ::skIn, 50 )
#endif
@@ -290,16 +290,16 @@ METHOD Close( cName ) CLASS HB_LogInetPort
ENDIF
#ifdef HB_THREAD_SUPPORT
// kind termination request
// kind termination request
::bTerminate := .T.
hb_threadJoin( ::nThread )
#endif
hb_inetClose( ::skIn )
// we now are sure that incoming thread index is not used.
// we now are sure that incoming thread index is not used.
DO WHILE Len( ::aListeners ) > 0
DO WHILE Len( ::aListeners ) > 0
sk := ATail( ::aListeners )
ASize( ::aListeners, Len( ::aListeners ) - 1 )
hb_inetClose( sk )
@@ -315,10 +315,10 @@ METHOD Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogInetPort
#ifdef HB_THREAD_SUPPORT
// be sure thread is not busy now
// be sure thread is not busy now
hb_mutexLock( ::mtxBusy )
#else
// IF we have not a thread, we must see if there is a new connection
// IF we have not a thread, we must see if there is a new connection
sk := hb_inetAccept( ::skIn ) //timeout should be short
IF sk != NIL
@@ -326,7 +326,7 @@ METHOD Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogInetPort
ENDIF
#endif
// now we transmit the message to all the available channels
// now we transmit the message to all the available channels
cMessage := ::Format( nStyle, cMessage, cName, nPriority )
nCount := 1
@@ -335,8 +335,7 @@ METHOD Send( nStyle, cMessage, cName, nPriority ) CLASS HB_LogInetPort
hb_inetSendAll( sk, cMessage + CRLF )
// if there is an error, we remove the listener
IF hb_inetErrorCode( sk ) != 0
ADel( ::aListeners, nCount )
ASize( ::aListeners , Len( ::aListeners ) - 1 )
hb_ADel( ::aListeners, nCount, .T. )
ELSE
nCount++
ENDIF

38
harbour/contrib/xhb/trpc.prg
View File

@@ -358,7 +358,7 @@ METHOD Describe() CLASS tRPCFunction
FOR nCount := 1 TO Len( ::aParameters ) - 1
cRet += ::aParameters[ nCount ] + ","
NEXT
cRet += ::aParameters[ -1 ]
cRet += ATail( ::aParameters )
ENDIF
cRet += ")-->" + ::cReturn
@@ -386,7 +386,7 @@ CLASS tRPCServeCon
/* User ID */
DATA cUserId
/* Allow progress ?*/
/* Allow progress ? */
DATA lAllowProgress
METHOD New( oParent, skIn ) CONSTRUCTOR
@@ -714,13 +714,13 @@ METHOD RecvAuth( lEncrypt ) CLASS tRPCServeCon
RETURN .F.
ENDIF
nPos := At( ":", cReadin )
nPos := hb_BAt( ":", cReadin )
IF nPos == 0
RETURN .F.
ENDIF
cUserID := SubStr( cReadin, 1, nPos - 1 )
cPassword := SubStr( cReadin, nPos + 1 )
cUserID := hb_BSubStr( cReadin, 1, nPos - 1 )
cPassword := hb_BSubStr( cReadin, nPos + 1 )
IF ! lEncrypt
::nAuthLevel := ::oServer:Authorize( cUserid, cPassword )
@@ -752,21 +752,21 @@ METHOD LaunchChallenge( cUserid, cPassword ) CLASS tRPCServeCon
::cChallengeUserid := cUserid
/* Let's generate the sequence */
cChallenge := Space( 255 )
cChallenge := ""
FOR nCount := 1 TO 255
cChallenge[ nCount ] := Chr( HB_Random(0, 255 ) )
cChallenge += hb_BChar( HB_Random(0, 255 ) )
NEXT
::nChallengeCRC := HB_Checksum( cChallenge )
cChallenge := HB_Crypt( cChallenge, ::cCryptKey )
hb_inetSendAll( ::skRemote, "XHBR94" + HB_CreateLen8( Len( cChallenge ) ) + cChallenge )
hb_inetSendAll( ::skRemote, "XHBR94" + HB_CreateLen8( hb_BLen( cChallenge ) ) + cChallenge )
IF hb_inetErrorCode( ::skRemote ) != 0
RETURN .F.
ENDIF
RETURN .T.
RETURN .T.
METHOD RecvChallenge() CLASS tRPCServeCon
@@ -1085,11 +1085,13 @@ METHOD FunctionRunner( cFuncName, oFunc, nMode, aParams, aDesc ) CLASS tRPCServe
// has still something to do.
::SendResult( oRet, cFuncName )
//Signal that the thread is no longer alive
// Signal that the thread is no longer alive
// Should not be needed!
/*HB_MutexLock( ::mtxBusy )
/*
hb_mutexLock( ::mtxBusy )
::thFunction := -1
HB_MutexUnlock( ::mtxBusy )*/
hb_mutexUnlock( ::mtxBusy )
*/
RETURN .T.
@@ -1315,8 +1317,7 @@ METHOD Remove( cName ) CLASS tRPCService
hb_mutexLock( ::mtxBusy )
nElem := AScan( ::aFunctions, {| x | cName == x:cName } )
IF nElem != 0
ADel( ::aFunctions, nElem )
ASize( ::aFunctions, Len( ::aFunctions ) - 1 )
hb_ADel( ::aFunctions, nElem, .T. )
lRet := .T.
ENDIF
hb_mutexUnlock( ::mtxBusy )
@@ -1470,7 +1471,7 @@ METHOD UDPInterpretRequest( cData, nPacketLen, cRes ) CLASS tRPCService
RETURN .F.
ENDIF
cCode := Substr( cData, 1, 6 )
cCode := hb_BSubstr( cData, 1, 6 )
DO CASE
/* XHRB00 - server scan */
@@ -1479,7 +1480,7 @@ METHOD UDPInterpretRequest( cData, nPacketLen, cRes ) CLASS tRPCService
RETURN .F.
ENDIF
IF nPacketLen > 6
cMatch := hb_Deserialize( Substr( cData, 7 ) )
cMatch := hb_Deserialize( hb_BSubstr( cData, 7 ) )
IF hb_regexMatch( cMatch, ::cServerName )
cRes := "XHBR10" + hb_Serialize( ::cServerName )
ENDIF
@@ -1495,7 +1496,7 @@ METHOD UDPInterpretRequest( cData, nPacketLen, cRes ) CLASS tRPCService
ENDIF
/* minimal length to be valid */
IF nPacketLen > 24
cSerial := hb_DeserialBegin( Substr( cData, 7 ) )
cSerial := hb_DeserialBegin( hb_BSubstr( cData, 7 ) )
cMatch := hb_DeserialNext( @cSerial )
cNumber := NIL
IF ! Empty( cMatch )
@@ -1533,8 +1534,7 @@ METHOD Terminating( oConnection ) CLASS tRPCService
hb_mutexLock( ::mtxBusy )
nToken := AScan( ::aServing, {| x | x == oConnection } )
IF nToken > 0
ADel( ::aServing, nToken )
ASize( ::aServing, Len( ::aServing ) - 1 )
hb_ADel( ::aServing, nToken, .T. )
ENDIF
hb_mutexUnlock( ::mtxBusy )

21
harbour/contrib/xhb/trpccli.prg
View File

@@ -474,12 +474,12 @@ METHOD BuildChallengePwd( cPassword ) CLASS tRPCClient
cRet := ""
FOR nCount := 1 TO nLen
cRet += Chr( Int( hb_Random( 2, 254 ) ) )
cRet += hb_BChar( Int( hb_Random( 2, 254 ) ) )
NEXT
cRet += "PASSWORD:" + cPassword + ":"
DO WHILE Len( cRet ) < 100
cRet += Chr( Int( hb_Random( 2, 254 ) ) )
DO WHILE hb_BLen( cRet ) < 100
cRet += hb_BChar( Int( hb_Random( 2, 254 ) ) )
ENDDO
cRet := ::Encrypt( cRet )
@@ -532,7 +532,7 @@ METHOD Disconnect() CLASS tRPCClient
IF ::nStatus >= RPC_STATUS_LOGGED
hb_mutexLock( ::mtxBusy )
::nStatus := RPC_STATUS_NONE
::nStatus := RPC_STATUS_NONE
hb_inetSendAll( ::skTcp, "XHBR92" )
hb_inetClose( ::skTcp )
hb_mutexUnlock( ::mtxBusy )
@@ -552,12 +552,12 @@ METHOD SetLoopMode( nMethod, xData, nEnd, nStep ) CLASS tRPCClient
IF HB_ISARRAY( xData )
::aLoopData := xData
ELSE
IF ValType( xData ) == "NI"
IF HB_ISNUMERIC( xData )
// this is to allow garbage collecting
::aLoopData := NIL
::nLoopStart := xData
::nLoopEnd := nEnd
IF ValType( nStep ) == "NI"
IF HB_ISNUMERIC( nStep )
::nLoopStep := nStep
ELSE
::nLoopStep := 1
@@ -606,8 +606,7 @@ METHOD Call( ... ) CLASS tRPCClient
oCalling := hb_PValue( 1 )
IF HB_ISARRAY( oCalling )
cFunction := oCalling[ 1 ]
ADel( oCalling, 1 )
ASize( oCalling, Len( oCalling ) - 1 )
hb_ADel( oCalling, 1, .T. )
aParams := oCalling
ELSE
cFunction := oCalling
@@ -777,18 +776,18 @@ METHOD SendCall( cFunction, aParams ) CLASS tRPCClient
hb_Serialize( ::nLoopStep )
ENDIF
cData += hb_Serialize( cFunction ) + hb_Serialize( aParams )
cData += hb_Serialize( cFunction ) + hb_Serialize( aParams )
IF ::aLoopData != NIL
cData += hb_Serialize( ::aLoopData )
nReq += 2
ENDIF
nLen := Len( cData )
nLen := hb_BLen( cData )
IF nLen > 512
cData := HB_Compress( cData )
cData := "XHBR2" + hb_ntos( nReq + 1 ) + ;
HB_CreateLen8( nLen ) + HB_CreateLen8( Len( cData ) ) + ;
HB_CreateLen8( nLen ) + HB_CreateLen8( hb_BLen( cData ) ) + ;
cType + ::Encrypt( cData )
ELSE
cData := "XHBR2" + hb_ntos( nReq ) + HB_CreateLen8( nLen ) + ;

4
harbour/contrib/xhb/ttable.prg
View File

@@ -1172,7 +1172,7 @@ METHOD Undo( nBuffer, nLevel ) CLASS HBTable
NEXT
IF lRet
ASize( ::deleteBuffers, ( nLen - nLevel ) )
ASize( ::deleteBuffers, nLen - nLevel )
ENDIF
ENDIF
@@ -1225,7 +1225,7 @@ METHOD Undo( nBuffer, nLevel ) CLASS HBTable
// erase entries
IF lRet
ASize( ::WriteBuffers, ( nLen - nLevel ) )
ASize( ::WriteBuffers, nLen - nLevel )
ENDIF
ENDIF

12
harbour/contrib/xhb/xhberr.prg
View File

@@ -578,12 +578,12 @@ STATIC FUNCTION LogError( oerr )
WHILE FSeek( nMemHandle, 0, FS_RELATIVE ) + 1 < nMemLength
nMemWidth := Space( 18 )
FRead( nMemHandle, @nMemWidth, 18 )
cVarName := Left( nMemWidth, At( Chr( 0 ), nMemWidth ) - 1 )
cVarType := SubStr( nMemWidth, 12, 1 )
cVarRec := Bin2W( Right( nMemWidth, 2 ) )
nMemCount := iif( cVarType $ Chr( 195 ) + Chr( 204 ), 14 + cVarRec, 22 )
cVarName := hb_BLeft( nMemWidth, hb_BAt( Chr( 0 ), nMemWidth ) - 1 )
cVarType := hb_BSubStr( nMemWidth, 12, 1 )
cVarRec := Bin2W( hb_BRight( nMemWidth, 2 ) )
nMemCount := iif( cVarType $ hb_BChar( 195 ) + hb_BChar( 204 ), 14 + cVarRec, 22 )
FSeek( nMemHandle, nMemCount, FS_RELATIVE )
cTemp := Left( cVarName + Space( 10 ), 10 )
cTemp := hb_BLeft( cVarName + Space( 10 ), 10 )
cTemp += " TYPE " + Type( cVarName )
cTemp += " " + iif( Type( cVarName ) == "C", '"' + &cVarName + '"', strvalue( &cVarName ) )
nBytes := 0
@@ -655,7 +655,7 @@ STATIC FUNCTION strvalue( c, l )
cr := DToC( c )
EXIT
CASE "L"
// cr := iif( l, iif( c, "On", "Off" ), iif( c, "True", "False" ) )
// cr := iif( l, iif( c, "On", "Off" ), iif( c, "True", "False" ) )
cr := iif( l, iif( c, "On", "Off" ), iif( c, ".t.", ".f." ) )
EXIT
ENDSWITCH

2
harbour/contrib/xhb/xhbmemo.prg
View File

@@ -487,7 +487,7 @@ FUNCTION xhb_MemoEdit( cString,;
/* 24/10/2005 - <maurilio.longo@libero.it>
Clipper MemoEdit() converts Tabs into spaces
*/
oEd := XHB_TMemoEditor():New( StrTran( cString, Chr( K_TAB ), Space( nTabSize ) ),;
oEd := XHB_TMemoEditor():New( StrTran( cString, Chr( 9 ), Space( nTabSize ) ),;
nTop, nLeft, nBottom, nRight,;
lEditMode,;
nLineLength,;

117
harbour/contrib/xhb/xhbtedit.prg
View File

@@ -75,19 +75,19 @@
*/
/*
* Teditor Fix: teditorx.prg -- V 2.0 2003/11/17
* Teditor Fix: teditorx.prg -- v2.0 2003-11-17
* Copyright 2003 Lance Owens <servant@gnosis.org>
*
* This Revised Version has a completely rewritten edit method key commands, with dynamic line & paragraqph reformatting.
* Includes a fix for the bugs in Teditor key processing that previously caused array errors
* This Revised Version has a completely rewritten edit method key commands, with dynamic line & paragraph reformatting.
* Includes a fix for the bugs in TEditor key processing that previously caused array errors
*
* Note: --If using the paste function to enter text, increase size of keyboard buffer to 2048 or 4096!
* Otherwise buffer will overrun -- it takes some processor time to do all the dynamic reformatting
* --SetCursor() is used to change cursor between insert and overwrite. Modify if desired....
* This will need to be cleared to return to original cursor within Memoedit()!!
* --K_LEFT is set to exit Memoedit() in read-only mode, in addition to the standard exit keys ESC.
* --CHR(141)+CHR(10) "soft CR" inserted by Clipper memoedit() is automatically removed when encountered in text
* --Color persistence problems in previous version corrected by taking setcolor() at Method New file call.
* Note: -- If using the paste function to enter text, increase size of keyboard buffer to 2048 or 4096!
* Otherwise buffer will overrun -- it takes some processor time to do all the dynamic reformatting
* -- SetCursor() is used to change cursor between insert and overwrite. Modify if desired....
* This will need to be cleared to return to original cursor within Memoedit()!!
* -- K_LEFT is set to exit MemoEdit() in read-only mode, in addition to the standard exit keys ESC.
* -- __SoftCR() "soft CR" inserted by Clipper MemoEdit() is automatically removed when encountered in text
* -- Color persistence problems in previous version corrected by taking SetColor() at Method New file call.
*
* Modifications are based upon the following source file:
*/
@@ -143,17 +143,17 @@ CREATE CLASS XHBEditor
DATA nMarkLen
DATA nOrigCursor INIT SetCursor() // Save to restore original cursor format on exit
DATA ProcName INIT ""
DATA ProcLine INIT 0
DATA ProcName INIT ""
DATA ProcLine INIT 0
DATA nCurrentCursor INIT SetCursor()
DATA nCurrentCursor INIT SetCursor()
DATA lSelActive INIT .F.
DATA nRowSelStart INIT 0 // First row selected
DATA nRowSelEnd INIT 0 // Last row selected
DATA nColSelRow INIT 0 // Row of col selected
DATA nColSelStart INIT 0 // First col selected
DATA nColSelEnd INIT 0 // Last col selected
DATA lSelActive INIT .F.
DATA nRowSelStart INIT 0 // First row selected
DATA nRowSelEnd INIT 0 // Last row selected
DATA nColSelRow INIT 0 // Row of col selected
DATA nColSelStart INIT 0 // First col selected
DATA nColSelEnd INIT 0 // Last col selected
// Class DATA can be faster, but since the user can change directly
// READINSERT(), ::lInsert must check in it.
@@ -233,15 +233,15 @@ CREATE CLASS XHBEditor
METHOD K_Esc()
// 2006/07/19 - E.F. - Added datas and methods.
DATA cInsLabel // <Insert> label to display at toggle insert.
DATA lVerticalScroll INIT .T. // True if vertical scrolling is active (default).
DATA cInsLabel // <Insert> label to display at toggle insert
DATA lVerticalScroll INIT .T. // True if vertical scrolling is active (default)
DATA bKeyBlock // To process set key codeblock
METHOD DisplayInsert( lInsert ) // Show <insert> message at top of screen.
METHOD DisplayInsert( lInsert ) // Show <insert> message at top of screen
METHOD LastRow() INLINE Len( ::aText ) // Replace old ::naTextLen
METHOD DelTextRight( nRow ) // Delete text right of cursor.
METHOD DelWordRight() // Delete word right <CTRL-T> key.
METHOD ReformParagraph() // Reformat paragraph. CTRL-B behaviour
METHOD DelTextRight( nRow ) // Delete text right of cursor
METHOD DelWordRight() // Delete word right <Ctrl+T> key
METHOD ReformParagraph() // Reformat paragraph. <Ctrl+B> behaviour
/////////////////
@@ -342,18 +342,16 @@ METHOD New( cString, nTop, nLeft, nBottom, nRight, lEditMode, nLineLength, nTabS
::nFirstCol := Max( 1, ::nTextCol - ::nWndCol )
// If memofield was created with Clipper, it needs to have chr( 141 )+chr( 10 ) stripped
// If memofield was created with Clipper, it needs to have __SoftCR() stripped
// 2006/JUL/20 - E.F. - We should not replace SoftCR with chr(32).
// 2006/JUL/20 - E.F. - We should not replace SoftCR with Chr( 32 ).
// See Text2Array function for more details.
/*
* IF chr( 141 ) $ cString
* acsn := chr( 32 ) + chr( 141 ) + chr( 10 )
* cString := STRTRAN( cString, acsn, " " )
* acsn := chr( 141 ) + chr( 10 )
* cString := STRTRAN( cString, acsn, " " )
* ENDIF
*/
// IF hb_BChar( 141 ) $ cString
// acsn := Chr( 32 ) + Chr( 141 ) + Chr( 10 )
// cString := StrTran( cString, acsn, " " )
// acsn := Chr( 141 ) + Chr( 10 )
// cString := StrTran( cString, acsn, " " )
// ENDIF
// Load text to internal array.
@@ -671,7 +669,7 @@ METHOD MoveCursor( nKey ) CLASS XHBEditor
::End()
EXIT
OTHERWISE
OTHERWISE
RETURN .F.
ENDSWITCH
@@ -987,13 +985,13 @@ METHOD Edit( nPassedKey ) CLASS XHBEditor
ENDIF
EXIT
CASE K_CTRL_BS // block chr( 127 ), a printable character in windows
CASE K_CTRL_BS // block Chr( 127 ), a printable character in windows
::ClrTextSelection()
EXIT
OTHERWISE
OTHERWISE
IF Len( hb_KeyChar( nKey ) ) > 0
IF Len( hb_keyChar( nKey ) ) > 0
IF ::lEditAllow
::ClrTextSelection()
::K_Ascii( nKey )
@@ -1439,10 +1437,10 @@ METHOD K_Ascii( nKey ) CLASS XHBEditor
// insert char if in insert mode or at end of current line
//
IF ::lInsert .OR. ( ::nCol > ::LineLen( ::nRow ) )
::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 0, hb_KeyChar( nKey ) )
::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 0, hb_keyChar( nKey ) )
::lChanged := .T.
ELSE
::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 1, hb_KeyChar( nKey ) )
::aText[ ::nRow ]:cText := Stuff( ::aText[ ::nRow ]:cText, ::nCol, 1, hb_keyChar( nKey ) )
::lChanged := .T.
ENDIF
@@ -1754,7 +1752,7 @@ METHOD K_Esc() CLASS XHBEditor
// 2006/JUL/21 - E.F - Exit only if "Y" is pressed.
//
::lExitEdit := ( Upper( hb_KeyChar( nKey ) ) == "Y" )
::lExitEdit := ( Upper( hb_keyChar( nKey ) ) == "Y" )
ENDIF
IF ::lExitEdit
@@ -1853,7 +1851,7 @@ METHOD DelTextRight( nRow ) CLASS XHBEditor
RETURN Self
//
// Delete a word to the right of cursor. <CTRL-T>
// Delete a word to the right of cursor. <Ctrl+T>
//
METHOD DelWordRight() CLASS XHBEditor
@@ -1887,7 +1885,7 @@ METHOD DelWordRight() CLASS XHBEditor
IF nCutCol <= 1 .AND. nCol < ::LineLen( ::nRow ) - 1
nCol++
ELSEIF nCutCol <= 1 .AND. nCol >= ::LineLen( ::nRow )
nCutCol := Len( SubStr( ::aText[::nRow]:cText, ::nCol, nCol - ::nCol ) )
nCutCol := Len( SubStr( ::aText[ ::nRow ]:cText, ::nCol, nCol - ::nCol ) )
EXIT
ENDIF
ENDDO
@@ -1904,40 +1902,32 @@ METHOD DelWordRight() CLASS XHBEditor
IF ::lWordWrap .AND. ::aText[ ::nRow ]:lSoftCR
::SplitLine( ::nRow )
ELSE
::aText[::nRow]:lSoftCR := .F.
::aText[ ::nRow ]:lSoftCR := .F.
ENDIF
ENDIF
RETURN Self
// <CTRL-B> behaviour.
// <Ctrl+B> behaviour.
METHOD ReformParagraph() CLASS XHBEditor
LOCAL nRow
LOCAL cHardCR := hb_eol()
LOCAL cSoftCR := Chr( 141 ) + Chr( 10 )
IF !::lEditAllow
RETURN Self
ENDIF
IF ::LastRow() > 0
IF ::lEditAllow .AND. ::LastRow() > 0
::lChanged := .T.
FOR nRow := 1 TO ::LastRow()
::aText[ nRow ]:cText := StrTran( ::aText[ nRow ]:cText, cSoftCR )
::aText[ nRow ]:cText := StrTran( ::aText[ nRow ]:cText, __SoftCR() )
::aText[ nRow ]:lSoftCR := .F.
IF At( cHardCR, ::aText[ nRow ]:cText ) != 0
IF At( hb_eol(), ::aText[ nRow ]:cText ) != 0
EXIT
ENDIF
NEXT
ENDIF
RETURN Self
@@ -2029,7 +2019,7 @@ METHOD GotoPos( nRow, nCol, lRefresh ) CLASS XHBEditor
// line, with or without chars.
// Note: ::nWordWrapCol can be different than ::nNumCols if user has
// informed nLineLength > 0
nCol := Max( 1, Min( nCol, Max(::nNumCols,::nWordWrapCol + 1 ) ) )
nCol := Max( 1, Min( nCol, Max( ::nNumCols, ::nWordWrapCol + 1 ) ) )
// I need to move cursor if is past requested line number and if requested line is
@@ -2393,7 +2383,7 @@ METHOD GetText( lSoftCr ) CLASS XHBEditor
IF ::LastRow() > 0
IF lSoftCr
cSoft := Chr( 141 ) + Chr( 10 )
cSoft := __SoftCR()
ENDIF
IF ::lWordWrap
@@ -2429,7 +2419,7 @@ METHOD GetTextSelection( lSoftCr ) CLASS XHBEditor
ENDIF
IF lSoftCr
cSoft := Chr( 141 ) + Chr( 10 )
cSoft := __SoftCR()
ENDIF
IF ::nRowSelStart > 0 .AND. ::nRowSelEnd > 0
@@ -2786,7 +2776,7 @@ METHOD DelTextSelection() CLASS XHBEditor
// nRowSelStart := ::nColSelRow
// ENDIF
cText := ::aText[ ::nRow ]:cText
::aText[::nRow]:cText := Stuff( cText, ::nColSelStart, ::nColSelEnd - ::nColSelStart + 1, "" )
::aText[ ::nRow ]:cText := Stuff( cText, ::nColSelStart, ::nColSelEnd - ::nColSelStart + 1, "" )
::RefreshLine()
::GoToPos( ::nRow, Max( 1, ::nColSelStart ) )
::nColSelStart := ::nColSelEnd := 0
@@ -2976,7 +2966,7 @@ STATIC FUNCTION Text2Array( cString, nWordWrapCol )
LOCAL cSplittedLine
LOCAL nTokPos := 0
LOCAL lTokenized := .F.
LOCAL cSoftCR := Chr( 141 ) + Chr( 10 )
LOCAL cSoftCR := __SoftCR()
// 2005/JUL/19 - E.F. - SoftCR must be removed before convert string to
// array. It will be treated by HBEditor.
@@ -3112,3 +3102,6 @@ METHOD BrowseText( nPassedKey, lHandleOneKey ) CLASS XHBEditor
ENDDO
RETURN NIL
STATIC FUNCTION __SoftCR()
RETURN Chr( 141 ) + Chr( 10 ) /* TOFIX: Won't work in UTF-8 mode */

2
harbour/doc/xhb-diff.txt
View File

@@ -775,7 +775,7 @@ for strings in XHB.LIB for his own preferences removing the RTE.
============================================================================
xHarbour supports negative indexes in [] operator. They are used
to access items from tail, f.e. aVal[ -1 ] is the same as
aVal[ len( aVal ) - 1 ].
aVal[ len( aVal ) ] or ATail( aVal ).
By default Harbour core code does not give such functionality but
it has strong enough OOP API to allow adding such extension without
touching core code even by user at .prg level. It was implemented

7
harbour/src/rtl/teditor.prg
View File

@@ -813,6 +813,13 @@ METHOD Edit( nPassedKey ) CLASS HBEditor
CASE ::MoveCursor( nKey )
// if it's a movement key ::MoveCursor() handles it
CASE K_CTRL_B
/* TODO: Resolve keycode collision with K_CTRL_RIGHT */
/* TODO: Implement reform paragraph */
CASE K_CTRL_T
/* TODO: Implement delete word right */
CASE nKey == K_ALT_W
/* TOFIX: Not clipper compatible */
::lSaved := .T.