1 # Copyright (c) 1999-2014 OPEN CASCADE SAS
3 # This file is part of Open CASCADE Technology software library.
5 # This library is free software; you can redistribute it and/or modify it under
6 # the terms of the GNU Lesser General Public License version 2.1 as published
7 # by the Free Software Foundation, with special exception defined in the file
8 # OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
9 # distribution for complete text of the license and disclaimer of any warranty.
11 # Alternatively, this file may be used under the terms of Open CASCADE
12 # commercial license or contractual agreement.
14 ###########################
19 ###########################
21 # Open : double-clic or +
22 # Close : double-clic or -
23 # Refresh tree : close top level and re-open
26 # white : interoperable
27 # white + c : non interoperable
29 # Red : not yet commited in transaction #0
33 proc __update { args } {
38 proc treebrowser { TreeBrowser } {
41 global TREE_LabelStyle
42 global TREE_LabelStyle1
43 global TREE_AttributeStyle
44 global TREE_AttributeStyle1
45 global TREE_AttributeStyle2
50 tixPref:InitFontSet:14Point
52 set TREE_LabelStyle [tixDisplayStyle imagetext \
57 set TREE_LabelStyle1 [tixDisplayStyle imagetext \
60 -foreground SeaGreen2 \
63 set TREE_AttributeStyle [tixDisplayStyle imagetext \
68 set TREE_AttributeStyle1 [tixDisplayStyle imagetext \
74 set TREE_AttributeStyle2 [tixDisplayStyle imagetext \
83 set top [frame $w.thu -bd 1 -relief raised -background Bisque3]
88 set p [tixPanedWindow $top.p -orient horizontal -height 400 -width 700]
89 pack $p -expand yes -fill both -padx 4 -pady 4
91 TREE:Tree:InitTreePanel $TreeBrowser $w $p
92 #TREE:Tree:InitTextPanel $TreeBrowser $w $p
94 tixForm $top -left 2 -top 2 -right %99 -bottom %99
99 ###############################################################################
102 proc TREE:Tree:InitTreePanel { TreeBrowser w p } {
110 set p1 [$p add pane1 -expand 1 -size 700] ; $p1 config -relief flat
111 set tree [tixTree $p1.tree \
112 -opencmd [list TREE:Tree:Open $TreeBrowser $w] \
114 hlist.separator "^" \
115 hlist.font 9x15bold \
116 hlist.background Bisque3 \
117 hlist.foreground Black \
119 pack $p1.tree -expand yes -fill both -padx 4 -pady 4
121 # -browsecmd TREE:Tree:BrowseCmd
122 # Cette option peut etre ajoutee a la commande tixTree,
123 # mais elle declanche l'appel a la procedure a chaque clic ,
124 # double-clic, voire a chaque appui puis relachement de souris!!!
126 # to see different fonts: /usr/openwin/lib/X11/fonts/misc or xlsfonts?
127 # 8x13 8x13bold 9x15 9x15bold
128 # hlist.font 8x13bold
132 set TREE_WINDOWS($w,NAV,tree) $tree
133 set TREE_WINDOWS($w,NAV,hlist) [$tree subwidget hlist]
134 $TREE_WINDOWS($w,NAV,hlist) add ^ \
136 -data [list $TreeBrowser Root]
137 $TREE_WINDOWS($w,NAV,tree) setmode ^ open
140 ###############################################################################
143 proc TREE:Tree:InitTextPanel { TreeBrowser w p } {
150 set p2 [$p add pane2 -expand 4 -size 400] ; $p2 config -relief flat
151 tixScrolledText $p2.st
152 pack $p2.st -expand yes -fill both -padx 4 -pady 4
154 set TREE_WINDOWS($w,NAV,text) [$p2.st subwidget text]
158 $TREE_WINDOWS($w,NAV,text) insert end " Welcome to the QDF browser (Rev #.#)\n"
159 $TREE_WINDOWS($w,NAV,text) insert end "--------------------------------------\n\n"
160 $TREE_WINDOWS($w,NAV,text) insert end "This browser is an easy to use prototype made with Tix technology. We hope it will be usefull for understanding and debugging QDF.\n"
161 $TREE_WINDOWS($w,NAV,text) insert end "\t\t\t\tFID & YAN"
164 ###############################################################################
167 proc TREE:Tree:BrowseCmd { dir } {
170 ###############################################################################
171 # Se positionne sur l'entry pere et update les fenetres.
173 proc FCTREE:Tree:Up { w } {
178 if { [set here [$TREE_WINDOWS($w,NAV,hlist) info anchor]] != {} } {
179 if { [set up [$TREE_WINDOWS($w,NAV,hlist) info parent $here]] != {} } {
180 TREE:Tree:ShowUp $w $up
181 set TREE_GLOBALS(CWD) [lindex [$TREE_WINDOWS($w,NAV,hlist) info data $up] 0]
186 ###############################################################################
187 # Se positionne sur l'entry up sans update (History)
189 proc TREE:Tree:ShowUp { w dir } {
191 #puts "TREE:Tree:ShowUp"
193 $TREE_WINDOWS($w,NAV,hlist) anchor clear
194 $TREE_WINDOWS($w,NAV,hlist) anchor set $dir
195 $TREE_WINDOWS($w,NAV,hlist) selection clear
196 $TREE_WINDOWS($w,NAV,hlist) selection set $dir
197 $TREE_WINDOWS($w,NAV,hlist) see $dir
200 ###############################################################################
203 proc TREE:Tree:Open { TreeBrowser w dir} {
206 #puts "TREE:Tree:Open"
210 if {[$TREE_WINDOWS($w,NAV,hlist) info children $dir] != {}} {
211 # The root branch already exists in hlist.
212 # Clear all its children to force the tree to be updated.
213 foreach kid [$TREE_WINDOWS($w,NAV,hlist) info children $dir] {
214 $TREE_WINDOWS($w,NAV,hlist) delete entry $kid
219 if {[$TREE_WINDOWS($w,NAV,hlist) info children $dir] != {}} {
220 # The branch exists in hlist.
221 foreach kid [$TREE_WINDOWS($w,NAV,hlist) info children $dir] {
222 $TREE_WINDOWS($w,NAV,hlist) show entry $kid
224 set data [$TREE_WINDOWS($w,NAV,hlist) info data $dir]
225 #set loc [lindex $data 0]
227 # The branch is unknown.
230 TREE:Tree:Fill $TreeBrowser $w $dir
235 ###############################################################################
238 proc TREE:Tree:Fill { TreeBrowser w dir } {
242 #puts "TREE:Tree:Fill"
244 set data [$TREE_WINDOWS($w,NAV,hlist) info data $dir]
245 #set loc [lindex $data 0]
246 set type [lindex $data 1]
248 #puts "====================="
253 #puts "====================="
258 TREE:Tree:UpdateRoot $TreeBrowser $w $dir
262 set lab [lindex $data 0]
263 TREE:Tree:UpdateNode $TreeBrowser $w $dir $lab
267 TREE:Tree:terminal $TreeBrowser $w $dir
271 puts "type non reconnu"
276 ###############################################################################
279 proc TREE:Tree:UpdateRoot { TreeBrowser w dir } {
282 global TREE_AttributeStyle
283 global TREE_AttributeStyle1
284 #puts "TREE:Tree:UpdateRoot"
286 foreach nodeItem [split [OpenNode $TreeBrowser ""] "\\" ] {
288 TREE:Tree:DecodeNodeItem $TreeBrowser $w $dir $nodeItem
294 ###############################################################################
297 proc TREE:Tree:UpdateNode { TreeBrowser w dir lab} {
300 global TREE_AttributeStyle
301 global TREE_AttributeStyle1
302 #puts "TREE:Tree:UpdateNode"
304 foreach nodeItem [split [OpenNode $TreeBrowser $lab ] "\\" ] {
306 TREE:Tree:DecodeNodeItem $TreeBrowser $w $dir $nodeItem
311 ###############################################################################
313 # "LabelEntry "Name" DynamicType Executable|Forgotten Failed|Success First|Null [ LabelFather]"
314 proc TREE:Tree:DecodeNodeItem { TreeBrowser w dir nodeItem} {
317 global TREE_AttributeStyle
318 global TREE_AttributeStyle1
319 global TREE_AttributeStyle2
320 #puts "TREE:Tree:DecodeNodeItem"
323 set standardimage [tix getimage file]
324 set forgottenimage [tix getimage maximize]
325 set image $standardimage
327 # Information first split
328 set tmplist [split $nodeItem " "]
329 set labentry [lindex $tmplist 0]
330 set name [lindex $tmplist 1]
331 set type [lindex $tmplist 2]
332 #set exec [lindex $tmplist 3]
333 #set state [lindex $tmplist 4]
334 set children [lindex $tmplist 3]
335 set father [lindex $tmplist 4]
336 set first [lindex $tmplist 5]
337 set next [lindex $tmplist 6]
338 set previous [lindex $tmplist 7]
340 #puts "labentry : $labentry"
343 #puts "state : $state"
345 #puts "children : $children"
346 #puts "father : $father"
347 #puts "first : $first"
349 #puts "previous : $previous"
351 # Label entry , name & Dynamic type.
352 set ll [expr [string length $name] -2]
354 set textname "$labentry [string range $name 1 $ll] $type"
356 set textname "$labentry $type"
359 set locstyle $TREE_AttributeStyle
361 # Executable/Forgotten?
362 #if {$exec == "Forgotten"} {
363 #set textname "$textname $exec"
364 #set locstyle $TREE_AttributeStyle1
365 #set image $forgottenimage
368 # Failed/Success analysis.
369 #if {$state == "Failed"} {
370 #set textname "$textname $state"
371 #set locstyle $TREE_AttributeStyle2
375 if {$father != "Null"} {set textname "$textname Father=$father"}
377 if {$first != "Null"} {set textname "$textname First=$first"}
379 if {$next != "Null"} {set textname "$textname Next=$next"}
381 if {$previous != "Null"} {set textname "$textname Previous=$previous"}
383 $TREE_WINDOWS($w,NAV,hlist) add ${dir}^${labentry} \
384 -itemtype imagetext \
388 -data [list ${labentry} Node]
389 if {$children == "First"} {
390 $TREE_WINDOWS($w,NAV,tree) setmode ${dir}^${labentry} open
392 lappend litm [list $labentry $image]
396 ###############################################################################
399 proc TREE:Tree:terminal { TreeBrowser w dir } {
404 ###############################################################################
407 proc TREE:Tree:DisplayAttribute { TreeBrowser w dir } {
413 ###############################################################################
414 # imprime tout ce qu'il y a dans hli ( Hlist )
416 proc wokDBG { {root {}} } {
419 set w $TREE_GLOBALS(toplevel)
420 set hli $TREE_WINDOWS($w,NAV,hlist)
421 foreach c [$hli info children $root] {
422 puts "$c : data <[$hli info data $c]>"