source: CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_selection.tcl @ 4775

Last change on this file since 4775 was 4775, checked in by aclsce, 5 years ago
  • Imported oasis3-mct from Cerfacs svn server (not suppotred anymore).

The version has been extracted from ​https://oasis3mct.cerfacs.fr/svn/branches/OASIS3-MCT_2.0_branch/oasis3-mct@1818
File size: 12.0 KB
Line 
1#  This program is under CECILL_B licence. See footer for details.
2
3proc selection_create { args } {
4    set mandatory_arguments { path_father address }
5   
6    # Initializes the widget
7    initWidget
8   
9   
10 
11   
12    ttk::frame $win
13   
14    eval $widgetInfo(packme-$win)
15   
16   
17    ttk::frame $win.forceps -width $widgetInfo(guiSmallWidgetWidth) -height 0     
18    set title [dTree_getAttribute $XMLtree $full_address_XML "title"]
19   
20    set widgetInfo($address-headings) [dTree_tryGetAttribute $XMLtree $full_address_XML "headings" ""]
21    set widgetInfo($address-controls) [split [dTree_tryGetAttribute $XMLtree $full_address_XML "controls" "toggle"] ";"]
22    set widgetInfo($address-selection) [dTree_tryGetAttribute $XMLtree $full_address_XML "selection" "multiple"] 
23    set widgetInfo($address-filter) ""
24    set widgetInfo($address-col_order) "0"
25    set widgetInfo($address-status) 1
26    set widgetInfo($address-mode) ""   
27    if {[dTree_attrExists $XMLtree $full_address_XML "require"]} {
28        set widgetInfo($address-mode) "require"       
29    }
30   
31   
32   
33    # controls
34    ttk::frame $win.c
35    grid $win.c -sticky e -column 0 -row 0
36    ttk::label $win.c.lb -text "$title:" -justify right
37    ttk::button $win.c.button -text "on" -image icon_checkedunchecked -text "Toggle all" -compound left -command [subst {selection_toggle_all $win $address}]
38   
39    ttk::label $win.c.flb -text "Filter" -justify right
40    ttk::entry $win.c.fle -textvariable widgetInfo($address-filter) -justify right
41    bind $win.c.fle <KeyRelease> [subst {selection_filter $win $address}]
42   
43
44    pack $win.c.lb -side top -fill x   
45    if {"toggle" in $widgetInfo($address-controls)} {
46        pack $win.c.button  -side top -fill x
47    }
48    if {"filter" in $widgetInfo($address-controls)} {
49        pack $win.c.flb -side top -fill x
50        pack $win.c.fle -side top -fill x
51    } 
52   
53    # treeview
54    ttk::treeview  $win.tv -selectmode browse -show {tree} -yscrollcommand [list $win.sby set] -height 10
55    ttk::scrollbar $win.sby -orient vertical -command [list $win.tv yview]
56    grid $win.tv -sticky e -column 1 -row 0
57    grid $win.sby -sticky news -column 2 -row 0
58   
59   
60   
61   
62   
63    bind $win.tv <Button-1> [subst {selection_toggle $win $address \%x \%y} ]
64    bind $win.tv <Enter> [subst { set tabscroll 0 }]
65    bind $win.tv <Leave> [subst { set tabscroll 1 }]
66   
67   
68    #add the check/refresh procedure to the bindings of the variable
69    append widgetInfo($address-check) [ subst {
70        selection_check $win $address
71    }]
72    append widgetInfo($address-refresh) [ subst {
73        selection_refresh $win $address
74    }]
75    finishWidget
76   
77    # to update content if called by a modelXOR
78    selection_refresh $win $address
79   
80    return $win
81}
82
83proc selection_filter { win address } {
84    global widgetInfo
85   
86    # remove the filtered values
87    set new_content "" 
88    foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
89        set key "[lindex $keyvalue 0]"
90        set value  [lindex $keyvalue 1]
91       
92        if {$widgetInfo($address-filter) != "" && ![string match "*$widgetInfo($address-filter)*" $key]} {
93            set value 0
94        }
95        lappend new_content $key
96        lappend new_content $value
97    }
98   
99    set widgetInfo($address-variable) [join $new_content ";" ]
100    selection_refresh $win $address
101   
102   
103}
104
105proc selection_toggle { win address x y} {
106    global widgetInfo
107   
108    set row [$win.tv identify row $x $y]
109    set col [$win.tv identify column $x $y]
110   
111   
112    if {$row != ""} {
113        set new_variable ""
114        foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
115            set key [lindex $keyvalue 0]
116           
117            if {$widgetInfo($address-selection)== "single"} {
118                set value 0   
119            } else {
120                set value  [lindex $keyvalue 1]
121            }
122           
123            if {$key == $row } {
124                if {$value == 1} {
125                    set value 0
126                } else {
127                    set value 1   
128                }
129            }
130            lappend new_variable $key
131            lappend new_variable $value
132        }
133        set widgetInfo($address-variable) [join $new_variable ";"]
134        selection_refresh $win $address
135        eval $widgetInfo($address-check)
136       
137       
138    } else {
139       
140        set widgetInfo($address-col_order) [string trim $col \"#\"]
141        selection_refresh $win $address
142       
143    }
144}
145
146
147
148proc selection_toggle_all { win address } {
149    global widgetInfo
150    set all 0
151    set selected 0
152    foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
153        set value  [lindex $keyvalue 1]
154        incr all
155        if {$value == 1} {incr selected}
156    }
157    if {$all == 0} {return}
158   
159    if {[expr {1.*$selected/$all}]>0.5} {
160        set toggle 0
161    } else {
162        set toggle 1
163    }
164   
165    set new_variable ""
166    foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
167        set key [lindex $keyvalue 0]
168        lappend new_variable $key
169       
170        if {$widgetInfo($address-filter) == "" || [string match "*$widgetInfo($address-filter)*" $key]} {
171            lappend new_variable $toggle
172        } else {
173            lappend new_variable 0
174        }
175       
176    }
177   
178    set widgetInfo($address-variable) [join $new_variable ";"]
179   
180    selection_refresh $win $address
181    eval $widgetInfo($address-check)
182}
183
184
185
186proc selection_refresh {win address} {
187    global widgetInfo
188    #debug "refresh"
189
190    regsub -all {\s+} $widgetInfo($address-variable) "_" widgetInfo($address-variable)   
191   
192    if {$widgetInfo($address-mode) =="require"} {
193        selection_require $win $address
194    }
195   
196    # Removing old treeview content
197    foreach item [$win.tv children ""] {
198        $win.tv delete $item
199    }
200   
201   
202   
203    # name and width of the first column
204    #$win.tv  configure -columns " "
205    # get columns
206    set nb_column 1
207    foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
208        set nvals [llength [split [lindex $keyvalue 0] "#"]]
209        if {$nb_column < $nvals } { set nb_column $nvals}
210    }
211    set lbl_column ""
212   
213   
214   
215   
216    if {$nb_column > 1} {
217     
218        $win.tv  configure -show {tree headings}
219        $win.forceps configure -width $widgetInfo(guiBigWidgetWidth)
220        set colwidth [expr {int(0.5* $widgetInfo(guiSmallWidgetWidth)) }]
221       
222        for {set i 0} {$i < $nb_column} {incr i} {
223            if {$i>0} {
224                lappend lbl_column col_$i
225            }
226            $win.tv configure -columns $lbl_column
227#            $win.tv column #$i -width $colwidth
228        }
229       
230    } else {
231        $win.tv  configure -show {tree}
232        $win.forceps configure -width $widgetInfo(guiSmallWidgetWidth)
233        set colwidth [expr {int(0.5* $widgetInfo(guiSmallWidgetWidth)) }]
234        $win.tv column #0 -width $colwidth
235        $win.tv configure -columns ""
236    }
237     
238    set headings [split $widgetInfo($address-headings) ";"]
239    if {$headings != ""} {
240        if {[llength $headings] >= $nb_column  } {
241             for {set i 0} {$i < $nb_column} {incr i} {
242                $win.tv heading #$i -text [lindex $headings $i ]
243            }
244        } else {
245            puts "error, found $nb_column columns with to few headings:  $headings"
246        }
247    }
248   
249   
250     
251    set tvheight [llength [keyvalue_listcsv $widgetInfo($address-variable)]]
252    $win.tv configure -height [expr {min($tvheight,10)}]
253   
254   
255   
256   
257   
258    # Reconstructing and filtering
259    foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
260        set key "[lindex $keyvalue 0]"
261        set value  [lindex $keyvalue 1]
262       
263        set colid 0
264        set head ""
265        if {$widgetInfo($address-filter) == "" || [string match "*$widgetInfo($address-filter)*" $key]} {
266            foreach elmt [split $key "#"] {
267               
268                if {$colid == 0} {
269                    set head $elmt
270                    if $value {
271                        $win.tv insert {} end -id "$key" -text "$head" -image icon_checked
272                    } else {
273                        $win.tv insert {} end -id "$key" -text "$head" -image icon_unchecked
274                    }
275                } else {
276                    $win.tv set "$key" #$colid "$elmt"
277                }
278                incr colid
279            }
280        }
281    }
282   
283   
284    # reorderin
285    set sortlist ""
286    set colid $widgetInfo($address-col_order)
287   
288    foreach keyvalue [keyvalue_listcsv $widgetInfo($address-variable)]  {
289        set key [lindex $keyvalue 0]
290        if {$widgetInfo($address-filter) == "" || [string match "*$widgetInfo($address-filter)*" $key]} {
291            set keylist [split $key "#"]
292            set elmt [string trim [lindex  $keylist $colid] ]
293            if {$elmt ==""} {set elmt "ZZZZZZ" }
294            lappend sortlist "$key $elmt"
295        }
296    }
297    set sortlist [lsort -dictionary -decreasing -index 1 $sortlist]
298    foreach pair $sortlist {
299        $win.tv move [lindex $pair 0] {} 0
300    }
301}
302
303
304
305proc selection_check {win address} {
306    global widgetInfo
307   
308}
309
310
311# prepare the filling in a different manner if a require is waiting
312proc selection_require { win address } {
313    global widgetInfo
314   
315    #debug "require"
316   
317    set reqVar $widgetInfo($address-requiredValue)
318    set default [lindex [split $widgetInfo($address-default) ";"]  1]
319    if {$default==""} {set default 0.0 }
320   
321    set new_content ""       
322    # get the present values of the components if they belon to reQvar   
323    foreach actual_component $reqVar {
324        set component_found 0
325        foreach keyvalue [keyvalue_listcsv  $widgetInfo($address-variable)]  {
326            set key [lindex $keyvalue 0]
327            set value [lindex  $keyvalue 1 ]
328           
329            if {$key == $actual_component} {
330                lappend new_content $key
331                lappend new_content $value
332                set component_found 1
333            }
334        }
335        if {$component_found==0 } {
336            lappend new_content $actual_component
337            lappend new_content $default
338        }
339    }
340   
341   
342    set widgetInfo($address-variable) [join $new_content ";" ]
343   
344    # hide id void list
345    if {[llength $new_content] == 0} {
346        pack forget $win
347        return
348    } else {
349        eval $widgetInfo(packme-$win)
350    }
351   
352    #debug "req : $widgetInfo($address-requiredValue) "
353}
354
355
356
357
358
359#  Copyright CERFACS 2014
360#   
361#  antoine.dauptain@cerfacs.fr
362#   
363#  This software is a computer program whose purpose is to ensure technology
364#  transfer between academia and industry.
365#   
366#  This software is governed by the CeCILL-B license under French law and
367#  abiding by the rules of distribution of free software.  You can  use,
368#  modify and/ or redistribute the software under the terms of the CeCILL-B
369#  license as circulated by CEA, CNRS and INRIA at the following URL
370#  "http://www.cecill.info".
371#   
372#  As a counterpart to the access to the source code and  rights to copy,
373#  modify and redistribute granted by the license, users are provided only
374#  with a limited warranty  and the software's author,  the holder of the
375#  economic rights,  and the successive licensors  have only  limited
376#  liability.
377#   
378#  In this respect, the user's attention is drawn to the risks associated
379#  with loading,  using,  modifying and/or developing or reproducing the
380#  software by the user in light of its specific status of free software,
381#  that may mean  that it is complicated to manipulate,  and  that  also
382#  therefore means  that it is reserved for developers  and  experienced
383#  professionals having in-depth computer knowledge. Users are therefore
384#  encouraged to load and test the software's suitability as regards their
385#  requirements in conditions enabling the security of their systems and/or
386#  data to be ensured and,  more generally, to use and operate it in the
387#  same conditions as regards security.
388#   
389#  The fact that you are presently reading this means that you have had
390#  knowledge of the CeCILL-B license and that you accept its terms.
Note: See TracBrowser for help on using the repository browser.