src/DDataStd/DDataStd_TreeBrowser.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.0             #
  17 # by FID                  #
  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 global TreeBrowser
  37
  38 proc treebrowser { TreeBrowser } {
  39
  40     global TREE_WINDOWS
  41     global TREE_LabelStyle
  42     global TREE_LabelStyle1
  43     global TREE_AttributeStyle
  44     global TREE_AttributeStyle1
  45     global TREE_AttributeStyle2
  46
  47     global $TreeBrowser
  48
  49     package require Tix
  50     tixPref:InitFontSet:14Point
  51
  52     set TREE_LabelStyle [tixDisplayStyle imagetext \
  53             -font 9x15bold \
  54             -background Bisque3 \
  55             ]
  56
  57     set TREE_LabelStyle1 [tixDisplayStyle imagetext \
  58             -font 9x15bold \
  59             -background Bisque3 \
  60             -foreground SeaGreen2 \
  61             ]
  62
  63     set TREE_AttributeStyle [tixDisplayStyle imagetext \
  64             -font 9x15 \
  65             -background Bisque3 \
  66             ]
  67
  68     set TREE_AttributeStyle1 [tixDisplayStyle imagetext \
  69             -font 9x15 \
  70             -background Bisque3 \
  71             -foreground Green \
  72             ]
  73
  74     set TREE_AttributeStyle2 [tixDisplayStyle imagetext \
  75             -font 9x15 \
  76             -background Bisque3 \
  77             -foreground Red \
  78             ]
  79
  80     set w .$TreeBrowser
  81     toplevel $w
  82
  83     set top [frame $w.thu -bd 1 -relief raised -background Bisque3]
  84
  85     ################
  86     # Paned Window #
  87     ################
  88     set p [tixPanedWindow $top.p -orient horizontal -height 400 -width 700]
  89     pack $p -expand yes -fill both -padx 4 -pady 4
  90
  91     TREE:Tree:InitTreePanel $TreeBrowser $w $p
  92     #TREE:Tree:InitTextPanel $TreeBrowser $w $p
  93
  94     tixForm $top -left 2 -top 2 -right %99 -bottom %99
  95
  96     return
  97 }
  98
  99 ###############################################################################
 100 #
 101 #
 102 proc TREE:Tree:InitTreePanel { TreeBrowser w p } {
 103     global TREE_WINDOWS
 104     global $TreeBrowser
 105
 106     ########
 107     # Tree #
 108     ########
 109
 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] \
 113             -options { \
 114             hlist.separator "^" \
 115             hlist.font 9x15bold \
 116             hlist.background Bisque3 \
 117             hlist.foreground Black \
 118         } ]
 119     pack $p1.tree -expand yes -fill both -padx 4 -pady 4
 120
 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!!!
 125
 126     # to see different fonts: /usr/openwin/lib/X11/fonts/misc or xlsfonts?
 127     # 8x13 8x13bold 9x15 9x15bold
 128     #       hlist.font 8x13bold
 129     #       hlist.gap "15"
 130     #       hlist.indent "30"
 131
 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 ^ \
 135             -text $TreeBrowser \
 136             -data [list $TreeBrowser Root]
 137     $TREE_WINDOWS($w,NAV,tree)  setmode ^ open
 138 }
 139
 140 ###############################################################################
 141 #
 142 #
 143 proc TREE:Tree:InitTextPanel { TreeBrowser w p } {
 144     global TREE_WINDOWS
 145     global $TreeBrowser
 146
 147     ########
 148     # Text #
 149     ########
 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
 153
 154     set TREE_WINDOWS($w,NAV,text)   [$p2.st subwidget text]
 155
 156
 157
 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"
 162 }
 163
 164 ###############################################################################
 165 #
 166 #
 167 proc TREE:Tree:BrowseCmd { dir } {
 168     puts "Hello $dir !"
 169 }
 170 ###############################################################################
 171 # Se positionne sur l'entry pere et update les fenetres.
 172 #
 173 proc FCTREE:Tree:Up { w } {
 174     global TREE_WINDOWS
 175     global TREE_GLOBALS
 176     #puts "TREE:Tree:Up"
 177
 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]
 182         }
 183     }
 184     return
 185 }
 186 ###############################################################################
 187 # Se positionne sur l'entry up sans update (History)
 188 #
 189 proc TREE:Tree:ShowUp { w dir } {
 190     global TREE_WINDOWS
 191     #puts "TREE:Tree:ShowUp"
 192
 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
 198     return
 199 }
 200 ###############################################################################
 201 #
 202 #
 203 proc TREE:Tree:Open { TreeBrowser w dir} {
 204     global TREE_WINDOWS
 205     global $TreeBrowser
 206     #puts "TREE:Tree:Open"
 207
 208     if {$dir == "^"} {
 209         # This is root
 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
 215             }
 216         }
 217     }
 218
 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
 223         }
 224         set data [$TREE_WINDOWS($w,NAV,hlist) info data $dir]
 225         #set loc  [lindex $data 0]
 226     } else {
 227         # The branch is unknown.
 228         tixBusy $w on
 229         update
 230         TREE:Tree:Fill $TreeBrowser $w $dir
 231         tixBusy $w off
 232     }
 233     return
 234 }
 235 ###############################################################################
 236 #
 237 #
 238 proc TREE:Tree:Fill { TreeBrowser w  dir } {
 239     global TREE_WINDOWS
 240     global TREE_GLOBALS
 241     global $TreeBrowser
 242     #puts "TREE:Tree:Fill"
 243
 244     set data [$TREE_WINDOWS($w,NAV,hlist) info data $dir]
 245     #set loc  [lindex $data 0]
 246     set type [lindex $data 1]
 247
 248     #puts "====================="
 249     #puts "Type $type"
 250     #puts "Window $w"
 251     #puts "Loc $loc"
 252     #puts "Dir $dir"
 253     #puts "====================="
 254
 255     switch -glob $type {
 256
 257         Root {
 258             TREE:Tree:UpdateRoot $TreeBrowser $w $dir
 259         }
 260
 261         Node {
 262             set lab [lindex $data 0]
 263             TREE:Tree:UpdateNode $TreeBrowser $w $dir $lab
 264         }
 265
 266         terminal {
 267             TREE:Tree:terminal $TreeBrowser $w $dir
 268         }
 269
 270         default {
 271             puts "type non reconnu"
 272         }
 273     }
 274     return
 275 }
 276 ###############################################################################
 277 # ici dir = ^
 278 #
 279 proc TREE:Tree:UpdateRoot  { TreeBrowser w dir } {
 280     global TREE_WINDOWS
 281     global $TreeBrowser
 282     global TREE_AttributeStyle
 283     global TREE_AttributeStyle1
 284     #puts "TREE:Tree:UpdateRoot"
 285
 286     foreach nodeItem [split [OpenNode $TreeBrowser ""] "\\" ] {
 287
 288         TREE:Tree:DecodeNodeItem $TreeBrowser $w $dir $nodeItem
 289
 290     }
 291
 292     return
 293 }
 294 ###############################################################################
 295 #
 296 #
 297 proc TREE:Tree:UpdateNode  { TreeBrowser w dir lab} {
 298     global TREE_WINDOWS
 299     global $TreeBrowser
 300     global TREE_AttributeStyle
 301     global TREE_AttributeStyle1
 302     #puts "TREE:Tree:UpdateNode"
 303
 304     foreach nodeItem [split [OpenNode $TreeBrowser $lab ] "\\" ] {
 305
 306         TREE:Tree:DecodeNodeItem $TreeBrowser $w $dir $nodeItem
 307
 308     }
 309     return
 310 }
 311 ###############################################################################
 312 # item:
 313 # "LabelEntry "Name" DynamicType Executable|Forgotten Failed|Success First|Null [ LabelFather]"
 314 proc TREE:Tree:DecodeNodeItem { TreeBrowser w dir nodeItem} {
 315     global TREE_WINDOWS
 316     global $TreeBrowser
 317     global TREE_AttributeStyle
 318     global TREE_AttributeStyle1
 319     global TREE_AttributeStyle2
 320     #puts "TREE:Tree:DecodeNodeItem"
 321
 322     set litm {}
 323     set standardimage  [tix getimage file]
 324     set forgottenimage [tix getimage maximize]
 325     set image $standardimage
 326
 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]
 339
 340     #puts "labentry : $labentry"
 341     #puts "name : $name"
 342     #puts "type : $type"
 343     #puts "state : $state"
 344     #puts "exec : $exec"
 345     #puts "children : $children"
 346     #puts "father : $father"
 347     #puts "first : $first"
 348     #puts "next : $next"
 349     #puts "previous : $previous"
 350
 351     # Label entry , name & Dynamic type.
 352     set ll [expr [string length $name] -2]
 353     if {$ll > 0} {
 354         set textname "$labentry [string range $name 1 $ll] $type"
 355     } else {
 356         set textname "$labentry $type"
 357     }
 358
 359     set locstyle $TREE_AttributeStyle
 360
 361     # Executable/Forgotten?
 362     #if {$exec == "Forgotten"} {
 363         #set textname "$textname $exec"
 364         #set locstyle $TREE_AttributeStyle1
 365         #set image $forgottenimage
 366     #}
 367
 368     # Failed/Success analysis.
 369     #if {$state == "Failed"} {
 370         #set textname "$textname $state"
 371         #set locstyle $TREE_AttributeStyle2
 372     #}
 373
 374     # Father?
 375     if {$father != "Null"} {set textname "$textname Father=$father"}
 376     # First?
 377     if {$first != "Null"} {set textname "$textname First=$first"}
 378     # Next?
 379     if {$next != "Null"} {set textname "$textname Next=$next"}
 380     # Previous?
 381     if {$previous != "Null"} {set textname "$textname Previous=$previous"}
 382
 383     $TREE_WINDOWS($w,NAV,hlist) add ${dir}^${labentry} \
 384             -itemtype imagetext \
 385             -text $textname \
 386             -image $image \
 387             -style $locstyle \
 388             -data  [list ${labentry} Node]
 389     if {$children == "First"} {
 390         $TREE_WINDOWS($w,NAV,tree) setmode ${dir}^${labentry} open
 391     }
 392     lappend litm [list $labentry $image]
 393
 394     return
 395 }
 396 ###############################################################################
 397 #
 398 #
 399 proc TREE:Tree:terminal { TreeBrowser w dir } {
 400     global TREE_WINDOWS
 401     global $TreeBrowser
 402     return
 403 }
 404 ###############################################################################
 405 #
 406 #
 407 proc TREE:Tree:DisplayAttribute { TreeBrowser w dir } {
 408     global TREE_WINDOWS
 409     global $TreeBrowser
 410
 411     return
 412 }
 413 ###############################################################################
 414 # imprime tout ce qu'il y a dans hli ( Hlist )
 415 #
 416 proc wokDBG { {root {}} } {
 417     global TREE_GLOBALS
 418     global TREE_WINDOWS
 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]>"
 423         wokDBG $c
 424     }
 425     return
 426 }