summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authordas <das>2007-05-30 06:37:03 (GMT)
committerdas <das>2007-05-30 06:37:03 (GMT)
commitf3d210a9783984b6003f0a0bc94414d2adfe5260 (patch)
tree15eb2ed51b80e925a08ac127290e70a94dac2cef /library
parente8a7346ab6321fdaaef3d8fda8c54cc1bebb9e12 (diff)
downloadtk-f3d210a9783984b6003f0a0bc94414d2adfe5260.zip
tk-f3d210a9783984b6003f0a0bc94414d2adfe5260.tar.gz
tk-f3d210a9783984b6003f0a0bc94414d2adfe5260.tar.bz2
* library/bgerror.tcl: standardize dialog option & button size
* library/dialog.tcl: modifications done when running on on Aqua. * library/msgbox.tcl: * library/demos/button.tcl: set button highlightbackground on Aqua.
Diffstat (limited to 'library')
-rw-r--r--library/bgerror.tcl6
-rw-r--r--library/demos/button.tcl18
-rw-r--r--library/dialog.tcl16
-rw-r--r--library/msgbox.tcl17
4 files changed, 40 insertions, 17 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl
index 50933d4..48c212e 100644
--- a/library/bgerror.tcl
+++ b/library/bgerror.tcl
@@ -9,8 +9,8 @@
# Copyright (c) 1998-2000 by Ajuba Solutions.
# All rights reserved.
#
-# RCS: @(#) $Id: bgerror.tcl,v 1.23.2.7 2007/04/29 02:24:49 das Exp $
-# $Id: bgerror.tcl,v 1.23.2.7 2007/04/29 02:24:49 das Exp $
+# RCS: @(#) $Id: bgerror.tcl,v 1.23.2.8 2007/05/30 06:37:03 das Exp $
+# $Id: bgerror.tcl,v 1.23.2.8 2007/05/30 06:37:03 das Exp $
namespace eval ::tk::dialog::error {
namespace import -force ::tk::msgcat::*
@@ -229,7 +229,7 @@ proc ::tk::dialog::error::bgerror err {
if {($tcl_platform(platform) eq "macintosh")
|| ($windowingsystem eq "aqua")} {
if {($name eq "ok") || ($name eq "dismiss")} {
- grid columnconfigure .bgerrorDialog.bot $i -minsize 79
+ grid columnconfigure .bgerrorDialog.bot $i -minsize 90
}
grid configure .bgerrorDialog.$name -pady 7
}
diff --git a/library/demos/button.tcl b/library/demos/button.tcl
index 896f72c..eb73408 100644
--- a/library/demos/button.tcl
+++ b/library/demos/button.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a toplevel window containing
# several button widgets.
#
-# RCS: @(#) $Id: button.tcl,v 1.2 1998/09/14 18:23:27 stanton Exp $
+# RCS: @(#) $Id: button.tcl,v 1.2.26.1 2007/05/30 06:37:03 das Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -25,12 +25,20 @@ button $w.buttons.dismiss -text Dismiss -command "destroy $w"
button $w.buttons.code -text "See Code" -command "showCode $w"
pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+proc colorrefresh {w col} {
+ $w configure -bg $col
+ $w.buttons configure -bg $col
+ if {[tk windowingsystem] eq "aqua"} {
+ $w.buttons configure -highlightbackground $col
+ }
+}
+
button $w.b1 -text "Peach Puff" -width 10 \
- -command "$w config -bg PeachPuff1; $w.buttons config -bg PeachPuff1"
+ -command [list colorrefresh $w PeachPuff1]
button $w.b2 -text "Light Blue" -width 10 \
- -command "$w config -bg LightBlue1; $w.buttons config -bg LightBlue1"
+ -command [list colorrefresh $w LightBlue1]
button $w.b3 -text "Sea Green" -width 10 \
- -command "$w config -bg SeaGreen2; $w.buttons config -bg SeaGreen2"
+ -command [list colorrefresh $w SeaGreen2]
button $w.b4 -text "Yellow" -width 10 \
- -command "$w config -bg Yellow1; $w.buttons config -bg Yellow1"
+ -command [list colorrefresh $w Yellow1]
pack $w.b1 $w.b2 $w.b3 $w.b4 -side top -expand yes -pady 2
diff --git a/library/dialog.tcl b/library/dialog.tcl
index 82f13fb..e083cf1 100644
--- a/library/dialog.tcl
+++ b/library/dialog.tcl
@@ -3,7 +3,7 @@
# This file defines the procedure tk_dialog, which creates a dialog
# box containing a bitmap, a message, and one or more buttons.
#
-# RCS: @(#) $Id: dialog.tcl,v 1.14.2.4 2007/04/29 02:24:49 das Exp $
+# RCS: @(#) $Id: dialog.tcl,v 1.14.2.5 2007/05/30 06:37:03 das Exp $
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -46,6 +46,13 @@ proc ::tk_dialog {w title text bitmap default args} {
set default [lsearch -exact $args $default]
}
+ set windowingsystem [tk windowingsystem]
+ if {$tcl_platform(platform) eq "macintosh" || $windowingsystem eq "aqua"} {
+ option add *Dialog*background systemDialogBackgroundActive widgetDefault
+ option add *Dialog*Button.highlightBackground \
+ systemDialogBackgroundActive widgetDefault
+ }
+
# 1. Create the top-level window and divide it into top
# and bottom parts.
@@ -66,13 +73,8 @@ proc ::tk_dialog {w title text bitmap default args} {
wm transient $w [winfo toplevel [winfo parent $w]]
}
- set windowingsystem [tk windowingsystem]
-
if {$tcl_platform(platform) eq "macintosh" || $windowingsystem eq "aqua"} {
::tk::unsupported::MacWindowStyle style $w moveableModal {}
- option add *Dialog*background systemDialogBackgroundActive widgetDefault
- option add *Dialog*Button.highlightBackground \
- systemDialogBackgroundActive widgetDefault
}
frame $w.bot
@@ -123,7 +125,7 @@ proc ::tk_dialog {w title text bitmap default args} {
if {$tcl_platform(platform) eq "macintosh" || $windowingsystem eq "aqua"} {
set tmp [string tolower $but]
if {$tmp eq "ok" || $tmp eq "cancel"} {
- grid columnconfigure $w.bot $i -minsize [expr {59 + 20}]
+ grid columnconfigure $w.bot $i -minsize 90
}
grid configure $w.button$i -pady 7
}
diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index fdf987a..2f8419b 100644
--- a/library/msgbox.tcl
+++ b/library/msgbox.tcl
@@ -3,7 +3,7 @@
# Implements messageboxes for platforms that do not have native
# messagebox support.
#
-# RCS: @(#) $Id: msgbox.tcl,v 1.24.2.3 2006/01/25 18:21:41 dgp Exp $
+# RCS: @(#) $Id: msgbox.tcl,v 1.24.2.4 2007/05/30 06:37:03 das Exp $
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
@@ -166,6 +166,9 @@ proc ::tk::MessageBox {args} {
"warning" {set data(-icon) "caution"}
"info" {set data(-icon) "note"}
}
+ option add *Dialog*background systemDialogBackgroundActive widgetDefault
+ option add *Dialog*Button.highlightBackground \
+ systemDialogBackgroundActive widgetDefault
}
if {![winfo exists $data(-parent)]} {
@@ -259,7 +262,7 @@ proc ::tk::MessageBox {args} {
}
if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} {
- unsupported::MacWindowStyle style $w dBoxProc
+ ::tk::unsupported::MacWindowStyle style $w moveableModal {}
}
frame $w.bot -background $bg
@@ -350,6 +353,16 @@ proc ::tk::MessageBox {args} {
}
grid $w.$name -in $w.bot -row 0 -column $i -padx 3m -pady 2m -sticky ew
grid columnconfigure $w.bot $i -uniform buttons
+ # We boost the size of some Mac buttons for l&f
+ if {$windowingsystem eq "classic" || $windowingsystem eq "aqua"} {
+ set tmp [string tolower $name]
+ if {$tmp eq "ok" || $tmp eq "cancel" || $tmp eq "yes" ||
+ $tmp eq "no" || $tmp eq "abort" || $tmp eq "retry" ||
+ $tmp eq "ignore"} {
+ grid columnconfigure $w.bot $i -minsize 90
+ }
+ grid configure $w.$name -pady 7
+ }
incr i
# create the binding for the key accelerator, based on the underline