mirror of
https://git.dev.opencascade.org/repos/occt.git
synced 2025-04-08 18:40:55 +03:00
d5f74e42d6
License statement text corrected; compiler warnings caused by Bison 2.41 disabled for MSVC; a few other compiler warnings on 54-bit Windows eliminated by appropriate type cast Wrong license statements corrected in several files. Copyright and license statements added in XSD and GLSL files. Copyright year updated in some files. Obsolete documentation files removed from DrawResources.
427 lines
12 KiB
Tcl
427 lines
12 KiB
Tcl
# Copyright (c) 1999-2014 OPEN CASCADE SAS
|
|
#
|
|
# This file is part of Open CASCADE Technology software library.
|
|
#
|
|
# This library is free software; you can redistribute it and/or modify it under
|
|
# the terms of the GNU Lesser General Public License version 2.1 as published
|
|
# by the Free Software Foundation, with special exception defined in the file
|
|
# OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
|
|
# distribution for complete text of the license and disclaimer of any warranty.
|
|
#
|
|
# Alternatively, this file may be used under the terms of Open CASCADE
|
|
# commercial license or contractual agreement.
|
|
|
|
###########################
|
|
# #
|
|
# 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
|
|
}
|