← Back to branch summary

~ubuntu-branches/ubuntu/quantal/astk/quantal

« back to all changes in this revision

Viewing changes to ASTK_CLIENT/lib/ihm_main.tcl

  • Committer: Bazaar Package Importer
  • Author(s): Christophe Trophime
  • Date: 2010-04-25 16:43:13 UTC
  • Revision ID: james.westby@ubuntu.com-20100425164313-0s0wtsmbiewbdz53
Tags: upstream-1.8.0
Import upstream version 1.8.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
ASTK_CLIENT/lib/ihm_main.tcl
 
1
#########################################################################
 
2
# COPYRIGHT (C) 2003         EDF R&D              WWW.CODE-ASTER.ORG    #
 
3
#                                                                       #
 
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.                              #
 
12
#                                                                       #
 
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
#########################################################################
 
17
 
 
18
# $Id: ihm_main.tcl 2881 2007-03-20 12:30:18Z courtois $
 
19
 
 
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]
 
27
   }
 
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
 
31
      }
 
32
      set astk::config(-1,flag_maj) $client_vers
 
33
      ashare::save_prefs
 
34
   }
 
35
 
 
36
# fenetre principale
 
37
   ashare::pointeur off
 
38
 
 
39
        # Titre de la fenetre + menu + creation de la frame complete + icon
 
40
        set_titre
 
41
        set_icon
 
42
        # on fixe la taille de la fenetre
 
43
#if_not_resizable       wm resizable . 0 0
 
44
   wm protocol . WM_DELETE_WINDOW { quitter }
 
45
 
 
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
 
53
 
 
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]
 
60
 
 
61
        # barre de menu
 
62
   create_popup $astk::ihm(popup)
 
63
        create_menu $astk::ihm(menu)
 
64
 
 
65
        # frame "satellite"
 
66
        affiche_satellite
 
67
 
 
68
   # etat, aide...
 
69
   affiche_status
 
70
 
 
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
 
75
        init_onglet
 
76
 
 
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) ""
 
84
        } else {
 
85
           # pour le demarrage
 
86
           affiche_onglet $astk::profil(onglet_actif)
 
87
        }
 
88
 
 
89
   # cree la liste des noeuds, des versions, choix batch/interactif...
 
90
   maj_sat
 
91
 
 
92
   # fenetre init
 
93
   catch {destroy .fen_about}
 
94
   
 
95
   # affichage
 
96
   ashare::pointeur on
 
97
   update idletasks
 
98
   wm deiconify .
 
99
   ashare::trace_geom astk .
 
100
}
 
101
 
 
102
# raffraichir la fenetre principale de l'interface
 
103
#################################################################
 
104
proc raffr_princ { } {
 
105
   global ongsel
 
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) } {
 
110
            set ongsel($i) $j
 
111
         }
 
112
      }
 
113
   }
 
114
# r�initialisation du nom des onglets
 
115
   def_onglet
 
116
   for {set i 1} {$i <= $astk::ihm(nbongM)} {incr i} {
 
117
      set ongsel($i) $astk::ihm(tit,$i,$ongsel($i))
 
118
   }
 
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 } {
 
127
         destroy $ww
 
128
      }
 
129
   }
 
130
# r�affichage
 
131
   astk_princ DETR
 
132
   if { $iasj } {
 
133
      show_fen $astk::ihm(asjob) force
 
134
   }
 
135
   raise .
 
136
}
 
137
 
 
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
 
143
   ashare::save_prefs
 
144
   init_couleur
 
145
   raffr_princ
 
146
}
 
147
 
 
148
# permet de changer les couleurs � la main
 
149
#################################################################
 
150
proc perso_couleur { } {
 
151
   global tmp_coul
 
152
# r�cup�re les couleurs actuelles
 
153
   set old_coul $astk::ihm(style,couleur)
 
154
   set astk::ihm(style,couleur) perso
 
155
   init_couleur "ras"
 
156
   set lmv [array get astk::ihm]
 
157
   set nbl [expr [llength $lmv] / 2]
 
158
   set lmcle [list]
 
159
   set lcoul [list]
 
160
   set nn 0
 
161
   for {set i 0} {$i < $nbl} {incr i} {
 
162
      set k  [expr $i * 2]
 
163
      set k1 [expr $k + 1]
 
164
      if { [regexp {^couleur,(.*)} [lindex $lmv $k] mat1 mcle] } {
 
165
         incr nn
 
166
         lappend lmcle $mcle
 
167
         lappend lcoul [lindex $lmv $k1]
 
168
      }
 
169
   }
 
170
   set lmcle [lsort $lmcle]
 
171
# fenetre
 
172
   set fen .fen_coul
 
173
   catch {destroy $fen}
 
174
   toplevel $fen
 
175
   wm withdraw $fen
 
176
   wm transient $fen .
 
177
   wm title $fen [ashare::mess ihm 328]
 
178
 
 
179
   pack [frame $fen.liste -relief solid -bd 1]
 
180
 
 
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)
 
187
      } else {
 
188
         set fgc $astk::ihm(couleur,entry_background)
 
189
      }
 
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] \
 
193
         -fg $fgc \
 
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
 
197
   }
 
198
 
 
199
# ok
 
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
 
208
   
 
209
   wm deiconify $fen
 
210
}
 
211
 
 
212
# choisit une couleur
 
213
#################################################################
 
214
proc choix_couleur { mcle fen w } {
 
215
   global tmp_coul
 
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)
 
220
   }
 
221
}
 
222
 
 
223
# accepte les couleurs
 
224
#################################################################
 
225
proc accept_couleur { } {
 
226
   global tmp_coul
 
227
   set id [open $astk::fic_color w]
 
228
   puts $id "# AUTOMATICALLY GENERATED - DO NOT EDIT !"
 
229
   puts $id "astkrc_version : $ashare::astkrc_version"
 
230
   puts $id "#"
 
231
   set lmv [array get tmp_coul]
 
232
   set nbl [expr [llength $lmv] / 2]
 
233
   for {set i 0} {$i < $nbl} {incr i} {
 
234
      set k  [expr $i * 2]
 
235
      set k1 [expr $k + 1]
 
236
      set mcle [lindex $lmv $k]
 
237
      set astk::ihm(couleur,$mcle) $tmp_coul($mcle)
 
238
      puts $id "$mcle : $tmp_coul($mcle)"
 
239
   }
 
240
   close $id
 
241
   if { $astk::ihm(style,couleur) == "perso" } {
 
242
      change_couleur perso
 
243
   }
 
244
}
 
245
 
 
246
# choix des polices
 
247
#################################################################
 
248
proc change_font { } {
 
249
# fenetre
 
250
   set fen .fen_font
 
251
   catch {destroy $fen}
 
252
   toplevel $fen
 
253
   wm withdraw $fen
 
254
   wm transient $fen .
 
255
   wm title $fen [ashare::mess ihm 331]
 
256
 
 
257
   pack [frame $fen.liste -relief solid -bd 1] -padx 10 -pady 10
 
258
 
 
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
 
267
   }
 
268
 
 
269
# ok
 
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
 
275
 
 
276
   ashare::centre_fen $fen .
 
277
   wm deiconify $fen
 
278
}
 
279
 
 
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"
 
288
      }
 
289
      set astk::ihm(style,font_$groupe) $newfont
 
290
      init_font
 
291
      ashare::save_prefs
 
292
      destroy $parent
 
293
      raffr_princ
 
294
   }
 
295
}