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

20000403-13:07 GMT+1 Victor Szakats <info@szelvesz.hu>

Browse Source
This commit is contained in:
Viktor Szakats
2000-04-03 11:09:20 +00:00
parent f8505455b2
commit 1be74da400
16 changed files with 632 additions and 450 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
harbour/ChangeLog
View File

@@ -1,3 +1,38 @@
20000403-13:07 GMT+1 Victor Szakats <info@szelvesz.hu>
* source/rtl/tgetlist.prg
! READKILL(), READUPDATED(), __KILLREAD(), READFORMAT() fixed.
% GetDoSetKey() optimized
; ----------------------------------------------------------
; Ad: Now DBU compiles and runs without *any* modification !
; ----------------------------------------------------------
(except for the Dbu() -> Main() renaming for some compilers)
+ source/tools/cttoken.prg
* source/tools/Makefile
* makefile.bc
* makefile.vc
* utils/hbrun/exttools.prg
+ CT_NUMTOKEN()
+ CT_TOKEN()
; CA-Tools compatible functions added. Thanks to Phil Barnett.
* source/rtl/tgetlist.prg
* source/rtl/tbrowse.prg
* source/rtl/browse.prg
* source/rtl/tbcolumn.prg
* source/rtl/tclass.prg
* source/rtl/typefile.prg
* source/debug/dbgtmenu.prg
* source/debug/dbgtwin.prg
* source/debug/debugger.prg
* include/hbclass.ch
! Assignment/equality operator (=) changed to assignment only operator (:=)
and equality only (==) operator.
Please don't use "=" operator, use "==" and ":=" instead.
! ValToStr() made MEMO aware.
! Some constants changed to manifest constants (again and again).
20000403-11:01 GMT+1 Victor Szakats <info@szelvesz.hu>
* source/vm/itemapi.c

2
harbour/include/hbclass.ch
View File

@@ -51,7 +51,7 @@
function <ClassName>() ;;
static oClass ;;
if oClass == nil ;;
oClass = TClass():New( <(ClassName)> [,<(SuperClass)>] ) ;;
oClass := TClass():New( <(ClassName)> [,<(SuperClass)>] ) ;;
#undef _CLASS_NAME_ ;;
#define _CLASS_NAME_ <ClassName> ;;
#translate CLSMETH <ClassName> <MethodName>() => @<ClassName>_<MethodName>() ;

8
harbour/makefile.bc
View File

@@ -319,6 +319,7 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\strright.obj \
\
$(OBJ_DIR)\ctmisc.obj \
$(OBJ_DIR)\cttoken.obj \
$(OBJ_DIR)\fileread.obj \
$(OBJ_DIR)\nconvert.obj \
$(OBJ_DIR)\numtxten.obj \
@@ -1611,6 +1612,13 @@ $(OBJ_DIR)\ctmisc.obj : $(OBJ_DIR)\ctmisc.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) -+$@,,
$(OBJ_DIR)\cttoken.c : $(TOOLS_DIR)\cttoken.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
$(OBJ_DIR)\cttoken.obj : $(OBJ_DIR)\cttoken.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(TOOLS_LIB) -+$@,,
$(OBJ_DIR)\fileread.c : $(TOOLS_DIR)\fileread.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@

1
harbour/makefile.vc
View File

@@ -365,6 +365,7 @@ TOOLS_LIB_OBJS = \
$(OBJ_DIR)\strright.obj \
\
$(OBJ_DIR)\ctmisc.obj \
$(OBJ_DIR)\cttoken.obj \
$(OBJ_DIR)\fileread.obj \
$(OBJ_DIR)\nconvert.obj \
$(OBJ_DIR)\numtxten.obj \

100
harbour/source/debug/dbgtmenu.prg
View File

@@ -82,22 +82,22 @@ METHOD New() CLASS TDbMenu
local nCol := 0
if ::aMenus == nil
::aMenus = {}
::lPopup = .f.
::aMenus := {}
::lPopup := .f.
else
::lPopup = .t.
::lPopup := .t.
endif
::nTop = 0
::nLeft = 0
::nBottom = 0
::nRight = 0
::aItems = {}
::cClrHilite = "W+/N"
::cClrHotFocus = "GR+/N"
::cClrHotKey = "GR+/BG"
::cClrPopup = "N/BG"
::nOpenPopup = 0
::nTop := 0
::nLeft := 0
::nBottom := 0
::nRight := 0
::aItems := {}
::cClrHilite := "W+/N"
::cClrHotFocus := "GR+/N"
::cClrHotKey := "GR+/BG"
::cClrPopup := "N/BG"
::nOpenPopup := 0
AAdd( ::aMenus, Self )
@@ -108,16 +108,16 @@ METHOD AddItem( oMenuItem ) CLASS TDbMenu
local oLastMenu := ATail( ::aMenus ), oLastMenuItem
if oLastMenu:lPopup
oMenuItem:nRow = Len( oLastMenu:aItems )
oMenuItem:nCol = oLastMenu:nLeft + 1
oMenuItem:nRow := Len( oLastMenu:aItems )
oMenuItem:nCol := oLastMenu:nLeft + 1
else
oMenuItem:nRow = 0
oMenuItem:nRow := 0
if Len( oLastMenu:aItems ) > 0
oLastMenuItem = ATail( oLastMenu:aItems )
oMenuItem:nCol = oLastMenuItem:nCol + ;
oLastMenuItem := ATail( oLastMenu:aItems )
oMenuItem:nCol := oLastMenuItem:nCol + ;
Len( StrTran( oLastMenuItem:cPrompt, "~", "" ) )
else
oMenuItem:nCol = 0
oMenuItem:nCol := 0
endif
endif
@@ -130,30 +130,30 @@ METHOD Build() CLASS TDbMenu
local n, nPos := 0, oMenuItem
if Len( ::aMenus ) == 1 // pulldown menu
for n = 1 to Len( ::aItems )
::aItems[ n ]:nRow = 0
::aItems[ n ]:nCol = nPos
for n := 1 to Len( ::aItems )
::aItems[ n ]:nRow := 0
::aItems[ n ]:nCol := nPos
nPos += Len( StrTran( ::aItems[ n ]:cPrompt, "~", "" ) )
next
else
oMenuItem = ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems )
::nTop = oMenuItem:nRow + 1
::nLeft = oMenuItem:nCol
nPos = ::nLeft
for n = 1 to Len( ::aItems )
::aItems[ n ]:nRow = ::nTop + n
::aItems[ n ]:nCol = ::nLeft + 1
nPos = Max( nPos, ::nLeft + Len( StrTran( ::aItems[ n ]:cPrompt, "~", "" ) ) + 1 )
oMenuItem := ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems )
::nTop := oMenuItem:nRow + 1
::nLeft := oMenuItem:nCol
nPos := ::nLeft
for n := 1 to Len( ::aItems )
::aItems[ n ]:nRow := ::nTop + n
::aItems[ n ]:nCol := ::nLeft + 1
nPos := Max( nPos, ::nLeft + Len( StrTran( ::aItems[ n ]:cPrompt, "~", "" ) ) + 1 )
next
::nRight = nPos
::nBottom = ::nTop + Len( ::aItems ) + 1
for n = 1 to Len( ::aItems )
::nRight := nPos
::nBottom := ::nTop + Len( ::aItems ) + 1
for n := 1 to Len( ::aItems )
if ::aItems[ n ]:cPrompt != "-"
::aItems[ n ]:cPrompt = PadR( ::aItems[ n ]:cPrompt, ::nRight - ::nLeft )
::aItems[ n ]:cPrompt := PadR( ::aItems[ n ]:cPrompt, ::nRight - ::nLeft )
endif
next
ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ):bAction = ATail( ::aMenus )
::aMenus = ASize( ::aMenus, Len( ::aMenus ) - 1 )
ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ):bAction := ATail( ::aMenus )
::aMenus := ASize( ::aMenus, Len( ::aMenus ) - 1 )
endif
return nil
@@ -163,11 +163,11 @@ METHOD ClosePopup( nPopup ) CLASS TDbMenu
local oPopup
if nPopup != 0
oPopup = ::aItems[ nPopup ]:bAction
oPopup := ::aItems[ nPopup ]:bAction
if oPopup:ClassName() == "TDBMENU"
RestScreen( oPopup:nTop, oPopup:nLeft, oPopup:nBottom + 1, oPopup:nRight + 2,;
oPopup:cBackImage )
oPopup:cBackImage = nil
oPopup:cBackImage := nil
endif
::aItems[ nPopup ]:Display( ::cClrPopup, ::cClrHotKey )
endif
@@ -192,12 +192,12 @@ METHOD Display() CLASS TDbMenu
DispOutAt( 0, 0, Space( MaxCol() + 1 ), ::cClrPopup )
SetPos( 0, 0 )
else
::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 2 )
::cBackImage := SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 2 )
@ ::nTop, ::nLeft, ::nBottom, ::nRight BOX B_SINGLE
hb_Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight )
endif
for n = 1 to Len( ::aItems )
for n := 1 to Len( ::aItems )
if ::aItems[ n ]:cPrompt == "-" // Separator
DispOutAt( ::aItems[ n ]:nRow, ::nLeft,;
Chr( 195 ) + Replicate( Chr( 196 ), ::nRight - ::nLeft - 1 ) + Chr( 180 ) )
@@ -212,8 +212,8 @@ METHOD EvalAction() CLASS TDbMenu
local oPopup, oMenuItem
oPopup = ::aItems[ ::nOpenPopup ]:bAction
oMenuItem = oPopup:aItems[ oPopup:nOpenPopup ]
oPopup := ::aItems[ ::nOpenPopup ]:bAction
oMenuItem := oPopup:aItems[ oPopup:nOpenPopup ]
if oMenuItem:bAction != nil
::Close()
@@ -226,7 +226,7 @@ METHOD GetHotKeyPos( cKey ) CLASS TDbMenu
local n
for n = 1 to Len( ::aItems )
for n := 1 to Len( ::aItems )
if Upper( SubStr( ::aItems[ n ]:cPrompt,;
At( "~", ::aItems[ n ]:cPrompt ) + 1, 1 ) ) == cKey
return n
@@ -239,7 +239,7 @@ METHOD GetItemOrdByCoors( nRow, nCol ) CLASS TDbMenu
local n
for n = 1 to Len( ::aItems )
for n := 1 to Len( ::aItems )
if ::aItems[ n ]:nRow == nRow .and. nCol >= ::aItems[ n ]:nCol .and. ;
nCol <= ::aItems[ n ]:nCol + Len( ::aItems[ n ]:cPrompt ) - 2
return n
@@ -253,7 +253,7 @@ METHOD GoBottom() CLASS TDbMenu
local oPopup
if ::IsOpen()
oPopup = ::aItems[ ::nOpenPopup ]:bAction
oPopup := ::aItems[ ::nOpenPopup ]:bAction
oPopup:DeHilite()
oPopup:ShowPopup( Len( oPopup:aItems ) )
endif
@@ -313,7 +313,7 @@ METHOD GoTop() CLASS TDbMenu
local oPopup
if ::IsOpen()
oPopup = ::aItems[ ::nOpenPopup ]:bAction
oPopup := ::aItems[ ::nOpenPopup ]:bAction
oPopup:DeHilite()
oPopup:ShowPopup( 1 )
endif
@@ -323,7 +323,7 @@ return nil
METHOD ShowPopup( nPopup ) CLASS TDbMenu
::aItems[ nPopup ]:Display( ::cClrHilite, ::cClrHotFocus )
::nOpenPopup = nPopup
::nOpenPopup := nPopup
if ValType( ::aItems[ nPopup ]:bAction ) == "O"
::aItems[ nPopup ]:bAction:Display()
@@ -395,8 +395,8 @@ ENDCLASS
METHOD New( cPrompt, bAction ) CLASS TDbMenuItem
::cPrompt = cPrompt
::bAction = bAction
::cPrompt := cPrompt
::bAction := bAction
return Self
@@ -425,7 +425,7 @@ function AltToKey_debugger( nKey )
if nIndex > 0
cKey := SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ", nIndex, 1 )
else
cKey = ""
cKey := ""
endif
return cKey

