#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Info.tcl,v $
# $Date: 1997/02/13 09:18:45 $
# $Revision: 1.18.1.13 $
#
package provide zircon 1.18
#
# Build a Zircon Information Window.
#
proc clSet {fr f l} {
    if {![string compare $f 0.0] && ![string compare $l 1.0]} {
	catch "pack forget $fr"
    } {
	catch "pack $fr -side bottom -fill x"
	$fr set $f $l
    }
}
#
proc MainInfo {} {
    global zlayout zInfo
    set zInfo [Window .@inf -title {Zircon Information}]
    set w [$zInfo name]
    catch {wm geometry .@inf $zlayout(default,info)}
    wm resizable .@inf 1 1
    grid columnconfigure .@inf 0 -weight 1 -minsize 50
}
#
proc Info {name args} {
    switch :: $name {
	return [eval Info_[lindex $args 0] [lrange $args 1 end] ]
    }
    global BF Fg Bg Ft Bl OType defChan ztrans zInfo
    initObj $name Channel Info
    proc $name {args} "eval info_call $name \$args"
    set OType($name) Info
    upvar #0 $name idata
    set net [set idata(net) [lindex $args 1]]
    set w [switchFrame .@inf $name [$net name] -handles]
    set df [getDefault defChan $net]
    $name configure -hpos end -open [$idata(net) popInfo] \
      -close [$df close] -jump 1 -quiet 0 -draw 0 \
      -msg [$df msg] -actionmode 0 \
      -actions 0 -patterns {} -logfile {} -history [$df history] \
      -closetime [$df closetime] -log {} -menu 0 -join 0 \
      -ops {} -keep 1 -monitor 0 -wid $zInfo -window $w 
    grid rowconfigure $w 0 -weight 1
    grid columnconfigure $w 0 -weight 1
    frame $w.cl -borderwidth 0
    grid columnconfigure $w.cl 0 -weight 1
    scrollbar $w.cl.hs -orient horizontal -command "$w.cl.cmd xview"
    emacsEntry $w.cl.cmd -xscrollcommand "ghsSet $w.cl.hs" \
      -relief sunken -state disabled
    button $w.cl.clear -text $ztrans(clear) -command "$name clear" -width 5 \
      -borderwidth 2 -highlightthickness 2 -pady 0
    grid $w.cl.cmd -row 0 -column 0 -sticky ew
    grid $w.cl.hs -row 1 -column 0 -sticky ew
    grid $w.cl.clear -row 0 -column 1 -rowspan 2
    if [$net command] { grid $w.cl -row 1 -columnspan 2 -sticky ew }
    doInfoBindings $w.cl.cmd $name
    bind $w.cl.cmd <Return> "$name doCmd %W"
    set idata(text) [set oft $w.info]
    scrollbar $w.vscroller -command "doScroll $oft"
    text $oft -height 10 -width 80 \
      -yscrollcommand "setScroll $name $oft $w.vscroller" -borderwidth 2
    rebind $oft $idata(net)
    bind $oft <Configure> {%W see end ; notIdle %W}
    bind $w <Visibility> {notIdle %W}
    grid $w.vscroller -row 0 -column 1 -sticky ns
    grid $oft -row 0 -column 0 -sticky nsew
    set BF($name) [getOValue $oft font boldFont Font]
    set Fg($name) [getOValue $oft foreground foreground Foreground]
    set Bg($name) [getOValue $oft background background Background]
    set Ft($name) [getOValue $oft font font Font]
    set Bl($name) [option get $oft bell Bell]
    confTag $oft {} $Fg($name) $Bg($name) $Ft($name) $BF($name)
    return $name
}
#
proc info_clear {this} {
   [$this text] delete 1.0 end
   update idletasks
}
#
proc info_send {this string args} {
    bell
}
#
proc info_doCmd {this w} {
    set net [$this net]
    if [$net raw] {
	set line [$w get]
	$this configure -hpos end
	$this addText {} ":>$line"
	$net sendRaw $line
	$w delete 0 end
    } {
	$net doMisc2 $this $w
    }
}
#
proc info_call {this op args} {
    upvar #0 $this idata
    switch $op {
    lname -
    name { return $this }
    crypt { return {} }
    control { return [$idata(net) control] }
    command {
	    if [lindex $args 0] {
		grid $idata(window).cl
	    } {
		grid forget $idata(window).cl
	    }
	    return
	}
    }
    if [info exists idata($op)] { return $idata($op) }
    switch {} [info procs info_$op] {
	return [eval channel_call $this $op $args]
    }
    return [eval info_$op $this $args]
}
#
proc info_popup {this} {
    [$this wid] expose [$this net]
    handleOn [$this net] POPINFO [list [$this lname]]
    return $this
}
#
proc info_insert {this text} {
    switch {} $text return
    set ent [$this window].cl.cmd
    while {[regexp "(\[^\n\]*)\n(.*)" $text d line text]} {
	switch {} $line continue
	tkEntryInsert $ent $line
	$this doCmd $ent
	$ent delete 0 end
    }
    switch {} $text {} default {
	$ent insert insert $text
	tkEntrySeeInsert $ent
    }
    $this configure -hpos end
}
#
proc info_flagState {this state} {
    [$this window].cl.cmd configure -state $state
}
