1 # ui-minimize.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/applications/collaborator/ui-minimize.tcl,v 1.4 2002/02/03 04:21:46 lim Exp $
32
33
34 import WidgetClass
35
36
37 Class UIMinimize
38 WidgetClass UIMinimizeSimpleFrame
39 WidgetClass UIMinimizeFrame
40
41
42 UIMinimize public init { minimize_path } {
43 $self next
44 $self set minimize_path_ $minimize_path
45 }
46
47
48 UIMinimize public create_frame { path tip { minimize_image horizontal } \
49 { restore_image vertical } \
50 { pack {-fill both -expand 1 -side bottom} } \
51 { pack_tab {-side top -anchor nw} } \
52 { pack_minimize {-side bottom -anchor s} } } {
53
54 $self instvar minimize_path_
55 set frame [UIMinimizeFrame ${path}_encloser]
56 $frame really_build_widget $path $tip $minimize_path_ $minimize_image \
57 $restore_image $pack $pack_tab $pack_minimize
58 return $frame
59 }
60
61
62 UIMinimizeSimpleFrame public build_widget { path } {
63 set f [frame $path.dummy]
64 pack $f
65 }
66
67
68 UIMinimizeSimpleFrame public should_check { w } {
69 if [catch {set cl [$w cget -class]}] { return 0 }
70 if { $cl == "UIMinimizeSimpleFrame" } { return 1 }
71 if { [WidgetClass info instances $cl] != $cl } { return 0 }
72 if { [$cl info heritage UIMinimizeSimpleFrame] != {} } { return 1 }
73 return 0
74 }
75
76
77 UIMinimizeSimpleFrame public pack { path args } {
78 $self instvar pack_
79 set w [$self info path]
80 if { [string index $path 0] == "." } {
81 eval pack $path $args -in $w
82 } else { eval pack $path $args }
83
84 set slaves [pack slaves $w]
85 if { [llength $slaves] <= 1 } {
86 set flag 1
87 } else {
88 set flag 1
89 foreach s $slaves {
90 if [string match "*dummy" $s] continue
91 if { ![$self should_check $s] || \
92 [llength [pack slaves $s]] > 1 } {
93 puts "flag was set to 0 for $s ($self)"
94 set flag 0
95 break
96 }
97 }
98 }
99
100 if $flag {
101 puts "flag was set to 1 ($self)"
102 set p [pack info $w]
103 set fill [lsearch $p "-fill"]
104 set expand [lsearch $p "-expand"]
105 set pack_(encloser) "-fill [lindex $p [expr $fill + 1]] \
106 -expand [lindex $p [expr $expand + 1]]"
107 pack configure $w -fill none -expand 0
108 } elseif [info exists pack_(encloser)] {
109 eval pack configure $w $pack_(encloser)
110 }
111 }
112
113
114 UIMinimizeFrame public really_build_widget { path tip minimize_path \
115 minimize_image restore_image pack pack_tab pack_minimize } {
116 $self instvar widget_ minimize_ restore_ pack_ tip_
117 set tip_ $tip
118 set widget_(main) $path
119 set widget_(minimize) $minimize_path
120 set minimize_ $minimize_image
121 set restore_ $restore_image
122 set pack_(main) $pack
123 set pack_(tab) $pack_tab
124 set pack_(minimize) $pack_minimize
125
126 set w [$self info path]
127 raise $path $w
128 set b ${path}_minimize
129 set widget_(tab) $b
130 button $b -bd 1 -highlightthickness 0 \
131 -image CollaboratorIcons($minimize_image) -command \
132 [list $self minimize] -bg \#c0c0c0 \
133 -activebackground \#c0c0c0
134 bind $b <Enter> "$b configure -bg \#9898f8 -activebackground \#9898f8 \
135 -image CollaboratorIcons(${minimize_}_sel)"
136 bind $b <Leave> "$b configure -bg \#c0c0c0 -activebackground \#c0c0c0 \
137 -image CollaboratorIcons(${minimize_})"
138
139 set f [frame $w.dummy]
140 pack $f
141
142 eval pack $b $pack_(tab) -in $w
143 eval pack $path $pack_(main) -in $w
144 }
145
146
147 UIMinimizeFrame private minimize { } {
148 $self instvar widget_ minimize_ restore_ pack_ tip_
149 pack forget $widget_(main)
150 pack forget $widget_(tab)
151
152 set b $widget_(tab)
153 $b configure -image CollaboratorIcons($restore_) -command \
154 "$self restore" -tip $tip_
155 bind $b <Enter> "$b configure -bg \#9898f8 -activebackground \#9898f8 \
156 -image CollaboratorIcons(${restore_}_sel)"
157 bind $b <Leave> "$b configure -bg \#c0c0c0 -activebackground \#c0c0c0 \
158 -image CollaboratorIcons(${restore_})"
159 eval pack $widget_(tab) $pack_(minimize) -in $widget_(minimize)
160
161 set w [$self info path]
162 set p [pack info $w]
163 set fill [lsearch $p "-fill"]
164 set expand [lsearch $p "-expand"]
165 set pack_(encloser) "-fill [lindex $p [expr $fill + 1]] \
166 -expand [lindex $p [expr $expand + 1]]"
167 pack configure $w -fill none -expand 0
168
169 $self instvar callback_
170 if { [info exists callback_] && $callback_!={} } {
171 eval $callback_ minimize
172 }
173 }
174
175
176 UIMinimizeFrame private restore { } {
177 $self instvar widget_ minimize_ restore_ pack_ tip_
178 pack forget $widget_(tab)
179
180 set b $widget_(tab)
181 $b configure -image CollaboratorIcons($minimize_) -command \
182 "$self minimize" -tip {}
183 bind $b <Enter> "$b configure -bg \#9898f8 -activebackground \#9898f8 \
184 -image CollaboratorIcons(${minimize_}_sel)"
185 bind $b <Leave> "$b configure -bg \#c0c0c0 -activebackground \#c0c0c0 \
186 -image CollaboratorIcons(${minimize_})"
187
188 set w [$self info path]
189 eval pack $b $pack_(tab) -in $w
190 eval pack $widget_(main) $pack_(main) -in $w
191 eval pack configure $w $pack_(encloser)
192
193 $self instvar callback_
194 if { [info exists callback_] && $callback_!={} } {
195 eval $callback_ restore
196 }
197 }
198
199
200 UIMinimizeFrame public callback { c } {
201 $self set callback_ $c
202 }
203
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.