#!../t_wish
# -*- Tcl -*-
#
# This is a simple program to demonstrate the TableList itcl widget 
# by displaying generated rows and columns of data
#
# Usage: mywish -f tablelist ?-numrows number? ?-numcols number?
#    (where mywish has the Itcl, BLT and TclX extensions)
#
# (The numrows and numcols options determine how man rows and columns 
# are inserted in the table)
#
# Copyright (c) 1994 Allan Brighton (allan@piano.sta.sub.org)


lappend auto_path ../library

#set_default_resources
#option readfile Xdefaults

# This is an example of a simple "application" class, i.e.: 
# this program does nothing but create an instance of this class.

itcl_class TableListDemo {
    inherit TopLevelWidget
    
    
    # constructor: create a toplevel window for the demo

    constructor {config} {
	TopLevelWidget::constructor
	
	wm title $this "TableList Demo"

	# add a menubar
	add_menubar
	set m [add_menubutton File]
	$m add command -label "Exit" -command "$this quit"

	# create the TableList widget
	pack [set table_ \
		  [TableList $this.tlist \
		       -menubar $this.menubar \
		       -use_regexp 1 \
		       -row_lines 15 \
		       -heading_lines 2 \
		       -selectmode extended]] \
		  -fill both -expand 1

	# add a row of buttons at botton
	pack [ButtonFrame $this.b -ok_cmd exit] -side bottom -fill x

	# generate some data and display it
	gen_data
	$table_ config \
	    -title "Demo" \
	    -headings $headings_ \
	    -info $info_

	bind $table_.listbox <1> "[bind Listbox <1>]; $this select_item"
	bind $table_.listbox <Double-Button-1> "$this show_selected_item"

	# add a test frame
	add_test_frame
    }


    # generate the table data

    method gen_data {} {
	puts "generating data to display in table ($numrows rows x $numcols columns)..."
	set headings_ {}
	set sizes_ {}
	set info_ {}
	for {set i 0} {$i < $numcols} {incr i} {
	    lappend headings_ "Column No-$i"
	    lappend sizes_ 10
	}
	for {set i 0} {$i < $numrows} {incr i} {
	    set col {}
	    for {set j 0} {$j < $numcols} {incr j} {
		lappend col Item-$i,$j
	    }
	    lappend info_ $col
	}
	puts "done."
    }

    
    # add a frame with some widgets for testing the tablelist
    
    method add_test_frame {} {
	pack [frame $this.test -bd 2 -relief raised] \
	    -side top

	pack [label $this.test.title \
		  -text "Test TableList Features"] \
	    -side top
		  
	pack [frame $this.test.top -bd 3] \
	    -side top -fill x

	pack [frame $this.test.top.left -bd 2 -relief groove] \
	    -side left -fill both -expand 1 -padx 1m -pady 1m

	pack [frame $this.test.top.right -bd 2 -relief groove] \
	    -side left -fill both -expand 1 -padx 1m -pady 1m

	pack [Choice $this.test.top.left.sline \
		  -text {Show ----- Line:} \
		  -anchor e \
		  -labelWidth 15 \
		  -choice {Yes No} \
		  -value No \
		  -command "$this show_dashed_line -"] \
	    -side top -anchor w
	
	pack [Choice $this.test.top.left.dline \
		  -text {Show ===== Line:} \
		  -anchor e \
		  -labelWidth 15 \
		  -choice {Yes No} \
		  -value No \
		  -command "$this show_dashed_line ="] \
	    -side top -anchor w

	pack [Choice $this.test.top.left.pos \
		  -text {Show This Line:} \
		  -anchor e \
		  -labelWidth 15 \
		  -choice {First Middle Last} \
		  -command "$this show_this_line"] \
	    -side top -anchor w

	pack [Choice $this.test.top.left.sel \
		  -text {Select This Line:} \
		  -anchor e \
		  -labelWidth 15 \
		  -choice {First Middle Last} \
		  -value {} \
		  -command "$this select_this_line"] \
	    -side top -anchor w


	pack [Check $this.test.top.right.head \
		  -text {Show Only:} \
		  -choice $headings_ \
		  -value $headings_ \
		  -rows 4 \
		  -command "$this show_only"] \
	    -side top
    }


    # called for double-click on a table row
    
    method show_selected_item {} {
	set sel [lindex [$table_ get_selected] 0]

	# if a dashed line was selected, ignore it
	if {[string length $sel] <= 1} {
	    $table_ clear_selection
	    return
	}
	info_dialog "Selected:\n\n$sel"
	
	# test the set_row method by changing the contents of this row
	regsub -all Item $sel Selected newrow
	$table_ set_row $sel $newrow
    }


    # called when a row in the table is selected
    
    method select_item {} {
	set sel [$table_ get_selected]

	# if a dashed line was selected, ignore it
	if {[string length $sel] == 1} {
	    $table_ clear_selection
	    return
	}
    }


    # insert or remove a dashed line. Dashed lines are inserted as a 
    # single "_", "-" or "=" in the table info list.
    # Args: dash is either "=" or "-", bool is Yes or No

    method show_dashed_line {dash bool} {
	set info_ [lremove_item $info_ $dash]
	if {"$bool" == "Yes"} {
	    if {"$dash" == "="} {
		set i 10
	    } else {
		set i 5
	    }
	    set info_ [linsert $info_ $i $dash]
	}
	busy {
	    $table_ config -info $info_
	}
    }

    
    # make sure the given line is visible
    # which is one of (First, Middle, Last)

    method show_this_line {which} {
	global tk_version
	if {$tk_version >= 4.0} {
	    switch $which {
		First {
		    $table_ yview moveto 0
		}
		Middle {
		    $table_ yview moveto 0.5
		}
		Last {
		    $table_ yview moveto 1
		}
	    }
	} else {
	    switch $which {
		First {
		    $table_ yview 0
		}
		Middle {
		    $table_ yview [expr $numrows/2]
		}
		Last {
		    # use this method so that the table displays 
		    # more than just the last row
		    $table_ show_last_row
		}
	    }
	}
    }


    # select the given line is visible
    # which is one of (First, Middle, Last)

    method select_this_line {which} {
	show_this_line $which
	switch $which {
	    First {
		$table_ select_row 0
	    }
	    Middle {
		$table_ select_row [expr $numrows/2]
	    }
	    Last {
		$table_ select_row [expr $numrows-1]
	    }
	}
    }


    # display only the columns selected
    
    method show_only {cols} {
	$table_ set_options $headings_ Show 0
	$table_ set_options $cols Show 1
	busy {
	    $table_ new_info
	}
    }


    # -- public variables (also program options) -- 

    # number of rows to generate
    public numrows {40}

    # number of columns to generate
    public numcols {8}

    
    # -- protected variables --
    
    # table wisget
    protected table_ {} 

    # table headings
    protected headings_ {} 

    # data: list of table rows, where each row is a list strings
    protected info_ {}

    # list of column sizes. This would be calculated if we didn't know it,
    # but it is faster if you know the size ahead of time
    protected sizes_ {}
}


# Start the demo:
# Note that "start" is a "member" proc in the TopLevelWidget class.
# It creates an instance of the above class and handles options and
# error checking.

TableListDemo :: start
