「Tcl/Tk」カテゴリーアーカイブ

Decoding IEEE754 Single Precision Floating Point Number in Tcl - NaN, Infinite etc.

コメントを残す

Each version of Tcl recognizes big-endian IEEE754 encoded exceptional single precision floating point numbers like followings.

# IEEE754 Reference
# http://babbage.cs.qc.edu/courses/cs341/IEEE-754references.html
namespace eval IEEE754 {
	variable CONST {
		Quiet-NaN_MIN            FFFFFFFF
		Quiet-NaN_MAX            FFC00001
		Indeterminate            FFC00000
		Signaling-NaN_MIN        FFBFFFFF
		Signaling-NaN_MAX        FF800001
		-Infinity                FF800000
		NegativeNormalized_MIN   FF7FFFFF
		NegativeNormalized_MAX   80800000
		NegativeDenormalized_MIN 807FFFFF
		NegativeDenormalized_MAX 80000001
		-0                       80000000
		+0                       00000000
		PositiveDenormalized_MIN 00000001
		PositiveDenormalized_MAX 007FFFFF
		PositiveNormalized_MIN   00800000
		PositiveNormalized_MAX   7F7FFFFF
		Infinity                 7F800000
		Signaling+NaN_MIN        7F800001
		Signaling+NaN_MAX        7FBFFFFF
		Quiet+NaN_MIN            7FC00000
		Quiet+NaN_MAX            7FFFFFFF
	}
}
 
if {$::tcl_version >= 8.5} {
	proc IEEE754::string_reverse {s} {
		string reverse $s
	}
} else {
	package require struct::list
	package require textutil
	proc IEEE754::string_reverse {s} {
		join [struct::list reverse [textutil::splitn $s 1]] ""
	}
}
 
proc IEEE754::test {} {
	variable CONST
	puts "tcl_patchLevel = $::tcl_patchLevel"
	foreach {name hex} $CONST {
		set name [format %-24s $name]
		binary scan [string_reverse [binary format H* $hex]] f a
		puts "FLOAT: $name $a"
	}
}
 
IEEE754::test

# tcl_patchLevel = 8.4.19
# FLOAT: Quiet-NaN_MIN            -1.#QNAN
# FLOAT: Quiet-NaN_MAX            -1.#QNAN
# FLOAT: Indeterminate            -1.#IND
# FLOAT: Signaling-NaN_MIN        -1.#QNAN
# FLOAT: Signaling-NaN_MAX        -1.#QNAN
# FLOAT: -Infinity                -1.#INF
# FLOAT: NegativeNormalized_MIN   -3.40282346639e+038
# FLOAT: NegativeNormalized_MAX   -1.17549435082e-038
# FLOAT: NegativeDenormalized_MIN -1.17549421069e-038
# FLOAT: NegativeDenormalized_MAX -1.40129846432e-045
# FLOAT: -0                       -0.0
# FLOAT: +0                       0.0
# FLOAT: PositiveDenormalized_MIN 1.40129846432e-045
# FLOAT: PositiveDenormalized_MAX 1.17549421069e-038
# FLOAT: PositiveNormalized_MIN   1.17549435082e-038
# FLOAT: PositiveNormalized_MAX   3.40282346639e+038
# FLOAT: Infinity                 1.#INF
# FLOAT: Signaling+NaN_MIN        1.#QNAN
# FLOAT: Signaling+NaN_MAX        1.#QNAN
# FLOAT: Quiet+NaN_MIN            1.#QNAN
# FLOAT: Quiet+NaN_MAX            1.#QNAN

# tcl_patchLevel = 8.5.9
# FLOAT: Quiet-NaN_MIN            -NaN(7ffffe0000000)
# FLOAT: Quiet-NaN_MAX            -NaN(20000000)
# FLOAT: Indeterminate            -NaN
# FLOAT: Signaling-NaN_MIN        -NaN(7ffffe0000000)
# FLOAT: Signaling-NaN_MAX        -NaN(20000000)
# FLOAT: -Infinity                -Inf
# FLOAT: NegativeNormalized_MIN   -3.4028234663852886e+38
# FLOAT: NegativeNormalized_MAX   -1.1754943508222875e-38
# FLOAT: NegativeDenormalized_MIN -1.1754942106924411e-38
# FLOAT: NegativeDenormalized_MAX -1.401298464324817e-45
# FLOAT: -0                       -0.0
# FLOAT: +0                       0.0
# FLOAT: PositiveDenormalized_MIN 1.401298464324817e-45
# FLOAT: PositiveDenormalized_MAX 1.1754942106924411e-38
# FLOAT: PositiveNormalized_MIN   1.1754943508222875e-38
# FLOAT: PositiveNormalized_MAX   3.4028234663852886e+38
# FLOAT: Infinity                 Inf
# FLOAT: Signaling+NaN_MIN        NaN(20000000)
# FLOAT: Signaling+NaN_MAX        NaN(7ffffe0000000)
# FLOAT: Quiet+NaN_MIN            NaN
# FLOAT: Quiet+NaN_MAX            NaN(7ffffe0000000)

