/*
 * $Id$
 */

/*
 * Harbour Project source code:
 * The Debugger
 *
 * Copyright 1999 Antonio Linares <alinares@fivetech.com>
 * 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 "hbclass.ch"
#include "hbmemvar.ch"
#include "box.ch"
#include "inkey.ch"
#include "common.ch"

#xcommand MENU [<oMenu>] => [ <oMenu> := ] TDbMenu():New()
#xcommand MENUITEM <cPrompt> [ ACTION <uAction,...> ] => ;
   TDbMenu():AddItem( TDbMenuItem():New( <cPrompt> [,{|Self|<uAction>}] ) )
#xcommand SEPARATOR => TDbMenu():AddItem( TDbMenuItem():New( "-" ) )
#xcommand ENDMENU => ATail( TDbMenu():aMenus ):Build()

static s_oDebugger
static s_lExit := .F.

function __dbgEntry( uParam1, uParam2 )  // debugger entry point

   do case
      case ValType( uParam1 ) == "C"   // called from hvm.c hb_vmModuleName()
           if ! s_lExit
              if s_oDebugger == nil
                 s_oDebugger = TDebugger():New()
                 s_oDebugger:Activate( uParam1 )
              else
                 s_oDebugger:ShowCode( uParam1 )
              endif
           endif

      case ValType( uParam1 ) == "N"   // called from hvm.c hb_vmDebuggerShowLines()
           if s_oDebugger != nil
              if PCount() == 2 // called from hvm.c hb_vmDebuggerLocalName()
                 AAdd( s_oDebugger:aVars, { uParam2, "Local", uParam1 } )
                 if s_oDebugger:oBrwVars != nil
                    s_oDebugger:oBrwVars:RefreshAll()
                 endif
                 return nil
              endif
              if s_oDebugger:lGo
                 s_oDebugger:lGo = ! s_oDebugger:IsBreakPoint( uParam1 )
              endif
              if s_oDebugger:lGo
                 DispBegin()
                 DispBegin()
                 s_oDebugger:SaveAppStatus()
                 s_oDebugger:RestoreAppStatus()
                 DispEnd()
                 DispEnd()
              else
                 s_oDebugger:SaveAppStatus()
                 s_oDebugger:GoToLine( uParam1 )
                 s_oDebugger:HandleEvent()
              endif
           endif

      otherwise   // called from hvm.c hb_vmDebuggerEndProc()
         if s_oDebugger != nil
            s_oDebugger:EndProc()
         endif
   endcase

return nil

CLASS TDebugger

   DATA   aWindows, nCurrentWindow
   DATA   oPullDown
   DATA   oWndCode, oWndCommand, oWndStack, oWndVars
   DATA   oBar, oBrwText, cPrgName, oBrwStack, oBrwVars, aVars
   DATA   cImage
   DATA   lEnd
   DATA   cAppImage, nAppRow, nAppCol, cAppColors, nAppCursor
   DATA   aBreakPoints, aCallStack
   DATA   lGo

   METHOD New()
   METHOD Activate( cModuleName )
   METHOD EndProc()
   METHOD Exit() INLINE ::lEnd := .t.
   METHOD Go() INLINE ::RestoreAppStatus(), ::lGo := .t., DispEnd(), ::Exit()
   METHOD GoToLine( nLine )
   METHOD HandleEvent()
   METHOD Hide()
   METHOD InputBox( cMsg, uValue )
   METHOD IsBreakPoint( nLine )
   METHOD NextWindow()
   METHOD Open()
   METHOD PrevWindow()
   METHOD RestoreAppStatus()
   METHOD SaveAppStatus()
   METHOD Show()
   METHOD ShowAppScreen()
   METHOD ShowCallStack()
   METHOD ShowCode( cModuleName )
   METHOD ShowVars()
   METHOD ToggleBreakPoint()

ENDCLASS

METHOD New() CLASS TDebugger

   ::aWindows       = {}
   ::nCurrentWindow = 1
   ::oPullDown      = BuildMenu( Self )
   ::oWndCode       = TDbWindow():New( 1, 0, MaxRow() - 6, MaxCol(),, "BG+/B" )
   ::oWndCommand    = TDbWindow():New( MaxRow() - 5, 0, MaxRow() - 1, MaxCol(),;
                                       "Command", "BG+/B" )
   ::lEnd           = .f.
   ::aBreakPoints   = {}
   ::aCallStack     = {}
   ::lGo            = .f.
   ::aVars          = {}

   AAdd( ::aWindows, ::oWndCode )
   AAdd( ::aWindows, ::oWndCommand )

   ::oWndCode:bKeyPressed = { | nKey | If( nKey == K_DOWN, ( ::oBrwText:Down(),;
      ::oBrwText:ForceStable() ), nil ), If( nKey == K_UP, ( ::oBrwText:Up(),;
      ::oBrwText:ForceStable() ), nil ) }

return Self

METHOD Activate( cModuleName ) CLASS TDebugger

   ::Show()
   ::ShowCode( cModuleName )
   ::ShowCallStack()
   ::ShowVars()
   ::RestoreAppStatus()

return nil

METHOD EndProc() CLASS TDebugger

   if Len( ::aCallStack ) > 1
      ADel( ::aCallStack, 1 )
      ASize( ::aCallStack, Len( ::aCallStack ) - 1 )
      if ::oBrwStack != nil
         ::oBrwStack:RefreshAll()
      endif
   endif

return nil

METHOD HandleEvent() CLASS TDebugger

   local nPopup, oWnd
   local nKey

   ::lEnd = .f.

   while ! ::lEnd

      nKey = InKey( 0 )

      do case
         case ::oPullDown:IsOpen()
              ::oPullDown:ProcessKey( nKey )

         case nKey == K_ESC
              ::RestoreAppStatus()
              s_oDebugger := nil
              s_lExit := .T.
              DispEnd()
              ::Exit()

         case nKey == K_UP
              oWnd = ::aWindows[ ::nCurrentWindow ]
              oWnd:KeyPressed( K_UP )

         case nKey == K_DOWN
              oWnd = ::aWindows[ ::nCurrentWindow ]
              oWnd:KeyPressed( K_DOWN )

         case nKey == K_HOME
              ::oBrwText:GoTop()
              ::oBrwText:ForceStable()

         case nKey == K_END
              ::oBrwText:GoBottom()
              ::oBrwText:ForceStable()

         case nKey == K_F4
              ::ShowAppScreen()

         case nKey == K_F5
              ::Go()

         case nKey == K_F8
              ::RestoreAppStatus()
              ::Exit()

         case nKey == K_F9
              ::ToggleBreakPoint()

         case nKey == K_TAB
              ::NextWindow()

         case nKey == K_SH_TAB
              ::PrevWindow()

         otherwise
              if ( nPopup := ::oPullDown:GetHotKeyPos( AltToKey( nKey ) ) ) != 0
                 ::oPullDown:ShowPopup( nPopup )
              endif
      endcase
   end

return nil

METHOD Hide() CLASS TDebugger

   RestScreen( ,,,, ::cAppImage )
   ::cAppImage = nil
   SetColor( ::cAppColors )
   SetCursor( ::nAppCursor )

return nil

METHOD NextWindow() CLASS TDebugger

   local oWnd

   if Len( ::aWindows ) > 0
      oWnd = ::aWindows[ ::nCurrentWindow++ ]
      oWnd:SetFocus( .f. )
      if ::nCurrentWindow > Len( ::aWindows )
         ::nCurrentWindow = 1
      endif
      oWnd = ::aWindows[ ::nCurrentWindow ]
      oWnd:SetFocus( .t. )
   endif

return nil

METHOD PrevWindow() CLASS TDebugger

   local oWnd

   if Len( ::aWindows ) > 0
      oWnd = ::aWindows[ ::nCurrentWindow-- ]
      oWnd:SetFocus( .f. )
      if ::nCurrentWindow < 1
         ::nCurrentWindow = Len( ::aWindows )
      endif
      oWnd = ::aWindows[ ::nCurrentWindow ]
      oWnd:SetFocus( .t. )
   endif

return nil

METHOD Show() CLASS TDebugger

   ::cAppImage  = SaveScreen()
   ::nAppRow    = Row()
   ::nAppCol    = Col()
   ::cAppColors = SetColor()
   ::nAppCursor = SetCursor( 0 )

   ::oPullDown:Display()
   ::oWndCode:Show( .t. )
   ::oWndCommand:Show()

   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"

return nil

METHOD ShowAppScreen() CLASS TDebugger

   ::cImage = SaveScreen()
   RestScreen( 0, 0, MaxRow(), MaxCol(), ::cAppImage )
   InKey( 0 )
   RestScreen( 0, 0, MaxRow(), MaxCol(), ::cImage )

return nil

METHOD ShowCallStack() CLASS TDebugger

   local n := 1

   if ::oWndStack == nil
      ::oWndCode:nRight -= 16
      ::oBrwText:nRight -= 16
      ::oBrwText:aColumns[ 1 ]:Width -= 16
      ::oWndCode:SetFocus( .t. )
      ::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,;
                             n := If( nSkip > 0, Min( Len( ::aCallStack ), n + nSkip ),;
                             Max( 1, n + nSkip )), n - nPos }

      ::oBrwStack:AddColumn( TBColumnNew( "",  { || PadC( ::aCallStack[ n ], 14 ) } ) )
      ::oBrwStack:ForceStable()
   endif

return nil

METHOD ShowVars() CLASS TDebugger

   local n := 1
   local nWidth
   local nCount, i, xValue, cName

   if ::oWndVars == nil
      ::oWndCode:nTop += 5
      ::oBrwText:nTop += 5
      ::oBrwText:RefreshAll()
      ::oWndCode:SetFocus( .t. )
      ::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(),;
      ::oBrwVars:ForceStable() ), nil ), If( nKey == K_UP, ( ::oBrwVars:Up(),;
      ::oBrwVars:ForceStable() ), nil ) }

      nCount = __mvDBGINFO( MV_PUBLIC )
      for i = 1 to nCount
         xValue = __mvDBGINFO( MV_PUBLIC, i, @cName )
         AAdd( ::aVars, { cName, "Public" } )
      next
      nCount = __mvDBGINFO( MV_PRIVATE )
      for i = 1 to nCount
         xValue = __mvDBGINFO( MV_PRIVATE, i, @cName )
         AAdd( ::aVars, { cName, "Private" } )
      next

      ::oBrwVars = TBrowseNew( 2, 1, 4, MaxCol() - If( ::oWndStack != nil,;
                               ::oWndStack:nWidth(), 0 ) - 1 )
      ::oBrwVars:ColorSpec = "BG+/B, N/BG"
      ::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
      ::oBrwVars:AddColumn( TBColumnNew( "",  { || AllTrim( Str( n ) ) + ") " + ;
         PadR( ::aVars[ n ][ 1 ] + " <" + ::aVars[ n ][ 2 ] + ", " + ;
         If( ::aVars[ n ][ 2 ] == "Local", ValType( __vmVarLGet( 6, ::aVars[ n ][ 3 ] ) ),;
         "" ) + ">:" + If( ::aVars[ n ][ 2 ] == "Local",;
         " Class " + __vmVarLGet( 6, ::aVars[ n ][ 3 ] ):ClassName(), "" ),;
         ::oWndVars:nWidth() - 5 ) } ) )
      ::oBrwVars:ForceStable()
   endif

return nil

static function CompareLine( Self )

return { | a | a[ 1 ] == Self:oBrwText:nLine }

METHOD ShowCode( cModuleName ) CLASS TDebugger

   local cFunction := SubStr( cModuleName, At( ":", cModuleName ) + 1 )
   local cPrgName  := SubStr( cModuleName, 1, At( ":", cModuleName ) - 1 )

   ASize( ::aCallStack, Len( ::aCallStack ) + 1 )
   AIns( ::aCallStack, 1 )
   if Len( ::aCallStack ) == 1
      ::aCallStack[ 1 ] = ProcName( 3 ) // cFunction
   else
      ::aCallStack[ 1 ] = ProcName( 2 ) // cFunction
   endif

   if ::oWndStack != nil
      ::oBrwStack:RefreshAll()
   endif

   if cPrgName != ::cPrgName
      ::cPrgName := cPrgName
      ::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,;
         CompareLine( Self ) ) != 0, { 3, 4 }, { 1, 2 } ) }

      ::oBrwText:ForceStable()
      ::oWndCode:SetCaption( ::cPrgName )
   endif

return nil

METHOD Open() CLASS TDebugger

   local cFileName := ::InputBox( "Please enter the filename", Space( 30 ) )

return nil

METHOD InputBox( cMsg, uValue ) CLASS TDebugger

   local nTop    := ( MaxRow() / 2 ) - 5
   local nLeft   := ( MaxCol() / 2 ) - 20
   local nBottom := ( MaxRow() / 2 ) - 3
   local nRight  := ( MaxCol() / 2 ) + 20
   local uTemp   := uValue
   local GetList := {}
   local nOldCursor
   local cImage := SaveScreen( nTop, nLeft, nBottom + 1, nRight + 1 )
   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
   __Shadow( nTop, nLeft, nBottom, nRight )

   @ nTop + 1, nLeft + 1 GET uTemp
   nOldCursor = SetCursor( 1 )
   READ
   SetCursor( nOldCursor )
   RestScreen( nTop, nLeft, nBottom + 1, nRight + 1, cImage )
   Set( _SET_SCOREBOARD, lScoreBoard )

return If( LastKey() != K_ESC, uTemp, uValue )

METHOD IsBreakPoint( nLine ) CLASS TDebugger

return AScan( ::aBreakPoints, { | aBreak | aBreak[ 1 ] == nLine } ) != 0

METHOD GotoLine( nLine ) CLASS TDebugger

   ::oBrwText:GotoLine( nLine )

   if ::oBrwVars != nil .and. ! ::oBrwVars:Stable
      ::oBrwVars:ForceStable()
   endif

   if ::oBrwStack != nil .and. ! ::oBrwStack:Stable
      ::oBrwStack:ForceStable()
   endif

return nil

METHOD RestoreAppStatus() CLASS TDebugger

   ::cImage = SaveScreen()
   DispBegin()
   RestScreen( 0, 0, MaxRow(), MaxCol(), ::cAppImage )
   SetPos( ::nAppRow, ::nAppCol )
   SetColor( ::cAppColors )
   SetCursor( ::nAppCursor )

return nil

METHOD SaveAppStatus() CLASS TDebugger

   ::cAppImage  = SaveScreen()
   ::nAppRow    = Row()
   ::nAppCol    = Col()
   ::cAppColors = SetColor()
   ::nAppCursor = SetCursor()
   RestScreen( 0, 0, MaxRow(), MaxCol(), ::cImage )
   SetCursor( 0 )
   DispEnd()

return nil

METHOD ToggleBreakPoint() CLASS TDebugger

   local nAt := AScan( ::aBreakPoints, { | aBreak | aBreak[ 1 ] == ;
                       ::oBrwText:nLine } )

   if nAt == 0
      AAdd( ::aBreakPoints, { ::oBrwText:nLine, ::cPrgName } )
   else
      ADel( ::aBreakPoints, nAt )
      ASize( ::aBreakPoints, Len( ::aBreakPoints ) - 1 )
   endif

   ::oBrwText:RefreshCurrent()
   ::oBrwText:ForceStable()

return nil

CLASS TDbWindow  // Debugger windows

   DATA   nTop, nLeft, nBottom, nRight
   DATA   cCaption
   DATA   cBackImage, cColor
   DATA   lFocused, bGotFocus
   DATA   bKeyPressed

   METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor )
   METHOD nWidth() INLINE ::nRight - ::nLeft + 1
   METHOD SetCaption( cCaption )
   METHOD SetFocus( lOnOff )
   METHOD Show( lFocused )
   METHOD Move()
   METHOD KeyPressed( nKey )

ENDCLASS

METHOD New( nTop, nLeft, nBottom, nRight, cCaption, cColor ) CLASS TDbWindow

   ::nTop     = nTop
   ::nLeft    = nLeft
   ::nBottom  = nBottom
   ::nRight   = nRight
   ::cCaption = cCaption
   ::cColor   = cColor

return Self

METHOD SetCaption( cCaption ) CLASS TDbWindow

   ::cCaption = cCaption

   if ! Empty( cCaption )
      @ ::nTop, ( ( ::nRight - ::nLeft ) / 2 ) - ;
     ( Len( cCaption ) + 2 ) / 2 SAY " " + cCaption + " " COLOR ::cColor
   endif

return nil

METHOD SetFocus( lOnOff ) CLASS TDbWindow

   DispBegin()

   ::lFocused = lOnOff

   @ ::nTop, ::nLeft, ::nBottom, ::nRight BOX If( lOnOff, B_DOUBLE, B_SINGLE ) ;
      COLOR ::cColor

   if ! Empty( ::cCaption )
      @ ::nTop, ::nLeft + ( ::nRight - ::nLeft ) / 2 - Len( ::cCaption ) / 2 ;
         SAY " " + ::cCaption + " " COLOR ::cColor
   endif

   DispEnd()

   if lOnOff .and. ::bGotFocus != nil
      Eval( ::bGotFocus, Self )
   endif

return nil

METHOD Show( lFocused ) CLASS TDbWindow

   DEFAULT lFocused TO .f.

   ::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom, ::nRight )
   SetColor( ::cColor )
   SCROLL( ::nTop, ::nLeft, ::nBottom, ::nRight )
   ::SetFocus( lFocused )

return nil

/*Method move()
Move a window across the screen
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

   while .t.
      restscreen(,,,, ::cbackimage)
      dispbox(::ntop,::nleft,::nright,::nbottom,pbar1)
      nkey=inkey(0)
      do case
         case nkey==K_UP
              if(::ntop != 0,(::ntop--,::nbottom--),nil)

         case nkey==K_DOWN
              if(::nbottom != maxrow(),(::ntop++,::nbottom++),nil)

         case nkey==K_LEFT
              if(::nleft != 0,(::nleft--,::nright--),nil)

         case nkey==K_RIGHT
              if(::nbottom != maxrow(),(::nleft++,::nright++),nil)

         case nkey==K_ESC
              ::ntop := noldtop
              ::nleft := noldleft
              ::nbottom := noldbottom
              ::nright := noldright
      endcase

      if ( nkey==K_ESC .or. nkey==K_ENTER)
         exit
      end
   end

   // __keyboard(chr(0)),inkey())

return nil

METHOD KeyPressed( nKey ) CLASS TDbWindow

   if ::bKeyPressed != nil
      Eval( ::bKeyPressed, nKey, Self )
   endif

return nil

CLASS TDbMenu  /* debugger menu */

   CLASSDATA aMenus

   DATA   nTop, nLeft, nBottom, nRight
   DATA   aItems
   DATA   cClrHilite, cClrHotKey, cClrHotFocus, cClrPopup
   DATA   nOpenPopup             // zero if no popup is shown
   DATA   lPopup
   DATA   cBackImage

   METHOD New( aItems )
   METHOD AddItem( oMenuItem )
   METHOD Build()
   METHOD ClosePopup()
   METHOD Close() INLINE ::ClosePopup( ::nOpenPopup ), ::nOpenPopup := 0
   METHOD DeHilite()
   METHOD Display()
   METHOD EvalAction()
   METHOD GetHotKeyPos( nKey )
   METHOD GoBottom()
   METHOD GoDown() INLINE ::aItems[ ::nOpenPopup ]:bAction:GoRight()
   METHOD GoLeft()
   METHOD GoRight()
   METHOD GoTop()
   METHOD GoUp() INLINE ::aItems[ ::nOpenPopup ]:bAction:GoLeft()
   METHOD IsOpen() INLINE ::nOpenPopup != 0
   METHOD ProcessKey( nKey )
   METHOD ShowPopup( nPopup )

