
# Stuff for handling toplevels

if ![info exists toplevel(single)] {
    set toplevel(single) 0
    foreach i {ICEM ICEPAK AIRPAK ORCA TDM STARLT} {
	if {[info exists env(${i}_ONE_WINDOW)] && $env(${i}_ONE_WINDOW)} {
	    set toplevel(single) 1
	}
    }
}

if ![info exists toplevel(visual)] {
   set toplevel(visual) ""
   if [info exist env(ICEM_WINDOW_VISUAL)] {
      set toplevel(visual) $env(ICEM_WINDOW_VISUAL)
   }
}

if ![info exist toplevel(root)] {
   set toplevel(root) "."
}

set toplevel(framew) 6

proc top_setup {} {
    global toplevel vwindow_fills_screen
    
    if $toplevel(single) {
	foreach w [winfo children .] {
	    if {[winfo class $w] != "Toplevel"} {
		destroy $w
	    }
	}
	set width [expr [winfo screenwidth .] - 50]
	set height [expr [winfo screenheight .] - 50]
	. configure -width $width -height $height -background gray -bd 0
	wm geometry . -0-0
	
	if ![info exists toplevel(windows_menu)] {
	    set tl .toplevel_windowmanager
	    set menu $tl.b.m
	    top_window $tl 1 "" "" "" 0 0
	    $tl configure -borderwidth 0 -relief flat
	    menubutton $tl.b -text Windows -borderwidth 2 -relief raised -menu $menu
	    menu $menu
	    grid $tl.b -sticky news
	    top_geometry $tl -0+0
	    
	    set toplevel(windows_menu) $menu
	}
	if ![info exists vwindow_fills_screen] {
	    bind . <Configure> {if {"%W" == "."} top_resize_dot}
	}
	bind . <Unmap> top_withdraw_menus
    }
}

proc top_withdraw_menus {} {
    global toplevel_others
    foreach w [array names toplevel_others] {
	catch {wm withdraw $w}
    }
}

proc top_set_windows_menu {m} {
    global toplevel
    
    if [winfo exists .toplevel_windowmanager] {
	catch {destroy .toplevel_windowmanager}
    }
    if [ info exists toplevel(windows_menu) ] {
    	set toplevel(windows_menu) $m
    }
}

proc top_transient {win subwin {map 1} {border 0}} {
    global toplevel
    
    if [top_is_single $win] {
	if $border {
	    frame $win -borderwidth 2 -relief ridge
	} else {
	    frame $win -borderwidth 0 -relief flat
	}
	set toplevel($win,pos) "0 0"
	if $map {
	    place $win -in $toplevel(root) -x 0 -y 0
	    set toplevel($win,mapped) 1
	} else {
	    set toplevel($win,mapped) 0
	}
	    
    } else {
	toplevel $win
	wm overrideredirect $win 1
	if {$subwin != ""} { wm transient $win $subwin }
	if !$map { wm withdraw $win }
    }
}

proc top_window_force {win map title delete_proc} {
    global toplevel
    if !$toplevel(single) {
	set toplevel(single) 1
	top_window $win $map $title $delete_proc
	set toplevel($win,single) 1
	set toplevel(single) 0
	destroy ${win}__head.i ;#$ no way to deiconify so this is useless
    } else {
	top_window $win $map $title $delete_proc
    }
}

