TStcltk 発言

こんにちは、山本です。

たまにはスクリプトのネタもpostしなくちゃ(^^;、と思って
急遽チャットスクリプトを作ってみました。
このスクリプトを少なくとも2台以上のマシンで動かして下さい。そして、
ウィンドウの一番上に相手先のホスト名やIPアドレスを入力すれば準備OKです。
一番下の行でテキストを入力すると、相手のチャットスクリプトに
メッセージが送信されます。

私はWindows2000/XPとMacOS9の上でこのスクリプトを動かしています。
転送文字コードをutf-8に変換しているおかげで、WindowsとMacの間でも
丸数字(○の中に1とか入っているアレ)を正常に送受信できています。
# 例えば、○の1はWindowsが0x8740であるのに対しMacでは0x8540なので
# そのまま送ると文字化けしてしまいます。

なお、スクリプトの中でfconfigure -blocking 0やっていますが、
今回の場合、その効果はありません。本当はnon blocking I/Oの
サンプルにしたかったんですけど、失敗(^^;

-----[chat.tcl]----------------------------------------------------
#!/usr/local/bin/wish
set port 30000
set hostname {}
set message {}
frame .hostname
label .hostname.l -text ホスト: -anchor e
entry .hostname.e -textvariable hostname -width 48
bind .hostname.e <Return> {focus .message.e}
pack .hostname.l .hostname.e -side left -expand yes -fill x
text .text -width 48 -height 20 \
        -takefocus 0 -relief flat -yscrollcommand {.ys set}
.text tag configure postmessage -foreground green
.text tag configure getmessage -foreground blue
scrollbar .ys -orient vertical -command {.text yview}
frame .message
entry .message.e -width 48 -textvariable message
bind .message.e <Return> PostMessage
button .message.b -text 送信 -command PostMessage
pack .message.e .message.b -side left -expand yes -fill x
grid .hostname - -sticky ew
grid .text -sticky nesw
grid .ys -row 1 -column 1 -sticky ns
grid .message - -sticky ew
grid rowconfigure . 1 -weight 1
grid columnconfigure . 0 -weight 1
bindtags .text {. all}
socket -server GetMessage $port
proc PostMessage {} {
    .text insert end 自分>$::message\n postmessage
    .text see end
    if [string length $::hostname] {
        set fd [socket -async $::hostname $::port]
        fconfigure $fd -encoding utf-8 -blocking 0
        puts -nonewline $fd $::message
        close $fd
    }
    set ::message {}
}
proc GetMessage {fd ip port} {
    fconfigure $fd -encoding utf-8 -blocking 0
    fileevent $fd readable [list Receive $fd]
    .text insert end $ip> getmessage
}
proc Receive fd {
    if [eof $fd] {
        .text insert end \n
        .text see end
        close $fd
        return
    }
    .text insert end [read $fd] getmessage
}
focus -force .hostname.e

--
Koichi Yamamoto, 
http://www3.ocn.ne.jp/~yamako/