Artifact
7ec18f62d6f6ce580ae0e5c8f3125f9e33ea03f2:
- File
panelframe.tcl
— part of check-in
[57cc13b104]
at
2004-09-09 22:17:51
on branch trunk
—
* panelframe.tcl (new): new PanelFrame widget which creates a
* pkgIndex.tcl: frame with boxed title area that accepts
* Makefile.in: additional widgets.
* BWman/contents.html:
* BWman/navtree.html:
* BWman/PanelFrame.html (new):
(user:
hobbs
size: 7846)
# ----------------------------------------------------------------------------
# panelframe.tcl
# Create PanelFrame widgets.
# A PanelFrame is a boxed frame that allows you to place items
# in the label area (liked combined frame+toolbar). It uses the
# highlight colors the default frame color.
# $Id: panelframe.tcl,v 1.1 2004/09/09 22:17:51 hobbs Exp $
# ----------------------------------------------------------------------------
# Index of commands:
# - PanelFrame::create
# - PanelFrame::configure
# - PanelFrame::cget
# - PanelFrame::getframe
# - PanelFrame::add
# - PanelFrame::remove
# - PanelFrame::items
# ----------------------------------------------------------------------------
namespace eval PanelFrame {
Widget::define PanelFrame panelframe
Widget::declare PanelFrame {
{-background TkResource "" 0 frame}
{-borderwidth TkResource 1 0 frame}
{-relief TkResource flat 0 frame}
{-panelbackground TkResource "" 0 {entry -selectbackground}}
{-panelforeground TkResource "" 0 {entry -selectforeground}}
{-width Int 0 0}
{-height Int 0 0}
{-font TkResource "" 0 label}
{-text String "" 0}
{-textvariable String "" 0}
{-ipad String 1 0}
{-bg Synonym -background}
{-bd Synonym -borderwidth}
}
# Should we have automatic state handling?
#{-state TkResource "" 0 label}
Widget::addmap PanelFrame "" :cmd {
-panelbackground -background
-width {} -height {} -borderwidth {} -relief {}
}
Widget::addmap PanelFrame "" .title {
-panelbackground -background
}
Widget::addmap PanelFrame "" .title.text {
-panelbackground -background
-panelforeground -foreground
-text {} -textvariable {} -font {}
}
Widget::addmap PanelFrame "" .frame {
-background {}
}
if {0} {
# This would be code to have an automated close button
#{-closebutton Boolean 0 0}
Widget::addmap PanelFrame "" .title.close {
-panelbackground -background
-panelforeground -foreground
}
variable HaveMarlett \
[expr {[lsearch -exact [font families] "Marlett"] != -1}]
variable imgdata {
#define close_width 16
#define close_height 16
static char close_bits[] = {
0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x10, 0x08,
0x38, 0x1c, 0x70, 0x0e,
0xe0, 0x07, 0xc0, 0x03,
0xc0, 0x03, 0xe0, 0x07,
0x70, 0x0e, 0x38, 0x1c,
0x10, 0x08, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00};
}
# We use the same -foreground as the default -panelbackground
image create bitmap ::PanelFrame::X -data $imgdata \
-foreground [lindex $Widget::PanelFrame::opt(-panelbackground) 1]
}
bind PanelFrame <Destroy> [list Widget::destroy %W]
}
# ----------------------------------------------------------------------------
# Command PanelFrame::create
# ----------------------------------------------------------------------------
proc PanelFrame::create { path args } {
variable HaveMarlett
Widget::init PanelFrame $path $args
set lblopts [list -bd 0 -highlightthickness 0]
set outer [eval [list frame $path -class PanelFrame] \
[Widget::subcget $path :cmd]]
set title [eval [list frame $path.title] \
[Widget::subcget $path .title]]
set tlbl [eval [list label $path.title.text] $lblopts -anchor w \
[Widget::subcget $path .title.text]]
set inner [eval [list frame $path.frame] \
[Widget::subcget $path .frame]]
foreach {ipadx ipady} [_padval [Widget::cget $path -ipad]] { break }
if {0} {
set btnopts [list -padx 0 -pady 0 -relief flat -overrelief raised \
-bd 1 -highlightthickness 0]
set clbl [eval [list button $path.title.close] $btnopts \
[Widget::subcget $path .title.close]]
set close [Widget::cget $path -closebutton]
if {$HaveMarlett} {
$clbl configure -font "Marlett -14" -text \u0072
} else {
$clbl configure -image ::PanelFrame::X
}
if {$close} {
pack $path.title.close -side right -padx $ipadx -pady $ipady
}
}
grid $path.title -row 0 -column 0 -sticky ew
grid $path.frame -row 1 -column 0 -sticky news
grid columnconfigure $path 0 -weight 1
grid rowconfigure $path 1 -weight 1
pack $path.title.text -side left -fill x -anchor w \
-padx $ipadx -pady $ipady
return [Widget::create PanelFrame $path]
}
# ----------------------------------------------------------------------------
# Command PanelFrame::configure
# ----------------------------------------------------------------------------
proc PanelFrame::configure { path args } {
set res [Widget::configure $path $args]
if {[Widget::hasChanged $path -ipad ipad]} {
}
return $res
}
# ----------------------------------------------------------------------------
# Command PanelFrame::cget
# ----------------------------------------------------------------------------
proc PanelFrame::cget { path option } {
return [Widget::cget $path $option]
}
# ----------------------------------------------------------------------------
# Command PanelFrame::getframe
# ----------------------------------------------------------------------------
proc PanelFrame::getframe { path } {
return $path.frame
}
# ------------------------------------------------------------------------
# Command PanelFrame::add
# ------------------------------------------------------------------------
proc PanelFrame::add {path w args} {
variable _widget
array set opts [list \
-side right \
-fill none \
-expand 0 \
-pad [Widget::cget $path -ipad] \
]
foreach {key val} $args {
if {[info exists opts($key)]} {
set opts($key) $val
} else {
set msg "unknown option \"$key\", must be one of: "
append msg [join [lsort [array names opts]] {, }]
return -code error $msg
}
}
foreach {ipadx ipady} [_padval $opts(-pad)] { break }
set f $path.title
lappend _widget($path,items) $w
pack $w -in $f -padx $ipadx -pady $ipady -side $opts(-side) \
-fill $opts(-fill) -expand $opts(-expand)
return $w
}
# ------------------------------------------------------------------------
# Command PanelFrame::remove
# ------------------------------------------------------------------------
proc PanelFrame::remove {path args} {
variable _widget
set destroy [string equal [lindex $args 0] "-destroy"]
if {$destroy} {
set args [lrange $args 1 end]
}
foreach w $args {
set idx [lsearch -exact $_widget($path,items) $w]
if {$idx == -1} {
# ignore unknown
continue
}
if {$destroy} {
destroy $w
} elseif {[winfo exists $w]} {
pack forget $w
}
set _widget($path,items) [lreplace $_widget($path,items) $idx $idx]
}
}
# ------------------------------------------------------------------------
# Command PanelFrame::delete
# ------------------------------------------------------------------------
proc PanelFrame::delete {path args} {
return [PanelFrame::remove $path -destroy $args]
}
# ------------------------------------------------------------------------
# Command PanelFrame::items
# ------------------------------------------------------------------------
proc PanelFrame::items {path} {
variable _widget
return $_widget($path,items)
}
proc PanelFrame::_padval {padval} {
set len [llength $padval]
foreach {a b} $padval { break }
if {$len == 0 || $len > 2} {
return -code error \
"invalid pad value \"$padval\", must be 1 or 2 pixel values"
} elseif {$len == 1} {
return [list $a $a]
} elseif {$len == 2} {
return $padval
}
}
