mirror of
https://git.dev.opencascade.org/repos/occt.git
synced 2025-08-09 13:22:24 +03:00
Integration of OCCT 6.5.0 from SVN
This commit is contained in:
bugmaster
bugmaster
413
src/DDataStd/DDataStd_TreeBrowser.tcl
Executable file
413
src/DDataStd/DDataStd_TreeBrowser.tcl
Executable file
@@ -0,0 +1,413 @@
|
||||
###########################
|
||||
# #
|
||||
# Version 1.0 #
|
||||
# by FID #
|
||||
# #
|
||||
###########################
|
||||
#
|
||||
# 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 } {
|
||||
}
|
||||
|
||||
global TreeBrowser
|
||||
|
||||
proc treebrowser { TreeBrowser } {
|
||||
|
||||
global TREE_WINDOWS
|
||||
global TREE_LabelStyle
|
||||
global TREE_LabelStyle1
|
||||
global TREE_AttributeStyle
|
||||
global TREE_AttributeStyle1
|
||||
global TREE_AttributeStyle2
|
||||
|
||||
global $TreeBrowser
|
||||
|
||||
package require Tix
|
||||
tixPref:InitFontSet:14Point
|
||||
|
||||
set TREE_LabelStyle [tixDisplayStyle imagetext \
|
||||
-font 9x15bold \
|
||||
-background Bisque3 \
|
||||
]
|
||||
|
||||
set TREE_LabelStyle1 [tixDisplayStyle imagetext \
|
||||
-font 9x15bold \
|
||||
-background Bisque3 \
|
||||
-foreground SeaGreen2 \
|
||||
]
|
||||
|
||||
set TREE_AttributeStyle [tixDisplayStyle imagetext \
|
||||
-font 9x15 \
|
||||
-background Bisque3 \
|
||||
]
|
||||
|
||||
set TREE_AttributeStyle1 [tixDisplayStyle imagetext \
|
||||
-font 9x15 \
|
||||
-background Bisque3 \
|
||||
-foreground Green \
|
||||
]
|
||||
|
||||
set TREE_AttributeStyle2 [tixDisplayStyle imagetext \
|
||||
-font 9x15 \
|
||||
-background Bisque3 \
|
||||
-foreground Red \
|
||||
]
|
||||
|
||||
set w .$TreeBrowser
|
||||
toplevel $w
|
||||
|
||||
set top [frame $w.thu -bd 1 -relief raised -background Bisque3]
|
||||
|
||||
################
|
||||
# Paned Window #
|
||||
################
|
||||
set p [tixPanedWindow $top.p -orient horizontal -height 400 -width 700]
|
||||
pack $p -expand yes -fill both -padx 4 -pady 4
|
||||
|
||||
TREE:Tree:InitTreePanel $TreeBrowser $w $p
|
||||
#TREE:Tree:InitTextPanel $TreeBrowser $w $p
|
||||
|
||||
tixForm $top -left 2 -top 2 -right %99 -bottom %99
|
||||
|
||||
return
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc TREE:Tree:InitTreePanel { TreeBrowser w p } {
|
||||
global TREE_WINDOWS
|
||||
global $TreeBrowser
|
||||
|
||||
########
|
||||
# Tree #
|
||||
########
|
||||
|
||||
set p1 [$p add pane1 -expand 1 -size 700] ; $p1 config -relief flat
|
||||
set tree [tixTree $p1.tree \
|
||||
-opencmd [list TREE:Tree:Open $TreeBrowser $w] \
|
||||
-options { \
|
||||
hlist.separator "^" \
|
||||
hlist.font 9x15bold \
|
||||
hlist.background Bisque3 \
|
||||
hlist.foreground Black \
|
||||
} ]
|
||||
pack $p1.tree -expand yes -fill both -padx 4 -pady 4
|
||||
|
||||
# -browsecmd TREE:Tree:BrowseCmd
|
||||
# Cette option peut etre ajoutee a la commande tixTree,
|
||||
# mais elle declanche l'appel a la procedure a chaque clic ,
|
||||
# double-clic, voire a chaque appui puis relachement de souris!!!
|
||||
|
||||
# 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 TREE_WINDOWS($w,NAV,tree) $tree
|
||||
set TREE_WINDOWS($w,NAV,hlist) [$tree subwidget hlist]
|
||||
$TREE_WINDOWS($w,NAV,hlist) add ^ \
|
||||
-text $TreeBrowser \
|
||||
-data [list $TreeBrowser Root]
|
||||
$TREE_WINDOWS($w,NAV,tree) setmode ^ open
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc TREE:Tree:InitTextPanel { TreeBrowser w p } {
|
||||
global TREE_WINDOWS
|
||||
global $TreeBrowser
|
||||
|
||||
########
|
||||
# Text #
|
||||
########
|
||||
set p2 [$p add pane2 -expand 4 -size 400] ; $p2 config -relief flat
|
||||
tixScrolledText $p2.st
|
||||
pack $p2.st -expand yes -fill both -padx 4 -pady 4
|
||||
|
||||
set TREE_WINDOWS($w,NAV,text) [$p2.st subwidget text]
|
||||
|
||||
|
||||
|
||||
$TREE_WINDOWS($w,NAV,text) insert end " Welcome to the QDF browser (Rev #.#)\n"
|
||||
$TREE_WINDOWS($w,NAV,text) insert end "--------------------------------------\n\n"
|
||||
$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"
|
||||
$TREE_WINDOWS($w,NAV,text) insert end "\t\t\t\tFID & YAN"
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc TREE:Tree:BrowseCmd { dir } {
|
||||
puts "Hello $dir !"
|
||||
}
|
||||
###############################################################################
|
||||
# Se positionne sur l'entry pere et update les fenetres.
|
||||
#
|
||||
proc FCTREE:Tree:Up { w } {
|
||||
global TREE_WINDOWS
|
||||
global TREE_GLOBALS
|
||||
#puts "TREE:Tree:Up"
|
||||
|
||||
if { [set here [$TREE_WINDOWS($w,NAV,hlist) info anchor]] != {} } {
|
||||
if { [set up [$TREE_WINDOWS($w,NAV,hlist) info parent $here]] != {} } {
|
||||
TREE:Tree:ShowUp $w $up
|
||||
set TREE_GLOBALS(CWD) [lindex [$TREE_WINDOWS($w,NAV,hlist) info data $up] 0]
|
||||
}
|
||||
}
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
# Se positionne sur l'entry up sans update (History)
|
||||
#
|
||||
proc TREE:Tree:ShowUp { w dir } {
|
||||
global TREE_WINDOWS
|
||||
#puts "TREE:Tree:ShowUp"
|
||||
|
||||
$TREE_WINDOWS($w,NAV,hlist) anchor clear
|
||||
$TREE_WINDOWS($w,NAV,hlist) anchor set $dir
|
||||
$TREE_WINDOWS($w,NAV,hlist) selection clear
|
||||
$TREE_WINDOWS($w,NAV,hlist) selection set $dir
|
||||
$TREE_WINDOWS($w,NAV,hlist) see $dir
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc TREE:Tree:Open { TreeBrowser w dir} {
|
||||
global TREE_WINDOWS
|
||||
global $TreeBrowser
|
||||
#puts "TREE:Tree:Open"
|
||||
|
||||
if {$dir == "^"} {
|
||||
# This is root
|
||||
if {[$TREE_WINDOWS($w,NAV,hlist) info children $dir] != {}} {
|
||||
# The root branch already exists in hlist.
|
||||
# Clear all its children to force the tree to be updated.
|
||||
foreach kid [$TREE_WINDOWS($w,NAV,hlist) info children $dir] {
|
||||
$TREE_WINDOWS($w,NAV,hlist) delete entry $kid
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if {[$TREE_WINDOWS($w,NAV,hlist) info children $dir] != {}} {
|
||||
# The branch exists in hlist.
|
||||
foreach kid [$TREE_WINDOWS($w,NAV,hlist) info children $dir] {
|
||||
$TREE_WINDOWS($w,NAV,hlist) show entry $kid
|
||||
}
|
||||
set data [$TREE_WINDOWS($w,NAV,hlist) info data $dir]
|
||||
#set loc [lindex $data 0]
|
||||
} else {
|
||||
# The branch is unknown.
|
||||
tixBusy $w on
|
||||
update
|
||||
TREE:Tree:Fill $TreeBrowser $w $dir
|
||||
tixBusy $w off
|
||||
}
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc TREE:Tree:Fill { TreeBrowser w dir } {
|
||||
global TREE_WINDOWS
|
||||
global TREE_GLOBALS
|
||||
global $TreeBrowser
|
||||
#puts "TREE:Tree:Fill"
|
||||
|
||||
set data [$TREE_WINDOWS($w,NAV,hlist) info data $dir]
|
||||
#set loc [lindex $data 0]
|
||||
set type [lindex $data 1]
|
||||
|
||||
#puts "====================="
|
||||
#puts "Type $type"
|
||||
#puts "Window $w"
|
||||
#puts "Loc $loc"
|
||||
#puts "Dir $dir"
|
||||
#puts "====================="
|
||||
|
||||
switch -glob $type {
|
||||
|
||||
Root {
|
||||
TREE:Tree:UpdateRoot $TreeBrowser $w $dir
|
||||
}
|
||||
|
||||
Node {
|
||||
set lab [lindex $data 0]
|
||||
TREE:Tree:UpdateNode $TreeBrowser $w $dir $lab
|
||||
}
|
||||
|
||||
terminal {
|
||||
TREE:Tree:terminal $TreeBrowser $w $dir
|
||||
}
|
||||
|
||||
default {
|
||||
puts "type non reconnu"
|
||||
}
|
||||
}
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
# ici dir = ^
|
||||
#
|
||||
proc TREE:Tree:UpdateRoot { TreeBrowser w dir } {
|
||||
global TREE_WINDOWS
|
||||
global $TreeBrowser
|
||||
global TREE_AttributeStyle
|
||||
global TREE_AttributeStyle1
|
||||
#puts "TREE:Tree:UpdateRoot"
|
||||
|
||||
foreach nodeItem [split [OpenNode $TreeBrowser ""] "\\" ] {
|
||||
|
||||
TREE:Tree:DecodeNodeItem $TreeBrowser $w $dir $nodeItem
|
||||
|
||||
}
|
||||
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc TREE:Tree:UpdateNode { TreeBrowser w dir lab} {
|
||||
global TREE_WINDOWS
|
||||
global $TreeBrowser
|
||||
global TREE_AttributeStyle
|
||||
global TREE_AttributeStyle1
|
||||
#puts "TREE:Tree:UpdateNode"
|
||||
|
||||
foreach nodeItem [split [OpenNode $TreeBrowser $lab ] "\\" ] {
|
||||
|
||||
TREE:Tree:DecodeNodeItem $TreeBrowser $w $dir $nodeItem
|
||||
|
||||
}
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
# item:
|
||||
# "LabelEntry "Name" DynamicType Executable|Forgotten Failed|Success First|Null [ LabelFather]"
|
||||
proc TREE:Tree:DecodeNodeItem { TreeBrowser w dir nodeItem} {
|
||||
global TREE_WINDOWS
|
||||
global $TreeBrowser
|
||||
global TREE_AttributeStyle
|
||||
global TREE_AttributeStyle1
|
||||
global TREE_AttributeStyle2
|
||||
#puts "TREE:Tree:DecodeNodeItem"
|
||||
|
||||
set litm {}
|
||||
set standardimage [tix getimage file]
|
||||
set forgottenimage [tix getimage maximize]
|
||||
set image $standardimage
|
||||
|
||||
# Information first split
|
||||
set tmplist [split $nodeItem " "]
|
||||
set labentry [lindex $tmplist 0]
|
||||
set name [lindex $tmplist 1]
|
||||
set type [lindex $tmplist 2]
|
||||
#set exec [lindex $tmplist 3]
|
||||
#set state [lindex $tmplist 4]
|
||||
set children [lindex $tmplist 3]
|
||||
set father [lindex $tmplist 4]
|
||||
set first [lindex $tmplist 5]
|
||||
set next [lindex $tmplist 6]
|
||||
set previous [lindex $tmplist 7]
|
||||
|
||||
#puts "labentry : $labentry"
|
||||
#puts "name : $name"
|
||||
#puts "type : $type"
|
||||
#puts "state : $state"
|
||||
#puts "exec : $exec"
|
||||
#puts "children : $children"
|
||||
#puts "father : $father"
|
||||
#puts "first : $first"
|
||||
#puts "next : $next"
|
||||
#puts "previous : $previous"
|
||||
|
||||
# Label entry , name & Dynamic type.
|
||||
set ll [expr [string length $name] -2]
|
||||
if {$ll > 0} {
|
||||
set textname "$labentry [string range $name 1 $ll] $type"
|
||||
} else {
|
||||
set textname "$labentry $type"
|
||||
}
|
||||
|
||||
set locstyle $TREE_AttributeStyle
|
||||
|
||||
# Executable/Forgotten?
|
||||
#if {$exec == "Forgotten"} {
|
||||
#set textname "$textname $exec"
|
||||
#set locstyle $TREE_AttributeStyle1
|
||||
#set image $forgottenimage
|
||||
#}
|
||||
|
||||
# Failed/Success analysis.
|
||||
#if {$state == "Failed"} {
|
||||
#set textname "$textname $state"
|
||||
#set locstyle $TREE_AttributeStyle2
|
||||
#}
|
||||
|
||||
# Father?
|
||||
if {$father != "Null"} {set textname "$textname Father=$father"}
|
||||
# First?
|
||||
if {$first != "Null"} {set textname "$textname First=$first"}
|
||||
# Next?
|
||||
if {$next != "Null"} {set textname "$textname Next=$next"}
|
||||
# Previous?
|
||||
if {$previous != "Null"} {set textname "$textname Previous=$previous"}
|
||||
|
||||
$TREE_WINDOWS($w,NAV,hlist) add ${dir}^${labentry} \
|
||||
-itemtype imagetext \
|
||||
-text $textname \
|
||||
-image $image \
|
||||
-style $locstyle \
|
||||
-data [list ${labentry} Node]
|
||||
if {$children == "First"} {
|
||||
$TREE_WINDOWS($w,NAV,tree) setmode ${dir}^${labentry} open
|
||||
}
|
||||
lappend litm [list $labentry $image]
|
||||
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc TREE:Tree:terminal { TreeBrowser w dir } {
|
||||
global TREE_WINDOWS
|
||||
global $TreeBrowser
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc TREE:Tree:DisplayAttribute { TreeBrowser w dir } {
|
||||
global TREE_WINDOWS
|
||||
global $TreeBrowser
|
||||
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
# imprime tout ce qu'il y a dans hli ( Hlist )
|
||||
#
|
||||
proc wokDBG { {root {}} } {
|
||||
global TREE_GLOBALS
|
||||
global TREE_WINDOWS
|
||||
set w $TREE_GLOBALS(toplevel)
|
||||
set hli $TREE_WINDOWS($w,NAV,hlist)
|
||||
foreach c [$hli info children $root] {
|
||||
puts "$c : data <[$hli info data $c]>"
|
||||
wokDBG $c
|
||||
}
|
||||
return
|
||||
}
|
||||
Reference in New Issue
Block a user