1
#########################################################################
2
# COPYRIGHT (C) 2003 EDF R&D WWW.CODE-ASTER.ORG #
4
# THIS PROGRAM IS FREE SOFTWARE; YOU CAN REDISTRIBUTE IT AND/OR #
5
# MODIFY IT UNDER THE TERMS OF THE GNU GENERAL PUBLIC LICENSE AS #
6
# PUBLISHED BY THE FREE SOFTWARE FOUNDATION; EITHER VERSION 2 OF THE #
7
# LICENSE, OR (AT YOUR OPTION) ANY LATER VERSION. #
8
# THIS PROGRAM IS DISTRIBUTED IN THE HOPE THAT IT WILL BE USEFUL, #
9
# BUT WITHOUT ANY WARRANTY; WITHOUT EVEN THE IMPLIED WARRANTY OF #
10
# MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. SEE THE GNU #
11
# GENERAL PUBLIC LICENSE FOR MORE DETAILS. #
13
# YOU SHOULD HAVE RECEIVED A COPY OF THE GNU GENERAL PUBLIC LICENSE #
14
# ALONG WITH THIS PROGRAM; IF NOT, WRITE TO : EDF R&D CODE_ASTER, #
15
# 1 AVENUE DU GENERAL DE GAULLE, 92141 CLAMART CEDEX, FRANCE. #
16
#########################################################################
18
# $Id: ihm_main.tcl 2881 2007-03-20 12:30:18Z courtois $
20
# construction de la fenetre principale de l'interface
21
#################################################################
22
proc astk_princ { { REINI "INI" } } {
23
# message de mise � jour
24
set client_vers "00.00.00"
25
if { [regexp {([0-9]+)\.([0-9]+)\.([0-9]+)} $astk::astk_version mat1 i1 i2 i3] } {
26
set client_vers [format "%02d.%02d.%02d" $i1 $i2 $i3]
28
if { $astk::config(-1,flag_maj) != $client_vers } {
29
if { $ashare::origine != "from_salome" } {
30
tk_messageBox -title [ashare::mess ihm 138] -message [ashare::mess ihm 242] -type ok -icon info
32
set astk::config(-1,flag_maj) $client_vers
39
# Titre de la fenetre + menu + creation de la frame complete + icon
42
# on fixe la taille de la fenetre
43
#if_not_resizable wm resizable . 0 0
44
wm protocol . WM_DELETE_WINDOW { quitter }
46
pack [frame $astk::ihm(menu) -relief raised -bd 1] -fill x -side top -anchor nw
47
pack [frame .fen -relief raised -bd 0] -fill both -expand 1 -anchor nw
48
grid [frame $astk::ihm(fenetre) -relief raised -bd 1] -row 0 -column 0 -sticky nsew
49
grid [frame $astk::ihm(satellite) -relief raised -bd 1] -row 0 -column 1 -sticky nsw
50
grid [frame $astk::ihm(status) -relief raised -bd 0] -row 1 -columnspan 2 -sticky nsew
51
grid columnconfigure .fen 0 -weight 1
52
grid rowconfigure .fen 0 -weight 1
54
# pack [frame $astk::ihm(fenetre) -relief raised -bd 1] -side left -fill both -expand 1 -anchor nw
55
# pack [frame $astk::ihm(satellite) -relief raised -bd 1] -fill y -expand 1 -anchor nw
56
# pack [frame $astk::ihm(status) -relief raised -bd 0] -fill x -anchor s -expand 1
57
# pack [panedwindow .fen -orient horizontal] -expand 1 -fill both -anchor nw
58
# .fen add [frame $astk::ihm(fenetre) -relief raised -bd 0]
59
# .fen add [frame $astk::ihm(satellite) -relief raised -bd 0]
62
create_popup $astk::ihm(popup)
63
create_menu $astk::ihm(menu)
71
# il est n�cessaire d'afficher l'onglet en dernier car c'est lui qui bride
72
# la taille de la fenetre
73
pack [frame $astk::ihm(fenetre).onglet] -anchor w
74
# creation et initialisation des onglets
77
# lecture du profil initial ou export
78
if { $astk::ihm(profil_ini) != "" } {
79
ouvrir $astk::ihm(serv_ini) $astk::ihm(profil_ini)
80
set astk::ihm(profil_ini) ""
81
} elseif { $astk::ihm(export_ini) != "" } {
82
import_from "astk_serv" -1 $astk::ihm(export_ini) "non" "oui"
83
set astk::ihm(export_ini) ""
86
affiche_onglet $astk::profil(onglet_actif)
89
# cree la liste des noeuds, des versions, choix batch/interactif...
93
catch {destroy .fen_about}
99
ashare::trace_geom astk .
102
# raffraichir la fenetre principale de l'interface
103
#################################################################
104
proc raffr_princ { } {
106
# sous-onglets s�lectionn�s
107
for {set i 1} {$i <= $astk::ihm(nbongM)} {incr i} {
108
for {set j 1} {$j <= $astk::ihm(nbong,$i)} {incr j} {
109
if { $ongsel($i) == $astk::ihm(tit,$i,$j) } {
114
# r�initialisation du nom des onglets
116
for {set i 1} {$i <= $astk::ihm(nbongM)} {incr i} {
117
set ongsel($i) $astk::ihm(tit,$i,$ongsel($i))
119
# d�truit les fen�tres filles et ouvre de nouveau asjob s'il existait
120
set iasj [winfo exists $astk::ihm(asjob)]
121
# ne pas d�truire les classes BWidgets
122
# eval destroy [winfo children .]
123
set lw [winfo children .]
124
for {set i 0} {$i < [llength $lw]} {incr i} {
125
set ww [lindex $lw $i]
126
if { [string match ".#BWidget*" $ww] == 0 } {
133
show_fen $astk::ihm(asjob) force
138
# change le th�me de couleur (voir init_couleur pour les th�mes)
139
#################################################################
140
proc change_couleur { theme } {
141
set astk::ihm(style,couleur) $theme
142
set astk::config(-1,couleur) $theme
148
# permet de changer les couleurs � la main
149
#################################################################
150
proc perso_couleur { } {
152
# r�cup�re les couleurs actuelles
153
set old_coul $astk::ihm(style,couleur)
154
set astk::ihm(style,couleur) perso
156
set lmv [array get astk::ihm]
157
set nbl [expr [llength $lmv] / 2]
161
for {set i 0} {$i < $nbl} {incr i} {
164
if { [regexp {^couleur,(.*)} [lindex $lmv $k] mat1 mcle] } {
167
lappend lcoul [lindex $lmv $k1]
170
set lmcle [lsort $lmcle]
177
wm title $fen [ashare::mess ihm 328]
179
pack [frame $fen.liste -relief solid -bd 1]
181
# boucle sur les couleurs
182
for {set i 0} {$i < $nn} {incr i} {
183
set mcle [lindex $lmcle $i]
184
set tmp_coul($mcle) $astk::ihm(couleur,$mcle)
185
if { $mcle != "foreground" } {
186
set fgc $astk::ihm(couleur,foreground)
188
set fgc $astk::ihm(couleur,entry_background)
190
pack [frame $fen.liste.l_$i -relief solid -bd 0] -anchor w
191
label $fen.liste.l_$i.lbl -font $astk::ihm(font,lab) -text $mcle -width 35 -anchor w
192
button $fen.liste.l_$i.butt -width 30 -font $astk::ihm(font,val) -text [ashare::mess ihm 329] \
194
-bg $astk::ihm(couleur,$mcle) \
195
-command "choix_couleur $mcle $fen $fen.liste.l_$i.butt"
196
pack $fen.liste.l_$i.lbl $fen.liste.l_$i.butt -pady 3 -side left
200
pack [frame $fen.valid -relief solid -bd 0]
201
button $fen.valid.annuler -font $astk::ihm(font,labbout) -text [ashare::mess ihm 85] \
202
-bg $astk::ihm(couleur,annul) \
203
-command "set astk::ihm(style,couleur) $old_coul ; init_couleur ras ; destroy $fen"
204
button $fen.valid.ok -font $astk::ihm(font,labbout) -text "Ok" \
205
-bg $astk::ihm(couleur,valid) \
206
-command "set astk::ihm(style,couleur) $old_coul ; init_couleur ras ; accept_couleur ; destroy $fen"
207
pack $fen.valid.ok $fen.valid.annuler -side left -padx 10 -pady 5
212
# choisit une couleur
213
#################################################################
214
proc choix_couleur { mcle fen w } {
216
set tmp_coul($mcle) [tk_chooseColor -title "Choose a color" -parent $fen \
217
-initialcolor $astk::ihm(couleur,$mcle)]
218
if { $tmp_coul($mcle) != "" } {
219
$w configure -bg $tmp_coul($mcle)
223
# accepte les couleurs
224
#################################################################
225
proc accept_couleur { } {
227
set id [open $astk::fic_color w]
228
puts $id "# AUTOMATICALLY GENERATED - DO NOT EDIT !"
229
puts $id "astkrc_version : $ashare::astkrc_version"
231
set lmv [array get tmp_coul]
232
set nbl [expr [llength $lmv] / 2]
233
for {set i 0} {$i < $nbl} {incr i} {
236
set mcle [lindex $lmv $k]
237
set astk::ihm(couleur,$mcle) $tmp_coul($mcle)
238
puts $id "$mcle : $tmp_coul($mcle)"
241
if { $astk::ihm(style,couleur) == "perso" } {
247
#################################################################
248
proc change_font { } {
255
wm title $fen [ashare::mess ihm 331]
257
pack [frame $fen.liste -relief solid -bd 1] -padx 10 -pady 10
259
set lf $astk::ihm(style,fontlist)
260
set lm $astk::ihm(style,fontlist_label)
261
for {set i 0} {$i < [llength $lf]} {incr i} {
262
set ff [lindex $lf $i]
263
set msg [ashare::mess ihm [lindex $lm $i]]
264
button $fen.liste.$ff -font $astk::ihm(style,font_$ff) -text $msg \
265
-command "choix_font $fen $ff"
266
grid $fen.liste.$ff -row $i -column 0 -sticky ew -padx 5 -pady 5
270
pack [frame $fen.valid -relief solid -bd 0]
271
button $fen.valid.ok -font $astk::ihm(font,labbout) -text "Ok" \
272
-bg $astk::ihm(couleur,valid) \
273
-command "destroy $fen"
274
pack $fen.valid.ok -side left -padx 10 -pady 5
276
ashare::centre_fen $fen .
280
# s�lection d'une police
281
# groupe = main, fixe
282
#################################################################
283
proc choix_font { parent groupe } {
284
set newfont [SelectFont .fontdlg -parent $parent -font $astk::ihm(style,font_$groupe)]
285
if { $newfont != "" } {
286
if { $ashare::dbg >= 4 } {
287
ashare::log "<DEBUG> Font : $newfont"
289
set astk::ihm(style,font_$groupe) $newfont