LoginSignup
2
1

More than 5 years have passed since last update.

@akinori-ito(伊藤 彰則)

TclOOベースのMegawidgetを作る

Last updated at Posted at 2018-05-26

Tclとオブジェクト指向

Tclはオブジェクト指向言語ではないが、言語仕様が柔軟なので、後からオブジェクト指向機構を（Lispのように）追加することができる。そのため、[incr Tcl], XOTcl, snitなど、Tclのためのオブジェクト指向パッケージが乱立していた。TclOOもその一つだが、Tcl 8.6からcore distributionの一部となり、事実上標準のオブジェクト指向パッケージになった。

Megawidgetとは

Tkにはさまざまなウィジェットがあるが、使い込んでいくと高機能な部品が作りたくなってくる。しかし、既存のウィジェットを組み合わせて新しいウィジェットを作るためのしくみがTkには備わっていない。そのため、「既存のウィジェットを組み合わせて作る部品で、利用感が普通のウィジェットと同じ」というものを作るしくみが発明されてきた。このように、ウィジェットを組み合わせて作る高機能部品をメガウィジェットと呼ぶ。

オブジェクト指向の仕組みが乱立したのと同じく、メガウィジェットを作るしくみも乱立してきた。iWidget, BWidget, widgetなどのメガウィジェットライブラリは、それぞれ別な方法で部品の組み合わせを実現している。

部品の組み合わせにはオブジェクト指向の考え方が有効だ。実際、iWidgetの実装には[incr Tcl]が使われている。TclOOが事実上標準のオブジェクト指向システムになったのに合わせて、TclOOを使ったメガウィジェット作成機構がTcl/Tk 8.6からついてくるようになった（実験的だそうだが）。そこで、早速試してみようと思ったのだが、どこにも情報がない。仕方なくライブラリのソースを見ながら試行錯誤してみた。

ラベル付き入力フィールドを作る

簡単な例として、ラベルつき入力フィールドを作ってみる。

クリップボード.png

こんな感じで作れる予定。

LabeledEntry .le -text ラベルだよ
pack .le

全体的な枠組み

こんな感じで作る。

tk::Megawidget create LabeledEntry tk::SimpleWidget {
  variable w hull options
  method Create {} {
    ...
  }
  method GetSpecs {} {
    ...
  }
  その他のメソッドたち
}

基本的にはTclOOのしくみを使っているのだが、見た目が簡単になるように工夫してある。Megawidgetコマンドは次のように使う。

tk::Megawidget create 部品名 スーパークラス スクリプト

それほど複雑でない部品なら、スーパークラスにはtk::SimpleWidgetを指定すればよいだろう。

次の variable はインスタンス変数の指定である。TclOOでは、インスタンス変数は継承されるのだが、継承する変数をサブクラスでも指定しなければならないという変態な仕様がある。そのため、スーパークラスで使われている重要な変数を宣言する必要がある。

ということで変数だが、wは自分のインスタンスの名前、hullは部品を挿入するためのフレーム、optionsは生成時に与えられるオプションである。

GetSpecsメソッド

部品を作るときには、CreateとGetSpecsの２つのメソッドを実装しなければならない。Createは部品が生成されるときに呼ばれるメソッド、GetSpecsは許容されるオプションとそのデフォルト値を返すメソッドである。

GetSpecsはこんな感じで書く。

 method GetSpecs {} {return {
      {-activebackground activeBackground Foreground SystemButtonFace SystemButtonFace}
      {-activeforeground activeForeground Background SystemButtonText SystemButtonText}
      {-anchor anchor Anchor center center}
      {-bitmap bitmap Bitmap {} {}}
      ...
}}

このリストは、部品が受け付けるオプション、そのリソース、デフォルト値のリストである。既存の部品については、configureで取り出すことができる。wishを使うとこんな感じ。

 % label .l
.l
 % .l configure
{-activebackground activeBackground Foreground SystemButtonFace SystemButtonFace} {-activeforeground activeForeground Background SystemButtonText SystemButtonText} {-anchor anchor Anchor center center} {-background background Background SystemButtonFace SystemButtonFace} {-bd -borderwidth} {-bg -background} {-bitmap bitmap Bitmap {} {}} {-borderwidth borderWidth BorderWidth 2 2} {-compound compound Compound none none} {-cursor cursor Cursor {} {}} {-disabledforeground disabledForeground DisabledForeground SystemDisabledText SystemDisabledText} {-fg -foreground} {-font font Font TkDefaultFont TkDefaultFont} {-foreground foreground Foreground SystemButtonText SystemButtonText} {-height height Height 0 0} {-highlightbackground highlightBackground HighlightBackground SystemButtonFace SystemButtonFace} {-highlightcolor highlightColor HighlightColor SystemWindowFrame SystemWindowFrame} {-highlightthickness highlightThickness HighlightThickness 0 0} {-image image Image {} {}} {-justify justify Justify center center} {-padx padX Pad 1 1} {-pady padY Pad 1 1} {-relief relief Relief flat flat} {-state state State normal normal} {-takefocus takeFocus TakeFocus 0 0} {-text text Text {} {}} {-textvariable textVariable Variable {} {}} {-underline underline Underline -1 -1} {-width width Width 0 0} {-wraplength wrapLength WrapLength 0 0}
 %

こうやって取り出したリストのうち、実際に使いたいものを並べるとよい。なお、省略形のオプションは

{-background background Background SystemButtonFace SystemButtonFace} 
{-bg -background}

のように出力されるが、GetSpecsではこのような別名のオプション記述はエラーになる。

Createメソッド

Createは部品が作られるときに呼ばれるメソッドである。Createが呼ばれるときには、配列変数optionsにオプションが格納されているので、それを呼び出して初期化を行う。

