[Common Lisp][UCW] フォームの値取得と入力チェック

UCW でフォームからの値取得と入力チェックを行ってみます。

top-window コンポーネントに name スロットを定義します。
name スロットは string-field のインスタンスに初期化します。
その string-field インスタンス生成時に :validators によって必須チェックをしこみます。

入力チェックは top-window-submit アクションの中で行います。
validp メソッドによりコンポーネントのスロットに :validators で指定してあったチェック処理が実行されます。
validp は (values エラーの有無 ((スロット1 . validator1) (スロット2 . validator2))) のような多値を返します。ここからエラーの有無を判定し、エラーメッセージを取得します。
エラーがなければ、top-window の name から value メソッドで入力された値を取得し、next-page を call するときの引数にそれを渡して画面遷移します。
エラーがあれば top-window の message にエラーメッセージを設定します。

バリデーションのあたりはまだ洗練されていな感じです。
他に何かよい方法があるのでしょうか？

;; ucw がロードされていなければロードする。
(eval-when (:load-toplevel :compile-toplevel :execute)
  (unless (find-package :ucw)
    ;; UCW の start.lisp をロードする。パスは環境にあわせて修正してください。
    (load "/home/ancient/letter/lisp/ucw/ucw-boxset/start.lisp")))

(in-package :it.bese.ucw-user)

(defvar *hello-form-application*
  (make-instance 'cookie-session-application
                 :url-prefix "/hello-form/" ; / で終ること
                 :debug-on-error t)     ; エラー時にはデバッガを起動
  "アプリケーションの作成。")

;; アプリケーションをサーバに登録する。
(register-application *default-server* *hello-form-application*)

;; エントリポイントの作成。http://localhost:8080/hello-form/index.ucw
(defentry-point "index.ucw" (:application *hello-form-application*)
    ()
  ;; トップページの無限ループ
  (loop (call 'top-window)))

(defcomponent top-window (simple-window-component)
  ((name
    :accessor name
    :initform (make-instance
               'string-field
               :validators `(,(make-instance 'not-empty-validator
                                             :message "名前を入力してください。")))
    :documentation "必須入力チェックを行なう。")
   (messages :initform nil :accessor messages
             :documentation "入力エラー時のメッセージを保持するために"))
  (:default-initargs :title "トップページ")
  (:documentation "最初のページです。入力フォームがあります。"))

(defmethod render ((self top-window))
  "入力フォームを表示します。"
  ;; エラーメッセージの表示
  (when (messages self)
    (<:ul (dolist (message (messages self))
            (<:li (<:b (<:as-html message))))))
  ;; フォームの表示
  (<ucw:form :action (top-window-submit self)
             (<:div "名前"  (render (name self))
                    (<:submit))))

(defaction top-window-submit ((self top-window))
  "入力チェックを行い、次のページに遷移します。"
  (setf (messages self) nil)
  (multiple-value-bind (validp faileds) (validp self)
    (if validp
        (call 'next-page :name (value (name self)))
        (setf (messages self)
              (mapcar #'(lambda (arg)
                          (ucw::message (cdr arg)))
                      faileds)))))

(defcomponent next-page (simple-window-component)
  ((name :initarg :name :accessor name))
  (:default-initargs :title "次のページです")
  (:documentation "前のページの入力を表示するためのページです。"))

(defmethod render ((self next-page))
  "前のページで入力した name を表示します。"
  (<:p (<:as-html (name self)))
  (<ucw:a :action (ok self) "最初のページに戻る"))