mirror of
https://git.dev.opencascade.org/repos/occt.git
synced 2025-09-03 14:10:33 +03:00
0023016: Elimination of dependency of Tcl OCAF Browser from Tix product
This commit is contained in:
szv
bugmaster
362
src/DrawResources/dftree.tcl
Normal file
362
src/DrawResources/dftree.tcl
Normal file
@@ -0,0 +1,362 @@
|
||||
###########################
|
||||
# #
|
||||
# Version 1.4 #
|
||||
# by SZV #
|
||||
# #
|
||||
###########################
|
||||
#
|
||||
# Open : double-clic or +
|
||||
# Close : double-clic or -
|
||||
# Refresh tree : close top level and re-open
|
||||
#
|
||||
# Attributes:
|
||||
# white : interoperable
|
||||
# white + c : non interoperable
|
||||
# X : X Reference
|
||||
# Red : not yet commited in transaction #0
|
||||
#
|
||||
#
|
||||
|
||||
proc __update { args } {
|
||||
}
|
||||
|
||||
proc dftree { DDF_Browser } {
|
||||
|
||||
global env
|
||||
global DFTREE_WINDOWS
|
||||
global DFTREE_GLOBALS
|
||||
global $DDF_Browser
|
||||
|
||||
puts $DDF_Browser
|
||||
|
||||
package require Tk
|
||||
|
||||
## Create images
|
||||
set DFTREE_GLOBALS(ImageLabel) [DFOpenImage dfb_folder.gif]
|
||||
set DFTREE_GLOBALS(ImageAttrOther) [DFOpenImage dfb_attribute.gif]
|
||||
set DFTREE_GLOBALS(ImageAttrNS) [DFOpenImage dfb_attribns.gif]
|
||||
|
||||
## set DFTREE_LabelStyle [tixDisplayStyle imagetext \
|
||||
## -font 9x15bold \
|
||||
## -background Bisque3 \
|
||||
## ]
|
||||
|
||||
## set DFTREE_LabelStyle1 [tixDisplayStyle imagetext \
|
||||
## -font 9x15bold \
|
||||
## -background Bisque3 \
|
||||
## -foreground SeaGreen2 \
|
||||
## ]
|
||||
|
||||
## set DFTREE_AttributeStyle [tixDisplayStyle imagetext \
|
||||
## -font 9x15 \
|
||||
## -background Bisque3 \
|
||||
## ]
|
||||
|
||||
## set DFTREE_AttributeStyle1 [tixDisplayStyle imagetext \
|
||||
## -font 9x15 \
|
||||
## -background Bisque3 \
|
||||
## -foreground DarkGreen \
|
||||
## ]
|
||||
|
||||
## set DFTREE_AttributeStyle2 [tixDisplayStyle imagetext \
|
||||
## -font 9x15 \
|
||||
## -background Bisque3 \
|
||||
## -foreground Red \
|
||||
## ]
|
||||
|
||||
set w .$DDF_Browser
|
||||
toplevel $w -height 400 -width 700 -background bisque3
|
||||
|
||||
########
|
||||
# Tree #
|
||||
########
|
||||
|
||||
set tree1 [ttk::treeview $w.tree -show tree]
|
||||
$tree1 tag bind Label <<TreeviewOpen>> [list DFTREE:Tree:Open $DDF_Browser $w]
|
||||
$tree1 tag configure Label -font 9x15bold -foreground DarkGreen
|
||||
#$tree1 tag configure Attribute -font 9x15 -background bisque3
|
||||
#$tree1 tag configure AttributeList -font 9x15 -background bisque3
|
||||
pack $tree1 -expand yes -fill both -padx 4 -pady 4
|
||||
|
||||
# to see different fonts: /usr/openwin/lib/X11/fonts/misc or xlsfonts?
|
||||
# 8x13 8x13bold 9x15 9x15bold
|
||||
# hlist.font 8x13bold
|
||||
# hlist.gap "15"
|
||||
# hlist.indent "30"
|
||||
|
||||
set DFTREE_WINDOWS($w,tree) $tree1
|
||||
set DFTREE_WINDOWS($w,root) [$tree1 insert {} end \
|
||||
-text $DDF_Browser \
|
||||
-values "" \
|
||||
-tags Label]
|
||||
|
||||
# Here we need to open first node!
|
||||
|
||||
return
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc DFTREE:Tree:Open { DDF_Browser w } {
|
||||
|
||||
global DFTREE_WINDOWS
|
||||
global DFTREE_GLOBALS
|
||||
global $DDF_Browser
|
||||
|
||||
set df_tree $DFTREE_WINDOWS($w,tree)
|
||||
set df_node [$df_tree focus]
|
||||
|
||||
#if {$df_node == $DFTREE_WINDOWS($w,root)} {
|
||||
# This is root
|
||||
set chdlist [$df_tree children $df_node]
|
||||
if {$chdlist != {}} {
|
||||
# The root branch already exists in hlist.
|
||||
# Clear all its children to force the tree to be updated.
|
||||
$df_tree delete $chdlist
|
||||
}
|
||||
#}
|
||||
|
||||
#update
|
||||
DFTREE:Tree:Fill $DDF_Browser $df_tree $df_node
|
||||
return
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc DFTREE:Tree:Fill { DDF_Browser df_tree df_node } {
|
||||
|
||||
global DFTREE_GLOBALS
|
||||
global $DDF_Browser
|
||||
|
||||
set loc [lindex [$df_tree item $df_node -values] 0]
|
||||
set type [lindex [$df_tree item $df_node -tags] 0]
|
||||
|
||||
switch -glob $type {
|
||||
|
||||
Label {
|
||||
DFTREE:Tree:UpdateLabel $DDF_Browser $df_tree $df_node $loc
|
||||
}
|
||||
|
||||
#AttributeList {
|
||||
# DFTREE:Tree:UpdateAttributeList $DDF_Browser $df_tree $df_node $loc
|
||||
#}
|
||||
|
||||
default {
|
||||
}
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
# $df_entry is a label entry, "1:3:2" for example, or "" for root.
|
||||
#
|
||||
proc DFTREE:Tree:UpdateLabel { DDF_Browser df_tree df_node df_entry } {
|
||||
|
||||
global DFTREE_GLOBALS
|
||||
global $DDF_Browser
|
||||
|
||||
foreach fullname [split [DFOpenLabel $DDF_Browser $df_entry] "\\" ] {
|
||||
FCTREE:Tree:DecodeLabelItem $DDF_Browser $df_tree $df_node $df_entry $fullname
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc DFTREE:Tree:UpdateAttributeList { DDF_Browser df_tree df_node df_entry} {
|
||||
|
||||
global DFTREE_GLOBALS
|
||||
global $DDF_Browser
|
||||
|
||||
set image_other $DFTREE_GLOBALS(ImageAttrOther)
|
||||
set image_ns $DFTREE_GLOBALS(ImageAttrNS)
|
||||
#set xrefimage $DFTREE_GLOBALS(ImageAttrOther)
|
||||
|
||||
# abv: index attributes
|
||||
set num 0
|
||||
set attributes [split [DFOpenAttributeList $DDF_Browser $df_entry ] "\\" ]
|
||||
set iattributes {}
|
||||
foreach fullname $attributes {
|
||||
set num [expr $num + 1]
|
||||
lappend fullname $num
|
||||
lappend iattributes $fullname
|
||||
}
|
||||
|
||||
foreach fullname [lsort $iattributes] {
|
||||
|
||||
# Information first split
|
||||
set tmplist [split $fullname " "]
|
||||
set name [lindex $tmplist 0]
|
||||
set transaction [lindex $tmplist 1]
|
||||
set valid [lindex $tmplist 2]
|
||||
set forgotten [lindex $tmplist 3]
|
||||
set backuped [lindex $tmplist 4]
|
||||
set maybeopen [lindex $tmplist 5]
|
||||
|
||||
# Name analysis to suppress the map address.
|
||||
set shortlist [split $name "#"]
|
||||
set shortname [lindex $shortlist 0]
|
||||
set index [lindex $shortlist 1]
|
||||
|
||||
# Package analysis to determine the icon type.
|
||||
#set pk [lindex [split $name _] 0]
|
||||
set node_img $image_other
|
||||
#if {$pk == "TDataStd" || $pk == "TNaming"} {set node_img $standardimage}
|
||||
#if {$pk == "TXRef"} {set node_img $xrefimage}
|
||||
if {$shortname == "TNaming_NamedShape"} {set node_img $image_ns}
|
||||
|
||||
set textname "$shortname"
|
||||
|
||||
# if { [llength $tmplist] >5 } { set textname [lindex $tmplist 5] }
|
||||
set textname "$textname [DFGetAttributeValue $DDF_Browser $df_entry [lindex $tmplist 6]]"
|
||||
|
||||
# Transaction analysis
|
||||
if {$transaction == "0"} {
|
||||
# set locstyle $DFTREE_AttributeStyle
|
||||
} else {
|
||||
# set textname "$textname T=$transaction"
|
||||
# set locstyle $DFTREE_AttributeStyle1
|
||||
}
|
||||
|
||||
# Valid?
|
||||
if {$valid == "NotValid"} {set textname "$textname $valid"}
|
||||
|
||||
# Forgotten?
|
||||
if {$forgotten == "Forgotten"} {set textname "$textname $forgotten"}
|
||||
|
||||
# Backuped?
|
||||
if {$backuped == "Backuped"} {set textname "$textname $backuped"}
|
||||
|
||||
set df_new [$df_tree insert $df_node end \
|
||||
-text $textname -image $node_img -tags Attribute]
|
||||
|
||||
if {$maybeopen == "1"} {
|
||||
$df_tree item $df_new -open true
|
||||
DFTREE:Tree:UpdateAttribute $DDF_Browser $df_tree $df_new $index
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
# $loc is always the attribute index
|
||||
#
|
||||
proc DFTREE:Tree:UpdateAttribute { DDF_Browser df_tree df_node a_index } {
|
||||
|
||||
global DFTREE_GLOBALS
|
||||
global $DDF_Browser
|
||||
|
||||
set tmplist [split [DFOpenAttribute $DDF_Browser $a_index ] "\\"]
|
||||
|
||||
# Failed or not?
|
||||
if {[lindex $tmplist 0] == "Failed"} {
|
||||
## set locstyle $DFTREE_AttributeStyle2
|
||||
} else {
|
||||
## set locstyle $DFTREE_AttributeStyle
|
||||
}
|
||||
|
||||
foreach name $tmplist {
|
||||
$df_tree insert $df_node end -text $name -tags Terminal
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
# item:
|
||||
# "Entry Name=TheNameIfExists Modified|NotModified 0|1"
|
||||
proc FCTREE:Tree:DecodeLabelItem { DDF_Browser df_tree df_node df_entry labelItem} {
|
||||
|
||||
global DFTREE_GLOBALS
|
||||
global $DDF_Browser
|
||||
|
||||
set tmplist [split $labelItem " " ]
|
||||
set labname [lindex $tmplist 0]
|
||||
|
||||
set textname "$labname"
|
||||
|
||||
if {$labname == "AttributeList"} {
|
||||
|
||||
# Attribute List
|
||||
# --------------
|
||||
|
||||
#set modified [lindex $tmplist 1]
|
||||
|
||||
# Modified or not?
|
||||
#if {$modified == "Modified"} {
|
||||
# set textname "$textname $modified"
|
||||
## set locstyle $DFTREE_AttributeStyle1
|
||||
#} else {
|
||||
## set locstyle $DFTREE_AttributeStyle
|
||||
#}
|
||||
|
||||
#set df_new [$df_tree insert $df_node end \
|
||||
# -text $textname \
|
||||
# -image $DFTREE_GLOBALS(ImageAttrList) \
|
||||
# -tags AttributeList]
|
||||
|
||||
#$df_tree item $df_new -open true
|
||||
|
||||
DFTREE:Tree:UpdateAttributeList $DDF_Browser $df_tree $df_node $df_entry
|
||||
|
||||
} else {
|
||||
|
||||
# Sub-label(s)
|
||||
# ------------
|
||||
|
||||
set name [lindex $tmplist 1]
|
||||
set modified [lindex $tmplist 2]
|
||||
set maybeopen [lindex $tmplist 3]
|
||||
|
||||
# Name?
|
||||
set ll [expr [string length $name] -2]
|
||||
if {$ll > 0} {
|
||||
set textname "$textname [string range $name 1 $ll]"
|
||||
}
|
||||
|
||||
# Modified or not?
|
||||
if {$modified == "Modified"} {
|
||||
set textname "$textname $modified"
|
||||
}
|
||||
|
||||
set df_new [$df_tree insert $df_node end \
|
||||
-text $textname \
|
||||
-image $DFTREE_GLOBALS(ImageLabel) \
|
||||
-values $labname \
|
||||
-tags Label]
|
||||
|
||||
if {$maybeopen == "1"} {
|
||||
$df_tree item $df_new -open true
|
||||
}
|
||||
|
||||
DFTREE:Tree:UpdateLabel $DDF_Browser $df_tree $df_new $labname
|
||||
}
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc DFGetAttributeValue { DDF_Browser lab index } {
|
||||
|
||||
global $DDF_Browser; # necessary for DRAW command to see the browser
|
||||
|
||||
if {[catch "XAttributeValue $DDF_Browser $lab $index" ret]} {
|
||||
return ""
|
||||
}
|
||||
if {"$ret" == ""} { return "" }
|
||||
return "\[$ret\]"
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc DFOpenImage { img } {
|
||||
|
||||
global env
|
||||
|
||||
if {[catch "image create photo -file $env(DRAWHOME)/$img" ret]} {
|
||||
return ""
|
||||
}
|
||||
return $ret
|
||||
}
|
||||
Reference in New Issue
Block a user