ENDCLASS

METHOD New() CLASS TDbMenu

   local nCol := 0

   if ::aMenus == nil
      ::aMenus = {}
      ::lPopup = .f.
   else
      ::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

   AAdd( ::aMenus, Self )

return Self

METHOD AddItem( oMenuItem ) CLASS TDbMenu

   local oLastMenu := ATail( ::aMenus ), oLastMenuItem

   if oLastMenu:lPopup
      oMenuItem:nRow = Len( oLastMenu:aItems )
      oMenuItem:nCol = oLastMenu:nLeft + 1
   else
      oMenuItem:nRow = 0
      if Len( oLastMenu:aItems ) > 0
         oLastMenuItem = ATail( oLastMenu:aItems )
         oMenuItem:nCol = oLastMenuItem:nCol + ;
                          Len( StrTran( oLastMenuItem:cPrompt, "&", "" ) )
      else
         oMenuItem:nCol = 0
      endif
   endif

   AAdd( ATail( ::aMenus ):aItems, oMenuItem )

return oMenuItem

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
         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 )
      next
      ::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 )
         endif
      next
      ATail( ::aMenus[ Len( ::aMenus ) - 1 ]:aItems ):bAction = ATail( ::aMenus )
      ::aMenus = ASize( ::aMenus, Len( ::aMenus ) - 1 )
   endif

