1 | # This program is under CECILL_B licence. See footer for details. |
---|
2 | |
---|
3 | |
---|
4 | # create the frame in wich an exclusive selection of model wil be done |
---|
5 | # create the menubutton used for selection |
---|
6 | proc modelxor_create { args } { |
---|
7 | |
---|
8 | set mandatory_arguments {path_father address} |
---|
9 | |
---|
10 | # Initializes the widget |
---|
11 | initWidget |
---|
12 | |
---|
13 | smartpacker_setup_modelframe $win $address |
---|
14 | |
---|
15 | # the menubutton seclector |
---|
16 | ttk::menubutton $win.mb -menu $win.mb.xor -textvariable widgetInfo($address-variable_title) |
---|
17 | menu $win.mb.xor -tearoff 0 |
---|
18 | pack $win.mb |
---|
19 | |
---|
20 | # this frame is where all xor choices will be used |
---|
21 | switchform_create $win.xor |
---|
22 | |
---|
23 | if {[dTree_attrExists $XMLtree $full_address_XML "groups"]==1} { |
---|
24 | set widgetInfo($address-groups) 1 |
---|
25 | } else { |
---|
26 | set widgetInfo($address-groups) 0 |
---|
27 | } |
---|
28 | |
---|
29 | set widgetInfo($address-full_address_XML_clean) $full_address_XML_clean |
---|
30 | set widgetInfo($address-children) [dTree_getChildren_fast $XMLtree $full_address_XML_clean ] |
---|
31 | |
---|
32 | |
---|
33 | set main_menu_reduced "" |
---|
34 | # find the redondant childs in the menu and gather , if groups are enabled |
---|
35 | if {$widgetInfo($address-groups)} { |
---|
36 | set main_menu "" |
---|
37 | foreach child $widgetInfo($address-children) { |
---|
38 | lappend main_menu [lindex [split $child "_"] 0] |
---|
39 | } |
---|
40 | foreach category $main_menu { |
---|
41 | set items [llength [lsearch -all $main_menu $category] ] |
---|
42 | if {$items > 1} { |
---|
43 | lappend main_menu_reduced $category |
---|
44 | } |
---|
45 | } |
---|
46 | set main_menu_reduced [lsort -unique $main_menu_reduced] |
---|
47 | } |
---|
48 | |
---|
49 | set widgetInfo($address-categories) $main_menu_reduced |
---|
50 | |
---|
51 | |
---|
52 | |
---|
53 | # add the groups (if any) |
---|
54 | set widgetInfo($address-catindex-none) 0 |
---|
55 | foreach category $main_menu_reduced { |
---|
56 | menu $win.mb.xor.$category -tearoff 0 |
---|
57 | $win.mb.xor add cascade -menu $win.mb.xor.$category -label "[string totitle $category]" |
---|
58 | set widgetInfo($address-catindex-$category) 0 |
---|
59 | set widgetInfo($address-catchildren-$category) "" |
---|
60 | } |
---|
61 | |
---|
62 | |
---|
63 | |
---|
64 | foreach child $widgetInfo($address-children) { |
---|
65 | set title [dTree_getAttribute_fast $XMLtree "$full_address_XML_clean $child" "title"] |
---|
66 | set child_nodeType [dTree_getAttribute_fast $XMLtree "$full_address_XML_clean $child" "nodeType"] |
---|
67 | switchform_add $win.xor $child |
---|
68 | gui_addpart -address $address.$child -path_father $win.xor.$child -class $child_nodeType -style "flat" |
---|
69 | |
---|
70 | |
---|
71 | # add the command either at the root or in the groups |
---|
72 | set category [lindex [split $child "_"] 0] |
---|
73 | if {[lsearch $widgetInfo($address-categories) $category] ==-1 } { |
---|
74 | $win.mb.xor add command -label "$title" -command [subst {modelxor_mb_action $win $address $child }] |
---|
75 | set widgetInfo($address-childindex-$child) $widgetInfo($address-catindex-none) |
---|
76 | set widgetInfo($address-childmenu-$child) $win.mb.xor |
---|
77 | set widgetInfo($address-childcategory-$child) "none" |
---|
78 | lappend widgetInfo($address-catchildren-none) $child |
---|
79 | incr widgetInfo($address-catindex-none) 1 |
---|
80 | } else { |
---|
81 | $win.mb.xor.$category add command -label "$title" -command [subst {modelxor_mb_action $win $address $child }] |
---|
82 | set widgetInfo($address-childindex-$child) $widgetInfo($address-catindex-$category) |
---|
83 | set widgetInfo($address-childmenu-$child) $win.mb.xor.$category |
---|
84 | set widgetInfo($address-childcategory-$child) "$category" |
---|
85 | lappend widgetInfo($address-catchildren-$category) $child |
---|
86 | incr widgetInfo($address-catindex-$category) 1 |
---|
87 | } |
---|
88 | } |
---|
89 | |
---|
90 | # Finishes the widget |
---|
91 | # append widgetInfo($address-check) [ subst {modelxor_check $win $address}] |
---|
92 | append widgetInfo($address-refreshStatus) [ subst {modelxor_refreshStatus $win $address}] |
---|
93 | |
---|
94 | finishWidget |
---|
95 | |
---|
96 | help_add_desc_docu_to_widget |
---|
97 | |
---|
98 | # initialize the layout by the default |
---|
99 | modelxor_mb_action $win $address $widgetInfo($address-variable) |
---|
100 | |
---|
101 | |
---|
102 | # clean the widget callBack on dstruction |
---|
103 | bind $win <Destroy> [ subst {widget_destroy $win $address}] |
---|
104 | |
---|
105 | return $win |
---|
106 | } |
---|
107 | |
---|
108 | |
---|
109 | proc modelxor_mb_action { win address child } { |
---|
110 | global widgetInfo XMLtree tmpTree |
---|
111 | |
---|
112 | # if this model is not available, switch to the previous. |
---|
113 | # set child_address "$address.$widgetInfo($address-variable)" |
---|
114 | |
---|
115 | # update the value |
---|
116 | if { $widgetInfo($address-variable) != $child} { |
---|
117 | set widgetInfo($address-variable) $child |
---|
118 | eval $widgetInfo($address-check) |
---|
119 | } |
---|
120 | } |
---|
121 | |
---|
122 | proc modelxor_refreshStatus {win address} { |
---|
123 | global widgetInfo XMLtree |
---|
124 | |
---|
125 | if {$widgetInfo($address-variable)!=""} { |
---|
126 | #puts "$widgetInfo($address-variable) and $widgetInfo($address-children)" |
---|
127 | # check if this child exist , if not move to the first availble |
---|
128 | if {$widgetInfo($address-variable) in $widgetInfo($address-children)} { |
---|
129 | # nothin to do, all okk |
---|
130 | } else { |
---|
131 | warning "found $widgetInfo($address-variable) , which is not one of $widgetInfo($address-children). Please check your setup " |
---|
132 | set widgetInfo($address-variable) [lindex $widgetInfo($address-children) 0] |
---|
133 | } |
---|
134 | |
---|
135 | switchform_raise $win.xor $widgetInfo($address-variable) |
---|
136 | set widgetInfo($address-variable_title) [dTree_getAttribute_fast $XMLtree "$widgetInfo($address-full_address_XML_clean) $widgetInfo($address-variable)" "title"] |
---|
137 | } |
---|
138 | |
---|
139 | |
---|
140 | # update the drop-down list |
---|
141 | foreach child $widgetInfo($address-children) { |
---|
142 | if {$widgetInfo($address.$child-visible)==0} { |
---|
143 | $widgetInfo($address-childmenu-$child) entryconfigure $widgetInfo($address-childindex-$child) -state disabled |
---|
144 | } else { |
---|
145 | $widgetInfo($address-childmenu-$child) entryconfigure $widgetInfo($address-childindex-$child) -state normal |
---|
146 | } |
---|
147 | } |
---|
148 | |
---|
149 | # move to the first visible children if needed |
---|
150 | set child_address "$address.$widgetInfo($address-variable)" |
---|
151 | |
---|
152 | # must be initialized in case of a change in the XML (new xor) |
---|
153 | if {[info exists widgetInfo($child_address-visible)] == 0} { |
---|
154 | set widgetInfo($child_address-visible) 0 |
---|
155 | puts ">>> modelxor_refreshstatus initialisation of visibility" |
---|
156 | } |
---|
157 | |
---|
158 | if {$widgetInfo($child_address-visible)==0} { |
---|
159 | set index 0 |
---|
160 | set found 0 |
---|
161 | foreach child $widgetInfo($address-catchildren-$widgetInfo($address-childcategory-$child)) { |
---|
162 | if {$widgetInfo($address.$child-visible)==1} { |
---|
163 | set found 1 |
---|
164 | $widgetInfo($address-childmenu-$child) invoke $index |
---|
165 | } |
---|
166 | if {$found} { |
---|
167 | break |
---|
168 | } |
---|
169 | incr index |
---|
170 | } |
---|
171 | if {$found == 0} { |
---|
172 | warning "Error in the XML library for the model:\n $address \n existif declarations allowed a dead end. " |
---|
173 | } |
---|
174 | } |
---|
175 | smartpacker_update_visibility $win $address |
---|
176 | } |
---|
177 | |
---|
178 | |
---|
179 | |
---|
180 | |
---|
181 | |
---|
182 | # Copyright CERFACS 2014 |
---|
183 | # |
---|
184 | # antoine.dauptain@cerfacs.fr |
---|
185 | # |
---|
186 | # This software is a computer program whose purpose is to ensure technology |
---|
187 | # transfer between academia and industry. |
---|
188 | # |
---|
189 | # This software is governed by the CeCILL-B license under French law and |
---|
190 | # abiding by the rules of distribution of free software. You can use, |
---|
191 | # modify and/ or redistribute the software under the terms of the CeCILL-B |
---|
192 | # license as circulated by CEA, CNRS and INRIA at the following URL |
---|
193 | # "http://www.cecill.info". |
---|
194 | # |
---|
195 | # As a counterpart to the access to the source code and rights to copy, |
---|
196 | # modify and redistribute granted by the license, users are provided only |
---|
197 | # with a limited warranty and the software's author, the holder of the |
---|
198 | # economic rights, and the successive licensors have only limited |
---|
199 | # liability. |
---|
200 | # |
---|
201 | # In this respect, the user's attention is drawn to the risks associated |
---|
202 | # with loading, using, modifying and/or developing or reproducing the |
---|
203 | # software by the user in light of its specific status of free software, |
---|
204 | # that may mean that it is complicated to manipulate, and that also |
---|
205 | # therefore means that it is reserved for developers and experienced |
---|
206 | # professionals having in-depth computer knowledge. Users are therefore |
---|
207 | # encouraged to load and test the software's suitability as regards their |
---|
208 | # requirements in conditions enabling the security of their systems and/or |
---|
209 | # data to be ensured and, more generally, to use and operate it in the |
---|
210 | # same conditions as regards security. |
---|
211 | # |
---|
212 | # The fact that you are presently reading this means that you have had |
---|
213 | # knowledge of the CeCILL-B license and that you accept its terms. |
---|