0030802: Draw Harness - add scrollbars to DFBrowse
[occt.git] / src / DrawResources / dftree.tcl
1 # Copyright (c) 1999-2014 OPEN CASCADE SAS
2 #
3 # This file is part of Open CASCADE Technology software library.
4 #
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.
10 #
11 # Alternatively, this file may be used under the terms of Open CASCADE
12 # commercial license or contractual agreement.
13
14 ###########################
15 #                         #
16 # Version 1.4             #
17 # by SZV                  #
18 #                         #
19 ###########################
20 #
21 # Open         : double-clic or +
22 # Close        : double-clic or -
23 # Refresh tree : close top level and re-open
24 #
25 # Attributes:
26 # white     : interoperable
27 # white + c : non interoperable
28 # X         : X Reference
29 # Red       : not yet commited in transaction #0
30
31 #
32
33 proc __update { args } {
34 }
35
36 proc dftree { DDF_Browser } {
37
38   global env
39   global DFTREE_WINDOWS
40   global DFTREE_GLOBALS
41   global $DDF_Browser
42     
43   puts $DDF_Browser
44
45   package require Tk
46
47   ## Create images
48   set DFTREE_GLOBALS(ImageLabel)     [DFOpenImage dfb_folder.gif]
49   set DFTREE_GLOBALS(ImageAttrOther) [DFOpenImage dfb_attribute.gif]
50   set DFTREE_GLOBALS(ImageAttrNS)    [DFOpenImage dfb_attribns.gif]
51
52 ##    set DFTREE_LabelStyle [tixDisplayStyle imagetext \
53 ##          -font 9x15bold \
54 ##          -background Bisque3 \
55 ##          ]
56
57 ##    set DFTREE_LabelStyle1 [tixDisplayStyle imagetext \
58 ##          -font 9x15bold \
59 ##          -background Bisque3 \
60 ##          -foreground SeaGreen2 \
61 ##          ]
62
63 ##    set DFTREE_AttributeStyle [tixDisplayStyle imagetext \
64 ##          -font 9x15 \
65 ##          -background Bisque3 \
66 ##          ]
67
68 ##    set DFTREE_AttributeStyle1 [tixDisplayStyle imagetext \
69 ##          -font 9x15 \
70 ##          -background Bisque3 \
71 ##          -foreground DarkGreen \
72 ##          ]
73
74 ##    set DFTREE_AttributeStyle2 [tixDisplayStyle imagetext \
75 ##          -font 9x15 \
76 ##          -background Bisque3 \
77 ##          -foreground Red \
78 ##          ]
79
80   set w .$DDF_Browser
81   toplevel $w -width 700 -height 400 -background bisque3
82   wm minsize $w 700 400
83
84   ########
85   # Tree #
86   ########
87
88   #set tree1 [ttk::treeview $w.tree -show tree]
89   set tree1 [ttk::treeview $w.tree -show tree -xscrollcommand "$w.tree.xscroll set" -yscrollcommand "$w.tree.yscroll set"]
90   set aScrollX [ttk::scrollbar $w.tree.xscroll -command "$w.tree xview" -orient horizontal]
91   set aScrollY [ttk::scrollbar $w.tree.yscroll -command "$w.tree yview"]
92   pack $aScrollX -side bottom -fill x
93   pack $aScrollY -side right  -fill y
94   $tree1 tag bind Label <<TreeviewOpen>> [list DFTREE:Tree:Open $DDF_Browser $w]
95   $tree1 tag configure Label -font 9x15bold -foreground DarkGreen
96   #$tree1 tag configure Attribute -font 9x15 -background bisque3
97   #$tree1 tag configure AttributeList -font 9x15 -background bisque3
98   pack $tree1 -expand yes -fill both -padx 4 -pady 4
99
100   # to see different fonts: /usr/openwin/lib/X11/fonts/misc or xlsfonts?
101   # 8x13 8x13bold 9x15 9x15bold
102   #         hlist.font 8x13bold
103   #         hlist.gap "15"
104   #         hlist.indent "30"
105
106   set DFTREE_WINDOWS($w,tree) $tree1
107   set DFTREE_WINDOWS($w,root) [$tree1 insert {} end \
108                                  -text $DDF_Browser \
109                                  -values "" \
110                                  -tags Label]
111
112   # Here we need to open first node!
113   
114   return
115 }
116
117 ###############################################################################
118 #
119 #
120 proc DFTREE:Tree:Open { DDF_Browser w } {
121
122   global DFTREE_WINDOWS
123   global DFTREE_GLOBALS
124   global $DDF_Browser
125
126   set df_tree $DFTREE_WINDOWS($w,tree)
127   set df_node [$df_tree focus]
128
129   #if {$df_node == $DFTREE_WINDOWS($w,root)} {
130         # This is root
131     set chdlist [$df_tree children $df_node]
132     if {$chdlist != {}} {
133       # The root branch already exists in hlist.
134       # Clear all its children to force the tree to be updated.
135       $df_tree delete $chdlist
136     }
137   #}
138
139   #update
140   DFTREE:Tree:Fill $DDF_Browser $df_tree $df_node
141   return
142 }
143
144 ###############################################################################
145 #
146 #
147 proc DFTREE:Tree:Fill { DDF_Browser df_tree df_node } {
148
149   global DFTREE_GLOBALS
150   global $DDF_Browser
151
152   set loc  [lindex [$df_tree item $df_node -values] 0]
153   set type [lindex [$df_tree item $df_node -tags] 0]
154
155   switch -glob $type {
156
157     Label {
158       DFTREE:Tree:UpdateLabel $DDF_Browser $df_tree $df_node $loc
159     }
160
161     #AttributeList { 
162     #  DFTREE:Tree:UpdateAttributeList $DDF_Browser $df_tree $df_node $loc
163     #}
164
165     default {
166     }
167   }
168   return
169 }
170
171 ###############################################################################
172 # $df_entry is a label entry, "1:3:2" for example, or "" for root.
173 #
174 proc DFTREE:Tree:UpdateLabel  { DDF_Browser df_tree df_node df_entry } {
175
176   global DFTREE_GLOBALS
177   global $DDF_Browser
178
179   foreach fullname [split [DFOpenLabel $DDF_Browser $df_entry] "\\" ] {
180     FCTREE:Tree:DecodeLabelItem $DDF_Browser $df_tree $df_node $df_entry $fullname
181   }
182   return
183 }
184
185 ###############################################################################
186 #
187 #
188 proc DFTREE:Tree:UpdateAttributeList { DDF_Browser df_tree df_node df_entry} {
189
190   global DFTREE_GLOBALS
191   global $DDF_Browser
192
193   set image_other $DFTREE_GLOBALS(ImageAttrOther)
194   set image_ns    $DFTREE_GLOBALS(ImageAttrNS)
195   #set xrefimage   $DFTREE_GLOBALS(ImageAttrOther)
196
197   # abv: index attributes
198   set num 0
199   set attributes [split [DFOpenAttributeList $DDF_Browser $df_entry ] "\\" ]
200   set iattributes {}
201   foreach fullname $attributes {
202         set num [expr $num + 1]
203         lappend fullname $num
204         lappend iattributes $fullname
205   }
206   
207   foreach fullname [lsort $iattributes] {
208
209         # Information first split
210         set tmplist [split $fullname " "]
211         set name        [lindex $tmplist 0]
212         set transaction [lindex $tmplist 1]
213         set valid       [lindex $tmplist 2]
214         set forgotten   [lindex $tmplist 3]
215         set backuped    [lindex $tmplist 4]
216         set maybeopen   [lindex $tmplist 5]
217
218         # Name analysis to suppress the map address.
219         set shortlist [split $name "#"]
220         set shortname [lindex $shortlist 0]
221         set index     [lindex $shortlist 1]
222
223         # Package analysis to determine the icon type.
224         #set pk [lindex [split $name _] 0]
225         set node_img $image_other
226         #if {$pk == "TDataStd" || $pk == "TNaming"} {set node_img $standardimage}
227         #if {$pk == "TXRef"} {set node_img $xrefimage}
228     if {$shortname == "TNaming_NamedShape"} {set node_img $image_ns}
229
230         set textname "$shortname"
231
232 #       if { [llength $tmplist] >5 } { set textname [lindex $tmplist 5] }
233     set textname "$textname [DFGetAttributeValue $DDF_Browser $df_entry [lindex $tmplist 6]]"
234
235         # Transaction analysis
236         if {$transaction == "0"} {
237 #           set locstyle $DFTREE_AttributeStyle
238         } else {
239 #           set textname "$textname T=$transaction"
240 #           set locstyle $DFTREE_AttributeStyle1
241         }
242
243         # Valid?
244         if {$valid == "NotValid"} {set textname "$textname $valid"}
245
246         # Forgotten?
247         if {$forgotten == "Forgotten"} {set textname "$textname $forgotten"}
248
249         # Backuped?
250         if {$backuped == "Backuped"} {set textname "$textname $backuped"}
251
252     set df_new [$df_tree insert $df_node end \
253                   -text $textname -image $node_img -tags Attribute]
254
255     if {$maybeopen == "1"} {
256       $df_tree item $df_new -open true
257       DFTREE:Tree:UpdateAttribute $DDF_Browser $df_tree $df_new $index
258     }
259   }
260 }
261
262 ###############################################################################
263 # $loc is always the attribute index
264 #
265 proc DFTREE:Tree:UpdateAttribute { DDF_Browser df_tree df_node a_index } {
266
267   global DFTREE_GLOBALS
268   global $DDF_Browser
269
270   set tmplist [split [DFOpenAttribute $DDF_Browser $a_index ] "\\"]
271
272   # Failed or not?
273   if {[lindex $tmplist 0] == "Failed"} {
274 ##      set locstyle $DFTREE_AttributeStyle2
275   } else {
276 ##      set locstyle $DFTREE_AttributeStyle
277   }
278
279   foreach name $tmplist {
280     $df_tree insert $df_node end -text $name -tags Terminal
281   }
282   return
283 }
284
285 ###############################################################################
286 # item:
287 # "Entry Name=TheNameIfExists Modified|NotModified 0|1"
288 proc FCTREE:Tree:DecodeLabelItem { DDF_Browser df_tree df_node df_entry labelItem} {
289
290   global DFTREE_GLOBALS
291   global $DDF_Browser
292
293   set tmplist [split $labelItem " " ]
294   set labname [lindex $tmplist 0]
295
296   set textname "$labname"
297
298   if {$labname == "AttributeList"} {
299   
300     # Attribute List
301         # --------------
302
303         #set modified  [lindex $tmplist 1]
304
305         # Modified or not?
306         #if {$modified == "Modified"} {
307     #  set textname "$textname $modified"
308 ##      set locstyle $DFTREE_AttributeStyle1
309         #} else {
310 ##      set locstyle $DFTREE_AttributeStyle
311         #}
312
313     #set df_new [$df_tree insert $df_node end \
314     #              -text $textname \
315     #              -image $DFTREE_GLOBALS(ImageAttrList) \
316     #              -tags AttributeList]
317
318     #$df_tree item $df_new -open true
319
320     DFTREE:Tree:UpdateAttributeList $DDF_Browser $df_tree $df_node $df_entry
321     
322   } else {
323
324     # Sub-label(s)
325     # ------------
326
327     set name      [lindex $tmplist 1]
328     set modified  [lindex $tmplist 2]
329     set maybeopen [lindex $tmplist 3]
330
331     # Name?
332     set ll [expr [string length $name] -2]
333     if {$ll > 0} {
334       set textname "$textname [string range $name 1 $ll]"
335         }
336
337         # Modified or not?
338         if {$modified == "Modified"} {
339       set textname "$textname $modified"
340     }
341
342     set df_new [$df_tree insert $df_node end \
343                   -text $textname \
344                   -image $DFTREE_GLOBALS(ImageLabel) \
345                   -values $labname \
346                   -tags Label]
347
348     if {$maybeopen == "1"} {
349       $df_tree item $df_new -open true
350     }
351
352     DFTREE:Tree:UpdateLabel $DDF_Browser $df_tree $df_new $labname
353   }
354 }
355
356 ###############################################################################
357 #
358 #
359 proc DFGetAttributeValue { DDF_Browser lab index } {
360
361     global $DDF_Browser; # necessary for DRAW command to see the browser
362
363     if {[catch "XAttributeValue $DDF_Browser $lab $index" ret]} {
364         return ""
365     }
366     if {"$ret" == ""} { return "" }
367     return "\[$ret\]"
368 }
369
370 ###############################################################################
371 #
372 #
373 proc DFOpenImage { img } {
374
375   global env
376
377   if {[catch "image create photo -file $env(CSF_OCCTResourcePath)/DrawResources/$img" ret]} {
378     return ""
379   }
380   return $ret
381 }