mirror of
https://git.dev.opencascade.org/repos/occt.git
synced 2025-08-04 13:13:25 +03:00
0023016: Elimination of dependency of Tcl OCAF Browser from Tix product
This commit is contained in:
szv
bugmaster
@@ -1,541 +0,0 @@
|
||||
###########################
|
||||
# #
|
||||
# Version 1.3 #
|
||||
# by FID & YAN #
|
||||
# #
|
||||
###########################
|
||||
#
|
||||
# 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 DFTREE_WINDOWS
|
||||
global DFTREE_LabelStyle
|
||||
global DFTREE_LabelStyle1
|
||||
global DFTREE_AttributeStyle
|
||||
global DFTREE_AttributeStyle1
|
||||
global DFTREE_AttributeStyle2
|
||||
|
||||
global $DDF_Browser
|
||||
## global $DDF_Browser
|
||||
puts $DDF_Browser
|
||||
|
||||
package require Tix
|
||||
#tixPref:InitFontSet:14Point
|
||||
|
||||
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
|
||||
|
||||
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
|
||||
|
||||
DFTREE:Tree:InitTreePanel $DDF_Browser $w $p
|
||||
# DFTREE:Tree:InitTextPanel $DDF_Browser $w $p
|
||||
|
||||
tixForm $top -left 2 -top 2 -right %99 -bottom %99
|
||||
|
||||
return
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc DFTREE:Tree:InitTreePanel { DDF_Browser w p } {
|
||||
global DFTREE_WINDOWS
|
||||
global $DDF_Browser
|
||||
|
||||
########
|
||||
# Tree #
|
||||
########
|
||||
|
||||
set p1 [$p add pane1 -expand 1 -size 700] ; $p1 config -relief flat
|
||||
set tree [tixTree $p1.tree \
|
||||
-opencmd [list DFTREE:Tree:Open $DDF_Browser $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 DFTREE: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 DFTREE_WINDOWS($w,NAV,tree) $tree
|
||||
set DFTREE_WINDOWS($w,NAV,hlist) [$tree subwidget hlist]
|
||||
$DFTREE_WINDOWS($w,NAV,hlist) add ^ \
|
||||
-text $DDF_Browser \
|
||||
-data [list $DDF_Browser DataFramework]
|
||||
$DFTREE_WINDOWS($w,NAV,tree) setmode ^ open
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc DFTREE:Tree:InitTextPanel { DDF_Browser w p } {
|
||||
global DFTREE_WINDOWS
|
||||
global $DDF_Browser
|
||||
|
||||
########
|
||||
# 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 DFTREE_WINDOWS($w,NAV,text) [$p2.st subwidget text]
|
||||
|
||||
|
||||
|
||||
$DFTREE_WINDOWS($w,NAV,text) insert end " Welcome to the QDF browser (Rev #.#)\n"
|
||||
$DFTREE_WINDOWS($w,NAV,text) insert end "--------------------------------------\n\n"
|
||||
$DFTREE_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"
|
||||
$DFTREE_WINDOWS($w,NAV,text) insert end "\t\t\t\tFID & YAN"
|
||||
}
|
||||
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc DFTREE:Tree:BrowseCmd { dir } {
|
||||
puts "Hello $dir !"
|
||||
}
|
||||
###############################################################################
|
||||
# Se positionne sur l'entry pere et update les fenetres.
|
||||
#
|
||||
proc DFTREE:Tree:Up { w } {
|
||||
global DFTREE_WINDOWS
|
||||
global DFTREE_GLOBALS
|
||||
#puts "DFTREE:Tree:Up"
|
||||
|
||||
if { [set here [$DFTREE_WINDOWS($w,NAV,hlist) info anchor]] != {} } {
|
||||
if { [set up [$DFTREE_WINDOWS($w,NAV,hlist) info parent $here]] != {} } {
|
||||
DFTREE:Tree:ShowUp $w $up
|
||||
set DFTREE_GLOBALS(CWD) [lindex [$DFTREE_WINDOWS($w,NAV,hlist) info data $up] 0]
|
||||
}
|
||||
}
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
# Se positionne sur l'entry up sans update (History)
|
||||
#
|
||||
proc DFTREE:Tree:ShowUp { w dir } {
|
||||
global DFTREE_WINDOWS
|
||||
#puts "DFTREE:Tree:ShowUp"
|
||||
|
||||
$DFTREE_WINDOWS($w,NAV,hlist) anchor clear
|
||||
$DFTREE_WINDOWS($w,NAV,hlist) anchor set $dir
|
||||
$DFTREE_WINDOWS($w,NAV,hlist) selection clear
|
||||
$DFTREE_WINDOWS($w,NAV,hlist) selection set $dir
|
||||
$DFTREE_WINDOWS($w,NAV,hlist) see $dir
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc DFTREE:Tree:Open { DDF_Browser w dir} {
|
||||
global DFTREE_WINDOWS
|
||||
global $DDF_Browser
|
||||
#puts "DFTREE:Tree:Open"
|
||||
|
||||
if {$dir == "^"} {
|
||||
# This is root
|
||||
if {[$DFTREE_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 [$DFTREE_WINDOWS($w,NAV,hlist) info children $dir] {
|
||||
$DFTREE_WINDOWS($w,NAV,hlist) delete entry $kid
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if {[$DFTREE_WINDOWS($w,NAV,hlist) info children $dir] != {}} {
|
||||
# The branch exists in hlist.
|
||||
foreach kid [$DFTREE_WINDOWS($w,NAV,hlist) info children $dir] {
|
||||
$DFTREE_WINDOWS($w,NAV,hlist) show entry $kid
|
||||
}
|
||||
set data [$DFTREE_WINDOWS($w,NAV,hlist) info data $dir]
|
||||
set loc [lindex $data 0]
|
||||
} else {
|
||||
# The branch is unknown.
|
||||
tixBusy $w on
|
||||
update
|
||||
DFTREE:Tree:Fill $DDF_Browser $w $dir
|
||||
tixBusy $w off
|
||||
}
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc DFTREE:Tree:Fill { DDF_Browser w dir } {
|
||||
global DFTREE_WINDOWS
|
||||
global DFTREE_GLOBALS
|
||||
global $DDF_Browser
|
||||
#puts "DFTREE:Tree:Fill"
|
||||
|
||||
set data [$DFTREE_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"
|
||||
switch -glob $type {
|
||||
|
||||
DataFramework {
|
||||
DFTREE:Tree:UpdateDataFramework $DDF_Browser $w $loc $dir
|
||||
}
|
||||
|
||||
Label {
|
||||
DFTREE:Tree:UpdateLabel $DDF_Browser $w $loc $dir
|
||||
}
|
||||
|
||||
AttributeList {
|
||||
set lab [lindex $data 2]
|
||||
DFTREE:Tree:UpdateAttributeList $DDF_Browser $w $loc $dir $lab
|
||||
}
|
||||
|
||||
Attribute {
|
||||
DFTREE:Tree:UpdateAttribute $DDF_Browser $w $loc $dir
|
||||
}
|
||||
|
||||
terminal {
|
||||
DFTREE:Tree:terminal $DDF_Browser $w $loc $dir
|
||||
}
|
||||
|
||||
default {
|
||||
puts "type non reconnu"
|
||||
}
|
||||
}
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
# ici dir = ^
|
||||
#
|
||||
proc DFTREE:Tree:UpdateDataFramework { DDF_Browser w loc dir } {
|
||||
global DFTREE_WINDOWS
|
||||
global $DDF_Browser
|
||||
global DFTREE_LabelStyle
|
||||
global DFTREE_LabelStyle1
|
||||
|
||||
set litm {}
|
||||
|
||||
foreach fullname [split [DFOpenLabel $DDF_Browser ""] "\\" ] {
|
||||
FCTREE:Tree:DecodeLabelItem $DDF_Browser $w $loc $dir $fullname
|
||||
}
|
||||
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
# $loc is a label entry, "1.3.2" for exemple.
|
||||
#
|
||||
proc DFTREE:Tree:UpdateLabel { DDF_Browser w loc dir } {
|
||||
global DFTREE_WINDOWS
|
||||
global $DDF_Browser
|
||||
global DFTREE_LabelStyle
|
||||
global DFTREE_LabelStyle1
|
||||
global DFTREE_AttributeStyle
|
||||
global DFTREE_AttributeStyle1
|
||||
|
||||
set litm {}
|
||||
foreach fullname [split [DFOpenLabel $DDF_Browser $loc ] "\\" ] {
|
||||
FCTREE:Tree:DecodeLabelItem $DDF_Browser $w $loc $dir $fullname
|
||||
}
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc DFTREE:Tree:UpdateAttributeList { DDF_Browser w loc dir lab} {
|
||||
global DFTREE_WINDOWS
|
||||
global $DDF_Browser
|
||||
global DFTREE_AttributeStyle
|
||||
global DFTREE_AttributeStyle1
|
||||
|
||||
set litm {}
|
||||
set standardimage [tix getimage srcfile]
|
||||
set otherimage [tix getimage file]
|
||||
set xrefimage [tix getimage cross]
|
||||
|
||||
# abv: index attributes
|
||||
set num 0
|
||||
set attributes [split [DFOpenAttributeList $DDF_Browser $lab ] "\\" ]
|
||||
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]
|
||||
|
||||
# Package analysis to determine the icon type.
|
||||
set pk [lindex [split $name _] 0]
|
||||
set image $otherimage
|
||||
if {$pk == "TDataStd" || $pk == "TNaming"} {set image $standardimage}
|
||||
if {$pk == "TXRef"} {set image $xrefimage}
|
||||
|
||||
# Name analysis to suppress the map address.
|
||||
set shortlist [split $name "#"]
|
||||
set shortname [lindex $shortlist 0]
|
||||
set index [lindex $shortlist 1]
|
||||
|
||||
set textname "$shortname"
|
||||
|
||||
# if { [llength $tmplist] >5 } { set textname [lindex $tmplist 5] }
|
||||
set textname "$textname [DFGetAttributeValue $DDF_Browser $lab [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"}
|
||||
|
||||
|
||||
$DFTREE_WINDOWS($w,NAV,hlist) add ${dir}^${name} \
|
||||
-itemtype imagetext \
|
||||
-text $textname \
|
||||
-image $image \
|
||||
-style $locstyle \
|
||||
-data [list ${index} Attribute]
|
||||
if {$maybeopen == "1"} {
|
||||
$DFTREE_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open
|
||||
}
|
||||
lappend litm [list $name $image]
|
||||
}
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
# $loc is always the attribute index
|
||||
#
|
||||
proc DFTREE:Tree:UpdateAttribute { DDF_Browser w loc dir } {
|
||||
global DFTREE_WINDOWS
|
||||
global $DDF_Browser
|
||||
global DFTREE_AttributeStyle
|
||||
global DFTREE_AttributeStyle1
|
||||
global DFTREE_AttributeStyle2
|
||||
|
||||
set litm {}
|
||||
set image [tix getimage minimize]
|
||||
set tmplist [split [DFOpenAttribute $DDF_Browser $loc ] "\\"]
|
||||
|
||||
# Failed or not?
|
||||
if {[lindex $tmplist 0] == "Failed"} {
|
||||
set locstyle $DFTREE_AttributeStyle2
|
||||
} else {
|
||||
set locstyle $DFTREE_AttributeStyle
|
||||
}
|
||||
|
||||
foreach name $tmplist {
|
||||
$DFTREE_WINDOWS($w,NAV,hlist) add ${dir}^${name} \
|
||||
-itemtype imagetext \
|
||||
-text $name \
|
||||
-image $image \
|
||||
-style $locstyle \
|
||||
-data [list ${loc}:${name} terminal] \
|
||||
-state disabled
|
||||
#$DFTREE_WINDOWS($w,NAV,tree) setmode ${dir}^${name} open
|
||||
lappend litm [list $name $image]
|
||||
}
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
# item:
|
||||
# "Entry Name=LeNomSIlExiste Modified|NotModified 0|1"
|
||||
proc FCTREE:Tree:DecodeLabelItem { DDF_Browser w loc dir labelItem} {
|
||||
global DFTREE_WINDOWS
|
||||
global $DDF_Browser
|
||||
global DFTREE_LabelStyle
|
||||
global DFTREE_LabelStyle1
|
||||
global DFTREE_AttributeStyle
|
||||
global DFTREE_AttributeStyle1
|
||||
|
||||
set image [tix getimage folder]
|
||||
|
||||
set tmplist [split $labelItem " " ]
|
||||
set labentry [lindex $tmplist 0]
|
||||
set name [lindex $tmplist 1]
|
||||
set modified [lindex $tmplist 2]
|
||||
set maybeopen [lindex $tmplist 3]
|
||||
|
||||
set textname "$labentry"
|
||||
|
||||
if {$labentry == "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 image [tix getimage textfile]
|
||||
$DFTREE_WINDOWS($w,NAV,hlist) add ${dir}^$labentry \
|
||||
-itemtype imagetext \
|
||||
-text $textname \
|
||||
-image $image \
|
||||
-style $locstyle \
|
||||
-data [list $labentry AttributeList $loc]
|
||||
$DFTREE_WINDOWS($w,NAV,tree) setmode ${dir}^$labentry open
|
||||
lappend litm [list $labentry $image]
|
||||
set image [tix getimage folder]
|
||||
|
||||
} else {
|
||||
# Sub-label(s)
|
||||
# ------------
|
||||
|
||||
# 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 locstyle $DFTREE_LabelStyle1
|
||||
} else {
|
||||
set locstyle $DFTREE_LabelStyle
|
||||
}
|
||||
|
||||
$DFTREE_WINDOWS($w,NAV,hlist) add ${dir}^$labentry \
|
||||
-itemtype imagetext \
|
||||
-text $textname \
|
||||
-image $image \
|
||||
-style $locstyle \
|
||||
-data [list $labentry Label]
|
||||
if {$maybeopen == "1"} {
|
||||
$DFTREE_WINDOWS($w,NAV,tree) setmode ${dir}^$labentry open
|
||||
}
|
||||
lappend litm [list $labentry $image]
|
||||
}
|
||||
}
|
||||
###############################################################################
|
||||
#
|
||||
#
|
||||
proc DFTREE:Tree:terminal { DDF_Browser w loc dir } {
|
||||
global DFTREE_WINDOWS
|
||||
global $DDF_Browser
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
# loc est une adresse de label?
|
||||
#
|
||||
proc DFTREE:Tree:DisplayAttribute { DDF_Browser w loc dir } {
|
||||
global DFTREE_WINDOWS
|
||||
global $DDF_Browser
|
||||
|
||||
return
|
||||
}
|
||||
###############################################################################
|
||||
# imprime tout ce qu'il y a dans hli ( Hlist )
|
||||
#
|
||||
proc wokDBG { {root {}} } {
|
||||
global DFTREE_GLOBALS
|
||||
global DFTREE_WINDOWS
|
||||
set w $DFTREE_GLOBALS(toplevel)
|
||||
set hli $DFTREE_WINDOWS($w,NAV,hlist)
|
||||
foreach c [$hli info children $root] {
|
||||
puts "$c : data <[$hli info data $c]>"
|
||||
wokDBG $c
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
proc DFGetAttributeValue {browser lab index} {
|
||||
global $browser; # necessary for DRAW command to see the browser
|
||||
#puts "$lab $index"
|
||||
# set names [split $dir ^]
|
||||
# set len [expr [llength $names] -1]
|
||||
# set lab [lindex $names [expr $len - 2]]
|
||||
# set num [lindex $names $len]
|
||||
# regexp {browser_(.*)} $browser whole doc
|
||||
# XSAttributeValue browser_D a b
|
||||
if {[catch "XAttributeValue $browser $lab $index" ret]} {
|
||||
return ""
|
||||
}
|
||||
if {"$ret" == ""} { return "" }
|
||||
return "\[$ret\]"
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user