# table.tcl
#	Support for HTML Table Display
#	The most gory part of this is that a Tk text widget doesn't
#	tell me how big it needs to be until after it is displayed.
#	We have to map the table rows, see how big they want to be,
#	and then successivly refine their size.  Ugh.
#

if {[info commands text_size] == ""} {
    Stderr "No text_size extension => no table support"
    return	;# terminates "source"
}
# These rightfully belong in maps.tcl

    set BreakMap(table) -
    array set StructureMap {
	table	-
	tr		-
    }
    # The Table Map and Structure Map are used to get output sorting of
    # tags correct.  Open tags in Structure Map will go before open tags
    # in Table Map.
    global TableMap
    array set TableMap {
	caption	-
	td		-
	th		-
    }

# Table_Reset is called when a page is initialized
proc Table_Reset {win} {
    upvar #0 HM$win var
    set var(S_tableID) 0
    catch {eval unset [info global Table.$win.*]}
}
# Set up a diversion from HMrender to Table_Divert
proc HMtag_table {win param textVar} {
    upvar #0 HM$win var
    incr var(S_tableID)
    # This array holds all the state for the table
    set tableVar Table$win.$var(S_tableID)
    upvar #0 $tableVar table
    catch {unset table}
    set var(tableHandler) [list Table_Divert $tableVar]
    set table(win) $win
    set table(id) $var(S_tableID)
    set table(rowframes) {}			;# list of per-row frames
    set table(border) 0
    HMextract_param $param borderwidth table(border)
    set table(row) -1
    set table(col) -1
    set table(numrow) 0
    set table(numcol) 0
    catch {unset table(cellopen)}
    Stderr $tableVar
    update
}
# Table_Divert is called from HMrender when a table is open
proc Table_Divert {tableVar tag not param textVar} {
    upvar #0 $tableVar table
    upvar $textVar text
    if {[info command Table_$not$tag] != {}} {
	# Call table structure handler
	return [Table_$not$tag $tableVar $param text]
    } elseif {[info exists table(caption)]} {
	lappend table(caption,data) $tag $not $param $text
    } else {
	# Embedded markup in the table, tuck it away
	lappend table(cell,$table(row),$table(col)) $tag $not $param $text
    }
}
# Turn off the diversion from HMrender
proc Table_/table {tableVar param textVar} {
    upvar #0 $tableVar table
    upvar #0 HM$table(win) var
    if [catch {unset var(tableHandler)}] {
	return
    }
    Table/Cell $tableVar
    if [info exists table(rowopen)] {
	Table_/tr $tableVar {} {}
    }
    TableSizeTable $tableVar
}
proc Table_caption {tableVar param textVar} {
    upvar #0 $tableVar table
    upvar $textVar text
    set table(caption) active
    set table(caption,param) $param
    set table(caption,data) [list "" "" "" $text]
}
proc Table_/caption {tableVar param textVar} {
    upvar #0 $tableVar table
    catch {unset table(caption)}
}
# Start a table row.
# Each row is held in its own frame to allow better scrolling
# behavior in the Tk text widget.  A frame might need to
# hold more than one row if any cell uses rowspan greater than one.
proc Table_tr {tableVar param textVar} {
    upvar #0 $tableVar table
    Table/Cell $tableVar		;# in case of unclosed row
    Table_/tr $tableVar
    set row [incr table(row) 1]
    setmax table(numrow) $row
    set table(col) -1
    set table(row,param) $param
    set table(rowspan,$row) 1		;# Max of cell rowspans
    if {$row > 0} {
	setmax table(rowspan,$row) [expr $table(rowspan,[expr $row-1])-1]
    }
    set table(rowopen) 1
}
# Create per-row frame in a lazy fashion when the row comes
# into display.  This is necessary because the window must
# be visible to get size information.
proc Table_/tr {tableVar {param ignore} {textVar ignore}} {
    upvar #0 $tableVar table
    upvar #0 HM$table(win) var
    if {![info exists table(rowopen)] || $table(row) < 0} {
	return	;# no data
    }
    unset table(rowopen)
    set row $table(row)
    if {($row > 0) && ($table(rowspan,[expr $row-1]) > 1)} {
	# Previous frame includes this row, too.
	set frame [lindex $table(rowframes) end]
	TableFillRow $tableVar $frame $row
	return
    }
    set ix [$table(win) index insert]
    $table(win) window create insert -window \
	[TableMakeRow $tableVar $table(row)]
    # Centering and other HTML structure is the only thing
    # we want with tables
    foreach tag $var(inserttags) {
	if [regexp {(^H:|^center$)} $tag] {
	    Text_TagAdd $table(win) $tag $ix insert
	}
    }
    Text_Insert $table(win) insert "\n" space
}
proc TableMakeRow {tableVar row} {
    upvar #0 $tableVar table
    catch {destroy $table(win).row$table(id),$row}
    set frame [frame $table(win).row$table(id),$row -class Table]
    lappend table(rowframes) $frame
    TableFillRow $tableVar $frame $row
    return $frame
}
proc TableFillRow {tableVar frame row} {
    upvar #0 $tableVar table
    set table(frame,$row) $frame
    for {set col 0} {$col <= $table(numcol)} {incr col} {
	TableFillCell $tableVar $frame $row $col
    }
}
proc Table_th {tableVar param textVar} {
    upvar $textVar text
    TableCell $tableVar th $param text
}
proc Table_td {tableVar param textVar} {
    upvar $textVar text
    TableCell $tableVar td $param text
}
proc Table_/th {tableVar param textVar} {
    Table/Cell $tableVar
}
proc Table_/td {tableVar param textVar} {
    Table/Cell $tableVar
}
# Initialize the contents of a table cell
# Take into account previous cells column span when updating row, col
# Each cell has a list of HTML that starts with the info from the 
# TD tag (tag, not, param, text).  More HTML may be added before /TD
proc TableCell {tableVar tag param textVar} {
    upvar #0 $tableVar table
    upvar $textVar text
    upvar 0 table(col) col table(row) row
    Table/Cell $tableVar
    if {$row < 0} {
	# no <tr> tag
	Table_tr $tableVar {} {}
    }
    set table(cellopen) yes
    # Move over by previous cell's column span
    set colspan 1
    catch {set colspan $table(colspan,$row,$col)} 
    incr col $colspan
    # See if a row span by something above us takes up this column
    while {[info exists table(rowspan,[expr $row-1],$col)] &&
		$table(rowspan,[expr $row-1],$col) > 1} {
	set table(rowspan,$row,$col) \
		[expr $table(rowspan,[expr $row-1],$col) -1]
	incr col
    }
    setmax table(numcol) $col
    set table(cell,$row,$col) [list $tag "" $param $text]
    if ![info exists table(reqwidth,$col)] {
	set table(reqwidth,$col) 0
    }
    if [HMextract_param $param width] {
	if [regsub % $width {} width] {
	    set table(relwidth,$col) $width
	} elseif {$width > 0} {
	    set table(abswidth,$col) $width
	}
    }
    set rowspan 1
    HMextract_param $param rowspan
    set table(rowspan,$row,$col) $rowspan
    setmax table(rowspan,$row) $rowspan
    set colspan 1
    HMextract_param $param colspan
    set table(colspan,$row,$col) $colspan
    setmax table(colspan,$col) $colspan
}
proc Table/Cell {tableVar} {
    upvar #0 $tableVar table
    catch {unset table(cellopen)}
}
# TableFillCell is called when a row is complete.
proc TableFillCell {tableVar frame row col} {
    global window
    upvar #0 $tableVar table
    if {![info exists table]} {
	return
    }
    upvar #0 HM$table(win) var
    upvar 0 table(cell,$row,$col) cell
    if {![info exists cell]} {
	# spanned by some other cell
	return
    }
    set ipady 0
    set w $frame.cell$row,$col 
    set len [llength $cell]
    text $w -bd 2 -relief raised -highlightthickness 0 -padx 1 -pady 1 \
	    -takefocus 1 \
	    -font [HMdefault_font $table(win)] \
	    -width 1 -height 1
    set ipady 2
    HMinit_win $w
    HMreset_win $w
    Head_SetColors $table(win) $w
    HMset_state $w -size $window(fontsize)
    HMset_indent $w $window(indentsize)
    Edit_Reset $w
    Input_Reset $w

    upvar #0 HM$w var2
    set var2(S_url) $var(S_url)
    # Keep a pointer to the main text widget for the page.
    Window_SetMaster $w $table(win)

    # Render the cell contents.
    HMrender $w hmstart "" "" ""
    # We unstack the vertical spacing from hmstart
    HMstack/ $w [list Tspace {}]
    foreach {tag not param text} $cell {
	HMrender $w $tag $not $param $text
    }
    HMrender $w hmstart "/" "" ""
    Input_ModeBindings $w [Input_Edit $table(win)]

    set table(widget,$row,$col) $w
    grid $w -in $frame -row $row -column $col -sticky news -ipady $ipady \
	-rowspan $table(rowspan,$row,$col) -columnspan $table(colspan,$row,$col) 
}

