Weblocksによる画面遷移

自分の以前のエントリを見ていたら、loginのところで「キャンセルボタン押しても次の画面に移る…どうしたらいいんや…」という感じで終わっていました。その頃に比べると多少は(ミジンコレベルですが)分かる部分もあるのでエントリを起こすのでした。新しいことが分かったら追記をする前提です!そもそも、「こうすれば出来る」という方法は分かったけど、それがベストの手法なのかはサッパリ分かりません。

with-flow

weblocks/examples/ 内に存在するデモで使われている with-flowマクロ。名前からすると、フロー(流れ)を記述するためのマクロみたい。

(defun init-session (root)
  (with-flow root
    (loop :until (yield (make-login-page)))
    (yield (make-main-page))))

with-flowの第1引数は親となる widgetかと思います。今のところ、init-session関数の引数以外を指定したことがないので、他の値を指定したときにどうなるのか分かりません…
第2引数以降が流れの記述になります。make-login-page関数と make-main-page関数は、それぞれログイン画面とメイン画面の widgetを返す関数です。with-flowの中で yield に対して widgetを渡すと、そのwidgetが画面に表示されます。そして流れとしては画面側で操作が行われるまで、そこで止まります。画面でなんらかのアクションが実行されると、先ほどの yieldから処理が再開されます*1。yieldの戻り値は 画面での操作に対する widget毎の値になります。具体的にはanswer関数の第2引数。

例えば、login widgetの場合、ログインに失敗したりキャンセルボタンが押されたときには nilが返ってきます。なので (loop :until (yield (make-login-page))) のように 非nilが返ってくるまで login画面に戻してやったらいいのではなかろうか。どうなんだろうか、ダメなんだろうか。cond とかで遷移先の画面を分けることもできると思うよ。

*1:たぶん、これが継続って奴なんですね!未だに継続がイメージとしては分かるけど、自分の血肉になっていない感じでシッカリとは分からない…

早いほうが嬉しいよね

http://cadr.g.hatena.ne.jp/g000001/20110303/1299155102 を CCL1.6/Win32 で実行してみた。

=========================== READ ===========================
  0.217 sec. LEXICAL-VAR-READ
  0.218 sec. LEXICAL-VECTOR-1-READ
  0.233 sec. LEXICAL-VECTOR-10-READ
  0.248 sec. LEXICAL-CONS-1-READ
  0.310 sec. GLOBAL-SPECIAL-1-READ
  0.311 sec. LOCAL-SPECIAL-1-READ
  0.607 sec. CLOSURE-1-READ
  0.715 sec. STRUCT-1-READ
  0.731 sec. STRUCT-10-READ
  0.762 sec. SYMBOL-PLIST-1-READ
  0.778 sec. SYMBOL-VALUE-1-READ
  2.192 sec. LEXICAL-PLIST-1-READ
  4.276 sec. LEXICAL-CONS-10-READ
  4.368 sec. HASH-1-READ
  4.431 sec. HASH-10-READ
  4.617 sec. SYMBOL-PLIST-10-READ
  9.887 sec. LEXICAL-PLIST-10-READ
 11.380 sec. CLASS-1-READ
 12.422 sec. CLASS-10-READ
=========================== WRITE ==========================
  0.203 sec. LEXICAL-VECTOR-10-WRITE
  0.217 sec. LEXICAL-VAR-WRITE
  0.218 sec. LEXICAL-VECTOR-1-WRITE
  0.310 sec. LEXICAL-CONS-1-WRITE
  0.342 sec. LOCAL-SPECIAL-1-WRITE
  0.855 sec. STRUCT-10-WRITE
  0.855 sec. STRUCT-1-WRITE
  0.933 sec. GLOBAL-SPECIAL-1-WRITE
  1.150 sec. SYMBOL-PLIST-1-WRITE
  1.354 sec. SYMBOL-VALUE-1-WRITE
  2.612 sec. LEXICAL-PLIST-1-WRITE
  4.527 sec. LEXICAL-CONS-10-WRITE
  5.332 sec. SYMBOL-PLIST-10-WRITE
  6.793 sec. CLASS-1-WRITE
  6.934 sec. CLASS-10-WRITE
  8.349 sec. HASH-10-WRITE
  8.379 sec. HASH-1-WRITE
  9.706 sec. CLOSURE-1-WRITE
 11.660 sec. LEXICAL-PLIST-10-WRITE

