Changeset 26


Ignore:
Timestamp:
Jul 19, 2005 1:15:04 AM (19 years ago)
Author:
mmc
Message:

Fixed the rendering of groups, and groups within groups.
If groups are mixed in with other elements, then they are
drawn with a gray outline/heading, with the title taken
from the <group><about><label>. However, if a group
contains only other groups, then it is treated as a tabbed
notebook, and each group within is put on a separate page.

WARNING: There are many bad interactions between the
blt::tabset, the Rappture::Scroller, and the Rappture::Pager.
Pages shake violently when all are in play. The only way I
could get them to settle down was by putting the tabs above
the pages they control. Have to revisit this some time to
make it look better...

Location:
trunk/gui/scripts
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/controls.tcl

    r23 r26  
    1111# ======================================================================
    1212package require Itk
     13package require BLT
    1314
    1415option add *Controls.padding 4 widgetDefault
    … …  
    3132    protected method _controlChanged {path}
    3233    protected method _formatLabel {str}
     34    protected method _changeTabs {}
    3335
    3436    private variable _owner ""       ;# controls belong to this owner
     37    private variable _tabs ""        ;# optional tabset for groups
     38    private variable _frame ""       ;# pack controls into this frame
    3539    private variable _counter 0      ;# counter for control names
    3640    private variable _dispatcher ""  ;# dispatcher for !events
    … …  
    5155
    5256    set _owner $owner
     57
     58    Rappture::Scroller $itk_interior.sc -xscrollmode none -yscrollmode auto
     59    pack $itk_interior.sc -expand yes -fill both
     60    set f [$itk_interior.sc contents frame]
     61
     62    set _tabs [blt::tabset $f.tabs -borderwidth 0 -relief flat \
     63        -side top -tearoff 0 -highlightthickness 0 \
     64        -selectbackground $itk_option(-background) \
     65        -selectcommand [itcl::code $this _changeTabs]]
     66
     67    set _frame [frame $f.inner]
     68    pack $_frame -expand yes -fill both
    5369
    5470    eval itk_initialize $args
    … …  
    7894    set _name2info($name-path) $path
    7995    set _name2info($name-label) ""
    80     set _name2info($name-value) [set w $itk_interior.v$name]
     96    set _name2info($name-value) [set w $_frame.v$name]
    8197
    8298    set type [$_owner xml element -as type $path]
    … …  
    126142        set label [$w label]
    127143        if {"" != $label} {
    128             set _name2info($name-label) $itk_interior.l$name
     144            set _name2info($name-label) $_frame.l$name
    129145            set font [option get $itk_component(hull) labelFont Font]
    130146            label $_name2info($name-label) -text [_formatLabel $label] \
    … …  
    257273        }
    258274    }
     275    if {[$_tabs size] > 0} {
     276        $_tabs delete 0 end
     277    }
    259278
    260279    #
    261     # Lay out the widgets in a simple "Label: Value" scheme...
     280    # Decide on a layout scheme:
     281    #   tabs ...... best if all elements within are groups
     282    #   hlabels ... horizontal labels (label: value)
    262283    #
    263     set row 0
    264     foreach name $_controls {
    265         set wl $_name2info($name-label)
    266         if {$wl != "" && [winfo exists $wl]} {
    267             grid $wl -row $row -column 0 -sticky e
    268         }
    269 
    270         set wv $_name2info($name-value)
    271         if {$wv != "" && [winfo exists $wv]} {
    272             grid $wv -row $row -column 1 -sticky ew
    273 
    274             set frame [winfo parent $wv]
    275             grid rowconfigure $frame $row -weight 0
    276             grid rowconfigure $frame $row -weight 0
    277 
    278             switch -- [winfo class $wv] {
    279                 TextEntry {
    280                     if {[regexp {[0-9]+x[0-9]+} [$wv size]]} {
    281                         grid $wl -sticky n -pady 4
    282                         grid $wv -sticky nsew
    283                         grid rowconfigure $frame $row -weight 1
    284                         grid columnconfigure $frame 1 -weight 1
     284    if {[llength $_controls] >= 2} {
     285        # assume tabs for multiple groups
     286        set scheme tabs
     287        foreach name $_controls {
     288            set w $_name2info($name-value)
     289
     290            if {[winfo class $w] != "GroupEntry"} {
     291                # something other than a group? then fall back on hlabels
     292                set scheme hlabels
     293                break
     294            }
     295        }
     296    } else {
     297        set scheme hlabels
     298    }
     299
     300    switch -- $scheme {
     301      tabs {
     302        #
     303        # SCHEME: tabs
     304        # put a series of groups into a tabbed notebook
     305        #
     306
     307        # use inner frame within tabs to show current group
     308        pack $_tabs -before $_frame -fill x
     309
     310        set gn 1
     311        foreach name $_controls {
     312            set wv $_name2info($name-value)
     313            $wv configure -heading no
     314
     315            set label [$wv component heading cget -text]
     316            if {"" == $label} {
     317                set label "Group #$gn"
     318            }
     319            set _name2info($name-label) $label
     320
     321            $_tabs insert end $label \
     322                -activebackground $itk_option(-background)
     323
     324            incr gn
     325        }
     326
     327        # compute the overall size
     328        # BE CAREFUL: do this after setting "-heading no" above
     329        set maxw 0
     330        set maxh 0
     331        update idletasks
     332        foreach name $_controls {
     333            set w [winfo reqwidth $wv]
     334            if {$w > $maxw} { set maxw $w }
     335            set h [winfo reqheight $wv]
     336            if {$h > $maxh} { set maxh $h }
     337        }
     338        $_frame configure -width $maxw -height $maxh
     339
     340        grid propagate $_frame off
     341        grid columnconfigure $_frame 0 -weight 1
     342        grid rowconfigure $_frame 0 -weight 1
     343
     344        $_tabs select 0; _changeTabs
     345      }
     346
     347      hlabels {
     348        #
     349        # SCHEME: hlabels
     350        # simple "Label: Value" layout
     351        #
     352        pack forget $_tabs
     353        grid propagate $_frame on
     354        grid columnconfigure $_frame 0 -weight 0
     355        grid rowconfigure $_frame 0 -weight 0
     356
     357        set row 0
     358        foreach name $_controls {
     359            set wl $_name2info($name-label)
     360            if {$wl != "" && [winfo exists $wl]} {
     361                grid $wl -row $row -column 0 -sticky e
     362            }
     363
     364            set wv $_name2info($name-value)
     365            if {$wv != "" && [winfo exists $wv]} {
     366                if {$wl != ""} {
     367                    grid $wv -row $row -column 1 -sticky ew
     368                } else {
     369                    grid $wv -row $row -column 0 -columnspan 2 -sticky ew
     370                }
     371
     372                set frame [winfo parent $wv]
     373                grid rowconfigure $frame $row -weight 0
     374                grid rowconfigure $frame $row -weight 0
     375
     376                switch -- [winfo class $wv] {
     377                    TextEntry {
     378                        if {[regexp {[0-9]+x[0-9]+} [$wv size]]} {
     379                            grid $wl -sticky n -pady 4
     380                            grid $wv -sticky nsew
     381                            grid rowconfigure $frame $row -weight 1
     382                            grid columnconfigure $frame 1 -weight 1
     383                        }
     384                    }
     385                    GroupEntry {
     386                        $wv configure -heading yes
    285387                    }
    286388                }
    287             }
    288             grid columnconfigure $frame 1 -weight 1
    289         }
    290 
    291 
    292         incr row
    293         grid rowconfigure [winfo parent $w] $row -minsize $itk_option(-padding)
    294         incr row
     389                grid columnconfigure $frame 1 -weight 1
     390            }
     391
     392
     393            incr row
     394            grid rowconfigure [winfo parent $w] $row \
     395                -minsize $itk_option(-padding)
     396            incr row
     397        }
     398      }
    295399    }
    296400}
    … …  
    325429
    326430# ----------------------------------------------------------------------
     431# USAGE: _changeTabs
     432#
     433# Used internally to change tabs when the user clicks on a tab
     434# in the "tabs" layout mode.  This mode is used when the widget
     435# contains nothing but groups, as a compact way of representing
     436# the groups.
     437# ----------------------------------------------------------------------
     438itcl::body Rappture::Controls::_changeTabs {} {
     439    set i [$_tabs index select]
     440    set name [lindex $_controls $i]
     441    if {"" != $name} {
     442        foreach w [grid slaves $_frame] {
     443            grid forget $w
     444        }
     445
     446        set wv $_name2info($name-value)
     447        grid $wv -row 0 -column 0 -sticky new
     448    }
     449}
     450
     451# ----------------------------------------------------------------------
    327452# OPTION: -padding
    328453# ----------------------------------------------------------------------

  • trunk/gui/scripts/deviceViewer1D.tcl

    r24 r26  
    205205    if {[llength $tabs] <= 0} {
    206206        #
    207         # == DEPRECATED FUNCTIONALITY ==
    208         # (I like the look of the tab, even if there's only one)
    209         #
    210         # No fields or one field?  Then we don't need to bother
    211         # with tabs.  Just pack the inner frame directly.  If
    212         # there are no fields, get rid of the graph.
     207        # No fields?  Then we don't need to bother with tabs.
     208        # Just pack the inner frame directly.  If there are no
     209        # fields, get rid of the graph.
    213210        #
    214211        pack $itk_component(inner) -expand yes -fill both

  • trunk/gui/scripts/groupentry.tcl

    r22 r26  
    1212package require Itk
    1313
     14option add *GroupEntry.headingBackground #cccccc widgetDefault
     15option add *GroupEntry.headingForeground white widgetDefault
     16option add *GroupEntry.font -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
     17
    1418itcl::class Rappture::GroupEntry {
    1519    inherit itk::Widget
     20
     21    itk_option define -heading heading Heading 1
    1622
    1723    constructor {owner path args} { # defined below }
    … …  
    2127    public method label {}
    2228    public method tooltip {}
     29
     30    protected method _fixheading {}
    2331
    2432    private variable _owner ""    ;# thing managing this control
    … …  
    4250    set _owner $owner
    4351    set _path $path
     52
     53    itk_component add heading {
     54        ::label $itk_interior.heading -anchor w
     55    } {
     56        usual
     57        rename -background -headingbackground headingBackground Background
     58        rename -foreground -headingforeground headingForeground Foreground
     59    }
     60
     61    $itk_component(heading) configure \
     62        -text [$_owner xml get $_path.about.label]
     63    Rappture::Tooltip::for $itk_component(heading) \
     64        [$_owner xml get $_path.about.description]
     65
     66    itk_component add outline {
     67        frame $itk_interior.outline -borderwidth 1
     68    } {
     69        usual
     70        ignore -borderwidth
     71        rename -background -headingbackground headingBackground Background
     72    }
     73    pack $itk_component(outline) -expand yes -fill both
     74
     75    itk_component add inner {
     76        frame $itk_component(outline).inner -borderwidth 3
     77    } {
     78        usual
     79        ignore -borderwidth
     80    }
     81    pack $itk_component(inner) -expand yes -fill both
    4482
    4583    eval itk_initialize $args
    … …  
    67105# ----------------------------------------------------------------------
    68106itcl::body Rappture::GroupEntry::label {} {
    69     return [$_owner xml get $_path.about.label]
     107    return ""  ;# manage the label inside this group
    70108}
    71109
    … …  
    81119    return [$_owner xml get $_path.about.description]
    82120}
     121
     122# ----------------------------------------------------------------------
     123# CONFIGURATION OPTION: -heading
     124# Turns the heading bar at the top of this group on/off.
     125# ----------------------------------------------------------------------
     126itcl::configbody Rappture::GroupEntry::heading {
     127    if {![string is boolean -strict $itk_option(-heading)]} {
     128        error "bad value \"$itk_option(-heading)\": should be boolean"
     129    }
     130
     131    set str [$itk_component(heading) cget -text]
     132    if {$itk_option(-heading) && "" != $str} {
     133        eval pack forget [pack slaves $itk_component(hull)]
     134        pack $itk_component(heading) -side top -fill x
     135        pack $itk_component(outline) -expand yes -fill both
     136        $itk_component(outline) configure -borderwidth 1
     137        $itk_component(inner) configure -borderwidth 3
     138    } else {
     139        pack forget $itk_component(heading)
     140        $itk_component(outline) configure -borderwidth 0
     141        $itk_component(inner) configure -borderwidth 0
     142    }
     143}

  • trunk/gui/scripts/page.tcl

    r23 r26  
    201201                        error $c "$c\n    (while building control for $path.$cname)"
    202202                    } else {
    203                         set w [$frame.cntls control $c]
     203                        set gentry [$frame.cntls control $c]
     204                        set w [$gentry component inner]
    204205                    }
    205206                }

  • trunk/gui/scripts/pager.tcl

    r24 r26  
    401401# ----------------------------------------------------------------------
    402402itcl::body Rappture::Pager::_fixSize {} {
     403    set sw [expr {[winfo screenwidth $itk_component(hull)]-200}]
     404    set sh [expr {[winfo screenheight $itk_component(hull)]-200}]
     405
    403406    switch -- $itk_option(-arrangement) {
    404407        pages {
    405408            if {$itk_option(-width) <= 0} {
    406                 update idletasks
    407409                set maxw [expr {
    408410                    [winfo reqwidth $itk_component(next)]
    … …  
    415417                }
    416418                set maxw [expr {$maxw + 2*$itk_option(-padding)}]
     419                if {$maxw > $sw} { set maxw $sw }
    417420                $itk_component(inside) configure -width $maxw
    418421            } else {
    … …  
    421424
    422425            if {$itk_option(-height) <= 0} {
    423                 update idletasks
    424426                set maxh 0
    425427                foreach name $_pages {
    … …  
    428430                }
    429431                set maxh [expr {$maxh + 2*$itk_option(-padding)}]
     432                if {$maxh > $sh} { set maxh $sh }
    430433                $itk_component(inside) configure -height $maxh
    431434            } else {
    … …  
    435438        side-by-side {
    436439            if {$itk_option(-width) <= 0} {
    437                 update idletasks
    438440                set maxw [expr {
    439441                    [winfo reqwidth $itk_component(next)]
    … …  
    447449                }
    448450                if {$wtotal > $maxw} { set maxw $wtotal }
     451                if {$maxw > $sw} { set maxw $sw }
    449452                $itk_component(inside) configure -width $maxw
    450453            } else {
    … …  
    453456
    454457            if {$itk_option(-height) <= 0} {
    455                 update idletasks
    456458                set maxh 0
    457459                foreach name $_pages {
    … …  
    460462                }
    461463                set maxh [expr {$maxh + 2*$itk_option(-padding)}]
     464                if {$maxh > $sh} { set maxh $sh }
    462465                $itk_component(inside) configure -height $maxh
    463466            } else {

  • trunk/gui/scripts/scroller.tcl

    r11 r26  
    3434    protected method _fixsbar {which {state ""}}
    3535    protected method _fixframe {which}
     36    protected method _fixsize {}
    3637    protected method _lock {option}
    3738
     39    private variable _dispatcher "" ;# dispatcher for !events
    3840    private variable _contents ""   ;# widget being controlled
    3941    private variable _frame ""      ;# for "contents frame" calls
    … …  
    5254# ----------------------------------------------------------------------
    5355itcl::body Rappture::Scroller::constructor {args} {
     56    Rappture::dispatcher _dispatcher
     57
     58    $_dispatcher register !fixframe-inner
     59    $_dispatcher dispatch $this !fixframe-inner \
     60        "[itcl::code $this _fixframe inner]; list"
     61
     62    $_dispatcher register !fixframe-outer
     63    $_dispatcher dispatch $this !fixframe-outer \
     64        "[itcl::code $this _fixframe outer]; list"
     65
     66    $_dispatcher register !fixsize
     67    $_dispatcher dispatch $this !fixsize \
     68        "[itcl::code $this _fixsize]; list"
     69
    5470    itk_component add xsbar {
    5571        scrollbar $itk_interior.xsbar -orient horizontal
    … …  
    104120            frame $_frame.f
    105121            $_frame create window 0 0 -anchor nw -window $_frame.f -tags frame
    106             bind $_frame.f <Configure> [itcl::code $this _fixframe inner]
    107             bind $_frame <Configure> [itcl::code $this _fixframe outer]
     122            bind $_frame.f <Configure> \
     123                [itcl::code $_dispatcher event -idle !fixframe-inner]
     124            bind $_frame <Configure> \
     125                [itcl::code $_dispatcher event -idle !fixframe-outer]
    108126        }
    109127        set widget $_frame
    … …  
    207225        inner {
    208226            $_frame configure -scrollregion [$_frame bbox all]
     227            $_dispatcher event -idle !fixsize
    209228        }
    210229        outer {
    211230            $_frame itemconfigure frame -width [winfo width $_frame]
    212231        }
     232    }
     233}
     234
     235# ----------------------------------------------------------------------
     236# USAGE: _fixsize
     237#
     238# Used internally to update the size options for the widget
     239# whenever the -width/-height options change.
     240# ----------------------------------------------------------------------
     241itcl::body Rappture::Scroller::_fixsize {} {
     242    if {$itk_option(-width) == "0" && $itk_option(-height) == "0"} {
     243        # for default size, let the frame being controlled set the size
     244        grid propagate $itk_component(hull) yes
     245        if {$_frame == "$itk_component(hull).ifr"} {
     246            set w [winfo reqwidth $_frame.f]
     247            set h [winfo reqheight $_frame.f]
     248            $_frame configure -width $w -height $h
     249        }
     250    } else {
     251        # for specific size, set the overall size of the widget
     252        grid propagate $itk_component(hull) no
     253        set w $itk_option(-width); if {$w == "0"} { set w 1i }
     254        set h $itk_option(-height); if {$h == "0"} { set h 1i }
     255        component hull configure -width $w -height $h
    213256    }
    214257}
    … …  
    264307# ----------------------------------------------------------------------
    265308itcl::configbody Rappture::Scroller::width {
    266     if {$itk_option(-width) == "0"} {
    267         if {$itk_option(-height) == "0"} {
    268             grid propagate $itk_component(hull) yes
    269         } else {
    270             component hull configure -width 1i
    271         }
    272     } else {
    273         grid propagate $itk_component(hull) no
    274         component hull configure -width $itk_option(-width)
    275     }
     309    # check for proper value
     310    winfo pixels $itk_component(hull) $itk_option(-width)
     311
     312    $_dispatcher event -idle !fixsize
    276313}
    277314
    … …  
    280317# ----------------------------------------------------------------------
    281318itcl::configbody Rappture::Scroller::height {
    282     if {$itk_option(-height) == "0"} {
    283         if {$itk_option(-width) == "0"} {
    284             grid propagate $itk_component(hull) yes
    285         } else {
    286             component hull configure -height 1i
    287         }
    288     } else {
    289         grid propagate $itk_component(hull) no
    290         component hull configure -height $itk_option(-height)
    291     }
    292 }
     319    # check for proper value
     320    winfo pixels $itk_component(hull) $itk_option(-height)
     321
     322    $_dispatcher event -idle !fixsize
     323}

  • trunk/gui/scripts/tooltip.tcl

    r14 r26  
    130130    }
    131131
     132    # if there's no message to show, forget it
     133    if {[string length $mesg] == 0} {
     134        return
     135    }
     136
    132137    # strings can't be too big, or they'll go off screen!
    133138    if {[string length $mesg] > 1000} {
Note: See TracChangeset for help on using the changeset viewer.