# We need this state.
# table(relwidth,$col)	If set in HTML, fixes width relative to window size
#			and we are done right away.  This is a percent.
# table(width,$col)	Final column width, in pixels.  If set, then we have
#			decided that the size is OK.
# table(reqwidth,$col)	Maximum requested size. Pixels.
# table(maxwidth,$col)	Maximum possible width for column. Pixels.

proc TableSizeTable {tableVar} {
    upvar #0 $tableVar table

    if ![info exists table(maxwidth)] {
	set table(maxwidth) [expr [winfo width $table(win)] \
		-2*[$table(win) cget -padx] \
		-2*[$table(win) cget -highlightthickness] \
		-2*[$table(win) cget -borderwidth]]
    }
    set totWidth 0

    Stderr "\nSize Table"
    # The rowextra information handles rowspan > 1 cases
    for {set col 0} {$col <= $table(numcol)} {incr col} {
	set rowextra($col) 0
    }
    for {set col 0} {$col <= $table(numcol)} {incr col} {
	set colextra($col) 0
    }
    for {set row 0} {$row <= $table(numrow)} {incr row} {
	for {set col 0} {$col <= $table(numcol)} {incr col} {
	    Stderr "($row,$col)"
	    if [info exists table(width,$col)] {
		Stderr "($row,$col) size $table(width,$col) (width)"
		continue
	    }
	    if [info exists table(relwidth,$col)] {
		set table(abswidth,$col) \
		    [expr int($table(relwidth,$col)/100.0 * $table(maxwidth))]
	    }
	    if [info exists table(abswidth,$col)] {
		set table(width,$col) [set table(reqwidth,$col) $table(abswidth,$col)]
		Stderr "($row,$col) size $table(width,$col) width $table(width,$col)"
		grid columnconfigure $table(frame,$row) $col \
			-minsize $table(width,$col)
		continue
	    }
	    # Determine natural column width
	    if ![catch {set table(widget,$row,$col)} w] {
		# fix bad spans
		while {$table(colspan,$row,$col) + $col - 1 > $table(numcol)} {
		    incr table(colspan,$row,$col) -1
		}
		if {$table(colspan,$row,$col) == 1} {
		    set pad [expr 2*([$w cget -bd]+\
				     [$w cget -highlightthickness]+\
				     [$w cget -padx])]
		    set width 0
		    $w config -wrap none
		    lassign {width height} [text_size $w]
		    Stderr "($row,$col) size $width $height"
		    setmin width $table(maxwidth)
		    $w config -wrap word
		    incr width $pad
		    if [setmax table(reqwidth,$col) $width] {
			Stderr "ReqWidth ($row,$col) $width"
		    }
		}
	    }
	}
    }
    # Fix size for all rows in this frame that have known column widths
    set undone 0
    set totWidth 0
    set knownWidth 0
    for {set col 0} {$col <= $table(numcol)} {incr col} {
	incr totWidth $table(reqwidth,$col)
	if ![info exists table(width,$col)] {
	    incr undone
	} else {
	    Stderr "KnownWidth (col,$col) -minsize $table(width,$col)"
	    incr knownWidth $table(width,$col)
	}
    }
    if {$totWidth <= $table(maxwidth) || !$undone} {
	# The table fits with requested sizes
	for {set col 0} {$col <= $table(numcol)} {incr col} {
	    if {$table(colspan,$col) > 1} {
		continue
	    }
	    if ![info exists table(width,$col)] {
		set table(width,$col) $table(reqwidth,$col)
	    }
	    TableSetWidth $tableVar $col $table(width,$col) FIT
	}
    } else {
	# Have to figure out which column(s) to shrink
	# Pass 1.  See if any are small enough to give up room.
	set defWidth [expr int(($table(maxwidth) - $knownWidth)/double($undone))]
	for {set col 0} {$col <= $table(numcol)} {incr col} {
	    if {$table(colspan,$col) > 1} {
		continue
	    }
	    set tmpdone($col) 0
	    if ![info exists table(width,$col)] {
		if {$table(reqwidth,$col) < $defWidth} {
		    set tmpdone($col) 1
		    incr undone -1
		    TableSetWidth $tableVar $col $table(reqwidth,$col) KNOWN
		    incr knownWidth $table(reqwidth,$col)
		    set table(width,$col) $table(reqwidth,$col)
		}
	    }
	}
	# Pass 2.  Scrunch big columns.
	if {$undone > 0} {
	    set defWidth [expr int(($table(maxwidth) - $knownWidth)/double($undone))]
	    for {set col 0} {$col <= $table(numcol)} {incr col} {
		if {$table(colspan,$col) > 1} {
		    continue
		}
		if {![info exists table(width,$col)] && !$tmpdone($col)} {
		    TableSetWidth $tableVar $col $defWidth SHRINK
		    incr knownWidth $defWidth
		    set table(width,$col) $table(reqwidth,$col)
		}
	    }
	}
	Stderr "TotalKnownWidth $knownWidth max $table(maxwidth)"
    }

    # Fix row height
    for {set row 0} {$row <= $table(numrow)} {incr row} {
	for {set col 0} {$col <= $table(numcol)} {incr col} {
	    if {![catch {set table(widget,$row,$col)} w] && \
		    $table(rowspan,$row,$col) == 1} {
		TableSetHeight $tableVar $w $row $col
	    }
	}
    }
    TableRowColSpan $tableVar
}
proc TableRowColSpan {tableVar} {
    upvar #0 $tableVar table
    # Do a second pass through the rows to get those with rowspan > 1
    # In this case, grow the last row that the widget spans
    Stderr "TableRowColSpan"
    for {set row 0} {$row <= $table(numrow)} {incr row} {
	for {set col 0} {$col <= $table(numcol)} {incr col} {
	    if {![catch {set table(widget,$row,$col)} w]} {
		if {$table(rowspan,$row,$col) > 1} {
		    set g [winfo parent $w]
		    for {set extra 0; set row1 $row} \
			    {$row1 < $row+$table(rowspan,$row,$col)-1} \
			    {incr row1} {
			incr extra [grid rowconfigure $g $row1 -minsize]
		    }
		    TableSetHeight $tableVar $w \
			    [expr $row + $table(rowspan,$row,$col) - 1] \
			    $col $extra
		}
		if {$table(colspan,$row,$col) > 1} {
		    set g [winfo parent $w]
		    set lastcol [expr $col+$table(colspan,$row,$col)-1]
		    # Compute the size of the columns based on requests
		    # from widgets that don't span columns (base)
		    for {set base 0; set col1 $col} {$col1 <= $lastcol} \
			    {incr col1} {
			incr base $table(reqwidth,$col1)
		    }
		    $w config -wrap none
		    lassign {reqwidth h} [text_size $w]
		    incr reqwidth [expr 2*([$w cget -bd]+[$w cget -highlightthickness]+[$w cget -padx])]
		    $w config -wrap word
		    if {$base >= $reqwidth} {
			# Already requested sizes are OK
			TableSetWidth $tableVar $col $table(reqwidth,$col) TableRowColSpan1
		    } else {
			Stderr "TableRowColSpan $col base $base req $reqwidth"
			set extra [expr $reqwidth - $base]
			for {set col1 $col} {$col1 <= $lastcol} {incr col1} {
			    # Compute dx like this to avoid rounding errors
			    set dx [expr $extra / ($lastcol - $col1 + 1)]
			    incr extra -$dx
			    incr table(reqwidth,$col1) $dx
			    TableSetWidth $tableVar $col1 \
				$table(reqwidth,$col1) TableRowColSpan2
			}
		    }
		}
	    }
	}
    }
}
# Set a widget's height by adjusting the minimum size of a given row
proc TableSetHeight {tableVar w row col {extra 0}} {
    upvar #0 $tableVar table
    set g [winfo parent $w]
    set pad [expr 2*([$w cget -bd]+[$w cget -highlightthickness]+[$w cget -pady])]
    if [catch {grid rowconfigure $g $row -minsize} min] {
	set min 0
    }
    set width [grid columnconfigure $g $col -minsize]
    $w config -wrap word
    lassign {w height} [text_size $w $width]
    Stderr "($row,$col) width $w height $height extra $extra"
    incr height [expr $pad-$extra]
    if {$height > $min} {
	Stderr "TableSetHeight ($row,$col) width $w height $height"
	grid rowconfigure $g $row -minsize $height
    }
}
proc TableSetWidth {tableVar col width {why {}}} {
    upvar #0 $tableVar table
    Stderr "TableSetWidth $col $width $why"
    for {set row1 0} {$row1 <= $table(numrow)} {incr row1} {
	if [info exists table(frame,$row1)] {
	    grid columnconfigure $table(frame,$row1) $col -minsize $width
	}
    }
}

proc Table_DestroyRow {tableVar frame} {
    upvar #0 $tableVar table
    set ix [lsearch $table(rowframes) $frame]
    if {$ix >= 0} {
	set table(rowframes) [lreplace $table(rowframes) $ix $ix]
	if {[llength $table(rowframes)] == 0} {
	    Stderr "Destroy $tableVar $frame"
	    unset table
	}
    }
}
#eof