return nil

METHOD ClosePopup( nPopup ) CLASS TDbMenu

   local oPopup
   local nAt

   // dispbegin()
   if nPopup != 0
      oPopup = ::aItems[ nPopup ]:bAction
      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

      @ 0, ::aItems[ nPopup ]:nCol + nAt := At( "&", ::aItems[ nPopup ]:cPrompt ) - 1 SAY ;
        SubStr( ::aItems[ nPopup ]:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotKey
   endif
   // dispend()

return nil

METHOD DeHilite() CLASS TDbMenu

   local oMenuItem := ::aItems[ ::nOpenPopup ]

   oMenuItem:Display( ::cClrPopup, ::cClrHotKey )

return nil

METHOD Display() CLASS TDbMenu

   local n, nAt

   SetColor( ::cClrPopup )

   // DispBegin()
   if ! ::lPopup
      @ 0, 0 SAY Space( MaxCol() + 1 ) COLOR ::cClrPopup
      DevPos( 0, 0 )
   else
      ::cBackImage = SaveScreen( ::nTop, ::nLeft, ::nBottom + 1, ::nRight + 1 )
      @ ::nTop, ::nLeft, ::nBottom, ::nRight BOX B_SINGLE
      __Shadow( ::nTop, ::nLeft, ::nBottom, ::nRight )
   endif

   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 )
      else
         @ ::aItems[ n ]:nRow, ::aItems[ n ]:nCol SAY ;
            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
      endif
   next
   // DispEnd()

