source: branches/r9/gui/scripts/groupentry.tcl @ 4988

Last change on this file since 4988 was 3647, checked in by gah, 11 years ago

add string trim to inputs

File size: 5.7 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
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
10#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
11#
12#  See the file "license.terms" for information on usage and
13#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14# ======================================================================
15package require Itk
16
17option add *GroupEntry.headingBackground #b5b5b5 widgetDefault
18option add *GroupEntry.headingForeground white widgetDefault
19option add *GroupEntry.font -*-helvetica-medium-r-normal-*-12-* widgetDefault
20
21itcl::class Rappture::GroupEntry {
22    inherit itk::Widget
23
24    itk_option define -heading heading Heading 1
25    itk_option define -state state State "normal"
26
27    constructor {owner path args} { # defined below }
28
29    public method value {args}
30
31    public method label {}
32    public method tooltip {}
33
34    protected method _fixheading {}
35
36    private variable _owner ""    ;# thing managing this control
37    private variable _path ""     ;# path in XML to this number
38}
39
40itk::usual GroupEntry {
41    keep -cursor -font
42    keep -foreground -background
43    keep -textbackground
44    keep -selectbackground -selectforeground -selectborderwidth
45}
46
47# ----------------------------------------------------------------------
48# CONSTRUCTOR
49# ----------------------------------------------------------------------
50itcl::body Rappture::GroupEntry::constructor {owner path args} {
51    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
52        error "bad object \"$owner\": should be Rappture::ControlOwner"
53    }
54    set _owner $owner
55    set _path $path
56
57    itk_component add heading {
58        ::label $itk_interior.heading -anchor w
59    } {
60        usual
61        rename -background -headingbackground headingBackground Background
62        rename -foreground -headingforeground headingForeground Foreground
63    }
64
65    $itk_component(heading) configure \
66        -text [string trim [$_owner xml get $_path.about.label]]
67    Rappture::Tooltip::for $itk_component(heading) \
68        [string trim [$_owner xml get $_path.about.description]]
69
70    itk_component add outline {
71        frame $itk_interior.outline -borderwidth 1
72    } {
73        usual
74        ignore -borderwidth
75        rename -background -headingbackground headingBackground Background
76    }
77    pack $itk_component(outline) -expand yes -fill both
78
79    itk_component add inner {
80        frame $itk_component(outline).inner -borderwidth 3
81    } {
82        usual
83        ignore -borderwidth
84    }
85    pack $itk_component(inner) -expand yes -fill both
86
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# ----------------------------------------------------------------------
99itcl::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# ----------------------------------------------------------------------
110itcl::body Rappture::GroupEntry::label {} {
111    return ""  ;# manage the label inside this group
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# ----------------------------------------------------------------------
122itcl::body Rappture::GroupEntry::tooltip {} {
123    return [string trim [$_owner xml get $_path.about.description]]
124}
125
126# ----------------------------------------------------------------------
127# CONFIGURATION OPTION: -heading
128# Turns the heading bar at the top of this group on/off.
129# ----------------------------------------------------------------------
130itcl::configbody Rappture::GroupEntry::heading {
131    if {![string is boolean -strict $itk_option(-heading)]} {
132        error "bad value \"$itk_option(-heading)\": should be boolean"
133    }
134
135    set str [$itk_component(heading) cget -text]
136    if {$itk_option(-heading) && "" != $str} {
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
142    } else {
143        pack forget $itk_component(heading)
144        $itk_component(outline) configure -borderwidth 0
145        $itk_component(inner) configure -borderwidth 0
146    }
147}
148
149# ----------------------------------------------------------------------
150# CONFIGURATION OPTION: -state
151# ----------------------------------------------------------------------
152itcl::configbody Rappture::GroupEntry::state {
153    set valid {normal disabled}
154    if {[lsearch -exact $valid $itk_option(-state)] < 0} {
155        error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
156    }
157}
Note: See TracBrowser for help on using the repository browser.