# tcl_patchLevel = 8.6b1.2
# FLOAT: Quiet-NaN_MIN            -NaN(7ffffe0000000)
# FLOAT: Quiet-NaN_MAX            -NaN(20000000)
# FLOAT: Indeterminate            -NaN
# FLOAT: Signaling-NaN_MIN        -NaN(7ffffe0000000)
# FLOAT: Signaling-NaN_MAX        -NaN(20000000)
# FLOAT: -Infinity                -Inf
# FLOAT: NegativeNormalized_MIN   -3.4028234663852886e+38
# FLOAT: NegativeNormalized_MAX   -1.1754943508222875e-38
# FLOAT: NegativeDenormalized_MIN -1.1754942106924411e-38
# FLOAT: NegativeDenormalized_MAX -1.401298464324817e-45
# FLOAT: -0                       -0.0
# FLOAT: +0                       0.0
# FLOAT: PositiveDenormalized_MIN 1.401298464324817e-45
# FLOAT: PositiveDenormalized_MAX 1.1754942106924411e-38
# FLOAT: PositiveNormalized_MIN   1.1754943508222875e-38
# FLOAT: PositiveNormalized_MAX   3.4028234663852886e+38
# FLOAT: Infinity                 Inf
# FLOAT: Signaling+NaN_MIN        NaN(20000000)
# FLOAT: Signaling+NaN_MAX        NaN(7ffffe0000000)
# FLOAT: Quiet+NaN_MIN            NaN
# FLOAT: Quiet+NaN_MAX            NaN(7ffffe0000000)

ipconfigを呼ばないでMACアドレスのリストを取得する

2件の返信

TclからNICのMACアドレスのリストを取得する場合、ipconfig/allの出力から取り出してたけど、Windowsのバージョンやロケールによって出力が変わるものを使うのはどうも気に食わんかったので、ちゃんとそれ用のWindows APIを使いたいと思っていた。
今回twapiを使えばできることが分かったので、メモしておく。

# IEEE754 Reference
# http://babbage.cs.qc.edu/courses/cs341/IEEE-754references.html
namespace eval IEEE754 {
	variable CONST {
		Quiet-NaN_MIN            FFFFFFFF
		Quiet-NaN_MAX            FFC00001
		Indeterminate            FFC00000
		Signaling-NaN_MIN        FFBFFFFF
		Signaling-NaN_MAX        FF800001
		-Infinity                FF800000
		NegativeNormalized_MIN   FF7FFFFF
		NegativeNormalized_MAX   80800000
		NegativeDenormalized_MIN 807FFFFF
		NegativeDenormalized_MAX 80000001
		-0                       80000000
		+0                       00000000
		PositiveDenormalized_MIN 00000001
		PositiveDenormalized_MAX 007FFFFF
		PositiveNormalized_MIN   00800000
		PositiveNormalized_MAX   7F7FFFFF
		Infinity                 7F800000
		Signaling+NaN_MIN        7F800001
		Signaling+NaN_MAX        7FBFFFFF
		Quiet+NaN_MIN            7FC00000
		Quiet+NaN_MAX            7FFFFFFF
	}
}
 
if {$::tcl_version >= 8.5} {
	proc IEEE754::string_reverse {s} {
		string reverse $s
	}
} else {
	package require struct::list
	package require textutil
	proc IEEE754::string_reverse {s} {
		join [struct::list reverse [textutil::splitn $s 1]] ""
	}
}
 
proc IEEE754::test {} {
	variable CONST
	puts "tcl_patchLevel = $::tcl_patchLevel"
	foreach {name hex} $CONST {
		set name [format %-24s $name]
		binary scan [string_reverse [binary format H* $hex]] f a
		puts "FLOAT: $name $a"
	}
}
 
IEEE754::test

