summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
Diffstat (limited to 'library')
-rw-r--r--library/bgerror.tcl18
-rw-r--r--library/button.tcl12
-rw-r--r--library/console.tcl23
-rw-r--r--library/demos/menu.tcl8
-rw-r--r--library/demos/menubu.tcl5
-rw-r--r--library/demos/puzzle.tcl17
-rw-r--r--library/demos/widget4
-rw-r--r--library/dialog.tcl16
-rw-r--r--library/entry.tcl7
-rw-r--r--library/listbox.tcl4
-rw-r--r--library/menu.tcl16
-rw-r--r--library/msgbox.tcl17
-rw-r--r--library/scrlbar.tcl5
-rw-r--r--library/spinbox.tcl7
-rw-r--r--library/text.tcl13
-rw-r--r--library/tk.tcl28
16 files changed, 128 insertions, 72 deletions
diff --git a/library/bgerror.tcl b/library/bgerror.tcl
index b53f37b..0c423df 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.22 2002/07/04 09:25:45 dkf Exp $
-# $Id: bgerror.tcl,v 1.22 2002/07/04 09:25:45 dkf Exp $
+# RCS: @(#) $Id: bgerror.tcl,v 1.23 2002/08/31 06:12:28 das Exp $
+# $Id: bgerror.tcl,v 1.23 2002/08/31 06:12:28 das Exp $
namespace eval ::tk {
namespace eval dialog {
@@ -92,7 +92,8 @@ proc ::tk::dialog::error::bgerror err {
# Ok the application's tkerror either failed or was not found
# we use the default dialog then :
- if {$tcl_platform(platform) eq "macintosh"} {
+ if {($tcl_platform(platform) eq "macintosh")
+ || ([tk windowingsystem] eq "aqua")} {
set ok [mc Ok]
set messageFont system
set textRelief flat
@@ -139,13 +140,14 @@ proc ::tk::dialog::error::bgerror err {
wm iconname .bgerrorDialog ErrorDialog
wm protocol .bgerrorDialog WM_DELETE_WINDOW { }
- if {$tcl_platform(platform) eq "macintosh"} {
+ if {($tcl_platform(platform) eq "macintosh")
+ || ([tk windowingsystem] eq "aqua")} {
::tk::unsupported::MacWindowStyle style .bgerrorDialog dBoxProc
}
frame .bgerrorDialog.bot
frame .bgerrorDialog.top
- if {$tcl_platform(platform) eq "unix"} {
+ if {[tk windowingsystem] eq "x11"} {
.bgerrorDialog.bot configure -relief raised -bd 1
.bgerrorDialog.top configure -relief raised -bd 1
}
@@ -181,7 +183,8 @@ proc ::tk::dialog::error::bgerror err {
set wrapwidth [expr {$wrapwidth-60-[winfo pixels .bgerrorDialog 9m]}]
label .bgerrorDialog.msg -justify left -text $text -font $messageFont \
-wraplength $wrapwidth
- if { $tcl_platform(platform) eq "macintosh" } {
+ if {($tcl_platform(platform) eq "macintosh")
+ || ([tk windowingsystem] eq "aqua")} {
# On the Macintosh, use the stop bitmap
label .bgerrorDialog.bitmap -bitmap stop
} else {
@@ -216,7 +219,8 @@ proc ::tk::dialog::error::bgerror err {
-padx 10
grid columnconfigure .bgerrorDialog.bot $i -weight 1
# We boost the size of some Mac buttons for l&f
- if {$tcl_platform(platform) eq "macintosh"} {
+ if {($tcl_platform(platform) eq "macintosh")
+ || ([tk windowingsystem] eq "aqua")} {
if {($name eq "ok") || ($name eq "dismiss")} {
grid columnconfigure .bgerrorDialog.bot $i -minsize 79
}
diff --git a/library/button.tcl b/library/button.tcl
index 55937e2..65971d8 100644
--- a/library/button.tcl
+++ b/library/button.tcl
@@ -4,7 +4,7 @@
# checkbutton, and radiobutton widgets and provides procedures
# that help in implementing those bindings.
#
-# RCS: @(#) $Id: button.tcl,v 1.14 2002/08/13 20:53:35 hobbs Exp $
+# RCS: @(#) $Id: button.tcl,v 1.15 2002/08/31 06:12:28 das Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -18,7 +18,8 @@
# The code below creates the default class bindings for buttons.
#-------------------------------------------------------------------------
-if {[string equal "macintosh" $tcl_platform(platform)]} {
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
bind Radiobutton <Enter> {
tk::ButtonEnter %W
}
@@ -68,7 +69,7 @@ if {[string equal "windows" $tcl_platform(platform)]} {
tk::CheckRadioEnter %W
}
}
-if {[string equal "unix" $tcl_platform(platform)]} {
+if {[string equal "x11" [tk windowingsystem]]} {
bind Checkbutton <Return> {
if {!$tk_strictMotif} {
tk::CheckRadioInvoke %W
@@ -298,7 +299,7 @@ proc ::tk::CheckRadioDown w {
}
-if {[string equal "unix" $tcl_platform(platform)]} {
+if {[string equal "x11" [tk windowingsystem]]} {
#####################
# Unix implementation
@@ -425,7 +426,8 @@ proc ::tk::ButtonUp w {
}
-if {[string equal "macintosh" $tcl_platform(platform)]} {
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
####################
# Mac implementation
diff --git a/library/console.tcl b/library/console.tcl
index 37739b5..955a06b 100644
--- a/library/console.tcl
+++ b/library/console.tcl
@@ -4,7 +4,7 @@
# can be used by non-unix systems that do not have built-in support
# for shells.
#
-# RCS: @(#) $Id: console.tcl,v 1.20 2002/06/22 08:50:43 hobbs Exp $
+# RCS: @(#) $Id: console.tcl,v 1.21 2002/08/31 06:12:28 das Exp $
#
# Copyright (c) 1995-1997 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
@@ -49,10 +49,11 @@ proc ::tk::ConsoleInit {} {
wm withdraw .
}
- if {[string compare $tcl_platform(platform) "macintosh"]} {
- set mod "Ctrl"
- } else {
+ if {[string equal $tcl_platform(platform) "macintosh"]
+ || [string equal [tk windowingsystem] "aqua"]} {
set mod "Cmd"
+ } else {
+ set mod "Ctrl"
}
if {[catch {menu .menubar} err]} { bgerror "INIT: $err" }
@@ -66,12 +67,13 @@ proc ::tk::ConsoleInit {} {
-underline 0 -command {wm withdraw .}
.menubar.file add command -label [mc "Clear Console"] \
-underline 0 -command {.console delete 1.0 "promptEnd linestart"}
- if {[string compare $tcl_platform(platform) "macintosh"]} {
- .menubar.file add command -label [mc "Exit"] \
- -underline 1 -command exit
- } else {
+ if {[string equal $tcl_platform(platform) "macintosh"]
+ || [string equal [tk windowingsystem] "aqua"]} {
.menubar.file add command -label [mc "Quit"] \
-command exit -accel Cmd-Q
+ } else {
+ .menubar.file add command -label [mc "Exit"] \
+ -underline 1 -command exit
}
menu .menubar.edit -tearoff 0
@@ -108,6 +110,11 @@ proc ::tk::ConsoleInit {} {
"windows" {
$con configure -font systemfixed
}
+ "unix" {
+ if {[string equal [tk windowingsystem] "aqua"]} {
+ $con configure -font {Monaco 9 normal} -highlightthickness 0
+ }
+ }
}
ConsoleBind $con
diff --git a/library/demos/menu.tcl b/library/demos/menu.tcl
index 45ca931..9352d73 100644
--- a/library/demos/menu.tcl
+++ b/library/demos/menu.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a window with a bunch of menus
# and cascaded menus using menubars.
#
-# RCS: @(#) $Id: menu.tcl,v 1.3 2001/11/12 15:01:33 dkf Exp $
+# RCS: @(#) $Id: menu.tcl,v 1.4 2002/08/31 06:12:28 das Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -17,7 +17,8 @@ wm iconname $w "menu"
positionWindow $w
label $w.msg -font $font -wraplength 4i -justify left
-if {$tcl_platform(platform) == "macintosh"} {
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
$w.msg configure -text "This window contains a menubar with cascaded menus. You can invoke entries with an accelerator by typing Command+x, where \"x\" is the character next to the command key symbol. The rightmost menu can be torn off into a palette by dragging outside of its bounds and releasing the mouse."
} else {
$w.msg configure -text "This window contains a menubar with cascaded menus. You can post a menu from the keyboard by typing Alt+x, where \"x\" is the character underlined on the menu. You can then traverse among the menus using the arrow keys. When a menu is posted, you can invoke the current entry by typing space, or you can invoke any entry by typing its underlined character. If a menu entry has an accelerator, you can invoke the entry without posting the menu just by typing the accelerator. The rightmost menu can be torn off into a palette by selecting the first item in the menu."
@@ -55,7 +56,8 @@ set m $w.menu.basic
$w.menu add cascade -label "Basic" -menu $m -underline 0
menu $m -tearoff 0
$m add command -label "Long entry that does nothing"
-if {$tcl_platform(platform) == "macintosh"} {
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
set modifier Command
} elseif {$tcl_platform(platform) == "windows"} {
set modifier Control
diff --git a/library/demos/menubu.tcl b/library/demos/menubu.tcl
index 36e8858..bfe6e5b 100644
--- a/library/demos/menubu.tcl
+++ b/library/demos/menubu.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a window with a bunch of menus
# and cascaded menus using menubuttons.
#
-# # RCS: @(#) $Id: menubu.tcl,v 1.2 1998/09/14 18:23:29 stanton Exp $
+# # RCS: @(#) $Id: menubu.tcl,v 1.3 2002/08/31 06:12:28 das Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -57,7 +57,8 @@ pack $body.buttons -padx 25 -pady 25
tk_optionMenu $body.buttons.options menubuttonoptions one two three
pack $body.buttons.options -side left -padx 25 -pady 25
set m [tk_optionMenu $body.buttons.colors paletteColor Black red4 DarkGreen NavyBlue gray75 Red Green Blue gray50 Yellow Cyan Magenta White Brown DarkSeaGreen DarkViolet]
-if {$tcl_platform(platform) == "macintosh"} {
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
set topBorderColor Black
set bottomBorderColor Black
} else {
diff --git a/library/demos/puzzle.tcl b/library/demos/puzzle.tcl
index b0fa685..fe48733 100644
--- a/library/demos/puzzle.tcl
+++ b/library/demos/puzzle.tcl
@@ -3,7 +3,7 @@
# This demonstration script creates a 15-puzzle game using a collection
# of buttons.
#
-# RCS: @(#) $Id: puzzle.tcl,v 1.3 2001/06/14 10:56:58 dkf Exp $
+# RCS: @(#) $Id: puzzle.tcl,v 1.4 2002/08/31 06:12:28 das Exp $
if {![info exists widgetDemo]} {
error "This script should be run from the \"widget\" demo."
@@ -54,8 +54,19 @@ pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
# scrollbar widget and using its trough color.
scrollbar $w.s
-frame $w.frame -width 120 -height 120 -borderwidth 2 -relief sunken \
- -bg [$w.s cget -troughcolor]
+
+# The button metrics are a bit bigger in Aqua, and since we are
+# using place which doesn't autosize, then we need to have a
+# slightly larger frame here...
+
+if {[string equal [tk windowingsystem] aqua]} {
+ set frameSize 160
+} else {
+ set frameSize 120
+}
+
+frame $w.frame -width $frameSize -height $frameSize -borderwidth 2\
+ -relief sunken -bg [$w.s cget -troughcolor]
pack $w.frame -side top -pady 1c -padx 1c
destroy $w.s
diff --git a/library/demos/widget b/library/demos/widget
index d8549c7..fde5c94 100644
--- a/library/demos/widget
+++ b/library/demos/widget
@@ -11,7 +11,7 @@ exec wish "$0" "$@"
# ".tcl" files is this directory, which are sourced by this script
# as needed.
#
-# RCS: @(#) $Id: widget,v 1.7 2002/02/22 14:07:01 dkf Exp $
+# RCS: @(#) $Id: widget,v 1.8 2002/08/31 06:12:28 das Exp $
eval destroy [winfo child .]
wm title . "Widget Demonstration"
@@ -47,7 +47,7 @@ menu .menuBar -tearoff 0
menu .menuBar.file -tearoff 0
# On the Mac use the specia .apple menu for the about item
-if {$tcl_platform(platform) == "macintosh"} {
+if {[string equal [tk windowingsystem] "classic"]} {
.menuBar add cascade -menu .menuBar.apple
menu .menuBar.apple -tearoff 0
.menuBar.apple add command -label "About..." -command "aboutBox"
diff --git a/library/dialog.tcl b/library/dialog.tcl
index 8afcdfb..2eb425f 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.13 2002/06/12 23:08:12 mdejong Exp $
+# RCS: @(#) $Id: dialog.tcl,v 1.14 2002/08/31 06:12:28 das Exp $
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -65,13 +65,14 @@ proc ::tk_dialog {w title text bitmap default args} {
wm transient $w [winfo toplevel [winfo parent $w]]
}
- if {[string equal $tcl_platform(platform) "macintosh"]} {
+ if {[string equal $tcl_platform(platform) "macintosh"]
+ || [string equal [tk windowingsystem] "aqua"]} {
::tk::unsupported::MacWindowStyle style $w dBoxProc
}
frame $w.bot
frame $w.top
- if {[string compare $tcl_platform(platform) "macintosh"]} {
+ if {[string equal [tk windowingsystem] "x11"]} {
$w.bot configure -relief raised -bd 1
$w.top configure -relief raised -bd 1
}
@@ -83,7 +84,8 @@ proc ::tk_dialog {w title text bitmap default args} {
# overridden by the caller).
option add *Dialog.msg.wrapLength 3i widgetDefault
- if {[string equal $tcl_platform(platform) "macintosh"]} {
+ if {[string equal $tcl_platform(platform) "macintosh"]
+ || [string equal [tk windowingsystem] "aqua"]} {
option add *Dialog.msg.font system widgetDefault
} else {
option add *Dialog.msg.font {Times 12} widgetDefault
@@ -92,7 +94,8 @@ proc ::tk_dialog {w title text bitmap default args} {
label $w.msg -justify left -text $text
pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
if {[string compare $bitmap ""]} {
- if {[string equal $tcl_platform(platform) "macintosh"] && \
+ if {([string equal $tcl_platform(platform) "macintosh"]
+ || [string equal [tk windowingsystem] "aqua"]) &&\
[string equal $bitmap "error"]} {
set bitmap "stop"
}
@@ -114,7 +117,8 @@ proc ::tk_dialog {w title text bitmap default args} {
-padx 10 -pady 4
grid columnconfigure $w.bot $i
# We boost the size of some Mac buttons for l&f
- if {[string equal $tcl_platform(platform) "macintosh"]} {
+ if {[string equal $tcl_platform(platform) "macintosh"]
+ || [string equal [tk windowingsystem] "aqua"]} {
set tmp [string tolower $but]
if {[string equal $tmp "ok"] || [string equal $tmp "cancel"]} {
grid columnconfigure $w.bot $i -minsize [expr {59 + 20}]
diff --git a/library/entry.tcl b/library/entry.tcl
index 6542903..04e3c35 100644
--- a/library/entry.tcl
+++ b/library/entry.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk entry widgets and provides
# procedures that help in implementing those bindings.
#
-# RCS: @(#) $Id: entry.tcl,v 1.19 2002/03/04 07:36:39 hobbs Exp $
+# RCS: @(#) $Id: entry.tcl,v 1.20 2002/08/31 06:12:28 das Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -50,7 +50,7 @@ bind Entry <<Copy>> {
bind Entry <<Paste>> {
global tcl_platform
catch {
- if {[string compare $tcl_platform(platform) "unix"]} {
+ if {[string compare [tk windowingsystem] "x11"]} {
catch {
%W delete sel.first sel.last
}
@@ -203,7 +203,8 @@ bind Entry <Escape> {# nothing}
bind Entry <Return> {# nothing}
bind Entry <KP_Enter> {# nothing}
bind Entry <Tab> {# nothing}
-if {[string equal $tcl_platform(platform) "macintosh"]} {
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
bind Entry <Command-KeyPress> {# nothing}
}
diff --git a/library/listbox.tcl b/library/listbox.tcl
index 6a51b66..ff3b549 100644
--- a/library/listbox.tcl
+++ b/library/listbox.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk listbox widgets
# and provides procedures that help in implementing those bindings.
#
-# RCS: @(#) $Id: listbox.tcl,v 1.12 2001/08/01 16:21:11 dgp Exp $
+# RCS: @(#) $Id: listbox.tcl,v 1.13 2002/08/31 06:12:28 das Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1995 Sun Microsystems, Inc.
@@ -183,7 +183,7 @@ bind Listbox <MouseWheel> {
%W yview scroll [expr {- (%D / 120) * 4}] units
}
-if {[string equal "unix" $tcl_platform(platform)]} {
+if {[string equal "x11" [tk windowingsystem]]} {
# Support for mousewheels on Linux/Unix commonly comes through mapping
# the wheel to the extended buttons. If you have a mousewheel, find
# Linux configuration info at:
diff --git a/library/menu.tcl b/library/menu.tcl
index b8f9103..21dd22d 100644
--- a/library/menu.tcl
+++ b/library/menu.tcl
@@ -4,7 +4,7 @@
# It also implements keyboard traversal of menus and implements a few
# other utility procedures related to menus.
#
-# RCS: @(#) $Id: menu.tcl,v 1.17 2002/06/22 09:08:40 hobbs Exp $
+# RCS: @(#) $Id: menu.tcl,v 1.18 2002/08/31 06:12:28 das Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -121,7 +121,7 @@ bind Menu <Enter> {
set tk::Priv(window) %W
if {[%W cget -type] eq "tearoff"} {
if {"%m" ne "NotifyUngrab"} {
- if {$tcl_platform(platform) eq "unix"} {
+ if {[tk windowingsystem] eq "x11"} {
tk_menuSetFocus %W
}
}
@@ -169,7 +169,7 @@ bind Menu <KeyPress> {
# The following bindings apply to all windows, and are used to
# implement keyboard menu traversal.
-if {[string equal $tcl_platform(platform) "unix"]} {
+if {[string equal [tk windowingsystem] "x11"]} {
bind all <Alt-KeyPress> {
tk::TraverseToMenu %W %A
}
@@ -251,7 +251,7 @@ proc ::tk::MbPost {w {x {}} {y {}}} {
if {[string equal $menu ""]} {
return
}
- set tearoff [expr {$tcl_platform(platform) eq "unix" \
+ set tearoff [expr {[tk windowingsystem] eq "x11" \
|| [$menu cget -type] eq "tearoff"}]
if {[string first $w $menu] != 0} {
error "can't post $menu: it isn't a descendant of $w (this is a new requirement in Tk versions 3.0 and later)"
@@ -443,7 +443,7 @@ proc ::tk::MenuUnpost menu {
$Priv(menuBar) configure -cursor $Priv(cursor)
set Priv(menuBar) {}
}
- if {$tcl_platform(platform) ne "unix"} {
+ if {[tk windowingsystem] ne "x11"} {
set Priv(tearoff) 0
}
}
@@ -499,7 +499,7 @@ proc ::tk::MbButtonUp w {
global tcl_platform
set menu [$w cget -menu]
- set tearoff [expr {$tcl_platform(platform) eq "unix" || \
+ set tearoff [expr {[tk windowingsystem] eq "x11" || \
($menu ne "" && [$menu cget -type] eq "tearoff")}]
if {($tearoff != 0) && $Priv(postedMb) eq $w \
&& $Priv(inMenubutton) eq $w} {
@@ -592,7 +592,7 @@ proc ::tk::MenuButtonDown menu {
# Must re-grab even if the grab window hasn't changed, in order
# to release the implicit grab from the button press.
- if {[string equal $tcl_platform(platform) "unix"]} {
+ if {[string equal [tk windowingsystem] "x11"]} {
grab -global $menu
}
}
@@ -1286,7 +1286,7 @@ proc ::tk_popup {menu x y {entry {}}} {
tk::MenuUnpost {}
}
tk::PostOverPoint $menu $x $y $entry
- if {$tcl_platform(platform) eq "unix" && [winfo viewable $menu]} {
+ if {[tk windowingsystem] eq "x11" && [winfo viewable $menu]} {
tk::SaveGrabInfo $menu
grab -global $menu
set Priv(popup) $menu
diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index 244f8ae..a694bb3 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.22 2002/07/22 21:25:39 mdejong Exp $
+# RCS: @(#) $Id: msgbox.tcl,v 1.23 2002/08/31 06:12:28 das Exp $
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
@@ -157,7 +157,8 @@ proc ::tk::MessageBox {args} {
if {[lsearch -exact {info warning error question} $data(-icon)] == -1} {
error "bad -icon value \"$data(-icon)\": must be error, info, question, or warning"
}
- if {[string equal $tcl_platform(platform) "macintosh"]} {
+ if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
switch -- $data(-icon) {
"error" {set data(-icon) "stop"}
"warning" {set data(-icon) "caution"}
@@ -260,7 +261,8 @@ proc ::tk::MessageBox {args} {
wm transient $w $data(-parent)
}
- if {[string equal $tcl_platform(platform) "macintosh"]} {
+ if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
unsupported::MacWindowStyle style $w dBoxProc
}
@@ -268,7 +270,8 @@ proc ::tk::MessageBox {args} {
pack $w.bot -side bottom -fill both
frame $w.top -background $bg
pack $w.top -side top -fill both -expand 1
- if {[string compare $tcl_platform(platform) "macintosh"]} {
+ if {![string equal [tk windowingsystem] "classic"]
+ && ![string equal [tk windowingsystem] "aqua"]} {
$w.bot configure -relief raised -bd 1
$w.top configure -relief raised -bd 1
}
@@ -278,7 +281,8 @@ proc ::tk::MessageBox {args} {
# overridden by the caller).
option add *Dialog.msg.wrapLength 3i widgetDefault
- if {[string equal $tcl_platform(platform) "macintosh"]} {
+ if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
option add *Dialog.msg.font system widgetDefault
} else {
option add *Dialog.msg.font {Times 18} widgetDefault
@@ -287,7 +291,8 @@ proc ::tk::MessageBox {args} {
label $w.msg -anchor nw -justify left -text $data(-message) \
-background $bg
if {[string compare $data(-icon) ""]} {
- if {[string equal $tcl_platform(platform) "macintosh"] \
+ if {([string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"])
|| ([winfo depth $w] < 4) || $tk_strictMotif} {
label $w.bitmap -bitmap $data(-icon) -background $bg
} else {
diff --git a/library/scrlbar.tcl b/library/scrlbar.tcl
index fb4bc0d..b31686d 100644
--- a/library/scrlbar.tcl
+++ b/library/scrlbar.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk scrollbar widgets.
# It also provides procedures that help in implementing the bindings.
#
-# RCS: @(#) $Id: scrlbar.tcl,v 1.9 2001/08/01 16:21:11 dgp Exp $
+# RCS: @(#) $Id: scrlbar.tcl,v 1.10 2002/08/31 06:12:28 das Exp $
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -17,8 +17,7 @@
#-------------------------------------------------------------------------
# Standard Motif bindings:
-if {[string compare $tcl_platform(platform) "windows"] && \
- [string compare $tcl_platform(platform) "macintosh"]} {
+if {[string equal [tk windowingsystem] "x11"]} {
bind Scrollbar <Enter> {
if {$tk_strictMotif} {
diff --git a/library/spinbox.tcl b/library/spinbox.tcl
index cf51553..8d0a52b 100644
--- a/library/spinbox.tcl
+++ b/library/spinbox.tcl
@@ -4,7 +4,7 @@
# procedures that help in implementing those bindings. The spinbox builds
# off the entry widget, so it can reuse Entry bindings and procedures.
#
-# RCS: @(#) $Id: spinbox.tcl,v 1.5 2002/07/25 20:57:33 hobbs Exp $
+# RCS: @(#) $Id: spinbox.tcl,v 1.6 2002/08/31 06:12:28 das Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -56,7 +56,7 @@ bind Spinbox <<Copy>> {
bind Spinbox <<Paste>> {
global tcl_platform
catch {
- if {$tcl_platform(platform) ne "unix"} {
+ if {[tk windowingsystem] ne "x11"} {
catch {
%W delete sel.first sel.last
}
@@ -212,7 +212,8 @@ bind Spinbox <Escape> {# nothing}
bind Spinbox <Return> {# nothing}
bind Spinbox <KP_Enter> {# nothing}
bind Spinbox <Tab> {# nothing}
-if {[string equal $tcl_platform(platform) "macintosh"]} {
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
bind Spinbox <Command-KeyPress> {# nothing}
}
diff --git a/library/text.tcl b/library/text.tcl
index 623b2e1..eb227c2 100644
--- a/library/text.tcl
+++ b/library/text.tcl
@@ -3,7 +3,7 @@
# This file defines the default bindings for Tk text widgets and provides
# procedures that help in implementing the bindings.
#
-# RCS: @(#) $Id: text.tcl,v 1.23 2002/06/21 23:09:55 hobbs Exp $
+# RCS: @(#) $Id: text.tcl,v 1.24 2002/08/31 06:12:28 das Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -276,7 +276,8 @@ bind Text <Meta-KeyPress> {# nothing}
bind Text <Control-KeyPress> {# nothing}
bind Text <Escape> {# nothing}
bind Text <KP_Enter> {# nothing}
-if {[string equal $tcl_platform(platform) "macintosh"]} {
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
bind Text <Command-KeyPress> {# nothing}
}
@@ -393,7 +394,8 @@ bind Text <Meta-Delete> {
# Macintosh only bindings:
# if text black & highlight black -> text white, other text the same
-if {[string equal $tcl_platform(platform) "macintosh"]} {
+if {[string equal [tk windowingsystem] "classic"]
+ || [string equal [tk windowingsystem] "aqua"]} {
bind Text <FocusIn> {
%W tag configure sel -borderwidth 0
%W configure -selectbackground systemHighlight -selectforeground systemHighlightText
@@ -460,7 +462,7 @@ bind Text <MouseWheel> {
%W yview scroll [expr {- (%D / 120) * 4}] units
}
-if {[string equal "unix" $tcl_platform(platform)]} {
+if {[string equal "x11" [tk windowingsystem]]} {
# Support for mousewheels on Linux/Unix commonly comes through mapping
# the wheel to the extended buttons. If you have a mousewheel, find
# Linux configuration info at:
@@ -589,6 +591,7 @@ proc ::tk::TextSelectTo {w x y {extend 0}} {
$w tag remove sel 0.0 end
$w mark set insert $cur
$w tag add sel $first $last
+ $w tag remove sel $last end
update idletasks
}
}
@@ -998,7 +1001,7 @@ proc ::tk_textPaste w {
$w configure -autoseparators 0
$w edit separator
}
- if {[string compare $tcl_platform(platform) "unix"]} {
+ if {[string compare [tk windowingsystem] "x11"]} {
catch { $w delete sel.first sel.last }
}
$w insert insert $sel
diff --git a/library/tk.tcl b/library/tk.tcl
index ea9e992..e695924 100644
--- a/library/tk.tcl
+++ b/library/tk.tcl
@@ -3,7 +3,7 @@
# Initialization script normally executed in the interpreter for each
# Tk-based application. Arranges class bindings for widgets.
#
-# RCS: @(#) $Id: tk.tcl,v 1.42 2002/07/25 20:36:55 hobbs Exp $
+# RCS: @(#) $Id: tk.tcl,v 1.43 2002/08/31 06:12:28 das Exp $
#
# Copyright (c) 1992-1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
@@ -257,7 +257,7 @@ proc ::tk::ScreenChanged screen {
selectMode char
}
set Priv(screen) $screen
- set Priv(tearoff) [string equal $tcl_platform(platform) "unix"]
+ set Priv(tearoff) [string equal [tk windowingsystem] "x11"]
set Priv(window) {}
}
@@ -333,8 +333,8 @@ if {[string equal [info command tk_chooseDirectory] ""]} {
# Define the set of common virtual events.
#----------------------------------------------------------------------
-switch $::tcl_platform(platform) {
- "unix" {
+switch [tk windowingsystem] {
+ "x11" {
event add <<Cut>> <Control-Key-x> <Key-F20>
event add <<Copy>> <Control-Key-c> <Key-F16>
event add <<Paste>> <Control-Key-v> <Key-F18>
@@ -360,7 +360,7 @@ switch $::tcl_platform(platform) {
trace variable ::tk_strictMotif w ::tk::EventMotifBindings
set ::tk_strictMotif $::tk_strictMotif
}
- "windows" {
+ "win32" {
event add <<Cut>> <Control-Key-x> <Shift-Key-Delete>
event add <<Copy>> <Control-Key-c> <Control-Key-Insert>
event add <<Paste>> <Control-Key-v> <Shift-Key-Insert>
@@ -368,7 +368,16 @@ switch $::tcl_platform(platform) {
event add <<Undo>> <Control-Key-z>
event add <<Redo>> <Control-Key-y>
}
- "macintosh" {
+ "aqua" {
+ event add <<Cut>> <Control-Key-x> <Key-F2>
+ event add <<Copy>> <Control-Key-c> <Key-F3>
+ event add <<Paste>> <Control-Key-v> <Key-F4>
+ event add <<PasteSelection>> <ButtonRelease-2>
+ event add <<Clear>> <Clear>
+ event add <<Undo>> <Control-Key-z>
+ event add <<Redo>> <Control-Key-y>
+ }
+ "classic" {
event add <<Cut>> <Control-Key-x> <Key-F2>
event add <<Copy>> <Control-Key-c> <Key-F3>
event add <<Paste>> <Control-Key-v> <Key-F4>
@@ -557,3 +566,10 @@ proc ::tk::mcmaxamp {args} {
}
return $maxlen
}
+# For now, turn off the custom mdef proc for the mac:
+
+if {[string equal [tk windowingsystem] "aqua"]} {
+ namespace eval ::tk::mac {
+ set useCustomMDEF 0
+ }
+}
generated by cgit v0.12 at 2024-11-02 12:40:30 (GMT)