summaryrefslogtreecommitdiffstats
path: root/mac/tclets.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'mac/tclets.tcl')
-rw-r--r--mac/tclets.tcl90
1 files changed, 50 insertions, 40 deletions
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