ちなみに以下は SBCL1.0.40/Win32での結果。

=========================== READ ===========================
  0.031 sec. LOCAL-SPECIAL-1-READ
  0.031 sec. STRUCT-10-READ
  0.046 sec. LEXICAL-PLIST-1-READ
  0.046 sec. CLOSURE-1-READ
  0.046 sec. LEXICAL-VAR-READ
  0.046 sec. GLOBAL-SPECIAL-1-READ
  0.046 sec. SYMBOL-PLIST-1-READ
  0.047 sec. SYMBOL-PLIST-10-READ
  0.047 sec. HASH-1-READ
  0.047 sec. STRUCT-1-READ
  0.047 sec. HASH-10-READ
  0.047 sec. LEXICAL-CONS-1-READ
  0.062 sec. LEXICAL-VECTOR-10-READ
  0.062 sec. LEXICAL-VECTOR-1-READ
  0.078 sec. LEXICAL-PLIST-10-READ
  0.155 sec. SYMBOL-VALUE-1-READ
  0.883 sec. CLASS-10-READ
  0.884 sec. CLASS-1-READ
  1.968 sec. LEXICAL-CONS-10-READ
========================== WRITE ===========================
  0.031 sec. LEXICAL-VAR-WRITE
  0.046 sec. CLOSURE-1-WRITE
  0.046 sec. LEXICAL-CONS-1-WRITE
  0.077 sec. STRUCT-10-WRITE
  0.078 sec. STRUCT-1-WRITE
  0.093 sec. LEXICAL-VECTOR-10-WRITE
  0.093 sec. LEXICAL-VECTOR-1-WRITE
  0.155 sec. LOCAL-SPECIAL-1-WRITE
  0.155 sec. GLOBAL-SPECIAL-1-WRITE
  0.682 sec. LEXICAL-PLIST-1-WRITE
  0.791 sec. SYMBOL-PLIST-1-WRITE
  0.915 sec. CLASS-10-WRITE
  0.915 sec. HASH-1-WRITE
  0.930 sec. CLASS-1-WRITE
  0.930 sec. HASH-10-WRITE
  2.124 sec. LEXICAL-CONS-10-WRITE
  2.837 sec. LEXICAL-PLIST-10-WRITE
  3.147 sec. SYMBOL-PLIST-10-WRITE
 42.135 sec. SYMBOL-VALUE-1-WRITE

少し前に、少し話題になったメソッド呼び出しのベンチマーク的な奴をCCLで実行したとき、あまりの遅さに心折れそうになった記憶があります。思わず「え・・・私の処理系、遅すぎ・・・!?」と呟くほどに遅かった。マジか、ってくらいSBCL早いなぁ。特にCCLは class の accessor が R/W両方共に遅いようなので、嫌だなー。何か間違ってるのかなー。

[Common Lisp] PATHNAMEから情報を取得

わたくし、本職はJavaプログラマなのですが「ファイルのパスを受け取ってゴニョゴニョする」ことがそれなりにあるなーと思いました。具体的に言うと

  • ファイルのフルパスからファイル名を取得
  • ファイルのフルパスから拡張子を取得

は結構頻繁にやっている気がします。フルパスの後ろのほうからディレクトリ区切り文字なり、ドットなりの位置を探して それ以降を取得って感じ。

Javaでやってることは、Common Lispでどうやるのかなーと思ったので、後のために書いておきます。

