# ---------------------------------------------------------------------------- # 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 [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 } }