#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Window.tcl,v $
# $Date: 1997/03/03 09:59:03 $
# $Revision: 1.18.1.21 $
#
package provide zircon 1.18
#
proc Window {name args} {
    switch :: $name {
	return [eval Window_[lindex $args 0] [lrange $args 1 end]]
    }
    set ln [string tolower $name]
    set this [objName Window]
    initObj $this Window
    uplevel #0 set WTO($ln) $this
    upvar #0 $this wdata
    set wdata(name) $ln
    proc $this {args} "eval window_call $this \$args"
    toplevel $ln -class Zircon
    wm resizable $ln 1 1
    wm protocol $ln WM_DELETE_WINDOW "$this close"
    eval $this configure $args
    uplevel #0 lappend zWList $this
    return $this
}
#
proc Window_id {win} {
    global WTO
    if [info exists WTO([set w [winfo toplevel $win]])] { return $WTO($w) }
    return nil
}
#
proc window_call {this op args} {
    upvar #0 $this wdata
    if [info exists wdata($op)] { return $wdata($op) }
    return [eval window_$op $this $args]
}
#
proc window_extendTime {this} {
    upvar #0 $this wdata
    set wdata(closecount) $wdata(closetime)
}
#
proc window_setTitle {this chan title} {
    switch [set win [$this name]] [$chan window] {
	wm title $win $title
    } default {
	retitleFrame $win $chan $title
    }
}
#
proc window_visible {this} {return [winfo ismapped [$this name]]}
#
proc window_setIcon {this chan title} {
    global Icon
    switch -- [set win [$this name]] [$chan window] {
	wm iconname $win $title
	set Icon($win) $title
	switch {} [set icn [$chan icon]] {} default {
	    global IconBM
	    set f [lindex [set IconBM($win) $icn] 0]
	    if [file exists $f] { set f @$f }
	    catch {wm iconbitmap $win $f}
	}
   }
}
#
proc window_noPopUp {this chan} {
    switch -- [set win [$this name]] [$chan window] {
	global Icon IconBM
	catch {wm iconname $win "*$Icon($win)*"}
	if {[info exists IconBM($win)] && \
	  ![string match {} [set icn [lindex $IconBM($win) 1]]]} {
	   wm iconbitmap $win $icn
	}
    }
}
#
proc window_expose {this chan} {
    $this popup
    switch [set win [$this name]] [$chan window] {} default {
	exposeFrame $win $chan
    }
}
#
proc window_popup {this} {
   wm deiconify [set w [$this name]]
   raise $w
}
#
proc window_close {this} {
    upvar #0 $this wdata
    foreach x $wdata(children) { eval [lindex $x 1] }
}
#
proc window_delete {this} {
    global WTO Icon IconBM Otype zWList
    set w [$this name]
    catch {bind $w.cFrm <Destroy> {}}
    catch {unset WTO($w) Icon($w) IconBM($w)}
    foreach v {OType } { catch {unset ${v}($this)} }
    uplevel #0 unset $this
    rename $this {}
    destroy $w
    listkill zWList $this
}
#
proc window_iconify {this} {
    wm iconify [$this name]
    foreach x [$this children] {[lindex $x 0] popdown }
}
#
proc window_configure {this args} {
    upvar #0 $this wdata
    while {![string match {} $args]} {
	set val [lindex $args 1]
	set name [lindex $args 0]
	set opt [string range $name 1 end]
	switch -glob -- $name {
	-closetime {set wdata(closetime) [expr {$val * 1000}]}
	-title -
	-iconname -
	-iconbitmap { wm $opt [$this name] $val }
	-geometry -
	-resizable { eval wm $opt [$this name] $val }
	+*  { lappend wdata($opt) $val }
	-*  { set wdata($opt) $val }
	}
	set args [lrange $args 2 end]
    }
}
#
proc window_register {this id lcmd dcmd} {
    upvar #0 $this wdata
    lappend wdata(children) [list $id $lcmd $dcmd]
    $this checkClose $id
}
#
proc window_checkClose {this id} {
    upvar #0 $this wdata
    if {[$id close] && [$id closetime] > [expr {$wdata(closetime)/1000}]} {
	$this configure -closetime [$id closetime]
    }
    
}
#
proc window_deregister {this id} {
    upvar #0 $this wdata
    if {[set x [lsearch $wdata(children) "$id *"]] >= 0} {
	eval [lindex [lindex $wdata(children) $x] 2]
	listdel wdata(children) $x
	set wdata(closetime) 0
	foreach x $wdata(children) { $this checkClose [lindex $x 0] }
    }
    switch {} $wdata(children) { $this delete }
}
#
proc Window_find {name} {
    global WTO
    set ln [string tolower $name]
    return [expr {[info exists WTO($ln)] ? $WTO($ln) : {nil}}]
}
#
proc Window_make {name} {
    global WTO
    set ln [string tolower $name]
    if [info exists WTO($ln)] {	return $WTO($ln) }
    return [Window $name]
}
#
proc window_inactive {this inc} {
    upvar #0 $this wdata
    if $wdata(closetime) {
	if {[incr wdata(closecount) $inc] <= 0} {
	    $this iconify
	}
    }
}

