# 
#    PT writes:
# 
#    This is a suggestion for a generalisation of the _send_ functionality.
#    This is derived from the tkinspect _send_ handling and shouldhelp a
#    little with the use of _send_ in a cross-platform application. (That is
#    an application that wants operate on either unix or windows. If you want
#    to use send _between_ unix and windows - you probably better use the
#    comm package!)

# send.tcl - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net>
#
# General send command
#
# This provides an abstraction of send, appname and interps that works for
# all available send mechanisms. This is especially useful for Windows where
# the usual Tk send is not available.
#
# We attempt to use the most efficient transport available. If the normal Tk
# send command is present then this will be used. Otherwise we try winsend,
# then dde for windows before defaulting to use comm.
#
# The interps command will try and build a list from all available transports.
#
# The appname command will try to apply the new name to all transports and
# will read it from them all as well.
#

namespace eval send {
    variable version 1.0
    variable rcsid {$Id$}

    namespace export send interps appname
}

# Try using Tk send first, then look for a winsend interp,
# then try dde and finally have a go at comm
proc send::send {args} {
    array set opts [list displayof {} async 0]
    while {[string match -* [lindex $args 0]]} {
        switch -exact -- [lindex $args 0] {
            -displayof { set opts(displayof) [Pop args 1] }
            -async     { set opts(async) 1 }
            -- { Pop args ; break }
            default {
                return -code error "bad option \"[lindex $args 0]\":\
                    should be -displayof, -async or --"
            }
        }
        Pop args
    }
    set app [Pop args]

    if {[info command ::winfo] != {}
        && [lsearch -exact [::winfo interps] $app] > -1} {
        set cmd ::send
        if {$opt(async) == 1} {append cmd " -async"}
        if {$opt(displayof) != {}} {append cmd " -displayof $opt(displayof)" }
        eval $cmd [list $app] $args
    } elseif {[info command ::winsend] != {}
              && [lsearch -exact [::winsend interps] $app] > -1} {
        eval ::winsend send [list $app] $args
    } elseif {[info command ::dde] != {}
              && [lsearch -exact [dde services TclEval {}] \
                      [list TclEval $app]] > -1} {
        eval ::dde eval [list $app] $args
    } elseif {[package provide comm] != {}
              && [string is integer $app]} {
        eval ::comm::comm send [list $app] $args
    } else {
        return -code error "bad interp: \"$app\" could not be found"
    }
}

proc send::interps {args} {
    array set opts [list displayof {}]
    while {[string match -* [lindex $args 0]]} {
        switch -exact -- [lindex $args 0] {
            -displayof { set opts(displayof) [Pop args 1] }
            --         { Pop args ; break }
            default {
                return -code error "bad option \"[lindex $args 0]\":\
                    should be -displayof or --"
            }
        }
        Pop args
    }

    set interps {}
    if {[info command ::winfo] != {}} {
        set cmd "::winfo interps"
        if {$opts(displayof) != {}} {
            append cmd " -displayof $opts(displayof)"
        }
        set interps [concat $interps [eval $cmd]]
    }
    if {[info command ::winsend] != {}} {
        set interps [concat $interps [::winsend interps]]
    }
    if {[info command ::dde] != {}} {
        set server {}
        foreach server [::dde services TclEval {}] {
            lappend servers [lindex $server 1]
        }
        set interps [concat $interps $servers]
    }
    if {[package provide comm] != {}} {
        set interps [concat $interps [::comm::comm self]]
    }
    return $interps
}

proc send::appname {{newname {}}} {
    set appname {}
    if {[info command ::tk] != {}} {
        set appname [eval ::tk appname $newname]
    }
    if {[info command ::winsend] != {}} {
        set appname [concat $appname [eval ::winsend appname $newname]]
    }
    if {[info command ::dde] != {}} {
        set appname [concat $appname [eval ::dde servername $newname]]
    }
    # comm?
    return [lsort -unique $appname]
}

proc send::Pop {varname {nth 0}} {
    upvar $varname args
    set r [lindex $args $nth]
    set args [lreplace $args $nth $nth]
    return $r
}

package provide send $send::version

# Local variables:
#   mode: tcl
#   indent-tabs-mode: nil
# End:

