neingeist
/
arduinisten
Archived
1
0
Fork 0
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.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.

88 lines
2.7 KiB
Tcl

# 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\""
}
}
}
}