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

19991021-23:33 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-10-21 21:47:49 +00:00
parent a67eac4e13
commit 964da8b34b
9 changed files with 308 additions and 260 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
harbour/ChangeLog
View File

@@ -1,3 +1,27 @@
19991021-23:33 GMT+1 Victor Szel <info@szelvesz.hu>
* config/rules.cf
+ /w switch added to the default Harbour switches in the GNU make system.
Be warned that some new warnings may arise in some test programs.
The core Harbour .PRG files compile without any warnings, though.
The only exception is HBRUN.PRG, but in that case either the compiler
or the PP should be modified, until then just ignore these.
* tests/fortest.prg
tests/memfile.prg
! /w warnings fixed.
* source/rtl/achoice.prg
source/rtl/menuto.prg
source/rtl/tgetlist.prg
% SetPos() + DispOut() -> DispOutAt()
* source/debug/debugger.prg
% Now all screen output is done using SetPos()/DispOutAt() so it's faster
and it's not fooled by output redirection or SET DEVICE TO PRINTER.
* Menu made more exactly Clipper like.
% "&" hotkey marker char changed to "~" to avoid any macro expansion
in the future.
* Some formatting (Move() method).
* source/debug/tbrwtext.prg
* Formatted.
19991021-22:18 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/gtapi.c
! hb_gtSetColorStr() now resets the ColorSelect() value to STANDARD,

2
harbour/config/rules.cf
View File

@@ -20,7 +20,7 @@ HB := $(HB_BIN_COMPILE)/
endif
HB := $(HB)harbour$(EXE_EXT)
HB_FLAGS = -n -q0 -I$(TOP) -I$(HB_INC_COMPILE)
HB_FLAGS = -n -q0 -w -I$(TOP) -I$(HB_INC_COMPILE)
# The rule to link an executable.
ifeq ($(LD_RULE),)

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