proc top_window {win {map 1} {title ""} {delete_proc ""} {group ""} \
		 {usehead 1} {useframe 1} {class FakeToplevel} \
		 {visual ""} {resize 1} {embed ""} {del_verify ""}} {
    global toplevel smallfont boldfont guibase_dir
    
    if {($visual == "") && [info exists toplevel(visual)]} {
	set visual $toplevel(visual)
    }

    if $toplevel(single) {
	if $useframe {
	    set frame ${win}__frame
	    catch {destroy $frame}
            if $usehead {
               frame $frame -borderwidth 6 -relief ridge
            } else {
               frame $frame -borderwidth 3 -relief ridge
            }
	    set toplevel($win,frame) $frame
	    set toplevel($win,framepos) ""
	    
	    if $resize {
		bind $frame <Motion> "top_resizecur $frame %W %x %y"
		bind $frame <1> "top_resizestart $win %W %X %Y"
		bind $frame <Button1-Motion> "top_resize $win %X %Y"
		bind $frame <ButtonRelease-1> "top_resizeend $frame %X %Y"
	    } else {
		bind $frame <1> "top_movestart $win %X %Y"
		bind $frame <Button1-Motion> "top_move $win %X %Y"
		bind $frame <ButtonRelease-1> "top_moveend $win %X %Y"
	    }
	    bind $frame <2> "top_movestart $win %X %Y"
	    bind $frame <Button2-Motion> "top_move $win %X %Y"
	    bind $frame <ButtonRelease-2> "top_moveend $win %X %Y"
	}
	
	# -------------------------------------
	
	if $useframe {
	    frame $win -borderwidth 0 -relief flat \
                                 -class $class -visual $visual
	} else {
	    frame $win -borderwidth 6 -relief ridge \
                                 -class $class -visual $visual
	}
	if $map {
	    place $win -in $toplevel(root) -x 0 -y 0
	}
	set toplevel($win,pos) "0 0"
	set toplevel($win,mapped) $map
	
	# -------------------------------------
	
	if {$title == ""} {
	    set title [string range $win 1 end]
	}
	if {$group != ""} {
	}
	set toplevel($win,delete_proc) $delete_proc
        if {$del_verify != ""} {
           set toplevel($win,del_verify) $del_verify
        }
	
	if $usehead {
	    set head ${win}__head
	    catch {destroy $head}
	    frame $head -borderwidth 0 -relief raised -bg blue
	    label $head.l -text " $title" -font $boldfont -bg blue -anchor w \
		-fg white
	    if {$usehead < 2} {
		button $head.i -borderwidth 1 -relief raised -command \
		    "top_iconify $win" -bitmap @$guibase_dir/window_iconify.xbm
		button $head.x -borderwidth 1 -relief raised -command \
		    "top_destroy $win" -bitmap @$guibase_dir/window_close.xbm
		pack $head.x $head.i -side right -padx 1 -pady 1
	    }
            pack $head.l -side left -fill both -expand 1
	    set toplevel($win,head) $head
	    set toplevel($win,headpos) ""
	    
	    bind $head.l <Double-1> "top_raise $win"
	    bind $head.l <1> "top_movestart $win %X %Y"
	    bind $head.l <Button1-Motion> "top_move $win %X %Y"
	    bind $head.l <ButtonRelease-1> "top_moveend $win %X %Y"
	    
	    bind $head <Double-1> "top_raise $win"
	    bind $head <1> "top_movestart $win %X %Y"
	    bind $head <Button1-Motion> "top_move $win %X %Y"
	    bind $head <ButtonRelease-1> "top_moveend $win %X %Y"
	    
	    top_add_window_menu $win
	}
	
	bind $win <Configure> "top_fix_subparts $win"
	
    } else {
	if {$embed != ""} {
	   toplevel $win -visual $visual -use $embed
	} else {
   	   toplevel $win -visual $visual
	   if !$map { wm withdraw $win }
        }
	if {$title != ""} { wm title $win $title }
	if {$group != "" && [winfo exists $group]} {
	   wm group $win $group
	}
	if {$delete_proc != ""} {
           if {$delete_proc == "withdraw"} {
              wm protocol $win WM_DELETE_WINDOW "wm withdraw $win"
           } else {
              wm protocol $win WM_DELETE_WINDOW $delete_proc
           }
	}
    }
}

