package provide stead 2.0


proc te:cmd:mkmenu_win {} {

   if {"$::tcl_platform(platform)" != "unix"} {
    return
   }
   menubutton .menu.win -text {Win} -menu .menu.win.m
   pack .menu.win -before .menu.config -side left
   
   menu .menu.win.m  -postcommand te:fillWinMenu

}

proc te:fillWinMenu {} {

    set m .menu.win.m
    catch {$m delete 0 last}

    
    # Recherche de la liste des couple valide (i.e. interpeteur "vivant")
    # de la forme {{WindowName1 InterpName1} {WindowName2 InterpName2} ..}
    set titles_interps [list]
    foreach steadWin [getSteadInterpList] {
        if {![catch {send $steadWin {wm title .}} title]} {
            lappend titles_interps [list $title $steadWin]
        }
    }
    # Construction des items de menu
    foreach pair [lsort $titles_interps] {
         set title [lindex $pair 0]
         set interp [lindex $pair 1]
         $m add command \
              -label $title\
              -command [list te:raise $interp]
    }
    
    $m add separator
    $m add command \
        -label "Make X server secure" \
        -command {makeXServerSecure}
    
    $m add command \
        -label "Quit All !!!" \
        -command {[te:quitAll]}
    
}
## makeXServerSecure (NOT EXIST) -- 
# 
# 
proc makeXServerSecure  {} {
    catch {
        exec xhost -
        exec xhost -LOCAL:
    }
}

proc te:raise {interp} {
    set ismap [send $interp winfo ismap .]
    if !$ismap {send $interp wm deiconify .}
    send $interp raise .
}

proc te:quitAll {} {
    # 1 - on quite tous les interpréteur sauf l'interpréteur courant
    foreach interp [getSteadInterpList]  {
        if {$interp != [tk appname]  } {
            send $interp stead:quitBox
        }
    }
    # 2 - on quite l'interpréteur courant
    stead:quitBox
}

proc getSteadInterpList {} {

    global stead
    set te_exe [file tail $stead(exe)]

    set allInterps [lsort [winfo interps]]
    
    # Sélection des interpreteur qui concernent stead (sous différents 
    # noms possibles) :
    
    set steadList    {}
    foreach i $allInterps {
        if {[string match "stead*" $i]   || 
            [string match "$te_exe*" $i]  ||
            [string match "te*" $i] 
           } {
           
            lappend steadList $i
        }  
    }
    return $steadList
    
}
