1 # ui-props.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/mbv2/ui-props.tcl,v 1.9 2002/02/03 04:21:59 lim Exp $
32
33
34 import Dialog/SelectFont
35
36
37 Class MBv2Properties
38
39 MBv2Properties public init { path } {
40 $self next
41
42 $self instvar props_ path_
43 set path_ $path
44 set props_(color,all) "/custom White Black Red Orange Yellow Green \
45 Blue Magenta Violet"
46 set props_(fill,all) "/custom /none White Black Red Orange Yellow \
47 Green Blue Magenta Violet"
48
49 set props_(justify,all) "{-image MbIcons(left)} \
50 {-image MbIcons(center)} {-image MbIcons(right)}"
51 set props_(width,all) "1 2 3 4 5 6 7 8 9 10"
52 set props_(arrow_type,all) [list "at the end" "beginning" "both ends"\
53 "none"]
54 set {props_(arrow_type,map,at the end)} last
55 set {props_(arrow_type,map,beginning)} first
56 set {props_(arrow_type,map,both ends)} both
57 set {props_(arrow_type,map,none)} none
58
59 $self build_toolbar $path
60 }
61
62
63 MBv2Properties public build_toolbar { path } {
64 $self instvar props_
65 $self tkvar outline_ fill_ justify_ font_ width_ arrow_
66 set abg [WidgetClass widget_default -background]
67 set o [list [list button.font {Helvetica 8}] \
68 [list button.activebackground $abg] ]
69
70 set outline_ Black
71 set fill_ /none
72 set justify_ {-image MbIcons(left)}
73 set font_ {Helvetica -18 bold}
74 set width_ 4
75 set arrow_ "at the end"
76 DropDown/Color $path.color -label {-image MbIcons(color)} -options $o \
77 -variable [$self tkvarname outline_]
78 TipManager tip $path.color "Outline\ncolor"
79 DropDown/Color $path.fill -label {-image MbIcons(fill)} -options $o \
80 -variable [$self tkvarname fill_]
81 TipManager tip $path.fill "Fill\ncolor"
82 DropDown $path.justify -label \
83 {-text justify -font {Helvetica 8} -anchor n -pady 1} \
84 -options $o -variable [$self tkvarname justify_]
85 TipManager tip $path.justify "Text\nJustification"
86 ImageTextButton $path.font -image MbIcons(font) -text "font" \
87 -style textimage \
88 -font {Helvetica 8} -highlightthickness 0 -options \
89 [list [list image.activebackground $abg] \
90 [list text.activebackground $abg]] -orient vertical \
91 -command "set [$self tkvarname font_]\
92 \[$path.font.dialog invoke $path.font\]"
93 TipManager tip $path.font "Text\nfont"
94 Dialog/SelectFont $path.font.dialog
95 $path.font.dialog size_in_pixels 1 1
96 $path.font.dialog configure -font $font_
97
98 DropDown $path.width -label {-image MbIcons(width)} -options $o \
99 -variable [$self tkvarname width_]
100 TipManager tip $path.width "Line\nthickness"
101 DropDown $path.arrow_type -label {-image MbIcons(arrow_type)} \
102 -options $o -variable [$self tkvarname arrow_]
103 TipManager tip $path.arrow_type "Arrow\ntype"
104
105 foreach elem [list color fill justify width arrow_type] {
106 foreach e $props_($elem,all) {
107 $path.$elem insert end $e
108 }
109 }
110
111 pack $path.color $path.fill $path.justify $path.font $path.width \
112 $path.arrow_type -side left -padx 1 -fill y
113 }
114
115
116 MBv2Properties public enable_session { f } {
117 $self instvar path_
118 if $f { set state normal } else { set state disabled }
119 foreach elem [list color fill font width arrow_type] {
120 $path_.$elem configure -state $state
121 }
122 }
123
124
125 MBv2Properties public outline { } {
126 $self tkvar outline_
127 return $outline_
128 }
129
130
131 MBv2Properties public fill { } {
132 $self tkvar fill_
133 if { $fill_ == "/none" } { return "none" } else { return $fill_ }
134 }
135
136
137 MBv2Properties public justify { } {
138 $self tkvar justify_
139 set j left
140 regexp {\(([^\)]*)\)} [lindex $justify_ 1] dummy j
141 return $j
142 }
143
144
145 MBv2Properties public font { } {
146 $self tkvar font_
147 return $font_
148 }
149
150
151 MBv2Properties public width { } {
152 $self tkvar width_
153 return $width_
154 }
155
156
157 MBv2Properties public arrow { } {
158 $self tkvar arrow_
159 $self instvar props_
160 return $props_(arrow_type,map,$arrow_)
161 }
162
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.