proc top_geometry {win geo} {
    global toplevel
    
    #puts "top_geometry $win $geo"
    if [top_is_single $win] {
	#set rw [. cget -width]
	#set rh [. cget -height]
	set rw [winfo width .]
	set rh [winfo height .]
	set ww [winfo width $win]
	set wh [winfo height $win]
	
	set setsize 0
	if {[regexp {^([0-9]*)x([0-9]*)([+-])([0-9]*)([+-])([0-9]*)$} \
		$geo dummy w h px nx py ny]} {
	    $win configure -width $w -height $h
	    set setsize 1
	} elseif {[regexp {^([0-9]*)x([0-9]*)$} $geo dummy w h]} {
	    set px +; set py +
	    set nx [winfo x $win]
	    set ny [winfo y $win]
	    $win configure -width $w -height $h
	    set setsize 1
	    
	} elseif {![regexp {^([+-])([0-9]*)([+-])([0-9]*)$} \
			$geo dummy px nx py ny]} {
	    return
	}
	if ![string compare $px "+"] {
	    set x $nx
	} else {
	    set x [expr $rw - $ww - $nx]
	}
	if ![string compare $py "+"] {
	    set y $ny
	} else {
	    set y [expr $rh - $wh - $ny]
	}
	# This is a special case
	if {($win == ".e") && [winfo exists .toplevel_windowmanager]} {
	    incr y [winfo reqheight .toplevel_windowmanager]
	}
	
	if $setsize {
	    place $win -in [winfo parent $win] -x $x -y $y -width $w -height $h
	    set toplevel($win,pos) "$x $y $w $h"
	} else {
	    place $win -in [winfo parent $win] -x $x -y $y
	    set toplevel($win,pos) "$x $y"
	}
	update idle
#	top_fix_subparts $win
	if [winfo exists .toplevel_windowmanager] {
	    raise .toplevel_windowmanager
	}
    	
    } else {
	wm geometry $win $geo
    }
}

proc top_geometry_wrt {w wrt xp yp usesaved} {
    global toplevel
    
    if {[string length $xp] == 1} {
	set xp $xp$toplevel(framew)
    }
    if {[string length $yp] == 1} {
	set h $toplevel(framew)
	if [winfo exists ${w}__head] { incr h [winfo reqheight ${w}__head] }
	set yp $yp$h
    }
    
    set geo ""
    foreach {d name} {x width y height} {
	set r [winfo root$d .]
	set t [winfo root$d $wrt]
	set ws [string index [set ${d}p] 0]
	set wv [string range [set ${d}p] 1 end]
	if {$ws == "+"} {
	    append geo +[expr $wv + $t - $r]
	} else {
	    append geo -[expr $r + [winfo $name .] - ($t + [winfo $name $wrt]) + $wv]
	}
    }
    top_geometry $w $geo
}

proc top_set_requested_geo {win} {
    global toplevel
    if {![top_is_single $win] || !$toplevel($win,mapped)} return
    update
    set w [winfo reqwidth $win]
    set h [winfo reqheight $win]
    top_geometry $win ${w}x${h}
    top_make_on_screen $win
}

proc top_get_geometry {win} {
    set x [expr [winfo rootx $win] - [winfo rootx .]]
    set y [expr [winfo rooty $win] - [winfo rooty .]]
    return [list $x $y]
}

proc top_fix_subparts {win} {
    global toplevel
    
    set ff $toplevel(framew)
    
    set x [winfo x $win]
    set y [winfo y $win]
    set w [winfo width $win]; set ow $w
    set h [winfo height $win]
    
    if [info exists toplevel($win,head)] {
	set head $toplevel($win,head)
	set headw [winfo reqwidth $head]
	if {$headw < $w} { set headw $w }
	set headw [expr $w + 0]
	set headh [winfo reqheight $head]
	
	#set headx [expr $x + $w - $headw + $ff]
	set headx [expr $x - 0]
	set heady [expr $y - $headh - 0]
	place $head -in [winfo parent $win] \
                    -x $headx -y $heady -width $headw -height $headh
	set toplevel($win,headpos) "$headx $y $headw $headh"
	if {$headw > $w} { set w $headw }
    } else {
	set headh 0
    }
    if {$w > $ow} { $win configure -width $w }
    if [info exists toplevel($win,frame)] {
	set frame $toplevel($win,frame)
	set fx [expr $x - $ff]; set fy [expr $y - $headh - $ff]
	set fw [expr $w + $ff * 2]; set fh [expr $h + $headh + $ff * 2]
	place $frame -in [winfo parent $win] -x $fx -y $fy -width $fw -height $fh
	set toplevel($win,framepos) "$fx $fy $fw $fh"
	raise $win $frame
	top_raise_packed $win
    }
}

