1# $Id$
2
3##########################################################################
4auto_load Button
5rename Button::create Button::create_old
6
7proc Button::create {path args} {
8
9    set new_args {}
10    foreach {attr val} $args {
11        switch -- $attr {
12            -background { }
13            default { lappend new_args $attr $val }
14        }
15    }
16
17    eval [list Button::create_old $path] $new_args
18}
19
20##########################################################################
21rename menu menu_old
22
23proc menu {path args} {
24
25    set new_args {}
26    foreach {attr val} $args {
27        switch -- $attr {
28            -background { }
29            default { lappend new_args $attr $val }
30        }
31    }
32
33    eval [list menu_old $path] $new_args
34}
35
36##########################################################################
37if {[info tclversion] >= 8.4} {
38
39    rename frame frame_old
40
41    proc frame {path args} {
42
43	set new_args {}
44	foreach {attr val} $args {
45	    switch -- $attr {
46		-class {
47		    lappend new_args $attr $val
48		    if {$val == "Tree"} {
49			lappend new_args -padx 0
50		    }
51		}
52		default { lappend new_args $attr $val }
53	    }
54	}
55
56	eval [list frame_old $path] $new_args
57    }
58}
59
60##########################################################################
61auto_load Tree
62
63proc Tree::_see {path idn {side "none"}} {
64    set bbox [$path.c bbox $idn]
65    set scrl [$path.c cget -scrollregion]
66
67    set ymax [lindex $scrl 3]
68    set dy   [$path.c cget -yscrollincrement]
69    set yv   [$path yview]
70    set yv0  [expr {round([lindex $yv 0]*$ymax/$dy)}]
71    set yv1  [expr {int([lindex $yv 1]*$ymax/$dy + 0.1)}]
72    set y    [expr {int([lindex [$path.c coords $idn] 1]/$dy)}]
73    if { $y < $yv0 } {
74        $path.c yview scroll [expr {$y-$yv0}] units
75    } elseif { $y >= $yv1 } {
76        $path.c yview scroll [expr {$y-$yv1+1}] units
77    }
78
79    set xmax [lindex $scrl 2]
80    set dx   [$path.c cget -xscrollincrement]
81    set xv   [$path xview]
82    if { ![string compare $side "none"] } {
83	set x0   [expr {int([lindex $bbox 0]/$dx)}]
84	set xv0  [expr {round([lindex $xv 0]*$xmax/$dx)}]
85	set xv1  [expr {round([lindex $xv 1]*$xmax/$dx)}]
86	if { $x0 >= $xv1 || $x0 < $xv0 } {
87	    $path.c xview scroll [expr {$x0-$xv0}] units
88	}
89    } elseif { ![string compare $side "right"] } {
90        set xv1 [expr {round([lindex $xv 1]*$xmax/$dx)}]
91        set x1  [expr {int([lindex $bbox 2]/$dx)}]
92        if { $x1 >= $xv1 } {
93            $path.c xview scroll [expr {$x1-$xv1+1}] units
94        }
95    } else {
96        set xv0 [expr {round([lindex $xv 0]*$xmax/$dx)}]
97        set x0  [expr {int([lindex $bbox 0]/$dx)}]
98        if { $x0 < $xv0 } {
99            $path.c xview scroll [expr {$x0-$xv0}] units
100        }
101    }
102}
103
104rename Tree::create Tree::create:old
105
106proc Tree::create {path args} {
107    eval [list Tree::create:old $path] $args
108
109    set deltax 0
110    set deltay 0
111    foreach {key val} $args {
112	switch -- $key {
113	    -deltax { set deltax 1 }
114	    -deltay { set deltay 1 }
115	}
116    }
117
118    if {!$deltax} {
119	$path configure -deltax [font measure $::ChatFont M]
120    }
121
122    if {!$deltay} {
123	$path configure -deltay [font metrics $::ChatFont -linespace]
124    }
125
126    Tree::bindText  $path <Control-Button-1> [list $path selection set]
127    Tree::bindImage $path <Control-Button-1> [list $path selection set]
128
129    return $path
130}
131
132##########################################################################
133if {0 && [info tclversion] >= 8.5} {
134
135    proc PanedWin {path args} {
136	set newargs [list -showhandle 0]
137	set pad 0
138	foreach {key val} $args {
139	    switch -- $key {
140		-side {
141		    switch -- $val {
142			left -
143			right {
144			    lappend newargs -orient vertical
145			}
146			top -
147			bottom {
148			    lappend newargs -orient horizontal
149			}
150		    }
151		}
152		-pad {
153		    set pad [expr {$pad + $val}]
154		}
155		-width {
156		    set pad [expr {$pad + ($val >> 2)}]
157		}
158	    }
159	}
160
161	if {$pad > 0} {
162	    lappend newargs -sashpad $pad
163	}
164
165	return [eval [list panedwindow $path] $newargs]
166    }
167
168    proc PanedWinAdd {path args} {
169	set newargs {}
170	foreach {key val} $args {
171	    switch -- $key {
172		-minsize {
173		    lappend newargs -minsize $val
174		}
175		-weight {
176		    if {$val == 0} {
177			lappend newargs -stretch never
178		    } else {
179			lappend newargs -stretch always
180		    }
181		}
182	    }
183	}
184	set idx [llength [$path panes]]
185	set f [frame $path.frame$idx]
186	eval [list $path add $f] $newargs
187	return $f
188    }
189
190    proc PanedWinConf {path index args} {
191	lassign $args key val
192	set f [lindex [$path panes] $index]
193	switch -- [llength $args] {
194	    1 {
195		switch -- $key {
196		    -width {
197			return [$path panecget $f -width]
198		    }
199		    default {
200			return -code error "PanedWinConf: Unknown option $key"
201		    }
202		}
203	    }
204	    2 {
205		switch -- $key {
206		    -width {
207			puts "$index $f $val"
208			$path paneconfigure $f -width $val
209		    }
210		    default {
211			return -code error "PanedWinConf: Unknown option $key"
212		    }
213		}
214	    }
215	    default {
216		return -code error "PanedWinConf: Illegal number of arguments"
217	    }
218	}
219    }
220
221} else {
222
223    proc PanedWin {path args} {
224	if {[catch {
225		 eval [list PanedWindow $path] $args -activator line
226	     } res]} {
227	    return [eval [list PanedWindow $path] $args]
228	} else {
229	    return $res
230	}
231    }
232
233    proc PanedWinAdd {path args} {
234	set res [eval [list $path add] $args]
235	catch {
236	    set activator [Widget::getoption $path -activator]
237	    if {$activator == ""} {
238		if { $::tcl_platform(platform) != "windows" } {
239		    set activator button
240		} else {
241		    set activator line
242		}
243	    }
244
245	    if {$activator == "line"} {
246		set side [Widget::getoption $path -side]
247		set num $PanedWindow::_panedw($path,nbpanes)
248		incr num -1
249		if {$num > 0} {
250		    $path.sash$num.sep configure -relief flat
251		    if {$side == "top" || $side == "bottom"} {
252			place configure $path.sash$num.sep -width 4
253		    } else {
254			place configure $path.sash$num.sep -height 4
255		    }
256		}
257	    }
258	}
259	return $res
260    }
261
262    proc PanedWinConf {path index args} {
263	lassign $args key val
264	set f [winfo parent [$path getframe $index]]
265	switch -- [llength $args] {
266	    1 {
267		switch -- $key {
268		    -width {
269			return [$f cget -width]
270		    }
271		    default {
272			return -code error "PanedWinConf: Unknown option $key"
273		    }
274		}
275	    }
276	    2 {
277		switch -- $key {
278		    -width {
279			$f configure -width $val
280		    }
281		    default {
282			return -code error "PanedWinConf: Unknown option $key"
283		    }
284		}
285	    }
286	    default {
287		return -code error "PanedWinConf: Illegal number of arguments"
288	    }
289	}
290    }
291
292}
293
294##########################################################################
295auto_load ComboBox
296
297option add *ComboBox.listRelief ridge widgetDefault
298option add *ComboBox.listBorder 2 widgetDefault
299
300rename ComboBox::_create_popup ComboBox::_create_popup_old
301
302proc ComboBox::_create_popup {path args} {
303
304    eval [list ComboBox::_create_popup_old $path] $args
305    $path.shell configure \
306	    -relief [option get $path listRelief ComboBox] \
307	    -border [option get $path listBorder ComboBox]
308}
309
310rename ComboBox::create ComboBox::create_old
311
312proc ComboBox::create {path args} {
313    set hlthick $::tk_highlightthickness
314    foreach {opt arg} $args {
315	if {[cequal $opt "-highlightthickness"]} {
316	    set hlthick $arg
317	}
318    }
319    eval [list ComboBox::create_old $path] $args -highlightthickness 0
320    $path:cmd configure -highlightthickness $hlthick
321
322    return $path
323}
324
325##########################################################################
326auto_load NoteBook
327
328if {![catch { rename NoteBook::_get_page_name NoteBook::_get_page_name:old }]} {
329    proc NoteBook::_get_page_name { path {item current} {tagindex end-1} } {
330	set pagename [NoteBook::_get_page_name:old $path $item $tagindex]
331	if {[catch { NoteBook::_test_page $path $pagename }]} {
332	    return [string range [lindex [$path.c gettags $item] 1] 2 end]
333	} else {
334	    return $pagename
335	}
336    }
337}
338
339##########################################################################
340if {($::tcl_platform(platform) != "unix") || ($::aquaP)} {
341    auto_load SelectFont
342
343    rename SelectFont::create SelectFont::create:old
344
345    proc SelectFont::create {path args} {
346	eval [list SelectFont::create:old $path] $args
347
348	foreach style {bold italic underline overstrike} {
349	    if {![catch { set bd [option get $path.$style \
350				      borderWidth Button] }]} {
351		if {$bd != ""} {
352		    $path.$style configure -bd $bd
353		}
354	    }
355	}
356	return $path
357    }
358}
359
360##########################################################################
361proc BWidget::bindMouseWheel {widget} {}
362
363##########################################################################
364auto_load Dialog
365
366rename Dialog::create Dialog::create:old
367
368proc Dialog::create {path args} {
369    toplevel $path
370    wm withdraw $path
371    set parent [winfo parent $path]
372    destroy $path
373    set transient 1
374    set newargs {}
375    foreach {key val} $args {
376	switch -- $key {
377	    -parent { set parent $val ; lappend newargs -parent $val }
378	    -transient { set transient $val }
379	    default { lappend newargs $key $val }
380	}
381    }
382    # Do not make a dialog window transient if its parent isn't vewable.
383    # Otherwise it leads to hang of a whole application.
384    if {$parent == ""} {
385	set parent .
386    }
387    if {![winfo viewable [winfo toplevel $parent]] } {
388	set transient 0
389    }
390    eval {Dialog::create:old $path -transient $transient} $newargs
391}
392
393##########################################################################
394
395