;; pathname からファイル名を取得
(file-namestring #P"/tmp/hoge.tgz")
;; => "hoge.tgz"

;; pathname から拡張子を取得
(pathname-type #P"/tmp/hoge.tgz")
;; => "tgz"

;; pathname からファイル名(拡張子無し)を取得
(pathname-name #P"/tmp/hoge.tgz")
;; => "hoge"

;; pathname からディレクトリを取得
(pathname-directory #P"/tmp/hoge.tgz")
;; => (:ABSOLUTE "tmp")

(pathname-directory #P"tmp/hoge.tgz")
;; => (:RELATIVE "tmp")

;; pathname からドライブレターを取得
(pathname-device #P"D:/tmp/hoge.tgz")
;; => "D"

(pathname-directory) は戻り値の carを見ると、渡したpathnameが相対パス絶対パスか分かるのですね。

ちなみに Windows絶対パスにはドライブレターが付きますが、これは (pathname-directory) では返ってきませんでした。

Weblocksの話

Weblocksも触っています。widgetでも navigationとか flashくらいは書く内容あるし、view関係はまだ全然書いてないし、store関係もいっぱい書きたいです。でもしばらく書けないのでした。ちょっと書けない。そういう心境。
Weblocks大好き。CSSがもっと書きやすいと嬉しいなぁ、って思ったけど。

[library] f-underscore

Weblocksで使っているライブラリの中身も、それなりに見ることが多くなってきたので纏めようと思ったのでした。たぶん、すぐに挫折します。

f-underscoreは lambdaを少ないタイプ数で記述するためのマクロを持ったユーティリティです。引数の数や種類などで複数種類が存在します。

f

通常のlambdaとほぼ同じ使い方。基本的にlambdaと打つ代わりに、fになっただけ。

CL-USER> (macroexpand-1 '(f (x y)
                           (* x y)))
; (LAMBDA (X Y) (* X Y))

f0

引数が0個のlambda。

CL-USER> (macroexpand-1 '(f0 (gethash :fuga *hoge-hash*)))
; (LAMBDA () (GETHASH :FUGA *HOGE-HASH*))

f_

引数が1個のlambda。引数は _ に束縛されている。

CL-USER> (macroexpand-1 '(f_ (* _ _)))
; (LAMBDA (_) (* _ _))

f_n

引数を &restで受け取るlambda。引数は _に束縛されている。

CL-USER> (macroexpand-1 '(f_n (format t "~{~A~^,~}" _)))
; (LAMBDA (&REST _) (FORMAT T "~{~A~^,~}" _))

f_%

引数を &restで受けるが、使用しないlambda。

CL-USER> (macroexpand-1 '(f_% (format t "Hello, world")))
; (LAMBDA (&REST #:|ignore1178|)
;  (DECLARE (IGNORE #:|ignore1178|))
;  (FORMAT T "Hello, world"))

パッと有用な使い方が思いつかなかったけど、関数に渡すための関数の場合には引数を無視したい状況は、ある、かな。

m

どう使うのだろう、これ。とりあえず、こんな感じで展開されます。

CL-USER> (macroexpand-1 '(m (arg &rest body)
                           "DocString."
                           `(lambda ,args ,@body)))
; (LAMBDA (&REST #:|macro-lambda-list1183|)
;   "DocString."
;   (DESTRUCTURING-BIND
;       (ARG &REST BODY)
;       #:|macro-lambda-list1183|
;     `(LAMBDA ,ARGS ,@BODY)))

f-underscore.lispのコメントには

;   (setf (macro-function 'foo) (m args ..)) ~= (defmacro foo args ..)

と書かれているのですが、、、

全体を通して

f-underscore のマクロ全てに言えることですが、lambdaとの大きな違いとして括弧の先頭、関数として評価される位置に置くことが出来ないようです。

CL-USER> ((lambda (x) (1+ x)) 1)
; 2
CL-USER> ((f_ (1+ _)) 1)
; in: LAMBDA NIL
;     ((F-UNDERSCORE:F_
;        (1+ F-UNDERSCORE:_))
;      1)
; 
; caught ERROR:
;   illegal function call
; 
; compilation unit finished
;   caught 1 ERROR condition

lambdaは特別なんですね。λかわいいよλ。

[Weblocks] Weblocks - widgets - DataList, ListEdit

今回見るWidget前回のDataGrid, GridEdit のお仲間、DataListとListEditです。今回もEditと付いている方が追加/変更/削除が出来るバージョンになっています。

GridEditとListEditの差ですが、見た目の違いだけかなーと思っています。たぶんね。
とりあえず見た目の違いは以下の画像のようになります。赤い線の上側が前回のGridEdit、下側が今回のListEdit。


コードは前回の DataGridを参照していただきたい。make-instance する際の クラス名を datalistなり listeditにすれば変更可能です。datalistはソート条件(画像の Sort ByのSELECT内容)に make-instanceの引数 :viewに設定されたviewの項目、画面での表示内容に :item-data-viewに設定されたviewの項目が反映されているっぽい。:item-form-viewは無視かな?
家に帰ったら、いい加減 githubにソース上げておこうと思うのでした。

気になること

listeditのAddボタンがやたら遠いのです(上の画像参照)が、CSSが悪いのかなー。

Shibuya.lisp TT #6 に行ってきたのでした。

27日(土)に行われた Shibuya.lisp TT #6に行ってきたのでした。

  1. お昼を食べていたら出発が遅れた
  2. 駅でPASMOがどうにかなったようで改札通れない
  3. 駅員のところへ行ったら、中学生くらいの女子にデレデレしていて電車2本逃す
  4. 渋谷で迷子
  5. 道玄坂を登りきる」ってどこが頂上だよ
  6. 方向音痴はGPSに頼る
  7. 遅刻してスミマセン、以後気をつけます
  8. TTは「なるほど、わからん」だった
  9. 分かるようになりたいがLISP以外の知識も足りない
  10. LTって結構短いのね
  11. 懇親会ではずっと「Weblocks、Weblocks」って言ってた

サイン、ねだってもいいのかな。シワシワの実践Common Lispにサインしてもらえるかな。

[Weblocks] Weblocks - widgets - DataGrid, GridEdit

Common LispのWeb Application Framework, Weblocksには便利な widgetがいろいろと用意されています。前回の Login widgetのように Webアプリケーションを作っていると使うことになる画面部品は標準で用意されていますし、それ以外のモノも結構簡単に自分で定義することが出来ます。今回は標準で用意されたwidgetの中から DataGrid と GridEditの2つです。

なぜ2つ同時かと言うと、DataGridは GridEditのReadOnly版だからです。使い方や見た目はほぼ同じっぽいので纏めました。

DataGrid & GridEditは表を作成する為のWidgetです。GridEditは表への追加、変更、削除の機能も付いています。

GridEditで定義されている Slotは以下。

drilldown-type (or :view :edit)。
:viewを指定すると表のレコードをクリックした際に詳細内容表示→ [Modify]リンク押下 → 内容編集という流れになる。
:editを指定すると詳細表示を飛ばして、即内容編集可能な状態になる。

DataGridではSlotは定義していませんが dataseqというWidgetを継承しています(ちなみにGridEditはDataGridを継承しています)。

DataSeqのslotは以下。

view 一覧表示時のview。
defviewの際、:type tableを指定したviewを使用。
data-class 一覧表示の1レコードを表すクラス名
class-store 特に指定しなければ data-classの内容から勝手に生成
on-query まだ調べてない。
allow-sorting-p 一覧のヘッダをクリックしたときにソートするか否か。
sort ソート条件。(ソート項目名 . :asc)か(ソート項目名 . :desc)
allow-select-p 削除のための選択チェックボックスを付けるか否か。
nilにすると レコードの削除が出来なくなる。
selection まだ調べてない。
allow-drilldown-p レコードをクリックした際の詳細表示、内容編集フォームを出さない。
on-drilldown レコードクリック時に呼び出す関数?
drilled-down-item まだ調べてない。
autoset-drilled-item-p まだ調べてない。
allow-operations-p まだ調べてない。
item-ops まだ調べてない。
common-ops まだ調べてない。
allow-pagination-p ページングするか否か
pagination-widget ページングwidget。指定しなければ勝手に作られる。
show-total-items-count-p 総レコード数を表示するか否か。デフォルトでは表示(t)
flash 追加/変更/削除後のメッセージ用Widget。普通はflash widget
rendered-data-sequence まだ調べてない。

調べてないばかりでスミマセン・・・

また GridEditは dataedit-mixinというクラスを継承しています。dataedit-mixinのslotは以下。

on-add-item 調べてないけど、レコード追加時に呼ばれる関数?
on-add-item-completed 調べてないけど、レコード追加完了時に呼ばれる関数?
allow-add-p 新規レコードを追加するための ADDボタンを付けるか否か。
show-add-form-when-empty-p t を指定した場合、データが0件のときは最初から新規追加フォームが開いている。
flash-message-on-first-add-p t を指定した場合、1レコード目の登録時も登録完了メッセージを表示。
on-delete-items 調べてないけど、レコード削除時に呼ばれる関数?
on-delete-items-completed 調べてないけど、レコード削除完了時に呼ばれる関数?
cascade-delete-mixins-p まだ調べてない。
allow-delete-p レコードを削除するための DELETEボタンをつけるか否か。
item-data-view データの View。defviewの際、:type dataで定義した view。
item-form-view フォームの View。defviewの際、:type formで定義した view。
auteset-drilled-down-item-p initargが無い・・・
ui-state まだ調べてない。
item-widget initargが無い・・・

dataedit-mixinでとても大事なのが item-data-viewと item-form-viewの2つです。
この2つはそれぞれ 詳細表示時の表示項目、新規追加/データ編集時の表示項目として使用されます。*1

;;; 1. 表示するクラスを定義
(defclass user (store-template)
  ((id)
   (login-id :accessor user-login-id
             :initarg :login-id
             :type string)
   (password :accessor user-password
             :initarg :password
             :type string)
   (name :accessor user-name
         :initarg :name
         :type string)
   (birthday :accessor user-birthday
             :initarg :birthday)))

;;; 2. TABLE VIEWを定義
(defview user-table-view (:type table :inherit-from '(:scaffold user))
  (id :hidep t)
  (login-id)
  (password :hidep t)
  (name :label "氏名")
  (birthday :label "誕生日"
            :reader (lambda (user)
                      (multiple-value-bind (s m h d mo y)
                          (decode-universal-time (user-birthday user))
                        (declare (ignore s m h))
                        (format nil "~4,'0d/~2,'0d/~2,'0d" y mo d)))))

;;; 3. DATA VIEWを定義
(defview user-data-view (:type data :inherit-from '(:scaffold user))
  (id :hidep t)
  (login-id)
  (password :hidep t)
  (name :label "氏名")
  (birthday :label "誕生日"
            :reader (lambda (user)
                      (multiple-value-bind (s m h d mo y)
                          (decode-universal-time (user-birthday user))
                        (declare (ignore s m h))
                        (format nil "~4,'0d/~2,'0d/~2,'0d" y mo d)))))

;;; 4. FORM VIEWを定義
(defview user-form-view (:type form :inherit-from '(:scaffold user))
  (id :hidep t)
  (login-id :requiredp t)
  (password :label "パスワード"
            :reader (lambda (obj)
                      "")
            :writer (lambda (value obj)
                      (setf (user-password obj)
                            (hash-password value))))
  (name :label "氏名" :requiredp t)
  (birthday :label "誕生日"
            :reader (lambda (user)
                      (multiple-value-bind (s m h d mo y)
                          (decode-universal-time (user-birthday user))
                        (declare (ignore s m h))
                        (format nil "~4,'0d/~2,'0d/~2,'0d" y mo d)))
            :writer (lambda (value obj)
                      (setf (slot-value obj 'birthday)
                            (yyyy/mm/dd->utime value)))))

;;; 5. 初期ページを作る関数
(defun initial-page ()
  (make-instance
     'widget :children
     (list
        (f_% (with-html (:p "Data Grid")))
        (make-instance
           'datagrid
           :name 'user-data-grid
           :data-class 'user
           :view 'user-table-view)

        (f_% (with-html (:hr) (:p "Grid Edit[DrillDown-Type=:view]")))
        (make-instance
           'gridedit
           :name 'user-edit-grid-view
           :drilldown-type :view
           :data-class 'user
           :view 'user-table-view
           :item-data-view 'user-data-view
           :item-form-view 'user-form-view
           )
        )))

;;; 6. 最初に呼ばれてるっぽい関数
(defun init-user-session (comp)
  (with-flow comp
    (yield (initial-page)) ))

やっていることは

  1. 一覧に表示するためのクラスを定義(項目 id login-id password name birthday)
  2. TABLE VIEWを定義(userクラスから自動生成, idとpasswordは非表示, birthdayはyyyy/mm/dd形式)
  3. DATA VIEWを定義(userクラスから自動生成, idとpasswordは非表示, birthdayはyyyy/mm/dd形式)
  4. FORM VIEWを定義(userクラスから自動生成, idは非表示, passwordは空欄表示で入力値は 暗号化して保存, birthdayはyyyy/mm/dd形式で表示し、yyyy/mm/dd形式の文字列をuniversal-timeに変換して保存)
  5. DataGridとGridEditを画面表示するための関数を定義
  6. Sessionが無い状態で表示される画面にする

自分で書いておいてなんですが、この説明全然わかんない。

*1:viewを作成する defviewはまた後日