2013/12/08

コンポジションに便利なpropagatedスロット

Metaobject Protocol(MOP) Advent Calendar 2013参加エントリ (12/9分)

GUI作っている時などによく出会うケースだけど、複数の関連するオブジェクトをまとめて ひとつのオブジェクトとして扱いたいことがある。例えばラベル、テキストボックス、 アイコンイメージを並べたものをひとつのウィジェットとして扱いたい、とか。

これはまあ普通にコンテナとなるクラスのサブクラスを作って 部品を配置し、必要な処理について委譲するメソッドを書いてやればいいんだけど、 GUIなんかだと「子ウィジェットのこのプロパティ(スロット)を合成した部品の プロパティとして見せたい」ってのが多い。上の例のウィジェットで テキストボックスのtextスロットを合成ウィジェットのtextスロットとして 参照させたい、等。

テキストボックス自体をスロットとして見せることで、(~ widget 'text-box 'text) というふうに多段で参照させる手もあるけど、必要以上に中身を見せている感じがして いまいち。(アクセスコントロールがデフォルトで備わっていないCLOSで 中身が見えるのを気にするのも妙な話ではあるけれど、 上のような多段アクセス法を公式なAPIにしてしまうと、後で実装を変えたくなった時に 面倒だったり、途中のオブジェクトへの参照を予想外のところで保持されて困ったりする。)

そんな時にpropagatedスロット。これは自分が内包しているオブジェクトのスロットを あたかも自分のスロットであるかのように見せるスロットオプションだ。 Gaucheでは gauche.mop.propagate モジュールで提供されている。 もともとSTkにあった機能を真似したものだ。 最低限の部分だけ示すとこんな感じ：

(use gauche.mop.propagate)

(define-class <text-box> ()
  ((text :init-keyword :text)))

(define-class <composited-widget> ()
  ((text-box :init-form (make <text-box>))
   (text     :allocation :propagated
             :propagate-to 'text-box
             :init-keyword :text))
  :metaclass <propagate-meta>)

<composited-widget> の text スロットへの読み書きは、 text-box に保持された text スロットへの読み書きになる。 通常の方法で初期化もできるので、当初<text-box>を使っていたコードを 変えずにその部品だけ<composited-widget>にすげ替えることが できたりして便利。

gosh> (define cw (make <composited-widget> :text "abc"))
cw
gosh> (~ cw 'text)
"abc"
gosh> (~ cw 'text-box 'text) ; 確かに子ウィジェットに伝わってるか確認
"abc"
gosh> (set! (~ cw 'text) "def")
#<undef>
gosh> (~ cw 'text-box 'text) ; 確かに子ウィジェットに伝わってるか確認
"def"

さて、この機能もMOPで実現されている。 これまでの例と同じく、compute-get-n-set をオーバライドする。 allocation スロットオプションが :propagated なら 自前で作ったアクセサ手続きを返し、そうでなければnext-methodを呼んで デフォルトの振る舞いに任せる。 (matchの二番目の節は、子スロットの名前と違う名前を親スロットで定義したい場合の処理)。

(define-method compute-get-n-set ((class <propagate-meta>) slot)
  (let ([name  (slot-definition-name slot)]
        [alloc (slot-definition-allocation slot)])
    (if (eq? alloc :propagated)
      (match (or (slot-definition-option slot :propagate #f)
                 (slot-definition-option slot :propagate-to #f))
        [(? symbol? prop)
         `(,(^o (slot-ref (slot-ref-using-class class o prop) name))
           ,(^(o v) (slot-set! (slot-ref-using-class class o prop) name v))
           ,(^o (slot-bound? (slot-ref-using-class class o prop) name))
           #t)]
        [((? symbol? object-slot) (? symbol? real-slot))
         `(,(^o (slot-ref (slot-ref-using-class class o object-slot)
                          real-slot))
           ,(^(o v) (slot-set! (slot-ref-using-class class o object-slot)
                               real-slot v))
           ,(^o (slot-bound? (slot-ref-using-class class o object-slot)
                             real-slot))
           #t)]
        [other
         (errorf "bad :propagated slot option value ~s for slot ~s of class ~s"
                 other name class)])
      (next-method))))

compute-get-n-set が返しているのは4要素のリストで、各要素の意味は

1. スロットを読む時に呼ばれる手続き
2. スロットに書く時に呼ばれる手続き
3. スロットが値を持っているかどうかをチェックする時に呼ばれる手続き
4. このスロットが初期化引数で初期化されるかどうかのフラグ

となっている。詳しくはrefj:compute-get-n-set参照。

Tags: Programming, Gauche, MOP