# tcl_patchLevel = 8.4.19
# FLOAT: Quiet-NaN_MIN            -1.#QNAN
# FLOAT: Quiet-NaN_MAX            -1.#QNAN
# FLOAT: Indeterminate            -1.#IND
# FLOAT: Signaling-NaN_MIN        -1.#QNAN
# FLOAT: Signaling-NaN_MAX        -1.#QNAN
# FLOAT: -Infinity                -1.#INF
# FLOAT: NegativeNormalized_MIN   -3.40282346639e+038
# FLOAT: NegativeNormalized_MAX   -1.17549435082e-038
# FLOAT: NegativeDenormalized_MIN -1.17549421069e-038
# FLOAT: NegativeDenormalized_MAX -1.40129846432e-045
# FLOAT: -0                       -0.0
# FLOAT: +0                       0.0
# FLOAT: PositiveDenormalized_MIN 1.40129846432e-045
# FLOAT: PositiveDenormalized_MAX 1.17549421069e-038
# FLOAT: PositiveNormalized_MIN   1.17549435082e-038
# FLOAT: PositiveNormalized_MAX   3.40282346639e+038
# FLOAT: Infinity                 1.#INF
# FLOAT: Signaling+NaN_MIN        1.#QNAN
# FLOAT: Signaling+NaN_MAX        1.#QNAN
# FLOAT: Quiet+NaN_MIN            1.#QNAN
# FLOAT: Quiet+NaN_MAX            1.#QNAN

# tcl_patchLevel = 8.5.9
# FLOAT: Quiet-NaN_MIN            -NaN(7ffffe0000000)
# FLOAT: Quiet-NaN_MAX            -NaN(20000000)
# FLOAT: Indeterminate            -NaN
# FLOAT: Signaling-NaN_MIN        -NaN(7ffffe0000000)
# FLOAT: Signaling-NaN_MAX        -NaN(20000000)
# FLOAT: -Infinity                -Inf
# FLOAT: NegativeNormalized_MIN   -3.4028234663852886e+38
# FLOAT: NegativeNormalized_MAX   -1.1754943508222875e-38
# FLOAT: NegativeDenormalized_MIN -1.1754942106924411e-38
# FLOAT: NegativeDenormalized_MAX -1.401298464324817e-45
# FLOAT: -0                       -0.0
# FLOAT: +0                       0.0
# FLOAT: PositiveDenormalized_MIN 1.401298464324817e-45
# FLOAT: PositiveDenormalized_MAX 1.1754942106924411e-38
# FLOAT: PositiveNormalized_MIN   1.1754943508222875e-38
# FLOAT: PositiveNormalized_MAX   3.4028234663852886e+38
# FLOAT: Infinity                 Inf
# FLOAT: Signaling+NaN_MIN        NaN(20000000)
# FLOAT: Signaling+NaN_MAX        NaN(7ffffe0000000)
# FLOAT: Quiet+NaN_MIN            NaN
# FLOAT: Quiet+NaN_MAX            NaN(7ffffe0000000)

# tcl_patchLevel = 8.6b1.2
# FLOAT: Quiet-NaN_MIN            -NaN(7ffffe0000000)
# FLOAT: Quiet-NaN_MAX            -NaN(20000000)
# FLOAT: Indeterminate            -NaN
# FLOAT: Signaling-NaN_MIN        -NaN(7ffffe0000000)
# FLOAT: Signaling-NaN_MAX        -NaN(20000000)
# FLOAT: -Infinity                -Inf
# FLOAT: NegativeNormalized_MIN   -3.4028234663852886e+38
# FLOAT: NegativeNormalized_MAX   -1.1754943508222875e-38
# FLOAT: NegativeDenormalized_MIN -1.1754942106924411e-38
# FLOAT: NegativeDenormalized_MAX -1.401298464324817e-45
# FLOAT: -0                       -0.0
# FLOAT: +0                       0.0
# FLOAT: PositiveDenormalized_MIN 1.401298464324817e-45
# FLOAT: PositiveDenormalized_MAX 1.1754942106924411e-38
# FLOAT: PositiveNormalized_MIN   1.1754943508222875e-38
# FLOAT: PositiveNormalized_MAX   3.4028234663852886e+38
# FLOAT: Infinity                 Inf
# FLOAT: Signaling+NaN_MIN        NaN(20000000)
# FLOAT: Signaling+NaN_MAX        NaN(7ffffe0000000)
# FLOAT: Quiet+NaN_MIN            NaN
# FLOAT: Quiet+NaN_MAX            NaN(7ffffe0000000)

ちなみにコマンドプロンプト上ではchcpで932以外のコードページを指定してからipconfigすれば英語の出力になる。
これをTclからもできればよかったんだけど、複数のコマンドをパイプ経由で渡すことはできないようだ。

cmd /c "chcp 437 & ipconfig/all"

というのをexecしたりしても、標準出力を受け取ることができなかった。
一時的にバッチファイルを作り、これを実行してもよいが、美しくない。

そういうわけで、上記のテクニックが今のところ一番いいと思う。

In which case vwait never returns

コメントを残す

If your Tcl script uses many afters and vwaits, sometimes it happens that vwait never returns even if its target variable is set. I didn't understand why my application get into such a situation.

