カテゴリー別アーカイブ: Tcl/Tk

最新Tclkit事情

Tcl/Tkのスクリプトを単体実行ファイルとして配布するのに使うTclkitは、ActiveTclと一緒に配布されるbasekitというのを使っておけば、検証済みの最新バージョンなので問題は少ないのですが、日本語パスやスペースを含むパスから実行しようとするとエラーになるという、何とも前時代的な制約があります。これはフリーソフトとして配布するソフトを作る時にはちょっと受け入れがたいです。そこで、その他のTclkitを手に入れるか、自分でビルドするわけですが。。。ものすごくサイズにこだわりがなければ、今時はKitCreatorのページで出来合いのものを取ってくるのが無難な入手方法です。

手動ビルド版
http://tclkits.rkeene.org/fossil/wiki/Downloads

自動ビルド版(最新版)
http://www.rkeene.org/devel/kitcreator/kitbuild/nightly/

ダウンロードファイルに拡張子.exeをつけます。

ちょっとサイズが大きいので、upxという実行ファイル圧縮ツールを使って小さくするのがお勧めです。

G:\Downloads>upx -k tclkit-8.5.18-win32-i586-threaded-xcompile.exe
                       Ultimate Packer for eXecutables
                          Copyright (C) 1996 - 2013
UPX 3.91w       Markus Oberhumer, Laszlo Molnar & John Reiser   Sep 30th 2013
 
        File size         Ratio      Format      Name
   --------------------   ------   -----------   -----------
   4378912 ->   2759968   63.03%    win32/pe     tclkit-8.5.18-win32-i586-threaded-xcompile.exe
 
Packed 1 file.
 
 
G:\Downloads>ls -l --block-size=KB tclkit-8.5.18-win32-i586-threaded-xcompile.ex*
-rwxrwxrwx  1 yusuke 0 4379kB 2015-06-09 23:31 tclkit-8.5.18-win32-i586-threaded-xcompile.ex~
-rwxrwxrwx  1 yusuke 0 2760kB 2015-06-09 23:31 tclkit-8.5.18-win32-i586-threaded-xcompile.exe

Tcl SQLite build configuration

Prerequisites

Build tool = MinGW GCC v4.9.2
Tcl build path = /c/src/tcl8.6.3/win
Tcl install path = /c/bin/tcl8.6.3
SQLite3 build path = /c/src/sqlite-autoconf-3080704/tea
wxSQLite3 secure source path = /c/src/wxsqlite3-trunk/sqlite3/secure/src

Tcl

./configure --prefix=(Tcl install path)
make
make install

Tk

./configure --prefix=(Tcl install path) --with-tcl=(Tcl build path)
make
make install

TclSQLite

Copy the files in (wxSQLite3 secure source path) to (SQLite3 build path)/generic.
Open tclsqlite3.c and replace "sqlite3.c" by "sqlite3secure.c" in the line #4.
cd (SQLite3 build path)
./configure --enable-threads --prefix=(Tcl install path) --with-tcl=(Tcl build path) CFLAGS="-DSQLITE_HAS_CODEC -DSQLITE_ENABLE_FTS4_UNICODE61 -DSQLITE_USER_AUTHENTICATION=0"
make
make install

This also works with ActiveTcl.

I could not make sqlite3 v3.8.2 independent from libgcc_s_dw2-1.dll with MinGW gcc v4.8.1.
I don't know the reason. But I could build it with nmake.
For example:
nmake -f makefile.vc TCLDIR=(Tcl install path) INSTALLDIR=(Tcl install path) OPTDEFINES="-DSQLITE_HAS_CODEC"

Ref. 暗号化APIを有効にしたSQLite3のTclバインディングをコンパイルする

tclkitの仲間

KitCreator Build and Test Status (Nightly build)
最新のバイナリが入手可能。サイズが大きめ。
Windowsの場合はダウンロードしたファイルの拡張子をexeに変える。
http://www.rkeene.org/devel/kitcreator/kitbuild/nightly/

