src/DDataStd/DDataStd_TreeBrowser.tcl

   1 # Copyright (c) 1999-2012 OPEN CASCADE SAS
   2 #
   3 # The content of this file is subject to the Open CASCADE Technology Public
   4 # License Version 6.5 (the "License"). You may not use the content of this file
   5 # except in compliance with the License. Please obtain a copy of the License
   6 # at http://www.opencascade.org and read it completely before using this file.
   7 #
   8 # The Initial Developer of the Original Code is Open CASCADE S.A.S., having its
   9 # main offices at: 1, place des Freres Montgolfier, 78280 Guyancourt, France.
  10 #
  11 # The Original Code and all software distributed under the License is
  12 # distributed on an "AS IS" basis, without warranty of any kind, and the
  13 # Initial Developer hereby disclaims all such warranties, including without
  14 # limitation, any warranties of merchantability, fitness for a particular
  15 # purpose or non-infringement. Please see the License for the specific terms
  16 # and conditions governing the rights and limitations under the License.
  17
  18 ###########################
  19 #                         #
  20 # Version 1.0             #
  21 # by FID                  #
  22 #                         #
  23 ###########################
  24 #
  25 # Open         : double-clic or +
  26 # Close        : double-clic or -
  27 # Refresh tree : close top level and re-open
  28 #
  29 # Attributes:
  30 # white     : interoperable
  31 # white + c : non interoperable
  32 # X         : X Reference
  33 # Red       : not yet commited in transaction #0
  34 #
  35 #
  36
  37 proc __update { args } {
  38 }
  39
  40 global TreeBrowser
  41
  42 proc treebrowser { TreeBrowser } {
  43
  44     global TREE_WINDOWS
  45     global TREE_LabelStyle
  46     global TREE_LabelStyle1
  47     global TREE_AttributeStyle
  48     global TREE_AttributeStyle1
  49     global TREE_AttributeStyle2
  50
  51     global $TreeBrowser
  52
  53     package require Tix
  54     tixPref:InitFontSet:14Point
  55
  56     set TREE_LabelStyle [tixDisplayStyle imagetext \
  57             -font 9x15bold \
  58             -background Bisque3 \
  59             ]
  60
  61     set TREE_LabelStyle1 [tixDisplayStyle imagetext \
  62             -font 9x15bold \
  63             -background Bisque3 \
  64             -foreground SeaGreen2 \
  65             ]
  66
  67     set TREE_AttributeStyle [tixDisplayStyle imagetext \
  68             -font 9x15 \
  69             -background Bisque3 \
  70             ]
  71
  72     set TREE_AttributeStyle1 [tixDisplayStyle imagetext \
  73             -font 9x15 \
  74             -background Bisque3 \
  75             -foreground Green \
  76             ]
  77
  78     set TREE_AttributeStyle2 [tixDisplayStyle imagetext \
  79             -font 9x15 \
  80             -background Bisque3 \
  81             -foreground Red \
  82             ]
  83
  84     set w .$TreeBrowser
  85     toplevel $w
  86
  87     set top [frame $w.thu -bd 1 -relief raised -background Bisque3]
  88
  89     ################
  90     # Paned Window #
  91     ################
  92     set p [tixPanedWindow $top.p -orient horizontal -height 400 -width 700]
  93     pack $p -expand yes -fill both -padx 4 -pady 4
  94
  95     TREE:Tree:InitTreePanel $TreeBrowser $w $p
  96     #TREE:Tree:InitTextPanel $TreeBrowser $w $p
  97
  98     tixForm $top -left 2 -top 2 -right %99 -bottom %99
  99
 100     return
 101 }
 102
 103 ###############################################################################
 104 #
 105 #
 106 proc TREE:Tree:InitTreePanel { TreeBrowser w p } {
 107     global TREE_WINDOWS
 108     global $TreeBrowser
 109
 110     ########
 111     # Tree #
 112     ########
 113
 114     set p1 [$p add pane1 -expand 1 -size 700] ; $p1 config -relief flat
 115     set tree  [tixTree $p1.tree \
 116             -opencmd  [list TREE:Tree:Open $TreeBrowser $w] \
 117             -options { \
 118             hlist.separator "^" \
 119             hlist.font 9x15bold \
 120             hlist.background Bisque3 \
 121             hlist.foreground Black \
 122         } ]
 123     pack $p1.tree -expand yes -fill both -padx 4 -pady 4
 124
 125     # -browsecmd TREE:Tree:BrowseCmd
 126     # Cette option peut etre ajoutee a la commande tixTree,
 127     # mais elle declanche l'appel a la procedure a chaque clic ,
 128     # double-clic, voire a chaque appui puis relachement de souris!!!
 129
 130     # to see different fonts: /usr/openwin/lib/X11/fonts/misc or xlsfonts?
 131     # 8x13 8x13bold 9x15 9x15bold
 132     #       hlist.font 8x13bold
 133     #       hlist.gap "15"
 134     #       hlist.indent "30"
 135
 136     set TREE_WINDOWS($w,NAV,tree)   $tree
 137     set TREE_WINDOWS($w,NAV,hlist)  [$tree subwidget hlist]
 138     $TREE_WINDOWS($w,NAV,hlist) add ^ \
 139             -text $TreeBrowser \
 140             -data [list $TreeBrowser Root]
 141     $TREE_WINDOWS($w,NAV,tree)  setmode ^ open
 142 }
 143
 144 ###############################################################################
 145 #
 146 #
 147 proc TREE:Tree:InitTextPanel { TreeBrowser w p } {
 148     global TREE_WINDOWS
 149     global $TreeBrowser
 150
 151     ########
 152     # Text #
 153     ########
 154     set p2 [$p add pane2 -expand 4 -size 400] ; $p2 config -relief flat
 155     tixScrolledText $p2.st
 156     pack $p2.st   -expand yes -fill both -padx 4 -pady 4
 157
 158     set TREE_WINDOWS($w,NAV,text)   [$p2.st subwidget text]
 159
 160
 161
 162     $TREE_WINDOWS($w,NAV,text) insert end " Welcome to the QDF browser (Rev #.#)\n"
 163     $TREE_WINDOWS($w,NAV,text) insert end "--------------------------------------\n\n"
 164     $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"
 165     $TREE_WINDOWS($w,NAV,text) insert end "\t\t\t\tFID & YAN"
 166 }
 167
 168 ###############################################################################
 169 #
 170 #
 171 proc TREE:Tree:BrowseCmd { dir } {
 172     puts "Hello $dir !"
 173 }
 174 ###############################################################################
 175 # Se positionne sur l'entry pere et update les fenetres.
 176 #
 177 proc FCTREE:Tree:Up { w } {
 178     global TREE_WINDOWS
 179     global TREE_GLOBALS
 180     #puts "TREE:Tree:Up"
 181
 182     if { [set here [$TREE_WINDOWS($w,NAV,hlist) info anchor]] != {} } {
 183         if { [set up [$TREE_WINDOWS($w,NAV,hlist) info parent $here]] != {} } {
 184             TREE:Tree:ShowUp $w $up
 185             set TREE_GLOBALS(CWD) [lindex [$TREE_WINDOWS($w,NAV,hlist) info data $up] 0]
 186         }
 187     }
 188     return
 189 }
 190 ###############################################################################
 191 # Se positionne sur l'entry up sans update (History)
 192 #
 193 proc TREE:Tree:ShowUp { w dir } {
 194     global TREE_WINDOWS
 195     #puts "TREE:Tree:ShowUp"
 196
 197     $TREE_WINDOWS($w,NAV,hlist) anchor clear
 198     $TREE_WINDOWS($w,NAV,hlist) anchor set $dir
 199     $TREE_WINDOWS($w,NAV,hlist) selection clear
 200     $TREE_WINDOWS($w,NAV,hlist) selection set $dir
 201     $TREE_WINDOWS($w,NAV,hlist) see $dir
 202     return
 203 }
 204 ###############################################################################
 205 #
 206 #
 207 proc TREE:Tree:Open { TreeBrowser w dir} {
 208     global TREE_WINDOWS
 209     global $TreeBrowser
 210     #puts "TREE:Tree:Open"
 211
 212     if {$dir == "^"} {
 213         # This is root
 214         if {[$TREE_WINDOWS($w,NAV,hlist) info children $dir] != {}} {
 215             # The root branch already exists in hlist.
 216             # Clear all its children to force the tree to be updated.
 217             foreach kid [$TREE_WINDOWS($w,NAV,hlist) info children $dir] {
 218                 $TREE_WINDOWS($w,NAV,hlist) delete entry $kid
 219             }
 220         }
 221     }
 222
 223     if {[$TREE_WINDOWS($w,NAV,hlist) info children $dir] != {}} {
 224         # The branch exists in hlist.
 225         foreach kid [$TREE_WINDOWS($w,NAV,hlist) info children $dir] {
 226             $TREE_WINDOWS($w,NAV,hlist) show entry $kid
 227         }
 228         set data [$TREE_WINDOWS($w,NAV,hlist) info data $dir]
 229         #set loc  [lindex $data 0]
 230     } else {
 231         # The branch is unknown.
 232         tixBusy $w on
 233         update
 234         TREE:Tree:Fill $TreeBrowser $w $dir
 235         tixBusy $w off
 236     }
 237     return
 238 }
 239 ###############################################################################
 240 #
 241 #
 242 proc TREE:Tree:Fill { TreeBrowser w  dir } {
 243     global TREE_WINDOWS
 244     global TREE_GLOBALS
 245     global $TreeBrowser
 246     #puts "TREE:Tree:Fill"
 247
 248     set data [$TREE_WINDOWS($w,NAV,hlist) info data $dir]
 249     #set loc  [lindex $data 0]
 250     set type [lindex $data 1]
 251
 252     #puts "====================="
 253     #puts "Type $type"
 254     #puts "Window $w"
 255     #puts "Loc $loc"
 256     #puts "Dir $dir"
 257     #puts "====================="
 258
 259     switch -glob $type {
 260
 261         Root {
 262             TREE:Tree:UpdateRoot $TreeBrowser $w $dir
 263         }
 264
 265         Node {
 266             set lab [lindex $data 0]
 267             TREE:Tree:UpdateNode $TreeBrowser $w $dir $lab
 268         }
 269
 270         terminal {
 271             TREE:Tree:terminal $TreeBrowser $w $dir
 272         }
 273
 274         default {
 275             puts "type non reconnu"
 276         }
 277     }
 278     return
 279 }
 280 ###############################################################################
 281 # ici dir = ^
 282 #
 283 proc TREE:Tree:UpdateRoot  { TreeBrowser w dir } {
 284     global TREE_WINDOWS
 285     global $TreeBrowser
 286     global TREE_AttributeStyle
 287     global TREE_AttributeStyle1
 288     #puts "TREE:Tree:UpdateRoot"
 289
 290     foreach nodeItem [split [OpenNode $TreeBrowser ""] "\\" ] {
 291
 292         TREE:Tree:DecodeNodeItem $TreeBrowser $w $dir $nodeItem
 293
 294     }
 295
 296     return
 297 }
 298 ###############################################################################
 299 #
 300 #
 301 proc TREE:Tree:UpdateNode  { TreeBrowser w dir lab} {
 302     global TREE_WINDOWS
 303     global $TreeBrowser
 304     global TREE_AttributeStyle
 305     global TREE_AttributeStyle1
 306     #puts "TREE:Tree:UpdateNode"
 307
 308     foreach nodeItem [split [OpenNode $TreeBrowser $lab ] "\\" ] {
 309
 310         TREE:Tree:DecodeNodeItem $TreeBrowser $w $dir $nodeItem
 311
 312     }
 313     return
 314 }
 315 ###############################################################################
 316 # item:
 317 # "LabelEntry "Name" DynamicType Executable|Forgotten Failed|Success First|Null [ LabelFather]"
 318 proc TREE:Tree:DecodeNodeItem { TreeBrowser w dir nodeItem} {
 319     global TREE_WINDOWS
 320     global $TreeBrowser
 321     global TREE_AttributeStyle
 322     global TREE_AttributeStyle1
 323     global TREE_AttributeStyle2
 324     #puts "TREE:Tree:DecodeNodeItem"
 325
 326     set litm {}
 327     set standardimage  [tix getimage file]
 328     set forgottenimage [tix getimage maximize]
 329     set image $standardimage
 330
 331     # Information first split
 332     set tmplist [split $nodeItem " "]
 333     set labentry    [lindex $tmplist 0]
 334     set name        [lindex $tmplist 1]
 335     set type        [lindex $tmplist 2]
 336     #set exec        [lindex $tmplist 3]
 337     #set state       [lindex $tmplist 4]
 338     set children    [lindex $tmplist 3]
 339     set father      [lindex $tmplist 4]
 340     set first       [lindex $tmplist 5]
 341     set next        [lindex $tmplist 6]
 342     set previous    [lindex $tmplist 7]
 343
 344     #puts "labentry : $labentry"
 345     #puts "name : $name"
 346     #puts "type : $type"
 347     #puts "state : $state"
 348     #puts "exec : $exec"
 349     #puts "children : $children"
 350     #puts "father : $father"
 351     #puts "first : $first"
 352     #puts "next : $next"
 353     #puts "previous : $previous"
 354
 355     # Label entry , name & Dynamic type.
 356     set ll [expr [string length $name] -2]
 357     if {$ll > 0} {
 358         set textname "$labentry [string range $name 1 $ll] $type"
 359     } else {
 360         set textname "$labentry $type"
 361     }
 362
 363     set locstyle $TREE_AttributeStyle
 364
 365     # Executable/Forgotten?
 366     #if {$exec == "Forgotten"} {
 367         #set textname "$textname $exec"
 368         #set locstyle $TREE_AttributeStyle1
 369         #set image $forgottenimage
 370     #}
 371
 372     # Failed/Success analysis.
 373     #if {$state == "Failed"} {
 374         #set textname "$textname $state"
 375         #set locstyle $TREE_AttributeStyle2
 376     #}
 377
 378     # Father?
 379     if {$father != "Null"} {set textname "$textname Father=$father"}
 380     # First?
 381     if {$first != "Null"} {set textname "$textname First=$first"}
 382     # Next?
 383     if {$next != "Null"} {set textname "$textname Next=$next"}
 384     # Previous?
 385     if {$previous != "Null"} {set textname "$textname Previous=$previous"}
 386
 387     $TREE_WINDOWS($w,NAV,hlist) add ${dir}^${labentry} \
 388             -itemtype imagetext \
 389             -text $textname \
 390             -image $image \
 391             -style $locstyle \
 392             -data  [list ${labentry} Node]
 393     if {$children == "First"} {
 394         $TREE_WINDOWS($w,NAV,tree) setmode ${dir}^${labentry} open
 395     }
 396     lappend litm [list $labentry $image]
 397
 398     return
 399 }
 400 ###############################################################################
 401 #
 402 #
 403 proc TREE:Tree:terminal { TreeBrowser w dir } {
 404     global TREE_WINDOWS
 405     global $TreeBrowser
 406     return
 407 }
 408 ###############################################################################
 409 #
 410 #
 411 proc TREE:Tree:DisplayAttribute { TreeBrowser w dir } {
 412     global TREE_WINDOWS
 413     global $TreeBrowser
 414
 415     return
 416 }
 417 ###############################################################################
 418 # imprime tout ce qu'il y a dans hli ( Hlist )
 419 #
 420 proc wokDBG { {root {}} } {
 421     global TREE_GLOBALS
 422     global TREE_WINDOWS
 423     set w $TREE_GLOBALS(toplevel)
 424     set hli $TREE_WINDOWS($w,NAV,hlist)
 425     foreach c [$hli info children $root] {
 426         puts "$c : data <[$hli info data $c]>"
 427         wokDBG $c
 428     }
 429     return
 430 }