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

2007-09-10 03:28 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)

Browse Source 
* source/rtl/color53.prg
     ! Fixed ApplyDefau().
     % Optimized.

   * source/debug/tbrwtext.prg
     ! Minor formatting.

   * source/rtl/memoedit.prg
     ! Variable name cleanup.

   * source/rtl/memoedit.prg
   * source/rtl/symbol.prg
   * source/rtl/color53.prg
   * source/rtl/teditor.prg
   * source/debug/dbgthsh.prg
   * source/debug/dbgtarr.prg
     ! "=" operators changed to ":=" (or "==" as per context)
This commit is contained in:
Viktor Szakats
2007-09-10 01:29:53 +00:00
parent a4af206c41
commit 69d03ea37e
8 changed files with 156 additions and 205 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
harbour/ChangeLog
View File

@@ -8,6 +8,25 @@
2002-12-01 13:30 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2007-09-10 03:28 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* source/rtl/color53.prg
! Fixed ApplyDefau().
% Optimized.
* source/debug/tbrwtext.prg
! Minor formatting.
* source/rtl/memoedit.prg
! Variable name cleanup.
* source/rtl/memoedit.prg
* source/rtl/symbol.prg
* source/rtl/color53.prg
* source/rtl/teditor.prg
* source/debug/dbgthsh.prg
* source/debug/dbgtarr.prg
! "=" operators changed to ":=" (or "==" as per context)
2007-09-10 01:53 UTC+0100 Viktor Szakats (harbour.01 syenar.hu)
* source/rtl/tgetlist.prg
! Fixed two typos in previous commit.

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

@@ -116,7 +116,7 @@ METHOD addWindows( aArray, nRow ) CLASS HBDbArray
oBrwSets:AddColumn( oCol := TBColumnNew( "", { || ::arrayName + "[" + LTrim( Str( oBrwSets:cargo[ 1 ], 6 ) ) + "]" } ) )
oCol:width := Len( ::arrayName + "[" + LTrim( Str( Len( aArray ), 6 ) ) + "]" )
oCol:DefColor := { 1, 2 }
nColWidth = oCol:Width
nColWidth := oCol:Width
oBrwSets:AddColumn( oCol := TBColumnNew( "", { || PadR( __dbgValToStr( aArray[ oBrwSets:cargo[ 1 ] ] ), nWidth - nColWidth - 1 ) } ) )
@@ -182,7 +182,7 @@ METHOD doGet( oBrowse, pItem, nSet ) CLASS HBDbArray
READ
IF LastKey() == K_ENTER
pItem[ nSet ] = &cValue
pItem[ nSet ] := &cValue
ENDIF
SetCursor( SC_NONE )

2
harbour/source/debug/dbgthsh.prg
View File

@@ -122,7 +122,7 @@ METHOD addWindows( hHash, nRow ) CLASS HBDbHash
hb_HEval( hHash, {| k, v, p | HB_SYMBOL_UNUSED( k ), HB_SYMBOL_UNUSED( v ), nKeyLen := Max( nKeyLen, Len( ::hashName + "[" + HashKeyString( hHash, p ) + "]" ) ) } )
oCol:width := nKeyLen
oCol:DefColor := { 1, 2 }
nColWidth = oCol:Width
nColWidth := oCol:Width
oBrwSets:AddColumn( oCol := TBColumnNew( "" ,{ || PadR( __dbgValToStr( hb_HValueAt( hHash, oBrwSets:cargo[ 1 ] ) ), nWidth - nColWidth - 1 ) } ) )

2
harbour/source/debug/tbrwtext.prg
View File

@@ -96,7 +96,7 @@ CREATE CLASS HBBrwText FROM HBEditor
ENDCLASS
METHOD New( nTop, nLeft, nBottom, nRight, cFileName, cColor, lLineNumbers) CLASS HBBrwText
METHOD New( nTop, nLeft, nBottom, nRight, cFileName, cColor, lLineNumbers ) CLASS HBBrwText
DEFAULT cColor TO SetColor()
DEFAULT lLineNumbers TO .T.

