[ginseng-cvs] CVS ginseng/examples

wchunye wchunye at common-lisp.net
Sat Sep 11 15:53:52 UTC 2010


Update of /project/ginseng/cvsroot/ginseng/examples
In directory cl-net:/tmp/cvs-serv24891

Added Files:
	examples.lisp 
Log Message:
add examples.lisp


--- /project/ginseng/cvsroot/ginseng/examples/examples.lisp	2010/09/11 15:53:52	NONE
+++ /project/ginseng/cvsroot/ginseng/examples/examples.lisp	2010/09/11 15:53:52	1.1
(in-package :ginseng-examples)
(defun http-hello-world-1()
  "
<html>
<head>
<title> Hello World </title>
</head>
<body>
<h1> Hello World </h1>
</body>
</html>
")
(defun http-hello-world-2()
  (with-yaclml-output-to-string
    (<:html
     (<:head
      (<:title "Hello World"))
     (<:body 
      (<:h1 "Hello World")))))
(defun http-hello-world-3()
  (standard-page
      (:title "Hello World")
    (<:h1 "Hello World")))

(defun http-sum-of(&rest args)           
  (standard-page ()
    (let ((a-list-of-number (mapcar #'(lambda (x) 
                                        (or (parse-integer x :junk-allowed t) 0)) 
                                    args)))
      (<:p      
       (<:as-html (format nil "~{~A~^+~}" a-list-of-number) "="
                  (apply #'+ a-list-of-number))))))
(defun http-counter(&optional (next-action nil))
  (invoke-next-action next-action :main #'(lambda () (counter-main 0))))
(defun counter-main (counter)
  (standard-page  ()
    (<:p (<:as-html counter))
    (<:p(<:a :href (dynamic-url (counter-main (1+ counter))) "++") 
        (<:as-html "  ")
        (<:a :href (dynamic-url (counter-main (1- counter))) "--"))))
(defun http-greet-1 (&optional next-action)
  (invoke-next-action next-action :main #'greet-1))
(defun greet-1 ()
  (let (name)
    (standard-page ()
      (<:form 
       :action (dynamic-url (how-are-you name))
       (<:p "What's your name?"
            (<:input :type :input 
                     :name (with-call-back (var)
                             (setf name var))))
       (<:p (<:input :type :submit
                     :name "OK"
                     :value "OK"))))))
(defun how-are-you (name)
  (standard-page ()
    (<:p "How are you, " (<:as-html name) "?")
    (<:a :href "." "try again")))

(defun http-greet-2 (&optional next-action)
  (invoke-next-action next-action :main #'greet-1))
(defun greet-2 ()
  (let* (name
         (form-id (dynamic-url (how-are-you name)))
         (name-id (with-call-back (var) (setf name var))))
    (standard-page ()
      (<:form 
       :action form-id
       (<:p "What's your name?"
            (<:input :type :input 
                     :name name-id))
       (<:p (<:input :type :submit
                     :name "OK"
                     :value "OK"))))))
(defun http-greet-3 (&optional next-action)
  (invoke-next-action next-action :main #'greet-1))
(defun greet-3 ()
  (let* (name
         (form-id (dynamic-url (how-are-you name)))
         (name-id (bindf name)))
    (standard-page ()
      (<:form 
       :action form-id
       (<:p "What's your name?"
            (<:input :type :input 
                     :name name-id))
       (<:p (<:input :type :submit
                     :name "OK"
                     :value "OK"))))))

(defun http-greet-4 (&optional next-action)
  (invoke-next-action next-action :main #'greet-4))
(defun greet-4 ()
  (let* (name
         (form-id (dynamic-url (how-are-you name)))
         (bob-id (with-call-back () (setf name "Bob")))
         (john-id (with-call-back () (setf name "John")))
         (tom-id (with-call-back () (setf name "Tom"))))
    (standard-page ()
      (<:form 
       :action form-id
       (<:p "What's your name?")
       (<:p (<:input :type :submit :name bob-id :value "Bob")
            (<:input :type :submit :name john-id :value "John")
            (<:input :type :submit :name tom-id :value "Tom"))))))

(defun http-greet-5 (&optional next-action)
  (invoke-next-action next-action :main #'greet-5))
(defun greet-5 ()
  (let* ((names   (make-list 3 :initial-element "default-name"))
         (form-id (dynamic-url (how-are-you (format nil "~{~A~^,~}" (remove nil names)))))
         (bob-id  (bindf (nth 0 names)))
         (john-id (bindf (nth 1 names)))
         (tom-id  (bindf (nth 2 names)))
         )
    (standard-page ()
      (<:form 
       :action form-id
       (<:p "What's your name?")
       (<:p (<:input :type :checkbox :name bob-id :value "Bob") "Bob")
       (<:p (<:input :type :checkbox :name john-id :value "John") "John")
       (<:p (<:input :type :checkbox :name tom-id :value "Tom")  "Tom")
       (<:p (<:input :type :submit
                     :name "OK"
                     :value "OK"))
       ))))

(defun http-greet-6 (&optional next-action)
  (invoke-next-action next-action :main #'greet-6))
(defun greet-6 ()
  (let* ((names   (make-list 3 :initial-element "default-name"))
         (form-id (dynamic-url (how-are-you (format nil "~{~A~^,~}" 
                                                    (remove "0" names :test #'equal)))))
         (bob-id  (bindf (nth 0 names)))
         (john-id (bindf (nth 1 names)))
         (tom-id  (bindf (nth 2 names)))
         )
    (standard-page ()
      (<:form 
       :action form-id
       (<:p "What's your name?")
       (<:p (<:input :type :checkbox :name bob-id :value "Bob") 
            (<:input :type :hidden :name bob-id :value "0") "Bob")
       (<:p (<:input :type :checkbox :name john-id :value "John")
            (<:input :type :hidden :name john-id :value "0") "John")
       (<:p (<:input :type :checkbox :name tom-id :value "Tom")
            (<:input :type :hidden :name tom-id :value "0")  "Tom")
       (<:p (<:input :type :submit
                     :name "OK"
                     :value "OK"))
       ))))
(defun http-greet-7 (&optional next-action)
  (invoke-next-action next-action :main #'greet-7))
(defun greet-7 ()
  (let* ((names   (list "Bob" "John" "Tom"))
         (form-id (dynamic-url (how-are-you 
                                (format nil "~{~A~^,~}" 
                                        (remove "0" names :test #'equal)))))
         (names-id (with-call-back (var :type 'list) (setf names var)))
         )
    (standard-page ()
      (<:form 
       :action form-id
       (<:p "What's your name?")
       (<:input :type :hidden :name names-id :value "0")
       (loop 
          for n in names
          do
            (<:p (<:input :type :checkbox :name names-id :value n) (<:as-html n)))
       (<:p (<:input :type :submit
                     :name "OK"
                     :value "OK"))
       ))))
(defun http-greet-8 (&optional next-action)
  (invoke-next-action next-action :main #'greet-8))
(defun greet-8 ()
  (let* ((names   (list "Bob" "John" "Tom"))
         (form-id (dynamic-url (how-are-you 
                                (format nil "~{~A~^,~}" 
                                        (remove "0" names :test #'equal)))))
         (names-id (bindf names :type 'list))
         )
    (standard-page ()
      (<:form 
       :action form-id
       (<:p "What's your name?")
       (<:input :type :hidden :name names-id :value "0")
       (loop 
          for n in names
          do
            (<:p (<:input :type :checkbox :name names-id :value n) (<:as-html n)))
       (<:p (<:input :type :submit
                     :name "OK"
                     :value "OK"))
       ))))






More information about the ginseng-cvs mailing list