Super Technique 講座

Tcl/Tk によるGUI(1)

John Ousterhout の作った言語 Tcl/Tk は、非常に便利な言語である。これは簡単なスクリプト言語の側面と、GUIツールキットの二面性を持ち、そのために多彩な理用法が可能である。ここで、筆者が経験した多様な使い方を紹介し、Tck/Tk の有効性について議論しよう。やや未完成なかたちで公開するが、それでも有益だろう。そのうち追加するので待っていて欲しい。

済まぬが量がちょっと異常になってしまった。それゆえ前編・後編と分けて記述する。続けて読まれたい。

前編

後編


Tcl/Tk とは

Tcl/Tk は John Ousterhout が作った言語である。正確にはシェル言語風のマクロ置換言語である Tcl と、その上から使うGUIツールキットである Tk の2つに分かれており、Tk を使わない Tcl のみのスクリプト言語としても使える。この小論では原則的には Tcl の話よりも Tk の話が中心となる。なぜならば、シェル言語に精通したプログラマならば Tcl の利用は簡単であり、一種の「賢いシェル」として使えるものに過ぎないが、Tk は一番簡単で効率的なGUIツールキットであるからである。この側面がさまざまな利用法を生んでいる。たとえば、Perl から Tk を利用する Perl/Tk など、現在のスクリプト言語でGUIを実現するライブラリのほとんどは、この Tk をベースに作られているのである。だから、Tk の利用は非常に応用範囲が広い。

ここでは利用の形態別に、Tcl/Tk のさまざまな側面に照明を当てていこう。

Tcl/Tk アプリケーション
Tcl/Tk のみでアプリケーションを書くことにもメリットがある。なぜなら Tcl/Tk は UNIX+Xウィンドウ、Windows、Machintosh など、主要なGUI環境のすべてで基本的に動作する。つまり、Tcl/Tk で書いておけばそれほど移植に苦労せずにマルチプラットフォーム・アプリケーションを実現できる。これはインタプリタの利点でもある。またリストなどのデータ構造も揃っており、スクリプトがかなり簡潔なのもうれしい。とはいえ、Tcl マクロ置換言語なので、馴れるまではちょっと練習が必要でもある。この側面は速攻で書ける「プロトタイピング言語」としての適性を備えていることを証明しているのである。
MVCデザイン
「M(モデル)V(ヴュー)C(コントローラ)」という言葉は、今では当り前のように使われている。しかし、これはオブジェクト指向設計に固有な方法論でも何でもない。よくUNIXのGUIアプリケーションだと、機能を実現したコマンドラインツールをまず作成し、それとは別個にそのコマンドラインツールを利用するGUIプログラムを別個に作る、という事がなされる。これはいわゆる「フロントエンド/バックエンド」である。つまり、C言語で書かれたコマンドライン(と標準入出力)のプログラムを利用するGUIインターフェイスを、Tcl/Tk で書くのである。この分業は非常に効果的である。完璧に動作するコマンドラインの機械語プログラムが処理の高速性を保証し、インタラクティブな使い勝手は、インタプリタによる柔軟な変更可能性によって、非常に扱いやすいものになる。また機能とインターフェイスが完全に分離されることによって、プログラムデザインが判りやすいものになり、バグを未然に防ぐ。これほど効果的な分業は使わなければ損である。
C言語プログラムから Tcl/Tk スクリプトを生成してGUIを実現する
これはかなり使いでのある技法である。つまり、具体的なGUIのレイアウトが変化に富んだ、細かいGUIインターフェイスを大量に用意しなければならない場合、何かのデータベースからプログラムによって自動的にインターフェイスを生成したくなる。このための言語として、Tcl/Tk は最適である。なぜならば、Tcl/Tk は簡潔であり、多少の配慮とわずかな工数でGUIインターフェイスを生成できるのである。これをうまく使わない手はないが、これをするには現実的には「双方向パイプ」を使い倒す能力が必要である。
C言語によってインタプリタを作成する
Tcl/Tk は「インタプリタ」の概念によって、独自の「コマンド(Tclの場合)」や「ウィジット(Tkの場合)」を追加しやすく設計されている。だから、主要な処理は Tcl/Tk に任せて、独自に実装する機能をC言語で「コマンド」や「ウィジット」として記述して、Tcl/Tk の上から利用するのである。これは非常に簡便なやり方であり、Tcl/Tk の柔軟性をうまく利用している。しかし、これをするためには、Ousterhout 自身が書いた「Tcl&Tk ツールキット」(邦訳 ソフトバンク)あたりをちゃんと読む必要があるが、この小論でもその入門を解説する。
C言語の上から Tk をツールキットとして利用する
「インタプリタ作成」のよりヘヴィなバージョンとして、C言語の上から他のツールキットを利用するように、Tk をツールキットとして利用することもできる。これも多少解説するが、このやり方を理解するためには多少のXツールキットに関する知識が必要にはなる。
他のスクリプト言語のGUIライブラリから利用する
先にも述べたように、各種スクリプト言語のデフォルトのGUIツールキットはほとんどTkベースである。ここでは Perl による Perl/Tk の使い方を紹介するが、Ruby や Python などでも同様なTkベースのGUIツールキットが存在する。要するにこういうGUIライブラリを使い倒すための基礎知識は、やはり Tcl/Tk である。

さあ、こんなにも多彩な利用法があるのである。「使わにゃ損」というものだ。


Tcl/Tk アプリケーション

まず、Tcl/Tk の使い方の紹介を兼ねて、スタンドアロンの Tcl/Tk アプリの作り方を説明しよう。ごく単純なスクリプトであるラベルと終了ボタンを備えた Tcl/Tk スクリプトは次の通り。

#!/usr/bin/wish

wm title . "Tcl/Tk"
wm geometry . "150x50"
label .lab -text "Tcl/Tk"
button .quit -text "Quit" -command { exit 0 }
pack .lab .quit

これは次のようなウィンドウを作成する。

強調すべきことは、これほど単純なプログラムでウィンドウを作れる言語は他にはない、ということである。要するに Tcl/Tk はウィジットの構造を明快かつ単純に示すことに重点を置いて設計されているのだ。現状のX+Tcl/TK では、タイトルを除いてはちゃんと日本語を表示するので安心して欲しい。では、先程のプログラムを解説して行こう

#!/usr/bin/wish
Tcl/Tk の Tk を使ったアプリ用のインタプリタは大概 /usr/bin/wish である。Tcl のみのインタプリタとして /usr/bin/tclsh があるが、wish ばかり使うのが普通だろう。
wm title . "Tcl/Tk"
ウィンドウタイトルに「Tcl/Tk」の文字を設定する。「wm」はウィンドウマネージャの略であり、要するにウィンドウマネージャに与えるプロパティとしてタイトルを設定している。
wm geometry . "150x50"
同様にウィンドウマネージャにジオメトリ(表示サイズ)を与えて、ウィンドウサイズを設定している。
label .lab -text "Tcl/Tk"
さて、具体的なウィジットを作っていく。Tk ではトップウィンドウは「.」で示されて、トップウィンドウの中にウィジットを作って行くから「.lab」のようなウィンドウの名前になる。つまり、「label .lab」とは、「ラベルウィジット」を作成するコマンド「label」に、作成するウィンドウのパス「.lab」(トップレベルウィンドウの直下の lab という名前のウィンドウ)を与える、ということになる。そして、「-text "Tcl/Tk"」はそのオプションとして表示文字に「Tcl/Tk」という文字列を設定するのである。勿論「-fg red -bg blue」とすれば、表示文字が赤に、背景色が青になる。このようにコマンドラインオプションのように、さまざまなプロパティを設定できるのである。
button .quit -text "Quit" -command { exit 0 }
さてこれもウィジットの作成である。「button .quit」はボタンウィジットをトップ直下に「quit」の名前で作成する。そして「-text "Quit"」によってボタンの表示テキストを「Quit」にしている。当然ボタンであるのだから、ボタンが押された時のアクションが記述できなければ意味がない。それを与えるのが「-command { exit 0 }」である。つまりコールバックだ何だということを大して考えなくても、直感的な書き方でコールバックを与えることができる。Tcl/Tk では「{ }」で囲まれた内容は、「Tcl/Tk ツールキット」によると次のように処理される。

