From 0ecd54f69712f24aebc4c2f5327731a88b007531 Mon Sep 17 00:00:00 2001 From: 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 + + * 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 * 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 @@ -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