You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
88 lines
2.7 KiB
Tcl
88 lines
2.7 KiB
Tcl
15 years ago
|
# wframe.tcl - Frame with a widget on its border.
|
||
|
|
# Copyright (C) 1997 Cygnus Solutions.
|
||
|
|
# Written by Tom Tromey <tromey@cygnus.com>.
|
||
|
|
|
||
|
|
itcl_class Widgetframe {
|
||
|
|
# Where to put the widget. For now, we don't support many anchors.
|
||
|
|
# Augment as you like.
|
||
|
|
public anchor nw {
|
||
|
|
if {$anchor != "nw" && $anchor != "n"} then {
|
||
|
|
error "anchors nw and n are the only ones supported"
|
||
|
|
}
|
||
|
|
_layout
|
||
|
|
}
|
||
|
|
|
||
|
|
# The name of the widget to put on the frame. This is set by some
|
||
|
|
# subclass calling the _add method. Private variable.
|
||
|
|
protected _widget {}
|
||
|
|
|
||
|
|
constructor {config} {
|
||
|
|
# The standard widget-making trick.
|
||
|
|
set class [$this info class]
|
||
|
|
set hull [namespace tail $this]
|
||
|
|
set old_name $this
|
||
|
|
::rename $this $this-tmp-
|
||
|
|
::frame $hull -class $class -relief flat -borderwidth 0
|
||
|
|
::rename $hull $old_name-win-
|
||
|
|
::rename $this $old_name
|
||
|
|
|
||
|
|
frame [namespace tail $this].iframe -relief groove -borderwidth 2
|
||
|
|
grid [namespace tail $this].iframe -row 1 -sticky news
|
||
|
|
grid rowconfigure [namespace tail $this] 1 -weight 1
|
||
|
|
grid columnconfigure [namespace tail $this] 0 -weight 1
|
||
|
|
|
||
|
|
# Make an internal frame so that user stuff isn't obscured. Note
|
||
|
|
# that we can't use the placer, because it doesn't set the
|
||
|
|
# geometry of the parent.
|
||
|
|
frame [namespace tail $this].iframe.frame -borderwidth 4 -relief flat
|
||
|
|
grid [namespace tail $this].iframe.frame -row 1 -sticky news
|
||
|
|
grid rowconfigure [namespace tail $this].iframe 1 -weight 1
|
||
|
|
grid columnconfigure [namespace tail $this].iframe 0 -weight 1
|
||
|
|
|
||
|
|
bind [namespace tail $this].iframe <Destroy> [list $this delete]
|
||
|
|
}
|
||
|
|
|
||
|
|
destructor {
|
||
|
|
catch {destroy $this}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Return name of internal frame.
|
||
|
|
method get_frame {} {
|
||
|
|
return [namespace tail $this].iframe.frame
|
||
|
|
}
|
||
|
|
|
||
|
|
# Name a certain widget to be put on the frame. This should be
|
||
|
|
# called by some subclass after making the widget. Protected
|
||
|
|
# method.
|
||
|
|
method _add {widget} {
|
||
|
|
set _widget $widget
|
||
|
|
set height [expr {int ([winfo reqheight $_widget] / 2)}]
|
||
|
|
grid rowconfigure [namespace tail $this] 0 -minsize $height -weight 0
|
||
|
|
grid rowconfigure [namespace tail $this].iframe 0 -minsize $height -weight 0
|
||
|
|
_layout
|
||
|
|
}
|
||
|
|
|
||
|
|
# Re-layout according to the anchor. Private method.
|
||
|
|
method _layout {} {
|
||
|
|
if {$_widget == "" || ! [winfo exists $_widget]} then {
|
||
|
|
return
|
||
|
|
}
|
||
|
|
|
||
|
|
switch -- $anchor {
|
||
|
|
n {
|
||
|
|
# Put the label over the border, in the center.
|
||
|
|
place $_widget -in [namespace tail $this].iframe -relx 0.5 -rely 0 -y -2 \
|
||
|
|
-anchor center
|
||
|
|
}
|
||
|
|
nw {
|
||
|
|
# Put the label over the border, at the top left.
|
||
|
|
place $_widget -in [namespace tail $this].iframe -relx 0 -x 6 -rely 0 -y -2 \
|
||
|
|
-anchor w
|
||
|
|
}
|
||
|
|
default {
|
||
|
|
error "unsupported anchor \"$anchor\""
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|