ブレースは、空白文字を含んだ文字列を囲んでワードを作ることができるという点でダブルクォートと同じ働きをするのだが、2つの点で異なっている。1つは、ブレースをネストして用いることができるということ。(中略) もう1つの違いは、ダブルクォートの中では置換が起こらないということである。

要するに、-command の引数である「{ exit 0 }」は、一種の文字列として、-command のプロパティとして保存される。そして、アクションが起きたときに、その「exit 0」の文字列が評価されて、インタプリタが終了するのである。こういう風に、Tcl は文字列ベースのマクロ置換言語であることに留意されたい。
pack .lab .quit
さて、最後はジオメトリマネージャである。これは「パッカー」と呼ばれる一番普通のジオメトリマネージャであり、ジオメトリマネージャは作成したウィジットを配置してそれをリアライズする。要するにジオメトリマネージャの呼び出しがないウィジットは、いくら作成しても表示されないのである。「パッカー」は適当なオプションを操作して具体的なレイアウトを実現できる。たとえば、「pack .lab .quit -side left」とすれば、左寄せで配置するし、「pack .lab -side left」「pabk .quit -side right」とすれば、左右に配置する。

さあ、随分直感的で判りやすいコマンド体系であることがわかるだろう。また、Tk のウィジットは他のツールキットと比較して種類が多く(Tk より多いのって Swing くらいか...)、しかも個々のウィジットの機能が豊富である。大変使いやすいウィジットが多い。例えば描画用に使うウィジットである canvas ウィジットは、描画オブジェクトを自前で管理してくれる。だから、マウスで指定した描画をした線を取り消したり、再描画する処理だって、どうということはなかったりする。ちょっと頭が下がるようなよくできたウィジットが多い。

Tk のウィジットには次のものがある。これらにどういうオプションが設定できるかは、一番速いのは man を見ることである。なぜか Tcl/Tk は伝統的に man を真面目に書いてあるので、man で見れば一目瞭然である。

これらのウィジットには共通していくつかの「コマンド」が使える。つまり、

# ウィジット configure オプション 設定内容
.button configure -text "changed text"
# ウィジット cget オプション
set text [.button cget -text]
puts "text of .but is $text"

こんな具合にである。ウィジットにはこんなものがある。

button
コマンドボタンを実現する。
canvas
画像描画用キャンバスである。先程も触れたように、沢山のコマンドがあり、これを使って描画オブジェクトを作成できる。描画オブジェクトには円弧(arc)、画像(bitmap)、線(line)、オーヴァル(oval)、多角形(polygon)、四角形(rectangle)、文字(text)、ウィンドウ(window)などがある。要するにちょっとしたお絵書きソフトは何も考えずに実装できるのである。
checkbutton
非排他選択チェックボックスである。-variable オプションで変数と結びつけ、-onvalue, -offvalue オプションでオン・オフの値を設定する。
entry
1行の文字列を入力するものである。getコマンドで現在の入力文字列を取得できるし、各種編集機能やカット&ペーストとの連係も可能である。
frame
各種ウィジットを中に入れることができるコンテナである。適当に複数のウィジットをグループ化するのに便利である。
label
文字を表示するだけのウィジットである。
listbox
いわゆるリストを実現する。やはり get コマンドで現在の選択内容を取得できるし、スクロールバーとの連係もサポートされている。
menu
プルダウンメニューやカスケードメニューを実現する。add コマンドで個々のメニュー項目を設定する。
menubutton
menu 用の menubutton を実現する。-menu オプションで menu ウィジットを設定する。
message
複数行に渡る文字を表示するためのウィジットである。text ウィジットのように編集は出来ない。
radiobutton
排他選択ラジオボタンである。オプションの使い方は checkbutton と同様である。
scale
数値入力用スライダーを作る。
scrollbar
スクロールバーを作る。listbox, canvas, text ウィジットと連係させることができる。また、entry だって横方向のみ連係されることが出来る。
text
複数行を編集可能なテキスト領域を実現する。何もしなくてもほとんど小規模なエディタである。キーバインドは Emacs 風であり、使いやすい。大量の編集用コマンドがある。
toplevel
ダイアログを作るのに使う、トップウィンドウから独立したシェルである。
tk_dialog, tk_getOpenFile, tk_getSaveFile, tk_messageBox, tk_popup など
これらは Tk の中であらかじめ用意されている便利なダイアログボックスたちである。適当に用途に合わせて使えば良い。

MVCデザイン

さて、イントロは終りで今からが本題。いわゆるMVC風のフロントエンド/バックエンドといううまい設計技法について述べて行こう。

Tcl/Tk は速攻でGUIインターフェイスを作り上げることができ、しかもスクリプト言語なので修正が容易である。これは難しめのコマンドライン構文を持ったUNIXコマンドを実行するフロントエンドのインターフェイスとして最適なのである。また、この分割は次の利点があることになる。

  1. インターフェイスは一番変わりやすい... この変わりやすい部分が、不変の「機能」と分離される。しかも変更が独立になるので、影響を機能に与えない。
  2. 機能とインターフェイスは設計の上でも独立させた方が判りやすい。Windows プログラムでありがちな機能とインターフェイスが癒着しまくったプログラムってたまらんな。
  3. 移植性も高まる。Tcl/Tk スクリプトの移植性はかなり高いので、うまくいけば「機能」の部分のコンパイル一発で移植できる。ウィンドウシステムのような互換性を欠いた部分を、うまく隠蔽できるのである。
  4. 特定用途にあわせたインターフェイスを複数作っても構わない。これは「機能」の部分を一種のライブラリのように使うことになる。これは未熟なユーザから危険な動作を隠したり、危険な動作をする場合に一旦警告を出してからするようなバリエーションを作れる。

まあ、今時の話、Linux だってルーザー向きのGUIインターフェイスで各種設定をするような御時勢である。あなたのコマンドラインプログラムだって、修正せずにGUIインターフェイスを Tcl/Tk で速攻で作るだけで、意外なヒット作に化けるかもしれない....

ではここで、MIDIファイルと音楽ファイルをブラウズするインターフェイスを作ってみよう。これは単に playmidi か sox による変換をして、一覧の音声ファイルを再生するだけの阿呆なプログラムである。まだ Tcl/Tk の本格的な例は出していないので、サンプルプログラムくらいのつもりで見てくれたまえ。当然 root じゃないと再生しないぞ。

#!/usr/bin/wish

# コメントはシェルと同じ
wm title . "Music Browser"  # タイトル設定
set theFile ""              # 再生するファイル

# tk_getOpenFile を呼び出して、再生するファイル名を取得するサブルーチン
proc set_dir {} {    # サブルーチン定義はこうする
    global theFile   # グローバル変数はこうやって指示する
    # set 変数名 [実行するコマンド] で値をセット。代入式とかはないシェル風構文
    set dir [tk_getOpenFile -title "Open music file" \
             -filetypes {{{MIDI} {.mid .midi}} {{SOUND} \
                         {.au .wav .snd}} \ 
                         {{All Files} {*}}}] 
    # テンポラリなローカル変数 dir に値があれば、グローバル変数 theFile にセット
    if { $dir != "" } { set theFile $dir }
}

# 再生をするサブルーチン。引数が今回はある
proc play { file } {
    global MidiCommand AudioCommand

    # glob パターン風のマッチ。file の値が "*.mid*" であれば
    if [ string match *.mid* $file ] {
	exec sh -c "playmidi -e $file"  # playmidi を実行
    } else {
    # それ以外は音声ファイルとして、sox で変換して /dev/audio に書き込んで再生
	exec sh -c "sox $file -U \'tmp$$.au\'; cat \'tmp$$.au\' \
                   >/dev/audio; rm \'tmp$$.au\'"
    }
}