Here is a sample script that causes first call of vwait never to return.
Run this script in wish.

package require twapi
proc getPhysicalAddresses {} {
	set macs {}
	foreach i [twapi::get_netif_indices] {
		set type [twapi::get_netif_info $i -type]
		array set netif [twapi::get_netif_info $i -type -physicaladdress]
		if {$netif(-type) eq "ethernet"} {
			lappend macs [string toupper $netif(-physicaladdress)]
		}
	}
	return $macs
}
puts [getPhysicalAddresses]

I expect the following output;

cmd /c "chcp 437 & ipconfig/all"

Contrary to my expection, the actual console output is;

enter vwait ::var1
enter vwait ::var2
set var1 go

When I call "set_var2 go" interactively, the output follows,

% set var2 go
go
leave vwait ::var2
leave vwait ::var1
set var2 go

This means that if you call nested vwaits, the first call of a vwait blocks until all of the nested vwait returns.

Even if you understand this characteristics of vwait, you can run into trouble in network programs. I guess this is caused by the following characteristics of a network program.

  • It doesn't know when a response comes.
  • It uses recursive call of vwait when resending a command on a response timeout.
  • A polling loop interrupts normal sequence order.

Sorry to suck at explaining.

I made an application that communicates with multiple I/O devices which have UDP servers.
I designed it in an object-oriented way and encapsulated UDP client sockets in each of the device objects. As the UDP server device doesn't support push-notification, I had to ask their status at a certain intervals: a polling loop for each device. The polling loops are recursive call of afters. They interrupt into the normal command sequence. I guess this causes unexpected vwait call.

My design was successful in the other platforms like Ruby and C# which have built-in preemptive threads. But in Tcl, I had to place a single manager object for highly concurrent parts of the program.

Tcl has many OOP extensions. We can call Tcl as multi paradigm programming language. But as to this kind of thing, Tcl is not truely object-oriented; it forces tight dependencies between objects.

Tcl 8.6 will gain coroutines. I hope it will introduce a true OOP into Tcl.

Tcl/Tk 8.5 Programming Cookbook

ttk::comboboxのドロップダウンリストのフォントを変更する

コメントを残す

ttk::comboboxには-fontオプションがあるのに、ドロップダウンリスト(popdown)のフォントを変えるオプションはありません。私の環境ではTkDefaultFontがTahoma 8ptになってるので、フォントが小さすぎて困ります。

Tcler's Wikiには全てのウィジェットで共通の設定をする方法が紹介されています。
Tcler's Wiki - ttk::combobox

console show
 
rename vwait original_vwait
proc vwait {var} {
	global last_vwait_var
	puts "enter vwait $var"
	set last_vwait_var $var
	original_vwait $var
	puts "leave vwait $var"
}
set last_vwait_var {}
 
proc set_var1 {val} {
	global var1
	puts "set var1 $val"
	set var1 $val
}
 
proc set_var2 {val} {
	global var2
	puts "set var2 $val"
	set var2 $val
}
 
after 1000 {
	after 1000 {
		set_var1 go
	}
	vwait ::var2
}
 
vwait ::var1
set_var2 go

しかし、個別に大きさを変更したいこともあると思います。
comboboxのリストはウィジェットなのですが、通常、最初に表示するときに生成されます。
しかし、以下のコマンドを使って今すぐウィジェットを作成することもできます。
ttk::combobox::PopdownWindow cb
これを呼んでおけばフォントを変えてやることができます。

enter vwait ::var1
enter vwait ::var2
set var1 go
leave vwait ::var1
set var2 go
leave vwait ::var2

ただ、ttk::comboboxだけがfontオプションを持っているのはスタイルのコンセプトに反するとか、fontを指定できるのにpopdownのフォントが指定できないとかいろいろ突っ込みどころの多いウィジェットなので、そのうち仕様が変更されるかもしれません。まあ、このくらいの労力ならむしろこのままでもいいんですが。。。

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

コメントを残す

コンパイルに使用したもの
ActiveTcl 8.4.19.5 http://www.activestate.com/activetcl/downloads
wxSQLite3(wxsqlite3-2.1.2.zip) http://sourceforge.net/projects/wxcode/files/Components/wxSQLite3/
SQLite3ソースコード(sqlite-autoconf-3070701.tar.gz) http://www.sqlite.org/download.html
MinGW(mingw-get-inst-20110530.exe) http://sourceforge.net/projects/mingw/files/Automated%20MinGW%20Installer/mingw-get-inst/

作業フォルダはどこでもいいですが、今回はc:\srcとします。
そこにSQLite3ソースコードとwxSQLite3を展開します。
こんな感じ。

# option add *TCombobox*Listbox.font MyComboboxFont

