- Compiler: PP → Lexer → Parser → Analyzer → Gengo pipeline - Parser: 232/236 (98%) Harbour compatibility, registry-based dispatch - RTL: 351 Harbour-compatible functions - RDD: DBF/NTX/CDX engines with Rushmore bitmap optimization - Go Interop: IMPORT + pkg.Func() + obj:Method() with FastPath (15M calls/sec) - HB_FUNC API: Full Harbour C API compatible Go bridge - Concurrency: SPAWN/LAUNCH/GOROUTINE, <-, WATCH, PARALLEL FOR, ASYNC/AWAIT - Extensions: Multi-return, DEFER, Slice, f-string, Nil-safe ?:, CONST - Macro Compiler: Runtime AST parsing and evaluation - Debugger: TUI debugger with source display, breakpoints, stepping - FRB: Native + Pcode dual mode runtime binary - Tests: 13 packages ALL PASS Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
397 lines
8.7 KiB
Plaintext
397 lines
8.7 KiB
Plaintext
// Five TBrowse — ported from Harbour src/rtl/tbrowse.prg
|
|
// Minimal implementation for dbEdit functionality
|
|
// Full Harbour TBrowse: 2719 lines — this is the essential core
|
|
|
|
// ============================================================
|
|
// TBColumn class
|
|
// ============================================================
|
|
CLASS TBColumn
|
|
DATA cHeading INIT ""
|
|
DATA bBlock INIT NIL
|
|
DATA cColSep INIT ""
|
|
DATA cHeadSep INIT ""
|
|
DATA cFootSep INIT ""
|
|
DATA cFooting INIT ""
|
|
DATA nWidth INIT 0
|
|
DATA cPicture INIT ""
|
|
|
|
METHOD Init(cHeading, bBlock)
|
|
ENDCLASS
|
|
|
|
METHOD Init(cHeading, bBlock) CLASS TBColumn
|
|
::cHeading := cHeading
|
|
::bBlock := bBlock
|
|
RETURN Self
|
|
|
|
// Constructor function
|
|
FUNCTION TBColumnNew(cHeading, bBlock)
|
|
RETURN TBColumn():Init(cHeading, bBlock)
|
|
|
|
// ============================================================
|
|
// TBrowse class
|
|
// ============================================================
|
|
CLASS TBrowse
|
|
DATA nTop INIT 0
|
|
DATA nLeft INIT 0
|
|
DATA nBottom INIT 24
|
|
DATA nRight INIT 79
|
|
|
|
DATA aColumns INIT {}
|
|
DATA nColPos INIT 1
|
|
DATA nRowPos INIT 1
|
|
DATA nRowCount INIT 0
|
|
DATA nColOffset INIT 1
|
|
|
|
DATA bSkipBlock INIT NIL
|
|
DATA bGoTopBlock INIT NIL
|
|
DATA bGoBottomBlock INIT NIL
|
|
|
|
DATA cHeadSep INIT ""
|
|
DATA cColSep INIT ""
|
|
DATA cFootSep INIT ""
|
|
DATA cColorSpec INIT ""
|
|
|
|
DATA lStable INIT .F.
|
|
DATA lHitTop INIT .F.
|
|
DATA lHitBottom INIT .F.
|
|
DATA lAutoLite INIT .T.
|
|
DATA lConfigured INIT .F.
|
|
|
|
METHOD Init(nTop, nLeft, nBottom, nRight)
|
|
METHOD addColumn(oCol)
|
|
METHOD getColumn(n)
|
|
METHOD colCount()
|
|
|
|
METHOD up()
|
|
METHOD down()
|
|
METHOD left()
|
|
METHOD right()
|
|
METHOD pageUp()
|
|
METHOD pageDown()
|
|
METHOD goTop()
|
|
METHOD goBottom()
|
|
METHOD home()
|
|
METHOD end()
|
|
|
|
METHOD stabilize()
|
|
METHOD forceStable()
|
|
METHOD refreshAll()
|
|
METHOD refreshCurrent()
|
|
METHOD hiLite()
|
|
METHOD deHilite()
|
|
|
|
METHOD configure()
|
|
METHOD dispRow(nRow)
|
|
METHOD dispFrames()
|
|
ENDCLASS
|
|
|
|
METHOD Init(nTop, nLeft, nBottom, nRight) CLASS TBrowse
|
|
::nTop := nTop
|
|
::nLeft := nLeft
|
|
::nBottom := nBottom
|
|
::nRight := nRight
|
|
::nRowCount := nBottom - nTop - 1
|
|
IF ::nRowCount < 1
|
|
::nRowCount := 1
|
|
ENDIF
|
|
RETURN Self
|
|
|
|
METHOD addColumn(oCol) CLASS TBrowse
|
|
AAdd(::aColumns, oCol)
|
|
RETURN Self
|
|
|
|
METHOD getColumn(n) CLASS TBrowse
|
|
IF n >= 1 .AND. n <= Len(::aColumns)
|
|
RETURN ::aColumns[n]
|
|
ENDIF
|
|
RETURN NIL
|
|
|
|
METHOD colCount() CLASS TBrowse
|
|
RETURN Len(::aColumns)
|
|
|
|
// --- Navigation ---
|
|
|
|
METHOD down() CLASS TBrowse
|
|
LOCAL nSkipped
|
|
IF ::nRowPos < ::nRowCount
|
|
// Cursor within screen: skip one record
|
|
nSkipped := Eval(::bSkipBlock, 1)
|
|
IF nSkipped > 0
|
|
::nRowPos += 1
|
|
ELSE
|
|
::lHitBottom := .T.
|
|
ENDIF
|
|
ELSE
|
|
// Cursor at bottom: scroll data
|
|
nSkipped := Eval(::bSkipBlock, 1)
|
|
IF nSkipped <= 0
|
|
::lHitBottom := .T.
|
|
ENDIF
|
|
ENDIF
|
|
::lStable := .F.
|
|
RETURN Self
|
|
|
|
METHOD up() CLASS TBrowse
|
|
LOCAL nSkipped
|
|
IF ::nRowPos > 1
|
|
nSkipped := Eval(::bSkipBlock, -1)
|
|
IF nSkipped < 0
|
|
::nRowPos -= 1
|
|
ELSE
|
|
::lHitTop := .T.
|
|
ENDIF
|
|
ELSE
|
|
nSkipped := Eval(::bSkipBlock, -1)
|
|
IF nSkipped >= 0
|
|
::lHitTop := .T.
|
|
ENDIF
|
|
ENDIF
|
|
::lStable := .F.
|
|
RETURN Self
|
|
|
|
METHOD pageDown() CLASS TBrowse
|
|
LOCAL nSkipped := Eval(::bSkipBlock, ::nRowCount)
|
|
IF nSkipped <= 0
|
|
::lHitBottom := .T.
|
|
ENDIF
|
|
::lStable := .F.
|
|
RETURN Self
|
|
|
|
METHOD pageUp() CLASS TBrowse
|
|
LOCAL nSkipped := Eval(::bSkipBlock, -::nRowCount)
|
|
IF nSkipped >= 0
|
|
::lHitTop := .T.
|
|
ENDIF
|
|
::lStable := .F.
|
|
RETURN Self
|
|
|
|
METHOD goTop() CLASS TBrowse
|
|
Eval(::bGoTopBlock)
|
|
::nRowPos := 1
|
|
::lStable := .F.
|
|
RETURN Self
|
|
|
|
METHOD goBottom() CLASS TBrowse
|
|
Eval(::bGoBottomBlock)
|
|
::nRowPos := ::nRowCount
|
|
::lStable := .F.
|
|
RETURN Self
|
|
|
|
METHOD left() CLASS TBrowse
|
|
IF ::nColPos > 1
|
|
::nColPos -= 1
|
|
IF ::nColPos < ::nColOffset
|
|
::nColOffset := ::nColPos
|
|
ENDIF
|
|
ENDIF
|
|
::lStable := .F.
|
|
RETURN Self
|
|
|
|
METHOD right() CLASS TBrowse
|
|
IF ::nColPos < Len(::aColumns)
|
|
::nColPos += 1
|
|
ENDIF
|
|
::lStable := .F.
|
|
RETURN Self
|
|
|
|
METHOD home() CLASS TBrowse
|
|
::nColPos := 1
|
|
::nColOffset := 1
|
|
::lStable := .F.
|
|
RETURN Self
|
|
|
|
METHOD end() CLASS TBrowse
|
|
::nColPos := Len(::aColumns)
|
|
::lStable := .F.
|
|
RETURN Self
|
|
|
|
// --- Display ---
|
|
|
|
METHOD configure() CLASS TBrowse
|
|
::lConfigured := .T.
|
|
RETURN Self
|
|
|
|
METHOD stabilize() CLASS TBrowse
|
|
IF !::lConfigured
|
|
::configure()
|
|
ENDIF
|
|
::dispFrames()
|
|
// Position back to current row
|
|
LOCAL nSaveSkip := Eval(::bSkipBlock, -(::nRowPos - 1))
|
|
LOCAL i
|
|
FOR i := 1 TO ::nRowCount
|
|
::dispRow(i)
|
|
IF i < ::nRowCount
|
|
Eval(::bSkipBlock, 1)
|
|
ENDIF
|
|
NEXT
|
|
// Restore to current position
|
|
Eval(::bSkipBlock, -(::nRowCount - ::nRowPos))
|
|
::lStable := .T.
|
|
::lHitTop := .F.
|
|
::lHitBottom := .F.
|
|
RETURN .T.
|
|
|
|
METHOD forceStable() CLASS TBrowse
|
|
DO WHILE !::lStable
|
|
::stabilize()
|
|
ENDDO
|
|
RETURN Self
|
|
|
|
METHOD refreshAll() CLASS TBrowse
|
|
::lStable := .F.
|
|
RETURN Self
|
|
|
|
METHOD refreshCurrent() CLASS TBrowse
|
|
::lStable := .F.
|
|
RETURN Self
|
|
|
|
METHOD dispFrames() CLASS TBrowse
|
|
LOCAL i, oCol, x, cSep, nWidth
|
|
|
|
// Ensure colOffset makes colPos visible
|
|
IF ::nColPos < ::nColOffset
|
|
::nColOffset := ::nColPos
|
|
ENDIF
|
|
// Check if colPos fits on screen
|
|
DO WHILE .T.
|
|
x := ::nLeft
|
|
LOCAL lVisible := .F.
|
|
FOR i := ::nColOffset TO Len(::aColumns)
|
|
oCol := ::aColumns[i]
|
|
nWidth := ::colWidth(oCol)
|
|
IF x + nWidth > ::nRight + 1
|
|
EXIT
|
|
ENDIF
|
|
x += nWidth
|
|
IF i = ::nColPos
|
|
lVisible := .T.
|
|
EXIT
|
|
ENDIF
|
|
IF Len(::cColSep) > 0
|
|
x += Len(::cColSep)
|
|
ENDIF
|
|
NEXT
|
|
IF lVisible
|
|
EXIT
|
|
ENDIF
|
|
::nColOffset += 1
|
|
ENDDO
|
|
|
|
// Draw header
|
|
SetPos(::nTop, ::nLeft)
|
|
x := ::nLeft
|
|
FOR i := ::nColOffset TO Len(::aColumns)
|
|
oCol := ::aColumns[i]
|
|
nWidth := ::colWidth(oCol)
|
|
IF x + nWidth > ::nRight + 1
|
|
EXIT
|
|
ENDIF
|
|
IF i = ::nColPos
|
|
DevOut(PadR(oCol:cHeading, nWidth))
|
|
ELSE
|
|
DevOut(PadR(oCol:cHeading, nWidth))
|
|
ENDIF
|
|
x += nWidth
|
|
IF i < Len(::aColumns) .AND. Len(::cColSep) > 0
|
|
DevOut(::cColSep)
|
|
x += Len(::cColSep)
|
|
ENDIF
|
|
NEXT
|
|
|
|
// Draw header separator
|
|
IF Len(::cHeadSep) > 0
|
|
SetPos(::nTop + 1, ::nLeft)
|
|
cSep := Left(::cHeadSep, 1)
|
|
DevOut(Replicate(cSep, ::nRight - ::nLeft + 1))
|
|
ENDIF
|
|
|
|
RETURN Self
|
|
|
|
METHOD dispRow(nRow) CLASS TBrowse
|
|
LOCAL i, oCol, x, nWidth, cVal, nScreenRow
|
|
|
|
nScreenRow := ::nTop + 1 + nRow // +1 for header separator
|
|
IF Len(::cHeadSep) > 0
|
|
nScreenRow += 1
|
|
ENDIF
|
|
|
|
SetPos(nScreenRow, ::nLeft)
|
|
x := ::nLeft
|
|
FOR i := ::nColOffset TO Len(::aColumns)
|
|
oCol := ::aColumns[i]
|
|
nWidth := ::colWidth(oCol)
|
|
IF x + nWidth > ::nRight + 1
|
|
EXIT
|
|
ENDIF
|
|
IF oCol:bBlock != NIL
|
|
cVal := PadR(Eval(oCol:bBlock), nWidth)
|
|
ELSE
|
|
cVal := Space(nWidth)
|
|
ENDIF
|
|
IF nRow = ::nRowPos .AND. i = ::nColPos
|
|
// Current cell: reverse video
|
|
DevOut(Chr(27) + "[7m" + cVal + Chr(27) + "[0m")
|
|
ELSEIF nRow = ::nRowPos
|
|
// Current row highlight
|
|
DevOut(Chr(27) + "[47;30m" + cVal + Chr(27) + "[0m")
|
|
ELSE
|
|
DevOut(cVal)
|
|
ENDIF
|
|
x += nWidth
|
|
IF i < Len(::aColumns) .AND. Len(::cColSep) > 0
|
|
DevOut(::cColSep)
|
|
x += Len(::cColSep)
|
|
ENDIF
|
|
NEXT
|
|
|
|
RETURN Self
|
|
|
|
METHOD hiLite() CLASS TBrowse
|
|
RETURN Self
|
|
|
|
METHOD deHilite() CLASS TBrowse
|
|
RETURN Self
|
|
|
|
FUNCTION colWidth(oCol)
|
|
LOCAL nW := oCol:nWidth
|
|
IF nW <= 0
|
|
nW := Len(oCol:cHeading)
|
|
IF nW < 10
|
|
nW := 10
|
|
ENDIF
|
|
ENDIF
|
|
RETURN nW
|
|
|
|
// ============================================================
|
|
// TBrowseDB — convenience constructor
|
|
// ============================================================
|
|
FUNCTION TBrowseDB(nTop, nLeft, nBottom, nRight)
|
|
LOCAL o := TBrowse():Init(nTop, nLeft, nBottom, nRight)
|
|
o:bSkipBlock := {|n| DBSkipBlock(n)}
|
|
o:bGoTopBlock := {|| dbGoTop()}
|
|
o:bGoBottomBlock := {|| dbGoBottom()}
|
|
RETURN o
|
|
|
|
FUNCTION DBSkipBlock(nRecs)
|
|
LOCAL nSkipped := 0
|
|
IF nRecs > 0
|
|
DO WHILE nSkipped < nRecs
|
|
SKIP
|
|
IF EOF()
|
|
SKIP -1
|
|
EXIT
|
|
ENDIF
|
|
nSkipped++
|
|
ENDDO
|
|
ELSEIF nRecs < 0
|
|
DO WHILE nSkipped > nRecs
|
|
SKIP -1
|
|
IF BOF()
|
|
EXIT
|
|
ENDIF
|
|
nSkipped--
|
|
ENDDO
|
|
ENDIF
|
|
RETURN nSkipped
|