# 横並びで作成
frame .l1   # 1行目をグループ化。このグループの中にあるウィジットは .l1.*
label .l1.lab -text "再生ファイル"
# .l1.ent ウィジットと変数 theFile とを結びつけている
entry .l1.ent -textvariable theFile -width 30  
button .l1.but -text "検索" -command { set_dir }

frame .l2
button .l2.go -text "再生" -command { play $theFile }
button .l2.quit -text "終了" -command { exit 0 }

# 縦並びをパック
pack .l1 .l2 -side top
# 横並び各行をパック
pack .l1.lab .l1.ent .l1.but -side left
pack .l2.go .l2.quit  -side left

C言語プログラムから Tcl/Tk スクリプトを生成してGUIを実現する

さて、今のなんかはシェル言語が判ってりゃどうという程の内容もない。単に「賢いシェル」+「GUIツールキット」程度の内容なのである。しかし、今からはCプログラムとの連係プレーである。

Cで書かれたアプリケーションで、細かいGUIインターフェイスが沢山欲しい場合がある。その時にいちいちツールキットを使って書いていたんじゃ身が持たない。また、Motif なんか使って書いたら、「俺の環境には Motif なんか無いぞ!」というユーザのクレームが来ること必定である。まあ、「X環境には標準ツールキットなんてない」という現実をしっかと見据える必要があるわけだ(Athena じゃヤだな)。

そこで最も現実的な解決は、やはり Tk ということになる。Tk ならばフリーであり、大概のX環境(Win や Mac も含め...)であるに決まってるし、「え、Tcl/Tk 入れてないの? あれはいれなきゃ損だよ!」と切り返すこともできるのである(といいな! ちゃんと INSTALL に「Tcl/Tk」が必要だから入れておけ」と書いておくんだよ!)。

そこでC言語から、適当なGUIインターフェイスを生成してやるわけだが、Tcl/Tk だとこれが簡潔で済む、というメリットがあるし、しかも単にサブプロセスで wish を起動してパイプでコマンドを送りつけ、選択結果などをパイプで取得するのが、UNIX プログラムと言うものだろう。だから、結果として双方向パイプを理解してないとキビしいが、これについての解説は「キュー(FIFO)〜双方向パイプ」にあるので、知らない人はあらかじめ見ておいてくれたまえ。

まあ、これも凝ろうと思えばいっくらでも凝れるもので、GUIインターフェイスとコマンドラインインターフェイスとを選択できるようにして、設定内容はデータのかたちで共有する(「MVC」だな)こともできる。まあ、そこまでサンプルではすることもないので、データから単純にGUIを生成し、wish に渡して選択結果を格納し直すくらいのプログラムを書いてみよう。

#include <stdio.h>
#include <unistd.h>

/* GUItype メンバの記号定数 */
#define TK_ENTRY  0   /* entry Widget */
#define TK_CHECK  1   /* checkbutton Widget */
#define TK_RADIO  2   /* radiobutton Widget */

/* vartype メンバの記号定数 */
#define VAR_STRING 0  /* cvar が char * で deflt も char * */
#define VAR_INT  1    /* cvar が int * で deflt も int * */
#define VAR_IMD  2    /* cvar が int * で delft は int */

struct ConfItem {
   int line;     /* 表示行 */
   int GUItype;  /* 生成する Widget のタイプ */
   char *var;    /* Tk の上で結びつける変数名 */
   char *desc;   /* 説明表示 */
   int vartype;  /* C の上で結びつける変数のタイプ */
   void *cvar;   /* C の上で結びつける変数のアドレス */
   int deflt;    /* Tk のデフォルトの値 */
};

/* Tk のインターフェイスで操作する変数たち */
char Str[16] = "default value";
int Opt1 = 0;
int  Opt2 = 0;

/* インターフェイスの定義 */
struct ConfItem Confs[] = {
   { 1, TK_ENTRY, "str", "文字列を入力してね", VAR_STRING, 
        Str, (int)Str },
   { 2, TK_CHECK, "opt1", "気が向いたら選択",  VAR_INT,  
        &Opt1, (int)&Opt1 },
   { 3, TK_RADIO, "opt2", "どれか選択のA", VAR_IMD, 
        &Opt2, 0 },
   { 3, TK_RADIO, "opt2", "どれか選択のB", VAR_IMD, 
        &Opt2, 1 },
   { 3, TK_RADIO, "opt2", "どれか選択のC", VAR_IMD, 
        &Opt2, 2 },
};

こんなデータが次のような Tcl/Tk スクリプトに化けるのである。

#!/usr/bin/wish

wm title . "Select It!"

label .lab -text "選択してね"
pack .lab -side top

set str "default value"
set opt1 0
set opt2 0

frame .l1
label .o1 -text "文字列を入力してね"
entry .o2 -textvariable str 
pack .o1 .o2 -in .l1 -side left

frame .l2
checkbutton .o3 -text "気が向いたら選択" -variable opt1
pack .o3 -in .l2 -side left

frame .l3
radiobutton .o4 -text "どれか選択のA" -variable opt2 -value 0
radiobutton .o5 -text "どれか選択のB" -variable opt2 -value 1
radiobutton .o6 -text "どれか選択のC" -variable opt2 -value 2
pack .o4 .o5 .o6 -in .l3 -side left

frame .last
button .ok -text "了解" -command { puts "str=$str"; \
                                   puts "opt1=$opt1"; \
                                   puts "opt2=$opt2"; \
                                   exit 0 }
pack .ok -in .last

pack .l1 .l2 .l3 .l4 -side top

これは次のGUIを生成する。

その操作をする関数は次の通りである。

/* 変数を初期化し、終了ボタンが押したときの実行内容(vars)を準備する */
static void gererateVars( FILE *fp, struct ConfItem *conf, 
                          int num, char *vars )
{
   int i;
   int prev = -1;
   int len;

   for( i = 0; i < num; i++ ) {
      if( prev != conf[i].line ) {  /* radiobutton は複数行ある */
         if( conf[i].vartype == VAR_STRING ) {
            fprintf( fp, "set %s \"%s\"\n", conf[i].var, 
                                          (char *)conf[i].deflt );
         } else if( conf[i].vartype == VAR_INT ) {
            fprintf( fp, "set %s %d\n", conf[i].var, 
                                          *(int *)conf[i].deflt );
         } else if( conf[i].vartype == VAR_IMD ) {
            fprintf( fp, "set %s %d\n", conf[i].var, 
                                          conf[i].deflt );
         }
	 /* 終了ボタンを押したときの実行コマンドの作成 */
         len = strlen( vars );
         sprintf( &vars[len], "puts \"%s=$%s\"; ", conf[i].var, 
                                             conf[i].var );
      }
      prev = conf[i].line;
   }
}

/* 以下3関数が、各Widget タイプ別の出力生成 */
static int sub_entry( FILE *fp, struct ConfItem *conf, int onum, 
                      char *pack )
{
   int len;
   fprintf( fp, "label .o%d -text \"%s\"\n", onum, conf->desc );
   len = strlen(pack);
   sprintf( &pack[len], ".o%d ", onum++ );
   fprintf( fp, "entry .o%d -textvariable %s\n", onum, conf->var );
   len = strlen(pack);
   sprintf( &pack[len], ".o%d ", onum++ );
   return onum;
}

static int sub_checkbutton( FILE *fp, struct ConfItem *conf, 
                            int onum, char *pack )
{
   int len;
   fprintf( fp, "checkbutton .o%d -text \"%s\" -variable %s\n", 
                 onum, conf->desc, conf->var );
   len = strlen(pack);
   sprintf( &pack[len], ".o%d ", onum++ );
   return onum;
}

