[3330] | 1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
---|
[11] | 2 | # ---------------------------------------------------------------------- |
---|
| 3 | # COMPONENT: GroupEntry - widget containing a group of controls |
---|
| 4 | # |
---|
| 5 | # This widget represents a <group> entry on a control panel. |
---|
| 6 | # It contains a series of other controls. Sort of a glorified |
---|
| 7 | # frame widget. |
---|
| 8 | # ====================================================================== |
---|
| 9 | # AUTHOR: Michael McLennan, Purdue University |
---|
[3177] | 10 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
[115] | 11 | # |
---|
| 12 | # See the file "license.terms" for information on usage and |
---|
| 13 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
[11] | 14 | # ====================================================================== |
---|
| 15 | package require Itk |
---|
| 16 | |
---|
[437] | 17 | option add *GroupEntry.headingBackground #b5b5b5 widgetDefault |
---|
[26] | 18 | option add *GroupEntry.headingForeground white widgetDefault |
---|
[676] | 19 | option add *GroupEntry.font -*-helvetica-medium-r-normal-*-12-* widgetDefault |
---|
[26] | 20 | |
---|
[11] | 21 | itcl::class Rappture::GroupEntry { |
---|
| 22 | inherit itk::Widget |
---|
| 23 | |
---|
[26] | 24 | itk_option define -heading heading Heading 1 |
---|
[437] | 25 | itk_option define -state state State "normal" |
---|
[26] | 26 | |
---|
[22] | 27 | constructor {owner path args} { # defined below } |
---|
[11] | 28 | |
---|
| 29 | public method value {args} |
---|
| 30 | |
---|
| 31 | public method label {} |
---|
| 32 | public method tooltip {} |
---|
| 33 | |
---|
[26] | 34 | protected method _fixheading {} |
---|
| 35 | |
---|
[22] | 36 | private variable _owner "" ;# thing managing this control |
---|
[11] | 37 | private variable _path "" ;# path in XML to this number |
---|
| 38 | } |
---|
| 39 | |
---|
| 40 | itk::usual GroupEntry { |
---|
| 41 | keep -cursor -font |
---|
| 42 | keep -foreground -background |
---|
| 43 | keep -textbackground |
---|
| 44 | keep -selectbackground -selectforeground -selectborderwidth |
---|
| 45 | } |
---|
| 46 | |
---|
| 47 | # ---------------------------------------------------------------------- |
---|
| 48 | # CONSTRUCTOR |
---|
| 49 | # ---------------------------------------------------------------------- |
---|
[22] | 50 | itcl::body Rappture::GroupEntry::constructor {owner path args} { |
---|
| 51 | if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} { |
---|
[1929] | 52 | error "bad object \"$owner\": should be Rappture::ControlOwner" |
---|
[11] | 53 | } |
---|
[22] | 54 | set _owner $owner |
---|
[11] | 55 | set _path $path |
---|
| 56 | |
---|
[26] | 57 | itk_component add heading { |
---|
[1929] | 58 | ::label $itk_interior.heading -anchor w |
---|
[26] | 59 | } { |
---|
[1929] | 60 | usual |
---|
| 61 | rename -background -headingbackground headingBackground Background |
---|
| 62 | rename -foreground -headingforeground headingForeground Foreground |
---|
[26] | 63 | } |
---|
| 64 | |
---|
| 65 | $itk_component(heading) configure \ |
---|
[3647] | 66 | -text [string trim [$_owner xml get $_path.about.label]] |
---|
[26] | 67 | Rappture::Tooltip::for $itk_component(heading) \ |
---|
[3647] | 68 | [string trim [$_owner xml get $_path.about.description]] |
---|
[26] | 69 | |
---|
| 70 | itk_component add outline { |
---|
[1929] | 71 | frame $itk_interior.outline -borderwidth 1 |
---|
[26] | 72 | } { |
---|
[1929] | 73 | usual |
---|
| 74 | ignore -borderwidth |
---|
| 75 | rename -background -headingbackground headingBackground Background |
---|
[26] | 76 | } |
---|
| 77 | pack $itk_component(outline) -expand yes -fill both |
---|
| 78 | |
---|
| 79 | itk_component add inner { |
---|
[1929] | 80 | frame $itk_component(outline).inner -borderwidth 3 |
---|
[26] | 81 | } { |
---|
[1929] | 82 | usual |
---|
| 83 | ignore -borderwidth |
---|
[26] | 84 | } |
---|
| 85 | pack $itk_component(inner) -expand yes -fill both |
---|
| 86 | |
---|
[11] | 87 | eval itk_initialize $args |
---|
| 88 | } |
---|
| 89 | |
---|
| 90 | # ---------------------------------------------------------------------- |
---|
| 91 | # USAGE: value ?-check? ?<newval>? |
---|
| 92 | # |
---|
| 93 | # Clients use this to query/set the value for this widget. With |
---|
| 94 | # no args, it returns the current value for the widget. If the |
---|
| 95 | # <newval> is specified, it sets the value of the widget and |
---|
| 96 | # sends a <<Value>> event. If the -check flag is included, the |
---|
| 97 | # new value is not actually applied, but just checked for correctness. |
---|
| 98 | # ---------------------------------------------------------------------- |
---|
| 99 | itcl::body Rappture::GroupEntry::value {args} { |
---|
| 100 | # groups have no value |
---|
| 101 | return "" |
---|
| 102 | } |
---|
| 103 | |
---|
| 104 | # ---------------------------------------------------------------------- |
---|
| 105 | # USAGE: label |
---|
| 106 | # |
---|
| 107 | # Clients use this to query the label associated with this widget. |
---|
| 108 | # Reaches into the XML and pulls out the appropriate label string. |
---|
| 109 | # ---------------------------------------------------------------------- |
---|
| 110 | itcl::body Rappture::GroupEntry::label {} { |
---|
[26] | 111 | return "" ;# manage the label inside this group |
---|
[11] | 112 | } |
---|
| 113 | |
---|
| 114 | # ---------------------------------------------------------------------- |
---|
| 115 | # USAGE: tooltip |
---|
| 116 | # |
---|
| 117 | # Clients use this to query the tooltip associated with this widget. |
---|
| 118 | # Reaches into the XML and pulls out the appropriate description |
---|
| 119 | # string. Returns the string that should be used with the |
---|
| 120 | # Rappture::Tooltip facility. |
---|
| 121 | # ---------------------------------------------------------------------- |
---|
| 122 | itcl::body Rappture::GroupEntry::tooltip {} { |
---|
[3647] | 123 | return [string trim [$_owner xml get $_path.about.description]] |
---|
[11] | 124 | } |
---|
[26] | 125 | |
---|
| 126 | # ---------------------------------------------------------------------- |
---|
| 127 | # CONFIGURATION OPTION: -heading |
---|
| 128 | # Turns the heading bar at the top of this group on/off. |
---|
| 129 | # ---------------------------------------------------------------------- |
---|
| 130 | itcl::configbody Rappture::GroupEntry::heading { |
---|
| 131 | if {![string is boolean -strict $itk_option(-heading)]} { |
---|
[1929] | 132 | error "bad value \"$itk_option(-heading)\": should be boolean" |
---|
[26] | 133 | } |
---|
| 134 | |
---|
| 135 | set str [$itk_component(heading) cget -text] |
---|
| 136 | if {$itk_option(-heading) && "" != $str} { |
---|
[1929] | 137 | eval pack forget [pack slaves $itk_component(hull)] |
---|
| 138 | pack $itk_component(heading) -side top -fill x |
---|
| 139 | pack $itk_component(outline) -expand yes -fill both |
---|
| 140 | $itk_component(outline) configure -borderwidth 1 |
---|
| 141 | $itk_component(inner) configure -borderwidth 3 |
---|
[26] | 142 | } else { |
---|
[1929] | 143 | pack forget $itk_component(heading) |
---|
| 144 | $itk_component(outline) configure -borderwidth 0 |
---|
| 145 | $itk_component(inner) configure -borderwidth 0 |
---|
[26] | 146 | } |
---|
| 147 | } |
---|
[437] | 148 | |
---|
| 149 | # ---------------------------------------------------------------------- |
---|
| 150 | # CONFIGURATION OPTION: -state |
---|
| 151 | # ---------------------------------------------------------------------- |
---|
| 152 | itcl::configbody Rappture::GroupEntry::state { |
---|
| 153 | set valid {normal disabled} |
---|
| 154 | if {[lsearch -exact $valid $itk_option(-state)] < 0} { |
---|
[1929] | 155 | error "bad value \"$itk_option(-state)\": should be [join $valid {, }]" |
---|
[437] | 156 | } |
---|
| 157 | } |
---|