source: tol/tolbase/lib/byswidget/bfunctions/bltSend.tcl

# --------------------------------------------------------------------------
#
# 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]\""
    } 
}