304
harbour/source/rtl/color53.prg
View File

@@ -52,230 +52,162 @@
#include "common.ch"
Function GETCLRPAIR( cColor, nColor )
Local nPos
FUNCTION GetClrPair( cColor, nColor )
LOCAL nPos
if ( nPos := getpairpos( cColor, nColor ) ) == 0
Return ""
endif
IF ( nPos := GetPairPos( cColor, nColor ) ) == 0
RETURN ""
ENDIF
Return SubStr( cColor, nPos, getpairlen( cColor, nColor ) )
RETURN SubStr( cColor, nPos, GetPairLen( cColor, nColor ) )
****************************************************************
Function SETCLRPAIR( cColor, nColor, cNewColor )
Local nPos
FUNCTION SetClrPair( cColor, nColor, cNewColor )
LOCAL nPos
if ( nPos := getpairpos( cColor, nColor ) ) == 0
Return ""
endif
IF ( nPos := GetPairPos( cColor, nColor ) ) == 0
RETURN ""
ENDIF
Return stuff( cColor, nPos, getpairlen( cColor, nColor ), cNewColor )
RETURN Stuff( cColor, nPos, GetPairLen( cColor, nColor ), cNewColor )
****************************************************************
Function GETPAIRPOS( cColor, nColor )
Local n, nPos := 1, nSep
FUNCTION GetPairPos( cColor, nColor )
LOCAL nPos := 1
LOCAL nSep
LOCAL n
For n := 2 To nColor
nSep := At( ",", SubStr( cColor, nPos) )
if nSep == 0
nPos := 0
Exit
endif
FOR n := 2 TO nColor
IF ( nSep := At( ",", SubStr( cColor, nPos ) ) ) == 0
RETURN 0
ENDIF
nPos += nSep
Next
NEXT
Return nPos
RETURN nPos
****************************************************************
Function GETPAIRLEN( cColor, nColor )
Local nPos := getpairpos( cColor, nColor ), nLen
FUNCTION GetPairLen( cColor, nColor )
LOCAL nPos := GetPairPos( cColor, nColor )
LOCAL nLen
if nPos == 0
Return 0
endif
IF nPos == 0
RETURN 0
ENDIF
nLen := At( ",", SubStr( cColor, nPos ) )
RETURN iif( nLen == 0, Len( cColor ) - nPos + 1, nLen - 1 )
if nLen == 0
nLen := Len( cColor ) - nPos + 1
Else
nLen--
endif
FUNCTION GetClrFore( cColor )
LOCAL nPos
Return nLen
IF ( nPos := At( "/", cColor ) ) == 0
RETURN ""
ENDIF
****************************************************************
Function GETCLRFORE( cColor )
Local nPos
RETURN SubStr( cColor, 1, nPos - 1 )
if ( nPos := At( "/", cColor ) ) == 0
Return ""
endif
FUNCTION GetClrBack( cColor )
LOCAL nPos
Return SubStr( cColor, 1, nPos - 1 )
IF ( nPos := At( "/", cColor ) ) == 0
RETURN ""
ENDIF
****************************************************************
Function GETCLRBACK( cColor )
Local nPos
RETURN SubStr( cColor, nPos + 1 )
if ( nPos := At( "/", cColor ) ) == 0
Return ""
endif
FUNCTION RADGRDefCo( cColor )
RETURN iif( IsDefColor(),;
ApplyDefau( cColor, "W/N", "W/N", "W+/N" ),;
ApplyDefau( cColor, 3, 1, 4 ) )
Return SubStr( cColor, nPos + 1 )
FUNCTION RADITDefCo( cColor )
RETURN iif( IsDefColor(),;
ApplyDefau( cColor, "W/N", "W+/N", "W+/N", "N/W", "W/N", "W/N", "W+/N" ),;
ApplyDefau( cColor, 5, 5, 2, 2, 1, 1, 4 ) )
****************************************************************
Function RADGRDEFCO( cColor )
FUNCTION LISTBDefCo( cColor )
RETURN iif( IsDefColor(),;
ApplyDefau( cColor, "W/N", "W+/N", "W+/N", "N/W", "W/N", "W/N", "W+/N" ),;
ApplyDefau( cColor, 5, 5, 5, 2, 3, 1, 4 ) )
if isdefcolor()
Return applydefau( cColor, "W/N", "W/N", "W+/N")
Else
Return applydefau( cColor, 3, 1, 4)
endif
FUNCTION COMBODefCo( cColor )
RETURN iif( IsDefColor(),;
ApplyDefau( cColor, "W/N", "W+/N", "W+/N", "N/W", "W/N", "W/N", "W+/N", "W/N" ),;
ApplyDefau( cColor, 5, 5, 5, 2, 3, 1, 4, 1 ) )
Return nil
FUNCTION CHECKDefCo( cColor )
RETURN iif( IsDefColor(),;
ApplyDefau( cColor, "W/N", "W+/N", "W/N", "W+/N" ),;
ApplyDefau( cColor, 5, 2, 1, 4 ) )
****************************************************************
Function RADITDEFCO( cColor )
FUNCTION BUTTNDefCo( cColor )
RETURN iif( IsDefColor(),;
ApplyDefau( cColor, "W/N", "N/W", "W+/N", "W+/N" ),;
ApplyDefau( cColor, 5, 2, 1, 4 ) )
if isdefcolor()
Return applydefau( cColor, "W/N", "W+/N", "W+/N", "N/W", "W/N", "W/N", "W+/N")
Else
Return applydefau( cColor, 5, 5, 2, 2, 1, 1, 4)
endif
FUNCTION MENUDefCol( cColor )
RETURN iif( IsDefColor(),;
ApplyDefau( cColor, "N/W", "W/N", "W+/W", "W+/N", "N+/W", "W/N" ),;
ApplyDefau( cColor, 5, 2, 4, 2, 1, 3 ) )
Return nil
FUNCTION ApplyDefau( cColor, xClr1, xClr2, xClr3, xClr4, xClr5, xClr6, xClr7, xClr8 )
****************************************************************
Function LISTBDEFCO( cColor )
LOCAL cSetColor
LOCAL aSetColor
LOCAL aNewcolor
LOCAL nColors
LOCAL cClrDefa
LOCAL cClrToSet
LOCAL cClrFore
LOCAL cClrBack
LOCAL xNewColor
LOCAL n
if isdefcolor()
Return applydefau( cColor, "W/N", "W+/N", "W+/N", "N/W", "W/N", "W/N", "W+/N")
Else
Return applydefau( cColor, 5, 5, 5, 2, 3, 1, 4)
endif
IF PCount() == 0
RETURN ""
ELSEIF PCount() == 1
RETURN cColor
ENDIF
Return nil
cSetColor := SetColor()
****************************************************************
Function COMBODEFCO( cColor )
aSetColor := {;
GetClrPair( cSetColor, 1 ) ,;
GetClrPair( cSetColor, 2 ) ,;
GetClrPair( cSetColor, 3 ) ,;
GetClrPair( cSetColor, 4 ) ,;
GetClrPair( cSetColor, 5 ) }
if isdefcolor()
Return applydefau( cColor, "W/N", "W+/N", "W+/N", "N/W", "W/N", "W/N", "W+/N", "W/N")
Else
Return applydefau( cColor, 5, 5, 5, 2, 3, 1, 4, 1)
endif
Return nil
****************************************************************
Function CHECKDEFCO( cColor )
if isdefcolor()
Return applydefau( cColor, "W/N", "W+/N", "W/N", "W+/N")
Else
Return applydefau( cColor, 5, 2, 1, 4)
endif
Return nil
****************************************************************
Function BUTTNDEFCO( cColor )
if isdefcolor()
Return applydefau( cColor, "W/N", "N/W", "W+/N", "W+/N")
Else
Return applydefau( cColor, 5, 2, 1, 4)
endif
Return nil
****************************************************************
Function MENUDEFCOL( cColor )
if isdefcolor()
Return applydefau( cColor, "N/W", "W/N", "W+/W", "W+/N", "N+/W", "W/N")
Else
Return applydefau( cColor, 5, 2, 4, 2, 1, 3)
endif
Return nil
****************************************************************
Function APPLYDEFAU( cColor, xClr1, xClr2, xClr3, xClr4, xClr5, xClr6, xClr7, xClr8 )
Local cSetColor, aSetColor := {}, aNewcolor := {}, nColors, cClrDefa
Local cClrToSet, cClrFore, cClrBack
Local cNewClrFore, cNewClrBack, xNewColor, n
if PCount() == 0
Return ""
endif
if PCount() == 1
Return cColor
endif
cSetColor := setcolor()
asize( aSetColor, 5)
aSetColor[1] := getclrpair( cSetColor, 1 )
aSetColor[2] := getclrpair( cSetColor, 2 )
aSetColor[3] := getclrpair( cSetColor, 3 )
aSetColor[4] := getclrpair( cSetColor, 4 )
aSetColor[5] := getclrpair( cSetColor, 5 )
asize( aNewColor, 8)
aNewColor[1] := xClr1
aNewColor[2] := xClr2
aNewColor[3] := xClr3
aNewColor[4] := xClr4
aNewColor[5] := xClr5
aNewColor[6] := xClr6
aNewColor[7] := xClr7
aNewColor[8] := xClr8
aNewColor := {;
xClr1 ,;
xClr2 ,;
xClr3 ,;
xClr4 ,;
xClr5 ,;
xClr6 ,;
xClr7 ,;
xClr8 }
nColors := PCount() - 1
cClrDefa := cColor
for n = 1 to Len( aNewColor )
xNewColor = aNewColor[ n ]
FOR n := 1 TO nColors
cClrToSet := getclrpair( cClrDefa, n )
xNewColor := aNewColor[ n ]
cClrToSet := GetClrPair( cClrDefa, n )
if At( "/", cClrToSet ) == 0
IF "/" $ cClrToSet
if ISNUMBER( xNewColor )
cClrDefa := setclrpair( cClrDefa, n, aSetColor[ xNewColor ] )
Else
cClrDefa := setclrpair( cClrDefa, n, xNewColor )
endif
IF ( cClrFore := GetClrFore( cClrToSet ) ) == ""
cClrFore := GetClrFore( iif( ISNUMBER( xNewColor ), aSetColor[ xNewColor ], xNewColor ) )
ENDIF
IF ( cClrBack := GetClrBack( cClrToSet ) ) == ""
cClrBack := GetClrBack( iif( ISNUMBER( xNewColor ), aSetColor[ xNewColor ], xNewColor ) )
ENDIF
else
cClrFore := getclrfore( cClrToSet )
cClrBack := getclrback( cClrToSet )
if ISNUMBER( xNewColor )
cNewClrFore := getclrfore( aSetColor[ xNewColor ] )
cNewClrBack := getclrback( aSetColor[ xNewColor ] )
else
cNewClrFore := getclrfore( xNewColor )
cNewClrBack := getclrback( xNewColor )
endif
if cClrFore == ""
cClrFore := cNewClrFore
endif
if cClrBack == ""
cClrBack := cNewClrBack
endif
cClrToSet := cClrFore + "/" + cClrBack
cClrDefa := setclrpair( cClrDefa, n, cClrToSet )
endif
Next
Return cClrDefa
cClrDefa := SetClrPair( cClrDefa, n, cClrFore + "/" + cClrBack )
ELSE
cClrDefa := SetClrPair( cClrDefa, n, iif( ISNUMBER( xNewColor ), aSetColor[ xNewColor ], xNewColor ) )
ENDIF
NEXT
RETURN cClrDefa

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

