source: CPL/oasis3-mct/branches/OASIS3-MCT_2.0_branch/util/oasisgui/opentea/create_tabs.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: 14.0 KB
Line 
1#  This program is under CECILL_B licence. See footer for details.
2
3proc tabs_create { args } {
4    global widgetInfo
5   
6    set mandatory_arguments { path_father address}
7   
8    read_arguments
9   
10   
11    switch $widgetInfo(guimode) {
12        "treeview" {
13            ttk::notebook $path_father.nb -style "NoTabs.TNotebook"
14        }
15        "multicolumn" {
16            ttk::notebook $path_father.nb 
17            ttk::notebook::enableTraversal $path_father.nb
18        }
19    }
20   
21    bind $path_father.nb  <<NotebookTabChanged>> [subst {
22        # get the tab under focus , finishing by .vport.form
23        set widgetInfo(tabfocus)  \[$path_father.nb select\]
24        smartpacker_regrid
25        #scrollform_upperleft "\$widgetInfo(tabfocus).sf"
26    }]
27    # make the gui sensitive to SetView to regrid widgets in multicolumns mode
28    bind . <<SetView>> +{tabs_update}
29   
30   
31    bind $path_father.nb <Destroy> "tabs_destroy $path_father.nb"
32   
33    return $path_father.nb
34}
35
36proc tabs_add { args } {
37    global widgetInfo codesPath solverPath
38    set mandatory_arguments { path_father address}
39   
40    initWidget
41   
42   
43   
44    set solver ""
45    set address_solver_XML ""
46    foreach level $full_address_XML {
47        lappend address_solver_XML $level
48        set nodeType [dTree_getAttribute $XMLtree "$address_solver_XML" "nodeType"]
49        if {$nodeType=="solver"} {
50            set solver $level
51        }
52    }
53   
54    set widgetInfo($address-custombutton) [dTree_tryGetAttribute $XMLtree $full_address_XML "custombutton" "Process"]
55    set widgetInfo($address-starttime) "0"
56    set widgetInfo($address-endtime) "0"
57   
58   
59    # insert object in tree
60    if {$widgetInfo(guimode)=="treeview"} {
61        $widgetInfo(globaltv.path) insert $solver end -id $name -text [dTree_getAttribute $XMLtree $full_address_XML "title"] -tag "$solver $solver.$name"
62        $widgetInfo(globaltv.path)  tag bind $solver.$name <ButtonPress> [subst {$path_father select $path_father.$name}]
63    }   
64   
65    set widgetInfo($address-refreshStatus) [subst {
66        tab_refreshStatus $path_father $solver $name $address 
67    }]
68    set title "[dTree_getAttribute $XMLtree $full_address_XML title]"
69   
70    if {[dTree_attrExists $XMLtree $full_address_XML "script"]} {
71        set script [dTree_getAttribute $XMLtree $full_address_XML "script"]
72        set args [split [dTree_tryGetAttribute $XMLtree $full_address_XML "script_args" ""] ";"]
73        set widgetInfo($address-args) $args
74        set widgetInfo($address-scriptAddress) [file join $solverPath scripts $script]
75        if {![file exists $widgetInfo($address-scriptAddress)]} {
76            error "File not found : \n$widgetInfo($address-scriptAddress)"
77        }
78    }
79   
80    lappend widgetInfo($path_father-tabnames) $name
81    lappend widgetInfo($path_father-tab-$name-valid) 1
82    $path_father add [ttk::frame $path_father.$name] -text $title -sticky news
83   
84   
85   
86   
87   
88   
89    set widgetInfo($address-order) [$path_father index  $path_father.$name]
90   
91    if {$widgetInfo(guimode)=="multicolumn"} { 
92        ttk::separator $path_father.$name.sep1 -orient horizontal
93        pack $path_father.$name.sep1 -side top -fill x
94    }
95   
96    scrollform_create $path_father.$name.sf
97   
98    set winreturn [scrollform_interior $path_father.$name.sf]
99
100    #add help
101    set docu_prefered_side "top"
102    set docu_prefered_place $winreturn
103    help_add_desc_docu_to_widget
104   
105   
106    ttk::separator $path_father.$name.sep2 -orient horizontal
107    pack $path_father.$name.sep2 -side top -fill x
108   
109    ## PROCESS ##
110    set cmd_widget_to_tree [subst {
111        #update_all_widgets $address widget_to_tree
112        set widgetInfo($address-status) 1
113        eval \$widgetInfo($address-refreshStatus)
114    }]
115   
116   
117   
118   
119   
120    ttk::button $path_father.$name.buttW2T -text $widgetInfo($address-custombutton) -command [subst {
121        log "\n@@@@@@@@ Process Tab '$title' @@@@@@@"
122        Validate $win $address
123    }]
124    pack $path_father.$name.buttW2T -side right -anchor e -padx 2 -pady 2
125   
126    ## CANCEL ##
127    set cmd_tree_to_widget [subst {
128        #update_all_widgets $address tree_to_widget
129        RefreshFamily $address
130    }]
131    ttk::button $path_father.$name.buttT2W -text "Cancel" -command $cmd_tree_to_widget
132    #pack $path_father.$name.buttT2W -side right -anchor e -padx 2 -pady 2
133   
134    ### SCRIPT IF NEEDED ####
135    if {[info exists widgetInfo($address-scriptAddress)]} {
136        set widgetInfo($address-progressValue) 0
137        set widgetInfo($address-cancellation) 0
138        ttk::progressbar $path_father.$name.progress  -mode indeterminate
139        ttk::label $path_father.$name.status -width -20 -textvariable widgetInfo($address-status_txt) -justify left -compound left
140        $path_father.$name.progress stop
141        pack $path_father.$name.progress -side right -anchor e -padx 2 -pady 2   
142        pack $path_father.$name.status -side right -anchor e -padx 2 -pady 2           
143       
144   
145        set widgetInfo($address-onScriptStarts) [subst {
146                CheckValidationStatus $address
147                UpdateValidationStatus $address
148                if {\$widgetInfo($address-status) == -1} {
149                    set widgetInfo($address-cancellation) 1
150                    set widgetInfo($address-status_txt) "Status issue, Cancelled ..."
151                    Stop_think normal
152                } else {
153                    set widgetInfo($address-cancellation) 0
154                    $win.progress start
155                    set widgetInfo(action-callingAddress) $address     
156                    set widgetInfo($address-status_txt) "Running ..."
157                }
158        }]
159       
160        set widgetInfo($address-updateProgress) [subst {
161                $win.progress stop           
162                $win.progress configure -mode determinate -value \$widgetInfo($address-progressValue)
163                           
164        }]
165           
166        set widgetInfo($address-onScriptStops) [subst {
167             $win.progress configure -mode indeterminate           
168            $win.progress stop
169            set widgetInfo($address-status) -1
170            set widgetInfo($address-status_txt) "Execution error : check logs. Took  \[printtime \$widgetInfo($address-starttime) \$widgetInfo($address-endtime) \]  s."                   
171            eval \$widgetInfo($address-refreshStatus)
172        }]
173       
174        set widgetInfo($address-onScriptEnds) [subst {
175             $win.progress configure -mode indeterminate             
176            $win.progress stop
177            set duration  \[format "%0.3f" \[expr {($widgetInfo($address-endtime)-\$widgetInfo($address-starttime))*0.001}  \]\]
178            set widgetInfo($address-status_txt) "Done in   \[printtime \$widgetInfo($address-starttime) \$widgetInfo($address-endtime) \] s."                   
179            if {\$widgetInfo($address-status) != -1} {
180                # Umbrella backward  then upward
181                CheckValidationStatus $address
182                UpdateValidationStatus $address
183            }
184        }]
185   
186    }
187   
188   
189    finishWidget
190   
191    lappend widgetInfo(form_to_update) $path_father.$name
192   
193    return $winreturn
194}
195
196proc tabs_update {}  {
197    global widgetInfo
198   
199    if {"$widgetInfo(ReGrid)" == "no"} {
200         set widgetInfo(ReGrid) [after 10 smartpacker_regrid ]
201    } else {
202        after cancel $widgetInfo(ReGrid)
203        set widgetInfo(ReGrid) [after 10 smartpacker_regrid ]
204    }
205}
206   
207
208# Utilities
209proc tabs_destroy {win} {
210    global widgetInfo
211    foreach item [array names widgetInfo "$path_father-*"] {
212        unset widgetInfo($item)
213    }
214}
215
216
217proc tab_refreshStatus {path_father solver name tab_address} {
218    global widgetInfo
219   
220    if {$widgetInfo($tab_address-visible)} {
221        $path_father add $path_father.$name
222        if {$widgetInfo(guimode)=="treeview"} {
223            $widgetInfo(globaltv.path) move $name $solver $widgetInfo($tab_address-order)
224        }
225    } else {
226        $path_father hide $path_father.$name
227        if {$widgetInfo(guimode)=="treeview"} {
228            $widgetInfo(globaltv.path) detach $name
229        }
230    }
231   
232    switch $widgetInfo($tab_address-status) {
233        "-2" {
234            switch $widgetInfo(guimode) {
235                "treeview" {
236                    $widgetInfo(globaltv.path) item $name -image icon_void
237                }
238                "multicolumn" {
239                    $path_father tab $path_father.$name -image icon_void -compound left       
240                }
241            }
242        }
243        "-1" {
244            $path_father.$name.buttT2W configure -state normal
245            $path_father.$name.buttW2T configure -state normal
246            switch $widgetInfo(guimode) {
247                "treeview" {
248                    $widgetInfo(globaltv.path) item $name -image icon_error
249                }
250                "multicolumn" {
251                    $path_father tab $path_father.$name -image icon_error -compound left       
252                }
253            }           
254        }
255        "0"  {
256            $path_father.$name.buttT2W configure -state normal
257            $path_father.$name.buttW2T configure -state normal
258            switch $widgetInfo(guimode) {
259                "treeview" {
260                    $widgetInfo(globaltv.path) item $name -image icon_question
261                }
262                "multicolumn" {
263                    $path_father tab $path_father.$name -image icon_question -compound left       
264                }
265            }       
266        }
267        "1"  {
268            #$path_father.$name.buttT2W configure -state disabled
269            #$path_father.$name.buttW2T configure -state disabled
270            switch $widgetInfo(guimode) {
271                "treeview" {
272                    $widgetInfo(globaltv.path) item $name -image icon_ok
273                }
274                "multicolumn" {
275                    $path_father tab $path_father.$name -image icon_ok -compound left       
276                }
277            }       
278        }
279    }
280}
281
282# trigger the update of all widget to tree
283# all values presently stored in widgets are written into the tree
284proc update_widget_to_tree {tab_address} {
285    get_all_widgets $tab_address widget_to_tree
286}
287
288
289# trigger the update of the tree to all widget in this tab
290# all values in the tree DIFFERENT than widget are broadcasted to widget
291proc update_tree_to_widget {tab_address} {
292    get_all_widgets $tab_address tree_to_widget
293}
294
295
296# starting from the tabs address
297# query the list of all widgets address in the case tree (DStree)
298# this list in the fomart .root.AVBP.tab1_mesh.mesh.file will be used
299# in the command "proccess" to update the DS tree according all widgets.
300proc update_all_widgets {tab_address mode} {
301    global  widgetInfo
302    set widgetInfo($tab_address-widgets) ""
303    set address_XML [split $tab_address "." ]
304   
305    recc_get_childs $tab_address "$address_XML" $mode
306}
307
308# search for childs in the case tree.
309# if the child have a value, then
310# if the value differs between tree and widget,
311# the address is stored in tabsInfo
312proc recc_get_childs {tab_address address_XML mode} {
313    global DStree widgetInfo widgetInfo
314    set children [dTree_getChildren $DStree $address_XML]
315    foreach child $children {
316        set child_address_XML "$address_XML $child"
317        set child_address  [join $child_address_XML "."]
318       
319        set isvalue [dTree_attrExists $DStree $child_address_XML "value" ]
320        if {$isvalue} {
321            lappend widgetInfo($tab_address-widgets) $child_address
322        }
323       
324        set tree_value [dTree_getAttribute $DStree "$child_address_XML" "value"]
325        if {$tree_value != $widgetInfo($child_address-variable) && $widgetInfo($child_address-validateMode) == "onProcess"} {
326            switch $mode {
327                "tree_to_widget" {
328                    response_queue Cancel $tab_address treeChange $child_address
329                    event generate . <<treeChange-$child_address>>
330                }
331                "widget_to_tree" {
332                    response_queue Process $tab_address widgetValidate $child_address
333                    event generate . <<widgetValidate-$child_address>>
334                }
335            }
336        }
337        recc_get_childs $tab_address "$child_address_XML" $mode
338    }
339   
340   
341}
342
343
344
345proc tabs_docu {address chin help_dir} {
346
347    global widgetInfo XMLtree     
348    set full_address_XML [split $address "."]
349   
350    set title [dTree_getAttribute $XMLtree $full_address_XML "title"]
351    puts $chin "<h2> Tab. $title </h2>"
352   
353    return
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.