summaryrefslogtreecommitdiff
path: root/xc/programs/Xserver/hw/xfree86/XF86Setup/keyboard.tcl
blob: 4b9ca2423d435fffcda75d21cd4c880b61f75f5d (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
# $XFree86: xc/programs/Xserver/hw/xfree86/XF86Setup/keyboard.tcl,v 3.12 1999/04/05 07:12:59 dawes Exp $
#
# Copyright 1996 by Joseph V. Moss <joe@XFree86.Org>
#
# See the file "LICENSE" for information regarding redistribution terms,
# and for a DISCLAIMER OF ALL WARRANTIES.
#
# $XConsortium: keyboard.tcl /main/2 1996/10/25 10:21:16 kaleb $

#
# Keyboard configuration routines
#

proc Keyboard_create_widgets { win } {
	global XKBComponents XKBavailable XKBhandle
	global pc98 messages

	set w [winpathprefix $win]
        if !$pc98 {
	    frame $w.keyboard -width 640 -height 420 \
		    -relief ridge -borderwidth 5
	} else {
	    frame $w.keyboard -width 640 -height 400 \
		    -relief ridge -borderwidth 5
	}

	frame $w.keyboard.xkb
	label $w.keyboard.xkb.text -text $messages(keyboard.4)
	frame $w.keyboard.xkb.geom
	label $w.keyboard.xkb.geom.title -text $messages(keyboard.1)
	combobox $w.keyboard.xkb.geom.cbox -bd 2 -width 30
	eval [list $w.keyboard.xkb.geom.cbox linsert end] \
		$XKBComponents(models,descriptions)
	pack  $w.keyboard.xkb.geom.title $w.keyboard.xkb.geom.cbox -side top
	frame $w.keyboard.xkb.lang
	label $w.keyboard.xkb.lang.title -text $messages(keyboard.2)
	combobox $w.keyboard.xkb.lang.cbox -bd 2 -width 30
	eval [list $w.keyboard.xkb.lang.cbox linsert end] \
		$XKBComponents(layouts,descriptions)
	pack  $w.keyboard.xkb.lang.title $w.keyboard.xkb.lang.cbox -side top
	frame $w.keyboard.xkb.vari
	label $w.keyboard.xkb.vari.title -text $messages(keyboard.6)
	combobox $w.keyboard.xkb.vari.cbox -bd 2 -width 30
	$w.keyboard.xkb.vari.cbox linsert end "<None>"
	eval [list $w.keyboard.xkb.vari.cbox linsert end] \
		$XKBComponents(variants,descriptions)
	pack  $w.keyboard.xkb.vari.title $w.keyboard.xkb.vari.cbox -side top
	pack $w.keyboard.xkb.text -side top -expand yes -fill both -padx 6m
	pack $w.keyboard.xkb.geom -side top -expand yes -fill both -padx 6m
	pack $w.keyboard.xkb.lang -side top -expand yes -fill both -padx 6m
	pack $w.keyboard.xkb.vari -side top -expand yes -fill both -padx 6m
	if { $XKBavailable } {
	    bind $w.keyboard.xkb.geom.cbox.popup.list <ButtonRelease-1> \
		"+Keyboard_loadsettings $win noload"
	    bind $w.keyboard.xkb.geom.cbox.popup <Return> \
		"+Keyboard_loadsettings $win noload"
	    bind $w.keyboard.xkb.lang.cbox.popup.list <ButtonRelease-1> \
		"+Keyboard_loadsettings $win noload"
	    bind $w.keyboard.xkb.lang.cbox.popup <Return> \
		"+Keyboard_loadsettings $win noload"
	    xkbview $w.keyboard.xkb.graphic -height 100 -kbd $XKBhandle \
		-dbl 1 -bd 6 -relief ridge
	} else {
	    frame $w.keyboard.xkb.graphic
	}
	pack $w.keyboard.xkb.graphic  -side top -expand yes -fill x
	if { $XKBavailable } {
	    button $w.keyboard.xkb.apply -text $messages(keyboard.3) \
		-command "Keyboard_loadsettings $win load"
	    pack $w.keyboard.xkb.apply -side top -expand yes -fill both
	}
	label $w.keyboard.xkb.message -text "" -foreground black
	pack $w.keyboard.xkb.message  -side top -expand yes -fill x

	frame $w.keyboard.options -relief groove -bd 4
	Keyboard_create_options_widgets $win
	pack $w.keyboard.xkb -side left -fill both -expand yes -pady 10m
	pack $w.keyboard.options -side left -fill both -expand no
	Keyboard_initsettings $win
}

proc Keyboard_create_options_widgets { win } {
	global XKBComponents keyboardXkbOpts messages

	set w [winpathprefix $win]
	set numopts [llength $XKBComponents(options,names)]
	if { $numopts == 0 } {
		set keyboardXkbOpts(noopts) -1
		return
	}

	label $w.keyboard.options.title -text $messages(keyboard.5)
	pack  $w.keyboard.options.title -fill x \
		-expand no -pady 3m -side top
	frame $w.keyboard.options.line -relief sunken -height 2 -bd 3
	pack  $w.keyboard.options.line -fill x \
		-expand no -pady 3m -side top

	set canv $w.keyboard.options.canvas
	canvas $canv
	frame $canv.list
	set id [$canv create window 0 0 -window $canv.list -anchor nw]
	for {set idx 0} { $idx < $numopts } {incr idx} {
		set name [lindex $XKBComponents(options,names) $idx]
		set desc [lindex $XKBComponents(options,descriptions) $idx]
		set tmp [split $name :]
		set value $idx
		if { [llength $tmp] != 2 } {
		    set next ""
		    if { [expr $idx+1] < $numopts } {
			set next [lindex $XKBComponents(options,names) \
					[expr $idx+1] ]
		    }
		    if { [string match $name:* $next] } {
			label $canv.list.$name -text $desc \
				-relief ridge -bd 3
			pack $canv.list.$name -fill both -expand no
			set tmp [list $name default]
			set value -1
			set desc $messages(keyboard.7)
			set keyboardXkbOpts($name) -1
		    } else {
			checkbutton $canv.list.$name \
				-variable keyboardXkbOpts($name) \
				-text $desc -highlightthickness 1 \
				-offvalue -1 -onvalue $idx -anchor w \
				-relief sunken -bd 1
			pack $canv.list.$name -fill both -expand no
			set keyboardXkbOpts($name) -1
		        continue
		    }
		}
		set group  [lindex $tmp 0]
		set option [lindex $tmp 1]
		radiobutton $canv.list.$group-$option \
			-variable keyboardXkbOpts($group) -value $value \
			-text $desc -highlightthickness 1 -anchor w
		pack $canv.list.$group-$option -fill both -expand no -padx 3
	}
	update idletasks
	pack $canv -fill y -expand no -side left
	scrollbar $w.keyboard.options.sb -command "$canv yview" -relief sunken
	set bbox [$canv bbox $id]
	$canv configure -yscrollcommand "$w.keyboard.options.sb set" \
		-scrollregion $bbox -width [lindex $bbox 2]
	if { [winfo reqheight $canv.list] > [winfo height $w]*.7 } {
		pack $w.keyboard.options.sb -side left -fill y -expand yes
	}
}

proc Keyboard_initsettings { win } {
	global Keyboard XKBComponents keyboardXkbOpts

	set w [winpathprefix $win]
	set model	$Keyboard(XkbModel)
	set layout	$Keyboard(XkbLayout)
	set variant	$Keyboard(XkbVariant)
	set options	$Keyboard(XkbOptions)

	set tmp [xkb_getrulesprop]
	if { [llength $tmp] == 5 } {
		set model	[lindex $tmp 1]
		set layout	[lindex $tmp 2]
		set variant	[lindex $tmp 3]
		set options	[lindex $tmp 4]
	}
	set geomidx [lsearch -exact $XKBComponents(models,names) $model]
	if { $geomidx == -1 } {set geomidx 0}
	set langidx [lsearch -exact $XKBComponents(layouts,names) $layout]
	if { $langidx == -1 } {set langidx 0}
	set variidx [lsearch -exact $XKBComponents(variants,names) $variant]
	incr variidx

	$w.keyboard.xkb.geom.cbox einsert 0 \
		[lindex $XKBComponents(models,descriptions) $geomidx]
	$w.keyboard.xkb.lang.cbox einsert 0 \
		[lindex $XKBComponents(layouts,descriptions) $langidx]
	if { $variidx } {
	    $w.keyboard.xkb.vari.cbox einsert 0 \
		[lindex $XKBComponents(variants,descriptions) $variidx]
	}
	$w.keyboard.xkb.geom.cbox econfig -state disabled
	$w.keyboard.xkb.lang.cbox econfig -state disabled
	$w.keyboard.xkb.vari.cbox econfig -state disabled
	$w.keyboard.xkb.geom.cbox lselection set $geomidx
	$w.keyboard.xkb.lang.cbox lselection set $langidx
	$w.keyboard.xkb.vari.cbox lselection set $variidx
	$w.keyboard.xkb.geom.cbox activate $geomidx
	$w.keyboard.xkb.lang.cbox activate $langidx
	$w.keyboard.xkb.vari.cbox activate $variidx
	$w.keyboard.xkb.geom.cbox see $geomidx
	$w.keyboard.xkb.lang.cbox see $langidx
	$w.keyboard.xkb.vari.cbox see $variidx

	set optlist [split $options ,]
	set namelist $XKBComponents(options,names)
	set cl $w.keyboard.options.canvas.list
	foreach opt $optlist {
		set tmp [split $opt :]
		set idx [lsearch -exact $namelist $opt]
		if { [llength $tmp] != 2 } {
			if { [winfo exists $cl.$opt-default] } {
				set keyboardXkbOpts($opt) -1
			} else {
				set keyboardXkbOpts($opt) $idx
			}
		} else {
			set keyboardXkbOpts([lindex $tmp 0]) $idx
		}
	}
}

proc Keyboard_activate { win } {
	set w [winpathprefix $win]
	pack $w.keyboard -side top -fill both -expand yes
}

proc Keyboard_deactivate { win } {
	set w [winpathprefix $win]
	pack forget $w.keyboard
	Keyboard_loadsettings $win setvars
}

proc Keyboard_loadsettings { win loadflag } {
	global XKBComponents XKBrules Keyboard XKBhandle keyboardXkbOpts
	global messages

	set w [winpathprefix $win]
	if { $loadflag == "load" } {
		$w.keyboard.xkb.message configure \
			-text $messages(keyboard.9)
	}
	if { $loadflag == "noload" } {
		$w.keyboard.xkb.message configure \
			-text $messages(keyboard.10)
	}
	update
	set geom_idx [$w.keyboard.xkb.geom.cbox curselection]
	set lang_idx [$w.keyboard.xkb.lang.cbox curselection]
	set vari_idx [$w.keyboard.xkb.vari.cbox curselection]
	incr vari_idx -1
	set geom [lindex $XKBComponents(models,names)  $geom_idx]
	set lang [lindex $XKBComponents(layouts,names) $lang_idx]
	if { $vari_idx == -1 } {
		set vari ""
	} else {
		set vari [lindex $XKBComponents(variants,names) $vari_idx]
	}
	set opts ""
	foreach key [array names keyboardXkbOpts] {
		if { $keyboardXkbOpts($key) == -1 } continue
		set opt [lindex $XKBComponents(options,names) \
					$keyboardXkbOpts($key)]
		if { ![string length $opts] } {
			set opts $opt
		} else {
			append opts ",$opt"
		}
	}

	if { $loadflag != "setvars" } {
		set comp [xkb_resolvecomponents \
			$XKBrules $geom $lang $vari $opts]
		set notloaded [catch {eval xkb_load $comp $loadflag} kbd]
		if { $notloaded } {
			$w.keyboard.xkb.message configure \
				-text $messages(keyboard.8)
			bell
			after 1000
		} else {
			xkb_free $XKBhandle
			set XKBhandle $kbd
			$w.keyboard.xkb.graphic configure -kbd $kbd
			if { $loadflag != "noload" } {
				xkb_setrulesprop $XKBrules \
					$geom $lang $vari $opts
				set Keyboard(XkbModel)		$geom
				set Keyboard(XkbLayout)		$lang
				set Keyboard(XkbVariant)	$vari
				set Keyboard(XkbOptions)	$opts
			}
		}
	} else {
		set Keyboard(XkbModel)		$geom
		set Keyboard(XkbLayout)		$lang
		set Keyboard(XkbVariant)	$vari
		set Keyboard(XkbOptions)	$opts
	}
	focus $w
	$w.keyboard.xkb.message configure -text ""
}