static int sub_radiobutton( FILE *fp, struct ConfItem *conf, 
                            int onum, char *pack )
{
   int len;
   fprintf( fp, 
        "radiobutton .o%d -text \"%s\" -variable %s -value %d\n",
        onum, conf->desc, conf->var, conf->deflt );
   len = strlen(pack);
   sprintf( &pack[len], ".o%d ", onum++ );
   return onum;
}

/* ConfItem を解釈し、それに見合った Tcl/Tk スクリプトを生成する */
void generateTk( FILE *fp, char *title, char *mess, 
           struct ConfItem *conf, int num )
{
   int i, j;
   int prev = -1;
   char pack[256];  /* pack すべき Widget をとっておく */
   char vars[256];  /* 終了ボタンを押したときに実行する内容を取っておく */
   int objnum = 1;  /* Widget の生成順に番号を振って管理 */

   vars[0] = '\0';

   /* プロローグ */
   fprintf( fp, "#!/usr/bin/wish\n\n" );
   fprintf( fp, "wm title . \"%s\"\n\n", title );
   fprintf( fp, "label .lab -text \"%s\"\npack .lab -side top\n\n",
                 mess );
   gererateVars( fp, conf, num, vars );  /* 変数に初期値を与える */

   /* 各 ConfItem 別の生成 */
   for( i = 0; i < num; i++ ) {
      if( conf[i].line != prev ) { /* line によって横方向にまとめる */
         if( prev != -1 ) {
            fprintf( fp, "pack %s -in .l%d -side left\n\n", 
                          pack, prev );
         }
         fprintf( fp, "frame .l%d\n", conf[i].line );
         pack[0] = '\0';
      }
      if( conf[i].GUItype == TK_ENTRY ) {
         objnum = sub_entry( fp, &conf[i], objnum, pack );
      } else if( conf[i].GUItype == TK_CHECK ) {
         objnum = sub_checkbutton( fp, &conf[i], objnum, pack );
      } else if( conf[i].GUItype == TK_RADIO ) {
         objnum = sub_radiobutton( fp, &conf[i], objnum, pack );
      }
      prev = conf[i].line;
   }
   if( prev != -1 ) {
      fprintf( fp, "pack %s -in .l%d -side left\n\n", pack, prev );
   }

   /* エピローグ */
   fprintf( fp, "frame .last\n" );
   fprintf( fp, "button .ok -text \"了解\" -command { %s exit 0 }\n",
            vars );
   fprintf( fp, "pack .ok -in .last\n" );

   /* 全 Frame のパック */
   fprintf( fp, "pack " );
   for( j = 1; j <= prev; j++ ) {
      fprintf( fp, ".l%d ", j );
   }
   fprintf( fp, ".last -side top\n" );
}

/* パイプから受け取った結果から、変数に設定 */
void parseOutput( struct ConfItem *conf, int num, char *buff )
{
   char *p;
   char *key, *val;
   int i;
   int len;

   /* key=val のかたちで1行がなっている。これをパースする */
   len = strlen(buff);
   if( buff[len-1] == '\n' ) buff[len-1] = '\0';

   for( p = buff; *p && *p != '='; p++ );
   if( *p == '\0' ) return;
   *p = '\0';
   val = p + 1;
   key = buff;

   /* ConfItem の中で一致するものを探して設定 */
   for( i = 0; i < num; i++ ) {
      if( strcmp( key, conf[i].var ) == 0 ) {
         if( conf[i].vartype == VAR_STRING ) {
            strcpy( (char *)conf[i].cvar, val );
         }  else if( conf[i].vartype == VAR_INT 
            || conf[i].vartype == VAR_IMD ) {
            int *var = (int *)conf[i].cvar;
            *var = atoi( val );
         }
         break;
      }
   }
}

/* 双方向パイプの実行 */
int do_TKpipe( char *title, char *mess, struct ConfItem *conf,
               int num )
{
   int p1[2], p2[2];  /* 2組のデスクリプタ */
   int ret;           /* 戻り値 */
   char buff[256];

   /* パイプの作成 */
   if( pipe( p1 ) == -1 ){  /* 0=子読み、1=親書き */
      printf( "cannot open pipe\n" );
      return -1;
   }
   if( pipe( p2 ) == -1 ){  /* 0=親読み、1=子書き */
      printf( "cannot open pipe\n" );
      return -1;
   }
   ret = 0;
   if( fork() ){   /* 親側 */
      /* パイプに書き込む */
      FILE *fp1, *fp2;
      close( p1[0] ); close( p2[1] );  /* 不要なデスクリプタは閉じる */

      /* fdopen(3) でFILE構造体を作り、扱いやすくする */
      if( (fp1 = fdopen( p1[1], "w" )) == NULL ) {
         fprintf( stderr, "cannot fdopen(3)!\n" );
         return -1;
      }
      if( (fp2 = fdopen( p2[0], "r" )) == NULL ) {
         fprintf( stderr, "cannot fdopen(3)!\n" );
         return -1;
      }
      generateTk( fp1, title, mess, conf, num );
      fclose( fp1 );  /* 書き込み終了を告げる */
      wait( &ret );    /* 子プロセスの終り待ち */
      if( ret == 0 ){
         /* 当然 fgets(3) だって使える */
         while( fgets( buff, sizeof(buff), fp2 ) ){
            parseOutput( conf, num, buff );
         }
      } else {
         ret = -1;
      }
      fclose( fp2 );

   } else {        /* 子側 */
      close( p1[1] ); close( p2[0] );  /* 不要なデスクリプタは閉じる */
      close( 1 );      /* 標準出力を閉じ */
      dup2( p2[1], 1 );  /* パイプの出力につなぐ */
      close( 0 );      /* 標準入力を閉じ */
      dup2( p1[0], 0 );  /* パイプの入力につなぐ */
      /* /bin/sh の実行 */
      execl( "/usr/bin/wish", "wish", NULL );

      /* 以降のコードは exec(2) がエラーでない限り実行されない */
      fprintf( stderr, "load program /usr/bin/wish\n" );
      perror("");
      exit(1);
   }
   return( ret );
   
}

void main()
{
   printf( "Str=%s Opt1=%d Opt2=%d\n", Str, Opt1, Opt2 );
   do_TKpipe( "Select It!", "選択してね", 
               Confs, sizeof(Confs)/sizeof(struct ConfItem) );
   printf( "Str=%s Opt1=%d Opt2=%d\n", Str, Opt1, Opt2 );
   /* 何回やっても大丈夫! */
   do_TKpipe( "Select It!", "選択してね", 
               Confs, sizeof(Confs)/sizeof(struct ConfItem) );
   printf( "Str=%s Opt1=%d Opt2=%d\n", Str, Opt1, Opt2 );
}

まあ、こんな要領である。ConfItem が複数あって、こまごまと面倒な場合にかなり役にたつ。なぜなら、ConfItem がデータであり、データを解釈して生成しているのだから、楽だしね。また、ConfItem の内容をプログラムで適当に修正することもできるし、ConfItem を usage とか、コマンドラインでの設定プログラムにも使うことができる。まあ、後は頑張ってくれ。

もう一つのやり方は、今のケースでは全部Cプログラムの側で頑張って生成したのだが、もっと扱いやすい形でずるずるとデータを渡し、受け取る側をもう少し「賢いTcl/Tkスクリプト」にしておいて、サブプロセス側で標準入力を読んで解釈してウィジットを生成する、というやり方もある。これは頑張って書いてみる価値がある。


タートルグラフィックス用インタプリタ

そういうわけで、こういうのはどうだ。元々は LOGO というLisp系言語で「発明」されて広まったグラフィックスの手法として、「タートルグラフィックス」というのがあることは御存じかな? これは要するに「亀さん」がキャンバスの上にいて、「亀さん、3歩前に」とか「亀さん、30度右に回って」とかコマンドを与えて、亀さんを動かすのである。この亀さんが筆を持っていて、「亀さん、筆を降ろして」と頼むとそうしてくれる。で、亀さんが動くとその軌跡がキャンバスに描かれる...という寸法だ。