以下のフォルダ内の全てのファイルを
C:\src\wxsqlite3-2.1.2\sqlite3\secure\src\codec-c

ここに上書きコピーします。
C:\src\sqlite-autoconf-3070701\tea\generic

そして、以下のソースコードをテキストエディタで開きます。
C:\src\sqlite-autoconf-3070701\tea\generic\tclsqlite3.c

4行目の"../../sqlite3.c"を

package require Tk
 
font create MyComboboxFont -family Arial -size 20
 
ttk::combobox .cb -font MyComboboxFont -values {ichiro jiro saburo}
set popdown [ttk::combobox::PopdownWindow .cb]
$popdown.f.l configure -font MyComboboxFont
 
place .cb -x 10 -y 10

"sqlite3secure.c"に書き換える。

#ifdef USE_SYSTEM_SQLITE
# include 
#else
#include "sqlite3secure.c"
#endif

これで、コンパイルの準備はできました。

さて、MinGW shellを起動しましょう。

ディレクトリを移動してコンパイルします。

cd /c/src/sqlite-autoconf-3070701/tea
$ ./configure CFLAGS="-DSQLITE_HAS_CODEC"
$ make

デフォルトではAES128コーデックが使われます。
試してませんが、AES256にしたければ、以下のようにすればよいと思います。

$ ./configure CFLAGS="-DSQLITE_HAS_CODEC -DCODEC_TYPE=CODEC_TYPE_AES256"

wxSQLite3 AES128ならGUIツールのSQLite2009 Proが対応していますが、AES256に対応しているツールはなさそうなので、セキュリティの強化以外の理由でAES256を選択する理由はないと思います。

これで以下のファイルができました。これ単体でTclのパッケージです。

C:\src\sqlite-autoconf-3070701\tea\sqlite3771.dll

直接tclshからloadするか、pkgIndex.tclとともにTcl/libにインストールしてpackage requireすることもできます。

さて、テストしてみましょう。

load sqlite3771.dll Sqlite3

# create plain database file
sqlite3 pdb plain.db

# create encrypted database file
sqlite3 sdb secret.db -key password

# SQL test script
# 1. create table
# 2. populate test data
# 3. execute query
set sql {
	create table users (
		id integer primary key autoincrement not null,
		name text,
		age integer
	);
	insert into users (name, age) values ("山田太郎", 30);
	select * from users;
}
 
pdb eval $sql
#=>; 1 山田太郎 30
pdb close
 
sdb eval $sql
#=>; 1 山田太郎 30
sdb close

# Re-open plain.db
sqlite3 pdb plain.db
pdb eval {
	select * from users;
}
#=>; 1 山田太郎 30
pdb close

# Re-open secret.db without a key
sqlite3 sdb secret.db
sdb eval {
	select * from users;
}
#=>; file is encrypted or is not a database
sdb close

既存のデータベースファイルを暗号化するには、rekeyするか、dumpを取得して
暗号化した新規データベースでrestoreすればOKです。
この作業には、wxSQLite3に付属するコンパイル済みのshellを使用してください。
C:\src\wxsqlite3-2.1.2\sqlite3\secure\aes128\sqlite3shell.exe

追記：Tclからもできます。

load sqlite3771.dll Sqlite3
# Encrypt plain database
sqlite3 pdb plain.db
pdb rekey "password"
pdb close

# Reopen as plain database
sqlite3 pdb plain.db
pdb eval {
	select * from users;
}
#=>; file is encrypted or is not a database

# Decript secret database
sqlite3 sdb plain.db -key password
sdb rekey ""; # specify null string as encryption key
sdb close

# Re-open plain.db
sqlite3 pdb plain.db
pdb eval {
	select * from users;
}
#=>; 1 山田太郎 30
pdb close

最後はちょっとはしょった説明になりましたが、できてしまえば結構簡単です。
tclsqliteの暗号化APIについてのドキュメントはないのですが、ネイティブの関数と基本的に変わりはないと思います。
間違ったコマンドを与えてやるとエラーメッセージに関数リストが出てきたり、
関数に間違った引数を与えてやることで使い方が出てきたりするので、いろいろ試してみるとよいと思います。

(tea) 1 % load sqlite3771.dll Sqlite3
(tea) 2 % sqlite3 sdb secret.db -key password
(tea) 3 % sdb ?
bad option "?": must be authorizer, backup, busy, cache, changes, close, collate, collation_needed, commit_hook, complete, copy, enable_load_extension, errorcode, eval, exists, function, incrblob, interrupt, last_insert_rowid, nullvalue, onecolumn, profile, progress, rekey, restore, rollback_hook, status, timeout, total_changes, trace, transaction, unlock_notify, update_hook, version, or wal_hook

