1 # scrolled-ui.tcl --
2 #
3 # FIXME: This file needs a description here.
4 #
5 # Copyright (c) 1998-2002 The Regents of the University of California.
6 # All rights reserved.
7 #
8 # Redistribution and use in source and binary forms, with or without
9 # modification, are permitted provided that the following conditions are met:
10 #
11 # A. Redistributions of source code must retain the above copyright notice,
12 # this list of conditions and the following disclaimer.
13 # B. Redistributions in binary form must reproduce the above copyright notice,
14 # this list of conditions and the following disclaimer in the documentation
15 # and/or other materials provided with the distribution.
16 # C. Neither the names of the copyright holders nor the names of its
17 # contributors may be used to endorse or promote products derived from this
18 # software without specific prior written permission.
19 #
20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
23 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
30 #
31 # @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/mplug/scrolled-ui.tcl,v 1.5 2002/02/03 04:27:54 lim Exp $
32
33
34 import ScrolledWindow Icons
35
36 Class ScrolledUI
37
38
39 ScrolledUI instproc init { {w {}} } {
40 $self next
41 $self instvar main_
42
43 if { $w=={} } {
44 set main_ .main
45 } else {
46 set main_ $w
47 }
48
49 #option add *ScrolledWindow*Scrollbar.borderWidth 1
50 #option add *ScrolledWindow*Scrollbar.highlightThickness 0
51 #option add *ScrolledWindow*Scrollbar.width 10
52
53 set main_ [ScrolledWindow $main_ -scrollbar both -options \
54 {{hscroll.borderwidth 1} \
55 {hscroll.highlightthickness 0} \
56 {hscroll.width 10} \
57 {vscroll.borderwidth 1} \
58 {vscroll.highlightthickness 0} \
59 {vscroll.width 10}} ]
60 set logo_frame [frame $main_.logo_frame]
61 set logo [button $main_.logo -image Icons(cal) -padx 4 -pady 0 -bd 0 \
62 -highlightthickness 0 -activebackground \
63 [WidgetClass widget_default -background]]
64
65 #
66 # FIXME: I'm using some of my knowledge of the internals of the
67 # ScrolledWindow object to get the following to work
68 #
69 set hscroll [$main_ subwidget hscroll]
70 foreach entry [$hscroll configure] {
71 if { [llength $entry]==5 } {
72 lappend config [lindex $entry 0] [lindex $entry 4]
73 }
74 }
75
76 set pack [pack info $hscroll]
77
78 # must destroy and recreate the scrollbar, since it should be
79 # created after the logo_frame
80
81 $main_ subwidget bbox configure -xscrollcommand ""
82 destroy $hscroll
83 eval scrollbar $hscroll $config
84 $main_ subwidget bbox configure -xscrollcommand "$hscroll set"
85
86 pack $hscroll -side left -fill both -expand 1 -in $logo_frame -anchor s
87 pack $logo -side right -fill y -in $logo_frame
88 eval pack $logo_frame $pack
89
90 pack $main_ -fill both -expand 1
91 }
92
93
94 ScrolledUI instproc root { } {
95 $self instvar main_
96 return [$main_ subwidget window]
97 }
98
99
100 Class MPlug/ScrolledUI -superclass { MPlug ScrolledUI }
101
102
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.