#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Window.tcl,v $
# $Date: 2000/02/04 14:49:37 $
# $Revision: 1.18.1.39 $
#
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 {op args} "objCall window $this \$op \$args"
    topAndIcon $ln "$this close"
    eval $this configure $args
    uplevel #0 lappend zWList $this
    return $this
}
#
proc topAndIcon {win del} {
#    global zLogo
    makeToplevel $win {} $del {}
#    wm withdraw [toplevel ${win}icon]
#    pack [label ${win}icon.label -image $zLogo]
#    wm iconwindow $win ${win}icon
}
#
proc Window_id {win} {
    global WTO
    if {[info exists WTO([set w [winfo toplevel $win]])]} { return $WTO($w) }
    return nil
}
#
proc window_grab {this cursor} {
    catch {grab set [$this name]}
    switch {} $cursor {} default {
        [$this name] configure -cursor $cursor
    }
}
#
proc window_release {this cursor} {
    catch {grab release [$this name]}
    switch {} $cursor {} default {
        [$this name] configure -cursor $cursor
    }
}
#
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 [$chan net]
    }
}
#
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
	set ibm [wm iconbitmap $win]
	catch {wm iconname $win "*$Icon($win)*"}
	if {[info exists IconBM($win)] && \
	  ![string match {} [set icn [lindex $IconBM($win) 1]]]} {
	   wm iconbitmap $win $icn
	}
	bind $win <Map> "$this resetIcon $ibm"
    }
}
#
proc window_resetIcon {this { icnbm {} } } {
    global Icon IconBM
    set win [$this name]
    wm iconname $win "$Icon($win)"
    switch {} $icnbm  {} default { wm iconbitmap $win $icnbm }
    bind $win <Map> {}
}
#
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 zWList
    set w [$this name]
    catch {bind $w.cFrm <Destroy> {}}
    safeUnset WTO($w) Icon($w) IconBM($w) OType($this) $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_withdraw {this} {
    wm withdraw [$this name]
    foreach x [$this children] {[lindex $x 0] popdown }
}
#
proc window_configure {this args} {
    upvar #0 $this wdata
    foreach {name val} $args {
	set opt [string range $name 1 end]
	switch -glob -- $name {
	-closetime {
		if {$val > 0} {
		    if {$val < 10000} { set val 10000 }
		    if {$val < $wdata(closecount)} { set wdata(closecount) $val}
		    set wdata(closetime) $val
		} elseif {$val == 0} {
		    set wdata(closetime) 0
		}
	    }
	-title -
	-iconname -
	-iconbitmap { wm $opt [$this name] $val }
	-geometry -
	-resizable { eval wm $opt [$this name] $val }
	+*  { lappend wdata($opt) $val }
	-*  { set wdata($opt) $val }
	}
    }
}
#
proc window_nextCol {this} {
    upvar #0 $this wdata
    set cl $wdata(curcol)
    if {[incr wdata(curcol)] >= $wdata(cols)} {
        set wdata(curcol) 0
    }
    return $cl
}
#
proc window_register {this id lcmd dcmd} {
    upvar #0 $this wdata
    lappend wdata(children) [list $id $lcmd $dcmd]
    $this checkClose $id
}
#
proc window_checkAllClose {this} {
    upvar #0 $this wdata
    set wdata(closetime) 0
    foreach x $wdata(children) { $this checkClose [lindex $x 0] }
    checkMainClose
}
#
proc window_checkClose {this id} {
    upvar #0 $this wdata
    if {[$id close]} {
	if {$wdata(closetime) == 0 || [$id closemsec] < $wdata(closetime)} {
	    $this configure -closetime [$id closemsec]
	}
    }
}
#
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
	$this checkAllClose
    }
    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) != 0} {
	if {[incr wdata(closecount) $inc] <=0} {
	    set wdata(closecount) 0
	    $this [$this iconop]
	}
    }
}

