実践？Tix(1)：TclXML と tixHList
ここからは実践(というほど今までと違うわけでもないのですが)、 ひとつ、GUI拡張のTixと非GUI拡張のなにがしかを共用して、 いろいろなアプリケーションを作ってみます。
このページのサンプルは、 TclXML のXMLパーサとTixのtixHListウィジェットを使って、 XMLドキュメントのタグ階層を表示するものです。
作り方ですが、TclXMLの-elementstartcommandと
-elementendcommandで、タグ要素が開いたり閉じたりするたびに、
現在のタグ階層をTcl広域変数hに持たせておきます。
その際、XMLの特性では同じタグが何度も開いたり閉じたりするとタグ階層が一意にならないので、
「document0.order2.line5.parts12」
のような通し番号をつけてtixHListの各行のIDにしています。
ソースプログラムです。
package require xml
package require Tix
option add *Font kanji16
wm title . "Sample XML Hierarchy Viewer"
set m [menu .m]
set mm [menu $m.m]
$mm add command -label "終了" -command exit
$m add cascade -label "ファイル" -menu $m.m
. configure -menu $m
set f [frame .f -rel groove -bd 2]
set ha [tixHList $f.ha -width 50 -height 10 -separator . \
-column 3 -header 1 -yscroll "$f.scrv set" -xscroll "$f.scrh set" \
-selectforeground "#600040" -selectbackground "#f0c0c0" -bg "#f0f0c0" \
-selectborderwidth 2]
scrollbar $f.scrv -ori v -command "$ha yview"
scrollbar $f.scrh -ori h -command "$ha xview"
$ha header create 0 -text タグ
$ha header create 1 -text 属性
$ha header create 2 -text 内容
grid $ha -col 1 -row 1
grid $f.scrv -col 2 -row 1 -sticky ns
grid $f.scrh -col 1 -row 2 -sticky ew
pack $f
set id 0
set h {}
# {name taro address tokyo} のような属性リストから、
# "name=taro address=tokyo" のような文字列を作って返します。
proc getAttr alist {
set r {}
set alist [lindex $alist 0]
set len [llength $alist]
for {set i 0} {$i < $len} {incr i 2} {
lappend r "[lindex $alist $i]=[lindex $alist [expr $i+1]]"
}
return $r
}
proc readXML {xmlfile ha} {
set fin [open $xmlfile r]
fconfigure $fin -encoding shiftjis
set buf [read $fin]; close $fin
set parser [::xml::parser \
-characterdatacommand "cdataCmd h $ha" \
-elementstartcommand "estartCmd h id $ha" \
-elementendcommand "eendCmd h"
]
$parser parse $buf
}
proc estartCmd {hvar idvar ha ename args} {
upvar $hvar h
upvar $idvar id
# XML文書は同じ完全修飾名のタグが繰り返し現れることがあるので、
# idをつけて逃げています。
lappend h $ename$id; incr id
# HListのキーはタグの階層をセパレータで連結したものです。
set path [join $h .]
$ha add $path -text $ename
$ha item create $path 1 -text [getAttr $args]
# puts "ESTART: $path / $ename / $args"
}
proc eendCmd {hvar ename args} {
upvar $hvar h
set h [lreplace $h end end]
}
proc cdataCmd {hvar ha data} {
upvar $hvar h
set path [join $h .]
$ha item create $path 2 -text $data
}
readXML [lindex argv $0] $ha
# end.
|
上のサンプルに読ませたXML文書はこんな感じです。
TclXMLの紹介のときにも出てきた、簡単な部品データです。
<?xml version="1.0" encoding="Shift_JIS"?>
<?xml-stylesheet type="text/xsl" href="orders.xsl"?>
<document>
<process_time>2001-08-17 03:15</process_time>
<order emflag="0">
<order_number>10289246</order_number>
<vendor_name>（株）鎌田電装</vendor_name>
<order_date>2001-08-16</order_date>
<line>
<no>1</no>
<item_code>CP80913027</item_code>
<m_item_code>SFD1023-FS10.3AN30RK6-001</m_item_code>
<name>カヘンテイコウキ</name>
<quantity>30</quantity>
<nbd>2001-09-04</nbd>
</line>
<line>
<no>2</no>
<item_code>CP10286513</item_code>
<m_item_code>SFN1038-VM24X60.0AF-003</m_item_code>
<name>チップテイコウ</name>
<quantity>100</quantity>
<nbd>2001-09-11</nbd>
</line>
</order>
</document>
|
(first uploaded 2001/09/22 last updated (not ever), MISUMI URANO - KOUKEN HEIJIMA)