proc top_is_single {win} {
  global toplevel

  set single $toplevel(single)
  if {!$single && [info exist toplevel($win,single)]} {
     set single $toplevel($win,single)
  }
  return $single
}

proc top_iconify {win} {
    global toplevel
    
    if [top_is_single $win] {
	place forget $win
	set toplevel($win,mapped) 0
	if [info exists toplevel($win,frame)] {
	    place forget $toplevel($win,frame)
	}
	if [info exists toplevel($win,head)] {
	    place forget $toplevel($win,head)
	    top_add_window_menu $win
	}
    } else {
	wm iconify $win
    }
}

proc top_deiconify {win} {
    global toplevel
    
    if [top_is_single $win] {
	if [info exists toplevel($win,pos)] {
	   set wh [lrange $toplevel($win,pos) 2 3]
           if {($wh == "") && [winfo exist ${win}__head]} {
              set w0 [winfo width $win]
              set h0 [winfo height $win]
              if {($w0 > 10) && ($h0 > 10)} { set wh [list $w0 $h0] }

             # The above is to avoid some forms starting with minimum size
           } 
	} else {
            set wh ""
	}
	set xy [concat [top_on_screen_xy $win] $wh]

	if {[llength $xy] == 2} {
           place $win -in [winfo parent $win] -x [lindex $xy 0] -y [lindex $xy 1]
	} else {
	    place $win -in [winfo parent $win] -x [lindex $xy 0] -y \
                [lindex $xy 1] -width [lindex $xy 2] -height [lindex $xy 3]
	}
	set toplevel($win,mapped) 1
	if [info exists toplevel($win,frame)] {
	    top_add_window_menu $win
	}
	update idle
	top_fix_subparts $win
	if [winfo exists .toplevel_windowmanager] {
	    raise .toplevel_windowmanager
	}
    } else {
	catch {wm deiconify $win}
    }
}

proc top_withdraw {win} {
    global toplevel
    
    if [top_is_single $win] {
	place forget $win
	if [info exists toplevel($win,frame)] {
	    place forget $toplevel($win,frame)
	}
	if [info exists toplevel($win,head)] {
	    place forget $toplevel($win,head)
	}
	set toplevel($win,mapped) 0
	top_remove_window_menu $win
    } else {
	wm withdraw $win
    }
}

proc top_withdraw_all {out} {
    global toplevel
    
    if $out {
    	set toplevel(windows_withdrawn) ""
	foreach m [array names toplevel] {
	    set win [lindex [split $m ,] 0]
	    if {[info exists toplevel($win,mapped)] &&
		$toplevel($win,mapped)} {
		top_withdraw $win
		lappend toplevel(windows_withdrawn) $win
	    }
	}
    } else {
	foreach win $toplevel(windows_withdrawn) {
	    top_deiconify $win
	}
	set toplevel(windows_withdrawn) ""
    }
}

proc top_title {win {title ""}} {
    global toplevel
    
    if [top_is_single $win] {
	set head ${win}__head
	if {$win == "."} {
	    if {$title == ""} {
		return [wm title .]
	    } else {
		wm title . $title
	    }
	} elseif [winfo exists $head] {
	    if {$title == ""} {
		return [string range [$head.l cget -text] 1 end]
	    } else {
		$head.l configure -text " $title"
		top_add_window_menu $win
	    }
	}
    } else {
	if {$title == ""} {
	    return [wm title $win]
	} else {
	    wm title $win $title
	}
    }
}

