source: branches/1.4/gui/scripts/sidebarframe.tcl @ 5116

Last change on this file since 5116 was 5116, checked in by ldelgass, 6 years ago

merge r5028 from trunk (sidebar insert tab)

File size: 20.7 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: SidebarFrame - pop-out controls for visualization widgets
4#
5#  The sidebar provides a way to put a thin strip of controls along the
6#  side of a visualization widget, with tabs that cause control panels
7#  to pop out.  The SidebarFrame has an empty frame (component "frame")
8#  on the left and a sidebar that pops out on the right.
9# ======================================================================
10#  AUTHOR:  George Howlett, Michael McLennan, Purdue University
11#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
12#
13#  See the file "license.terms" for information on usage and
14#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15# ======================================================================
16package require Itk
17
18option add *SidebarFrame.width 3i widgetDefault
19option add *SidebarFrame.height 3i widgetDefault
20option add *SidebarFrame.titlebarBackground #6666cc widgetDefault
21option add *SidebarFrame.titlebarForeground white widgetDefault
22option add *SidebarFrame.controlBackground gray widgetDefault
23option add *SidebarFrame*cntls*highlightBackground gray widgetDefault
24option add *SidebarFrame.sashRelief flat widgetDefault
25option add *SidebarFrame.sashActiveRelief solid widgetDefault
26option add *SidebarFrame.sashColor gray widgetDefault
27option add *SidebarFrame.sashWidth 2 widgetDefault
28option add *SidebarFrame.sashPadding 2 widgetDefault
29option add *SidebarFrame.sashCursor sb_h_double_arrow
30
31itcl::class Rappture::SidebarFrame {
32    inherit itk::Widget
33
34    itk_option define -sashrelief sashRelief Relief ""
35    itk_option define -sashactiverelief sashActiveRelief SashActiveRelief ""
36    itk_option define -sashcolor sashColor SashColor ""
37    itk_option define -sashwidth sashWidth SashWidth 0
38    itk_option define -sashpadding sashPadding SashPadding 0
39    itk_option define -sashcursor sashCursor Cursor ""
40
41    public variable resizeframe 1
42    constructor {args} { # defined below }
43
44    public method insert {pos args}
45    public method exists {which}
46    public method panel {which}
47    public method select {which}
48    public method pop {what}
49    public method width { size } {
50        set _width $size
51    }
52    public method enable { which }
53    public method disable { which }
54
55    protected method _toggleTab {which}
56    protected method _sash {op x}
57    protected method _fixLayout {args}
58    protected method TabIndex { which }
59
60    private variable _dispatcher ""  ;# dispatcher for !events
61    private variable _state "closed" ;# sidebar open/closed
62    private variable _panels         ;# maps panel => title, etc.
63    private variable _selected ""    ;# selected panel
64    private variable _width "auto"   ;# width adjusted by sash or "auto"
65    private variable _counter 0      ;# counter for auto-generated names
66    private variable _title2panel
67}
68
69itk::usual SidebarFrame {
70    keep -background -cursor
71    keep -titlebarbackground -titlebarforeground
72}
73
74# ----------------------------------------------------------------------
75# CONSTRUCTOR
76# ----------------------------------------------------------------------
77itcl::body Rappture::SidebarFrame::constructor {args} {
78    itk_option add hull.width hull.height
79
80    # create a dispatcher for events
81    Rappture::dispatcher _dispatcher
82    $_dispatcher register !layout
83    $_dispatcher dispatch $this !layout [itcl::code $this _fixLayout]
84
85    # fix the layout whenever the window size changes
86    bind SidebarFrame <Configure> [itcl::code %W _fixLayout]
87
88    #
89    # Empty frame for main widget
90    #
91    itk_component add frame {
92        frame $itk_interior.f
93    }
94
95    #
96    # Sash along the left side of sidebar
97    #
98    itk_component add sashbg {
99        frame $itk_interior.sashbg
100    } {
101        usual
102        rename -cursor -sashcursor sashCursor Cursor
103    }
104
105    itk_component add sash {
106        frame $itk_component(sashbg).sash -borderwidth 1
107    } {
108        usual
109        ignore -background -borderwidth
110        rename -relief -sashrelief sashRelief Relief
111        rename -width -sashwidth sashWidth SashWidth
112        rename -cursor -sashcursor sashCursor Cursor
113    }
114    pack $itk_component(sash) -side left -fill y
115
116    foreach c {sash sashbg} {
117        bind $itk_component($c) <Enter> \
118            [itcl::code $this _sash enter %X]
119        bind $itk_component($c) <Leave> \
120            [itcl::code $this _sash leave %X]
121        bind $itk_component($c) <ButtonPress-1> \
122            [itcl::code $this _sash grab %X]
123        bind $itk_component($c) <B1-Motion> \
124            [itcl::code $this _sash drag %X]
125        bind $itk_component($c) <ButtonRelease-1> \
126            [itcl::code $this _sash release %X]
127    }
128
129    itk_component add sidebar {
130        frame $itk_interior.sbar
131    }
132
133    #
134    # Title bar along top of sidebar
135    #
136    itk_component add titlebar {
137        frame $itk_component(sidebar).tbar -highlightthickness 0
138    } {
139        usual
140        ignore -highlightthickness
141        rename -background -titlebarbackground titlebarBackground Background
142    }
143    pack $itk_component(titlebar) -side top -fill x
144
145    itk_component add popbutton {
146        button $itk_component(titlebar).popb \
147            -borderwidth 1 -relief flat -overrelief raised \
148            -highlightthickness 0 \
149            -image [Rappture::icon sbar-open] \
150            -command [itcl::code $this pop toggle]
151    } {
152        usual
153        ignore -borderwidth -relief -overrelief -highlightthickness
154        rename -background -titlebarbackground titlebarBackground Background
155        rename -activebackground -titlebarbackground titlebarBackground Background
156    }
157    pack $itk_component(popbutton) -side left -padx 6 -pady 2
158    Rappture::Tooltip::for $itk_component(popbutton) \
159        "Open/close the sidebar"
160
161    itk_component add title {
162        label $itk_component(titlebar).title -anchor w -font "Arial 10"
163    } {
164        usual
165        ignore -font
166        rename -foreground -titlebarforeground titlebarForeground Foreground
167        rename -background -titlebarbackground titlebarBackground Background
168    }
169    pack $itk_component(title) -side left -expand yes -fill both -padx 1 -pady 1
170
171    #
172    # Area for active panel
173    #
174    itk_component add area {
175        Rappture::Scroller $itk_component(sidebar).area \
176            -xscrollmode auto -yscrollmode auto \
177            -highlightthickness 0
178    }
179    $itk_component(area) contents frame
180
181    itk_component add controlbar {
182        frame $itk_component(sidebar).cbar
183    } {
184        usual
185        rename -background -controlbackground controlBackground Background
186    }
187    pack $itk_component(controlbar) -side left -fill y
188
189    #
190    # Control area above the tabs
191    #
192    itk_component add controls {
193        frame $itk_component(controlbar).cntls -height 20
194    } {
195        usual
196        rename -background -controlbackground controlBackground Background
197    }
198    pack $itk_component(controls) -side top -pady {8 20}
199
200    #
201    # Tabs used to select sidebar panels. 
202    #
203    # Note:  Bugs in BLT 2.4 tabset/VNC server crashes the server
204    #        when -outerpad is set to 0.
205    #
206    itk_component add tabs {
207        blt::tabset $itk_component(controlbar).tabs \
208            -highlightthickness 0 -tearoff 0 -side left \
209            -bd 0 -gap 0 -tabborderwidth 1 \
210            -outerpad 1
211    } {
212        keep -background -cursor
213        ignore -highlightthickness -borderwidth
214        rename -highlightbackground -controlbackground controlBackground \
215            Background
216        rename -background -controlbackground controlBackground \
217            Background
218    }
219    pack $itk_component(tabs) -side top -expand yes -anchor e -padx {4 0} -fill y
220
221    eval itk_initialize $args
222
223    # make sure we fix up the layout at some point
224    $_dispatcher event -idle !layout
225}
226
227# ----------------------------------------------------------------------
228# USAGE: insert <pos> ?-title t? ?-icon i?
229#
230# Adds a new panel into this widget at the given position <pos>.  The
231# panel has a tab with the specified -icon, and is labeled by the
232# -title string in the titlebar area when it is selected.
233# ----------------------------------------------------------------------
234itcl::body Rappture::SidebarFrame::insert {pos args} {
235    Rappture::getopts args panel "
236        value -title Options
237        value -icon [Rappture::icon cboff]
238    "
239    if {[llength $args] > 0} {
240        error "wrong # args: should be \"insert pos ?-title t? ?-icon i?\""
241    }
242
243    set f [$itk_component(area) contents]
244    set pname "panel[incr _counter]"
245    itk_component add $pname {
246        frame $f.$pname
247    }
248
249    $itk_component(tabs) insert $pos $pname \
250        -image $panel(-icon) -text "" -padx 0 -pady 0 \
251        -command [itcl::code $this _toggleTab $pname]
252
253    set _title2panel($panel(-title)) $pname
254    Rappture::Tooltip::text $itk_component(tabs)-$pname \
255        "Open/close sidebar for $panel(-title)"
256    $itk_component(tabs) bind $pname <Enter> \
257        [list ::Rappture::Tooltip::tooltip pending %W-$pname @%X,%Y]
258    $itk_component(tabs) bind $pname <Leave> \
259        [list ::Rappture::Tooltip::tooltip cancel]
260    $itk_component(tabs) bind $pname <ButtonPress> \
261        [list ::Rappture::Tooltip::tooltip cancel]
262    $itk_component(tabs) bind $pname <KeyPress> \
263        [list ::Rappture::Tooltip::tooltip cancel]
264
265    set _panels($pname-title) $panel(-title)
266    if { ![info exists _panels(all)] || $pos == "end" } {
267        lappend _panels(all) $pname
268    } else {
269        set _panels(all) [linsert $_panels(all) $pos $pname]
270    }
271    if {$_selected == ""} {
272        set _selected $pname
273        if {$_state == "open"} {
274            $itk_component(title) configure -text $panel(-title)
275        }
276    }
277
278    return $itk_component($pname)
279}
280
281# ----------------------------------------------------------------------
282# USAGE: panel <which>
283#
284# Returns the frame representing the requested panel.  The <which>
285# argument can be a panel index, name, or title, or the keyword
286# "current" for the selected panel.
287# ----------------------------------------------------------------------
288itcl::body Rappture::SidebarFrame::panel {which} {
289    switch -glob -- $which {
290        current {
291            return $itk_component($_selected)
292        }
293        [0-9]* {
294            set pname [lindex $_panels(all) $which]
295            return $itk_component($pname)
296        }
297        panel[0-9]* {
298            if {[info exists itk_component($which)]} {
299                return $itk_component($which)
300            }
301            error "bad panel name \"$which\""
302        }
303        default {
304            foreach pname $_panels(all) {
305                if {[string equal $_panels($pname-title) $which]} {
306                    return $itk_component($pname)
307                }
308            }
309            error "bad panel title \"$which\""
310        }
311    }
312}
313
314# ----------------------------------------------------------------------
315# USAGE: exists <which>
316#
317# Returns the frame representing the requested panel.  The <which>
318# argument can be a panel index, name, or title, or the keyword
319# "current" for the selected panel.
320# ----------------------------------------------------------------------
321itcl::body Rappture::SidebarFrame::exists { title } {
322    if { [info exists _title2panel($title)] } {
323        return 1
324    }
325    return 0
326}
327
328# ----------------------------------------------------------------------
329# USAGE: select <which>
330#
331# Pops open the sidebar and selects the specified panel.  The <which>
332# argument can be a panel index, name, or title.
333# ----------------------------------------------------------------------
334itcl::body Rappture::SidebarFrame::select {which} {
335    set pname ""
336    switch -glob -- $which {
337        [0-9]* {
338            set pname [lindex $_panels(all) $which]
339        }
340        panel[0-9]* {
341            if {[info exists itk_component($which)]} {
342                set pname $which
343            }
344        }
345        default {
346            foreach p $_panels(all) {
347                if {[string equal $_panels($p-title) $which]} {
348                    set pname $p
349                    break
350                }
351            }
352        }
353    }
354    if {$pname == ""} {
355        error "bad panel name \"$which\": should be panel id, title, or index"
356    }
357
358    if {$_state == "closed"} {
359        pop open
360    }
361
362    set minw [winfo reqwidth $itk_component(controlbar)]
363    if {$_width != "auto" && $_width < $minw+50} {
364        set _width [expr {$minw+50}]
365        $_dispatcher event -idle !layout
366    }
367    set n [$itk_component(tabs) index -name $pname]
368    $itk_component(tabs) select $n
369
370    $itk_component(title) configure -text $_panels($pname-title)
371
372    set f [$itk_component(area) contents]
373    foreach w [pack slaves $f] {
374        pack forget $w
375    }
376    pack $itk_component($pname) -expand yes -fill both
377
378    #
379    # HACK ALERT!  Force the scroller to check the size of the
380    # panel that we just slid in under the covers.  Make it
381    # think the panel and the scroller itself have changed size.
382    #
383    event generate [winfo parent $f] <Configure>
384    event generate $f <Configure>
385
386    set _selected $pname
387    return $pname
388}
389
390# ----------------------------------------------------------------------
391# USAGE: pop open|close|toggle
392#
393# Used to open/close the sidebar area.  When open, the selected panel
394# appears and the titlebar shows its name.
395# ----------------------------------------------------------------------
396itcl::body Rappture::SidebarFrame::pop {how} {
397    if {$how == "toggle"} {
398        if {$_state == "closed"} {
399            set how "open"
400        } else {
401            set how "close"
402        }
403    }
404
405    switch -- $how {
406        open {
407            $itk_component(popbutton) configure \
408                -image [Rappture::icon sbar-closed]
409            pack $itk_component(area) -side right -expand yes -fill both
410
411            set _state "open"
412            select $_selected
413            $_dispatcher event -idle !layout
414        }
415        close {
416            $itk_component(popbutton) configure \
417                -image [Rappture::icon sbar-open]
418            $itk_component(title) configure -text ""
419            pack forget $itk_component(area)
420
421            set _state "closed"
422            $_dispatcher event -idle !layout
423        }
424        default {
425            error "bad option \"$how\": should be open, close, toggle"
426        }
427    }
428}
429
430# ----------------------------------------------------------------------
431# USAGE: disable <which>
432#
433# Pops open the sidebar and selects the specified panel.  The <which>
434# argument can be a panel index, name, or title.
435# ----------------------------------------------------------------------
436itcl::body Rappture::SidebarFrame::disable {which} {
437    set index [TabIndex $which]
438    set tab [$itk_component(tabs) get $index]
439    $itk_component(tabs) tab configure $tab -state disabled
440}
441
442
443# ----------------------------------------------------------------------
444# USAGE: enable <which>
445#
446# Pops open the sidebar and selects the specified panel.  The <which>
447# argument can be a panel index, name, or title.
448# ----------------------------------------------------------------------
449itcl::body Rappture::SidebarFrame::enable {which} {
450    set index [TabIndex $which]
451    set tab [$itk_component(tabs) get $index]
452    $itk_component(tabs) tab configure $tab -state normal
453}
454
455# ----------------------------------------------------------------------
456# USAGE: TabIndex <which>
457#
458# Pops open the sidebar and selects the specified panel.  The <which>
459# argument can be a panel index, name, or title.
460# ----------------------------------------------------------------------
461itcl::body Rappture::SidebarFrame::TabIndex {which} {
462    set pname ""
463    switch -glob -- $which {
464        [0-9]* {
465            set pname [lindex $_panels(all) $which]
466        }
467        panel[0-9]* {
468            if {[info exists itk_component($which)]} {
469                set pname $which
470            }
471        }
472        default {
473            foreach p $_panels(all) {
474                if {[string equal $_panels($p-title) $which]} {
475                    set pname $p
476                    break
477                }
478            }
479        }
480    }
481    if {$pname == ""} {
482        error "bad panel name \"$which\": should be panel id, title, or index"
483    }
484    set n [$itk_component(tabs) index -name $pname]
485    return $n
486}
487
488# ----------------------------------------------------------------------
489# USAGE: _toggleTab <which>
490#
491# Invoked automatically when the user clicks on a tab for the sidebar.
492# If the sidebar is closed, it is automatically opened and the tab is
493# selected.  If the sidebar is opened, then it's closed.
494# ----------------------------------------------------------------------
495itcl::body Rappture::SidebarFrame::_toggleTab {which} {
496    if {$_state == "closed"} {
497        pop open
498        select $which
499    } elseif {[$itk_component(tabs) index -name $_selected]
500          == [$itk_component(tabs) index -name $which]} {
501        pop close
502    } else {
503        select $which
504    }
505}
506
507# ----------------------------------------------------------------------
508# USAGE: _sash <op> <X>
509#
510# Invoked automatically when the user clicks/drags on a sash, to resize
511# the sidebar.
512# ----------------------------------------------------------------------
513itcl::body Rappture::SidebarFrame::_sash {op X} {
514    switch -- $op {
515        enter {
516            # mouse over sash -- make it active
517            if {$itk_option(-sashactiverelief) != ""} {
518                $itk_component(sash) configure -relief $itk_option(-sashactiverelief)
519            }
520        }
521        leave {
522            # mouse left sash -- back to normal
523            $itk_component(sash) configure -relief $itk_option(-sashrelief)
524        }
525        grab {
526            if {$_state == "closed"} { pop open }
527            _sash drag $X
528        }
529        drag {
530            set w [winfo width $itk_component(hull)]
531            set minw [winfo reqwidth $itk_component(controlbar)]
532            set dx [expr {$X - [winfo rootx $itk_component(hull)]}]
533            set sashw [winfo reqwidth $itk_component(sashbg)]
534            set _width [expr {$w - $dx - $sashw/2}]
535
536            if {$_width < $minw} { set _width $minw }
537            if {$_width > $w-50} { set _width [expr {$w-50}] }
538            _fixLayout
539        }
540        release {
541            set minw [winfo reqwidth $itk_component(controlbar)]
542            if {$_width-$minw < 40} {
543                set _width "auto"
544                pop close
545            }
546        }
547        default {
548            error "bad option \"$op\": should be enter, leave, grab, drag, release"
549        }
550    }
551}
552
553# ----------------------------------------------------------------------
554# USAGE: _fixLayout ?<eventArgs>...?
555#
556# Used internally to update the layout of panes whenever a new pane
557# is added or a sash is moved.
558# ----------------------------------------------------------------------
559itcl::body Rappture::SidebarFrame::_fixLayout {args} {
560    set w [winfo width $itk_component(hull)]
561    set h [winfo height $itk_component(hull)]
562
563    set sashw [winfo reqwidth $itk_component(sashbg)]
564
565    set tabw [winfo reqwidth $itk_component(tabs)]
566    set btnw [winfo reqwidth $itk_component(controls)]
567    set ctrlw [expr {($tabw > $btnw) ? $tabw : $btnw}]
568
569    if {$_state == "closed"} {
570        set sbarw $ctrlw
571    } else {
572        if {$_width == "auto"} {
573            # pop open to the size of the widest pane
574            set sbarw 0
575            foreach pname $_panels(all) {
576                set pw [winfo reqwidth $itk_component($pname)]
577                if {$pw > $sbarw} {
578                    set sbarw $pw
579                }
580            }
581            set sbarw [expr {$sbarw + $ctrlw + $sashw}]
582        } else {
583            set sbarw $_width
584        }
585    }
586
587    # don't let the sidebar take up too much of the window area
588    if {$sbarw > 0.75*$w} {
589        set sbarw [expr {int(0.75*$w)}]
590    }
591
592    set x1 [expr {$w - $sbarw - $sashw}]
593    set x2 [expr {$w - $sbarw}]
594    if { $resizeframe } {
595        set framew $x1
596    } else {
597        set framew [expr $w - $ctrlw - $sashw]
598    }
599    place $itk_component(frame) -x 0 -y 0 -anchor nw -width $framew -height $h
600    place $itk_component(sashbg) -x $x1 -y 0 -anchor nw -width $sashw -height $h
601    place $itk_component(sidebar) -x $x2 -y 0 -anchor nw \
602        -width $sbarw -height $h
603}
604
605# ----------------------------------------------------------------------
606# CONFIGURATION OPTION: -sashpadding
607# ----------------------------------------------------------------------
608itcl::configbody Rappture::SidebarFrame::sashpadding {
609    pack $itk_component(sash) -padx $itk_option(-sashpadding)
610}
611
612# ----------------------------------------------------------------------
613# CONFIGURATION OPTION: -sashcolor
614# ----------------------------------------------------------------------
615itcl::configbody Rappture::SidebarFrame::sashcolor {
616    if {$itk_option(-sashcolor) != ""} {
617        $itk_component(sash) configure -background $itk_option(-sashcolor)
618    } else {
619        $itk_component(sash) configure -background $itk_option(-background)
620    }
621}
622
Note: See TracBrowser for help on using the repository browser.