/usr/share/blt2.4/demos/scripts/send.tcl is in blt-demo 2.4z-4.2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 | # --------------------------------------------------------------------------
#
# SendInit --
#
# Creates a "send" proc to replace the former Tk send command.
# Uses DDE services to simulate the transfer. This must be
# called before any drag&drop targets are registered. Otherwise
# they will pick up the wrong application name.
#
# The first trick is to determine a unique application name. This
# is what other applications will use to send to us. Tk used to
# do this for us.
#
# Note that we can generate the same name for two different Tk
# applications. This can happen if two Tk applications picking
# names at exactly the same time. [In the future, we should
# probably generate a name based upon a global system value, such
# as the handle of the main window ".".] The proc "SendVerify"
# below will verify that you have only one DDE server registered
# with this application's name.
#
# Arguments:
# myInterp Sets the application name explicitly to this
# string. If the argument isn't given, or is the
# empty string, then the routine picks a name for
# us.
#
# Results:
# Returns the name of the application.
#
# Side Effects:
# Sets the name of our application. You can call "tk appname" to
# get the name. A DDE topic using the same name is also created.
# A send proc is also automatically created. Be careful that you
# don't overwrite an existing send command.
#
# --------------------------------------------------------------------------
proc SendInit { {myInterp ""} } {
# Load the DDE package.
package require dde
if { $myInterp == "" } {
# Pick a unique application name, replicating what Tk used to do.
# This is what other applications will use to "send" to us. We'll
# use DDE topics to represent interpreters.
set appName [tk appname]
set count 0
set suffix {}
# Keep generating interpreter names by suffix-ing the original
# application name with " #number". Sooner of later we'll find
# one that's not currently use.
while { 1 } {
set myInterp "${appName}${suffix}"
set myServer [list TclEval $myInterp]
if { [lsearch [dde services TclEval {}] $myServer] < 0 } {
break
}
incr count
set suffix " \#$count"
}
}
tk appname $myInterp
dde servername $myInterp
proc send { interp args } {
dde eval $interp $args
}
return $myInterp
}
# --------------------------------------------------------------------------
#
# SendVerify --
#
# Verifies that application name picked is uniquely registered
# as a DDE server. This checks that two Tk applications don't
# accidently use the same name.
#
# Arguments:
# None Used the current application name.
#
# Results:
# Generates an error if either a server can't be found or more
# than one server is registered.
#
# --------------------------------------------------------------------------
proc SendVerify {} {
# Load the DDE package.
package require dde
set count 0
set appName [tk appname]
foreach server [dde services TclEval {}] {
set topic [lindex $server 1]
if { [string compare $topic $appName] == 0 } {
incr count
}
}
if {$count == 0} {
error "Service not found: wrong name registered???"
}
if { $count > 1 } {
error "Duplicate names found for \"[tk appname]\""
}
}
|