ということは、何かの言語(再帰が重要なのがよろしい)を作った際に、おまけとしてこのようなタートルグラフィックス用の関数を用意する、というのも面白い。基本的に言語処理系は比較的互換性が良いプログラムのうち(コンパイラなんて考えてみりゃテキストフィルターみたいなもんだ)なので、コンパイル一発で通りそうな気がするのだが(あまり特化した組込み関数を用意しなきゃね)、こういうタートルグラフィックスを用意したら最後、ウィンドウシステム依存になるのは目に見えている。

だったら、これは Tcl/Tk の出番だ。先ほど解説した双方向パイプを使って、サブプロセスで「タートルグラフィックスのコマンドを理解し、亀さんが描画するウィンドウを作る」Tcl/Tk スクリプトを用意して、それにコマンドを流し込めばイイのである。こっちの方がずっとお洒落で、MVCっぽいわけで、汚い互換性処理を全部 Tcl/Tk に丸投げできる。

だから、こいつにコマンドを食わす言語なんてなんでもいい。好きなもんを作ってくれ。また、当然単独で起動すれば標準入力からコマンドを食うから、デバッグも楽だ。コマンド体系はこんなところか。

forward num
現在亀が向いている方向にnumpixel前に進む。
backward num
現在亀が向いているのとは反対方向にnumpixel進む。
goto x y
座標x,yへ移動。
penup
ペンを上げる。描画されなくなる。
pendown
ペンを下げる。描画されるようになる。
rotate deg
今の向きから更にdeg度回転する。
pencolor colorname
ペンの色を変える。
penwidth pixel
ペンの太さを変える。
background colorname
背景色を変える。
resize width height
キャンバスのサイズを変える。
clear
キャンバスを消去する。

まあ、こんなところだろう。実装はこんなところ。細かいインターフェイスを実装した関数が多いが、どうというほど難しくもない。まあ、Canvas ウィジットはよく出来ているので、やろうと思えばもっと高度なこともできるが、こんなところにしておこう。

#!/usr/bin/wish

グローバル変数定義
set PI  3.14159265358979323846
set nowx 100  # 現在位置のX座標
set nowy 100  # 現在位置のY座標
set pen 0     # ==0 非描画(penup) ==1 描画(pendown)
set deg 0     # 現在亀が向いている方向
set color black # ペンの色
set penw 1    # ペンの線の太さ

インターフェイス定義
proc forward { s } {
   global deg nowx nowy pen PI
   global color penw
   set rad [expr $deg * $PI / 180.0]
   if { $pen == 1 } {
      set nextx [expr $nowx + $s * cos($rad)]
      set nexty [expr $nowy + $s * sin($rad)]
      .can create line $nowx $nowy $nextx $nexty -fill $color \
          -width $penw -tags all
      set nowx $nextx
      set nowy $nexty
   } else {
      set nowx [expr $nowx + $s * cos($rad)]
      set nowy [expr $nowy + $s * sin($rad)]
   }
}

proc backward { s } {
   global deg nowx nowy pen PI
   global color penw
   set rad [expr ($deg + 180.0) * $PI / 180.0]
   if { $pen == 1 } {
      set nextx [expr $nowx + $s * cos($rad)]
      set nexty [expr $nowy + $s * sin($rad)]
      .can create line $nowx $nowy $nextx $nexty -fill $color \
          -width $penw -tags all
      set nowx $nextx
      set nowy $nexty
   } else {
      set nowx [expr $nowx + $s * cos($rad)]
      set nowy [expr $nowy + $s * sin($rad)]
   }
}

proc goto { x y } {
   global deg nowx nowy pen
   global color penw
   if { $pen == 1 } {
      .can create line $nowx $nowy $x $y -fill $color -width $penw -tags all
   }
   set nowx $x
   set nowy $y
}

proc penup { } {
   global pen
   set pen 0
}

proc pendown { } {
   global pen
   set pen 1
}

proc rotate { d } {
   global deg
   set deg [expr $deg + $d]
}

proc pencolor { s } {
   global color
   set color $s
}

proc penwidth { d } {
   global penw
   set penw $d
}

proc background { col } {
   .can configure -bg $col
}

proc resize { x y } {
   .can configure -width $x -height $y
}

proc clear { } {
   .can delete all
}

# 標準入力から呼んでコマンドを評価していく。標準入力はブロックせず、
# 入力がないと空文字列を返すので、after コマンドを使って 100 ミリ秒ごと
# に読み直すようにする。
proc readit { } {
   while { [expr 1 + 1] } {
      set buff [gets stdin]
      if { $buff == "" } {
         after 100 readit
         return
      }
      eval $buff
   }
}

# ウィジット定義
wm title . "scheme-logo"

canvas .can -width 200 -height 200 -bg white
pack .can

# 標準入力をブロックしないようにする
fconfigure stdin -blocking false
after 100 readit

まあ、テキトーに遊んでくれ。たとえば Scheme でこんな関数を実行すると、

(define (paseli win length degree rate)
  (if (> length 5) 
      (begin 
       (forward win length)
       (rotate win degree)
       (forward win length)
       (paseli win (* length rate) degree rate)
       (backward win length)
       (rotate win (- (* degree 2)))
       (forward win length)
       (paseli win (* length rate) degree rate)
       (backward win length)
       (rotate win degree)
       (backward win length)
       T )))

(define win (open-window))
(resize win 400 400)
(goto win 50 200)
(background win "yellow")
(pencolor win "darkgreen")
(pendown)
(paseli win 30 30 0.8 )

これが次のようなタートルグラフィックス用コマンドに変換されて、この Tcl/Tk スクリプトに食わされる...という風に Scheme インタプリタを書いてやればOKだ(異常に軽い言い方をしてしまうが)。

resize 400 400
goto 50 200
background "yellow"
pencolor "darkgreen"
pendown

forward 30
rotate 30
forward 30
  forward 24
  rotate 30
  forward 24
    forward 19.2
    rotate 30
    forward 19.2
      forward 15.36
      rotate 30
      forward 15.36
        forward 12.288
        rotate 30
        forward 12.288
          forward 9.8304
          rotate 30
          forward 9.8304
            forward 7.86432
............

で、上のコマンドを食わされたタートルグラフィックス・インタプリタは次のような画像を表示する、という寸法だ。



C言語によって自前コマンドを処理できるインタプリタを作成する!

さて、まあここまでは特殊なプログラミング知識なしでも頑張りゃできる範囲だった。今からは Tcl/Tk のライブラリを使って、C言語の上から Tcl/Tk を操作して行くのである。しかし、Tcl/Tk の場合には「手抜き」ができるのである。どう見てもCのプログラムよりも Tcl/Tk のプログラムの方が簡潔であり、手早く書けることを否定する人は多分いないだろう。だから、特殊な機能をCで実装する場合でも、Tcl/Tk スクリプトの中からCで書かれた関数を呼び出して実行させることができるといいわけだ。

Tcl/Tk ではこれをこういう具合に実現する。

  1. 「Tcl インタプリタ」を作成する。
  2. 「Tcl インタプリタ」を初期化する。
  3. 「Tk ライブラリ」を初期化する。
  4. 自分が必要とする新しいコマンドを作成する。当然その時、Tcl/Tk の上でそのコマンドが実行された時に、呼び出されるコールバック関数を登録する。
  5. Tcl/Tk スクリプトを読んで評価する。
  6. メインループに入る。

要するに、オブジェクト指向っぽいコールバックプログラムになるのである。具体的には次のようになる。

#include <X11/X.h>  /* 一応入れとく */
#include <stdio.h>
#include <tcl.h>
#include <tk.h>

int MyCommand_Init( Tcl_Interp *interp )
{
   /* コマンドを作成する */
   Tcl_CreateCommand( interp, "MyCommand", MyCommand_Proc, 
                      (ClientData *)NULL, (Tcl_CmdDeleteProc *)NULL );
   return( TCL_OK );
}

