source: branches/1.3/gui/scripts/controls.tcl @ 4069

Last change on this file since 4069 was 4069, checked in by gah, 9 years ago

don't turn off propagation for groups

File size: 33.5 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: controls - a container for various Rappture controls
4#
5#  This widget is a smart frame acting as a container for controls.
6#  Controls are added to this panel, and the panel itself decides
7#  how to arrange them given available space.
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
16package require BLT
17
18option add *Controls.padding 4 widgetDefault
19option add *Controls.labelFont \
20    -*-helvetica-medium-r-normal-*-12-* widgetDefault
21
22itcl::class Rappture::Controls {
23    inherit itk::Widget
24
25    itk_option define -layout layout Layout ""
26    itk_option define -padding padding Padding 0
27
28    constructor {owner args} { # defined below }
29    destructor { # defined below }
30
31    public method insert {pos path}
32    public method delete {first {last ""}}
33    public method index {name}
34    public method control {args}
35    public method refresh {}
36
37    protected method _layout {}
38    protected method _monitor {name state}
39    protected method _controlChanged {name}
40    protected method _controlValue {path {units ""}}
41    protected method _formatLabel {str}
42    protected method _changeTabs {{why -program}}
43    protected method _resize {}
44
45    private variable _owner ""       ;# controls belong to this owner
46    private variable _tabs ""        ;# optional tabset for groups
47    private variable _frame ""       ;# pack controls into this frame
48    private variable _counter 0      ;# counter for control names
49    private variable _dispatcher ""  ;# dispatcher for !events
50    private variable _controls ""    ;# list of known controls
51    private variable _showing ""     ;# list of enabled (showing) controls
52    private variable _name2info      ;# maps control name => info
53    private variable _scheme ""      ;# layout scheme (tabs/vert/horz/sentence)
54    private variable _sentenceparts  ;# info for layout scheme "sentence:"
55}
56                                                                               
57itk::usual Controls {
58}
59
60# ----------------------------------------------------------------------
61# CONSTRUCTOR
62# ----------------------------------------------------------------------
63itcl::body Rappture::Controls::constructor {owner args} {
64    Rappture::dispatcher _dispatcher
65    $_dispatcher register !layout
66    $_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
67    $_dispatcher register !resize
68    $_dispatcher dispatch $this !resize "[itcl::code $this _resize]; list"
69
70    set _owner $owner
71
72    Rappture::Scroller $itk_interior.sc -xscrollmode none -yscrollmode auto
73    pack $itk_interior.sc -expand yes -fill both
74    set f [$itk_interior.sc contents frame]
75
76    set _tabs [blt::tabset $f.tabs -borderwidth 0 -relief flat \
77        -side top -tearoff 0 -samewidth 0 -highlightthickness 0 \
78        -selectbackground $itk_option(-background) \
79        -selectcommand [itcl::code $this _changeTabs -user]]
80    pack $_tabs -expand yes -fill both
81
82    set _frame [frame $_tabs.inner]
83    pack $_frame -expand yes -fill both
84
85    #
86    # Put this frame in whenever the control frame is empty.
87    # It forces the size to contract back now when controls are deleted.
88    #
89    frame $_frame.empty -width 1 -height 1
90
91    #
92    # Set up a binding that all inserted widgets will use so that
93    # we can monitor their size changes.
94    #
95    bind Controls-$this <Configure> \
96        [list $_dispatcher event -idle !resize]
97
98    eval itk_initialize $args
99}
100
101# ----------------------------------------------------------------------
102# DESTRUCTOR
103# ----------------------------------------------------------------------
104itcl::body Rappture::Controls::destructor {} {
105    delete 0 end
106}
107
108# ----------------------------------------------------------------------
109# USAGE: insert <pos> <path>
110#
111# Clients use this to insert a control into this panel.  The control
112# is inserted into the list at position <pos>, which can be an integer
113# starting from 0 or the keyword "end".  Information about the control
114# is taken from the specified <path>.
115#
116# Returns a name that can be used to identify the control in other
117# methods.
118# ----------------------------------------------------------------------
119itcl::body Rappture::Controls::insert {pos path} {
120    if {$pos ne "end" && ![string is integer $pos]} {
121        set pos [index $pos]
122    }
123
124    incr _counter
125    set name "control$_counter"
126    set path [$_owner xml element -as path $path]
127
128    set _name2info($name-path) $path
129    set _name2info($name-id) [$_owner xml element -as id $path]
130    set _name2info($name-label) ""
131    set _name2info($name-type) ""
132    set _name2info($name-value) [set w $_frame.v$name]
133    set _name2info($name-enable) "yes"
134    set _name2info($name-disablestyle) "greyout"
135
136    set type [$_owner xml element -as type $path]
137    set _name2info($name-type) $type
138    switch -- $type {
139        choice {
140            Rappture::ChoiceEntry $w $_owner $path
141            bind $w <<Value>> [itcl::code $this _controlChanged $name]
142        }
143        group {
144            Rappture::GroupEntry $w $_owner $path
145        }
146        loader {
147            Rappture::Loader $w $_owner $path -tool [$_owner tool]
148            bind $w <<Value>> [itcl::code $this _controlChanged $name]
149        }
150        number {
151            Rappture::NumberEntry $w $_owner $path
152            bind $w <<Value>> [itcl::code $this _controlChanged $name]
153        }
154        integer {
155            Rappture::IntegerEntry $w $_owner $path
156            bind $w <<Value>> [itcl::code $this _controlChanged $name]
157        }
158        boolean {
159            Rappture::BooleanEntry $w $_owner $path
160            bind $w <<Value>> [itcl::code $this _controlChanged $name]
161        }
162        string {
163            Rappture::TextEntry $w $_owner $path
164            bind $w <<Final>> [itcl::code $this _controlChanged $name]
165        }
166        drawing {
167            Rappture::DrawingEntry $w $_owner $path
168        }
169        image {
170            Rappture::ImageEntry $w $_owner $path
171        }
172        control {
173            set label [string trim [$_owner xml get $path.label]]
174            if {"" == $label} {
175                set label "Simulate"
176            }
177            set service [string trim [$_owner xml get $path.service]]
178            button $w -text $label -command [list $service run]
179        }
180        separator {
181            frame $w -class Separator -height 10
182        }
183        note {
184            Rappture::Note $w $_owner $path
185        }
186        periodicelement {
187            Rappture::PeriodicElementEntry $w $_owner $path
188            bind $w <<Value>> [itcl::code $this _controlChanged $name]
189        }
190        default {
191            error "don't know how to add control type \"$type\""
192        }
193    }
194
195    #
196    # If this element has an <enable> expression, then register
197    # its controlling widget here.
198    #
199    set disablestyle [string trim [$_owner xml get $path.about.disablestyle]]
200    if { $disablestyle != "" } {
201        set _name2info($name-disablestyle) $disablestyle
202    }
203    #
204    # If this element has an <enable> expression, then register
205    # its controlling widget here.
206    #
207    set enable [string trim [$_owner xml get $path.about.enable]]
208    if {"" == $enable} {
209        set enable yes
210    }
211    if {![string is boolean $enable]} {
212        set re {([a-zA-Z_]+[0-9]*|\([^\(\)]+\)|[a-zA-Z_]+[0-9]*\([^\(\)]+\))(\.([a-zA-Z_]+[0-9]*|\([^\(\)]+\)|[a-zA-Z_]+[0-9]*\([^\(\)]+\)))*(:[-a-zA-Z0-9/]+)?}
213        set rest $enable
214        set enable ""
215        set deps ""
216        while {1} {
217            if {[regexp -indices $re $rest match]} {
218                foreach {s0 s1} $match break
219
220                if {[string index $rest [expr {$s0-1}]] == "\""} {
221                    # string in ""'s? then leave it alone
222                    append enable [string range $rest 0 [expr {$s0-1}]]
223                    set rest [string range $rest $s0 end]
224                    if {[regexp -indices {[^\"]+\"} $rest match]} {
225                        foreach {s0 s1} $match break
226                        append enable [string range $rest $s0 $s1]
227                        set rest [string range $rest [expr {$s1+1}] end]
228                    } else {
229                        puts stderr "WARNING: mismatched quote in enable condition for $path"
230                        puts stderr "   expr: [string trim [$_owner xml get $path.about.enable]]"
231                        set rest ""
232                    }
233                } else {
234                    #
235                    # This is a symbol which should be substituted
236                    # it can be either:
237                    #   input.foo.bar
238                    #   input.foo.bar:units
239                    #
240                    set cpath [string range $rest $s0 $s1]
241                    set parts [split $cpath :]
242                    set ccpath [lindex $parts 0]
243                    set units [lindex $parts 1]
244
245                    # make sure we have the standard path notation
246                    set stdpath [$_owner regularize $ccpath]
247                    if {"" == $stdpath} {
248                        puts stderr "WARNING: don't recognize parameter $cpath in <enable> expression for $path.  This may be buried in a structure that is not yet loaded."
249                        set stdpath $ccpath
250                    }
251                    # substitute [_controlValue ...] call in place of path
252                    append enable [string range $rest 0 [expr {$s0-1}]]
253                    append enable [format {[_controlValue %s %s]} $stdpath $units]
254                    lappend deps $stdpath
255                    set rest [string range $rest [expr {$s1+1}] end]
256                }
257            } else {
258                append enable $rest
259                break
260            }
261        }
262
263        foreach cpath $deps {
264            $_owner dependenciesfor $cpath $path
265        }
266    }
267    set _name2info($name-enable) $enable
268    $_owner widgetfor $path $w
269
270    if {[lsearch {control group drawing separator note} $type] < 0} {
271        # make a label for this control
272        set label [$w label]
273        if {$label ne ""} {
274            set _name2info($name-label) $_frame.l$name
275            set font [option get $itk_component(hull) labelFont Font]
276            label $_name2info($name-label) -text [_formatLabel $label] \
277                -font $font
278        }
279
280        # register the tooltip for this control
281        set tip [$w tooltip]
282        if {$tip ne ""} {
283            Rappture::Tooltip::for $w $tip -log $path
284
285            # add the tooltip to the label too, if there is one
286            if {$_name2info($name-label) ne ""} {
287                Rappture::Tooltip::for $_name2info($name-label) $tip -log $path
288            }
289        }
290    }
291
292    # insert the new control onto the known list
293    set _controls [linsert $_controls $pos $name]
294    _monitor $name on
295
296    # now that we have a new control, we should fix the layout
297    $_dispatcher event -idle !layout
298    _controlChanged $name
299
300    return $name
301}
302
303# ----------------------------------------------------------------------
304# USAGE: delete <first> ?<last>?
305#
306# Clients use this to delete one or more controls from this widget.
307# The <first> and <last> represent the integer index of the desired
308# control.  You can use the "index" method to convert a control name to
309# its integer index.  If only <first> is specified, then that one
310# control is deleted.  If <last> is specified, then all controls in the
311# range <first> to <last> are deleted.
312# ----------------------------------------------------------------------
313itcl::body Rappture::Controls::delete {first {last ""}} {
314    if {$last == ""} {
315        set last $first
316    }
317    if {![string is integer $first]} {
318        set first [index $first]
319    }
320    if {![string is integer $last]} {
321        set last [index $last]
322    }
323
324    foreach name [lrange $_controls $first $last] {
325        _monitor $name off
326
327        if {"" != $_name2info($name-label)} {
328            destroy $_name2info($name-label)
329        }
330        if {"" != $_name2info($name-value)} {
331            destroy $_name2info($name-value)
332        }
333        $_owner widgetfor $_name2info($name-path) ""
334        array unset _name2info $name-*
335    }
336    set _controls [lreplace $_controls $first $last]
337
338    $_dispatcher event -idle !layout
339}
340
341# ----------------------------------------------------------------------
342# USAGE: index <name>|<path>|@n|end
343#
344# Clients use this to convert a control <name> into its corresponding
345# integer index.  Returns an error if the <name> is not recognized.
346# ----------------------------------------------------------------------
347itcl::body Rappture::Controls::index {val} {
348    set i [lsearch $_controls $val]
349    if {$i >= 0} {
350        return $i
351    }
352    if {[regexp {^@([0-9]+)$} $val match i]} {
353        return $i
354    }
355    if {$val eq "end"} {
356        return [expr {[llength $_controls]-1}]
357    }
358
359    # treat as a path name and search for this path
360    foreach name $_controls {
361        if {$_name2info($name-path) eq $val} {
362            set i [lsearch $_controls $name]
363            if {$i >= 0} {
364                return $i
365            }
366        }
367    }
368
369    error "bad control name \"$name\": should be @int or \"end\" or path name or one of [join [lsort $_controls] {, }]"
370}
371
372# ----------------------------------------------------------------------
373# USAGE: control ?-label|-value|-path|-enable? ?<name>|@n?
374#
375# Clients use this to get information about controls.  With no args, it
376# returns a list of all control names.  Otherwise, it returns the frame
377# associated with a control name.  The -label option requests the label
378# widget instead of the value widget.  The -path option requests the
379# path within the XML that the control affects.  The -enable option
380# requests the enabling condition for this control.
381# ----------------------------------------------------------------------
382itcl::body Rappture::Controls::control {args} {
383    if {[llength $args] == 0} {
384        return $_controls
385    }
386    Rappture::getopts args params {
387        flag switch -value default
388        flag switch -label
389        flag switch -path
390        flag switch -enable
391        flag switch -disablestyle
392    }
393    if {[llength $args] == 0} {
394        error "missing control name"
395    }
396    set i [index [lindex $args 0]]
397    set name [lindex $_controls $i]
398
399    set opt $params(switch)
400    return $_name2info($name$opt)
401}
402
403# ----------------------------------------------------------------------
404# USAGE: refresh
405#
406# Clients use this to refresh the layout of the control panel
407# whenever a widget within the panel changes visibility state.
408# ----------------------------------------------------------------------
409itcl::body Rappture::Controls::refresh {} {
410    $_dispatcher event -idle !layout
411}
412
413# ----------------------------------------------------------------------
414# USAGE: _layout
415#
416# Used internally to fix the layout of controls whenever controls
417# are added or deleted, or when the control arrangement changes.
418# There are a lot of heuristics here trying to achieve a "good"
419# arrangement of controls.
420# ----------------------------------------------------------------------
421itcl::body Rappture::Controls::_layout {} {
422    #
423    # Clear any existing layout
424    #
425    foreach {rmax cmax} [grid size $_frame] break
426    for {set r 0} {$r < $rmax} {incr r} {
427        grid rowconfigure $_frame $r -weight 0 -minsize 0
428    }
429    grid rowconfigure $_frame 99 -weight 0
430   
431    for {set c 0} {$c < $cmax} {incr c} {
432        grid columnconfigure $_frame $c -weight 0 -minsize 0
433    }
434   
435    foreach name $_controls {
436        foreach elem {label value} {
437            set w $_name2info($name-$elem)
438            if {$w ne "" && [winfo exists $w]} {
439                grid forget $w
440            }
441        }
442    }
443    grid forget $_frame.empty
444   
445    if {[$_tabs size] > 0} {
446        $_tabs delete 0 end
447    }
448   
449    #
450    # Decide which widgets should be shown and which should be hidden.
451    #
452    set hidden ""
453    set showing ""
454    foreach name $_controls {
455        set show 1
456        set cond $_name2info($name-enable)
457        if {[string is boolean $cond] && !$cond} {
458            # hard-coded "off" -- ignore completely
459           
460            # When the "enable" of a control is hardcoded "off", "0", etc., it
461            # means to hide the control. This is used by bandstrlab to add
462            # invisible parameters to a structure.  The value of the parameter
463            # is used by other widgets with enable statements.
464           
465            # The proper method for doing this is to add a
466            #   <disablestyle>hide<disablestyle>
467            # tag to the about section of the control. 
468           
469        } elseif {[catch {expr $cond} show] == 0} {
470            set type $_name2info($name-type)
471            set disablestyle $_name2info($name-disablestyle)
472            set lwidget $_name2info($name-label)
473            set vwidget $_name2info($name-value)
474            if {[lsearch -exact {group image structure} $type] >= 0 ||
475                $disablestyle == "hide" } {
476                if {$show ne "" && $show} {
477                    lappend showing $name
478                } else {
479                    lappend hidden $name
480                }
481            } else {
482                # show other objects, but enable/disable them
483                lappend showing $name
484                if {$show ne "" && $show} {
485                    catch {$vwidget configure -state normal}
486                    if {[winfo exists $lwidget]} {
487                        $lwidget configure -foreground \
488                            [lindex [$lwidget configure -foreground] 3]
489                    }
490                } else {
491                    catch {$vwidget configure -state disabled}
492                    if {[winfo exists $lwidget]} {
493                        $lwidget configure -foreground gray
494                    }
495                }
496            }
497        } else {
498            bgerror "Error in <enable> expression for \"$_name2info($name-path)\":\n  $show"
499        }
500    }
501   
502    # store the showing tabs in the object so it can be used in _changeTabs
503    set _showing $showing
504   
505    #
506    # Decide on a layout scheme:
507    #   default ...... tabs for groups of groups; vertical otherwise
508    #   tabs ......... tabbed notebook
509    #   vertical ..... "label: value" down in rows
510    #   horizontal ... "label: value" across columns
511    #   sentence ..... text with embedded widgets
512    #
513    set _scheme $itk_option(-layout)
514    if {$_scheme eq "" || $_scheme eq "tabs"} {
515        if {[llength $showing] < 2} {
516            set _scheme "vertical"
517        } else {
518            set _scheme "tabs"
519            foreach name $showing {
520                set w $_name2info($name-value)
521                if {[winfo class $w] ne "GroupEntry"} {
522                    # something other than a group? then fall back on vertical
523                    set _scheme "vertical"
524                    break
525                }
526            }
527        }
528    }
529   
530    # if the layout is "sentence:..." then create new parts
531    if {[string match {sentence:*} $itk_option(-layout)]
532        && [array size _sentenceparts] == 0} {
533        set n 0
534        set font [option get $itk_component(hull) labelFont Font]
535        set str [string range $itk_option(-layout) 9 end]
536        while {[regexp -indices {\$\{([a-zA-Z0-9_]+)\}} $str match name]} {
537            foreach {s0 s1} $name break
538            set name [string range $str $s0 $s1]
539           
540            # create a label for the string before the substitution
541            foreach {s0 s1} $match break
542            set prefix [string trim [string range $str 0 [expr {$s0-1}]]]
543            if {$prefix ne ""} {
544                set lname $_frame.sentence[incr n]
545                label $lname -text $prefix -font $font
546                lappend _sentenceparts(all) $lname
547                lappend _sentenceparts(fragments) $lname
548            }
549           
550            # add the widget for the substitution part
551            set found ""
552            foreach c $_controls {
553                if {$_name2info($c-id) eq $name} {
554                    set found $c
555                    break
556                }
557            }
558            if {$found ne ""} {
559                lappend _sentenceparts(all) $_name2info($found-value)
560            } else {
561                puts stderr "WARNING: name \"$name\" in sentence layout \"$itk_option(-layout)\" not recognized"
562            }
563           
564            set str [string range $str [expr {$s1+1}] end]
565        }
566       
567        # create a label for any trailing string
568        set str [string trim $str]
569        if {$str ne ""} {
570            set lname $_frame.sentence[incr n]
571            label $lname -text $str -font $font
572            lappend _sentenceparts(all) $lname
573            lappend _sentenceparts(fragments) $lname
574        }
575    }
576   
577    switch -glob -- $_scheme {
578        tabs {
579            #
580            # SCHEME: tabs
581            # put a series of groups into a tabbed notebook
582            #
583           
584            # stop covering up the tabset and put the _frame inside the tabs
585            pack forget $_frame
586            $_tabs configure -width 0 -height 0
587           
588            set gn 1
589            foreach name $showing {
590                set wv $_name2info($name-value)
591                $wv configure -heading no
592                set label [$wv component heading cget -text]
593                if {"" == $label} {
594                    set label "Group #$gn"
595                }
596                set _name2info($name-label) $label
597                $_tabs insert end $name -text $label \
598                    -activebackground $itk_option(-background) \
599                    -window $_frame -fill both
600                incr gn
601            }
602           
603            # compute the overall size
604            # BE CAREFUL: do this after setting "-heading no" above
605            $_dispatcher event -now !resize
606           
607            grid columnconfigure $_frame 0 -weight 1
608            grid rowconfigure $_frame 0 -weight 1
609           
610            $_tabs select 0; _changeTabs
611        }
612       
613        vertical {
614            #
615            # SCHEME: vertical
616            # simple "Label: Value" layout
617            #
618            if {[$_tabs size] > 0} {
619                $_tabs delete 0 end
620            }
621            pack $_frame -expand yes -fill both
622            $_tabs configure -width [winfo reqwidth $_frame] \
623                -height [winfo reqheight $_frame]
624           
625            set expand 0  ;# most controls float to top
626            set row 0
627            foreach name $showing {
628                set wl $_name2info($name-label)
629                if {$wl != "" && [winfo exists $wl]} {
630                    grid $wl -row $row -column 0 -sticky e
631                }
632               
633                set wv $_name2info($name-value)
634                if {$wv ne "" && [winfo exists $wv]} {
635                    if {$wl != ""} {
636                        grid $wv -row $row -column 1 -sticky ew
637                    } else {
638                        grid $wv -row $row -column 0 -columnspan 2 -sticky ew
639                    }
640                   
641                    grid rowconfigure $_frame $row -weight 0
642                   
643                    switch -- [winfo class $wv] {
644                        TextEntry {
645                            if {[regexp {[0-9]+x[0-9]+} [$wv size]]} {
646                                grid $wl -sticky ne -pady 4
647                                grid $wv -sticky nsew
648                                grid rowconfigure $_frame $row -weight 1
649                                grid columnconfigure $_frame 1 -weight 1
650                                set expand 1
651                            }
652                        }
653                        GroupEntry {
654                            $wv configure -heading yes
655                           
656                            #
657                            # Scan through all children in this group
658                            # and see if any demand more space.  If the
659                            # group contains a structure or a note, then
660                            # make sure that the group itself is set to
661                            # expand/fill.
662                            #
663                            set queue [winfo children $wv]
664                            set expandgroup 0
665                            while {[llength $queue] > 0} {
666                                set w [lindex $queue 0]
667                                set queue [lrange $queue 1 end]
668                                set c [winfo class $w]
669                                if {[lsearch {DeviceEditor Note} $c] >= 0} {
670                                    set expandgroup 1
671                                    break
672                                }
673                                eval lappend queue [winfo children $w]
674                            }
675                            if {$expandgroup} {
676                                set expand 1
677                                grid $wv -sticky nsew
678                                grid rowconfigure $_frame $row -weight 1
679                            }
680                        }
681                        Note {
682                            grid $wv -sticky nsew
683                            grid rowconfigure $_frame $row -weight 1
684                            set expand 1
685                        }
686                    }
687                    grid columnconfigure $_frame 1 -weight 1
688                }
689               
690                incr row
691                grid rowconfigure $_frame $row -minsize $itk_option(-padding)
692                incr row
693            }
694            grid $_frame.empty -row $row
695           
696            #
697            # If there are any hidden items, then make the bottom of
698            # this form fill up any extra space, so the form floats
699            # to the top.  Otherwise, it will jitter around as the
700            # hidden items come and go.
701            #
702            if {[llength $hidden] > 0 && !$expand} {
703                grid rowconfigure $_frame 99 -weight 1
704            } else {
705                grid rowconfigure $_frame 99 -weight 0
706            }
707        }
708       
709        horizontal {
710            #
711            # SCHEME: horizontal
712            # lay out left to right
713            #
714            if {[$_tabs size] > 0} {
715                $_tabs delete 0 end
716            }
717            pack $_frame -expand yes -fill both
718            $_tabs configure -width [winfo reqwidth $_frame] \
719                -height [winfo reqheight $_frame]
720           
721            set col 0
722            set pad [expr {$itk_option(-padding)/2}]
723            foreach name $showing {
724                set wl $_name2info($name-label)
725                if {$wl != "" && [winfo exists $wl]} {
726                    grid $wl -row 0 -column $col -sticky e -padx $pad
727                    incr col
728                }
729               
730                set wv $_name2info($name-value)
731                if {$wv != "" && [winfo exists $wv]} {
732                    grid $wv -row 0 -column $col -sticky ew -padx $pad
733                    grid columnconfigure $_frame $col -weight 0
734                    incr col
735                }
736            }
737        }
738       
739        sentence:* {
740            #
741            # SCHEME: sentence
742            # lay out left to right with sentence parts: "( [x] , [y] )"
743            #
744            if {[$_tabs size] > 0} {
745                $_tabs delete 0 end
746            }
747            pack $_frame -expand yes -fill both
748            $_tabs configure -width [winfo reqwidth $_frame] \
749                -height [winfo reqheight $_frame]
750           
751            set col 0
752            set pad [expr {$itk_option(-padding)/2}]
753            foreach widget $_sentenceparts(all) {
754                grid $widget -row 0 -column $col -padx $pad
755                incr col
756            }
757        }
758    }
759}
760
761# ----------------------------------------------------------------------
762# USAGE: _monitor <name> <state>
763#
764# Used internally to add/remove bindings that cause the widget
765# associated with <name> to notify this controls widget of size
766# changes.  Whenever there is a size change, this controls widget
767# should fix its layout.
768# ----------------------------------------------------------------------
769itcl::body Rappture::Controls::_monitor {name state} {
770    set tag "Controls-$this"
771    set wv $_name2info($name-value)
772    if {[catch {bindtags $wv} btags]} {
773        return
774    }
775    set i [lsearch $btags $tag]
776
777    if {$state} {
778        if {$i < 0} {
779            bindtags $wv [linsert $btags 0 $tag]
780        }
781    } else {
782        if {$i >= 0} {
783            bindtags $wv [lreplace $btags $i $i]
784        }
785    }
786}
787
788# ----------------------------------------------------------------------
789# USAGE: _controlChanged <name>
790#
791# Invoked automatically whenever the value for a control changes.
792# Sends a notification along to the tool controlling this panel.
793# ----------------------------------------------------------------------
794itcl::body Rappture::Controls::_controlChanged {name} {
795    set path $_name2info($name-path)
796
797    #
798    # Let the owner know that this control changed.
799    #
800    if {"" != $_owner} {
801        $_owner changed $path
802    }
803}
804
805# ----------------------------------------------------------------------
806# USAGE: _controlValue <path> ?<units>?
807#
808# Used internally to get the value of a control with the specified
809# <path>.  Returns the current value for the control.
810# ----------------------------------------------------------------------
811itcl::body Rappture::Controls::_controlValue {path {units ""}} {
812    if {"" != $_owner} {
813        set val [$_owner valuefor $path]
814        if {"" != $units} {
815            set val [Rappture::Units::convert $val -to $units -units off]
816        }
817        return $val
818    }
819    return ""
820}
821
822# ----------------------------------------------------------------------
823# USAGE: _formatLabel <string>
824#
825# Used internally to format a label <string>.  Trims any excess
826# white space and adds a ":" to the end.  That way, all labels
827# have a uniform look.
828# ----------------------------------------------------------------------
829itcl::body Rappture::Controls::_formatLabel {str} {
830    set str [string trim $str]
831    if {"" != $str && [string index $str end] != ":"} {
832        append str ":"
833    }
834    return $str
835}
836
837# ----------------------------------------------------------------------
838# USAGE: _changeTabs ?-user|-program?
839#
840# Used internally to change tabs when the user clicks on a tab
841# in the "tabs" layout mode.  This mode is used when the widget
842# contains nothing but groups, as a compact way of representing
843# the groups.
844# ----------------------------------------------------------------------
845itcl::body Rappture::Controls::_changeTabs {{why -program}} {
846    set i [$_tabs index select]
847    # we use _showing here instead of _controls because sometimes tabs
848    # are disabled, and the index of the choosen tab always matches
849    # _showing, even if tabs are disabled.
850    set name [lindex $_showing $i]
851    if {$name ne ""} {
852        foreach w [grid slaves $_frame] {
853            grid forget $w
854        }
855
856        set wv $_name2info($name-value)
857        grid $wv -row 0 -column 0 -sticky nsew
858
859        $_tabs tab configure [$_tabs get $i] -window $_frame
860
861        if {$why eq "-user"} {
862            Rappture::Logger::log group $_name2info($name-path)
863        }
864    }
865}
866
867# ----------------------------------------------------------------------
868# USAGE: _resize
869#
870# Used internally to resize the widget when its contents change.
871# ----------------------------------------------------------------------
872itcl::body Rappture::Controls::_resize {} {
873    switch -glob -- $_scheme {
874        tabs {
875            # in "tabs" mode, the overall size is the largest for all pages
876            set maxw 0
877            set maxh 0
878            update idletasks
879            foreach name $_controls {
880                set wv $_name2info($name-value)
881                set w [winfo reqwidth $wv]
882                if {$w > $maxw} { set maxw $w }
883                set h [winfo reqheight $wv]
884                if {$h > $maxh} { set maxh $h }
885            }
886
887            # Turn off propagation temporarily so that we don't keep
888            # recursing back into this routine when we change the frame's
889            # dimensions below.
890            grid propagate $_frame no
891
892            $_frame configure -width $maxw -height $maxh
893
894            # Turn progagation back on so that the parent widget recognizes
895            # when the widget changes size or is unpacked.
896            grid propagate $_frame yes
897        }
898        vertical - horizontal - sentence* {
899            # in other modes, just use normal size propagation
900            grid propagate $_frame yes
901        }
902        default {
903            error "bad layout scheme \"$_scheme\""
904        }
905    }
906}
907
908# ----------------------------------------------------------------------
909# OPTION: -padding
910# ----------------------------------------------------------------------
911itcl::configbody Rappture::Controls::padding {
912    $_dispatcher event -idle !layout
913}
914
915# ----------------------------------------------------------------------
916# OPTION: -layout
917# ----------------------------------------------------------------------
918itcl::configbody Rappture::Controls::layout {
919    # clear any existing sentence parts
920    if {[array size _sentenceparts] > 0} {
921        foreach part $_sentenceparts(fragments) {
922            destroy $part
923        }
924        catch {unset _sentenceparts}
925    }
926
927    if {![regexp {^(|horizontal|vertical|tabs|sentence:.+)$} $itk_option(-layout)]} {
928        puts "ERROR: bad layout option \"$itk_option(-layout)\" -- should be horizontal, vertical, tabs or sentence:..."
929        set itk_option(-layout) ""
930    }
931
932    # recompute the layout at some point
933    $_dispatcher event -idle !layout
934}
Note: See TracBrowser for help on using the repository browser.