@@ -298,18 +298,17 @@ METHOD Show() CLASS TDebugger
SET COLOR TO "N/BG"
@ MaxRow(), 0 CLEAR TO MaxRow(), MaxCol()
@ MaxRow(), 0 SAY ;
"F1-Help F2-Zoom F3-Repeat F4-User F5-Go F6-WA F7-Here F8-Step F9-BkPt F10-Trace" COLOR "N/BG"
@ MaxRow(), 0 SAY "F1" COLOR "GR+/BG"
@ MaxRow(), 8 SAY "F2" COLOR "GR+/BG"
@ MaxRow(), 16 SAY "F3" COLOR "GR+/BG"
@ MaxRow(), 26 SAY "F4" COLOR "GR+/BG"
@ MaxRow(), 34 SAY "F5" COLOR "GR+/BG"
@ MaxRow(), 40 SAY "F6" COLOR "GR+/BG"
@ MaxRow(), 46 SAY "F7" COLOR "GR+/BG"
@ MaxRow(), 54 SAY "F8" COLOR "GR+/BG"
@ MaxRow(), 62 SAY "F9" COLOR "GR+/BG"
@ MaxRow(), 70 SAY "F10" COLOR "GR+/BG"
DispOutAt( MaxRow(), 0, "F1-Help F2-Zoom F3-Repeat F4-User F5-Go F6-WA F7-Here F8-Step F9-BkPt F10-Trace", "N/BG" )
DispOutAt( MaxRow(), 0, "F1", "GR+/BG" )
DispOutAt( MaxRow(), 8, "F2", "GR+/BG" )
DispOutAt( MaxRow(), 16, "F3", "GR+/BG" )
DispOutAt( MaxRow(), 26, "F4", "GR+/BG" )
DispOutAt( MaxRow(), 34, "F5", "GR+/BG" )
DispOutAt( MaxRow(), 40, "F6", "GR+/BG" )
DispOutAt( MaxRow(), 46, "F7", "GR+/BG" )
DispOutAt( MaxRow(), 54, "F8", "GR+/BG" )
DispOutAt( MaxRow(), 62, "F9", "GR+/BG" )
DispOutAt( MaxRow(), 70, "F10", "GR+/BG" )
return nil
@@ -341,7 +340,7 @@ METHOD ShowCallStack() CLASS TDebugger
::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 }
Max( 1, n + nSkip ) ), n - nPos }
::oBrwStack:AddColumn( TBColumnNew( "", { || PadC( ::aCallStack[ n ], 14 ) } ) )
::oBrwStack:ForceStable()
@@ -387,7 +386,7 @@ METHOD ShowVars() CLASS TDebugger
::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 }
Max( 1, n + nSkip ) ), n - nPos }
nWidth = ::oWndVars:nWidth() - 1
::oBrwVars:AddColumn( TBColumnNew( "", { || AllTrim( Str( n ) ) + ") " + ;
@@ -455,8 +454,8 @@ METHOD InputBox( cMsg, uValue ) CLASS TDebugger
local lScoreBoard := Set( _SET_SCOREBOARD, .f. )
@ nTop, nLeft, nBottom, nRight BOX B_SINGLE COLOR ::oPullDown:cClrPopup
@ nTop, nLeft + ( ( nRight - nLeft ) ) / 2 - Len( cMsg ) / 2 SAY ;
cMsg COLOR ::oPullDown:cClrPopup
DispOutAt( nTop, nLeft + ( ( nRight - nLeft ) ) / 2 - Len( cMsg ) / 2,;
cMsg, ::oPullDown:cClrPopup )
__Shadow( nTop, nLeft, nBottom, nRight )
@ nTop + 1, nLeft + 1 GET uTemp
@@ -561,8 +560,8 @@ METHOD SetCaption( cCaption ) CLASS TDbWindow
::cCaption = cCaption
if ! Empty( cCaption )
@ ::nTop, ( ( ::nRight - ::nLeft ) / 2 ) - ;
( Len( cCaption ) + 2 ) / 2 SAY " " + cCaption + " " COLOR ::cColor
DispOutAt( ::nTop, ( ( ::nRight - ::nLeft ) / 2 ) - ;
( Len( cCaption ) + 2 ) / 2, " " + cCaption + " ", ::cColor )
endif
return nil
@@ -577,8 +576,8 @@ METHOD SetFocus( lOnOff ) CLASS TDbWindow
COLOR ::cColor
if ! Empty( ::cCaption )
@ ::nTop, ::nLeft + ( ::nRight - ::nLeft ) / 2 - Len( ::cCaption ) / 2 ;
SAY " " + ::cCaption + " " COLOR ::cColor
DispOutAt( ::nTop, ::nLeft + ( ::nRight - ::nLeft ) / 2 - Len( ::cCaption ) / 2 ,;
" " + ::cCaption + " ", ::cColor )
endif
DispEnd()
@@ -606,44 +605,56 @@ Copyright Luiz Rafael Culik 1999
*/
METHOD Move() Class TDbWindow
#define pbar1 replicate(chr(176),8)+chr(32)
local noldtop := ::nTop
local noldleft := ::nLeft
local noldbottom := ::nbottom
local noldright := ::nright
local nkey
local nOldTop := ::nTop
local nOldLeft := ::nLeft
local nOldBottom := ::nbottom
local nOldRight := ::nright
local nKey
while .t.
restscreen(,,,, ::cbackimage)
dispbox(::ntop,::nleft,::nright,::nbottom,pbar1)
nkey=inkey(0)
RestScreen( ,,,, ::cbackimage )
DispBox( ::nTop, ::nLeft, ::nRight, ::nBottom, Replicate( Chr( 176 ), 8 ) + " " )
nKey := Inkey( 0 )
do case
case nkey==K_UP
if(::ntop != 0,(::ntop--,::nbottom--),nil)
case nkey == K_UP
if ::ntop != 0
::ntop--
::nbottom--
endif
case nkey==K_DOWN
if(::nbottom != maxrow(),(::ntop++,::nbottom++),nil)
case nKey == K_DOWN
if ::nBottom != MaxRow()
::nTop++
::nBottom++
endif
case nkey==K_LEFT
if(::nleft != 0,(::nleft--,::nright--),nil)
case nKey == K_LEFT
if ::nLeft != 0
::nLeft--
::nRight--
endif
case nkey==K_RIGHT
if(::nbottom != maxrow(),(::nleft++,::nright++),nil)
case nKey == K_RIGHT
if ::nBottom != MaxRow()
::nLeft++
::nRight++
endif
case nkey==K_ESC
::ntop := noldtop
::nleft := noldleft
::nbottom := noldbottom
::nright := noldright
case nKey == K_ESC
::nTop := nOldTop
::nLeft := nOldLeft
::nBottom := nOldBottom
::nRight := nOldRight
endcase
if ( nkey==K_ESC .or. nkey==K_ENTER)
if nKey == K_ESC .or. nKey == K_ENTER
exit
end
end
// __keyboard(chr(0)),inkey())
// __keyboard( chr( 0 ) ), inkey() )
return nil
@@ -725,7 +736,7 @@ METHOD AddItem( oMenuItem ) CLASS TDbMenu
if Len( oLastMenu:aItems ) > 0
oLastMenuItem = ATail( oLastMenu:aItems )
oMenuItem:nCol = oLastMenuItem:nCol + ;
Len( StrTran( oLastMenuItem:cPrompt, "&", "" ) )
Len( StrTran( oLastMenuItem:cPrompt, "~", "" ) )
else
oMenuItem:nCol = 0
endif
@@ -743,7 +754,7 @@ METHOD Build() CLASS TDbMenu
for n = 1 to Len( ::aItems )
::aItems[ n ]:nRow = 0
::aItems[ n ]:nCol = nPos
nPos += Len( StrTran( ::aItems[ n ]:cPrompt, "&", "" ) )
nPos += Len( StrTran( ::aItems[ n ]:cPrompt, "~", "" ) )
next
else
oMenuItem = ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems )
@@ -753,7 +764,7 @@ METHOD Build() CLASS TDbMenu
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 )
nPos = Max( nPos, ::nLeft + Len( StrTran( ::aItems[ n ]:cPrompt, "~", "" ) ) + 1 )
next
::nRight = nPos
::nBottom = ::nTop + Len( ::aItems ) + 1
@@ -779,11 +790,11 @@ METHOD ClosePopup( nPopup ) CLASS TDbMenu
RestScreen( oPopup:nTop, oPopup:nLeft, oPopup:nBottom + 1, oPopup:nRight + 1,;
oPopup:cBackImage )
oPopup:cBackImage = nil
@ 0, ::aItems[ nPopup ]:nCol SAY ;
StrTran( ::aItems[ nPopup ]:cPrompt, "&", "" ) COLOR ::cClrPopup
DispOutAt( 0, ::aItems[ nPopup ]:nCol,;
StrTran( ::aItems[ nPopup ]:cPrompt, "~", "" ), ::cClrPopup )
@ 0, ::aItems[ nPopup ]:nCol + nAt := At( "&", ::aItems[ nPopup ]:cPrompt ) - 1 SAY ;
SubStr( ::aItems[ nPopup ]:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotKey
DispOutAt( 0, ::aItems[ nPopup ]:nCol + nAt := At( "~", ::aItems[ nPopup ]:cPrompt ) - 1,;
SubStr( ::aItems[ nPopup ]:cPrompt, nAt + 2, 1 ), ::cClrHotKey )
endif
// dispend()
@@ -805,8 +816,8 @@ METHOD Display() CLASS TDbMenu
// DispBegin()
if ! ::lPopup
@ 0, 0 SAY Space( MaxCol() + 1 ) COLOR ::cClrPopup
DevPos( 0, 0 )
DispOutAt( 0, 0, Space( MaxCol() + 1 ), ::cClrPopup )
SetPos( 0, 0 )
else
::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 1 )
@ ::nTop, ::nLeft, ::nBottom, ::nRight BOX B_SINGLE
@@ -815,15 +826,15 @@ METHOD Display() CLASS TDbMenu
for n = 1 to Len( ::aItems )
if ::aItems[ n ]:cPrompt == "-" // Separator
@ ::aItems[ n ]:nRow, ::nLeft SAY ;
Chr( 195 ) + Replicate( Chr( 196 ), ::nRight - ::nLeft - 1 ) + Chr( 180 )
DispOutAt( ::aItems[ n ]:nRow, ::nLeft,;
Chr( 195 ) + Replicate( Chr( 196 ), ::nRight - ::nLeft - 1 ) + Chr( 180 ) )
else
@ ::aItems[ n ]:nRow, ::aItems[ n ]:nCol SAY ;
StrTran( ::aItems[ n ]:cPrompt, "&", "" )
DispOutAt( ::aItems[ n ]:nRow, ::aItems[ n ]:nCol,;
StrTran( ::aItems[ n ]:cPrompt, "~", "" ) )
@ ::aItems[ n ]:nRow, ::aItems[ n ]:nCol + nAt := ;
At( "&", ::aItems[ n ]:cPrompt ) - 1 SAY ;
SubStr( ::aItems[ n ]:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotKey
DispOutAt( ::aItems[ n ]:nRow, ::aItems[ n ]:nCol + nAt := ;
At( "~", ::aItems[ n ]:cPrompt ) - 1 ,;
SubStr( ::aItems[ n ]:cPrompt, nAt + 2, 1 ), ::cClrHotKey )
endif
next
// DispEnd()
@@ -850,7 +861,7 @@ METHOD GetHotKeyPos( cKey ) CLASS TDbMenu
for n = 1 to Len( ::aItems )
if Upper( SubStr( ::aItems[ n ]:cPrompt,;
At( "&", ::aItems[ n ]:cPrompt ) + 1, 1 ) ) == cKey
At( "~", ::aItems[ n ]:cPrompt ) + 1, 1 ) ) == cKey
return n
endif
next
@@ -882,12 +893,12 @@ METHOD GoLeft() CLASS TDbMenu
::ClosePopup( ::nOpenPopup )
else
SetColor( ::cClrPopup )
@ oMenuItem:nRow, oMenuItem:nCol SAY ;
StrTran( oMenuItem:cPrompt, "&", "" )
DispOutAt( oMenuItem:nRow, oMenuItem:nCol,;
StrTran( oMenuItem:cPrompt, "~", "" ) )
@ oMenuItem:nRow, oMenuItem:nCol + nAt := ;
At( "&", oMenuItem:cPrompt ) - 1 SAY ;
SubStr( oMenuItem:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotKey
DispOutAt( oMenuItem:nRow, oMenuItem:nCol + nAt := ;
At( "~", oMenuItem:cPrompt ) - 1 ,;
SubStr( oMenuItem:cPrompt, nAt + 2, 1 ), ::cClrHotKey )
endif
if ::nOpenPopup > 1
--::nOpenPopup
@@ -915,12 +926,12 @@ METHOD GoRight() CLASS TDbMenu
::ClosePopup( ::nOpenPopup )
else
SetColor( ::cClrPopup )
@ oMenuItem:nRow, oMenuItem:nCol SAY ;
StrTran( oMenuItem:cPrompt, "&", "" )
DispOutAt( oMenuItem:nRow, oMenuItem:nCol ,;
StrTran( oMenuItem:cPrompt, "~", "" ) )
@ oMenuItem:nRow, oMenuItem:nCol + nAt := ;
At( "&", oMenuItem:cPrompt ) - 1 SAY ;
SubStr( oMenuItem:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotKey
DispOutAt( oMenuItem:nRow, oMenuItem:nCol + nAt := ;
At( "~", oMenuItem:cPrompt ) - 1 ,;
SubStr( oMenuItem:cPrompt, nAt + 2, 1 ), ::cClrHotKey )
endif
if ::nOpenPopup < Len( ::aItems )
++::nOpenPopup
@@ -954,19 +965,19 @@ METHOD ShowPopup( nPopup ) CLASS TDbMenu
local nAt, oMenuItem
if ! ::lPopup
@ 0, ::aItems[ nPopup ]:nCol SAY ;
StrTran( ::aItems[ nPopup ]:cPrompt, "&", "" ) COLOR ::cClrHilite
DispOutAt( 0, ::aItems[ nPopup ]:nCol ,;
StrTran( ::aItems[ nPopup ]:cPrompt, "~", "" ), ::cClrHilite )
@ 0, ::aItems[ nPopup ]:nCol + nAt := At( "&", ::aItems[ nPopup ]:cPrompt ) - 1 SAY ;
SubStr( ::aItems[ nPopup ]:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotFocus
DispOutAt( 0, ::aItems[ nPopup ]:nCol + nAt := At( "~", ::aItems[ nPopup ]:cPrompt ) - 1 ,;
SubStr( ::aItems[ nPopup ]:cPrompt, nAt + 2, 1 ), ::cClrHotFocus )
else
oMenuItem = ::aItems[ nPopup ]
@ oMenuItem:nRow, oMenuItem:nCol SAY ;
StrTran( oMenuItem:cPrompt, "&", "" ) COLOR ::cClrHilite
DispOutAt( oMenuItem:nRow, oMenuItem:nCol ,;
StrTran( oMenuItem:cPrompt, "~", "" ), ::cClrHilite )
@ oMenuItem:nRow, oMenuItem:nCol + nAt := ;
At( "&", oMenuItem:cPrompt ) - 1 SAY ;
SubStr( oMenuItem:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotFocus
DispOutAt( oMenuItem:nRow, oMenuItem:nCol + nAt := ;
At( "~", oMenuItem:cPrompt ) - 1 ,;
SubStr( oMenuItem:cPrompt, nAt + 2, 1 ), ::cClrHotFocus )
endif
::nOpenPopup = nPopup
@@ -1038,12 +1049,12 @@ METHOD Display( cClrText, cClrHotKey ) CLASS TDbMenuItem
local nAt
@ ::nRow, ::nCol SAY ;
StrTran( ::cPrompt, "&", "" ) COLOR cClrText
DispOutAt( ::nRow, ::nCol ,;
StrTran( ::cPrompt, "~", "" ), cClrText )
@ ::nRow, ::nCol + nAt := ;
At( "&", ::cPrompt ) - 1 SAY ;
SubStr( ::cPrompt, nAt + 2, 1 ) COLOR cClrHotKey
DispOutAt( ::nRow, ::nCol + nAt := ;
At( "~", ::cPrompt ) - 1 ,;
SubStr( ::cPrompt, nAt + 2, 1 ), cClrHotKey )
return nil
@@ -1069,103 +1080,103 @@ function BuildMenu( oDebugger ) // Builds the debugger pulldown menu
local oMenu
MENU oMenu
MENUITEM " &File "
MENUITEM " ~File "
MENU
MENUITEM " &Open..." ACTION oDebugger:Open()
MENUITEM " &Resume" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Shell" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Open..." ACTION oDebugger:Open()
MENUITEM " ~Resume" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~OS Shell" ACTION Alert( "Not implemented yet!" )
SEPARATOR
MENUITEM " &Exit Alt-X " ACTION oDebugger:Exit(), oDebugger:Hide()
MENUITEM " e~Xit Alt-X " ACTION oDebugger:Exit(), oDebugger:Hide()
ENDMENU
MENUITEM " &Locate "
MENUITEM " ~Locate "
MENU
MENUITEM " &Find" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Next" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Previous" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Goto line..." ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Find" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Next" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Previous" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Goto line..." ACTION Alert( "Not implemented yet!" )
SEPARATOR
MENUITEM " &Case sensitive " ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Case sensitive " ACTION Alert( "Not implemented yet!" )
ENDMENU
MENUITEM " &View "
MENUITEM " ~View "
MENU
MENUITEM " &Sets" ACTION Alert( "Not implemented yet!" )
MENUITEM " &WorkAreas F6" ACTION Alert( "Not implemented yet!" )
MENUITEM " &App screen F4 " ACTION oDebugger:ShowAppScreen()
MENUITEM " ~Sets" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~WorkAreas F6" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~App Screen F4 " ACTION oDebugger:ShowAppScreen()
SEPARATOR
MENUITEM " &CallStack" ACTION oDebugger:ShowCallStack()
MENUITEM " ~CallStack" ACTION oDebugger:ShowCallStack()
ENDMENU
MENUITEM " &Run "
MENUITEM " ~Run "
MENU
MENUITEM " &Restart" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Animate" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Step F8 " ACTION Alert( "Not implemented yet!" )
MENUITEM " &Trace F10" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Go F5" ACTION oDebugger:Go()
MENUITEM " to &Cursor F7" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Next routine Ctrl-F5" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Restart" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Animate" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Step F8 " ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Trace F10" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Go F5" ACTION oDebugger:Go()
MENUITEM " to ~Cursor F7" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Next routine Ctrl-F5" ACTION Alert( "Not implemented yet!" )
SEPARATOR
MENUITEM " S&peed..." ACTION Alert( "Not implemented yet!" )
MENUITEM " s~Peed..." ACTION Alert( "Not implemented yet!" )
ENDMENU
MENUITEM " &Point "
MENUITEM " ~Point "
MENU
MENUITEM " &Watchpoint..." ACTION Alert( "Not implemented yet!" )
MENUITEM " &Tracepoint..." ACTION Alert( "Not implemented yet!" )
MENUITEM " &Breakpoint F9 " ACTION oDebugger:ToggleBreakPoint()
MENUITEM " &Delete..." ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Watchpoint..." ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Tracepoint..." ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Breakpoint F9 " ACTION oDebugger:ToggleBreakPoint()
MENUITEM " ~Delete..." ACTION Alert( "Not implemented yet!" )
ENDMENU
MENUITEM " &Monitor "
MENUITEM " ~Monitor "
MENU
MENUITEM " &Public" ACTION oDebugger:ShowVars()
MENUITEM " Pri&vate " ACTION oDebugger:ShowVars()
MENUITEM " &Static" ACTION oDebugger:ShowVars()
MENUITEM " &Local" ACTION oDebugger:ShowVars()
MENUITEM " ~Public" ACTION oDebugger:ShowVars()
MENUITEM " pri~Vate " ACTION oDebugger:ShowVars()
MENUITEM " ~Static" ACTION oDebugger:ShowVars()
MENUITEM " ~Local" ACTION oDebugger:ShowVars()
SEPARATOR
MENUITEM " &All" ACTION Alert( "Not implemented yet!" )
MENUITEM " S&ort" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~All" ACTION Alert( "Not implemented yet!" )
MENUITEM " s~Ort" ACTION Alert( "Not implemented yet!" )
ENDMENU
MENUITEM " &Options "
MENUITEM " ~Options "
MENU
MENUITEM " &Preprocessed code" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Line numbers" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Exchange screens" ACTION Alert( "Not implemented yet!" )
MENUITEM " swap on &Input" ACTION Alert( "Not implemented yet!" )
MENUITEM " code&block trace" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Menu Bar" ACTION Alert( "Not implemented yet!" )
MENUITEM " Mono &display" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Colors..." ACTION Alert( "Not implemented yet!" )
MENUITEM " &Tab width..." ACTION Alert( "Not implemented yet!" )
MENUITEM " path for &files..." ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Preprocessed Code" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Line Numbers" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Exchange Screens" ACTION Alert( "Not implemented yet!" )
MENUITEM " swap on ~Input" ACTION Alert( "Not implemented yet!" )
MENUITEM " code~Block Trace" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Menu Bar" ACTION Alert( "Not implemented yet!" )
MENUITEM " mono ~Display" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Colors..." ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Tab Width..." ACTION Alert( "Not implemented yet!" )
MENUITEM " path for ~Files..." ACTION Alert( "Not implemented yet!" )
SEPARATOR
MENUITEM " &Save settings..." ACTION Alert( "Not implemented yet!" )
MENUITEM " &Restore settings... " ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Save Settings..." ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Restore Settings... " ACTION Alert( "Not implemented yet!" )
ENDMENU
MENUITEM " &Window "
MENUITEM " ~Window "
MENU
MENUITEM " &Next Tab " ACTION oDebugger:NextWindow()
MENUITEM " &Prev Sh-Tab" ACTION oDebugger:PrevWindow()
MENUITEM " &Move" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Size" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Zoom F2" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Iconize" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Next Tab " ACTION oDebugger:NextWindow()
MENUITEM " ~Prev Sh-Tab" ACTION oDebugger:PrevWindow()
MENUITEM " ~Move" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Size" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Zoom F2" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Iconize" ACTION Alert( "Not implemented yet!" )
SEPARATOR
MENUITEM " &Tile" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Tile" ACTION Alert( "Not implemented yet!" )
ENDMENU
MENUITEM " &Help "
MENUITEM " ~Help "
MENU
MENUITEM " &About Help " ACTION Alert( "Not implemented yet!" )
MENUITEM " ~About Help " ACTION Alert( "Not implemented yet!" )
SEPARATOR
MENUITEM " &Keys" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Windows" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Menus" ACTION Alert( "Not implemented yet!" )
MENUITEM " &Commands" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Keys" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Windows" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Menus" ACTION Alert( "Not implemented yet!" )
MENUITEM " ~Commands" ACTION Alert( "Not implemented yet!" )
ENDMENU
ENDMENU

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

@@ -55,182 +55,190 @@ ENDCLASS
METHOD New( nTop, nLeft, nBottom, nRight, cFileName, cColors ) CLASS TBrwText
DEFAULT nTop TO 0, nLeft TO 0, nRight TO MaxCol(), nBottom TO MaxRow(),;
cColors TO SetColor()
DEFAULT nTop TO 0
DEFAULT nLeft TO 0
DEFAULT nRight TO MaxCol()
DEFAULT nBottom TO MaxRow()
DEFAULT cColors TO SetColor()
Super:New()
::nTop = nTop
::nLeft = nLeft
::nBottom = nBottom
::nRight = nRight
::ColorSpec = cColors
::cFileName = cFileName
::nHandle = FOpen( cFileName, FO_READ )
::nFileSize = FSeek( ::nHandle, 0, FS_RELATIVE )
::cLine = Space( ::nRight - ::nLeft - 2 )
::nLine = 1
::Autolite = .t.
::nTop := nTop
::nLeft := nLeft
::nBottom := nBottom
::nRight := nRight
::ColorSpec := cColors
::cFileName := cFileName
::nHandle := FOpen( cFileName, FO_READ )
::nFileSize := FSeek( ::nHandle, 0, FS_RELATIVE )
::cLine := Space( ::nRight - ::nLeft - 2 )
::nLine := 1
::Autolite := .T.
::AddColumn( TbColumnNew( "", { || Alltrim( Str( ::nLine ) ) + ": " + ::cLine } ) )
::GoTopBlock = { || GoFirstLine( Self ) }
::GoBottomBlock = { || GoLastLine( Self ) }
::SkipBlock = { | nLines | Skipper( Self, nLines ) }
::GoTopBlock := {|| GoFirstLine( Self ) }
::GoBottomBlock := {|| GoLastLine( Self ) }
::SkipBlock := {| nLines | Skipper( Self, nLines ) }
::GoTop()
return Self
return Self
METHOD GotoLine( nLine ) CLASS TBrwText
if nLine > ::nLine
while ::nLine < nLine
IF nLine > ::nLine
DO WHILE ::nLine < nLine
::Down()
end
ENDDO
::ForceStable()
else
while ::nLine > nLine
ELSE
DO WHILE ::nLine > nLine
::Up()
end
ENDDO
::ForceStable()
endif
ENDIF
return nil
RETURN NIL
static function GoFirstLine( oBrw )
STATIC FUNCTION GoFirstLine( oBrw )
local cLine
LOCAL cLine
FSeek( oBrw:nHandle, 0, FS_SET )
FReadLn( oBrw:nHandle, @cLine )
oBrw:cLine = cLine
oBrw:nLine = 1
oBrw:cLine := cLine
oBrw:nLine := 1
FSeek( oBrw:nHandle, 0, FS_SET )
return nil
RETURN NIL
static function GoLastLine( oBrw )
STATIC FUNCTION GoLastLine( oBrw )
local cLine := oBrw:cLine
LOCAL cLine := oBrw:cLine
FSeek( oBrw:nHandle, -1, FS_END )
GoPrevLine( oBrw:nHandle, @cLine, oBrw:nFileSize )
oBrw:cLine = cLine
oBrw:cLine := cLine
return nil
RETURN NIL
static function Skipper( oBrw, nLines )
STATIC FUNCTION Skipper( oBrw, nLines )
local nSkipped := 0
local cLine := oBrw:cLine
LOCAL nSkipped := 0
LOCAL cLine := oBrw:cLine
// Skip down
if nLines > 0
while nSkipped != nLines .and. GoNextLine( oBrw:nHandle, @cLine )
IF nLines > 0
DO WHILE nSkipped != nLines .AND. GoNextLine( oBrw:nHandle, @cLine )
nSkipped++
end
oBrw:cLine = cLine
ENDDO
oBrw:cLine := cLine
// Skip Up
else
while nSkipped != nLines .and. GoPrevLine( oBrw:nHandle, @cLine, oBrw:nFileSize )
ELSE
DO WHILE nSkipped != nLines .AND. GoPrevLine( oBrw:nHandle, @cLine, oBrw:nFileSize )
nSkipped--
end
oBrw:cLine = cLine
endif
ENDDO
oBrw:cLine := cLine
ENDIF
oBrw:nLine += nSkipped
return nSkipped
RETURN nSkipped
static function FReadLn( nHandle, cBuffer )
STATIC FUNCTION FReadLn( nHandle, cBuffer )
local nEOL, ; // End Of Line Postion
nRead, ; // Number of characters read
nSaveFPos // Saved File Postion
LOCAL nEOL // End Of Line Postion
LOCAL nRead // Number of characters read
LOCAL nSaveFPos // Saved File Postion
cBuffer = Space( MAX_LINE_LEN )
cBuffer := Space( MAX_LINE_LEN )
// First save current file pointer
nSaveFPos = FSeek( nHandle, 0, FS_RELATIVE )
nRead = FRead( nHandle, @cBuffer, MAX_LINE_LEN )
nSaveFPos := FSeek( nHandle, 0, FS_RELATIVE )
nRead := FRead( nHandle, @cBuffer, MAX_LINE_LEN )
if ( nEOL := At( Chr( 13 ) + Chr( 10 ), SubStr( cBuffer, 1, nRead ) ) ) == 0 .and. ;
IF ( nEOL := At( Chr( 13 ) + Chr( 10 ), SubStr( cBuffer, 1, nRead ) ) ) == 0 .AND. ;
( nEOL := At( Chr( 10 ), SubStr( cBuffer, 1, nRead ) ) ) == 0
// Line overflow or eof
// ::cLine has the line we need
else
ELSE
// Copy up to EOL
cBuffer = SubStr( cBuffer, 1, nEOL - 1 )
cBuffer := SubStr( cBuffer, 1, nEOL - 1 )
// Position file pointer to next line
FSeek( nHandle, nSaveFPos + nEOL + 1, FS_SET )
endif
ENDIF
return nRead != 0
RETURN nRead != 0
static function GoPrevLine( nHandle, cLine, nFileSize )
STATIC FUNCTION GoPrevLine( nHandle, cLine, nFileSize )
local nOrigPos, ; // Original File Pointer Position
nMaxRead, ; // Maximum Line Length
nNewPos, ; // New File Pointer Position
lMoved, ; // Pointer Moved
cBuff, ; // Line buffer
nWhereCrLf, ; // Position of CRLF
nPrev // Previous File Pointer Position
LOCAL nOrigPos // Original File Pointer Position
LOCAL nMaxRead // Maximum Line Length
LOCAL nNewPos // New File Pointer Position
LOCAL lMoved // Pointer Moved
LOCAL cBuff // Line buffer
LOCAL nWhereCrLf // Position of CRLF
LOCAL nPrev // Previous File Pointer Position
// Save Original file position
nOrigPos := FSEEK( nHandle, 0, FS_RELATIVE )
if nOrigPos == 0
IF nOrigPos == 0
lMoved := FALSE
else
ELSE
lMoved := TRUE
if nOrigPos != nFileSize
IF nOrigPos != nFileSize
// Skip over preceeding CR / LF
FSeek( nHandle, -2, FS_RELATIVE )
endif
ENDIF
nMaxRead := Min( MAX_LINE_LEN, FTELL( nHandle ) )
// Capture the line into a buffer, strip off the CRLF
cBuff := Space( nMaxRead )
nNewPos := FSeek( nHandle, -nMaxRead, FS_RELATIVE )
FRead( nHandle, @cBuff, nMaxRead )
if (nWhereCrLf := RAt( Chr( 13 ) + Chr( 10 ), cBuff ) ) == 0 .and. ;
(nWhereCrLf := RAt( Chr( 10 ), cBuff ) ) == 0
IF ( nWhereCrLf := RAt( Chr( 13 ) + Chr( 10 ), cBuff ) ) == 0 .AND. ;
( nWhereCrLf := RAt( Chr( 10 ), cBuff ) ) == 0
nPrev := nNewPos
cLine = cBuff
else
cLine := cBuff
ELSE
nPrev := nNewPos + nWhereCrLf + 1
cLine := SubStr( cBuff, nWhereCrLf + 2 )
endif
ENDIF
// Move to the beginning of the line
FSeek( nHandle, nPrev, FS_SET )
endif
ENDIF
return lMoved
RETURN lMoved
static function GoNextLine( nHandle, cLine )
STATIC FUNCTION GoNextLine( nHandle, cLine )
local nSavePos,; // Save File pointer position
cBuff := "",; // Line Buffer
lMoved,; // Pointer Moved
nNewPos // New File Pointer Position
LOCAL nSavePos // Save File pointer position
LOCAL cBuff := "" // Line Buffer
LOCAL lMoved // Pointer Moved
LOCAL nNewPos // New File Pointer Position
// Save the file pointer position
nSavePos := FTELL( nHandle )
// Find the end of the current line
FSeek( nHandle, Len( cLine ) + 2, FS_RELATIVE )
nNewPos := FTELL( nHandle )
// Read in the next line
if FReadLn( nHandle, @cBuff )
lMoved := .t.
IF FReadLn( nHandle, @cBuff )
lMoved := .T.
cLine := cBuff
FSeek( nHandle, nNewPos, FS_SET )
else
lMoved := .f.
ELSE
lMoved := .F.
FSeek( nHandle, nSavePos, FS_SET )
endif
ENDIF
return lMoved
RETURN lMoved

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

@@ -549,8 +549,7 @@ STATIC PROCEDURE DispPage( acCopy, alSelect, nTop, nLeft, nNumRows, nPos, nAtTop
DispLine( acCopy[ nIndex ], nRow, nLeft, alSelect[ nIndex ], nIndex == nPos )
ELSE
ColorSelect( CLR_STANDARD )
SetPos( nRow, nLeft )
DispOut( Space( Len( acCopy[ 1 ] ) ) )
DispOutAt( nRow, nLeft, Space( Len( acCopy[ 1 ] ) ) )
ENDIF
NEXT
@@ -565,8 +564,7 @@ STATIC PROCEDURE DispLine( cLine, nRow, nCol, lSelect, lHiLite )
ColorSelect( iif( lSelect, ;
iif( lHiLite, CLR_ENHANCED, CLR_STANDARD ), CLR_UNSELECTED ) )
SetPos( nRow, nCol )
DispOut( cLine )
DispOutAt( nRow, nCol, cLine )
ColorSelect( CLR_STANDARD )

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

@@ -48,8 +48,7 @@ function __AtPrompt( nCol, nRow, cPrompt, cMsg )
aadd( s_aLevel[ s_nPointer ], { nCol, nRow, cPrompt, cMsg } )
// put this prompt on the screen right now
setpos( nCol, nRow )
dispout( cPrompt )
DispOutAt( nCol, nRow, cPrompt )
return .f.
@@ -120,8 +119,7 @@ function __MenuTo( bBlock, cVariable )
if nMsgRow > 0
if ! Empty( xMsg )
setpos( nMsgRow, nMsgCol )
dispout( space( len( xMsg ) ) )
DispOutAt( nMsgRow, nMsgCol, Space( Len( xMsg ) ) )
endif
xMsg := s_aLevel[ s_nPointer - 1, n, 4 ]
@@ -139,8 +137,7 @@ function __MenuTo( bBlock, cVariable )
nMsgCol := int( ( maxcol() - len( xMsg ) ) / 2 )
endif
setpos( nMsgRow, nMsgCol )
dispout( xMsg )
DispOutAt( nMsgRow, nMsgCol, xMsg )
endif
@@ -152,8 +149,9 @@ function __MenuTo( bBlock, cVariable )
endif
// highlight the prompt
setpos( s_aLevel[ s_nPointer - 1, n, 1 ], s_aLevel[ s_nPointer - 1, n, 2 ] )
dispout( s_aLevel[ s_nPointer - 1, n, 3 ] )
DispOutAt( s_aLevel[ s_nPointer - 1, n, 1 ],;
s_aLevel[ s_nPointer - 1, n, 2 ],;
s_aLevel[ s_nPointer - 1, n, 3 ] )
if Set( _SET_INTENSITY )
ColorSelect( CLR_STANDARD )
@@ -216,8 +214,9 @@ function __MenuTo( bBlock, cVariable )
endcase
if n <> 0
setpos( s_aLevel[ s_nPointer - 1, q, 1 ], s_aLevel[ s_nPointer - 1, q, 2 ] )
dispout( s_aLevel[ s_nPointer - 1, q, 3 ] )
DispOutAt( s_aLevel[ s_nPointer - 1, q, 1 ],;
s_aLevel[ s_nPointer - 1, q, 2 ],;
s_aLevel[ s_nPointer - 1, q, 3 ] )
endif
enddo

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

@@ -479,8 +479,7 @@ METHOD ShowScoreboard() CLASS TGetList
nOldCursor = SetCursor( 0 )
nRow = Row()
nCol = Col()
SetPos( SCORE_ROW, SCORE_COL )
DispOut( If( Set( _SET_INSERT ), "Ins", " " ) )
DispOutAt( SCORE_ROW, SCORE_COL, If( Set( _SET_INSERT ), "Ins", " " ) )
SetPos( nRow, nCol )
SetCursor( nOldCursor )
endif
@@ -497,15 +496,13 @@ METHOD DateMsg() CLASS TGetList
nRow := Row()
nCol := Col()
SetPos( SCORE_ROW, SCORE_COL )
DispOut( "Invalid date" )
DispOutAt( SCORE_ROW, SCORE_COL, "Invalid date" )
SetPos( nRow, nCol )
do while NextKey() == 0
enddo
SetPos( SCORE_ROW, SCORE_COL )
DispOut( Space( Len( "Invalid date" ) ) )
DispOutAt( SCORE_ROW, SCORE_COL, Space( Len( "Invalid date" ) ) )
SetPos( nRow, nCol )
endif

1
harbour/tests/fortest.prg
View File

@@ -18,6 +18,7 @@ static snStep
function Main()
local array
local tmp, n
QOut( "Testing Harbour For Next loops." )

10
harbour/tests/memfile.prg
View File

@@ -4,6 +4,16 @@
/* ; Donated to the public domain by Victor Szel <info@szelvesz.hu> */
MEMVAR mcString
MEMVAR mnDouble
MEMVAR mnDoubleH
MEMVAR mnInt
MEMVAR mnLong
MEMVAR mdDate
MEMVAR mlLogicalT
MEMVAR mlLogicalF
MEMVAR mxStayHere
FUNCTION Main()
PRIVATE mcString := "This is a" + Chr(0) + "string to save."
PRIVATE mnDouble := 100.0000