365 lines
11 KiB
Tcl
365 lines
11 KiB
Tcl
#------------------------------------------------------
|
|
# Script for generating the "cell manager" window.
|
|
#
|
|
# Written by Daniel Bearden and Tim Edwards, 2009-2010
|
|
#------------------------------------------------------
|
|
|
|
global Opts
|
|
|
|
if {$::tk_version >= 8.5} {
|
|
|
|
set Opts(cellmgr) 0
|
|
|
|
magic::tag add select "magic::mgrselect %r"
|
|
magic::tag add load "catch {magic::clearstack}; magic::cellmanager"
|
|
magic::tag add getcell "magic::cellmanager"
|
|
|
|
# Callback to the cell manager
|
|
|
|
proc magic::instcallback {command} {
|
|
global Opts
|
|
|
|
set rpath [ split [.cellmgr.box.view focus] "/"]
|
|
set rootdef [lindex $rpath 0]
|
|
set cellpath [lrange $rpath 1 end]
|
|
set celldef [lrange $rpath end end]
|
|
|
|
if { $Opts(target) == "default" } {
|
|
set winlist [magic::windownames layout]
|
|
set winname [lindex $winlist 0]
|
|
} else {
|
|
set winname $Opts(target)
|
|
}
|
|
|
|
if { $cellpath == {} } {
|
|
switch $command {
|
|
load {$winname load $rootdef}
|
|
place {$winname getcell $rootdef}
|
|
default {
|
|
magic::select top cell
|
|
switch $command {
|
|
edit {$winname expand; $winname edit}
|
|
expand {$winname expand}
|
|
zoom {$winname view}
|
|
}
|
|
}
|
|
}
|
|
} else {
|
|
set celluse [join $cellpath "/"]
|
|
set curpath [$winname windowcaption]
|
|
set curname [lindex $curpath 2]
|
|
set curroot [lindex $curpath 0]
|
|
|
|
switch $command {
|
|
load {$winname load $celldef}
|
|
place {$winname getcell $celldef}
|
|
default {
|
|
# Here: need to check first for the select cell belonging to the
|
|
# current loaded root cell (get the first use).
|
|
set defpath [list $rootdef]
|
|
foreach i $cellpath {
|
|
lappend defpath [magic::instance list celldef $i]
|
|
}
|
|
set rootpos [lsearch $defpath $curroot]
|
|
if {$rootpos < 0} {
|
|
$winname load $rootdef
|
|
set rootpos 0
|
|
}
|
|
# set usepath [join [lrange $cellpath $rootpos end] "/"]
|
|
|
|
set usepath [magic::findinstance .cellmgr.box.view \
|
|
[.cellmgr.box.view selection]]
|
|
$winname select cell ${usepath}
|
|
|
|
switch $command {
|
|
edit {$winname expand; $winname edit}
|
|
expand {$winname expand toggle}
|
|
zoom {$winname findbox zoom}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# The cell manager
|
|
|
|
proc magic::makecellmanager { mgrpath } {
|
|
|
|
toplevel ${mgrpath}
|
|
wm withdraw ${mgrpath}
|
|
frame ${mgrpath}.actionbar
|
|
frame ${mgrpath}.box
|
|
frame ${mgrpath}.target
|
|
|
|
ttk::treeview ${mgrpath}.box.view -show tree -selectmode browse \
|
|
-yscrollcommand "${mgrpath}.box.vert set" \
|
|
-xscrollcommand "${mgrpath}.box.vert set" \
|
|
-columns 1
|
|
scrollbar ${mgrpath}.box.vert -orient vertical -command "${mgrpath}.box.view yview"
|
|
|
|
pack ${mgrpath}.actionbar -side top -fill x
|
|
pack ${mgrpath}.box.view -side left -fill both -expand true
|
|
pack ${mgrpath}.box.vert -side right -fill y
|
|
pack ${mgrpath}.box -side top -fill both -expand true
|
|
pack ${mgrpath}.target -side top -fill x
|
|
|
|
button ${mgrpath}.actionbar.done -text "Zoom" -command {magic::instcallback zoom}
|
|
button ${mgrpath}.actionbar.edit -text "Edit" -command {magic::instcallback edit}
|
|
button ${mgrpath}.actionbar.load -text "Load" -command {magic::instcallback load}
|
|
button ${mgrpath}.actionbar.expand -text "Expand" -command \
|
|
{magic::instcallback expand}
|
|
button ${mgrpath}.actionbar.place -text "Place" -command \
|
|
{magic::instcallback place}
|
|
button ${mgrpath}.actionbar.refresh -text "Refresh" -command \
|
|
{magic::cellmanager update}
|
|
|
|
pack ${mgrpath}.actionbar.load -side left
|
|
pack ${mgrpath}.actionbar.edit -side left
|
|
pack ${mgrpath}.actionbar.expand -side left
|
|
pack ${mgrpath}.actionbar.place -side left
|
|
pack ${mgrpath}.actionbar.refresh -side left
|
|
pack ${mgrpath}.actionbar.done -side right
|
|
|
|
label ${mgrpath}.target.name -text "Target window:"
|
|
menubutton ${mgrpath}.target.list -text "default" \
|
|
-menu ${mgrpath}.target.list.winmenu
|
|
|
|
pack ${mgrpath}.target.name -side left -padx 2
|
|
pack ${mgrpath}.target.list -side left
|
|
|
|
.winmenu clone ${mgrpath}.target.list.winmenu
|
|
|
|
#Withdraw the window when the close button is pressed
|
|
wm protocol ${mgrpath} WM_DELETE_WINDOW "set Opts(cellmgr) 0 ; \
|
|
wm withdraw ${mgrpath}"
|
|
|
|
#-------------------------------------------------
|
|
# Callback when a treeview item is opened
|
|
#-------------------------------------------------
|
|
|
|
bind .cellmgr <<TreeviewOpen>> {
|
|
set s [.cellmgr.box.view selection]
|
|
# puts stdout "open $s"
|
|
foreach i [.cellmgr.box.view children $s] {
|
|
magic::addlistset $i
|
|
.cellmgr.box.view item $i -open false
|
|
}
|
|
}
|
|
|
|
bind .cellmgr <<TreeviewClose>> {
|
|
set s [.cellmgr.box.view selection]
|
|
# puts stdout "close $s"
|
|
foreach i [.cellmgr.box.view children $s] {
|
|
foreach j [.cellmgr.box.view children $i] {
|
|
.cellmgr.box.view delete $j
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
proc magic::addlistentry {parent child cinst} {
|
|
if {$child != 0} {
|
|
set hiername [join [list $parent $child] "/"]
|
|
# puts stdout "listentry $hiername"
|
|
if {[.cellmgr.box.view exists $hiername] == 0} {
|
|
.cellmgr.box.view insert $parent end -id $hiername -text "$child"
|
|
.cellmgr.box.view set $hiername 0 "$cinst"
|
|
}
|
|
}
|
|
}
|
|
|
|
proc magic::addlistset {item} {
|
|
set cellname [.cellmgr.box.view item $item -text]
|
|
set cd [magic::cellname list children $cellname]
|
|
if {$cd != 0} {
|
|
foreach i $cd {
|
|
set inst [lindex [magic::cellname list instances $i] 0]
|
|
magic::addlistentry $item $i $inst
|
|
}
|
|
}
|
|
}
|
|
|
|
#--------------------------------------------------------------
|
|
# Get the hierarchical name of the treeview item corresponding
|
|
# to the cell view in the window
|
|
#--------------------------------------------------------------
|
|
|
|
proc magic::getwindowitem {} {
|
|
set tl [magic::cellname list window]
|
|
if {![catch {set editstack}]} {
|
|
set tl [concat $editstack $tl]
|
|
}
|
|
|
|
set pl [magic::cellname list parents [lindex $tl 0]]
|
|
while {$pl != {}} {
|
|
set tl [concat [lindex $pl 0] $tl]
|
|
set pl [magic::cellname list parents [lindex $tl 0]]
|
|
}
|
|
|
|
set newpl ""
|
|
set parent {}
|
|
foreach j $tl {
|
|
set parent $pl
|
|
set pl "${newpl}$j"
|
|
|
|
if {[.cellmgr.box.view exists $pl] == 0} {
|
|
.cellmgr.box.view insert $parent end -id $pl -text "$j"
|
|
set inst [lindex [magic::cellname list instances $j] 0]
|
|
.cellmgr.box.view set $pl 0 "$inst"
|
|
magic::addlistset $pl
|
|
}
|
|
.cellmgr.box.view item $pl -open true
|
|
set newpl "${pl}/"
|
|
}
|
|
return $pl
|
|
}
|
|
|
|
#--------------------------------------------------------------
|
|
# The cell manager window main callback function
|
|
#--------------------------------------------------------------
|
|
|
|
proc magic::cellmanager {{option "update"}} {
|
|
global editstack
|
|
|
|
# Check for existence of the manager widget
|
|
if {[catch {wm state .cellmgr}]} {
|
|
if {$option == "create"} {
|
|
magic::makecellmanager .cellmgr
|
|
} else {
|
|
return
|
|
}
|
|
} elseif { $option == "create"} {
|
|
return
|
|
}
|
|
|
|
magic::suspendall
|
|
|
|
# determine the full cell heirarchy
|
|
set tl [magic::cellname list topcells]
|
|
foreach i $tl {
|
|
if {[file extension $i] == ".mag"} {
|
|
set nameroot [file rootname $i]
|
|
} else {
|
|
set nameroot $i
|
|
}
|
|
set nameroot [file tail $nameroot]
|
|
|
|
if {[.cellmgr.box.view exists $i] == 0} {
|
|
.cellmgr.box.view insert {} end -id $i -text $nameroot
|
|
}
|
|
magic::addlistset $i
|
|
.cellmgr.box.view item $i -open false
|
|
}
|
|
|
|
# Open view to current cell, generating the hierarchy as necessary.
|
|
# Accept the first hierarchy, unless the push/pop stack has been
|
|
# used.
|
|
|
|
set pl [magic::getwindowitem]
|
|
.cellmgr.box.view selection set $pl
|
|
.cellmgr.box.view see $pl
|
|
|
|
# Generate next level of hierarchy (not open)
|
|
|
|
magic::addlistset $pl
|
|
.cellmgr.box.view item $pl -open false
|
|
|
|
magic::resumeall
|
|
}
|
|
|
|
#--------------------------------------------------------------
|
|
# Redirect and reformat Tcl output of "select" command
|
|
#--------------------------------------------------------------
|
|
|
|
proc magic::mgrselect {{sstr ""}} {
|
|
# Make sure we have a valid option, and the cell manager exists.
|
|
if {$sstr == ""} {
|
|
return
|
|
} elseif {[catch {wm state .cellmgr}]} {
|
|
return
|
|
}
|
|
|
|
set savetag [magic::tag select]
|
|
magic::tag select {}
|
|
.cellmgr.box.view selection remove [.cellmgr.box.view selection]
|
|
# puts stdout "selecting $sstr"
|
|
|
|
if {[llength $sstr] == 5} {
|
|
# sstr is "Topmost cell in the window"
|
|
set item [magic::getwindowitem]
|
|
} else {
|
|
regsub -all {\[.*\]} $sstr {[^a-z]+} gsrch
|
|
if {[catch {set item [magic::scantree .cellmgr.box.view $gsrch]}]} {
|
|
set item ""
|
|
}
|
|
}
|
|
if {$item != ""} {
|
|
.cellmgr.box.view item $item -open false
|
|
.cellmgr.box.view selection set $item
|
|
if {[wm state .cellmgr] == "normal"} { .cellmgr.box.view see $item }
|
|
if {$sstr != ""} {
|
|
puts stdout "Selected cell is $item ($sstr)"
|
|
}
|
|
}
|
|
magic::tag select $savetag
|
|
}
|
|
|
|
#------------------------------------------------------------
|
|
# Given an item in the tree view, return a string of slash-
|
|
# separated instances that can be used by "select cell".
|
|
# This is effectively the inverse of magic::scantree
|
|
#------------------------------------------------------------
|
|
|
|
proc magic::findinstance {tree item} {
|
|
set start [magic::getwindowitem]
|
|
set start ${start}/
|
|
set pathhead [string first $start $item]
|
|
if {$pathhead >= 0} {
|
|
set ss [expr {$pathhead -1}]
|
|
set sb [expr {[string length $start] + $pathhead}]
|
|
set pathtail [string range $item 0 $ss][string range $item $sb end]
|
|
set rpath [ split [join $pathtail] "/"]
|
|
set cinst ""
|
|
while {$rpath != {}} {
|
|
set item ${start}[lindex $rpath 0]
|
|
set rpath [lrange $rpath 1 end]
|
|
if {[string length $cinst] == 0} {
|
|
set cinst [$tree set $item 0]
|
|
} else {
|
|
set cinst ${cinst}/[$tree set $item 0]
|
|
}
|
|
set start ${item}/
|
|
}
|
|
return $cinst
|
|
}
|
|
return {}
|
|
}
|
|
|
|
#------------------------------------------------------------
|
|
# Given an item in the form of a string returned by magic's
|
|
# "select list" command (list of slash-separated instances),
|
|
# find the corresponding tree item.
|
|
#------------------------------------------------------------
|
|
|
|
proc magic::scantree {tree item} {
|
|
set start [magic::getwindowitem]
|
|
set rpath [ split [join $item] "/"]
|
|
while {$rpath != {}} {
|
|
set pathhead [lindex $rpath 0]
|
|
set pathtail [join [lrange $rpath 1 end] "/"]
|
|
set cellname [magic::instance list celldef $pathhead]
|
|
set item [join [list $start [join $cellname]] "/"]
|
|
magic::addlistset $item
|
|
$tree set $item 0 $pathhead
|
|
$tree item $item -open true
|
|
set start $item
|
|
set item $pathtail
|
|
set rpath [ split [join $item] "/"]
|
|
}
|
|
$tree item $start -open false
|
|
return $start
|
|
}
|
|
|
|
} ;# (if Tk version 8.5)
|
|
|