proc top_destroy {win {force 0}} {
    global toplevel
    
    if ![winfo exists $win] return
    
    if [info exist toplevel($win,del_verify)] {
       if ![eval $toplevel($win,del_verify)] {return ""}
    }

    if {[top_is_single $win] && [info exists toplevel($win,pos)]} {
	if {!$force && ($toplevel($win,delete_proc) != "")} {
	    if {($toplevel($win,delete_proc) == "withdraw") ||
		![eval $toplevel($win,delete_proc)]} {
		top_withdraw $win
		return
	    }
	}
	
	# Maybe the delete_proc deleted it
	if ![winfo exists $win] return
	
	unset toplevel($win,pos)
	unset toplevel($win,mapped)
	if [info exists toplevel($win,head)] {
	    destroy $toplevel($win,head)
	    unset toplevel($win,head)
	    unset toplevel($win,headpos)
	}
	if [info exists toplevel($win,frame)] {
	    destroy $toplevel($win,frame)
	    unset toplevel($win,frame)
	    unset toplevel($win,framepos)
	}
    }

    top_remove_window_menu $win
    destroy $win
}

proc top_lower {win} {
    global toplevel
    
    if [winfo exists .toplevel_windowmanager] {
       lower .toplevel_windowmanager
    }
    lower $win
    if [info exists toplevel($win,head)] { lower $toplevel($win,head) }
    if [info exists toplevel($win,frame)] { lower $toplevel($win,frame) }
}

proc top_raise {win} {
    global toplevel
    
    if [info exists toplevel($win,frame)] { raise $toplevel($win,frame) }
    if [info exists toplevel($win,head)] { raise $toplevel($win,head) }
    raise $win
    top_raise_packed $win
    if [winfo exists .toplevel_windowmanager] {
	raise .toplevel_windowmanager
    }

    if [info exist toplevel($win,raise_proc)] {
       eval $toplevel($win,raise_proc)
    }
}

proc top_raise_packed {win} {
    foreach sub [pack slaves $win] {
	if ![string match $win* $sub] {
	    raise $sub $win
	}
    }
}

proc top_resizable {win w h} {
    global toplevel
    
    if [top_is_single $win] {
    } else {
	wm resizable $win $w $h
    }
}

# ----------------------------------------------------

proc top_resizecur {win checkw x y} {
    global toplevel

    #puts "top_resizecur $win $checkw $x $y"

    if {$checkw != $win} return
    
    # Set the cursor appropriately.
    set w [winfo width $win]
    set h [winfo height $win]
    
    if {$x < 20} {
	set xp -1
    } elseif {$x > $w - 20} {
	set xp 1
    } else {
	set xp 0
    }
    if {$y < 20} {
	set yp -1
    } elseif {$y > $h - 20} {
	set yp 1
    } else {
	set yp 0
    }
    switch -- "$xp $yp" {
	"-1 -1" { set cur top_left_corner }
	"-1 0"  { set cur left_side }
	"-1 1"  { set cur bottom_left_corner }
	"0 -1"  { set cur top_side }
	"0 1"   { set cur bottom_side }
	"1 -1"  { set cur top_right_corner }
	"1 0"   { set cur right_side }
	"1 1"   { set cur bottom_right_corner }
	default { return }
    }
    $win configure -cursor $cur
    set toplevel($win,resizetype) "$xp $yp"
}

proc top_resizestart {win checkw x y} {
    global toplevel

   #puts "top_resizestart $win $checkw $x $y"

    if {$checkw != $toplevel($win,frame)} return
    
    top_raise $win
    set toplevel($win,resizestart) [list $x $y]
    if [info exist toplevel($win,resizestart_proc)] {
       eval $toplevel($win,resizestart_proc)
    }
}

proc top_resizeend {win x y} {
    global toplevel
    
   #puts "top_resizeend $win $x $y"

    top_resize_doit $win $x $y
    catch {unset toplevel($win,resizestart)}
    catch {unset toplevel($win,resizetype)}

    if [info exist toplevel($win,resizeend_proc)] {
       eval $toplevel($win,resizeend_proc)
    }
}

proc top_resize {win x y} {
    global toplevel
    
   #puts "top_resize $win $x $y"

    if [info exists toplevel(after_idle_resize)] {
	foreach ii $toplevel(after_idle_resize) {
	    catch {after cancel $ii}
	}
	unset toplevel(after_idle_resize)
    }
    set toplevel(after_idle_resize) [after idle "top_resize_doit $win $x $y"]
}

