diff options
Diffstat (limited to 'library')
| -rw-r--r-- | library/bgerror.tcl | 6 | ||||
| -rw-r--r-- | library/demos/button.tcl | 18 | ||||
| -rw-r--r-- | library/dialog.tcl | 16 | ||||
| -rw-r--r-- | library/msgbox.tcl | 17 |
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 |