# $Id: reflect.tcl,v 1.1 1998/10/26 08:25:49 c81319 Exp c81319 $
# vtk Reflector

# copyright March-April 1998 Robert Riviere
# The author hereby grant permission to use, copy, modify and distribute this
# software and its documentation for any purpose, provided that existing
# copyright notices are retained in all copies and that this notice is included
# verbatim in any distributions. 
# 
# THIS SOFTWARE IS PROVIDED BY ``AS IS'' AND IN NO EVENT SHALL THE AUTHOR BE
# LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL
# DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE.


# TODO
# - check that object we are trying to Print/ListMethods
#           is really a VTK Object instance
# - correct resizing of windows on toplevel resizing
# - maintain an history of executed commands

proc reflect { toMatch args} {
    global Gdbg

    # toplevel and globals
    catch {destroy .dbg}
    toplevel .dbg
    set Gdbg(nomObj) ""
    set Gdbg(comm) ""
    set Gdbg(tkText) ""
    set Gdbg(toMatch) "$toMatch $args"

    ######################### Left Side #############################

    frame .dbg.list
    
    # refresh button
    button .dbg.list.b -text "Refresh" -command "fillCatalog"   
    # Objects display window
    ScrolledYListbox .dbg.list.lb -height 20
    
    pack .dbg.list.b -fill x
    pack .dbg.list.lb -expand y
    pack .dbg.list -side left
    
    # binding for selection managing
    bind .dbg.list.lb.list <ButtonRelease-1> {
	global Gdbg
	set Gdbg(nomObj) [selection get]
    }

    # We scan objects to display a first time
    fillCatalog
    
    #  Print / Methods buttons
    button .dbg.list.p -text "Print" -command {contentsPrint}
    button .dbg.list.m -text "Methods" -command {methodsPrint}
    
    pack .dbg.list.p .dbg.list.m -fill x
    
    ######################### Right Side #############################
    # title label for name and type
    label .dbg.titre -height 1 -relief groove  -padx 0 -pady 0
    pack .dbg.titre -fill x -side top
    
    # result display window - pointer to text widget stored in global
    set Gdbg(tkText) [ScrolledYText .dbg.txt -width 60 -cursor left_ptr]
    pack .dbg.txt -fill y -expand y -padx 0 -pady 0
    # tag look for hypertext
    $Gdbg(tkText) tag configure hyperTag -underline 1 -foreground blue
    # tag for indentation level
    # level 0 - column #1 not empty - white on black
    $Gdbg(tkText) tag configure indentTag1 -foreground white -background black
    # level 1 - column #3 not empty - do nothing
    $Gdbg(tkText) tag configure indentTag3
    # level 2 - column #5 not empty - print in blue
    $Gdbg(tkText) tag configure indentTag5  -foreground blue
    # level 3 - column #7 not empty - print in yellow
    $Gdbg(tkText) tag configure indentTag7 -foreground steelblue

    # hyperText tag binding
    $Gdbg(tkText) tag bind hyperTag <Button-1> {
	global Gdbg
	
	# retrieves the word on which we clicked
	set comm [%W get "@%x,%y wordstart" "@%x,%y wordend"]
	# paste it in the command line
	.dbg.comm.entry delete 0 end
	.dbg.comm.entry insert end "$Gdbg(nomObj) $comm "
    }
    
    # entry for command display and edit
    frame .dbg.comm 
    entry .dbg.comm.entry -relief sunken -bg skyblue -textvar Gdbg(comm)
    pack .dbg.comm.entry -fill x -side left -expand y
    button .dbg.comm.b -text Exec -command "faisLaComm"
    
    pack .dbg.comm.b
    
    pack .dbg.comm -fill x -expand y
    
    # return key makes exec
    bind .dbg.comm.entry <Return> {
	faisLaComm
    }
}
    
# scrolled listbox - used for object catalog
proc ScrolledYListbox { parent args } {
    frame $parent
    eval {listbox $parent.list -yscrollcommand [list $parent.sy set]} $args
    scrollbar $parent.sy -orient vertical -command [list $parent.list yview]
    pack $parent.sy -side right -fill y
    pack $parent.list -side left -fill both -expand true
    return $parent.list
}

# scanning tcl objects to display by comparing to regexp list stored in global
proc fillCatalog {} {
    global Gdbg

    .dbg.list.lb.list delete 0 end
    # for each regexp in list
    foreach re $Gdbg(toMatch) {
	foreach item [eval list [info commands $re]] {
	# Place for Ron Carter's (carter@sll.northrop.com) patch
	    .dbg.list.lb.list insert end $item
	}
    }
}

# special printing : update label line, call Print method on current 
# selection and display in right part
proc contentsPrint {} {
    global Gdbg
    
    .dbg.titre configure -text "$Gdbg(nomObj) ([$Gdbg(nomObj) GetClassName])"

    set res [$Gdbg(nomObj) Print]
    # in display window
    #   return to normal (editable) state
    $Gdbg(tkText) configure -state normal
    $Gdbg(tkText) delete 1.0 end
    $Gdbg(tkText) insert end $res
    # Identation level tagging
    set lastLine [$Gdbg(tkText) index end]
    # far all lines, we examine first columns of text 
    for {set curLine 1} {$curLine < $lastLine} {incr curLine} {
	foreach aCol {1 3 5 7} {
	    set aChar [$Gdbg(tkText) get $curLine.$aCol]
	    # as soon as achar != " ", we are at level aCol identation 
	    if { $aChar != " "} {
		$Gdbg(tkText) tag add indentTag$aCol \
		    $curLine.0 $curLine.end
		break
	    }
	}
    }
    #   go into disabled (non-editable) state
    $Gdbg(tkText) configure -state disabled
    # current command reset
    set Gdbg(comm) ""
}

# special printing : update label line, call ListMethods method on current 
# selection and display in right part
proc methodsPrint {} {
    global Gdbg
    
    .dbg.titre configure -text "$Gdbg(nomObj) ([$Gdbg(nomObj) GetClassName])"

    set res [$Gdbg(nomObj) ListMethods]
    # in display window
    #   return to normal (editable) state
    $Gdbg(tkText) configure -state normal
    $Gdbg(tkText) delete 1.0 end
    $Gdbg(tkText) insert end $res
    # hyper-text tagging
    # last line of text
    set lastLine [$Gdbg(tkText) index end]
    # far all lines, we examine 1st column of text 
    for {set curLine 1} {$curLine < $lastLine} {incr curLine} {
	set aChar [$Gdbg(tkText) get $curLine.0]
	# if there is a char != " ", we are in a 
	#   "Methods from XXX:" line - skip it
	if { $aChar == "M"} { continue }
	# else put a tag on the word beginning in column #3
	$Gdbg(tkText) tag add hyperTag \
	    "$curLine.3 wordstart" "$curLine.3 wordend"
    }

    #   go into disabled (non-editable) state
    $Gdbg(tkText) configure -state disabled
    # current command reset
    set Gdbg(comm) ""
}

# scrolled Text
proc ScrolledYText { parent args } {
    frame $parent
    eval {text $parent.text -yscrollcommand [list $parent.sy set]} $args
    scrollbar $parent.sy -orient vertical -command [list $parent.text yview]
    pack $parent.sy -side right -fill y
    pack $parent.text -side left -fill both -expand true
    return $parent.text
} 

# current command line execution and refresh object list
proc faisLaComm {} {
    global Gdbg

    set res [eval $Gdbg(comm)]
    # we display command output to standard output
    puts "$Gdbg(comm) : $res"
    fillCatalog
}
    