int main( int argc, char **argv )
{
    Tcl_Interp *interp;           /* Tcl インタプリタ */
    char *file = "./myprog.tcl";  /* 自分のスクリプト */

    interp = Tcl_CreateInterp();  /* インタプリタを作成する */

    /* 初期化 */
    if( Tcl_Init( interp ) == TCL_ERROR ){
       fprintf( stderr, "%s\n", interp->result );
       exit( 1 );
    }
    if( Tk_Init( interp ) == TCL_ERROR ){
       fprintf( stderr, "Tk_Init failed:%s\n", interp->result );
       exit( 1 );
    }

    /* これは自分のコマンドの初期化である */
    if( MyCommand_Init( interp ) == TCL_ERROR ){
       fprintf( stderr, "Dith_Init failed:%s\n", interp->result );
       exit( 1 );
    }

    /* 引数を適当に解釈する */
    parse_arg( argc, argv, interp );

    /* インタプリタで自分のスクリプトを実行する */
    if( Tcl_EvalFile( interp, file ) == TCL_ERROR ){
       fprintf( stderr, "%s TCL error\n", file );
       fprintf( stderr, "%s\n", interp->result );
       exit( 1 );
    }

    /* メインループに入り、イベントの生成を待つ */
    Tk_MainLoop();
    return( 0 );
}

コンパイルする時には次のようなオプションが必要になる。ひょっとしたらXのヘッダが必要になるかもしれないので、-I/usr/X11R6/include も要るかもしれない。昔共有ライブラリでなかった頃はもっとここらへんが面倒だったが、そういう環境の人はもうあまりいないだろう。

gcc -Wall -o mytcl mytcl.c -ltcl -ltk

これでリンクに失敗するようなら、「ls /usr/lib/libtcl*」とかして、正しい tclライブラリの名称を確認してくれ。なぜか筆者の Plamo4.0 環境では /usr/lib/libtcl8.0jp.so とか /usr/lib/libtcl8.3.so とかになるので(要するに日本語対応版の古い奴と非対応の新しい奴が共存している)、/usr/lib/libtcl.so というリンクをどっちかに張るか、-ltcl8.3 という風にコンパイルオプションを指定すればよい。

まあ、呼ばれている Tcl/Tk のライブラリ関数も、ほとんどのものは名前から自明だろう。ただ、Tcl_CreateCommand() だけは説明が必要だ。

Tcl_Command Tcl_CreateCommand( Tcl_Interp interp, 
                               char *cmdName, 
                               Tcl_CmdProc proc, 
                               ClientData clientData, 
                               Tcl_CmdDeleteProc deleteProc);

Tcl_CreateCommand() は自前のコマンドを作る。第1引数は Tclインタプリタであることはいうまでもない。第2引数は Tcl の上でのコマンド名になり、第3引数がそのコマンドが実行された時に呼び出されるコールバック関数を指定する。第4引数はこの時に与えたいデータを指定できるようになっている。第5引数はコマンドが削除された時のコールバック関数が指定できるようになっているが、これは特に解放が必要なリソースを使う場合に「コマンドの削除」をTcl の上から実行して(rename myCommand {}のように)やると呼び出される。まあ、一般には使う必要もないだろうから、NULLを渡すケースが多い。

まあありがちなものだが、Tcl/Tk からソケットを開いて、HTTPプロトコルを発行するサンプルプログラムを書いてみよう。とりあえず、スタンドアロンのCで動くプログラムはこんなものである。ちょっとオブジェクト指向風に書いておくと、Tcl で実装しやすい。転用を考えて、まずヘッダファイルを作ろう。こんな具合。httplib.h とでもしておく。

#include <netdb.h>
#include <netinet/in.h>
#include <sys/types.h>
#include <sys/socket.h>

struct Tcl_HTTP {
   int socket;   /* socket descripter を保持 */
   int status;   /* 接続の上での状態 */
   struct sockaddr_in addr;  /* IPアドレス構造体 */
   struct URL {  /* URL の分解のための領域 */
      char *host;
      int port;
      char *filename;
   } parsed;
   char *URL;    /* オリジナルのURLを保持 */
};

/* status メンバの値の記号定数 */
#define HTTP_CLOSED    0
#define HTTP_CREATED   1
#define HTTP_CONNECTED 2
#define HTTP_REQUESTED 3
#define HTTP_EOF       4

struct Tcl_HTTP *newHTTP( char *url );
int connectHTTP( struct Tcl_HTTP *http );
int requestHTTP( struct Tcl_HTTP *http );
int readHTTP( struct Tcl_HTTP *http, char *buf, int len );
int isHTTPeof( struct Tcl_HTTP *http );
void closeHTTP( struct Tcl_HTTP *http );

では実装コードの httplib.c はこんな具合。一応ライブラリにしておく。

#include <stdio.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <netdb.h>
#include <unistd.h>
#include <netinet/in.h>
#include <string.h>
#include <ctype.h>
#include <malloc.h>
#include <stdlib.h>
#include "httplib.h"

/* 文字列のURL を分解し、struct URL にセットする。読めば判る */
static struct URL *parseURL( char *url, struct URL *buf )
{
   char *p, *q;
   char buff[256];

   if( strncmp( url, "http://", 7 ) == 0 ) {
      buf->port = 80;
      p = &url[7];
   } else if( strncmp( url, "https://", 8 ) == 0 ) {
      buf->port = 443;
      p = &url[8];
   } else {
      return NULL;
   }
   for( q = buff; *p != '\0' && *p != ':' && *p != '/'; p++, q++ ) {
      *q = *p;
   }
   *q = '\0';
   buf->host = strdup( buff );
   if( *p == '\0' ) {
      buf->filename = strdup( "/" );
      return buf;
   } else if( *p == ':' ) {
      buf->port = atoi( p + 1 );
      for( p++; isdigit(*p); p++ );
      if( *p != '/' ) {
         return NULL;
      }
   }
   if( *p != '/' ) {
      return NULL;
   }
   buf->filename = strdup( p );
   return buf;
}

/* インターフェイス */
struct Tcl_HTTP *newHTTP( char *url )
{
   struct Tcl_HTTP *ret;
   struct hostent *hent;

   /* 構造体を生成する */
   ret = (struct Tcl_HTTP *)malloc( sizeof( struct Tcl_HTTP ) );
   if( ret == NULL )   return NULL;
   ret->status = HTTP_CLOSED;
   ret->URL = strdup(url);
   if( parseURL( ret->URL, &ret->parsed ) == NULL ) {
      free( ret ); return NULL;
   }
   /* 以下定型的なソケット生成 */
   hent = gethostbyname( ret->parsed.host );
   if( hent == NULL ) {
      free( ret ); return NULL;
   }
   memcpy( &ret->addr.sin_addr, hent->h_addr, hent->h_length );
   ret->addr.sin_port = htons( ret->parsed.port );
   ret->addr.sin_family = AF_INET;

   ret->socket = socket( PF_INET, SOCK_STREAM, 0 );
   if( ret->socket < 0 ) {
      free( ret ); return NULL;
   }
   ret->status = HTTP_CREATED;
   return ret;
}

/* インターフェイス */
int connectHTTP( struct Tcl_HTTP *http )
{
   int ret;
   int i;

   /* 定型的なコネクト処理 */
   if( http->status != HTTP_CREATED ) return -1;
   for( i = 0; i < 10; i++ ) {
      ret = connect( http->socket, (struct sockaddr *)&http->addr, 
                     sizeof(struct sockaddr_in) );
      if( ret == 0 ) {
         break;
      }
      sleep( 1 );
   }
   if( i == 10 ) {
      return -1;
   }
   http->status = HTTP_CONNECTED;
   return ret;
}