なお、.NET Frameworkから使えるADOプロバイダとしてSystem.Data.SQLite.dllが暗号化に対応していますが、これはRSA-MS Cryptだそうです。名前しか分かりませんがとりあえずAESとは別物です。SQLite Encryption Extension($2,000)は4つのコーデックがコンパイル時に選択できるようです。

SQLite3にformatみたいな関数がないのでTclでやる

コメントを残す

1-12みたいな連番文字列を01012に一括変換したかった。別のカラムに分けるのが普通でしょうが、諸事情により。
SQLiteの組み込み関数には日付の操作関数は充実してるけど、文字列操作関数は大したものがない。
それで、Tclでやることにした。

c:\src
├─sqlite-autoconf-3070701
│  └─tea
│      ├─doc
│      ├─generic
│      ├─tclconfig
│      └─win
└─wxsqlite3-2.1.2
    ├─build
    ├─build29
    ├─dbadmin
    │  └─images
    ├─docs
    │  └─html
    ├─include
    │  └─wx
    ├─lib
    ├─samples
    ├─sqlite3
    │  ├─include
    │  ├─lib
    │  └─secure
    │      ├─aes128
    │      ├─aes256
    │      └─src
    │          ├─codec
    │          └─codec-c
    ├─src
    └─website

02012みたいなのは、クォートしないと数値とみなされて2012みたいになってしまうので注意が必要です。
LIKE以外にもGLOBやREGEXPも使えるらしい。

050-で始まる電話番号を持つ人のリストを取得するなど。
select * from users where phone_number REGEXP "^050-.+$"

Tcl/TkでMutexを使った多重起動防止

コメントを残す

Tcl単体でやろうとすると、ロックファイルでやりなさいということになるんですけど、その場合Tclの処理系が起動するまでに、別のインスタンスが起動できてしまう可能性があるので、厳密ではないです。たとえば、

package require sqlite3
sqlite3 db ./app.db; # handle and database file
 
db eval {SELECT * FROM squence WHERE field LIKE "%-%"} values {
	set R-V $values(field)
	if {[scan ${R-V} %d-%d R V] == 2} {
		set RRVVV [format %02d%03d $R $V]
		db eval [format {UPDATE squence SET field="%s" WHERE id=%d} $RRVVV $values(id)]
	}
}

とかやると、2重起動してしまいます。

プロセスリストを取得して処理する方法もあります http://goo.gl/K38a 。今まではこれを使っていました。ただ、プロセスリストの取得自体が結構時間かかるので、上記よりましですが確実ではないです。

別の方法として、socketで特定ポートをバインドして、多重起動時にエラーにするという方法があります。singleton application - Tcler's Wiki
ネットワークを使わないのにファイアウォールの例外にするか聞かれたりするのが嫌です。

Mutexを使うと、VBやC#とかでやってるみたいな厳密な多重起動防止対策ができます（Windows限定）。

twapi 2.2.3での実装

package require twapi 2.2.3
twapi::import_commands
 
set appname "My Application"
 
set handle [create_mutex -name $appname]
if {[lock_mutex $handle -wait 1] > 0} {
	tk_messageBox -icon error 
		-title "Startup error" 
		-message "Another instance is running." 
		-type ok
	exit
}
console show

twapi 3.0 正式版での実装

先日twapi3.0の正式版がリリースされました。
3.0では従来通りpackage require するか、dllを1個loadするかが選べるようになりました。
x86版はTcl8.4をサポートしています。
3.0ではAPIの仕様がいろいろ変わって、lock_mutexの返り値がsignalled, timeout, abandonedのいずれかとなっています。

load twapi-x86-3.0.29.dll
twapi::import_commands
 
set appname "My Application"
 
set handle [create_mutex -name $appname]
if {[lock_mutex $handle -wait 1] ne "signalled"} {
	tk_messageBox -icon error 
		-title "Startup error" 
		-message "Another instance is running." 
		-type ok
	exit
}
console show

先に起動してたウインドウを閉じるかユーザに聞く

そういうことをする実験です。実際にはプロセスをkillするとか、ウィンドウの存在を監視して、完全に終了するのを待つとかが必要になると思います。

package require Tk
load twapi-x86-3.0.29.dll
twapi::import_commands
 
set appname "My Application"
 
set handle [create_mutex -name $appname]
if {[lock_mutex $handle -wait 1] ne "signalled"} {
	set ans [tk_messageBox -icon error 
		-title "Startup error" 
		-message "Another instance is running. Kill it?" 
		-type yesno]
	switch $ans {
	yes {
		set hWnds [find_windows -text $appname]
		foreach hWnd $hWnds {
			close_window $hWnd
		}
	}
	no {
		exit
	}
	}
}
 
