From 4176fc87bc1a70ad3558015bc3c8d02e52074ba2 Mon Sep 17 00:00:00 2001
From: "dgp@users.sourceforge.net" <dgp>
Date: Mon, 6 Aug 2001 18:29:41 +0000
Subject: * TIP 44 changes specific to the Mac and Windows
platforms that were overlooked before: tkOpenDocument, tkConsoleExit,
tkConsoleOutput, unsupported1 out of namespace :: . Thanks to Vince Darley
for prompting another look.
---
ChangeLog | 15 +++++++++
generic/tkConsole.c | 12 +++----
generic/tkWindow.c | 5 +--
library/bgerror.tcl | 6 ++--
library/dialog.tcl | 4 +--
library/msgbox.tcl | 4 +--
library/unsupported.tcl | 5 ++-
mac/tclets.tcl | 90 +++++++++++++++++++++++++++----------------------
mac/tkMacHLEvents.c | 6 ++--
mac/tkMacWm.c | 8 ++---
10 files changed, 92 insertions(+), 63 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index e185b99..bf61a99 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,18 @@
+2001-08-06 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tkConsole.c:
+ * generic/tkWindow.c:
+ * library/bgerror.tcl:
+ * library/dialog.tcl:
+ * library/msgbox.tcl:
+ * library/unsupported.tcl:
+ * mac/tclets.tcl:
+ * mac/tkMacHLEvents.c:
+ * mac/tkMacWm.c: TIP 44 changes specific to the Mac and
+ Windows platforms that were overlooked before: tkOpenDocument,
+ tkConsoleExit, tkConsoleOutput, unsupported1 out of namespace :: .
+ Thanks to Vince Darley for prompting another look.
+
2001-08-03 Jeff Hobbs <jeffh@ActiveState.com>
* win/winMain.c (WishPanic): fixed CONST changes to go with
diff --git a/generic/tkConsole.c b/generic/tkConsole.c
index 3e91f62..bb6bcad 100644
--- a/generic/tkConsole.c
+++ b/generic/tkConsole.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkConsole.c,v 1.12 2000/07/18 02:31:06 davidg Exp $
+ * RCS: @(#) $Id: tkConsole.c,v 1.13 2001/08/06 18:29:41 dgp Exp $
*/
#include "tk.h"
@@ -708,13 +708,13 @@ ConsoleDeleteProc(clientData)
* This event procedure is registered on the main window of the
* slave interpreter. If the user or a running script causes the
* main window to be destroyed, then we need to inform the console
- * interpreter by invoking "tkConsoleExit".
+ * interpreter by invoking "::tk::ConsoleExit".
*
* Results:
* None.
*
* Side effects:
- * Invokes the "tkConsoleExit" procedure in the console interp.
+ * Invokes the "::tk::ConsoleExit" procedure in the console interp.
*
*----------------------------------------------------------------------
*/
@@ -745,7 +745,7 @@ ConsoleEventProc(clientData, eventPtr)
return;
}
Tcl_Preserve((ClientData) consoleInterp);
- Tcl_DStringAppend(&dString, "tkConsoleExit", -1);
+ Tcl_DStringAppend(&dString, "::tk::ConsoleExit", -1);
Tcl_Eval(consoleInterp, Tcl_DStringValue(&dString));
Tcl_DStringFree(&dString);
Tcl_Release((ClientData) consoleInterp);
@@ -790,9 +790,9 @@ TkConsolePrint(interp, devId, buffer, size)
}
if (devId == TCL_STDERR) {
- cmd = "tkConsoleOutput stderr ";
+ cmd = "::tk::ConsoleOutput stderr ";
} else {
- cmd = "tkConsoleOutput stdout ";
+ cmd = "::tk::ConsoleOutput stdout ";
}
result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
diff --git a/generic/tkWindow.c b/generic/tkWindow.c
index 522df47..3c83daa 100644
--- a/generic/tkWindow.c
+++ b/generic/tkWindow.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkWindow.c,v 1.31 2001/07/03 05:59:50 hobbs Exp $
+ * RCS: @(#) $Id: tkWindow.c,v 1.32 2001/08/06 18:29:41 dgp Exp $
*/
#include "tkPort.h"
@@ -154,7 +154,8 @@ static TkCmd commands[] = {
*/
#ifdef MAC_TCL
- {"unsupported1", TkUnsupported1Cmd, NULL, 1, 1},
+ {"::tk::unsupported::MacWindowStyle",
+ TkUnsupported1Cmd, NULL, 1, 1},
#endif
{(char *) NULL, (int (*) _ANSI_ARGS_((ClientData, Tcl_Interp *, int, char **))) NULL, NULL, 0}
};
diff --git a/library/bgerror.tcl b/library/bgerror.tcl
index 13b0389..5cb96c6 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.16 2001/08/01 16:21:11 dgp Exp $
-# $Id: bgerror.tcl,v 1.16 2001/08/01 16:21:11 dgp Exp $
+# RCS: @(#) $Id: bgerror.tcl,v 1.17 2001/08/06 18:29:41 dgp Exp $
+# $Id: bgerror.tcl,v 1.17 2001/08/06 18:29:41 dgp Exp $
option add *ErrorDialog.function.text [::msgcat::mc "Save To Log"] \
widgetDefault
@@ -143,7 +143,7 @@ proc ::bgerror err {
wm transient .bgerrorDialog .bgerrorDialog
if {$tcl_platform(platform) == "macintosh"} {
- unsupported1 style .bgerrorDialog dBoxProc
+ ::tk::unsupported::MacWindowStyle style .bgerrorDialog dBoxProc
}
frame .bgerrorDialog.bot
diff --git a/library/dialog.tcl b/library/dialog.tcl
index 534a9ae..a6f3c5b 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.9 2001/08/01 16:21:11 dgp Exp $
+# RCS: @(#) $Id: dialog.tcl,v 1.10 2001/08/06 18:29:41 dgp Exp $
#
# Copyright (c) 1992-1993 The Regents of the University of California.
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
@@ -66,7 +66,7 @@ proc ::tk_dialog {w title text bitmap default args} {
}
if {[string equal $tcl_platform(platform) "macintosh"]} {
- unsupported1 style $w dBoxProc
+ ::tk::unsupported::MacWindowStyle style $w dBoxProc
}
frame $w.bot
diff --git a/library/msgbox.tcl b/library/msgbox.tcl
index ade57ce..6fdef49 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.14 2001/08/01 16:21:11 dgp Exp $
+# RCS: @(#) $Id: msgbox.tcl,v 1.15 2001/08/06 18:29:41 dgp Exp $
#
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
#
@@ -286,7 +286,7 @@ proc ::tk::MessageBox {args} {
}
if {[string equal $tcl_platform(platform) "macintosh"]} {
- unsupported1 style $w dBoxProc
+ unsupported::MacWindowStyle style $w dBoxProc
}
frame $w.bot
diff --git a/library/unsupported.tcl b/library/unsupported.tcl
index 467fb9c..d1eb5a8 100644
--- a/library/unsupported.tcl
+++ b/library/unsupported.tcl
@@ -3,7 +3,7 @@
# Commands provided by Tk without official support. Use them at your
# own risk. They may change or go away without notice.
#
-# RCS: @(#) $Id: unsupported.tcl,v 1.2 2001/08/01 16:21:11 dgp Exp $
+# RCS: @(#) $Id: unsupported.tcl,v 1.3 2001/08/06 18:29:41 dgp Exp $
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -222,6 +222,7 @@ namespace eval ::tk::unsupported {
tkTextUpDownLine ::tk::TextUpDownLine
tkTraverseToMenu ::tk::TraverseToMenu
tkTraverseWithinMenu ::tk::TraverseWithinMenu
+ unsupported1 ::tk::unsupported::MacWindowStyle
}
# Map from the old global names of Tk private variable to their
@@ -229,7 +230,9 @@ namespace eval ::tk::unsupported {
variable PrivateVariables
array set PrivateVariables {
+ droped_to_start ::tk::mac::Droped_to_start
histNum ::tk::HistNum
+ stub_location ::tk::mac::Stub_location
tkFocusIn ::tk::FocusIn
tkFocusOut ::tk::FocusOut
tkPalette ::tk::Palette
diff --git a/mac/tclets.tcl b/mac/tclets.tcl
index d6b847b..993a9b5 100644
--- a/mac/tclets.tcl
+++ b/mac/tclets.tcl
@@ -3,11 +3,12 @@
# Drag & Drop Tclets
# by Ray Johnson
#
-# A simple way to create Tcl applications. This applications will copy a droped Tcl file
-# into a copy of a stub application (the user can pick). The file is placed into the
-# TEXT resource named "tclshrc" which is automatically executed on startup.
+# A simple way to create Tcl applications. This applications will copy a
+# droped Tcl file into a copy of a stub application (the user can pick).
+# The file is placed into the TEXT resource named "tclshrc" which is
+# automatically executed on startup.
#
-# RCS: @(#) $Id: tclets.tcl,v 1.2 1998/09/14 18:23:33 stanton Exp $
+# RCS: @(#) $Id: tclets.tcl,v 1.3 2001/08/06 18:29:41 dgp Exp $
#
# Copyright (c) 1997 Sun Microsystems, Inc.
#
@@ -15,13 +16,17 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# tkOpenDocument --
+namespace eval ::tk {}
+namespace eval ::tk::mac {}
+
+# ::tk::mac::OpenDocument --
#
# This procedure is a called whenever Wish recieves an "Open" event. The
-# procedure must be named tkOpenDocument for this to work. Passed in files
-# are assumed to be Tcl files that the user wants to be made into Tclets.
-# (Only the first one is used.) The procedure then creates a copy of the
-# stub app and places the Tcl file in the new application's resource fork.
+# procedure must be named ::tk::mac::OpenDocument for this to work.
+# Passed in files are assumed to be Tcl files that the user wants to be
+# made into Tclets. (Only the first one is used.) The procedure then
+# creates a copy of the stub app and places the Tcl file in the new
+# application's resource fork.
#
# Parameters:
# args List of files
@@ -29,8 +34,8 @@
# Results:
# One success a new Tclet is created.
-proc tkOpenDocument {args} {
- global droped_to_start
+proc ::tk::mac::OpenDocument {args} {
+ variable Droped_to_start
# We only deal with the one file droped on the App
set tclFile [lindex $args 0]
@@ -38,7 +43,7 @@ proc tkOpenDocument {args} {
# Give a helper screen to guide user
toplevel .helper -menu .bar
- unsupported1 style .helper dBoxProc
+ ::tk::unsupported::MacWindowStyle style .helper dBoxProc
message .helper.m -aspect 300 -text \
"Select the name & location of your target Tcl application."
pack .helper.m
@@ -59,10 +64,10 @@ proc tkOpenDocument {args} {
close $id
# This is a hint to the start-up code - always set to true
- set droped_to_start true
+ set Droped_to_start true
}
-# GetStub --
+# ::tk::mac::GetStub --
#
# Get the location of our stub application. The value may be cached,
# in the preferences file, or we may need to ask the user.
@@ -73,11 +78,12 @@ proc tkOpenDocument {args} {
# Results:
# A path to the stub application.
-proc GetStub {} {
- global env stub_location
+proc ::tk::mac::GetStub {} {
+ global env
+ variable Stub_location
- if {[info exists stub_location]} {
- return $stub_location
+ if {[info exists Stub_location]} {
+ return $Stub_location
}
set file $env(PREF_FOLDER)
@@ -86,21 +92,21 @@ proc GetStub {} {
if {[file exists $file]} {
uplevel #0 [list source $file]
- if {[info exists stub_location] && [file exists $stub_location]} {
- return $stub_location
+ if {[info exists Stub_location] && [file exists $Stub_location]} {
+ return $Stub_location
}
}
SelectStub
- if {[info exists stub_location]} {
- return $stub_location
+ if {[info exists Stub_location]} {
+ return $Stub_location
} else {
exit
}
}
-# SelectStub --
+# ::tk::mac::SelectStub --
#
# This procedure uses tk_getOpenFile to allow the user to select
# the copy of "Wish" that is used as the basis for Tclets. The
@@ -112,12 +118,13 @@ proc GetStub {} {
# Results:
# None. The prefernce file is updated.
-proc SelectStub {} {
- global env stub_location
+proc ::tk::mac::SelectStub {} {
+ global env
+ variable Stub_location
# Give a helper screen to guide user
toplevel .helper -menu .bar
- unsupported1 style .helper dBoxProc
+ ::tk::unsupported::MacWindowStyle style .helper dBoxProc
message .helper.m -aspect 300 -text \
"Select \"Wish\" stub to clone. A copy of this application will be made to create your Tclet." \
@@ -128,16 +135,17 @@ proc SelectStub {} {
set new_location [tk_getOpenFile]
destroy .helper
if {$new_location != ""} {
- set stub_location $new_location
+ set Stub_location $new_location
set file [file join $env(PREF_FOLDER) "D&D Tclet Preferences"]
set id [open $file w]
- puts $id [list set stub_location $stub_location]
+ puts $id [list set [namespace which -variable Stub_location] \
+ $Stub_location]
close $id
}
}
-# CreateMenus --
+# ::tk::mac::CreateMenus --
#
# Create the menubar for this application.
#
@@ -147,23 +155,25 @@ proc SelectStub {} {
# Results:
# None.
-proc CreateMenus {} {
+proc ::tk::mac::CreateMenus {} {
menu .bar
.bar add cascade -menu .bar.file -label File
.bar add cascade -menu .bar.apple
. configure -menu .bar
menu .bar.apple -tearoff 0
- .bar.apple add command -label "About Drag & Drop Tclets..." -command {ShowAbout}
+ .bar.apple add command -label "About Drag & Drop Tclets..." \
+ -command [namespace code ShowAbout]
menu .bar.file -tearoff 0
.bar.file add command -label "Show Console..." -command {console show}
- .bar.file add command -label "Select Wish Stub..." -command {SelectStub}
+ .bar.file add command -label "Select Wish Stub..." \
+ -command [namespace code SelectStub]
.bar.file add separator
.bar.file add command -label "Quit" -accel Command-Q -command exit
}
-# ShowAbout --
+# ::tk::mac::ShowAbout --
#
# Show the about box for Drag & Drop Tclets.
#
@@ -173,14 +183,14 @@ proc CreateMenus {} {
# Results:
# None.
-proc ShowAbout {} {
+proc ::tk::mac::ShowAbout {} {
tk_messageBox -icon info -type ok -message \
"Drag & Drop Tclets
by Ray Johnson\n\n\
Copyright (c) 1997 Sun Microsystems, Inc."
}
-# Start --
+# ::tk::mac::Start --
#
# This procedure provides the main start-up code for the application.
# It should be run first thing on start up. It will create the UI
@@ -192,8 +202,8 @@ Copyright (c) 1997 Sun Microsystems, Inc."
# Results:
# None.
-proc Start {} {
- global droped_to_start
+proc ::tk::mac::Start {} {
+ variable Droped_to_start
# Hide . & console - see if we ran as a droped item
wm geometry . 1x1-25000-25000
@@ -201,9 +211,9 @@ proc Start {} {
# Run update - if we get any drop events we know that we were
# started by a drag & drop - if so, we quit automatically when done
- set droped_to_start false
+ set Droped_to_start false
update
- if {$droped_to_start == "true"} {
+ if {$Droped_to_start == "true"} {
exit
}
@@ -212,4 +222,4 @@ proc Start {} {
}
# Now that everything is defined, lets start the app!
-Start
+::tk::mac::Start
diff --git a/mac/tkMacHLEvents.c b/mac/tkMacHLEvents.c
index b8604d8..79ad66e 100644
--- a/mac/tkMacHLEvents.c
+++ b/mac/tkMacHLEvents.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkMacHLEvents.c,v 1.4 1999/12/21 23:55:36 hobbs Exp $
+ * RCS: @(#) $Id: tkMacHLEvents.c,v 1.5 2001/08/06 18:29:41 dgp Exp $
*/
#include "tcl.h"
@@ -202,7 +202,7 @@ OdocHandler(
*/
if ((interp == NULL) ||
- (Tcl_GetCommandInfo(interp, "tkOpenDocument", &dummy)) == 0) {
+ (Tcl_GetCommandInfo(interp, "::tk::mac::OpenDocument", &dummy)) == 0) {
return noErr;
}
@@ -228,7 +228,7 @@ OdocHandler(
}
Tcl_DStringInit(&command);
- Tcl_DStringAppend(&command, "tkOpenDocument", -1);
+ Tcl_DStringAppend(&command, "::tk::mac::OpenDocument", -1);
for (index = 1; index <= count; index++) {
int length;
Handle fullPath;
diff --git a/mac/tkMacWm.c b/mac/tkMacWm.c
index 8ee7e6c..23b7fd7 100644
--- a/mac/tkMacWm.c
+++ b/mac/tkMacWm.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tkMacWm.c,v 1.10 2000/04/25 01:02:13 hobbs Exp $
+ * RCS: @(#) $Id: tkMacWm.c,v 1.11 2001/08/06 18:29:41 dgp Exp $
*/
#include <Gestalt.h>
@@ -3744,9 +3744,9 @@ TkMacZoomToplevel(
*
* TkUnsupported1Cmd --
*
- * This procedure is invoked to process the "unsupported1" Tcl
- * command. This command allows you to set the style of decoration
- * for a Macintosh window.
+ * This procedure is invoked to process the
+ * "::tk::unsupported::MacWindowStyle" Tcl command. This command
+ * allows you to set the style of decoration for a Macintosh window.
*
* Results:
* A standard Tcl result.
--
cgit v0.12