Tcl拡張の作成

Tcl拡張は、C言語やC++言語で作成できますが、ここでは、
100% Pure TclでTcl拡張を作成する方法を説明します。

Tclには、Tcllibという100% Pure Tclで記述された拡張パッケージがあります。
Tclで良く使われる便利なプロシジャをパッケージ化したものです。
Tcllibは、TclでTcl拡張パッケージを作成するための良いお手本となるでしょう。

プロシジャを作成する

まず、パッケージに入れるプロシジャを作成します。
ここでは、例題として、UNIXのcatコマンドとheadコマンドに似たプロシジャを定義します。
catは、ファイルの内容をすべて表示するプロシジャで、headは、ファイルの先頭から指定した行数分を表示するプロシジャです。 

#
# cat file ...
#
proc cat {args} {
    set out {}
    foreach file $args {
        if {[catch {open $file r} fd]} {
            error "No such file or directory"
        }
        while {![eof $fd]} {
            if {[gets $fd line] < 0} {
                break
            }
            append out $line "\n"
        }
        close $fd
    }
    return $out
}

#
# head file ?number?
#
proc head {file {num 10}} {
    if {[catch {open $file r} fd]} {
        error "No such file or directory"
    }
    set out {}
    set count 0
    while {![eof $fd]} {
        if {[gets $fd line] < 0} {
            break
        }
        append out $line "\n"
        incr count
        if {$count == $num} {
            break
        }
    }
    close $fd
    return $out
}

パッケージ名を決める

ここでは、mylib という名前でパッケージを作成します。
ファイル名は、mylib.tclとします。

mylib.tcl 
package require Tcl 8.0
package provide mylib 1.0

package requireコマンドは、このパッケージを動作させるのに必要な
パッケージを記述します。この例では、Tcl8.0以上が必要となります。
package provideコマンドは、パッケージ名とバージョンを定義します。

namespace化する

プロシジャの名前が他のパッケージと競合した場合に備えて、
プロシジャをnamespaceで囲います。

mylib.tcl 
namespace eval ::mylib {
    namespace export *
}

namespace exportコマンドは、すべてのプロシジャを外部に公開します。
catとheadプロシジャは、namespaceで囲うために修正します。

mylib.tcl 
#
# cat file ...
#
proc ::mylib::cat {args} {
    set out {}
    foreach file $args {
        if {[catch {open $file r} fd]} {
            error "No such file or directory"
        }
        while {![eof $fd]} {
            if {[gets $fd line] < 0} {
                break
            }
            append out $line "\n"
        }
        close $fd
    }
    return $out
}

#
# head file ?number?
#
proc ::mylib::head {file {num 10}} {
    if {[catch {open $file r} fd]} {
        error "No such file or directory"
    }
    set out {}
    set count 0
    while {![eof $fd]} {
        if {[gets $fd line] < 0} {
            break
        }
        append out $line "\n"
        incr count
        if {$count == $num} {
            break
        }
    }
    close $fd
    return $out
}

インデックスの作成

Tclにパッケージを自動ロードするためのインデックスを作成します。

tclshまたはwishでmylib.tclの場所に移動してpkg_mkIndexコマンドを実行します。 

cd mylib
pkg_mkIndex . mylib.tcl

mylib.tclと同じディレクトリにpkgIndex.tclが生成されます。

pkgIndex.tcl 
# Tcl package index file, version 1.1
# This file is generated by the "pkg_mkIndex" command
# and sourced either when an application starts up or
# by a "package unknown" script.  It invokes the
# "package ifneeded" command to set up package-related
# information so that packages will be loaded automatically
# in response to "package require" commands.  When this
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.

package ifneeded mylib 1.0 [list source [file join $dir mylib.tcl]]

これでmylibパッケージは完成です。

パッケージのインストール

mylibパッケージをシステムの tcl8x/lib にインストールします。

もし、何かの事情でシステムにインストールできない場合は、
auto_path変数に mylib1.0 のあるディレクトリを追加することで対処できます。 

lappend auto_path {d:/work/mylib1.0}

これでmylibパッケージのインストールは完了です。

パッケージを使ってみる

それでは、mylibパッケージを使ってみましょう。
package requireコマンドで、mylibパッケージのバージョン1.0を使うことを宣言すると、
Tclがインデックスからmylibパッケージ探してロードします。
すべてのプロシジャをimportすれば、namaspaceのスコープ指定をせずに使えます。 

package require mylib 1.0

::mylib::cat foo.txt bar.txt
::mylib::head foo.txt 5

namespace import mylib::*
cat foo.txt bar.txt
head foo.txt 5

TclでTcl拡張を作成するのは、意外と簡単でしたね。