| 1 |
578 |
markom |
# wframe.tcl - Frame with a widget on its border.
|
| 2 |
|
|
# Copyright (C) 1997 Cygnus Solutions.
|
| 3 |
|
|
# Written by Tom Tromey <tromey@cygnus.com>.
|
| 4 |
|
|
|
| 5 |
|
|
itcl_class Widgetframe {
|
| 6 |
|
|
# Where to put the widget. For now, we don't support many anchors.
|
| 7 |
|
|
# Augment as you like.
|
| 8 |
|
|
public anchor nw {
|
| 9 |
|
|
if {$anchor != "nw" && $anchor != "n"} then {
|
| 10 |
|
|
error "anchors nw and n are the only ones supported"
|
| 11 |
|
|
}
|
| 12 |
|
|
_layout
|
| 13 |
|
|
}
|
| 14 |
|
|
|
| 15 |
|
|
# The name of the widget to put on the frame. This is set by some
|
| 16 |
|
|
# subclass calling the _add method. Private variable.
|
| 17 |
|
|
protected _widget {}
|
| 18 |
|
|
|
| 19 |
|
|
constructor {config} {
|
| 20 |
|
|
# The standard widget-making trick.
|
| 21 |
|
|
set class [$this info class]
|
| 22 |
|
|
set hull [namespace tail $this]
|
| 23 |
|
|
set old_name $this
|
| 24 |
|
|
::rename $this $this-tmp-
|
| 25 |
|
|
::frame $hull -class $class -relief flat -borderwidth 0
|
| 26 |
|
|
::rename $hull $old_name-win-
|
| 27 |
|
|
::rename $this $old_name
|
| 28 |
|
|
|
| 29 |
|
|
frame [namespace tail $this].iframe -relief groove -borderwidth 2
|
| 30 |
|
|
grid [namespace tail $this].iframe -row 1 -sticky news
|
| 31 |
|
|
grid rowconfigure [namespace tail $this] 1 -weight 1
|
| 32 |
|
|
grid columnconfigure [namespace tail $this] 0 -weight 1
|
| 33 |
|
|
|
| 34 |
|
|
# Make an internal frame so that user stuff isn't obscured. Note
|
| 35 |
|
|
# that we can't use the placer, because it doesn't set the
|
| 36 |
|
|
# geometry of the parent.
|
| 37 |
|
|
frame [namespace tail $this].iframe.frame -borderwidth 4 -relief flat
|
| 38 |
|
|
grid [namespace tail $this].iframe.frame -row 1 -sticky news
|
| 39 |
|
|
grid rowconfigure [namespace tail $this].iframe 1 -weight 1
|
| 40 |
|
|
grid columnconfigure [namespace tail $this].iframe 0 -weight 1
|
| 41 |
|
|
|
| 42 |
|
|
bind [namespace tail $this].iframe <Destroy> [list $this delete]
|
| 43 |
|
|
}
|
| 44 |
|
|
|
| 45 |
|
|
destructor {
|
| 46 |
|
|
catch {destroy $this}
|
| 47 |
|
|
}
|
| 48 |
|
|
|
| 49 |
|
|
# Return name of internal frame.
|
| 50 |
|
|
method get_frame {} {
|
| 51 |
|
|
return [namespace tail $this].iframe.frame
|
| 52 |
|
|
}
|
| 53 |
|
|
|
| 54 |
|
|
# Name a certain widget to be put on the frame. This should be
|
| 55 |
|
|
# called by some subclass after making the widget. Protected
|
| 56 |
|
|
# method.
|
| 57 |
|
|
method _add {widget} {
|
| 58 |
|
|
set _widget $widget
|
| 59 |
|
|
set height [expr {int ([winfo reqheight $_widget] / 2)}]
|
| 60 |
|
|
grid rowconfigure [namespace tail $this] 0 -minsize $height -weight 0
|
| 61 |
|
|
grid rowconfigure [namespace tail $this].iframe 0 -minsize $height -weight 0
|
| 62 |
|
|
_layout
|
| 63 |
|
|
}
|
| 64 |
|
|
|
| 65 |
|
|
# Re-layout according to the anchor. Private method.
|
| 66 |
|
|
method _layout {} {
|
| 67 |
|
|
if {$_widget == "" || ! [winfo exists $_widget]} then {
|
| 68 |
|
|
return
|
| 69 |
|
|
}
|
| 70 |
|
|
|
| 71 |
|
|
switch -- $anchor {
|
| 72 |
|
|
n {
|
| 73 |
|
|
# Put the label over the border, in the center.
|
| 74 |
|
|
place $_widget -in [namespace tail $this].iframe -relx 0.5 -rely 0 -y -2 \
|
| 75 |
|
|
-anchor center
|
| 76 |
|
|
}
|
| 77 |
|
|
nw {
|
| 78 |
|
|
# Put the label over the border, at the top left.
|
| 79 |
|
|
place $_widget -in [namespace tail $this].iframe -relx 0 -x 6 -rely 0 -y -2 \
|
| 80 |
|
|
-anchor w
|
| 81 |
|
|
}
|
| 82 |
|
|
default {
|
| 83 |
|
|
error "unsupported anchor \"$anchor\""
|
| 84 |
|
|
}
|
| 85 |
|
|
}
|
| 86 |
|
|
}
|
| 87 |
|
|
}
|