28
harbour/source/debug/dbgtwin.prg
View File

@@ -70,13 +70,13 @@ ENDCLASS
METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) CLASS TDbWindow
::nTop = nTop
::nLeft = nLeft
::nBottom = nBottom
::nRight = nRight
::cCaption = cCaption
::cColor = cColor
::lShadow = .f.
::nTop := nTop
::nLeft := nLeft
::nBottom := nBottom
::nRight := nRight
::cCaption := cCaption
::cColor := cColor
::lShadow := .f.
return Self
@@ -84,7 +84,7 @@ METHOD Hide() CLASS TDbWindow
RestScreen( ::nTop, ::nLeft, ::nBottom + If( ::lShadow, 1, 0 ),;
::nRight + If( ::lShadow, 2, 0 ), ::cBackImage )
::cBackImage = nil
::cBackImage := nil
return nil
@@ -106,7 +106,7 @@ METHOD SetCaption( cCaption ) CLASS TDbWindow
local nOldLen := If( ::cCaption != nil, Len( ::cCaption ), 0 )
::cCaption = cCaption
::cCaption := cCaption
if ! Empty( cCaption )
DispOutAt( ::nTop, ::nLeft + ( ( ::nRight - ::nLeft ) / 2 ) - ;
@@ -124,7 +124,7 @@ METHOD SetFocus( lOnOff ) CLASS TDbWindow
DispBegin()
::lFocused = lOnOff
::lFocused := lOnOff
@ ::nTop, ::nLeft, ::nBottom, ::nRight BOX If( lOnOff, B_DOUBLE, B_SINGLE ) ;
COLOR ::cColor
@@ -151,7 +151,7 @@ METHOD Show( lFocused ) CLASS TDbWindow
DEFAULT lFocused TO .f.
::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom + If( ::lShadow, 1, 0 ),;
::cBackImage := SaveScreen( ::nTop, ::nLeft, ::nBottom + If( ::lShadow, 1, 0 ),;
::nRight + If( ::lShadow, 2, 0 ) )
SetColor( ::cColor )
Scroll( ::nTop, ::nLeft, ::nBottom, ::nRight )
@@ -168,11 +168,11 @@ METHOD ShowModal() CLASS TDbWindow
local lExit := .f.
local nKey
::lShadow = .t.
::lShadow := .t.
::Show()
while ! lExit
nKey = InKey( 0 )
nKey := InKey( 0 )
if ::bKeyPressed != nil
Eval( ::bKeyPressed, nKey )
@@ -180,7 +180,7 @@ METHOD ShowModal() CLASS TDbWindow
do case
case nKey == K_ESC
lExit = .t.
lExit := .t.
endcase
end

242
harbour/source/debug/debugger.prg
View File

@@ -56,15 +56,15 @@ function AltD( nAction )
do case
case nAction == nil
if s_lEnabled
s_lExit = .f.
s_lExit := .f.
__dbgEntry( ProcLine( 2 ) )
endif
case nAction == ALTD_DISABLE
s_lEnabled = .f.
s_lEnabled := .f.
case nAction == ALTD_ENABLE
s_lEnabled = .t.
s_lEnabled := .t.
endcase
return nil
@@ -75,7 +75,7 @@ function __dbgEntry( uParam1, uParam2 ) // debugger entry point
case ValType( uParam1 ) == "C" // called from hvm.c hb_vmModuleName()
if ! s_lExit
if s_oDebugger == nil
s_oDebugger = TDebugger():New()
s_oDebugger := TDebugger():New()
s_oDebugger:Activate( uParam1 )
else
s_oDebugger:ShowCode( uParam1 )
@@ -92,7 +92,7 @@ function __dbgEntry( uParam1, uParam2 ) // debugger entry point
return nil
endif
if s_oDebugger:lGo
s_oDebugger:lGo = ! s_oDebugger:IsBreakPoint( uParam1 )
s_oDebugger:lGo := ! s_oDebugger:IsBreakPoint( uParam1 )
endif
if s_oDebugger:lGo
DispBegin()
@@ -162,22 +162,22 @@ ENDCLASS
METHOD New() CLASS TDebugger
::aWindows = {}
::nCurrentWindow = 1
::cClrDialog = "N/W"
::oPullDown = BuildMenu( Self )
::aWindows := {}
::nCurrentWindow := 1
::cClrDialog := "N/W"
::oPullDown := BuildMenu( Self )
::oWndCode = TDbWindow():New( 1, 0, MaxRow() - 6, MaxCol(),, "BG+/B" )
::oWndCode:bKeyPressed = { | nKey | ::CodeWindowProcessKey( nKey ) }
::oWndCode := TDbWindow():New( 1, 0, MaxRow() - 6, MaxCol(),, "BG+/B" )
::oWndCode:bKeyPressed := { | nKey | ::CodeWindowProcessKey( nKey ) }
AAdd( ::aWindows, ::oWndCode )
::BuildCommandWindow()
::lEnd = .f.
::aBreakPoints = {}
::aCallStack = {}
::lGo = .f.
::aVars = {}
::lEnd := .f.
::aBreakPoints := {}
::aCallStack := {}
::lGo := .f.
::aVars := {}
return Self
@@ -196,24 +196,24 @@ METHOD BuildCommandWindow() CLASS TDebugger
local GetList := {}
local cCommand
::oWndCommand = TDbWindow():New( MaxRow() - 5, 0, MaxRow() - 1, MaxCol(),;
::oWndCommand := TDbWindow():New( MaxRow() - 5, 0, MaxRow() - 1, MaxCol(),;
"Command", "BG+/B" )
::oWndCommand:bGotFocus = { || ::oGetListCommand:SetFocus(), SetCursor( SC_NORMAL ) }
::oWndCommand:bLostFocus = { || SetCursor( SC_NONE ) }
::oWndCommand:bKeyPressed = { | nKey | ::CommandWindowProcessKey( nKey ) }
::oWndCommand:bPainted = { || DispOutAt( ::oWndCommand:nBottom - 1,;
::oWndCommand:bGotFocus := { || ::oGetListCommand:SetFocus(), SetCursor( SC_NORMAL ) }
::oWndCommand:bLostFocus := { || SetCursor( SC_NONE ) }
::oWndCommand:bKeyPressed := { | nKey | ::CommandWindowProcessKey( nKey ) }
::oWndCommand:bPainted := { || DispOutAt( ::oWndCommand:nBottom - 1,;
::oWndCommand:nLeft + 1, "> ", ::oWndCommand:cColor ) }
AAdd( ::aWindows, ::oWndCommand )
::aLastCommands = {}
::nCommand = 0
::aLastCommands := {}
::nCommand := 0
cCommand = Space( ::oWndCommand:nRight - ::oWndCommand:nLeft - 3 )
cCommand := Space( ::oWndCommand:nRight - ::oWndCommand:nLeft - 3 )
// We don't use the GET command here to avoid the painting of the GET
AAdd( GetList, TGet():New( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 3,;
{ | u | If( PCount() > 0, cCommand := u, cCommand ) }, "cCommand" ) )
ATail( GetList ):ColorSpec = Replicate( ::oWndCommand:cColor + ",", 5 )
::oGetListCommand = TGetList():New( GetList )
ATail( GetList ):ColorSpec := Replicate( ::oWndCommand:cColor + ",", 5 )
::oGetListCommand := TGetList():New( GetList )
return nil
@@ -255,8 +255,8 @@ METHOD CommandWindowProcessKey( nKey ) CLASS TDebugger
case nKey == K_UP
if ::nCommand > 0
::oGetListCommand:oGet:VarPut( ::aLastCommands[ ::nCommand ] )
::oGetListCommand:oGet:Buffer = ::aLastCommands[ ::nCommand ]
::oGetListCommand:oGet:Pos = 1
::oGetListCommand:oGet:Buffer := ::aLastCommands[ ::nCommand ]
::oGetListCommand:oGet:Pos := 1
::oGetListCommand:oGet:Display()
if ::nCommand > 1
::nCommand--
@@ -266,8 +266,8 @@ METHOD CommandWindowProcessKey( nKey ) CLASS TDebugger
case nKey == K_DOWN
if ::nCommand <= Len( ::aLastCommands )
::oGetListCommand:oGet:VarPut( ::aLastCommands[ ::nCommand ] )
::oGetListCommand:oGet:Buffer = ::aLastCommands[ ::nCommand ]
::oGetListCommand:oGet:Pos = 1
::oGetListCommand:oGet:Buffer := ::aLastCommands[ ::nCommand ]
::oGetListCommand:oGet:Pos := 1
::oGetListCommand:oGet:Display()
if ::nCommand < Len( ::aLastCommands )
::nCommand++
@@ -275,14 +275,14 @@ METHOD CommandWindowProcessKey( nKey ) CLASS TDebugger
endif
case nKey == K_ENTER
cCommand = ::oGetListCommand:oGet:VarGet()
cCommand := ::oGetListCommand:oGet:VarGet()
AAdd( ::aLastCommands, cCommand )
::nCommand++
::oWndCommand:ScrollUp( 1 )
if SubStr( LTrim( cCommand ), 1, 2 ) == "? "
cResult = ValToStr( &( AllTrim( SubStr( LTrim( cCommand ), 3 ) ) ) )
cResult := ValToStr( &( AllTrim( SubStr( LTrim( cCommand ), 3 ) ) ) )
else
cResult = "Command error"
cResult := "Command error"
endif
DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1,;
Space( ::oWndCommand:nRight - ::oWndCommand:nLeft - 1 ),;
@@ -292,10 +292,10 @@ METHOD CommandWindowProcessKey( nKey ) CLASS TDebugger
::oWndCommand:ScrollUp( 1 )
DispOutAt( ::oWndCommand:nBottom - 1, ::oWndCommand:nLeft + 1, "> ",;
::oWndCommand:cColor )
cCommand = Space( ::oWndCommand:nRight - ::oWndCommand:nLeft - 3 )
cCommand := Space( ::oWndCommand:nRight - ::oWndCommand:nLeft - 3 )
::oGetListCommand:oGet:VarPut( cCommand )
::oGetListCommand:oGet:Buffer = cCommand
::oGetListCommand:oGet:Pos = 1
::oGetListCommand:oGet:Buffer := cCommand
::oGetListCommand:oGet:Pos := 1
::oGetListCommand:oGet:Display()
otherwise
@@ -319,8 +319,8 @@ METHOD EditVar( nVar ) CLASS TDebugger
// It is an object, don't do anything
otherwise
::aVars[ nVar ][ 2 ] = &uVarValue
&( ::aVars[ nVar ][ 1 ] ) = ::aVars[ nVar ][ 2 ]
::aVars[ nVar ][ 2 ] := &uVarValue
&( ::aVars[ nVar ][ 1 ] ) := ::aVars[ nVar ][ 2 ]
endcase
::oBrwVars:RefreshCurrent()
@@ -345,11 +345,11 @@ METHOD HandleEvent() CLASS TDebugger
local nPopup, oWnd
local nKey, nMRow, nMCol, n
::lEnd = .f.
::lEnd := .f.
while ! ::lEnd
nKey = InKey( 0, INKEY_ALL )
nKey := InKey( 0, INKEY_ALL )
do case
case ::oPullDown:IsOpen()
@@ -371,15 +371,15 @@ METHOD HandleEvent() CLASS TDebugger
elseif MRow() == MaxRow()
else
nMRow = MRow()
nMCol = MCol()
for n = 1 to Len( ::aWindows )
nMRow := MRow()
nMCol := MCol()
for n := 1 to Len( ::aWindows )
if ::aWindows[ n ]:IsOver( nMRow, nMCol ) .and. ;
! ::aWindows[ n ]:lFocused
::aWindows[ ::nCurrentWindow ]:SetFocus( .f. )
::nCurrentWindow = n
::nCurrentWindow := n
::aWindows[ n ]:SetFocus( .t. )
n = Len( ::aWindows ) + 1
n := Len( ::aWindows ) + 1
endif
next
endif
@@ -395,7 +395,7 @@ METHOD HandleEvent() CLASS TDebugger
case nKey == K_UP .or. nKey == K_DOWN .or. nKey == K_HOME .or. ;
nKey == K_END .or. nKey == K_ENTER
oWnd = ::aWindows[ ::nCurrentWindow ]
oWnd := ::aWindows[ ::nCurrentWindow ]
oWnd:KeyPressed( nKey )
case nKey == K_F4
@@ -435,7 +435,7 @@ return nil
METHOD Hide() CLASS TDebugger
RestScreen( ,,,, ::cAppImage )
::cAppImage = nil
::cAppImage := nil
SetColor( ::cAppColors )
SetCursor( ::nAppCursor )
@@ -446,12 +446,12 @@ METHOD NextWindow() CLASS TDebugger
local oWnd
if Len( ::aWindows ) > 0
oWnd = ::aWindows[ ::nCurrentWindow++ ]
oWnd := ::aWindows[ ::nCurrentWindow++ ]
oWnd:SetFocus( .f. )
if ::nCurrentWindow > Len( ::aWindows )
::nCurrentWindow = 1
::nCurrentWindow := 1
endif
oWnd = ::aWindows[ ::nCurrentWindow ]
oWnd := ::aWindows[ ::nCurrentWindow ]
oWnd:SetFocus( .t. )
endif
@@ -462,12 +462,12 @@ METHOD PrevWindow() CLASS TDebugger
local oWnd
if Len( ::aWindows ) > 0
oWnd = ::aWindows[ ::nCurrentWindow-- ]
oWnd := ::aWindows[ ::nCurrentWindow-- ]
oWnd:SetFocus( .f. )
if ::nCurrentWindow < 1
::nCurrentWindow = Len( ::aWindows )
::nCurrentWindow := Len( ::aWindows )
endif
oWnd = ::aWindows[ ::nCurrentWindow ]
oWnd := ::aWindows[ ::nCurrentWindow ]
oWnd:SetFocus( .t. )
endif
@@ -475,11 +475,11 @@ return nil
METHOD Show() CLASS TDebugger
::cAppImage = SaveScreen()
::nAppRow = Row()
::nAppCol = Col()
::cAppColors = SetColor()
::nAppCursor = SetCursor( SC_NONE )
::cAppImage := SaveScreen()
::nAppRow := Row()
::nAppCol := Col()
::cAppColors := SetColor()
::nAppCursor := SetCursor( SC_NONE )
::oPullDown:Display()
::oWndCode:Show( .t. )
@@ -505,7 +505,7 @@ return nil
METHOD ShowAppScreen() CLASS TDebugger
::cImage = SaveScreen()
::cImage := SaveScreen()
RestScreen( 0, 0, MaxRow(), MaxCol(), ::cAppImage )
InKey( 0 )
RestScreen( 0, 0, MaxRow(), MaxCol(), ::cImage )
@@ -521,15 +521,15 @@ METHOD ShowCallStack() CLASS TDebugger
::oBrwText:nRight -= 16
::oBrwText:aColumns[ 1 ]:Width -= 16
::oWndCode:SetFocus( .t. )
::oWndStack = TDbWindow():New( 1, MaxCol() - 15, MaxRow() - 6, MaxCol(),;
::oWndStack := TDbWindow():New( 1, MaxCol() - 15, MaxRow() - 6, MaxCol(),;
"Stack", "BG+/B" )
::oWndStack:Show( .f. )
AAdd( ::aWindows, ::oWndStack )
::oBrwStack = TBrowseNew( 2, MaxCol() - 14, MaxRow() - 7, MaxCol() - 1 )
::oBrwStack:ColorSpec = "BG+/B, N/BG"
::oBrwStack:GoTopBlock = { || n := 1 }
::oBrwStack:GoBottomBlock = { || n := Len( ::aCallStack ) }
::oBrwStack:SkipBlock = { | nSkip, nPos | nPos := n,;
::oBrwStack := TBrowseNew( 2, MaxCol() - 14, MaxRow() - 7, MaxCol() - 1 )
::oBrwStack:ColorSpec := "BG+/B, N/BG"
::oBrwStack:GoTopBlock := { || n := 1 }
::oBrwStack:GoBottomBlock := { || n := Len( ::aCallStack ) }
::oBrwStack:SkipBlock := { | nSkip, nPos | nPos := n,;
n := If( nSkip > 0, Min( Len( ::aCallStack ), n + nSkip ),;
Max( 1, n + nSkip ) ), n - nPos }
@@ -543,16 +543,16 @@ METHOD LoadVars() CLASS TDebugger // updates monitored variables
local nCount, n, xValue, cName
::aVars = {}
::aVars := {}
nCount = __mvDbgInfo( HB_MV_PUBLIC )
for n = nCount to 1 step -1
xValue = __mvDbgInfo( HB_MV_PUBLIC, n, @cName )
nCount := __mvDbgInfo( HB_MV_PUBLIC )
for n := nCount to 1 step -1
xValue := __mvDbgInfo( HB_MV_PUBLIC, n, @cName )
AAdd( ::aVars, { cName, xValue, "Public" } )
next
nCount = __mvDbgInfo( HB_MV_PRIVATE )
for n = nCount to 1 step -1
xValue = __mvDbgInfo( HB_MV_PRIVATE, n, @cName )
nCount := __mvDbgInfo( HB_MV_PRIVATE )
for n := nCount to 1 step -1
xValue := __mvDbgInfo( HB_MV_PRIVATE, n, @cName )
AAdd( ::aVars, { cName, xValue, "Private" } )
next
@@ -571,26 +571,26 @@ METHOD ShowVars() CLASS TDebugger
::oBrwText:nTop += 5
::oBrwText:RefreshAll()
::oWndCode:SetFocus( .t. )
::oWndVars = TDbWindow():New( 1, 0, 5,;
::oWndVars := TDbWindow():New( 1, 0, 5,;
MaxCol() - If( ::oWndStack != nil, ::oWndStack:nWidth(), 0 ),;
"Monitor", "BG+/B" )
::oWndVars:Show( .f. )
AAdd( ::aWindows, ::oWndVars )
::oWndVars:bKeyPressed = { | nKey | If( nKey == K_DOWN, ( ::oBrwVars:Down(),;
::oWndVars:bKeyPressed := { | nKey | If( nKey == K_DOWN, ( ::oBrwVars:Down(),;
::oBrwVars:ForceStable() ), nil ), If( nKey == K_UP, ( ::oBrwVars:Up(),;
::oBrwVars:ForceStable() ), nil ), If( nKey == K_ENTER, ::EditVar( n ), nil ) }
::oBrwVars = TBrowseNew( 2, 1, 4, MaxCol() - If( ::oWndStack != nil,;
::oBrwVars := TBrowseNew( 2, 1, 4, MaxCol() - If( ::oWndStack != nil,;
::oWndStack:nWidth(), 0 ) - 1 )
::oBrwVars:ColorSpec = "BG+/B, N/BG"
::oBrwVars:ColorSpec := "BG+/B, N/BG"
::LoadVars()
::oBrwVars:GoTopBlock = { || n := 1 }
::oBrwVars:GoBottomBlock = { || n := Len( ::aVars ) }
::oBrwVars:SkipBlock = { | nSkip, nPos | nPos := n,;
::oBrwVars:GoTopBlock := { || n := 1 }
::oBrwVars:GoBottomBlock := { || n := Len( ::aVars ) }
::oBrwVars:SkipBlock := { | nSkip, nPos | nPos := n,;
n := If( nSkip > 0, Min( Len( ::aVars ), n + nSkip ),;
Max( 1, n + nSkip ) ), n - nPos }
nWidth = ::oWndVars:nWidth() - 1
nWidth := ::oWndVars:nWidth() - 1
::oBrwVars:AddColumn( TBColumnNew( "", { || AllTrim( Str( n ) ) + ") " + ;
PadR( GetVarInfo( ::aVars[ n ] ), ::oWndVars:nWidth() - 5 ) } ) )
::oBrwVars:ForceStable()
@@ -625,9 +625,9 @@ METHOD ShowCode( cModuleName ) CLASS TDebugger
ASize( ::aCallStack, Len( ::aCallStack ) + 1 )
AIns( ::aCallStack, 1 )
if Len( ::aCallStack ) == 1
::aCallStack[ 1 ] = ProcName( 3 ) // cFunction
::aCallStack[ 1 ] := ProcName( 3 ) // cFunction
else
::aCallStack[ 1 ] = ProcName( 2 ) // cFunction
::aCallStack[ 1 ] := ProcName( 2 ) // cFunction
endif
if ::oWndStack != nil
@@ -636,10 +636,10 @@ METHOD ShowCode( cModuleName ) CLASS TDebugger
if cPrgName != ::cPrgName
::cPrgName := cPrgName
::oBrwText = TBrwText():New( ::oWndCode:nTop + 1, ::oWndCode:nLeft + 1,;
::oBrwText := TBrwText():New( ::oWndCode:nTop + 1, ::oWndCode:nLeft + 1,;
::oWndCode:nBottom - 1, ::oWndCode:nRight - 1, ::cPrgName, "BG+/B, N/BG, W+/R, W+/BG" )
::oBrwText:aColumns[ 1 ]:ColorBlock = { || If( AScan( ::aBreakPoints,;
::oBrwText:aColumns[ 1 ]:ColorBlock := { || If( AScan( ::aBreakPoints,;
CompareLine( Self ) ) != 0, { 3, 4 }, { 1, 2 } ) }
::oBrwText:ForceStable()
@@ -667,7 +667,7 @@ METHOD InputBox( cMsg, uValue, bValid ) CLASS TDebugger
local oWndInput := TDbWindow():New( nTop, nLeft, nBottom, nRight, cMsg,;
::oPullDown:cClrPopup )
oWndInput:lShadow = .t.
oWndInput:lShadow := .t.
oWndInput:Show()
if bValid == nil
@@ -676,7 +676,7 @@ METHOD InputBox( cMsg, uValue, bValid ) CLASS TDebugger
@ nTop + 1, nLeft + 1 GET uTemp VALID bValid
endif
nOldCursor = SetCursor( SC_NORMAL )
nOldCursor := SetCursor( SC_NORMAL )
READ
SetCursor( nOldCursor )
oWndInput:Hide()
@@ -706,7 +706,7 @@ return nil
METHOD RestoreAppStatus() CLASS TDebugger
::cImage = SaveScreen()
::cImage := SaveScreen()
DispBegin()
RestScreen( 0, 0, MaxRow(), MaxCol(), ::cAppImage )
SetPos( ::nAppRow, ::nAppCol )
@@ -717,11 +717,11 @@ return nil
METHOD SaveAppStatus() CLASS TDebugger
::cAppImage = SaveScreen()
::nAppRow = Row()
::nAppCol = Col()
::cAppColors = SetColor()
::nAppCursor = SetCursor()
::cAppImage := SaveScreen()
::nAppRow := Row()
::nAppCol := Col()
::cAppColors := SetColor()
::nAppCursor := SetCursor()
RestScreen( 0, 0, MaxRow(), MaxCol(), ::cImage )
SetCursor( SC_NONE )
DispEnd()
@@ -765,23 +765,23 @@ METHOD ViewSets() CLASS TDebugger
local nWidth := oWndSets:nRight - oWndSets:nLeft - 1
local oCol
oBrwSets:ColorSpec = "N/W, W+/W, N/BG"
oBrwSets:GoTopBlock = { || n := 1 }
oBrwSets:GoBottomBlock = { || n := Len( aSets ) }
oBrwSets:SkipBlock = { | nSkip, nPos | nPos := n,;
oBrwSets:ColorSpec := "N/W, W+/W, N/BG"
oBrwSets:GoTopBlock := { || n := 1 }
oBrwSets:GoBottomBlock := { || n := Len( aSets ) }
oBrwSets:SkipBlock := { | nSkip, nPos | nPos := n,;
n := If( nSkip > 0, Min( Len( aSets ), n + nSkip ),;
Max( 1, n + nSkip ) ), n - nPos }
oBrwSets:AddColumn( TBColumnNew( "", { || PadR( aSets[ n ], 12 ) } ) )
oBrwSets:AddColumn( oCol := TBColumnNew( "",;
{ || PadR( ValToStr( Set( n ) ), nWidth - 13 ) } ) )
oBrwSets:Cargo = 1 // Actual highligthed row
oCol:ColorBlock = { || { If( n == oBrwSets:Cargo, 3, 1 ), 3 } }
oBrwSets:Cargo := 1 // Actual highligthed row
oCol:ColorBlock := { || { If( n == oBrwSets:Cargo, 3, 1 ), 3 } }
oWndSets:bPainted = { || oBrwSets:ForceStable() }
oWndSets:bKeyPressed = { | nKey | SetsKeyPressed( nKey, oBrwSets, Len( aSets ),;
oWndSets:bPainted := { || oBrwSets:ForceStable() }
oWndSets:bKeyPressed := { | nKey | SetsKeyPressed( nKey, oBrwSets, Len( aSets ),;
oWndSets ) }
SetCursor( 0 )
SetCursor( SC_NONE )
oWndSets:ShowModal()
return nil
@@ -805,7 +805,7 @@ static function SetsKeyPressed( nKey, oBrwSets, nSets, oWnd )
case nKey == K_HOME
if oBrwSets:Cargo > 1
oBrwSets:Cargo = 1
oBrwSets:Cargo := 1
oBrwSets:GoTop()
oBrwSets:RefreshAll()
oBrwSets:ForceStable()
@@ -813,7 +813,7 @@ static function SetsKeyPressed( nKey, oBrwSets, nSets, oWnd )
case nKey == K_END
if oBrwSets:Cargo < nSets
oBrwSets:Cargo = nSets
oBrwSets:Cargo := nSets
oBrwSets:GoBottom()
oBrwSets:RefreshAll()
oBrwSets:ForceStable()
@@ -832,18 +832,18 @@ static function SetsUp( oBrw )
local nRow := oBrw:RowPos
local nSetPos
if oBrw:RowPos = 1
nSetPos = oBrw:Cargo
oBrw:Cargo = 0
if oBrw:RowPos == 1
nSetPos := oBrw:Cargo
oBrw:Cargo := 0
oBrw:RefreshCurrent()
oBrw:ForceStable()
oBrw:Cargo = nSetPos
oBrw:Cargo := nSetPos
endif
oBrw:Up()
oBrw:RefreshCurrent()
if nRow != oBrw:Cargo
oBrw:aReDraw[ nRow ] = .f.
oBrw:aReDraw[ nRow ] := .f.
endif
oBrw:ForceStable()
@@ -854,18 +854,18 @@ static function SetsDown( oBrw )
local nRow := oBrw:RowPos
local nSetPos
if oBrw:RowPos = oBrw:RowCount
nSetPos = oBrw:Cargo
oBrw:Cargo = 0
if oBrw:RowPos == oBrw:RowCount
nSetPos := oBrw:Cargo
oBrw:Cargo := 0
oBrw:RefreshCurrent()
oBrw:ForceStable()
oBrw:Cargo = nSetPos
oBrw:Cargo := nSetPos
endif
oBrw:Down()
oBrw:RefreshCurrent()
if nRow != oBrw:Cargo
oBrw:aReDraw[ nRow ] = .f.
oBrw:aReDraw[ nRow ] := .f.
endif
oBrw:ForceStable()
@@ -878,25 +878,25 @@ static function ValToStr( uVal )
do case
case uVal == nil
cResult = "NIL"
cResult := "NIL"
case cType == "A"
cResult = "{ ... }"
cResult := "{ ... }"
case cType == "C"
cResult = '"' + uVal + '"'
case cType $ "CM"
cResult := '"' + uVal + '"'
case cType == "L"
cResult = If( uVal, ".T.", ".F." )
cResult := If( uVal, ".T.", ".F." )
case cType == "D"
cResult = DToC( uVal )
cResult := DToC( uVal )
case cType == "N"
cResult = AllTrim( Str( uVal ) )
cResult := AllTrim( Str( uVal ) )
case cType == "O"
cResult = "Class " + uVal:ClassName() + " object"
cResult := "Class " + uVal:ClassName() + " object"
endcase
return cResult

12
harbour/source/rtl/browse.prg
View File

@@ -56,18 +56,18 @@ function Browse( nTop, nLeft, nBottom, nRight )
nRight := MaxCol()
endif
nOldCursor = SetCursor( 0 )
cOldScreen = SaveScreen( nTop, nLeft, nBottom, nRight )
nOldCursor := SetCursor( 0 )
cOldScreen := SaveScreen( nTop, nLeft, nBottom, nRight )
@ nTop, nLeft TO nBottom, nRight
@ nTop + 3, nLeft SAY Chr( 198 )
@ nTop + 3, nRight SAY Chr( 181 )
@ nTop + 1, nLeft + 1 SAY Space( nRight - nLeft - 1 )
oBrw = TBrowseDB( nTop + 2, nLeft + 1, nBottom - 1, nRight - 1 )
oBrw:HeadSep = " " + Chr( 205 )
oBrw := TBrowseDB( nTop + 2, nLeft + 1, nBottom - 1, nRight - 1 )
oBrw:HeadSep := " " + Chr( 205 )
for n = 1 to FCount()
for n := 1 to FCount()
oBrw:AddColumn( TBColumnNew( FieldName( n ), FieldBlock( FieldName( n ) ) ) )
next
@@ -97,7 +97,7 @@ function Browse( nTop, nLeft, nBottom, nRight )
do case
case nKey == K_ESC
lExit = .t.
lExit := .t.
case nKey == K_UP
oBrw:Up()

6
harbour/source/rtl/tbcolumn.prg
View File

@@ -56,9 +56,9 @@ ENDCLASS
METHOD New() CLASS TBColumn
::DefColor = { 1, 2 }
::FootSep = ""
::ColPos = 1
::DefColor := { 1, 2 }
::FootSep := ""
::ColPos := 1
return Self

188
harbour/source/rtl/tbrowse.prg
View File

@@ -146,28 +146,28 @@ ENDCLASS
METHOD New() CLASS TBrowse
::aColumns = {}
::nTop = 0
::nLeft = 0
::nBottom = MaxRow()
::nRight = MaxCol()
::AutoLite = .t.
::leftVisible = 1
::ColPos = 1
::Freeze = 0
::HitBottom = .f.
::HitTop = .f.
::ColorSpec = SetColor()
::ColSep = " "
::FootSep = ""
::HeadSep = ""
::RowPos = 1
::stable = .f.
::RelativePos = 1
::aRedraw = nil
::lHeaders = .f.
::aRect = nil
::aRectColor = nil
::aColumns := {}
::nTop := 0
::nLeft := 0
::nBottom := MaxRow()
::nRight := MaxCol()
::AutoLite := .t.
::leftVisible := 1
::ColPos := 1
::Freeze := 0
::HitBottom := .f.
::HitTop := .f.
::ColorSpec := SetColor()
::ColSep := " "
::FootSep := ""
::HeadSep := ""
::RowPos := 1
::stable := .f.
::RelativePos := 1
::aRedraw := nil
::lHeaders := .f.
::aRect := nil
::aRectColor := nil
return Self
@@ -185,7 +185,7 @@ METHOD Down() CLASS TBrowse
local n
::HitTop = .F.
::HitTop := .F.
if !::HitBottom
::DeHilite()
if Eval( ::SkipBlock, 1 ) != 0
@@ -194,13 +194,13 @@ METHOD Down() CLASS TBrowse
::Hilite()
::RelativePos++
else
n = ::nTop + If( ::lHeaders, 1, 0 ) + If( Empty( ::HeadSep ), 0, 1 )
n := ::nTop + If( ::lHeaders, 1, 0 ) + If( Empty( ::HeadSep ), 0, 1 )
Scroll( n, ::nLeft, n + ::RowCount - 1, ::nRight, 1 )
::RefreshCurrent()
endif
else
::Hilite()
::HitBottom = .t.
::HitBottom := .t.
endif
endif
@@ -209,7 +209,7 @@ return Self
METHOD End() CLASS TBrowse
if ::ColPos < ::rightVisible
::ColPos = ::rightVisible
::ColPos := ::rightVisible
::RefreshCurrent()
endif
@@ -217,24 +217,24 @@ return Self
METHOD GoBottom() CLASS TBrowse
::HitTop = .F.
::HitBottom = .F.
::HitTop := .F.
::HitBottom := .F.
if Eval( ::goBottomBlock ) != 0
::RefreshAll()
::RowPos = ::RowCount
::RelativePos = ::RowCount
::RowPos := ::RowCount
::RelativePos := ::RowCount
endif
return Self
METHOD GoTop() CLASS TBrowse
::HitTop = .F.
::HitBottom = .F.
::HitTop := .F.
::HitBottom := .F.
if Eval( ::goTopBlock ) != 0
::RefreshAll()
::RowPos = 1
::RelativePos = 1
::RowPos := 1
::RelativePos := 1
endif
return Self
@@ -242,7 +242,7 @@ return Self
METHOD Home() CLASS TBrowse
if ::ColPos != ::leftVisible
::ColPos = ::leftVisible
::ColPos := ::leftVisible
::RefreshCurrent()
endif
@@ -253,14 +253,14 @@ METHOD Invalidate() CLASS TBrowse
local n
local lFooters := .f.
for n = 1 to Len( ::aColumns )
for n := 1 to Len( ::aColumns )
if ! Empty( ::aColumns[ n ]:Footing )
lFooters = .t.
lFooters := .t.
exit
endif
next
::RowCount = ::nBottom - ::nTop + 1 - If( ::lHeaders, 1, 0 ) - ;
::RowCount := ::nBottom - ::nTop + 1 - If( ::lHeaders, 1, 0 ) - ;
If( lFooters, 1, 0 ) - If( Empty( ::HeadSep ), 0, 1 ) - ;
If( Empty( ::FootSep ), 0, 1 )
@@ -282,11 +282,11 @@ METHOD Left() CLASS TBrowse
if ::ColPos > 1 .and. ::leftVisible - ::Freeze > 1
while leftVis == ::leftVisible
::rightVisible--
::leftVisible = ::LeftDetermine()
::leftVisible := ::LeftDetermine()
::RefreshAll()
end
if --::ColPos < ::leftVisible
::ColPos = ::rightVisible
::ColPos := ::rightVisible
endif
endif
endif
@@ -329,18 +329,18 @@ METHOD PageDown() CLASS TBrowse
local nDown
::HitTop = .F.
::HitTop := .F.
if !::HitBottom
if ( nDown := Eval( ::SkipBlock, ::RowCount ) ) != 0
if nDown < ::RowCount
::RefreshAll()
::RowPos = ::RowCount
::RelativePos = ::RowCount
::RowPos := ::RowCount
::RelativePos := ::RowCount
else
::RefreshAll()
endif
else
::HitBottom = .t.
::HitBottom := .t.
endif
endif
@@ -350,18 +350,18 @@ METHOD PageUp() CLASS TBrowse
local nUp
::HitBottom = .F.
::HitBottom := .F.
if !::HitTop
if ( nUp := Abs( Eval( ::SkipBlock, - ::RowCount ) ) ) != 0
if nUp < ::RowCount
::RefreshAll()
::RowPos = 1
::RelativePos = 1
::RowPos := 1
::RelativePos := 1
else
::RefreshAll()
endif
else
::HitTop = .t.
::HitTop := .t.
endif
endif
@@ -371,12 +371,12 @@ METHOD PanEnd() CLASS TBrowse
if ::ColPos < Len( ::aColumns )
if ::rightVisible < Len( ::aColumns )
::rightVisible = Len( ::aColumns )
::leftVisible = ::LeftDetermine()
::ColPos = ::rightVisible
::rightVisible := Len( ::aColumns )
::leftVisible := ::LeftDetermine()
::ColPos := ::rightVisible
::RefreshAll()
else
::ColPos = ::rightVisible
::ColPos := ::rightVisible
::RefreshCurrent()
endif
endif
@@ -387,11 +387,11 @@ METHOD PanHome() CLASS TBrowse
if ::ColPos > 1
if ::leftVisible > ::Freeze + 1
::leftVisible = ::Freeze + 1
::ColPos = 1
::leftVisible := ::Freeze + 1
::ColPos := 1
::RefreshAll()
else
::ColPos = 1
::ColPos := 1
::RefreshCurrent()
endif
endif
@@ -404,8 +404,8 @@ METHOD PanLeft() CLASS TBrowse
if ::leftVisible > ::Freeze + 1
::rightVisible--
::leftVisible = ::LeftDetermine()
::ColPos = Min( ::leftVisible + n, ::rightVisible )
::leftVisible := ::LeftDetermine()
::ColPos := Min( ::leftVisible + n, ::rightVisible )
::RefreshAll()
endif
@@ -417,8 +417,8 @@ METHOD PanRight() CLASS TBrowse
if ::rightVisible < Len( ::aColumns )
::rightVisible++
::leftVisible = ::LeftDetermine()
::ColPos = Min( ::leftVisible + n, ::rightVisible )
::leftVisible := ::LeftDetermine()
::ColPos := Min( ::leftVisible + n, ::rightVisible )
::RefreshAll()
endif
@@ -433,7 +433,7 @@ METHOD Right() CLASS TBrowse
else
if ::ColPos < Len( ::aColumns )
::rightVisible++
::leftVisible = ::LeftDetermine()
::leftVisible := ::LeftDetermine()
::ColPos++
::RefreshAll()
endif
@@ -499,16 +499,16 @@ METHOD Stabilize() CLASS TBrowse
if ::aRedraw == Nil .or. !::aRedraw[ 1 ]
// Are there any column header to paint ?
for n = 1 to Len( ::aColumns )
for n := 1 to Len( ::aColumns )
if ! Empty( ::aColumns[ n ]:Heading )
::lHeaders = .t.
::lHeaders := .t.
exit
endif
next
// Are there any column footer to paint ?
for n = 1 to Len( ::aColumns )
for n := 1 to Len( ::aColumns )
if ! Empty( ::aColumns[ n ]:Footing )
lFooters = .t.
lFooters := .t.
exit
endif
next
@@ -543,7 +543,7 @@ METHOD Stabilize() CLASS TBrowse
endif
endif
nColsVisible = ::leftVisible - 1
nColsVisible := ::leftVisible - 1
while nColsVisible < Len( ::aColumns )
@@ -563,28 +563,28 @@ METHOD Stabilize() CLASS TBrowse
nColsVisible++
enddo
::rightVisible = nColsVisible
::rightVisible := nColsVisible
if ::aRedraw == nil
::RowCount = ::nBottom - ::nTop + 1 - If( ::lHeaders, 1, 0 ) - ;
::RowCount := ::nBottom - ::nTop + 1 - If( ::lHeaders, 1, 0 ) - ;
If( lFooters, 1, 0 ) - If( Empty( ::HeadSep ), 0, 1 ) - If( Empty( ::FootSep ), 0, 1 )
::aRedraw = Array( ::RowCount )
::aRedraw := Array( ::RowCount )
AFill( ::aRedraw, .F. )
endif
else
oCol = ::aColumns[ If( ::rightVisible != 0, ::rightVisible, 1 ) ]
oCol2 = ::aColumns[ If( ::Freeze > 0, 1, ::leftVisible ) ]
nColsWidth = If( oCol != nil, oCol:ColPos, 0 ) + ;
oCol := ::aColumns[ If( ::rightVisible != 0, ::rightVisible, 1 ) ]
oCol2 := ::aColumns[ If( ::Freeze > 0, 1, ::leftVisible ) ]
nColsWidth := If( oCol != nil, oCol:ColPos, 0 ) + ;
If( oCol != nil, oCol:Width, 0 ) - oCol2:ColPos
lFooters = ( ::RowCount != ::nBottom - ::nTop + 1 - If( ::lHeaders, 1, 0 ) - ;
lFooters := ( ::RowCount != ::nBottom - ::nTop + 1 - If( ::lHeaders, 1, 0 ) - ;
- If( Empty( ::HeadSep ), 0, 1 ) - If( Empty( ::FootSep ), 0, 1 ) )
endif
if !::aRedraw[ 1 ]
if ::lHeaders // Drawing headers
DispOutAt( ::nTop, ::nLeft, Space( ( nWidth - nColsWidth ) / 2 ), ::ColorSpec )
for n = If( ::Freeze>0, 1, ::leftVisible ) to ::rightVisible
for n := If( ::Freeze>0, 1, ::leftVisible ) to ::rightVisible
if ::Freeze > 0 .and. n == ::Freeze + 1
n = ::leftVisible
n := ::leftVisible
endif
DispOut( PadR( ::aColumns[ n ]:Heading, ::aColumns[ n ]:Width ), ::ColorSpec )
if n < ::rightVisible
@@ -597,15 +597,15 @@ METHOD Stabilize() CLASS TBrowse
if ! Empty( ::HeadSep ) //Drawing heading separator
DispOutAt( ::nTop + If( ::lHeaders, 1, 0 ), ::nLeft, Replicate( Right( ::HeadSep, 1 ), ( nWidth - nColsWidth ) / 2 ), ::ColorSpec )
if Len( ::HeadSep ) > 1
iW = 0
for n = If( ::Freeze > 0, 1, ::leftVisible ) to ::rightVisible
iW := 0
for n := If( ::Freeze > 0, 1, ::leftVisible ) to ::rightVisible
if ::Freeze > 0 .and. n == ::Freeze + 1
n = ::leftVisible
n := ::leftVisible
endif
DispOut( Replicate( Right( ::HeadSep, 1 ), ::aColumns[ n ]:Width - iW ), ::ColorSpec )
if n < ::rightVisible
DispOut( Left( ::HeadSep, Len( ::HeadSep ) - 1 ), ::ColorSpec )
iW = Len( ::HeadSep ) - 1 - If( ::aColumns[ n + 1 ]:ColSep != Nil, ;
iW := Len( ::HeadSep ) - 1 - If( ::aColumns[ n + 1 ]:ColSep != Nil, ;
Len( ::aColumns[ n + 1 ]:ColSep ), Len( ::ColSep ) )
endif
next
@@ -617,15 +617,15 @@ METHOD Stabilize() CLASS TBrowse
if ! Empty( ::FootSep ) // Drawing footing separator
DispOutAt( ::nBottom - If( lFooters, 1, 0 ), ::nLeft, Replicate( Right( ::FootSep, 1 ), ( nWidth - nColsWidth ) / 2 ), ::ColorSpec )
if Len( ::FootSep ) > 1
iW = 0
for n = If( ::Freeze > 0, 1, ::leftVisible ) to ::rightVisible
iW := 0
for n := If( ::Freeze > 0, 1, ::leftVisible ) to ::rightVisible
if ::Freeze > 0 .and. n == ::Freeze + 1
n = ::leftVisible
n := ::leftVisible
endif
DispOut( Replicate( Right( ::FootSep, 1 ), ::aColumns[ n ]:Width - iW ), ::ColorSpec )
if n < ::rightVisible
DispOut( Left( ::FootSep, Len( ::FootSep ) - 1 ), ::ColorSpec )
iW = Len( ::FootSep ) - 1 - If( ::aColumns[ n + 1 ]:ColSep != Nil, ;
iW := Len( ::FootSep ) - 1 - If( ::aColumns[ n + 1 ]:ColSep != Nil, ;
Len( ::aColumns[ n + 1 ]:ColSep ), Len( ::ColSep ) )
endif
next
@@ -636,9 +636,9 @@ METHOD Stabilize() CLASS TBrowse
endif
if lFooters // Drawing footers
DispOutAt( ::nBottom, ::nLeft, Space( ( nWidth - nColsWidth ) / 2 ), ::ColorSpec )
for n = If( ::Freeze > 0, 1, ::leftVisible ) to ::rightVisible
for n := If( ::Freeze > 0, 1, ::leftVisible ) to ::rightVisible
if ::Freeze > 0 .and. n == ::Freeze + 1
n = ::leftVisible
n := ::leftVisible
endif
DispOut( PadR( ::aColumns[ n ]:Footing, ::aColumns[ n ]:Width ), ::ColorSpec )
if n < ::rightVisible
@@ -652,7 +652,7 @@ METHOD Stabilize() CLASS TBrowse
for nRow := 1 to ::RowCount // Looking for row to redraw
if !::aRedraw[ nRow ]
::aRedraw[ nRow ] = .T.
::aRedraw[ nRow ] := .T.
exit
endif
next
@@ -660,35 +660,35 @@ METHOD Stabilize() CLASS TBrowse
if nRow > ::RowCount // if all rows are draw, hilite current
if !::stable
Eval( ::SkipBlock, ::RowPos - ::RelativePos )
::RelativePos = ::RowPos
::HitBottom = .F.
::RelativePos := ::RowPos
::HitBottom := .F.
::HiLite()
endif
::stable = .t.
::stable := .t.
return .t.
else // redraw a row
if !::HitBottom
if nRow != ::RelativePos
if lDisplay := ( Eval( ::SkipBlock, nRow - ::RelativePos ) != 0 )
::RelativePos = nRow
::RelativePos := nRow
else
::HitBottom = .T.
::HitBottom := .T.
endif
endif
else
lDisplay = .F.
lDisplay := .F.
endif
DispOutAt( ::nTop + nRow + If( ::lHeaders, 0, -1 ) + If( Empty( ::HeadSep ), 0, 1 ), ::nLeft,;
Space( ( nWidth - nColsWidth ) / 2 ), ::ColorSpec )
for n = If( ::Freeze > 0, 1, ::leftVisible ) to ::rightVisible
for n := If( ::Freeze > 0, 1, ::leftVisible ) to ::rightVisible
if ::Freeze > 0 .and. n == ::Freeze + 1
n = ::leftVisible
n := ::leftVisible
endif
if nRow == 1
::aColumns[ n ]:ColPos = Col()
::aColumns[ n ]:ColPos := Col()
endif
nCol := Col()

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

@@ -265,7 +265,7 @@ STATIC FUNCTION SetOnError( nFuncPtr )
LOCAL Self := QSelf()
::nOnError = nFuncPtr
::nOnError := nFuncPtr
RETURN NIL
@@ -278,9 +278,9 @@ STATIC FUNCTION SetType( cType )
::cType := cType
if cType != nil .and. Upper( cType ) == "LOGICAL" .and. ::uInit == nil
::uInit = .f.
::uInit := .f.
else
::uInit = nil
::uInit := nil
endif
RETURN NIL

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

@@ -55,17 +55,17 @@ function ReadModal( GetList, nPos )
return .f.
endif
oGetList = TGetList():New( GetList )
oGetList:cReadProcName = ProcName( 1 )
oGetList:nReadProcLine = ProcLine( 1 )
s_oGetListActive = oGetList
oGetList := TGetList():New( GetList )
oGetList:cReadProcName := ProcName( 1 )
oGetList:nReadProcLine := ProcLine( 1 )
s_oGetListActive := oGetList
if ! ( ISNUMBER( nPos ) .and. nPos > 0 )
oGetList:nPos = oGetList:Settle( 0 )
oGetList:nPos := oGetList:Settle( 0 )
endif
while oGetList:nPos != 0
oGetList:oGet = oGetList:aGetList[ oGetList:nPos ]
oGetList:oGet := oGetList:aGetList[ oGetList:nPos ]
oGetList:PostActiveGet()
if ISBLOCK( oGetList:oGet:Reader )
@@ -74,7 +74,7 @@ function ReadModal( GetList, nPos )
oGetList:Reader()
endif
oGetList:nPos = oGetList:Settle()
oGetList:nPos := oGetList:Settle()
end
SetPos( MaxRow() - 1, 0 )
@@ -121,16 +121,16 @@ ENDCLASS
METHOD New( GetList ) CLASS TGetList
::aGetList = GetList
::lKillRead = .f.
::lBumpTop = .f.
::lBumpBot = .f.
::nLastExitState = 0
::nLastPos = 0
::cReadProcName = ""
::lUpdated = .f.
::nPos = 1
::oGet = GetList[ 1 ]
::aGetList := GetList
::lKillRead := .f.
::lBumpTop := .f.
::lBumpBot := .f.
::nLastExitState := 0
::nLastPos := 0
::cReadProcName := ""
::lUpdated := .f.
::nPos := 1
::oGet := GetList[ 1 ]
return Self
@@ -144,7 +144,7 @@ METHOD Reader() CLASS TGetList
while oGet:ExitState == GE_NOEXIT
if oGet:typeOut
oGet:ExitState = GE_ENTER
oGet:ExitState := GE_ENTER
endif
while oGet:exitState == GE_NOEXIT
@@ -152,7 +152,7 @@ METHOD Reader() CLASS TGetList
end
if ! ::GetPostValidate()
oGet:ExitState = GE_NOEXIT
oGet:ExitState := GE_NOEXIT
endif
end
@@ -161,12 +161,6 @@ METHOD Reader() CLASS TGetList
return nil
procedure GetReader( oGet )
oGet:Reader()
return
METHOD GetApplyKey( nKey ) CLASS TGetList
local cKey, bKeyBlock, oGet := ::oGet
@@ -178,41 +172,41 @@ METHOD GetApplyKey( nKey ) CLASS TGetList
do case
case nKey == K_UP
oGet:ExitState = GE_UP
oGet:ExitState := GE_UP
case nKey == K_SH_TAB
oGet:ExitState = GE_UP
oGet:ExitState := GE_UP
case nKey == K_DOWN
oGet:ExitState = GE_DOWN
oGet:ExitState := GE_DOWN
case nKey == K_TAB
oGet:ExitState = GE_DOWN
oGet:ExitState := GE_DOWN
case nKey == K_ENTER
oGet:ExitState = GE_ENTER
oGet:ExitState := GE_ENTER
case nKey == K_ESC
if Set( _SET_ESCAPE )
oGet:UnDo()
oGet:ExitState = GE_ESCAPE
oGet:ExitState := GE_ESCAPE
endif
case nKey == K_PGUP
oGet:ExitState = GE_WRITE
oGet:ExitState := GE_WRITE
case nKey == K_PGDN
oGet:ExitState = GE_WRITE
oGet:ExitState := GE_WRITE
case nKey == K_CTRL_HOME
oGet:ExitState = GE_TOP
oGet:ExitState := GE_TOP
#ifdef CTRL_END_SPECIAL
case nKey == K_CTRL_END
oGet:ExitState = GE_BOTTOM
oGet:ExitState := GE_BOTTOM
#else
case nKey == K_CTRL_W
oGet:ExitState = GE_WRITE
oGet:ExitState := GE_WRITE
#endif
case nKey == K_INS
@@ -274,7 +268,7 @@ METHOD GetApplyKey( nKey ) CLASS TGetList
?? Chr( 7 )
endif
if ! Set( _SET_CONFIRM )
oGet:ExitState = GE_ENTER
oGet:ExitState := GE_ENTER
endif
endif
endif
@@ -289,20 +283,20 @@ METHOD GetPreValidate() CLASS TGetList
local lUpdated, lWhen := .t.
if oGet:PreBlock != nil
lUpdated = ::lUpdated
lWhen = Eval( oGet:PreBlock, oGet )
lUpdated := ::lUpdated
lWhen := Eval( oGet:PreBlock, oGet )
oGet:Display()
::ShowScoreBoard()
::lUpdated := lUpdated
endif
if ::lKillRead
lWhen = .f.
oGet:ExitState = GE_ESCAPE
lWhen := .f.
oGet:ExitState := GE_ESCAPE
elseif ! lWhen
oGet:ExitState = GE_WHEN
oGet:ExitState := GE_WHEN
else
oGet:ExitState = GE_NOEXIT
oGet:ExitState := GE_NOEXIT
end
return lWhen
@@ -310,7 +304,7 @@ return lWhen
function GetPreValidate( oGet )
if oGet != nil
s_oGetListActive:oGet = oGet
s_oGetListActive:oGet := oGet
endif
return s_oGetListActive:GetPreValidate()
@@ -333,24 +327,24 @@ METHOD GetPostValidate() CLASS TGetList
if oGet:Changed
oGet:Assign()
::lUpdated = .t.
::lUpdated := .t.
endif
oGet:Reset()
if oGet:PostBlock != nil
lUpdated = ::lUpdated
lUpdated := ::lUpdated
SetPos( oGet:Row, oGet:Col + Len( oGet:Buffer ) )
lValid = Eval( oGet:PostBlock, oGet )
lValid := Eval( oGet:PostBlock, oGet )
SetPos( oGet:Row, oGet:Col )
::ShowScoreBoard()
oGet:UpdateBuffer()
::lUpdated = lUpdated
::lUpdated := lUpdated
if ::lKillRead
oGet:ExitState = GE_ESCAPE
lValid = .t.
oGet:ExitState := GE_ESCAPE
lValid := .t.
endif
endif
@@ -359,7 +353,7 @@ return lValid
function GetPostValidate( oGet )
if oGet != nil
s_oGetListActive:oGet = oGet
s_oGetListActive:oGet := oGet
endif
return s_oGetListActive:GetPostValidate()
@@ -373,43 +367,31 @@ METHOD GetDoSetKey( bKeyBlock ) CLASS TGetList
::lUpdated := .t.
endif
lUpdated = ::lUpdated
lUpdated := ::lUpdated
Eval( bKeyBlock, ::cReadProcName, ::nReadProcLine, ::ReadVar() )
::ShowScoreboard()
oGet:UpdateBuffer()
::lUpdated = lUpdated
::lUpdated := lUpdated
if ::lKillRead
oGet:ExitState = GE_ESCAPE
oGet:ExitState := GE_ESCAPE
endif
return nil
PROCEDURE GetDoSetKey( keyBlock, oGet )
if oGet != nil .and. s_oGetListActive != nil
s_oGetListActive:oGet = oGet
endif
if s_oGetListActive != nil
s_oGetListActive:GetDoSetKey( keyBlock )
endif
return
METHOD Settle( nPos ) CLASS TGetList
local nExitState
if nPos == nil
nPos = ::nPos
nPos := ::nPos
endif
if nPos == 0
nExitState = GE_DOWN
nExitState := GE_DOWN
else
nExitState := ::aGetList[ nPos ]:ExitState
endif
@@ -419,9 +401,9 @@ METHOD Settle( nPos ) CLASS TGetList
endif
if nExitState != GE_WHEN
::nLastPos = nPos
::lBumpTop = .f.
::lBumpBot = .f.
::nLastPos := nPos
::lBumpTop := .f.
::lBumpBot := .f.
else
nExitState := ::nLastExitState
endif
@@ -434,14 +416,14 @@ METHOD Settle( nPos ) CLASS TGetList
nPos++
case nExitState == GE_TOP
nPos = 1
::lBumpTop = .T.
nExitState = GE_DOWN
nPos := 1
::lBumpTop := .T.
nExitState := GE_DOWN
case nExitState == GE_BOTTOM
nPos = Len( ::aGetList )
::lBumpBot = .t.
nExitState = GE_UP
nPos := Len( ::aGetList )
::lBumpBot := .t.
nExitState := GE_UP
case nExitState == GE_ENTER
nPos++
@@ -449,22 +431,22 @@ METHOD Settle( nPos ) CLASS TGetList
if nPos == 0
if ! ::ReadExit() .and. ! ::lBumpBot
::lBumpTop = .t.
nPos = ::nLastPos
nExitState = GE_DOWN
::lBumpTop := .t.
nPos := ::nLastPos
nExitState := GE_DOWN
endif
elseif nPos == Len( ::aGetList ) + 1
if ! ::ReadExit() .and. nExitState != GE_ENTER .and. ! ::lBumpTop
::lBumpBot = .t.
nPos = ::nLastPos
nExitState = GE_UP
::lBumpBot := .t.
nPos := ::nLastPos
nExitState := GE_UP
else
nPos = 0
nPos := 0
endif
endif
::nLastExitState = nExitState
::nLastExitState := nExitState
if nPos != 0
::aGetList[ nPos ]:ExitState := nExitState
@@ -496,10 +478,12 @@ return cName
function ReadFormat( bFormat )
if PCount() > 0
return s_oGetListActive:SetFormat( bFormat )
else
return s_oGetListActive:SetFormat()
if s_oGetListActive != NIL
if PCount() > 0
return s_oGetListActive:SetFormat( bFormat )
else
return s_oGetListActive:SetFormat()
endif
endif
return nil
@@ -508,46 +492,20 @@ METHOD SetFormat( bFormat ) CLASS TGetList
local bSavFormat := ::bFormat
::bFormat = bFormat
::bFormat := bFormat
return bSavFormat
procedure __SetFormat( bFormat )
if s_oGetListActive != nil
if ValType( bFormat ) == "B"
s_oGetListActive:SetFormat( bFormat )
else
s_oGetListActive:SetFormat()
endif
endif
return
METHOD KillRead( lKill ) CLASS TGetList
local lSavKill := ::lKillRead
if PCount() > 0
::lKillRead = lKill
::lKillRead := lKill
endif
return lSavKill
function ReadKill( lKill )
if PCount() > 0
return s_oGetListActive:KillRead( lKill )
endif
return s_oGetListActive:KillRead()
procedure __KillRead()
s_oGetListActive:KillRead( .T. )
return
METHOD GetActive( oGet ) CLASS TGetList
local oOldGet := ::oActiveGet
@@ -558,26 +516,14 @@ METHOD GetActive( oGet ) CLASS TGetList
return oOldGet
function GetActive( oGet )
if s_oGetListActive != nil
if PCount() > 0
return s_oGetListActive:GetActive( oGet )
else
return s_oGetListActive:GetActive()
endif
endif
return nil
METHOD ShowScoreboard() CLASS TGetList
local nRow, nCol, nOldCursor
if Set( _SET_SCOREBOARD )
nRow = Row()
nCol = Col()
nOldCursor = SetCursor( SC_NONE )
nRow := Row()
nCol := Col()
nOldCursor := SetCursor( SC_NONE )
DispOutAt( SCORE_ROW, SCORE_COL, If( Set( _SET_INSERT ), "Ins", " " ) )
SetPos( nRow, nCol )
SetCursor( nOldCursor )
@@ -618,13 +564,63 @@ METHOD ReadVar( cNewVarName ) CLASS TGetList
return cOldName
FUNCTION ReadVar( cNewVarName )
METHOD ReadUpdated( lUpdated ) CLASS TGetList
if s_oGetListActive != nil
return s_oGetListActive:ReadVar( cNewVarName )
local lSavUpdated := ::lUpdated
if PCount() > 0
::lUpdated := lUpdated
endif
return ""
return lSavUpdated
/* ------------------ Global functions ------------------- */
PROCEDURE GetReader( oGet )
oGet:Reader()
RETURN
FUNCTION GetActive( oGet )
if s_oGetListActive != NIL
if PCount() > 0
RETURN s_oGetListActive:GetActive( oGet )
else
RETURN s_oGetListActive:GetActive()
endif
endif
RETURN NIL
PROCEDURE GetDoSetKey( keyBlock, oGet )
if s_oGetListActive != NIL
if oGet != NIL
s_oGetListActive:oGet := oGet
endif
s_oGetListActive:GetDoSetKey( keyBlock )
endif
RETURN
PROCEDURE GetApplyKey( oGet, nKey )
if s_oGetListActive != NIL
s_oGetListActive:oGet := oGet
s_oGetListActive:GetApplyKey( nKey )
endif
RETURN
FUNCTION ReadVar( cNewVarName )
if s_oGetListActive != NIL
RETURN s_oGetListActive:ReadVar( cNewVarName )
endif
RETURN ""
FUNCTION ReadExit( lExit )
RETURN Set( _SET_EXIT, lExit )
@@ -632,37 +628,55 @@ FUNCTION ReadExit( lExit )
FUNCTION ReadInsert( lInsert )
RETURN Set( _SET_INSERT, lInsert )
METHOD ReadUpdated( lUpdated ) CLASS TGetList
FUNCTION ReadUpdated( lUpdated )
local lSavUpdated := ::lUpdated
if PCount() > 0
::lUpdated = lUpdated
if s_oGetListActive != NIL
if PCount() > 0
RETURN s_oGetListActive:ReadUpdated( lUpdated )
else
RETURN s_oGetListActive:ReadUpdated()
endif
endif
return lSavUpdated
RETURN .F.
function ReadUpdated( lUpdated )
FUNCTION Updated()
if PCount() > 0
return s_oGetListActive:ReadUpdated( lUpdated )
if s_oGetListActive != NIL
RETURN s_oGetListActive:lUpdated
endif
return s_oGetListActive:ReadUpdated()
RETURN .F.
function Updated()
FUNCTION ReadKill( lKill )
if s_oGetListActive != nil
return s_oGetListActive:lUpdated
if s_oGetListActive != NIL
if PCount() > 0
RETURN s_oGetListActive:KillRead( lKill )
else
RETURN s_oGetListActive:KillRead()
endif
endif
return .f.
RETURN .F.
procedure GetApplyKey( oGet, nKey )
PROCEDURE __KillRead()
if s_oGetListActive != nil
s_oGetListActive:oGet := oGet
s_oGetListActive:GetApplyKey( nKey )
endif
IF s_oGetListActive != NIL
s_oGetListActive:KillRead( .T. )
ENDIF
RETURN
PROCEDURE __SetFormat( bFormat )
if s_oGetListActive != NIL
if ValType( bFormat ) == "B"
s_oGetListActive:SetFormat( bFormat )
else
s_oGetListActive:SetFormat()
endif
endif
RETURN
return

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

@@ -70,7 +70,7 @@ PROCEDURE __TYPEFILE( cFile, lPrint )
cTmp := substr( cTmp, 1, i - 1 )
ENDIF
aPath := aDvd( cTmp )
FOR i = 1 TO len( aPath )
FOR i := 1 TO len( aPath )
cTmp := hb_FNameMerge( aPath[ i ], cName, cExt )
IF file( cTmp )
cFile := cTmp

1
harbour/source/tools/Makefile
View File

@@ -36,6 +36,7 @@ C_SOURCES=\
PRG_SOURCES=\
ctmisc.prg \
cttoken.prg \
fileread.prg \
nconvert.prg \
numtxthu.prg \

122
harbour/source/tools/cttoken.prg Normal file
View File

@@ -0,0 +1,122 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* CT_NUMTOKEN() and CT_TOKEN() CA-Tools function
*
* Copyright 2000 Phil Barnett <philb@iag.net>
* 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 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) 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 HRL
* and/or HVM code into it.
*
* 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 program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "common.ch"
// This is used to get a count of how many tokens are in a string based
// on the supplied delimiter. This defaults to the same delimiters as
// used in the like named function in Clipper Tools III, so it should
// work identically.
function CT_NUMTOKEN( cString, cDelimiter )
local x
local nStrLen := len( cString )
local nHowMany := 0
local lFoundWord := .F.
local retval := 0
DEFAULT cDelimiter TO ' ,.;:!?/\<>()^#&%+-*' + chr( 0 ) + chr( 9 ) + ;
chr( 10 ) + chr( 13 ) + ;
chr( 26 ) + chr( 138 ) + ;
chr( 141 )
for x := 1 to nStrLen
if substr( cString, x, 1 ) $ cDelimiter
if lFoundWord
nHowMany++
endif
do while x < nStrLen .and. substr( cString, x + 1, 1 ) $ cDelimiter
x++
enddo
else
lFoundWord := .T.
endif
next
if nStrLen > 0
retval := iif( right( cString, 1 ) $ cDelimiter, nHowmany, nHowMany + 1 )
endif
return retval
// This is used to extract each token from the string based on the
// delimiter and the numeric pointer which tells us which token to
// return.
// This defaults to the same delimiters as used in the like named
// function in Clipper Tools III, so it should work identically.
function CT_TOKEN( cString, cDelimiter, nPointer )
local x
local nStrLen := len( cString )
local nHowMany := 0
local nLastPointer := 0
local cPart
local lFoundWord := .F.
DEFAULT cDelimiter TO ' ,.;:!?/\<>()^#&%+-*' + chr( 0 ) + chr( 9 ) + ;
chr( 10 ) + chr( 13 ) + ;
chr( 26 ) + chr( 138 ) + ;
chr( 141 )
for x := 1 to nStrLen
if substr( cString, x, 1 ) $ cDelimiter
if lFoundWord
nHowMany++
endif
if nHowMany == nPointer
exit
endif
do while x < nStrLen .and. substr( cString, x + 1, 1 ) $ cDelimiter
x++
enddo
nLastPointer := x
else
lFoundWord := .T.
endif
next
// went all the way without nHowmany == nPointer
if x == nStrLen + 1
// take the last word
cPart := substr( cString, nLastPointer + 1 )
else
cPart := substr( cString, nLastPointer + 1, ( x - nLastPointer ) - 1 )
endif
return cPart

3
harbour/utils/hbrun/exttools.prg
View File

@@ -214,4 +214,5 @@ EXTERNAL CT_RESTGETS
EXTERNAL CT_SAVEGETS
EXTERNAL CT_SCREENMIX
EXTERNAL CT_POSUPPER
EXTERNAL CT_NUMTOKEN
EXTERNAL CT_TOKEN