Cookit
Tclkitとはちょっと方式が違うらしい。バイナリはやや古いものしかない。
http://www.endorser.org/en/blog/tcl/cookit/download

Tclkit
バイナリはかなり古く、更新停止中。
https://code.google.com/p/tclkit/wiki/BuildingTclkit

Kitgen build system
自分で作りたい方向け
http://sourceforge.net/projects/kbskit

Tcl8.6系でTDBCをビルトインしてるのがあったらほしいけど今のところ見当たらない。
他にもあった気がするけど思い出したら追記する。

Kitgenで作った小さめのバイナリが手元にあるけど、どこかに置いとこうかな。。。

kitgenをVisual Studio 2012でビルドする

kitgenが正式にサポートしているのはVC6からVC8(2005)までです。
VS2008~VS2013についても、いくつか変更を加えてやればビルドできます。

ただ、これはTclに限ったことではないのですが、VS2012で普通にビルドした実行ファイルはXPで動作しません。SDK 7.1Aにリンクすればビルドできますが、VS2010以前を持ってる人にとっては面倒なだけでメリットがないので古いVSを使った方がいいです。(参考ページ)。

あと、これはいいのかどうか分かりませんが、VC6でビルドするとOS標準添付のC++ランタイム(msvcrt.dll)をリンクするので、別途ランタイムをインストールすることなく動作します。MinGWでビルドした場合もそうなるのでまあ問題ないんじゃないでしょうか。

kitgen/Makefile.vc

70c70
< CFLAGS  = -W3 -D_WINDOWS -DWIN32 -DSTATIC_BUILD
---
> CFLAGS  = -W3 -D_WINDOWS -DWIN32 -DSTATIC_BUILD -D_CRT_SECURE_NO_WARNINGS
142c142,148
< !if $(VCVERSION) >= 1500
---
> !if $(VCVERSION) >= 1800
> VCVER=12
> !elseif $(VCVERSION) >= 1700
> VCVER=11
> !elseif $(VCVERSION) >= 1600
> VCVER=10
> !elseif $(VCVERSION) >= 1500

kitgen/8.x/mk/tcl/mk4tcl.cpp

