diff --git a/harbour/ChangeLog b/harbour/ChangeLog index a9395e4321..29a677a6b4 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,27 @@ +19991021-23:33 GMT+1 Victor Szel + * 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 * source/rtl/gtapi.c ! hb_gtSetColorStr() now resets the ColorSelect() value to STANDARD, diff --git a/harbour/config/rules.cf b/harbour/config/rules.cf index d6b6efb5e7..7897922bff 100644 --- a/harbour/config/rules.cf +++ b/harbour/config/rules.cf @@ -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),) diff --git a/harbour/source/debug/debugger.prg b/harbour/source/debug/debugger.prg index 90b4bcc350..c94ffa7fa0 100644 --- a/harbour/source/debug/debugger.prg +++ b/harbour/source/debug/debugger.prg @@ -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 diff --git a/harbour/source/debug/tbrwtext.prg b/harbour/source/debug/tbrwtext.prg index f81de3e48e..3c8136c34e 100644 --- a/harbour/source/debug/tbrwtext.prg +++ b/harbour/source/debug/tbrwtext.prg @@ -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 diff --git a/harbour/source/rtl/achoice.prg b/harbour/source/rtl/achoice.prg index a733c57fa0..fd511d4410 100644 --- a/harbour/source/rtl/achoice.prg +++ b/harbour/source/rtl/achoice.prg @@ -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 ) diff --git a/harbour/source/rtl/menuto.prg b/harbour/source/rtl/menuto.prg index 02d58b9c1c..6b90bea203 100644 --- a/harbour/source/rtl/menuto.prg +++ b/harbour/source/rtl/menuto.prg @@ -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 diff --git a/harbour/source/rtl/tgetlist.prg b/harbour/source/rtl/tgetlist.prg index 9aca7a546a..95fae20e24 100644 --- a/harbour/source/rtl/tgetlist.prg +++ b/harbour/source/rtl/tgetlist.prg @@ -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 diff --git a/harbour/tests/fortest.prg b/harbour/tests/fortest.prg index c489422194..bf38be639d 100644 --- a/harbour/tests/fortest.prg +++ b/harbour/tests/fortest.prg @@ -18,6 +18,7 @@ static snStep function Main() local array + local tmp, n QOut( "Testing Harbour For Next loops." ) diff --git a/harbour/tests/memfile.prg b/harbour/tests/memfile.prg index e156dd2c5c..aa6d2d9cc0 100644 --- a/harbour/tests/memfile.prg +++ b/harbour/tests/memfile.prg @@ -4,6 +4,16 @@ /* ; Donated to the public domain by Victor Szel */ +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