@@ -61,7 +61,7 @@ CREATE CLASS HBMemoEditor FROM HBEditor
VAR xUserFunction // User Function called to change default MemoEdit() behaviour
METHOD MemoInit( cUserFunction ) // This method is called after ::New() returns to perform ME_INIT actions
METHOD MemoInit( xUserFunction ) // This method is called after ::New() returns to perform ME_INIT actions
METHOD Edit() // Calls super:Edit(nKey) but is needed to handle configurable keys
METHOD KeyboardHook( nKey ) // Gets called every time there is a key not handled directly by HBEditor
METHOD IdleHook() // Gets called every time there are no more keys to hanlde
@@ -73,12 +73,12 @@ CREATE CLASS HBMemoEditor FROM HBEditor
ENDCLASS
METHOD MemoInit( cUserFunction ) CLASS HBMemoEditor
METHOD MemoInit( xUserFunction ) CLASS HBMemoEditor
LOCAL nKey
// Save/Init object internal representation of user function
::xUserFunction := cUserFunction
::xUserFunction := xUserFunction
if ISCHARACTER( ::xUserFunction )
// Keep calling user function until it returns 0
@@ -149,13 +149,13 @@ METHOD KeyboardHook( nKey ) CLASS HBMemoEditor
if nKey == K_ESC
cBackScr = SaveScreen( ::nTop, ::nRight - 18, ::nTop, ::nRight )
cBackScr := SaveScreen( ::nTop, ::nRight - 18, ::nTop, ::nRight )
nRow = Row()
nCol = Col()
nRow := Row()
nCol := Col()
@ ::nTop, ::nRight - 18 SAY "Abort Edit? (Y/N)"
nYesNoKey = Inkey( 0 )
nYesNoKey := Inkey( 0 )
RestScreen( ::nTop, ::nRight - 18, ::nTop, ::nRight, cBackScr )
SetPos( nRow, nCol )
@@ -241,7 +241,7 @@ METHOD xDo( nStatus ) CLASS HBMemoEditor
METHOD MoveCursor( nKey ) CLASS HBMemoEditor
if nKey == K_CTRL_END // same value as CTRL-W
::lSaved = .t.
::lSaved := .t.
::lExitEdit := .T.
else
RETURN ::Super:MoveCursor( nKey )
@@ -255,7 +255,7 @@ FUNCTION MemoEdit( cString,;
nTop, nLeft,;
nBottom, nRight,;
lEditMode,;
cUserFunction,;
xUserFunction,;
nLineLength,;
nTabSize,;
nTextBuffRow,;
@@ -280,15 +280,15 @@ FUNCTION MemoEdit( cString,;
// Original MemoEdit() converts Tabs into spaces;
oEd := HBMemoEditor():New( StrTran( cString, Chr( K_TAB ), Space( 1 ) ), nTop, nLeft, nBottom, nRight, lEditMode, nLineLength, nTabSize )
oEd:MemoInit( cUserFunction )
oEd:MemoInit( xUserFunction )
oEd:RefreshWindow()
if ! ISLOGICAL( cUserFunction ) .OR. cUserFunction == .T.
if ! ISLOGICAL( xUserFunction ) .OR. xUserFunction == .T.
oEd:Edit()
if oEd:Saved()
cString := oEd:GetText()
// dbu tests for LastKey() == K_CTRL_END, so I try to make it happy
KEYBOARD Chr(K_CTRL_END)
KEYBOARD Chr( K_CTRL_END )
Inkey()
endif
endif

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

@@ -68,7 +68,7 @@ CLASS Symbol
ENDCLASS
METHOD New( cSymName ) CLASS Symbol
::nSym = __DynSN2Sym( cSymName )
::nSym := __DynSN2Sym( cSymName )
return Self
METHOD Name() CLASS Symbol

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

@@ -463,7 +463,7 @@ METHOD RefreshWindow() CLASS HBEditor
// Clear rest of editor window (needed when deleting lines of text)
if ::naTextLen < ::nNumRows
cOldColor = SetColor( ::cColorSpec )
cOldColor := SetColor( ::cColorSpec )
Scroll( ::nTop + ::naTextLen, ::nLeft, ::nBottom, ::nRight )
SetColor( cOldColor )
endif
@@ -1048,7 +1048,7 @@ STATIC PROCEDURE BrowseText( oSelf, nPassedKey )
nKey := InKey( 0 )
else
nKey = nPassedKey
nKey := nPassedKey
endif
if ( bKeyBlock := Setkey( nKey ) ) != NIL