2007/08/15

[Common Lisp][UCW] 簡単な TODO リストアプリケーションを作ってみる

UCW で簡単なアプリケーションを作成してみます。
TODO の一覧表示、新規作成と完了ができるアプリケーションです。
あまり継続を活用できいない気がしますが、そのあたりは最初のアプリということで… UCW のサンプルに Wiki アプリがあったので、今度それを見て勉強してみましょう。

まずはいつもどおりの UCW の start.lisp のロードからエントリポイントの作成です。

続いて todo クラスを定義します。
作成した todo を *todo* に保管するために、initialize-instance :after で id の設定と *todo* への push を行っています。
こうしておけば普通に make-instance するだけで、todo のインスタンスは *todo* に保管されるようになります。もっとも、今回は永続化は行っていませんので Lisp を再起動すれば消えてしまいますが。

ビューでは body スロットも持った top-window を定義し、各機能毎に body スロットにリスト表示コンポーネント、新規作成コンポーネントが設定されるようにします。top-window がテンプレート的な役割を果します。初期状態は :component todo-list-view により一覧が表示されます。

ということで、ソースは次のようになりました。


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

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

(defvar *todo-list-application*
(make-instance 'cookie-session-application
:url-prefix "/todo/" ; / で終ること
:charset :utf-8 ; 文字コードを UTF-8 に設定
:debug-on-error t) ; エラー時にはデバッガを起動
"アプリケーションの作成。")

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

;; エントリポイントの作成。http://localhost:8080/todo/index.ucw
(defentry-point "index.ucw" (:application *todo-list-application*)
()
(call 'top-window))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; モデル
(defvar *todo* nil "TODO を保管するリスト")

(defvar *todo-id-counter* 0 "TODO の id カウンタ")

(defclass todo ()
((id :accessor id)
(content :initarg :content :accessor content)
(done :initform nil :accessor done))
(:documentation "TODO クラス"))

(defmethod initialize-instance :after ((todo todo) &rest initargs)
"id を設定して *todo* に保存する。"
(declare (ignore initargs))
(setf (id todo) (incf *todo-id-counter*))
(push todo *todo*))

(defmethod print-object ((todo todo) stream)
"debug のために"
(print-unreadable-object (todo stream :type t :identity t)
(format stream "~a: ~a" (id todo) (content todo))))

(defun find-todo (id)
"id をもとに TODO を取得します。"
(find id *todo* :key #'id))

(defun delete-todo (id)
"id をもとに TODO を削除します。"
(setf *todo* (delete id *todo* :key #'id)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; ビュー
(defcomponent top-window (simple-window-component)
((body :initarg :body
:accessor body
:component todo-list-view))
(:default-initargs :title "TODO リスト")
(:documentation "トップウィンドウ。
body に一覧や編集のコンポーネントをセットして画面表示を行う。"))

(defmethod render ((top top-window))
(<:h1 "TODO リスト")
;; body の表示
(render (body top)))

(defcomponent todo-list-view ()
()
(:documentation "TODO の一覧コンポーネント"))

(defmethod render ((self todo-list-view))
"TODO の一覧を表示する。"
(<ucw:a :action (call 'todo-create-view) "新規作成")
(<:table
:border 1
(<:tr (<:th "完了") (<:th "TODO") (<:th "削除"))
(loop for each in *todo*
do (let* ((todo each)
(id (id todo)))
(<:tr
(<:td (<:as-html
(if (done todo)
"済"
(<ucw:a
:action (done-todo-action self todo)
"完了する"))))
(<:td (<:as-html (content todo)))
(<:td (<ucw:a :action (delete-todo-action self id)
"削除する")))))))

(defaction done-todo-action ((self todo-list-view) todo)
"TODO を完了する。"
(setf (done todo) t))

(defaction delete-todo-action ((self todo-list-view) id)
"TODO を1件削除する。"
(delete-todo id))

(defcomponent todo-create-view ()
((content
:accessor content
:initform (make-instance 'string-field)))
(:documentation "TODO を新規作成するためのコンポーネント"))

(defmethod render ((self todo-create-view))
"TODO 新規作成画面"
(<ucw:form
:action (create-todo self)
"TODO" (render (content self))
(<:submit :value "新規作成"))
(<ucw:a :action (ok self) "キャンセル"))

(defaction create-todo ((self todo-create-view))
"画面からの入力により TODO を新規作成する。"
(make-instance 'todo :content (value (content self)))
(ok self))

0 件のコメント: