[Common Lisp] 書きかけ

(in-package :you.example)

(defmacro with-default-template ((&key (title "TODO")) &body body)
  `(html (:head (:title ,title))
         (:body ,@body)))

(defaction todo ()
  (with-default-template (:title "TODO リスト")
    (:h1 "TODO リスト")
    (:form :action 'todo
           (:input :type :text :name :q)
           (:input :type :submit :value "しぼりこみ"))
    (:table
     :border 1
     (do-query
         ((append #q(select * from todo)
                  (when @q #q(where content like :param))
                  #q(order by id))
          :param (string+ "%" @q "%"))
       (html (:tr (:td $id)
                  (:td (:a :href (url 'todo-edit :id $id) $content))
                  (:td $done)))))
    (:h2 "登録")
    (:form
     :action 'todo-add :method :post
     (:table
      (:tr
       (:td "ID")
       (:td (:input :type :text :name :id :value @id)))
      (:tr
       (:td "内容")
       (:td (:input :type :text :name :content :value @content)))
      (:tr
       (:td (:input :type :submit :value "登録")))))))

(defaction todo-add ()
  (html*
    (execute-sql
     #q(insert into todo(id, content, done) values(:id, :content, 'f'))
     :id @id :content @content))
  (todo))


(defaction todo-edit ()
  (html*
    (setf s@id @id)
    (do-query (#q(select * from todo where id = :id) :id @id)
      (with-default-template (:title "更新")
        (:div "更新しますよ。")
        (:form
         :action 'todo-edit-confirm :method :post
         (:table
          (:tr
           (:td "内容")
           (:td (:input :type :text :name :content :value $content)))
          (:tr
           (:td :rowspan 2 (:input :type :submit :value "更新")))))))))

(defaction todo-edit-confirm ()
  (html*
    (setf s@content @content)
    (with-default-template (:title "確認画面")
      (:div "この内容でいいですか?")
      (:div "内容 " @content)
      (:form :action 'todo-edit-done :method :post
             (:input :type :submit :value "はい")
             " "
             (:input :type :button :value "いいえ"
                     :onclick "history.back()")))))

(defaction todo-edit-done ()
  (with-default-template (:title "完了")
    (execute-sql #q(update todo set content = :c where id = :i)
                 :c @content :i @id)
    (:div "更新しました")
    (:a :href 'todo "一覧へ")))