source: trunk/gui/scripts/controls.tcl @ 3648

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

revert change to detect ignore non-groupentries

File size: 31.7 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 <<Value>> [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 {[catch {expr $cond} show] == 0} {
458            set type $_name2info($name-type)
459            set disablestyle $_name2info($name-disablestyle)
460            set lwidget $_name2info($name-label)
461            set vwidget $_name2info($name-value)
462            if {[lsearch -exact {group image structure} $type] >= 0 ||
463                $disablestyle == "hide" } {
464                if {$show ne "" && $show} {
465                    lappend showing $name
466                } else {
467                    lappend hidden $name
468                }
469            } else {
470                # show other objects, but enable/disable them
471                lappend showing $name
472                if {$show ne "" && $show} {
473                    catch {$vwidget configure -state normal}
474                    if {[winfo exists $lwidget]} {
475                        $lwidget configure -foreground \
476                            [lindex [$lwidget configure -foreground] 3]
477                    }
478                } else {
479                    catch {$vwidget configure -state disabled}
480                    if {[winfo exists $lwidget]} {
481                        $lwidget configure -foreground gray
482                    }
483                }
484            }
485        } else {
486            bgerror "Error in <enable> expression for \"$_name2info($name-path)\":\n  $show"
487        }
488    }
489
490    # store the showing tabs in the object so it can be used in _changeTabs
491    set _showing $showing
492
493    #
494    # Decide on a layout scheme:
495    #   default ...... tabs for groups of groups; vertical otherwise
496    #   tabs ......... tabbed notebook
497    #   vertical ..... "label: value" down in rows
498    #   horizontal ... "label: value" across columns
499    #   sentence ..... text with embedded widgets
500    #
501    set _scheme $itk_option(-layout)
502    if {$_scheme eq "" || $_scheme eq "tabs"} {
503        if {[llength $showing] < 2} {
504            set _scheme "vertical"
505        } else {
506            set _scheme "tabs"
507            foreach name $showing {
508                set w $_name2info($name-value)
509                if {[lsearch {GroupEntry Separator} [winfo class $w]] < 0} {
510                    # something other than a group? then fall back on vertical
511                    set _scheme "vertical"
512                    break
513                }
514            }
515        }
516    }
517
518    # if the layout is "sentence:..." then create new parts
519    if {[string match {sentence:*} $itk_option(-layout)]
520          && [array size _sentenceparts] == 0} {
521        set n 0
522        set font [option get $itk_component(hull) labelFont Font]
523        set str [string range $itk_option(-layout) 9 end]
524        while {[regexp -indices {\$\{([a-zA-Z0-9_]+)\}} $str match name]} {
525            foreach {s0 s1} $name break
526            set name [string range $str $s0 $s1]
527
528            # create a label for the string before the substitution
529            foreach {s0 s1} $match break
530            set prefix [string trim [string range $str 0 [expr {$s0-1}]]]
531            if {$prefix ne ""} {
532                set lname $_frame.sentence[incr n]
533                label $lname -text $prefix -font $font
534                lappend _sentenceparts(all) $lname
535                lappend _sentenceparts(fragments) $lname
536            }
537
538            # add the widget for the substitution part
539            set found ""
540            foreach c $_controls {
541                if {$_name2info($c-id) eq $name} {
542                    set found $c
543                    break
544                }
545            }
546            if {$found ne ""} {
547                lappend _sentenceparts(all) $_name2info($found-value)
548            } else {
549                puts stderr "WARNING: name \"$name\" in sentence layout \"$itk_option(-layout)\" not recognized"
550            }
551
552            set str [string range $str [expr {$s1+1}] end]
553        }
554
555        # create a label for any trailing string
556        set str [string trim $str]
557        if {$str ne ""} {
558            set lname $_frame.sentence[incr n]
559            label $lname -text $str -font $font
560            lappend _sentenceparts(all) $lname
561            lappend _sentenceparts(fragments) $lname
562        }
563    }
564
565    switch -glob -- $_scheme {
566      tabs {
567        #
568        # SCHEME: tabs
569        # put a series of groups into a tabbed notebook
570        #
571
572        # stop covering up the tabset and put the _frame inside the tabs
573        pack forget $_frame
574        $_tabs configure -width 0 -height 0
575
576        set gn 1
577        foreach name $showing {
578            set wv $_name2info($name-value)
579            $wv configure -heading no
580            set label [$wv component heading cget -text]
581            if {"" == $label} {
582                set label "Group #$gn"
583            }
584            set _name2info($name-label) $label
585            $_tabs insert end $name -text $label \
586                -activebackground $itk_option(-background) \
587                -window $_frame -fill both
588            incr gn
589        }
590
591        # compute the overall size
592        # BE CAREFUL: do this after setting "-heading no" above
593        $_dispatcher event -now !resize
594
595        grid columnconfigure $_frame 0 -weight 1
596        grid rowconfigure $_frame 0 -weight 1
597
598        $_tabs select 0; _changeTabs
599      }
600
601      vertical {
602        #
603        # SCHEME: vertical
604        # simple "Label: Value" layout
605        #
606        if {[$_tabs size] > 0} {
607            $_tabs delete 0 end
608        }
609        pack $_frame -expand yes -fill both
610        $_tabs configure -width [winfo reqwidth $_frame] \
611            -height [winfo reqheight $_frame]
612
613        set expand 0  ;# most controls float to top
614        set row 0
615        foreach name $showing {
616            set wl $_name2info($name-label)
617            if {$wl != "" && [winfo exists $wl]} {
618                grid $wl -row $row -column 0 -sticky e
619            }
620
621            set wv $_name2info($name-value)
622            if {$wv ne "" && [winfo exists $wv]} {
623                if {$wl != ""} {
624                    grid $wv -row $row -column 1 -sticky ew
625                } else {
626                    grid $wv -row $row -column 0 -columnspan 2 -sticky ew
627                }
628
629                grid rowconfigure $_frame $row -weight 0
630
631                switch -- [winfo class $wv] {
632                    TextEntry {
633                        if {[regexp {[0-9]+x[0-9]+} [$wv size]]} {
634                            grid $wl -sticky n -pady 4
635                            grid $wv -sticky nsew
636                            grid rowconfigure $_frame $row -weight 1
637                            grid columnconfigure $_frame 1 -weight 1
638                            set expand 1
639                        }
640                    }
641                    GroupEntry {
642                        $wv configure -heading yes
643
644                        #
645                        # Scan through all children in this group
646                        # and see if any demand more space.  If the
647                        # group contains a structure or a note, then
648                        # make sure that the group itself is set to
649                        # expand/fill.
650                        #
651                        set queue [winfo children $wv]
652                        set expandgroup 0
653                        while {[llength $queue] > 0} {
654                            set w [lindex $queue 0]
655                            set queue [lrange $queue 1 end]
656                            set c [winfo class $w]
657                            if {[lsearch {DeviceEditor Note} $c] >= 0} {
658                                set expandgroup 1
659                                break
660                            }
661                            eval lappend queue [winfo children $w]
662                        }
663                        if {$expandgroup} {
664                            set expand 1
665                            grid $wv -sticky nsew
666                            grid rowconfigure $_frame $row -weight 1
667                        }
668                    }
669                    Note {
670                        grid $wv -sticky nsew
671                        grid rowconfigure $_frame $row -weight 1
672                        set expand 1
673                    }
674                }
675                grid columnconfigure $_frame 1 -weight 1
676            }
677
678            incr row
679            grid rowconfigure $_frame $row -minsize $itk_option(-padding)
680            incr row
681        }
682        grid $_frame.empty -row $row
683
684        #
685        # If there are any hidden items, then make the bottom of
686        # this form fill up any extra space, so the form floats
687        # to the top.  Otherwise, it will jitter around as the
688        # hidden items come and go.
689        #
690        if {[llength $hidden] > 0 && !$expand} {
691            grid rowconfigure $_frame 99 -weight 1
692        } else {
693            grid rowconfigure $_frame 99 -weight 0
694        }
695      }
696
697      horizontal {
698        #
699        # SCHEME: horizontal
700        # lay out left to right
701        #
702        if {[$_tabs size] > 0} {
703            $_tabs delete 0 end
704        }
705        pack $_frame -expand yes -fill both
706        $_tabs configure -width [winfo reqwidth $_frame] \
707            -height [winfo reqheight $_frame]
708
709        set col 0
710        set pad [expr {$itk_option(-padding)/2}]
711        foreach name $showing {
712            set wl $_name2info($name-label)
713            if {$wl != "" && [winfo exists $wl]} {
714                grid $wl -row 0 -column $col -sticky e -padx $pad
715                incr col
716            }
717
718            set wv $_name2info($name-value)
719            if {$wv != "" && [winfo exists $wv]} {
720                grid $wv -row 0 -column $col -sticky ew -padx $pad
721                grid columnconfigure $_frame $col -weight 0
722                incr col
723            }
724        }
725      }
726
727      sentence:* {
728        #
729        # SCHEME: sentence
730        # lay out left to right with sentence parts: "( [x] , [y] )"
731        #
732        if {[$_tabs size] > 0} {
733            $_tabs delete 0 end
734        }
735        pack $_frame -expand yes -fill both
736        $_tabs configure -width [winfo reqwidth $_frame] \
737            -height [winfo reqheight $_frame]
738
739        set col 0
740        set pad [expr {$itk_option(-padding)/2}]
741        foreach widget $_sentenceparts(all) {
742            grid $widget -row 0 -column $col -padx $pad
743            incr col
744        }
745      }
746    }
747}
748
749# ----------------------------------------------------------------------
750# USAGE: _monitor <name> <state>
751#
752# Used internally to add/remove bindings that cause the widget
753# associated with <name> to notify this controls widget of size
754# changes.  Whenever there is a size change, this controls widget
755# should fix its layout.
756# ----------------------------------------------------------------------
757itcl::body Rappture::Controls::_monitor {name state} {
758    set tag "Controls-$this"
759    set wv $_name2info($name-value)
760    if {[catch {bindtags $wv} btags]} {
761        return
762    }
763    set i [lsearch $btags $tag]
764
765    if {$state} {
766        if {$i < 0} {
767            bindtags $wv [linsert $btags 0 $tag]
768        }
769    } else {
770        if {$i >= 0} {
771            bindtags $wv [lreplace $btags $i $i]
772        }
773    }
774}
775
776# ----------------------------------------------------------------------
777# USAGE: _controlChanged <name>
778#
779# Invoked automatically whenever the value for a control changes.
780# Sends a notification along to the tool controlling this panel.
781# ----------------------------------------------------------------------
782itcl::body Rappture::Controls::_controlChanged {name} {
783    set path $_name2info($name-path)
784
785    #
786    # Let the owner know that this control changed.
787    #
788    if {"" != $_owner} {
789        $_owner changed $path
790    }
791}
792
793# ----------------------------------------------------------------------
794# USAGE: _controlValue <path> ?<units>?
795#
796# Used internally to get the value of a control with the specified
797# <path>.  Returns the current value for the control.
798# ----------------------------------------------------------------------
799itcl::body Rappture::Controls::_controlValue {path {units ""}} {
800    if {"" != $_owner} {
801        set val [$_owner valuefor $path]
802        if {"" != $units} {
803            set val [Rappture::Units::convert $val -to $units -units off]
804        }
805        return $val
806    }
807    return ""
808}
809
810# ----------------------------------------------------------------------
811# USAGE: _formatLabel <string>
812#
813# Used internally to format a label <string>.  Trims any excess
814# white space and adds a ":" to the end.  That way, all labels
815# have a uniform look.
816# ----------------------------------------------------------------------
817itcl::body Rappture::Controls::_formatLabel {str} {
818    set str [string trim $str]
819    if {"" != $str && [string index $str end] != ":"} {
820        append str ":"
821    }
822    return $str
823}
824
825# ----------------------------------------------------------------------
826# USAGE: _changeTabs ?-user|-program?
827#
828# Used internally to change tabs when the user clicks on a tab
829# in the "tabs" layout mode.  This mode is used when the widget
830# contains nothing but groups, as a compact way of representing
831# the groups.
832# ----------------------------------------------------------------------
833itcl::body Rappture::Controls::_changeTabs {{why -program}} {
834    set i [$_tabs index select]
835    # we use _showing here instead of _controls because sometimes tabs
836    # are disabled, and the index of the choosen tab always matches
837    # _showing, even if tabs are disabled.
838    set name [lindex $_showing $i]
839    if {$name ne ""} {
840        foreach w [grid slaves $_frame] {
841            grid forget $w
842        }
843
844        set wv $_name2info($name-value)
845        grid $wv -row 0 -column 0 -sticky nsew
846
847        $_tabs tab configure [$_tabs get $i] -window $_frame
848
849        if {$why eq "-user"} {
850            Rappture::Logger::log group $_name2info($name-path)
851        }
852    }
853}
854
855# ----------------------------------------------------------------------
856# USAGE: _resize
857#
858# Used internally to resize the widget when its contents change.
859# ----------------------------------------------------------------------
860itcl::body Rappture::Controls::_resize {} {
861    switch -glob -- $_scheme {
862        tabs {
863            # in "tabs" mode, the overall size is the largest for all pages
864            set maxw 0
865            set maxh 0
866            update idletasks
867            foreach name $_controls {
868                set wv $_name2info($name-value)
869                set w [winfo reqwidth $wv]
870                if {$w > $maxw} { set maxw $w }
871                set h [winfo reqheight $wv]
872                if {$h > $maxh} { set maxh $h }
873            }
874
875            grid propagate $_frame no
876            $_frame configure -width $maxw -height $maxh
877        }
878        vertical - horizontal - sentence* {
879            # in other modes, just use normal size propagation
880            grid propagate $_frame yes
881        }
882        default {
883            error "bad layout scheme \"$_scheme\""
884        }
885    }
886}
887
888# ----------------------------------------------------------------------
889# OPTION: -padding
890# ----------------------------------------------------------------------
891itcl::configbody Rappture::Controls::padding {
892    $_dispatcher event -idle !layout
893}
894
895# ----------------------------------------------------------------------
896# OPTION: -layout
897# ----------------------------------------------------------------------
898itcl::configbody Rappture::Controls::layout {
899    # clear any existing sentence parts
900    if {[array size _sentenceparts] > 0} {
901        foreach part $_sentenceparts(fragments) {
902            destroy $part
903        }
904        catch {unset _sentenceparts}
905    }
906
907    if {![regexp {^(|horizontal|vertical|tabs|sentence:.+)$} $itk_option(-layout)]} {
908        puts "ERROR: bad layout option \"$itk_option(-layout)\" -- should be horizontal, vertical, tabs or sentence:..."
909        set itk_option(-layout) ""
910    }
911
912    # recompute the layout at some point
913    $_dispatcher event -idle !layout
914}
Note: See TracBrowser for help on using the repository browser.