また、変数hullには部品を配置するためのフレームが入っているので、自分で部品を生成してhullの中に配置する。

method Create {} {
    label $hull.lbl
    entry $hull.ent
    foreach {optsw val} [array get $options] {
      # optsw はオプションスイッチ (-textなど)
      # val はオプションで指定した値
      # これらのオプションをもとに、部品を初期化する
    }
    pack $hull.lbl $hull.ent -side left
}

その他のメソッド

あとは、部品が受け付けるメソッドを個別に記述する。たとえば、getメソッドではentryの内容を返すようにする。

method get {} {
  return [$hull.ent get]
}

多くのメソッドは、内部の部品のどれかにそのまま渡す場合が多い。そのため、次のようなメソッドを実装しておくと楽だ。

   method forward {parts cmd arg} {
      return [eval [concat $hull.$parts $cmd $arg]]
   }

これを使えば、メソッドが次のように書ける。（wには自分自身のオブジェクト名が格納されている）

method get {} {return [$w forward ent get {}]}
method insert args {return [$w forward ent insert $args]}

できあがり

できたものはこんな感じになる。オプションを部品に振り分けるのがちょっと面倒な感じだが、全部のオプションを実装する必要もないのかも。

tk::Megawidget create LabeledEntry tk::SimpleWidget {
   variable w hull options
   method Create {} {
     my variable lblopt entopt bothopt
     set lblopt {-activebackground -activeforeground -anchor -bitmap -compound -height -highlightbackground 
                      -image -justify -relief -underline -padx -pady -text -wraplength }
     set bothopt {-background -bd -bg -borderwidth -cursor -font -foreground -highlightcolor -highlightthickness
                      -state -takefocus}
     set entopt  {-disabledbackground -exportselection -highlightbackground -insertbackground
                           -insertborderwidth -insertofftime -insertontime -insertwidth -invalidcommand -invcmd
                           -readonlybackground -selectbackground -selectborderwidth -selectforeground -show
                            -textvariable -validate -validatecommand -vcmd -width -xscrollcommand}

     label $hull.lbl
     entry $hull.ent
     foreach {optsw val} [array get options] {
        if {[lsearch $lblopt $optsw] >= 0} {
            $hull.lbl configure $optsw $val
        } elseif {[lsearch $entopt $optsw] >= 0} {
            $hull.ent configure $optsw $val
        } else {
            $hull.lbl configure $optsw $val
            $hull.ent configure $optsw $val
        }
     }
     pack $hull.lbl $hull.ent -side left
   }
   method forward {parts cmd arg} {
      return [eval [concat $hull.$parts $cmd $arg]]
   }
   method get {} {return [$w forward ent get {}]}
   method insert {args} {return [$w forward ent insert $args]}
   method delete {args} {return [$w forward ent delete $args]}
   method GetSpecs {} {return {
      {-activebackground activeBackground Foreground SystemButtonFace SystemButtonFace}
      {-activeforeground activeForeground Background SystemButtonText SystemButtonText}
      {-anchor anchor Anchor center center}
      {-bitmap bitmap Bitmap {} {}}
      {-compound compound Compound none none}
      {-height height Height 0 0} {-highlightbackground highlightBackground HighlightBackground SystemButtonFace SystemButtonFace}
      {-image image Image {} {}}
      {-justify justify Justify center center}
      {-relief relief Relief flat flat}
      {-padx padX Pad 1 1}
      {-pady padY Pad 1 1}
      {-text text Text {} {}}
      {-underline underline Underline -1 -1}
      {-wraplength wrapLength WrapLength 0 0}
      {-background background Background SystemButtonFace SystemButtonFace}
      {-bd borderWidth BorderWidth 2 2}
      {-bg background Background SystemButtonFace SystemButtonFace}
      {-borderwidth borderWidth BorderWidth 2 2}
      {-cursor cursor Cursor {} {}} 
      {-font font Font TkDefaultFont TkDefaultFont}
      {-foreground foreground Foreground SystemButtonText SystemButtonText}
      {-highlightcolor highlightColor HighlightColor SystemWindowFrame SystemWindowFrame}
      {-highlightthickness highlightThickness HighlightThickness 0 0}
      {-state state State normal normal}
      {-takefocus takeFocus TakeFocus 0 0}
      {-disabledbackground disabledBackground DisabledBackground SystemButtonFace SystemButtonFace}
      {-exportselection exportSelection ExportSelection 1 1}
      {-highlightbackground highlightBackground HighlightBackground SystemButtonFace SystemButtonFace}
      {-insertbackground insertBackground Foreground SystemWindowText SystemWindowText}
      {-insertborderwidth insertBorderWidth BorderWidth 0 0}
      {-insertofftime insertOffTime OffTime 300 300}
      {-insertontime insertOnTime OnTime 600 600}
      {-insertwidth insertWidth InsertWidth 2 2}
      {-invalidcommand invalidCommand InvalidCommand {} {}}
      {-invcmd invalidCommand InvalidCommand {} {}}
      {-readonlybackground readonlyBackground ReadonlyBackground SystemButtonFace SystemButtonFace}
      {-selectbackground selectBackground Foreground SystemHighlight SystemHighlight}
      {-selectborderwidth selectBorderWidth BorderWidth 0 0}
      {-selectforeground selectForeground Background SystemHighlightText SystemHighlightText}
      {-show show Show {} {}}
      {-textvariable textVariable Variable {} {}}
      {-validate validate Validate none none}
      {-validatecommand validateCommand ValidateCommand {} {}}
      {-vcmd validateCommand ValidateCommand {} {}}
      {-width width Width 20 20}
      {-xscrollcommand xScrollCommand ScrollCommand {} {}}
     }
   }
}
2
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
2
1