wm title . $appname
wm protocol . DELETE_WINDOW EXIT
proc EXIT {} {
	after 3000 exit
}

DataGridViewをActiveXコントロールにラップしてTcl/Tkのウィンドウに埋め込む(3)

コメントを残す

これまでの経緯
DataGridViewをActiveXコントロールにラップしてTcl/Tkのウィンドウに埋め込む(1)
DataGridViewをActiveXコントロールにラップしてTcl/Tkのウィンドウに埋め込む(2)

去年やってたoptclによるDataGridView埋め込みが、ようやく役に立つときが来た。
しかし、イベントを追加しようとしたところ、いきなり壁にぶち当たってしまった。

新たに定義したイベントにコールバックを登録できない。

続きを読む →

DataGridViewをActiveXコントロールにラップしてTcl/Tkのウィンドウに埋め込む(2)

コメントを残す

 

前回に引き続き、イベントの定義をやってみました。

DataGridViewのボタンセルが押されたら、そのセルの行・列番号を引数にして、Tclのプロシージャをコールバックするということがしたい。

ソリューション一式: SimpleDgv.zip

まず、メソッドと別にインターフェースを用意して、InterfaceTypeをComInterfaceType.InterfaceIsIDispatchにします。

[Guid("1AE7D7D7-02EF-4d70-B7F5-71CE046FAEA9"), ComVisible(true), InterfaceType(ComInterfaceType.InterfaceIsIDispatch)]
public interface ISimpleDgvDispatch
{
    void ButtonClick(int col, int row);
}

そして、クラスの属性にComSourceInterfaces(“ISimpleDgvDispatch”)を追加し、クラスにButtonClickイベントを定義します。

[Guid("29E1BC35-88D3-47f0-997D-B889CA25E135"), ComVisible(true), ClassInterface(ClassInterfaceType.None), ComSourceInterfaces(typeof(ISimpleDgvDispatch))]
public partial class SimpleDgv : UserControl, ISimpleDgvInteface
{
    public delegate void ButtonClickDelegate(int col, int row);
    public event ButtonClickDelegate ButtonClick;

    protected void OnButtonClick(int col, int row)
    {
        if (ButtonClick != null)
        {
            ButtonClick(col, row);
        }
    }
}

ビルドするとCOMとして公開されました。

Tcl側のコード

proc ButtonClick {col row} {
    tk_messageBox -type ok -message "Callback Col=$col, Row=$row"
}
optcl::bind $dgvObj ButtonClick ButtonClick

 

さあ、どうでしょう？

エラー全文

イベントを実行したC#側で例外が発生しました。例外テキストからはSystem.RuntimeType.InvokeDispMethodに渡されるcultureが不明なものであったということだろうと解釈できますが、だからといってどうすればよいというのでしょう？

DISP_E_UNKNOWNLCIDとはなんぞや？ググっても文字通りの説明しか出てきません。

AssemblyInfo.csでCultureInfoを指定したりもしてみたが、何も変わらない。

これで丸1日試行錯誤したものの、全く原因も解決法も分からず途方にくれました。

どうしよう。引っ込みがつかない。

2009/9/8 -- 追記: 成功

.Net Framework フォーラムで質問したらjzkeyさんが回答をくれました。

http://social.msdn.microsoft.com/Forums/ja-JP/netfxgeneralja/thread/46e0c5a2-0a89-472e-b4d6-0cd7399e1300

動くようになったoptclのバイナリとソースを置いておきます。

http://yyamasak.drivehq.com/devel/src/tcl/lib/optcl3010t-bin.zip
http://yyamasak.drivehq.com/devel/src/tcl/lib/optcl3010t-src.zip

optclがビルドできるようになったので、とりあえずBase64でのやり取りで妥協したマルチバイト引数の件も調べれば何とかなるかもしれないという希望が出てきました。

DataGridViewをActiveXコントロールにラップしてTcl/Tkのウィンドウに埋め込む(1)

コメントを残す
先日Tcl/TkのGUIにデータグリッドを、ということでTkTableをいじっていましたが、やっぱりいろいろ大変だということで、.NET FrameworkのDataGridViewをTkのウインドウに埋め込む実験をしてみました。これならほとんどデフォルトのバインディングでも文句はないでしょう。
 
さて、C#で作ったユーザーコントロールをActiveXコントロールにする方法は比較的簡単です。プロジェクトのプロパティでそれっぽいところに2箇所ほどチェックを入れてビルドすればCOM参照可能になります。
 
ビルドしてできたDLLはP/Invoke的な方法で利用することはできないです。マネージド環境の外から使うため、COMに登録する必要があります。
 