2597c2597
< EXTERN int Mk4tcl_Init(Tcl_Interp *interp) {
---
> int Mk4tcl_Init(Tcl_Interp *interp) {
2601c2601
< EXTERN int Mk_Init(Tcl_Interp *interp) {
---
> int Mk_Init(Tcl_Interp *interp) {
2605c2605
< EXTERN int Mk4tcl_SafeInit(Tcl_Interp *interp) {
---
> int Mk4tcl_SafeInit(Tcl_Interp *interp) {
2609c2609
< EXTERN int Mk_SafeInit(Tcl_Interp *interp) {
---
> int Mk_SafeInit(Tcl_Interp *interp) {

kitgen/8.x/mk/tcl/mk4tcl.h

382a383,391
> 
> 
> EXTERN int Mk4tcl_Init(Tcl_Interp *interp);
> 
> EXTERN int Mk_Init(Tcl_Interp *interp);
> 
> EXTERN int Mk4tcl_SafeInit(Tcl_Interp *interp);
> 
> EXTERN int Mk_SafeInit(Tcl_Interp *interp);

kitgen/8.x/itcl/win/rules.vc

195c195,201
< !if $(VCVERSION) >= 1500
---
> !if $(VCVERSION) >= 1800
> VCVER=12
> !elseif $(VCVERSION) >= 1700
> VCVER=11
> !elseif $(VCVERSION) >= 1600
> VCVER=10
> !elseif $(VCVERSION) >= 1500

kitgen/8.x/mk/win/rules.vc

187c187,195
< !if $(VCVERSION) >= 1400
---
> !if $(VCVERSION) >= 1800
> VCVER=12
> !elseif $(VCVERSION) >= 1700
> VCVER=11
> !elseif $(VCVERSION) >= 1600
> VCVER=10
> !elseif $(VCVERSION) >= 1500
> VCVER=9
> !elseif $(VCVERSION) >= 1400
189,190d196
< _VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1
< _VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
195a202,205
> !if $(VCVERSION) >= 1400
> _VC_MANIFEST_EMBED_EXE=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1
> _VC_MANIFEST_EMBED_DLL=if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
> !endif

kitgen/8.x/thread/win/rules.vc

195c195,201
< !if $(VCVERSION) >= 1500
---
> !if $(VCVERSION) >= 1800
> VCVER=12
> !elseif $(VCVERSION) >= 1700
> VCVER=11
> !elseif $(VCVERSION) >= 1600
> VCVER=10
> !elseif $(VCVERSION) >= 1500

kitgen/8.x/vqtcl/win/rules.vc

195c195,201
< !if $(VCVERSION) >= 1500
---
> !if $(VCVERSION) >= 1800
> VCVER=12
> !elseif $(VCVERSION) >= 1700
> VCVER=11
> !elseif $(VCVERSION) >= 1600
> VCVER=10
> !elseif $(VCVERSION) >= 1500

8.6.1をビルドするには、kitgen、Tcl、Tkのソースをダウンロードして、
以下にコピーします。

C:\src\kitgen
C:\src\kitgen\8.6.1\tcl
C:\src\kitgen\8.6.1\tk

Visual Studioのコマンドプロンプトを開き、

mkdir C:\src\kitgen\8.6.1\kit-msvc
cd C:\src\kitgen\8.6.1\kit-msvc
echo all: lite heavy > Makefile
echo !include ..\..\Makefile.vc >> Makefile
nmake -f Makefile.vc -nologo VERSION=86 KITOPTS=”-t -z”

ちなみに、tdbc関連のモジュールが大量にビルド失敗しますが、使わない限りは問題ありませんでした。

kitgen+VC6でtclkitを作るときの注意点

TclAppを使うと、Tcl/Tkのスクリプトと実行環境を単一のEXEファイルにラップすることができるのですが、このときprefixファイルといって、ベースとなる実行ファイルを指定する必要があります。これをtclkitとかbasekitとか呼び、標準ライブラリや最低限のエンコーディングファイルなどが含まれていて、自分で開発したアプリに必要な、スクリプト一式、ライブラリ、エンコーディングなどを、TclAppを使って追加することで単体のアプリとして動作するようになります。アイコンやバージョン情報なども、prefixに組み込まれているものを置き換えることもできます。

prefixとして使えるファイルは、実はActiveTclにbasekitという名前でついてきます(Tcl/binフォルダにある)。これがあれば別に自分でtclkitを入手する必要はないのですが、2点ほど問題があります。

  • 実行ファイルのサイズが比較的大きい
  • バイトコードコンパイルすると、スペースおよびマルチバイト文字を含むパスから起動できない

ということで、私にとっては不都合だったので、basekitをやめてtclkitを使うことにしました。tclkitのWindowsバイナリはTcl8.5.13まではhttp://www.patthoyts.tk/tclkitで配布していたのですが、8.5.14がなかなか出ないなあと思っていたら今日見たら落ちてました。また、配布しているものにはtzdataというタイムゾーンの定義ファイルがないので、時刻表示が狂う場合がありました。そういう理由があって、自分でコンパイルすることにしました。前置きが長くなりましたが、以下がその手順です。Windows7 Professional SP1 32bit上で試しました。

必要なものをそろえる

Visual Studio 6.0 (Visual Studio 2003でもいいと書いてあった。)
Microsoft Platform SDK Febuary 2003 (Last version with VC6 support)

kitgenのソースコードを取ってくる

C:\src\kitgenに展開。

Tcl/Tkのソースコードを取ってくる

C:\src\kitgen\8.5\tcl
C:\src\kitgen\8.5\tkに展開。

ビルド用のフォルダとMakefileを作る

VC6のコマンドプロンプトを開く
mkdir C:\src\kitgen\8.5\kit-msvc
cd C:\src\kitgen\8.5\kit-msvc
echo all: lite heavy > Makefile
echo !include ..\..\Makefile.vc >> Makefile

リソースファイルを編集する

これはお好みですが、kitgenに添付されているものを使うと、TclAppでバージョン情報を編集できなくなるので、変更することをお勧めします。
C:\src\kitgen\tclkit.rcをテキストエディタで開き、CommentとPaddingを削除する。

            VALUE "Comments", "Comments\0More Comments\0"
            VALUE "Padding",
               "                                                            "
               "                                                            "
               "                                                            "
               "                                                            \0"

ビルドする

Platform SDKを参照するようにします。また、KITOPTS=-zというオプションを与えることで、tzdataが含まれるようにします。他にもオプションがありますが、kitgenのREADMEファイルを読んでください。

set INCLUDE=C:\PROGRA~1\MIC1C5~1\include;%INCLUDE%
nmake -f Makefile.vc -nologo VERSION=85 KITOPTS="-z"

C:\src\kitgen\8.5\kit-msvcの中にできる、tclkit-cli.exe、tclkit-gui.exeをTclAppのprefixに指定できます。

Tclでベクトル計算するサンプル

SXGAのリモートデスクトップウィンドウをアスペクト比を保ちつつ65%に縮小し、FullHDのディスプレイの右下に配置したい。手計算でも簡単にできることだが、今まで使ってなかった行列計算ライブラリの練習台に使うことを思いついた。

+-----------------------------+
|                             |
|                             |
|                             |
|                             |
|                             |
|               nw------------+
|               |xxxx         |
|               |   x rec x   |
|               |        xxxx |
|               |           xxx
+---------------+------------se
package require math::linearalgebra
namespace eval LinearAlgebraSample {
  namespace import -force ::math::linearalgebra::*
 
  set scale 0.65
  set v(se) [mkVector 2]
  set v(rec) [mkVector 2]
 
  setelem v(se) 0 0 1920
  setelem v(se) 1 0 1280
 
  setelem v(rec) 0 0 1280
  setelem v(rec) 1 0 1024
 
  set v(nw) [sub_vect $v(se) [scale $scale $v(rec)]]
  show $v(nw)
}

例題がしょぼすぎて練習になってないな。

線形代数苦手でプログラミングにも活用してないし、Maxima、Scilab、Octave、Rとかも使ってない。
ロボットの研究室にいたのに行列計算が苦手というのは勉強してなかった証拠ですね。

Tcl/Tkで任意のフォルダをデフォルトファイラーで開く

たまにやるけど忘れるので。スペースを含まないときは別のやり方でも開くのですが、
一般的には以下のようにします。cmdの引数にエスケープされた状態で渡すというのがキモです。
string mapの変換ルールではエスケープシーケンスが適用されることに注意します。

set office_dir {C:\Program Files\Microsoft Office}
set escaped_office_dir [string map {\\ \\\\} [file nativename $office_dir]]
puts [concat exec [auto_execok start] explorer $escaped_office_dir]
eval exec [auto_execok start] explorer $escaped_office_dir

-- 追記
上記のスクリプトではエクスプローラで開くのが前提だったので、私のように秀丸ファイラーなどの代替ファイラーを使ってる人にとっては100%満足できるものではありませんでした。なんかこれを書いてるちょっと前にStackOverflowに同じ内容の質問が挙がってて、上記の提案をドヤ顔で投稿したところ、100%満足な回答が返ってきました。
http://bit.ly/Uu6q6N

set folderpath "C:/Program Files/Microsoft Office"
exec {*}[auto_execok start] "" [file nativename $folderpath]

ちなみに、趣旨が異なりますが、エクスプローラで指定のファイルを選択した状態でフォルダを開くには、

set out "C:/Program Files (x86)/Microsoft Office/Office14/EXCEL.EXE"
exec explorer.exe /select, [file nativename $out] &

LinkedList in XOTcl

いわゆる双方向連結リストというデータ構造ですが、かつてはリチャードストールマンに、Tclには構造体がないからlinked listを作れないと指摘されていました。今ではいくつもあるオブジェクト指向拡張を使い、クラスを導入すればTclでも他の言語と同じような形で実装できます。

arrayでもできますが、あまり使いやすくならないと思うので、僕はXOTclでLinkedList::ContainerとLinkedList::Elementというクラスを作っていて、これらを継承するか、mixinしたクラスは、連結リストの管理オブジェクト、リスト要素として扱えるようにしています。

通常のリストに比べると、要素が少ないうちは遅いですが、数千数万の要素数になってくるとかなり効率が違ってきます。

テストスクリプト

package require -exact linkedlist 3.0
 
Class ListContainer -instmixin {LinkedList::Container}
Class ListElement -instmixin {LinkedList::Element}
 
proc test_linkedlist {size} {
	set container [ListContainer new]
	for {set i 0} {$i < $size} {incr i} {
		$container push [ListElement new]
	}
	foreach e [$container rlist] {
		$container delete $e
	}
	return {}
}
 
proc test_nativelist {size} {
	set l {}
	for {set i 0} {$i < $size} {incr i} {
		lappend l $i
	}
	for {set i 0} {$i < $size} {incr i} {
		set l [lreplace $l end end]
	}
	return {}
}
 
foreach size {1000 10000 15000 20000 30000} {
	puts "size=$size"
	puts "linkedlist [time {test_linkedlist $size} 2]"
	puts "nativelist [time {test_nativelist $size} 2]"
	puts ""
}

結果

C:\Tcl\lib\linkedlist3>
tclsh test2.tcl
size=1000
linkedlist 30047.5 microseconds per iteration
nativelist 2168.5 microseconds per iteration
 
size=10000
linkedlist 307218.5 microseconds per iteration
nativelist 215719.0 microseconds per iteration
 
size=15000
linkedlist 491008.5 microseconds per iteration
nativelist 469101.5 microseconds per iteration
 
size=20000
linkedlist 627835.0 microseconds per iteration
nativelist 900121.5 microseconds per iteration
 
size=30000
linkedlist 962158.5 microseconds per iteration
nativelist 1995813.5 microseconds per iteration

tktableなんかもarrayをデータソースにすると高速なんですが、arrayを直接操作するよりも、データの順序などを安全に扱うことができる連結リストでデータ管理するのがいいと思います。

package require XOTcl
namespace import xotcl::*
 
namespace eval LinkedList {}
 
Class LinkedList::Container
 
LinkedList::Container instproc init {} {
	my set first {}
	my set last {}
	my set size 0
	next
}
 
LinkedList::Container instproc destroy {} {
	set es [my list]
	foreach e $es {
		my drop $e
	}
	next
	return $es
}
 
LinkedList::Container instproc clear {} {
	set es [my list]
	foreach e $es {
		$e destroy
	}
	return {}
}
 
LinkedList::Container instproc first {} {
	my instvar first
	return $first
}
 
LinkedList::Container instproc last {} {
	my instvar last
	return $last
}
 
LinkedList::Container instproc size {} {
	my instvar size
	return $size
}
 
LinkedList::Container instproc unlink {element} {
	my instvar size first last
 
	if {![Object isobject $element]} {return -1}
	if {[$element container] != [self]} {return -1}
 
	set prev [$element prev_p]
	set next [$element next_p]
 
	$element prev_p {}
	$element next_p {}
	$element container {}
 
	if {$prev eq {}} {
		set first $next
	} else {
		$prev next_p $next
	}
	if {$next eq {}} {
		set last $prev
	} else {
		$next prev_p $prev
	}
 
	incr size -1
}
 
# private
LinkedList::Container instproc add {element} {
	my instvar size first last
	if {[$element next_p] == $first} {
		set first $element
	}
	if {[$element prev_p] == $last} {
		set last $element
	}
	$element container [self]
	incr size
	return $element
}
 
LinkedList::Container instproc scan {key value} {
	for {set e [my first]} {$e != {}} {set e [$e next_p]} {
		if {[$e $key] == $value} {return $e}
	}
}
 
LinkedList::Container instproc at {index} {
	if {$index == "end"} {return [my last]}
	if {$index < 0 || [my size] <= $index} {return {}}
	set i 0
	for {set e [my first]} {$e != {}} {set e [$e next_p]} {
		if {$i == $index} {return $e}
		incr i
	}
	return {}; # not found
}
 
LinkedList::Container instproc list {} {
	set es {}
	for {set e [my first]} {$e != {}} {set e [$e next_p]} {
		lappend es $e
	}
	return $es
}
 
LinkedList::Container instproc rlist {} {
	set es {}
	for {set e [my last]} {$e != {}} {set e [$e prev_p]} {
		lappend es $e
	}
	return $es
}
 
LinkedList::Container instproc index {element} {
	set i 0
	for {set e [my first]} {$e != {}} {set e [$e next_p]} {
		if {$e == $element} {return $i}
		incr i
	}
	return -1; # not found
}
 
LinkedList::Container instproc pop {} {
	set last [my last]
	my drop $last
}
 
LinkedList::Container instproc push {element} {
	set last [my last]
	if {$last == {}} {
		my add $element
	} else {
		$last append $element
	}
	return $element
}
 
LinkedList::Container instproc shift {} {
	my drop [my first]
}
 
LinkedList::Container instproc unshift {element} {
	set first [my first]
	if {$first == {}} {
		my add $element
	} else {
		$first prepend $element
	}
	return $element
}
 
LinkedList::Container instproc drop {element} {
	if {[my unlink $element] >= 0} {
		return $element
	}
}
 
LinkedList::Container instproc delete {element} {
	if {![Object isobject $element]} {
		$element destroy
	}
}
 
# InstMixin this class into element class to use container
Class LinkedList::Element -parameter {
	{prev_p {}}
	{next_p {}}
	{container {}}
}
 
LinkedList::Element instproc destroy {} {
	my drop
	next
	return [self]
}
 
LinkedList::Element instproc drop {} {
	if {[my container] != {}} {
		[my container] drop [self]
	}
}
 
LinkedList::Element instproc index {} {
	if {[my container] != {}} {
		[my container] index [self]
	}
}
 
LinkedList::Element instproc append {element} {
	if {[my container] != {}} {
		$element prev_p [self]
		$element next_p [my next_p]
		if {[my next_p] != {}} {
			[my next_p] prev_p $element
		}
		my next_p $element
		[my container] add $element
	}
}
 
LinkedList::Element instproc prepend {element} {
	if {[my container] != {}} {
		$element prev_p [my prev_p]
		$element next_p [self]
		if {[my prev_p] != {}} {
			[my prev_p] next_p $element
		}
		my prev_p $element
		[my container] add $element
	}
}
 
LinkedList::Element instproc status {} {
	append stat "  container = [my container]\n"
	append stat "  index     = [my index]\n"
	append stat "  element   = [self]\n"
	append stat "  neighbors = ([my prev_p]) => ([self]) => ([my next_p])\n"
}
 
package provide linkedlist 3.0

パッケージにしておきました。
linkedlist.3.0.120823

break可能なコードブロック

Tclにはgotoみたいに直列に書いたコードをスキップする制御構文がない。

例えばなんかデータを受信して、チェックしたり加工したりしたあとでどこかに記録するけど、
結果によらず受信回数はカウントしときたい場合、こんなコードを書いたとする。

proc on_receive {data} {
  global cnt
  set res [validate $data]
  if {$res == 1} {
    incr cnt; return $res
  }
  set res [convert $data data2]
  if {$res == 2} {
    incr cnt; return $res
  }
  set res [save $data2]
  incr cnt; return $res
}

incr cnt; return $res; というコードを何度も書かないといけないのが嫌だ。

そこで今まではこんな書き方をしてたことがあった。

proc on_receive {data} {
  global cnt
  while {1} {
    set res [validate $data]
    if {$res == 1} break
    set res [convert $data data2]
    if {$res == 2} break
    set res [save $data2]
    break; # Don't forget!
  }
  incr cnt; return $res
}

ときどきだけど、while {1} の最後のbreakを忘れて、
無限ループに陥ることがあったので、ケアレスミスを減らすため、こう変えた。

proc on_receive {data} {
  global cnt
  foreach once {1} {
    set res [validate $data]
    if {$res == 1} break
    set res [convert $data data2]
    if {$res == 2} break
    set res [save $data2]
  }
  incr cnt; return $res
}

ちなみにforeachのところは、こうしても同じ。

proc on_receive {data} {
  global cnt
  for {} {1} break {
    # ...
  }

だけど何とも見た目が悪い。
初めて見た人は foreach {var1 var2} {1 2} break 並みに分かりづらいだろう。
多重代入のためにlassignが導入されたように、やはり目的が分かる名前の制御構文があったほうがかっこいい。

8.6のtry(8.5ではtcllibに入ってる)を使って、blockという途中でbreak可能な制御構文を作ってみる。

if {[info tclversion] <= 8.5} {
package require try
}
proc block {script} {
  try {
    return [uplevel 1 $script]
  } on break {result options} {}
}

さっきのコードを書き換えてみる。

proc on_receive {data} {
  global cnt
  block {
    set res [validate $data]
    if {$res == 1} break
    set res [convert $data data2]
    if {$res == 2} break
    set res [save $data2]
  }
  incr cnt
  return $res
}

どうかな。

これだけでblockなんて名乗るのはおこがましいので、もうちょい慎ましい名前を考えたら使ってみようと思う。

候補

  • breakable
  • through

Tclだとそんなところに脳のリソースを割かないといけないの?とか言わないでね。

ソースコード中のUnicodeリテラルを展開して出力

Tclスクリプトにマルチバイト文字が入ってると、環境によっては文字化けして実行できないという問題がありました。
コメントは英語表記にしてあるのでいいとして、ギリシャ文字のシグマとか、パスワード隠し記号とかは見た目上どうしても使いたいので、そういう記号は全部Unicodeリテラル表記にしました。ここのツールを使うと簡単にUnicodeリテラルを調べられます。

http://www.snible.org/java2/uni2java.html

ついでに、あとでリテラルが何の記号に対応するかみたいという場合もあると思って、以下のようなスクリプトを書きました。
これでリテラルを展開した結果を見られます。

# filename: subst_unicode_literal.tcl
proc read_file {f} {
	set ch [open $f r]
	set out [read $ch]
	close $ch
	return $out
}
 
proc extract_unicode_literals {str _ll _lu} {
	upvar $_ll ll
	upvar $_lu lu
	set ll [lsort -unique [regexp -all -inline -expanded {(\\u[0-9A-Fa-f]{4})} $str]]
	set lu [subst [join $ll]]
}
 
proc make_map {ll lu} {
	set map {}
	foreach l $ll u $lu {
		lappend map $l $u
	}
	return $map
}
 
set f [lindex $argv 0]
set str [read_file $f]
 
set ll {}
set lu {}
extract_unicode_literals $str ll lu
set map [make_map $ll $lu]
set out [string map $map $str]
 
puts -nonewline $out

仕組みとしては単に\uXXXXという文字を見つけて、置換してるだけです。
Tclの場合は、Unicodeは16bitまでしか定義されてないので、リテラル表記は例外なくこれで処理できるようです。
なお、{\uXXXX}という表記はリテラルとはみなされないのですが、ここでは考慮してません。