return nil

METHOD EvalAction() CLASS TDbMenu

   local oPopup, oMenuItem

   oPopup = ::aItems[ ::nOpenPopup ]:bAction
   oMenuItem = oPopup:aItems[ oPopup:nOpenPopup ]

   if oMenuItem:bAction != nil
      ::Close()
      Eval( oMenuItem:bAction, oMenuItem )
   endif

return nil

METHOD GetHotKeyPos( cKey ) CLASS TDbMenu

   local n

   for n = 1 to Len( ::aItems )
      if Upper( SubStr( ::aItems[ n ]:cPrompt,;
         At( "&", ::aItems[ n ]:cPrompt ) + 1, 1 ) ) == cKey
         return n
      endif
   next

return 0

return .f.

METHOD GoBottom() CLASS TDbMenu

   local oPopup

   if ::IsOpen()
      oPopup = ::aItems[ ::nOpenPopup ]:bAction
      oPopup:DeHilite()
      oPopup:ShowPopup( Len( oPopup:aItems ) )
   endif

return nil

METHOD GoLeft() CLASS TDbMenu

   local oMenuItem := ::aItems[ ::nOpenPopup ]
   local nAt

   // DispBegin()
   if ::nOpenPopup != 0
      if ! ::lPopup
         ::ClosePopup( ::nOpenPopup )
      else
         SetColor( ::cClrPopup )
         @ oMenuItem:nRow, oMenuItem:nCol SAY ;
            StrTran( oMenuItem:cPrompt, "&", "" )

         @ oMenuItem:nRow, oMenuItem:nCol + nAt := ;
            At( "&", oMenuItem:cPrompt ) - 1 SAY ;
            SubStr( oMenuItem:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotKey
      endif
      if ::nOpenPopup > 1
         --::nOpenPopup
         while ::nOpenPopup > 1 .and. ;
            SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-"
            --::nOpenPopup
         end
         ::ShowPopup( ::nOpenPopup )
      else
         ::ShowPopup( ::nOpenPopup := Len( ::aItems ) )
      endif
   endif
   // DispEnd()

return nil

METHOD GoRight() CLASS TDbMenu

   local oMenuItem := ::aItems[ ::nOpenPopup ]
   local nAt

   // DispBegin()
   if ::nOpenPopup != 0
      if ! ::lPopup
         ::ClosePopup( ::nOpenPopup )
      else
         SetColor( ::cClrPopup )
         @ oMenuItem:nRow, oMenuItem:nCol SAY ;
            StrTran( oMenuItem:cPrompt, "&", "" )

         @ oMenuItem:nRow, oMenuItem:nCol + nAt := ;
            At( "&", oMenuItem:cPrompt ) - 1 SAY ;
            SubStr( oMenuItem:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotKey
      endif
      if ::nOpenPopup < Len( ::aItems )
         ++::nOpenPopup
         while ::nOpenPopup < Len( ::aItems ) .and. ;
            SubStr( ::aItems[ ::nOpenPopup ]:cPrompt, 1, 1 ) == "-"
            ++::nOpenPopup
         end
         ::ShowPopup( ::nOpenPopup )
      else
         ::ShowPopup( ::nOpenPopup := 1 )
      endif
   endif
   // DispEnd()

return nil

METHOD GoTop() CLASS TDbMenu

   local oPopup

   if ::IsOpen()
      oPopup = ::aItems[ ::nOpenPopup ]:bAction
      oPopup:DeHilite()
      oPopup:ShowPopup( 1 )
   endif

return nil

METHOD ShowPopup( nPopup ) CLASS TDbMenu

   local nAt, oMenuItem

   if ! ::lPopup
      @ 0, ::aItems[ nPopup ]:nCol SAY ;
        StrTran( ::aItems[ nPopup ]:cPrompt, "&", "" ) COLOR ::cClrHilite

      @ 0, ::aItems[ nPopup ]:nCol + nAt := At( "&", ::aItems[ nPopup ]:cPrompt ) - 1 SAY ;
        SubStr( ::aItems[ nPopup ]:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotFocus
   else
      oMenuItem = ::aItems[ nPopup ]
      @ oMenuItem:nRow, oMenuItem:nCol SAY ;
        StrTran( oMenuItem:cPrompt, "&", "" ) COLOR ::cClrHilite

      @ oMenuItem:nRow, oMenuItem:nCol + nAt := ;
        At( "&", oMenuItem:cPrompt ) - 1 SAY ;
        SubStr( oMenuItem:cPrompt, nAt + 2, 1 ) COLOR ::cClrHotFocus
   endif

   ::nOpenPopup = nPopup

   if ValType( ::aItems[ nPopup ]:bAction ) == "O"
      ::aItems[ nPopup ]:bAction:Display()
      ::aItems[ nPopup ]:bAction:ShowPopup( 1 )
   endif

return nil

METHOD ProcessKey( nKey ) CLASS TDbMenu

   local nPopup

   do case
      case nKey == K_ESC
           ::Close()

      case nKey == K_LEFT
           ::GoLeft()

      case nKey == K_RIGHT
           ::GoRight()

      case nKey == K_DOWN
           ::GoDown()

      case nKey == K_UP
           ::GoUp()

      case nKey == K_ENTER
           ::EvalAction()

      case nKey == K_HOME
           ::GoTop()

      case nKey == K_END
           ::GoBottom()

      otherwise
         if ( nPopup := ::GetHotKeyPos( AltToKey( nKey ) ) ) != 0
            ::Close()
            ::ShowPopup( nPopup )
         endif
   endcase

return nil

CLASS TDbMenuItem

   DATA  nRow, nCol
   DATA  cPrompt
   DATA  bAction

   METHOD New( cPrompt, bAction )
   METHOD Display( cClrText, cClrHotKey )

ENDCLASS

METHOD New( cPrompt, bAction ) CLASS TDbMenuItem

   ::cPrompt = cPrompt
   ::bAction = bAction

return Self

METHOD Display( cClrText, cClrHotKey ) CLASS TDbMenuItem

   local nAt

   @ ::nRow, ::nCol SAY ;
      StrTran( ::cPrompt, "&", "" ) COLOR cClrText

   @ ::nRow, ::nCol + nAt := ;
      At( "&", ::cPrompt ) - 1 SAY ;
      SubStr( ::cPrompt, nAt + 2, 1 ) COLOR cClrHotKey

return nil

static function AltToKey( nKey )

   local nIndex := AScan( { K_ALT_A, K_ALT_B, K_ALT_C, K_ALT_D, K_ALT_E, K_ALT_F,;
                            K_ALT_G, K_ALT_H, K_ALT_I, K_ALT_J, K_ALT_K, K_ALT_L,;
                            K_ALT_M, K_ALT_N, K_ALT_O, K_ALT_P, K_ALT_Q, K_ALT_R,;
                            K_ALT_S, K_ALT_T, K_ALT_U, K_ALT_V, K_ALT_W, K_ALT_X,;
                            K_ALT_Y, K_ALT_Z }, nKey )
   local cKey

      if nIndex > 0
         cKey := SubStr( "ABCDEFGHIJKLMNOPQRSTUVWXYZ", nIndex, 1 )
      else
         cKey = ""
      endif

return cKey

function BuildMenu( oDebugger )  // Builds the debugger pulldown menu

   local oMenu

   MENU oMenu
      MENUITEM " &File "
      MENU
         MENUITEM " &Open..."        ACTION oDebugger:Open()
         MENUITEM " &Resume"         ACTION Alert( "Not implemented yet!" )
         MENUITEM " &Shell"          ACTION Alert( "Not implemented yet!" )
         SEPARATOR
         MENUITEM " &Exit  Alt-X  "  ACTION oDebugger:Exit(), oDebugger:Hide()
      ENDMENU

      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!" )
         SEPARATOR
         MENUITEM " &Case sensitive " ACTION Alert( "Not implemented yet!" )
      ENDMENU

      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()
         SEPARATOR
         MENUITEM " &CallStack"       ACTION oDebugger:ShowCallStack()
      ENDMENU

      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!" )
         SEPARATOR
         MENUITEM " S&peed..."              ACTION Alert( "Not implemented yet!" )
      ENDMENU

      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!" )
      ENDMENU

      MENUITEM " &Monitor "
      MENU
         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!" )
      ENDMENU

      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!" )
         SEPARATOR
         MENUITEM " &Save settings..."      ACTION Alert( "Not implemented yet!" )
         MENUITEM " &Restore settings... "  ACTION Alert( "Not implemented yet!" )
      ENDMENU

      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!" )
         SEPARATOR
         MENUITEM " &Tile"                  ACTION Alert( "Not implemented yet!" )
      ENDMENU

      MENUITEM " &Help "
      MENU
         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!" )
      ENDMENU

   ENDMENU

return oMenu

Function AltD()
   s_lExit := .F.
return NIL