evalclient.tcl

是TCL的另外一个编译（解释）器

#!/bin/sh
#\
exec wish "$0" ${1+"$@"}
# evalClient --
# starts the evalServer and set up connection to it
# provides an execution terminal which shows the output of the commands
# it磗 also possible to execute commands via this terminal

package require Tk

namespace eval Client {
    variable terminal
    variable port
    variable shutdown 0
    variable serverInitDone 0
}

proc Client::runTclApp {sock} {
    global tk_library
    global tcl_library
    global tcl_platform
    global auto_path
    
    set filename [tk_getOpenFile]
    if {$filename == ""} {
        return
    }
    set fd [open $filename r]
    set data [read $fd]
    close $fd
    set curDir [pwd]
    puts $sock "cd [file dirname $filename]"
    puts $sock "set argv0 [list $filename]"
    puts $sock "set argv \"\" "
    puts $sock "set argc 0"
    puts $sock "set tcl_library [list $tcl_library]"
    puts $sock "set tk_library [list $tk_library]"
    puts $sock "set auto_path [list $auto_path]"
    puts $sock $data
    puts $sock "wm protocol . WM_DELETE_WINDOW \"puts $sock exit\""
    puts $sock "wm deiconify ."
    puts $sock "focus -force ."
    puts $sock "cd [file dirname $curDir]"
    
    return
}

proc Client::sockHandler {sock handleProc} {
    variable serverInitDone
    
    eval $handleProc $sock
    set serverInitDone 1
}

proc Client::showResult {sock} {
    variable terminal
    
    if [eof $sock] {
        catch {close $sock}
        exit
    }
    if {[gets $sock result] < 0 } {
        catch {close $sock}
        exit
    } elseif {$result != ""} {
        $terminal(win) insert insert $result\n result
        $terminal(win) see insert
    }
    
    return
}

proc Client::exitExecutionServer {{serverPort {}} {host localhost}} {
    variable port
    variable shutdown
    global waitforexit
    
    if {$serverPort != {}} {
        set port $serverPort
    }
    # setup client sock
    if {[catch {
            set sock [eval [list socket $host $port]]
        } errorInfo ]} {
        return
    }
    # send exit command
    puts $sock "exitASEDServer"
    catch {close $sock}
    set shutdown "done"
    return 0
}

proc Client::initExecutionClient {{host localhost} {port 9001} {sockHandleProc Client::showResult} {serverName "./evalServer.tcl"} {serverWish {}} {timeout 10}} {
        
    global serverUp
    variable serverInitDone
    
    if {$serverWish == {}} {
        set serverWish [info nameofexecutable]
    }
    # setup client sock
    if {[catch {
            set sock [eval [list socket $host $port]]
        }]} {
        # start execution server
        if {[file exists $serverName]} {
            eval [list Client::initExecutionServer $port $serverName $serverWish]
            # and try again
            after 10000 {set Client::serverInitDone timeout}
            while {[catch {set sock [eval [list socket $host $port]]}]} {
                if {$Client::serverInitDone == "timeout"} {
                    break
                }
                after 200
            }
            if {$Client::serverInitDone == "timeout"} {
                tk_messageBox -message "Couldn磘 connect to evalServer!" -icon error -title "server error"
                return
            }
        } else  {
            tk_messageBox -message "Server $serverName not found!" -icon error -title "server error"
            return
        }
    }
    fileevent $sock readable [list Client::sockHandler $sock $sockHandleProc]
    fconfigure $sock -buffering none
    fconfigure $sock -blocking 0
    set serverUp 1
    return $sock
}

proc Client::initExecutionServer {{port 9001} {serverName "./evalServer.tcl"} {serverWish {}} } {
    global env
    global tcl_platform
    global serverUp
    
    if {$serverUp} {
        return
    }
    if {$serverWish == {}} {
        set serverWish [info nameofexecutable]
    }
    # start execution server
    set command [list $serverWish $serverName $port]
    
    eval exec $command &
    set serverUp 1
}

proc Client::remoteExecute {sock command} {
    
    puts $sock $command
    
}

proc Client::initClientTerminal { \
        {host localhost} \
        {port 9001} \
        {serverName "./evalServer.tcl"} \
        {sockHandleProc Client::showResult}} {
            
    variable terminal
    
        
    frame .ft
    set terminal(win) [text .ft.clientTerminal \
            -wrap word \
            -yscrollcommand [list .ft.sb set]]
    scrollbar .ft.sb -orient vertical -command [list .ft.clientTerminal yview]
    $terminal(win) tag configure result -foreground blue
    $terminal(win) tag configure error -foreground red
    
    # setup client sock
    set terminal(sock) [eval [list Client::initExecutionClient $host $port $sockHandleProc $serverName]]
    if {$terminal(sock) == {}} {
        return {}
    }
    
    frame .f
    button .f.b -text "Exit" -command Client::exitExecutionServer
    button .f.c -text "Run Tcl App" -command "Client::runTclApp $terminal(sock)"
    
    pack $terminal(win) -expand yes -fill both -side left
    pack .ft.sb -fill y -side left
    pack .ft
    pack .f.b .f.c -side left -fill both -expand yes
    pack .f -fill both -expand yes
    bind $terminal(win) <Return> {
        #get command and execute it
        set command [$Client::terminal(win) get "insert linestart" "insert lineend"]
        eval [list puts $Client::terminal(sock) $command]
    }
    wm title . "ASED Execution Terminal"
    wm protocol . WM_DELETE_WINDOW {Client::exitExecutionServer}
    return $terminal(sock)
}

global serverUp
set serverUp 0

if {[string compare [info script] $argv0] == 0} {
    
    switch -- $argc {
        0    {
            set Client::port 9001
            set serverName "./evalServer.tcl"
            set sockHandleProc "Client::showResult"
        }
        1    {
            set Client::port [lindex $argv 0]
            set serverName "./evalServer.tcl"
            set sockHandleProc "Client::showResult"
        }
        2    {
            set Client::port [lindex $argv 0]
            set serverName [lindex $argv 1]
            set sockHandleProc "Client::showResult"
        }
        3    {
            set Client::port [lindex $argv 0]
            set serverName [lindex $argv 1]
            set sockHandleProc [lindex $argv 2]
        }
        default {
            # sockHandleProc has to be the the name of the sockHandler proc
            eval [list puts "usage: evalClient.tcl ?port? ?serverName? ?sockHandleProc?"]
            exit
        }
    }
    eval [list Client::initClientTerminal localhost $Client::port $serverName $sockHandleProc]
}