proc top_resize_doit {win x y} {
    global toplevel
    
   #puts "top_resize_doit $win $x $y"

    if ![info exists toplevel($win,resizestart)] return
    
    set frame $toplevel($win,frame)
    set xy $toplevel($win,resizestart)
    set toplevel($win,resizestart) [list $x $y]
    set dx [expr $x - [lindex $xy 0]]
    set dy [expr $y - [lindex $xy 1]]
    
    set x [winfo x $win]
    set y [winfo y $win]
    set w [winfo width $win]
    set h [winfo height $win]
    
    if ![info exists toplevel($frame,resizetype)] {
	# puts " This can happen if you move the mouse fast enough"
	top_resizecur $frame $frame [expr $x - [winfo rootx $frame]] \
	    [expr $y - [winfo rooty $frame]]
    }
    
    set rt $toplevel($frame,resizetype)
   #puts "rt = $rt : $x $y $dx $dy"

    switch -- [lindex $rt 0] {
	-1 { incr x $dx; incr w [expr -$dx] }
	0  {}
	1  { incr w $dx }
    }
    switch -- [lindex $rt 1] {
	-1 { incr y $dy; incr h [expr -$dy] }
	0  {}
	1  { incr h $dy }
    }
    place $win -x $x -y $y -width $w -height $h
    set toplevel($win,pos) "$x $y $w $h"
    update idle
#    top_fix_subparts $win
}


proc top_resize_direct {win dw dh} {
   global toplevel

   if ![winfo exists $win] return
   top_raise $win

   set x [winfo x $win]
   set y [winfo y $win]
   set w [winfo width $win]
   set h [winfo height $win]

   incr w $dw
   incr h $dh

   if [top_is_single $win] {
      place $win -x $x -y $y -width $w -height $h
      set toplevel($win,pos) "$x $y $w $h"
   } else {
      wm geometry ${w}x${h}+${x}+${y} 
   } 
}

# ----------------------------------------------------

proc top_movestart {win x y} {
    global toplevel
    
    top_raise $win
    set toplevel($win,movestart) [list $x $y [winfo x $win] [winfo y $win]]
    if [info exist toplevel($win,movestart_proc)] {
       eval $toplevel($win,movestart_proc)
    }
}

proc top_moveend {win x y} {
    global toplevel
    
    set td [top_move_doit $win $x $y]
    if {$td < 4} { raise . }
    catch {unset toplevel($win,movestart)}
    if [info exist toplevel($win,moveend_proc)] {
       eval $toplevel($win,moveend_proc)
    }
}

proc top_move {win x y} {
    global toplevel
    
    if [info exists toplevel(after_idle_move)] {
	foreach ii $toplevel(after_idle_move) {
	    catch {after cancel $ii}
	}
	unset toplevel(after_idle_move)
    }
    set toplevel(after_idle_move) [after idle "top_move_doit $win $x $y"]
}

proc top_move_doit {win x y} {
    global toplevel
    if ![info exists toplevel($win,movestart)] return
    
    set xy $toplevel($win,movestart)
#    set toplevel($win,movestart) [list $x $y]
    set dx [expr $x - [lindex $xy 0]]
    set dy [expr $y - [lindex $xy 1]]
    
    place $win -x [expr [lindex $xy 2] + $dx] -y [expr [lindex $xy 3] + $dy]
    
    return [expr abs($dx) + abs($dy)]
#    update idle
#    top_fix_subparts $win
}

# ----------------------------------------------------

proc top_resize_dot {} {
    global toplevel
    
    if $toplevel(single) {
	set width [winfo width .]
	set height [winfo height .]
	set adj [info command top_adjust_window_geometry]
	foreach sub [winfo children .] {
	    if {($adj != "") && ([lsearch {.e .m .v} $sub] >= 0)} continue
	    if {![info exists toplevel($sub,mapped)] || \
		    !$toplevel($sub,mapped)} continue
	    
	    set mx [expr [winfo x $sub] + [winfo width $sub]]
	    set my [expr [winfo y $sub] + [winfo height $sub]]
	    if {$mx > $width} { set chx [expr $mx - $width] } else { set chx 0 }
	    if {$my > $height} { set chy [expr $my - $height] } else { set chy 0 }
	    set nx [expr {[winfo x $sub] - $chx}]
	    set ny [expr {[winfo y $sub] - $chy}]
	    if {$nx < 0} { set nx 0 }
	    if {$ny < 0} { set ny 0 }
	    top_geometry $sub +$nx+$ny
	}
	if {$adj != ""} $adj
	if [winfo exists .toplevel_windowmanager] {
	    if [winfo exists .e] {
		set w [winfo width .e]
		.toplevel_windowmanager configure -width $w
		grid columnconfigure .toplevel_windowmanager 0 -minsize $w
	    }
	    top_geometry .toplevel_windowmanager -0+0
	}
    }
}

proc top_add_window_menu {win {title ""}} {
   global toplevel
    
   if {! [info exists toplevel(windows_menu)] ||
		$toplevel(windows_menu) == ""} return

   if {$title == ""} {
      if ![info exists toplevel($win,head)] return
      set title [$toplevel($win,head).l cget -text]
   }

   if [info exist toplevel($win,mapped)] {
      if $toplevel($win,mapped) { set ss "  " } else { set ss "* " }
      set title $ss$title
   } else {
      set title "  $title"
   }

   set select_cmd top_menuselect
   if {[info exist toplevel(menuselect_cmd)] && \
           ([info command $toplevel(menuselect_cmd)] != "")} {
      set select_cmd $toplevel(menuselect_cmd)
   }

   foreach m $toplevel(windows_menu) {
      set pos ""
      set n [$m index end]
      if {$n != "none"} {
         set start [$m cget -tearoff]
         for {set i $start} {$i <= $n} {incr i} {
            if {[lindex [$m entrycget $i -command] 1] == $win} {
               set pos $i
               break
            }
         }
      }
    
      if {$pos == ""} {
         $m add command -label $title -command [list $select_cmd $win]
      } else {
         $m entryconfigure $pos -label $title
      }
   }
}

proc top_remove_window_menu {win} {
    global toplevel
    
   if { ![ info exists toplevel(windows_menu) ] ||
		$toplevel(windows_menu) == ""} return
    
   foreach m $toplevel(windows_menu) {
      set n [$m index end]
      if {$n != "none"} {
         for {set i [$m cget -tearoff]} {$i <= $n} {incr i} {
            if {[lindex [$m entrycget $i -command] 1] == $win} {
               $m delete $i
               break
            }
         }
      }
   }
}

proc top_menuselect {win} {
    global toplevel
    if !$toplevel($win,mapped) {
	top_deiconify $win
    }
    top_make_on_screen $win
    top_raise $win
}

proc top_on_screen_xy {win} {
    global toplevel
    set wx [winfo x $win]
    set wy [winfo y $win]
    if ![info exists toplevel($win,head)] { return [list $wx $wy] }
    set ww [winfo width $win]
    set wh [winfo height $win]
    set tw [winfo width .]
    set th [winfo height .]
    set xs 4
    set ys 26
    if {$wx < $xs} { set wx $xs }
    if {$wy < $ys} { set wy $ys }
    if {$wx + $ww > $tw} { set wx [expr $tw - $ww - $xs] }
    if {$wy + $wh > $th} { set wy [expr $th - $wh - $xs] }
    return [list $wx $wy]
}

proc top_make_on_screen {win} {
    global toplevel
    
    if ![top_is_single $win] return
    
    set xy [top_on_screen_xy $win]
    top_geometry $win +[lindex $xy 0]+[lindex $xy 1]
}

proc top_minsize {win x y} {
    global toplevel
    if ![top_is_single $win] {
	wm minsize $win $x $y
    }
}

proc top_xypos {w} {
    return [list [expr [winfo rootx $w] - [winfo rootx .]] \
		[expr [winfo rooty $w] - [winfo rooty .]]]
}
