summaryrefslogtreecommitdiffstats
path: root/mac/tclets.tcl
diff options
context:
space:
mode:
authordas <das>2004-03-17 18:15:28 (GMT)
committerdas <das>2004-03-17 18:15:28 (GMT)
commit65423864cf9618016945cddd968b3f2c4343dcfc (patch)
treea4d842ff3e2a8fc34e8fd25e2322f00537fdfae9 /mac/tclets.tcl
parenta69b5b4fefe30134396d6269d0eca5fff4ba8500 (diff)
downloadtk-65423864cf9618016945cddd968b3f2c4343dcfc.zip
tk-65423864cf9618016945cddd968b3f2c4343dcfc.tar.gz
tk-65423864cf9618016945cddd968b3f2c4343dcfc.tar.bz2
Removed support for Mac OS Classic platform [Patch 918139]
Diffstat (limited to 'mac/tclets.tcl')
-rw-r--r--mac/tclets.tcl225
1 files changed, 0 insertions, 225 deletions
diff --git a/mac/tclets.tcl b/mac/tclets.tcl
deleted file mode 100644
index 993a9b5..0000000
--- a/mac/tclets.tcl
+++ /dev/null
@@ -1,225 +0,0 @@
-# tclets.tcl --
-#
-# 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.
-#
-# RCS: @(#) $Id: tclets.tcl,v 1.3 2001/08/06 18:29:41 dgp Exp $
-#
-# Copyright (c) 1997 Sun Microsystems, Inc.
-#
-# See the file "license.terms" for information on usage and redistribution
-# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
-
-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 ::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
-#
-# Results:
-# One success a new Tclet is created.
-
-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]
- set stub [GetStub]
-
- # Give a helper screen to guide user
- toplevel .helper -menu .bar
- ::tk::unsupported::MacWindowStyle style .helper dBoxProc
- message .helper.m -aspect 300 -text \
- "Select the name & location of your target Tcl application."
- pack .helper.m
- wm geometry .helper +20+40
- update idletasks
-
- # Get the target file from the end user
- set target [tk_getSaveFile]
- destroy .helper
- if {$target == ""} return
-
- # Copy stub, copy the droped file into the stubs text resource
- file copy $stub $target
- set id [open $tclFile r]
- set rid [resource open $target w]
- resource write -name tclshrc -file $rid TEXT [read $id]
- resource close $rid
- close $id
-
- # This is a hint to the start-up code - always set to true
- set Droped_to_start true
-}
-
-# ::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.
-#
-# Parameters:
-# None.
-#
-# Results:
-# A path to the stub application.
-
-proc ::tk::mac::GetStub {} {
- global env
- variable Stub_location
-
- if {[info exists Stub_location]} {
- return $Stub_location
- }
-
- set file $env(PREF_FOLDER)
- append file "D&D Tclet Preferences"
-
-
- if {[file exists $file]} {
- uplevel #0 [list source $file]
- if {[info exists Stub_location] && [file exists $Stub_location]} {
- return $Stub_location
- }
- }
-
- SelectStub
-
- if {[info exists Stub_location]} {
- return $Stub_location
- } else {
- exit
- }
-}
-
-# ::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
-# result is stored in a preferences file.
-#
-# Parameters:
-# None.
-#
-# Results:
-# None. The prefernce file is updated.
-
-proc ::tk::mac::SelectStub {} {
- global env
- variable Stub_location
-
- # Give a helper screen to guide user
- toplevel .helper -menu .bar
- ::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." \
-
- pack .helper.m
- wm geometry .helper +20+40
- update idletasks
-
- set new_location [tk_getOpenFile]
- destroy .helper
- if {$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 [namespace which -variable Stub_location] \
- $Stub_location]
- close $id
- }
-}
-
-# ::tk::mac::CreateMenus --
-#
-# Create the menubar for this application.
-#
-# Parameters:
-# None.
-#
-# Results:
-# None.
-
-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 [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 [namespace code SelectStub]
- .bar.file add separator
- .bar.file add command -label "Quit" -accel Command-Q -command exit
-}
-
-# ::tk::mac::ShowAbout --
-#
-# Show the about box for Drag & Drop Tclets.
-#
-# Parameters:
-# None.
-#
-# Results:
-# None.
-
-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."
-}
-
-# ::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
-# and set up the rest of the state of the application.
-#
-# Parameters:
-# None.
-#
-# Results:
-# None.
-
-proc ::tk::mac::Start {} {
- variable Droped_to_start
-
- # Hide . & console - see if we ran as a droped item
- wm geometry . 1x1-25000-25000
- console hide
-
- # 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
- update
- if {$Droped_to_start == "true"} {
- exit
- }
-
- # We were not started by a drag & drop - create the UI
- CreateMenus
-}
-
-# Now that everything is defined, lets start the app!
-::tk::mac::Start