手動でインストールする場合は、WindowsSDKに含まれるregasm.exeを使って、
regasm SimpleDgv.dll /tlb:SimpleDgv.tlb /codebase
 
アンインストールは
regasm SimpleDgv.dll /unregister
 
COMへの登録に成功したら、次はいかにTclから利用するかです。ActiveTclには標準でtcomというCOMを利用するためのパッケージが付いてきますが、ActiveXコントロールをTkに埋め込むという目的には使えません。代わりにOptclというパッケージが存在します。これはActiveTclに含まれていないため、Tcler's Wikiにあったリンクからコンパイル済みのバイナリをとってきました。
 
System.Windows.Forms.dllがそのままCOMにできればいいなと一瞬思ったんですが、そうしたところでOptclで使うのが難しい引数や型もあるので、あまり意味がない気がします。必要そうなものに限ってラッパーメソッドを作って公開することにします。
 
以下の図は、上がC#のフォームにユーザーコントロールを貼り付けたもの（これはCOMではありません）。下の方が、optclを使ってActiveXコントロールとしてTkのウインドウに貼り付けたものです。
 
 
日本語が文字化けしていますね。どうしてこうなるのか、よく分かっていません。
文字列はソースファイルに埋め込んであります。
 
TclのソースはShiftJISで、C#はUTF-8 BOM有りとなっています。
聞くところによると、Tclは内部エンコーディングとしてUTF-8を、C#はunicodeを採用しているそうですが、その辺の問題でしょうか？
optclが出す（C#のエラーメッセージと思われる）も文字化けしてて復元できないんですよね。
 
いろいろといじってみてはいますが、解決していません。
 
encoding convertto unicode
encoding convertto cp932
 
とかは意味なかったです。このコマンドもあまり理解してないんですけどね。
 
C#でバイト列から文字コードを判定する方法はあちこちで紹介されていたので、Tclから渡すときに文字列をbinary formatしてbyte[]で渡そうと思ったらoptclの制限で配列引数は未実装とのこと。
 
うーん困った。
 

2009/9/2 -- 追記: とりあえずC#の側で解決しました。

byte[] b = Encoding.Default.GetBytes(s);
string u = Encoding.UTF8.GetString(b);

要するに、TclはUTF-8をデコードして送ってるのに、C#はシステムのデフォルトエンコーディング（Shift_JIS）としてエンコードしてるようなのです。

だからその逆をたどってやればよいわけで、まず文字化けした文字列をShift_JISとしてバイト列に戻します。これをUTF-8エンコードしてやることで、本来の文字列に戻してやることができるという理屈です。ただし、これはもともとUTF-8で送ってくるクライアントにしか対応できません。2行目が決めうちだからです。

2009/9/2 -- 追記: やっぱだめ

うまくできたと思ったのはひらがなだけで、漢字やカタカナは一部が文字化けしてしまいました（例: 選択 -> 選･）。

ここによれば、一度間違って変換されたものは可逆性を失うようです。
http://dobon.net/vb/dotnet/string/getencoding.html

最初から不可逆なんだからC#で直すことはできないってことになる。

あとはTclからそもそもShift_JISで送れるようにするか、base64でASCIIとして送って、デコードするかしかなさそう。

2009/9/2 -- 追記: 成功

やっぱりbase64でやることにした。いちいち変換しないといけなくてめんどいけど、しょうがあるまい。

Tcl側のポイントは、マルチバイト文字を含む場合は一旦バイナリに変換しないといけないこと。encoding converttoを使う。
C#側はShift_JISのASCII部分だけ使うので、情報の損失がなくなった。返すときは任意のエンコーディングでかまわないようだが、Tcl側で対称性を持たせるためにシステムデフォルト（Shift_JIS）で返すようにした。

Tcl側のコード（エンコーディング省略でシステムデフォルト）

proc dec {s} {
 ::base64::encode [encoding convertto $s]; # Tcl -> C#
}

proc enc {s} {
 encoding convertfrom [base64::decode $s]; # C# -> Tcl
}

C#側のコード

namespace Extension
{
    public static class StringMethod
    {
        public static string Dec(this string s, Encoding encoding) // Tcl -> C#
        {
            var b = Convert.FromBase64String(s);
            b = Encoding.Convert(Encoding.Default, encoding, b);
            return encoding.GetString(b);
        }

        public static string Enc(this string s) // C# -> Tcl
        {
            var b = Encoding.Default.GetBytes(s);
            return Convert.ToBase64String(b);
        }
    }
}

Visual Studio 2008 C#ソリューションとTclのソースを固めて置いときます。ご自由に拾ってください。
 
 
 
今後の予定：
  1. イベントの定義（ボタンクリックとか）
  2. クリップボード操作（CSV/TSVプレーンテキスト）
  3. その他もろもろ