/* インターフェイス。HTTP GETメソッドの発行 */
int requestHTTP( struct Tcl_HTTP *http )
{
   char buff[256];
   int ret;

   if( http->status != HTTP_CONNECTED ) return -1;
   sprintf( buff, "GET %s HTTP/1.0\n\n", http->parsed.filename );
   ret = write( http->socket, buff, strlen(buff) );
   if( ret <= 0 ) {
      return -1;
   }
   http->status = HTTP_REQUESTED;
   return 0;
}

/* インターフェイス。結果の読み込み */
int readHTTP( struct Tcl_HTTP *http, char *buf, int len )
{
   int ret;
   if( http->status != HTTP_REQUESTED ) return -1;
   ret = read( http->socket, buf, len );
   if( ret <= 0 ) {
      http->status = HTTP_EOF;
   }
   return ret;
}

/* インターフェイス。EOFの判定 */
int isHTTPeof( struct Tcl_HTTP *http )
{
   if( http->status == HTTP_EOF ) {
      return 1;
   } else if( http->status == HTTP_REQUESTED ) {
      return 0;
   } else {
      return -1;
   }
}

/* インターフェイス。クローズ処理 */
void closeHTTP( struct Tcl_HTTP *http )
{
   if( http == NULL || http->status == HTTP_CLOSED ) {
      return;  /* 二重にはクローズしない */
   }
   close( http->socket );
   http->status = HTTP_CLOSED;
}

これを使うプログラムはこんな風に呼び出す。

#include <stdio.h>
#include <unistd.h>
#include "httplib.h"

int main( int argc, char **argv )
{
   struct Tcl_HTTP *http;
   int len;
   char buff[256];

   if( argc < 2 ) {
      fprintf( stderr, "brows URL\n" );
      exit( 1 );
   }
   
   if( (http = newHTTP( argv[1] )) == NULL ) {
      fprintf( stderr, "cannot create Tcl_HTTP for %s\n", argv[1] );
      exit( 1 );
   }
   if( connectHTTP( http ) != 0 ) {
      closeHTTP( http );
      fprintf( stderr, "cannot connect to %s\n", argv[1] );
      exit( 1 );
   }
   if( requestHTTP( http ) != 0 ) {
      closeHTTP( http );
      fprintf( stderr, "cannot write HTTP protocol\n" );
      exit( 1 );
   }
   while( ! isHTTPeof( http ) ) {
      len = readHTTP( http, buff, sizeof(buff) );
      if( len > 0 ) {
         write( 1, buff, len );
      }
   }
   closeHTTP( http );
   return 0;
}

とりあえずプロキシには対応してないが、そこそこのプログラムである。ネットワークプログラムに馴れている人は説明の必要もないが、馴れていない人も「こんなもんだ」と思って呼んで欲しい。要するに引数のURLを解析して、ポートとホスト名と取得するファイルに分離して、ソケットを作成し(これが struct Tcl_HTTP で渡される)、ホストにコネクトを試み、「GET / HTTP/1.0」のようなリクエストを発行して、データを引きずり出すわけだ。これを Tcl のコマンド「HTTP」で実装していく。

つまり、こんな風にTcl コマンドとして使えるわけだ。

# 変数 conn に、HTTP コマンドで作成されたオブジェクトが代入される
set conn [HTTP "http://www.nurs.or.jp/~sug/soft/"]
$conn connect  # オブジェクト指向風の呼び出しでコネクト
$conn request  # オブジェクト指向風の呼び出しでリクエストを発行
while { ! [$conn isEOF] } {
    puts -nonewline [$conn read]
}
rename $conn {}  # オブジェクトの破棄。今回は socket をクローズする必要あり

さて、この HTTP コマンドを備えたインタプリタを作成していく。すでにライブラリは完璧なので、これを呼び出して使っていくのである。ただし、ちょっと難しい点がある。それはこういうオブジェクト指向風のやり方をしているので、「HTTP」コマンドは実際のソケットを含むオブジェクトである struct Tcl_HTTP を Tcl の上で示すようなオブジェクトを返さなくてはならない。そして、そのオブジェクトに対して connect などのコマンドを発行するのである。だから、実際には2つの新しいコマンドを作成する。1つは言うまでもなく HTTP コマンドだが、もう1つはそのオブジェクトを示す「http0」のような、作成された順番を持つその場限りの名前のコマンドである。ちょっとトリッキーなので、気をつけて欲しい。

まず、include 文と main 関数だけ先に示そう。

#include <stdio.h>
#include <tcl.h>
#include "httplib.h"

int main( int argc, char **argv )
{
   Tcl_Interp *interp;
   char *script = "tclhttp.tcl";
   int ret;

   /* ここらへんは定型的 */
   interp = Tcl_CreateInterp();
   if( Tcl_Init( interp ) == TCL_ERROR ){
      fprintf( stderr, "%s\n", interp->result );
      exit( 1 );
   }
   /* HTTP コマンドを作成してコールバックを登録する */
   if( HTTP_Init( interp ) == TCL_ERROR ){
      fprintf( stderr, "Dith_Init failed:%s\n", interp->result );
      exit( 1 );
   }

   /* ここらへんも定型的 */
   ret = Tcl_EvalFile( interp, script );
   if( *interp->result != 0 ) {
      printf( "%s\n", interp->result );
   }
   if( ret != TCL_OK ) {
      return -1;
   }
   return 0;
}

さて、まずは HTTP コマンドを作成して、その HTTP コマンドが呼び出されたとき(Tcl の上では「set conn [HTTP "http://〜"]」)の処理をするコールバックを定義する。

/* HTTP コマンドのコールバック */
/* 引数は cd はとりあえずNULL、argc,argv 方式でこの場合 URLが argv[1] */
int HTTP_Cmd( ClientData cd, Tcl_Interp *interp, 
              int argc, char *argv[] )
{
   static int id = 0;    /* 作成順を憶えておく */
   struct Tcl_HTTP *ret;

   if( argc != 2 ) {
      interp->result = "HTTP \"URL\"";
      return TCL_ERROR;  /* エラーはこういう風にして返す */
   }
   /* ライブラリを呼び出して構造体を作成する */
   ret = newHTTP( argv[1] );
   if( ret == NULL ) {
      interp->result = "HTTP cannot get\n";
      return TCL_ERROR;
   }
   /* これが実際の Tcl 上での戻り値になる。だから $conn を参照すると「http0」
      のようなコマンド名である */
   sprintf( interp->result, "http%d", id++ );

   /* さて、「http0」のような使い捨てコマンドを作成し、コールバックを設定する */
   /* この場合は普通のコールバックと、破棄用のコールバックの両方が必要である */
   /* 第4引数が NULL ではなく、作成した構造体のポインタを渡していることに注意 */
   Tcl_CreateCommand( interp, interp->result, HTTPObjectCmd,
                (ClientData)ret, DeleteHTTPObject ); 
   return TCL_OK;
}

/* main から呼ばれる HTTP コマンドの作成登録関数 */
int HTTP_Init( Tcl_Interp *interp )
{
   Tcl_CreateCommand( interp, "HTTP", HTTP_Cmd, 
                (ClientData)NULL, NULL );
   return( TCL_OK );
}

では、使い捨てコマンドのコールバックはどうだろう? いくつかの命令を使い捨てコマンドは認識する。まあ、大体がこれらは直接ライブラリ関数と結びついているので意味は自明だろう。問題はいろいろな戻り値をどうやって返すか、だ。

/* 使い捨てコマンドの普通のコールバック */
/* この時、うまくできたもので、HTTP コマンドで作成した構造体が
第1引数で渡って来る */
int HTTPObjectCmd( ClientData cd, Tcl_Interp *interp, 
                   int argc, char *argv[] )
{
   struct Tcl_HTTP *at = (struct Tcl_HTTP *)cd;
   int ret;
   char buff[1024];
   
   /* 要するに argv[1](命令)の場合分けが本質 */
   if( strcmp( argv[1], "connect" ) == 0 ) {
      ret = connectHTTP( at );
      if( ret != 0 ) {
         interp->result = "HTTPObject fail connect";
         return TCL_ERROR;
      }
   } else if( strcmp( argv[1], "request" ) == 0 ) {
      ret = requestHTTP( at );
      if( ret != 0 ) {
         interp->result = "HTTPObject fail request";
         return TCL_ERROR;
      }
   } else if( strcmp( argv[1], "isEOF" ) == 0 ) {
      ret = isHTTPeof( at );
      /* この場合数値(真偽値)を返したいが、Tcl は文字列のみ */
      sprintf( interp->result, "%d", ret );
      if( ret == -1 ) {
         return TCL_ERROR;
      }
   } else if( strcmp( argv[1], "read" ) == 0 ) {
      ret = readHTTP( at, buff, sizeof(buff) - 1 );
      if( ret < 0 ) {
         return TCL_ERROR;
      }
      buff[ret] = '\0';
      /* さて、クソ長い文字列を返したい。これはこうする。*/
      Tcl_AppendResult( interp, buff, NULL );
   } else if( strcmp( argv[1], "close" ) == 0 ) {
      closeHTTP( at );
   } else {
      interp->result = "HTTPObject unknown command";
      return TCL_ERROR;
   }
   return TCL_OK;
}

/* 使い捨てコマンドの削除用コールバック */
/* この時も HTTP コマンドで作成した構造体が引数で渡って来る! うれしい! */
void DeleteHTTPObject( ClientData cd )
{
   struct Tcl_HTTP *at = (struct Tcl_HTTP *)cd;
   closeHTTP( at );  /* ソケットを閉じる */
   free( at );       /* 構造体の破棄 */
}

じゃあ、これをもう少し実用的なスクリプトにしてみよう。URLを入れてHTMLを取得して、リンクだけを抽出してリストにする、というのはどうだ。

#!/usr/bin/wish

# 最初用のエントリなど
frame .l1
label .url -text "URL:"
entry .ent -width 30 -textvariable URL
button .go -text "GO" -command { readURL $URL }
pack .url .ent .go -in .l1 -side left
pack .l1 -side top

# ヘッダの削除オプション
checkbutton .option -text "ヘッダの削除" -variable delHeader
pack .option -side top

# ファイル表示
label .filenam -text "取得されたファイル: "
pack .filenam -side top

frame .l2
text .text -yscrollcommand ".scroll1 set" -wrap char
scrollbar .scroll1 -command ".text yview"
pack .scroll1 -in .l2 -side right -fill y
pack .text -in .l2 -fill both -expand yes -side top
pack .l2 -side top

# リンク抽出リストボックス
label .links -text "その中のリンク "
pack .links -side top

frame .l3
listbox .list -width 50 -yscrollcommand ".scroll2 set"
scrollbar .scroll2 -command ".list yview"
bind .list <Double-Button-1> { jump $URL [selection get] }

pack .scroll2 -in .l3 -side right -fill y
pack .list -in .l3 -fill both -expand yes
pack .l3 -side top

# 終了ボタン
button .quit -text "Quit" -command { exit 0 }
pack .quit -side bottom

# 以下サブルーチン
# URL を分解してリストで返す
proc parseURL { url } {
   global a0 a1 a2 a3 a4
   if [regexp {^http://([^/]+)(/?.*)$} $url a0 a1 a2] {
      if [regexp {[^/]*\.[a-zA-Z0-9]+$} $a2] {
#        ファイル名(.を含む)で終っているケース
         regexp {^(.*)/([^/]+)$} $a2 a0 a3 a4
           return [list $a1 $a3 $a4]
        } elseif [regexp {/$} $a2] {
#          / で終っている(http://host/dir/)ケース
           return [list $a1 $a2 ""]
        } else {
           if { $a2 == "" } {
#             http://host.co.jp など
              return [list $a1 "/" ""]
           } else {
#             http://host.co.jp/dir など
              return [list $a1 $a2 ""]
           }
        }
   } else {
        return [list]
   }
}

# 前回アクセスしたURLから相対URLを計算する
proc makeURL { url at } {
   global a0 a1
   set lis [parseURL $url]
   set host [lindex $lis 0]
   set path [lindex $lis 1]
   set a1 ""
   if { [string range $at 0 6] == "http://" } {
       return $at
   } elseif { [string range $at 0 1] == "//" } {
       return "http:$at"
   } elseif { [string range $at 0 0] == "/" } {
       return "http://$host$at"
   } else {
#      ../ で前回アクセスURLからディレクトリを削る
       while { [string range $at 0 2] == "../" } {
          regexp {^(.*)/[^/]*} $path a0 a1
          set path $a1
          set at [string range $at 3 end]
#         ふう、面倒!
       }
       return "http://$host$path/$at"
   }
}

# リストボックスのコールバック
proc jump { url at } {
   global URL
   set go [makeURL $url $at]
   set URL $go
   readURL $URL
}

# ライブラリを使う HTML コマンドを発行してアクセスをする
proc readURL { url } {
   global delHeader
   .text delete 1.0 end
   set conn [HTTP $url]
   $conn connect
   $conn request
   set htm ""
   while { ! [$conn isEOF] } {
       set htm "$htm[$conn read]"
   }
   rename $conn {}
#   インターネットなので、場合によっては \r\n を \n にまとめる
   regsub -all "\r\n" $htm "\n" txt
#  オプションにより、ヘッダを削る
   if { $delHeader != 0 } {
       set top  [string first "\n\n" $txt]
       if { $top != -1 } {
          set top [expr $top + 2]
          set txt [string range $txt $top end]
       }
   }
#   ようやくテキストに挿入
   .text insert end $txt
#   リンクの抽出はサブルーチンに
   setLink $txt
}

# 取得したHTMLからリンクを抽出し、リストボックスに追加する
# 正規表現置換ばっかり!
proc setLink { txt } {
   global ind dum t e
   set links {}
   .list delete 0 end
   while { [regexp -nocase -indices {<a [^>]*>} $txt ind] } {
       regexp {([0-9]+)[ ]+([0-9]+)} $ind dum t e
       set matched [string range $txt $t $e]
       set txt [string range $txt $e end]
       if { [regexp -nocase \
             {href[ \n]*=[ \n]*('[^']+'|"[^"]+"|[^ ]+)} \
             $matched dum t] != 0 } {
          regsub {^['"]?(.*)['"]$} $t {\1} e
          if { [string index $e 0] == "#" } {
          } else {
             set frag [string first "#" $e]
               if { $frag != -1 } {
                  set e [string range $e 0 [expr $frag - 1]]
               }
               if { [lsearch $links $e] == -1 } {
                  lappend links $e
               }
           }
       }
   }
   set links [lsort $links]
   foreach i $links {
       .list insert end $i
   }
}

やや残念なことに、前回アクセスしたURLから、リンクボックスの相対URL指定によって新しいURLを取得するロジックが、厳格にやろうとすると難しい(正確にはそのURLの末尾がファイルなのかディレクトリなのか判定できない... 拡張子があればファイルだと思う。あと、「./」処理は省略した)。ちょっと手抜きだが、実用上は大体大丈夫だろう。当然、プロキシには対応していないので、プロキシ環境でやってみる場合には、ちょっくら直してくれ(要するにプロキシに接続して、そのプロキシ宛てにGETメソッドを発行する。詳しくは 「プロキシとは?」でも見てくれ。)。

まともに実用的なものをやろうとすると、正規表現で照合したり置換したりする処理がやたらと多くてゴメン。URL処理って難しいんだ、わがままな筆者を許せ。筆者は詰まらないサンプルプログラムを書くのは死ぬ程嫌だ。けど、作成したインタプリタが一種のライブラリのドライバみたいに使えることはわかるだろう。だから、一旦ライブラリをちゃんと書いて、Tcl からのインターフェイスを作っておけば、後の使い方は工夫次第だ。

1ページとしては量が異常になってしまったので、後編に続く.....



copyright by K.Sugiura, 1996-2006