[claw-cvs] r121 - in trunk/main/claw-demo: . src src/backend src/frontend src/frontend/components src/frontend/docroot/css
Andrea Chiumenti
achiumenti at common-lisp.net
Tue Oct 21 12:45:47 UTC 2008
Author: achiumenti
Date: Tue Oct 21 12:45:47 2008
New Revision: 121
Log:
several bugfixes and enhancements
Added:
trunk/main/claw-demo/src/frontend/components/translator-stringlist.lisp
trunk/main/claw-demo/src/main.lisp
trunk/main/claw-demo/src/packages.lisp
Modified:
trunk/main/claw-demo/claw-demo.asd
trunk/main/claw-demo/src/backend/dao.lisp
trunk/main/claw-demo/src/backend/packages.lisp
trunk/main/claw-demo/src/backend/service.lisp
trunk/main/claw-demo/src/backend/vo.lisp
trunk/main/claw-demo/src/frontend/components/djconfirmation-submit.lisp
trunk/main/claw-demo/src/frontend/components/edit-customer.lisp
trunk/main/claw-demo/src/frontend/components/edit-user.lisp
trunk/main/claw-demo/src/frontend/components/site-template.lisp
trunk/main/claw-demo/src/frontend/customers.lisp
trunk/main/claw-demo/src/frontend/docroot/css/style.css
trunk/main/claw-demo/src/frontend/login.lisp
trunk/main/claw-demo/src/frontend/main.lisp
trunk/main/claw-demo/src/frontend/packages.lisp
trunk/main/claw-demo/src/frontend/users.lisp
Modified: trunk/main/claw-demo/claw-demo.asd
==============================================================================
--- trunk/main/claw-demo/claw-demo.asd (original)
+++ trunk/main/claw-demo/claw-demo.asd Tue Oct 21 12:45:47 2008
@@ -50,7 +50,7 @@
:name "claw-demo-frontend"
:author "Andrea Chiumenti"
:description "Demo application for claw, frontend part."
- :depends-on (:local-time :claw :hunchentoot-connector :claw-html :claw-html.dojo :claw-demo-backend)
+ :depends-on (:local-time :claw :hunchentoot-connector :claw-html :claw-html.dojo :claw-demo-backend :split-sequence)
:components ((:module src
:components ((:module frontend
:components ((:file "packages")
@@ -75,8 +75,12 @@
(:file "translator-threestate"
:pathname #.(make-pathname :directory '(:relative "components") :name "translator-threestate" :type "lisp")
:depends-on ("packages"))
+ (:file "translator-stringlist"
+ :pathname #.(make-pathname :directory '(:relative "components") :name "translator-stringlist" :type "lisp")
+ :depends-on ("packages"))
(:file "auth" :depends-on ("packages"))
- (:file "commons" :depends-on ("packages" "site-template" "pager" "djconfirmation-submit" "redirect" "edit-customer" "edit-user" "translator-threestate"))
+ (:file "commons" :depends-on ("packages" "site-template" "pager" "djconfirmation-submit" "redirect" "edit-customer"
+ "edit-user" "translator-threestate" "translator-stringlist"))
(:file "main" :depends-on ("packages" "auth"))
(:file "index" :depends-on ("commons" "main"))
(:file "logout" :depends-on ("commons" "main"))
@@ -93,4 +97,7 @@
:perform (test-op :after (op c)
(describe (funcall (find-symbol "RUN-TESTS" "LIFT")
:suite (find-symbol "CLAW-DEMO-BACKEND-TESTSUITE" "CLAW-DEMO-BACKEND"))))
- :depends-on (:clsql :clsql-postgresql :local-time :claw :closer-mop :claw-demo-backend :claw-demo-frontend))
+ :depends-on (:clsql :clsql-postgresql :local-time :claw :closer-mop :claw-demo-backend :claw-demo-frontend)
+ :components ((:module src
+ :components ((:file "packages")
+ (:file "main" :depends-on ("packages"))))))
Modified: trunk/main/claw-demo/src/backend/dao.lisp
==============================================================================
--- trunk/main/claw-demo/src/backend/dao.lisp (original)
+++ trunk/main/claw-demo/src/backend/dao.lisp Tue Oct 21 12:45:47 2008
@@ -85,18 +85,15 @@
(defmethod delete-instance-records :before ((instance base-table))
(check-instance-version instance :database *claw-demo-db*))
-
-
(defmethod update-records-from-instance :before ((instance base-table) &key (database *claw-demo-db*))
(check-instance-version instance :database database)
(sign-table-update instance)
- (if (and (slot-boundp instance 'id) (not (= 0 (table-id instance))))
- (incf (table-version instance))
- (unless (typep instance 'base-table-121)
- (let ((sequence-name (format nil
- "~a_id_seq"
- (string-downcase (symbol-name (view-table (class-of instance)))))))
- (setf (table-id instance) (sequence-next sequence-name :database database))))))
+ (if (= (table-id instance) 0)
+ (let ((sequence-name (format nil
+ "~a_id_seq"
+ (string-downcase (symbol-name (view-table (class-of instance)))))))
+ (setf (table-id instance) (sequence-next sequence-name :database database)))
+ (incf (table-version instance))))
(defmethod update-record-from-slot :before ((instance base-table) slot &key (database *claw-demo-db*))
(declare (ignore slot database))
@@ -119,25 +116,15 @@
(defmethod update-records-from-instance :after ((instance user) &key (database *claw-demo-db*))
(with-transaction (:database database)
- (let* ((id (table-id instance))
- (table-name (view-table (find-class 'user-role)))
- (user-id-column-name (slot-column-name 'user-role 'user-id))
- (role-id-column-name (slot-column-name 'user-role 'role-id))
- (role-list (user-roles instance))
- (roles-already-present-id-list (when role-list
- (select role-id-column-name
- :from table-name
- :where (sql-operation 'in user-id-column-name
- (loop for user-role in role-list
- collect (table-id user-role)))
- :flatp t
- :refresh t
- :database database))))
- (dolist (role (user-roles instance))
- (unless (member (table-id role) roles-already-present-id-list)
- (update-records-from-instance (make-instance 'user-role
- :user-id id
- :role-id (table-id role)) :database database))))))
+ (let ((id (table-id instance))
+ (role-list (user-roles instance)))
+ (delete-records :from (symbol-name (view-table (find-class 'user-role)))
+ :where (sql-operation '= (slot-column-name 'user-role 'user-id) id)
+ :database database)
+ (dolist (role role-list)
+ (update-records-from-instance (make-instance 'user-role
+ :user-id id
+ :role-id (table-id role)) :database database)))))
(defmethod update-records-from-instance :before ((instance customer) &key (database *claw-demo-db*))
@@ -391,4 +378,4 @@
:field-names field-names
:database database)))))))))
-(export '(sql-join sql-left-join sql-right-join sql-outer-join sql-inner-join sql-upper))
\ No newline at end of file
+(export '(sql-join sql-left-join sql-right-join sql-outer-join sql-inner-join sql-upper))
Modified: trunk/main/claw-demo/src/backend/packages.lisp
==============================================================================
--- trunk/main/claw-demo/src/backend/packages.lisp (original)
+++ trunk/main/claw-demo/src/backend/packages.lisp Tue Oct 21 12:45:47 2008
@@ -107,5 +107,7 @@
#:find-vo
#:count-vo
#:find-user-by-name
+ #:find-roles-by-names
+ #:find-roles-by-ids
#:find-customers
#:find-users))
\ No newline at end of file
Modified: trunk/main/claw-demo/src/backend/service.lisp
==============================================================================
--- trunk/main/claw-demo/src/backend/service.lisp (original)
+++ trunk/main/claw-demo/src/backend/service.lisp Tue Oct 21 12:45:47 2008
@@ -108,12 +108,13 @@
(find-by-id symbol-class id)))
(defun find-user-by-name (name)
- (let ((where (sql-operation '= (slot-column-name 'user 'username) name)))
- (first (select 'user
- :where where
- :flatp t
- :refresh t
- :database *claw-demo-db*))))
+ (let* ((where (sql-operation '= (slot-column-name 'user 'username) name))
+ (user (first (select 'user
+ :where where
+ :flatp t
+ :refresh t
+ :database *claw-demo-db*))))
+ user))
(defun find-customers (&key (offset 0) (limit *select-limit*) name1 name2 email vat phone sorting)
(let ((where (remove-if #'null (list
@@ -161,11 +162,11 @@
(sql-operation 'in (sql-slot-value 'role 'name) role-names))))))
(find-vo 'user :offset offset
:limit limit
- :from (sql-join (sql-join (view-table (find-class 'user))
- (view-table (find-class 'user-role))
- (sql-operation '=
- (sql-slot-value 'user 'id)
- (sql-slot-value 'user-role 'user-id)))
+ :from (sql-left-join (sql-left-join (view-table (find-class 'user))
+ (view-table (find-class 'user-role))
+ (sql-operation '=
+ (sql-slot-value 'user 'id)
+ (sql-slot-value 'user-role 'user-id)))
(view-table (find-class 'role))
(sql-operation '=
(sql-slot-value 'user-role 'role-id)
@@ -175,8 +176,19 @@
(first where))
:order-by sorting)))
-#|
-(defun oo ()
- (list [slot-value 'role 'id]))
-|#
+
+(defun find-roles-by-names (&key (offset 0) (limit *select-limit*) names)
+ (if (null names)
+ (values nil 0)
+ (find-vo 'role :offset offset
+ :limit limit
+ :where (sql-operation 'in (slot-value 'role 'name) names))))
+
+(defun find-roles-by-ids (&key (offset 0) (limit *select-limit*) ids)
+ (if (null ids)
+ (values nil 0)
+ (find-vo 'role :offset offset
+ :limit limit
+ :where (sql-operation 'in 'id ids))))
+
(clsql-sys:locally-disable-sql-reader-syntax)
\ No newline at end of file
Modified: trunk/main/claw-demo/src/backend/vo.lisp
==============================================================================
--- trunk/main/claw-demo/src/backend/vo.lisp (original)
+++ trunk/main/claw-demo/src/backend/vo.lisp Tue Oct 21 12:45:47 2008
@@ -72,12 +72,8 @@
(and (equal (type-of o1) (type-of o2))
(= (table-id o1) (table-id o2))))
-(def-view-class base-table-121 (base-table)
- ((id :db-kind :key
- :accessor table-id
- :initarg :id
- :type integer
- :db-constraints :not-null)))
+(def-view-class base-table-121 ()
+ ())
(def-view-class user-role ()
((user-id :db-kind :key
@@ -142,7 +138,7 @@
:foreign-key user-id
:target-slot role
:set t)))
- (:default-initargs :firstname nil :surname nil :username nil :email nil :password nil :active t)
+ (:default-initargs :firstname nil :surname nil :username nil :email nil :password nil :active t )
(:base-table users))
(defmethod user-roles ((user user))
(loop for role-users-roles in (slot-value user 'roles)
Modified: trunk/main/claw-demo/src/frontend/components/djconfirmation-submit.lisp
==============================================================================
--- trunk/main/claw-demo/src/frontend/components/djconfirmation-submit.lisp (original)
+++ trunk/main/claw-demo/src/frontend/components/djconfirmation-submit.lisp Tue Oct 21 12:45:47 2008
@@ -46,11 +46,19 @@
(defmethod wcomponent-template ((obj djconfirmation-submit))
(let* ((dialog-id (generate-id "confirmationDiaolg"))
(yes-id (generate-id "yes"))
- (value (djconfirmation-submit-value obj)))
+ (value (djconfirmation-submit-value obj))
+ (informal-parameters (wcomponent-informal-parameters obj))
+ (on-click (or (getf (wcomponent-informal-parameters obj) :on-click)
+ (getf (wcomponent-informal-parameters obj) :onclick))))
+ (remf informal-parameters :on-click)
+ (remf informal-parameters :onclick)
(div> :class "dijit dijitReset dijitLeft dijitInline"
(djbutton> :static-id (htcomponent-client-id obj)
- :on-click (ps:ps* `(.show (dijit.by-id ,dialog-id)))
- (wcomponent-informal-parameters obj)
+ informal-parameters
+ (script> :type "dojo/connect" :event "onClick" :args "evt"
+ (format nil "if ((function (evt) {~a}).call(this, evt) !== false) {" on-click)
+ (ps:ps* `(.show (dijit.by-id ,dialog-id)))
+ "}")
(or (htcomponent-body obj) value))
(djdialog> :static-id dialog-id
:title "Confirm"
Modified: trunk/main/claw-demo/src/frontend/components/edit-customer.lisp
==============================================================================
--- trunk/main/claw-demo/src/frontend/components/edit-customer.lisp (original)
+++ trunk/main/claw-demo/src/frontend/components/edit-customer.lisp Tue Oct 21 12:45:47 2008
@@ -140,61 +140,73 @@
(djvalidation-text-box> :visit-object visit-object
:required "true"
:label "Name 1"
+ :size 150
:accessor 'customer-name1))
(div> :class "label name2"
(span> "Name 2")
(djvalidation-text-box> :visit-object visit-object
:label "Name 2"
+ :size 80
:accessor 'customer-name2))
(div> :class "label email"
(span> "Email")
(djvalidation-text-box> :visit-object visit-object
:label "Email"
+ :size 200
:accessor 'customer-email))
(div> :class "label pone1"
(span> "Phone 1")
(djvalidation-text-box> :visit-object visit-object
:label "Phone 1"
+ :size 25
:accessor 'customer-phone1))
(div> :class "label pone2"
(span> "Phone 2")
(djvalidation-text-box> :visit-object visit-object
:label "Phone 2"
+ :size 25
:accessor 'customer-phone2))
(div> :class "label pone3"
(span> "Phone 3")
(djvalidation-text-box> :visit-object visit-object
:label "Phone 3"
+ :size 25
:accessor 'customer-phone3))
(div> :class "label fax"
(span> "Fax")
(djvalidation-text-box> :visit-object visit-object
:label "Fax"
+ :size 25
:accessor 'customer-fax))
(div> :class "label vat"
(span> "VAT")
(djvalidation-text-box> :visit-object visit-object
:label "VAT"
+ :size 50
:accessor 'customer-vat))
(div> :class "label code1"
(span> "Code 1")
(djvalidation-text-box> :visit-object visit-object
:label "Code 1"
+ :size 50
:accessor 'customer-code1))
(div> :class "label code2"
(span> "Code 2")
(djvalidation-text-box> :visit-object visit-object
:label "Code 2"
+ :size 50
:accessor 'customer-code2))
(div> :class "label code3"
(span> "Code 3")
(djvalidation-text-box> :visit-object visit-object
:label "Code 3"
+ :size 50
:accessor 'customer-code3))
(div> :class "label code4"
(span> "Code 4")
(djvalidation-text-box> :visit-object visit-object
:label "Code 4"
+ :size 50
:accessor 'customer-code4))
(djtab-container> :id "addressTabs"
:class "addressTabs"
@@ -206,6 +218,7 @@
:visit-object main-address
:class "text"
:label "Main Address[address]"
+ :size 200
:accessor 'customer-address-address))
(div> :class "zip"
(span> :class "label" "Zip")
@@ -214,6 +227,7 @@
:visit-object main-address
:class "text"
:label "Main Address[zip]"
+ :size 5
:accessor 'customer-address-zip))
(div> :class "city"
(span> :class "label" "City")
@@ -222,6 +236,7 @@
:visit-object main-address
:class "text"
:label "Main Address[city]"
+ :size 120
:accessor 'customer-address-city))
(div> :class "state"
(span> :class "label" "State")
@@ -230,6 +245,7 @@
:visit-object main-address
:class "text"
:label "Main Address[state]"
+ :size 120
:accessor 'customer-address-state))
(div> :class "country"
(span> :class "label" "Country")
@@ -238,6 +254,7 @@
:visit-object main-address
:class "text"
:label "Main Address[country]"
+ :size 80
:accessor 'customer-address-country))))
(djcontent-pane> :static-id billing-address-id :class "billingAddress" :title "Billing address"
(div> (div> :class "address"
@@ -247,6 +264,7 @@
:visit-object billing-address
:class "text"
:label "Billing Address[street]"
+ :size 200
:accessor 'customer-address-address))
(div> :class "zip"
(span> :class "label" "Zip")
@@ -255,6 +273,7 @@
:visit-object billing-address
:class "text"
:label "Billing Address[zip]"
+ :size 5
:accessor 'customer-address-zip))
(div> :class "city"
(span> :class "label" "City")
@@ -263,6 +282,7 @@
:visit-object billing-address
:class "text"
:label "Billing Address[city]"
+ :size 120
:accessor 'customer-address-city))
(div> :class "state"
(span> :class "label" "State")
@@ -271,6 +291,7 @@
:visit-object billing-address
:class "text"
:label "Billing Address[state]"
+ :size 120
:accessor 'customer-address-state))
(div> :class "country"
(span> :class "label" "Country")
@@ -279,6 +300,7 @@
:visit-object billing-address
:class "text"
:label "Billing Address[country]"
+ :size 80
:accessor 'customer-address-country)))))
(div> :class "buttons"
(djsubmit-button> :value "Save")
@@ -291,9 +313,11 @@
(defmethod wcomponent-before-rewind :before ((obj edit-customer) (page page))
(when (string-equal (htcomponent-client-id obj) (claw-parameter *rewind-parameter*))
(let ((customer-id (parse-integer (claw-parameter (edit-customer-customer-id-parameter obj)))))
- (setf (edit-customer-customer obj)
- (find-by-id 'customer
- customer-id))
+ (if (> customer-id 0)
+ (setf (edit-customer-customer obj)
+ (find-by-id 'customer
+ customer-id))
+ (setf (edit-customer-customer obj) (make-instance 'customer)))
(find-or-add-address (edit-customer-customer obj) 0)
(find-or-add-address (edit-customer-customer obj) 1))))
Modified: trunk/main/claw-demo/src/frontend/components/edit-user.lisp
==============================================================================
--- trunk/main/claw-demo/src/frontend/components/edit-user.lisp (original)
+++ trunk/main/claw-demo/src/frontend/components/edit-user.lisp Tue Oct 21 12:45:47 2008
@@ -34,97 +34,49 @@
(defclass edit-user (djform)
((user :initarg :user
:accessor edit-user-user)
+ (password :initarg :password
+ :accessor edit-user-password)
(user-id-parameter :initarg :user-id-parameter
:accessor edit-user-user-id-parameter)
+ (assigned-roles :initform ()
+ :accessor edit-user-assigned-roles)
(on-close-click :initarg :on-close-click
:accessor edit-user-on-close-click))
(:metaclass metacomponent)
(:default-initargs :on-close-click nil
- :class "userForm" :user-id-parameter "userid"))
+ :class "userForm" :user-id-parameter "userid" :user nil :password nil))
(defmethod initialize-instance :after ((obj edit-user) &key rest)
(declare (ignore rest))
(setf (action-object obj) obj
(action obj) 'edit-user-save))
-#|
-(defun find-or-add-address (user address-type)
- (let ((address (loop for item in (user-addresses user)
- when (= (user-address-type item) address-type)
- return item)))
- (unless address
- (setf address (make-instance 'user-address :address-type address-type))
- (push address (user-addresses user)))
- address))
-
-(defun address-nullp (address)
- (let ((attributes (list (user-address-address address)
- (user-address-zip address)
- (user-address-city address)
- (user-address-state address)
- (user-address-country address))))
- (not
- (loop for val in (mapcar #'(lambda (x)
- (when (and x (string-not-equal x ""))
- t))
- attributes)
- when val
- return t))))
-
-(defmethod htcomponent-class-initscripts :around ((obj edit-user))
- (let ((req-function (ps:ps (defun is-address-field-required (container-id)
- (defvar input-list (dojo.query "[widgetId]" (dojo.by-id container-id)))
- (defvar result false)
- (dojo.for-each (.map input-list (slot-value dijit 'by-node))
- (lambda (input) (when (.get-value input) (setf result t))))
- (return result))))
- (address-field-validation (ps:ps (progn
- (defun address-field-validation-init (component-id address-container-class)
- (dojo.for-each (dojo.query (+ "." address-container-class) (dojo.by-id component-id))
- (lambda (main-address-node)
- (dojo.for-each (.map (dojo.query "[widgetId]" main-address-node) dijit.by-node)
- (lambda (widget)
- (setf (slot-value widget 'is-valid) (lambda (is-focused)
- (address-field-validation widget (slot-value main-address-node 'id))
- (return (.validator widget (slot-value (slot-value widget 'textbox) 'value)
- (slot-value widget 'constraints))))))))))
- (defun address-field-validation (sender container-id)
- (if (is-address-field-required container-id)
- (unless (= (slot-value sender 'required) t)
- (defvar input-list (dojo.query "[widgetId]" (dojo.by-id container-id)))
- (dojo.for-each (.map input-list dijit.by-node)
- (lambda (input-widget) (setf (slot-value input-widget 'required) t))))
- (unless (!= (slot-value sender 'required) t)
- (defvar input-list (dojo.query "[widgetId]" (dojo.by-id container-id)))
- (dojo.for-each (.map input-list dijit.by-node)
- (lambda (input-widget) (setf (slot-value input-widget 'required) false))))))))))
- (append (list req-function address-field-validation) (call-next-method))))
-
-(defmethod htcomponent-instance-initscript :around ((obj edit-user))
- (let* ((component-id (htcomponent-client-id obj))
- (parent-script (call-next-method))
- (script (ps:ps* `(progn
- (address-field-validation-init ,component-id "mainAddress")
- (address-field-validation-init ,component-id "billingAddress")))))
- (if parent-script
- (format nil "~a~%~a" parent-script script)
- script)))
-|#
-
+(defmethod wcomponent-created :after ((obj edit-user))
+ (setf (edit-user-assigned-roles obj) (and (edit-user-user obj)
+ (loop for role in (user-roles (edit-user-user obj))
+ collect (table-id role)))))
(defun unused-roles (user)
(remove-if #'(lambda (role) (find role (user-roles user) :test #'records-equal))
(find-vo 'role :order-by (list (slot-column-name 'role "name")))))
-
(defun edit-user-roles-can-drop (css-class-name)
- (ps:ps* `(progn
- (defvar m (.manager (slot-value dojo 'dnd)))
- (when (slot-value m 'source)
- (.can-drop m (.has-class dojo (slot-value (slot-value m 'source) 'node) ,css-class-name))))))
+ `(progn
+ (defvar m (.manager (slot-value dojo 'dnd)))
+ (when (slot-value m 'source)
+ (.can-drop m (.has-class dojo (slot-value (slot-value m 'source) 'node) ,css-class-name)))))
+
+(defun edit-user-check-nodes (checked-p)
+ `(progn
+ (defvar m (.manager (slot-value dojo 'dnd)))
+ (.for-each dojo nodes (lambda (node-el)
+ (.for-each dojo (.query dojo "input" node-el)
+ (lambda (input-el) (setf (slot-value input-el 'checked) ,checked-p)))))))
(defmethod htcomponent-body ((obj edit-user))
- (let* ((visit-object (edit-user-user obj)))
+ (let* ((visit-object (edit-user-user obj))
+ (assigned-roles-container-id (generate-id "assignedRolesContainer"))
+ (available-roles-container-id (generate-id "availableRolesContainer")))
(list
(cinput> :id (edit-user-user-id-parameter obj)
:type "hidden" :visit-object visit-object
@@ -135,21 +87,31 @@
:visit-object visit-object
:translator *integer-translator*
:accessor 'table-version)
+ (div> :class "label username"
+ (span> "Username")
+ (djvalidation-text-box> :visit-object visit-object
+ :required "true"
+ :label "Username"
+ :size 80
+ :accessor 'user-username))
(div> :class "label surname"
(span> "Surname")
(djvalidation-text-box> :visit-object visit-object
:required "true"
:label "Surname"
+ :size 80
:accessor 'user-surname))
(div> :class "label firstname"
(span> "First name")
(djvalidation-text-box> :visit-object visit-object
:label "First name"
+ :size 80
:accessor 'user-firstname))
(div> :class "label email"
(span> "Email")
(djvalidation-text-box> :visit-object visit-object
:label "Email"
+ :size 200
:accessor 'user-email))
(div> :class "label active"
(span> "Active")
@@ -157,24 +119,50 @@
:label "Active"
:translator *boolean-translator*
:value t
+ :multiple nil
:accessor 'user-active))
- (div> :class "label password"
- (span> "Password")
- (djvalidation-text-box> :visit-object visit-object
- :label "Password"
- :type "password"
- :accessor 'user-password))
- (div> :class "userRoles"
- (djdnd-source> :class "userRolesContainer availableRoles"
+ (djxpassword-validator> :id "password"
+ :class "label password"
+ :visit-object obj
+ :label "Password"
+ :type "password"
+ :size 100
+ :accessor 'edit-user-password
+ (div> :class "label"
+ (span> "Password")
+ (djxpassword-new>))
+ (div> :class "label"
+ (span> "Confirm password")
+ (djxpassword-verify>)))
+ (div> :class "userRolesRow"
+ (djdnd-source> :static-id available-roles-container-id :class "userRolesContainer availableRoles"
+ :tag-name "fieldset"
(script> :type "dojo/connect" :event "onMouseMove" :args "e"
- (edit-user-roles-can-drop "userRoles"))
+ (ps:ps* `,(edit-user-roles-can-drop "userRoles")))
+ (script> :type "dojo/connect" :event "onDndDrop" :args "source, nodes, copy, target"
+ (ps:ps* `(when (= target.id ,available-roles-container-id) ,(edit-user-check-nodes 'false))))
+ (legend> "Available roles")
(loop for role in (unused-roles visit-object)
- collect (djdnd-item> (role-name role))))
- (djdnd-source> :class "userRolesContainer userRoles"
+ collect (djdnd-item> (role-name role)
+ (ccheckbox> :id "userRole"
+ :visit-object obj
+ :translator *integer-translator*
+ :value (table-id role)
+ :accessor 'edit-user-assigned-roles))))
+ (djdnd-source> :static-id assigned-roles-container-id :class "userRolesContainer userRoles"
+ :tag-name "fieldset"
(script> :type "dojo/connect" :event "onMouseMove" :args "e"
- (edit-user-roles-can-drop "availableRoles"))
- (loop for role in (user-roles visit-object)
- collect (djdnd-item> (role-name role)))))
+ (ps:ps* `,(edit-user-roles-can-drop "availableRoles")))
+ (script> :type "dojo/connect" :event "onDndDrop" :args "source, nodes, copy, target"
+ (ps:ps* `(when (= target.id ,assigned-roles-container-id) ,(edit-user-check-nodes t))))
+ (legend> "Assigned roles")
+ (loop for role in (user-roles visit-object)
+ collect (djdnd-item> (role-name role)
+ (ccheckbox> :id "userRole"
+ :visit-object obj
+ :translator *integer-translator*
+ :value (table-id role)
+ :accessor 'edit-user-assigned-roles)))))
(div> :class "buttons"
(djsubmit-button> :value "Save")
(djbutton> :render-condition #'(lambda () (edit-user-on-close-click obj))
@@ -187,15 +175,22 @@
(when (string-equal (htcomponent-client-id obj) (claw-parameter *rewind-parameter*))
(let ((user-id (parse-integer (claw-parameter (edit-user-user-id-parameter obj)))))
(setf (edit-user-user obj)
- (find-by-id 'user
- user-id)))))
+ (if (> user-id 0)
+ (find-by-id 'user
+ user-id)
+ (make-instance 'user))))))
(defmethod edit-user-save ((obj edit-user))
(let ((id (htcomponent-client-id obj))
- (user (edit-user-user obj)))
+ (user (edit-user-user obj))
+ (roles (find-roles-by-ids :ids (edit-user-assigned-roles obj))))
(handler-case
(progn
- (update-db-item user))
+ (log-message :info "password ~a" (edit-user-password obj))
+ (setf (user-roles user) roles
+ (user-password user) (edit-user-password obj))
+ (update-db-item user)
+ (setf (edit-user-password obj) nil))
(clsql-sys:sql-database-error (cond)
(log-message :info "Exception on edit-user-save: ~a" cond)
(add-validation-error id (clsql-sys:sql-error-database-message cond))
Modified: trunk/main/claw-demo/src/frontend/components/site-template.lisp
==============================================================================
--- trunk/main/claw-demo/src/frontend/components/site-template.lisp (original)
+++ trunk/main/claw-demo/src/frontend/components/site-template.lisp Tue Oct 21 12:45:47 2008
@@ -39,7 +39,6 @@
(defmethod wcomponent-template ((site-template site-template))
(let ((principal (current-principal)))
-;(log-message :info "###### ~a ~a" principal (principal-roles principal))
(html>
(head>
(title> (site-template-title site-template))
@@ -57,6 +56,9 @@
(djtoolbar> :id "menuBar" :class "menuBar"
(djdrop-down-button> (span> "File")
(djmenu>
+ (djmenu-item> :id "homeMenu"
+ :on-click (ps:ps* `(location.replace ,(format nil "~a/home.html" *root-path*)))
+ "Home")
(djmenu-item> :id "loginMenu"
:render-condition #'(lambda () (null principal))
:on-click (ps:ps* `(location.replace ,(format nil "~a/login.html" *root-path*)))
@@ -65,7 +67,7 @@
:render-condition #'(lambda () principal)
:on-click (ps:ps* `(location.replace ,(format nil "~a/logout.html" *root-path*)))
"Logout")))
- (djdrop-down-button> :render-condition #'(lambda () principal)
+ (djdrop-down-button> :render-condition #'(lambda () (user-in-role-p '("user")))
(span> "Anagraphics")
(djmenu>
(djmenu-item> :id "customersMenu"
Added: trunk/main/claw-demo/src/frontend/components/translator-stringlist.lisp
==============================================================================
--- (empty file)
+++ trunk/main/claw-demo/src/frontend/components/translator-stringlist.lisp Tue Oct 21 12:45:47 2008
@@ -0,0 +1,44 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: src/frontend/components/translator-stringlist.lisp $
+
+;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :claw-demo-frontend)
+
+(defclass translator-stringlist (translator)
+ ())
+
+(defmethod translator-value-encode ((translator translator-stringlist) value)
+ (if (string= (string-trim " " value) "")
+ ()
+ (split-sequence #\, value)))
+
+(defmethod translator-value-decode ((translator translator-stringlist) value &optional client-id label)
+ (declare (ignore client-id label))
+ (format nil "~{~a~^,~}" value))
+
+(defvar *stringlist-translator* (make-instance 'translator-stringlist))
\ No newline at end of file
Modified: trunk/main/claw-demo/src/frontend/customers.lisp
==============================================================================
--- trunk/main/claw-demo/src/frontend/customers.lisp (original)
+++ trunk/main/claw-demo/src/frontend/customers.lisp Tue Oct 21 12:45:47 2008
@@ -35,11 +35,13 @@
(defgeneric customers-page-edit-customer (customers-page))
+(defgeneric customers-page-add-customer (customers-page))
+
(defgeneric customers-page-sorting (customers-page))
(defgeneric customers-page-delete-customers (customers-page))
-(defclass customers-page (db-page)
+(defclass customers-page (db-page)
((customers :initform nil
:accessor customers-page-customers)
(current-customer :initform (make-instance 'customer)
@@ -59,17 +61,17 @@
(email :initform ""
:accessor customers-page-email)
(vat :initform ""
- :accessor customers-page-vat)
+ :accessor customers-page-vat)
(phone :initform ""
:accessor customers-page-phone)
(sorting-column :initform "name1"
- :accessor customers-page-sorting-column)
+ :accessor customers-page-sorting-column)
(sorting-order :initform "asc"
- :accessor customers-page-sorting-order)
+ :accessor customers-page-sorting-order)
(delete-all :initform nil
:accessor customers-page-delete-all)
(delete-items :initform nil
- :accessor customers-page-delete-items))
+ :accessor customers-page-delete-items))
(:default-initargs :list-size 20))
(defmethod wcomponent-after-rewind :after ((obj edit-customer) (page customers-page))
@@ -78,28 +80,108 @@
(defmethod customers-page-offset-reset ((page customers-page)) 0)
-(defmethod customers-page-edit-customer ((page customers-page))
+(defmethod customers-page-edit-customer ((page customers-page))
(let ((customer-id (parse-integer (claw-parameter "customerid")))
(current-customer))
- (setf current-customer (find-by-id 'customer customer-id)
- (customers-page-customer-edit-dialog-title page) "Edit customer"
- (customers-page-customers page) (list current-customer))
- (when current-customer
- (setf (customers-page-current-customer page) current-customer))))
+ (log-message :info "customers-page-edit-customer")
+ (if (> customer-id 0)
+ (progn
+ (setf current-customer (find-by-id 'customer customer-id)
+ (customers-page-customer-edit-dialog-title page) "Edit customer"
+ (customers-page-customers page) (list current-customer))
+ (when current-customer
+ (setf (customers-page-current-customer page) current-customer)))
+ (customers-page-add-customer page))))
+
+(defmethod customers-page-add-customer ((page customers-page))
+ (let ((current-customer (make-instance 'customer)))
+ (log-message :info "customers-page-add-customer")
+ (setf (customers-page-customer-edit-dialog-title page) "Add new customer"
+ (customers-page-current-customer page) current-customer)))
(defmethod customers-page-sorting ((page customers-page))
(let ((direction (if (string-equal "asc" (customers-page-sorting-order page))
:asc
:desc))
(fields (if (string-equal "name1" (customers-page-sorting-column page))
- (list (slot-column-name 'customer "name1")
+ (list (slot-column-name 'customer "name1")
(slot-column-name 'customer "name2"))
- (list (slot-column-name 'customer "email")
- (slot-column-name 'customer "name1")
+ (list (slot-column-name 'customer "email")
+ (slot-column-name 'customer "name1")
(slot-column-name 'customer "name2")))))
(loop for field in fields
collect (list field direction))))
+(defun js-customers-check-deletion ()
+ (ps:ps* '(when (= (slot-value (.query dojo ".dijitCheckBoxChecked > [name='deleteItem']") 'length) 0)
+ (.show-message claw "Message" "No items to delete")
+ (return false))))
+
+(defun js-customers-add-new-click (edit-customer-action-link-id offset-id)
+ (remove #\newline
+ (ps:ps*
+ `(progn (setf (slot-value (.by-id dojo ,offset-id) 'value)
+ 0
+ (slot-value (dijit.by-id ,edit-customer-action-link-id) 'parameters)
+ (create "customerid" 0))
+ (.click (dijit.by-id ,edit-customer-action-link-id))))))
+
+(defun js-customers-form-submit (spinner-id edit-customer-dialog-id)
+ (remove #\newline
+ (ps:ps* `(progn (.hide (dijit.by-id ,spinner-id))
+ (when (slot-value (dijit.by-id ,edit-customer-dialog-id) 'xhrShow)
+ (setf (slot-value (dijit.by-id ,edit-customer-dialog-id) 'xhrShow) false)
+ (.show (dijit.by-id ,edit-customer-dialog-id)))))))
+
+(defun js-customers-show-spinner (spinner-id)
+ (remove #\newline (ps:ps* `(.show (dijit.by-id ,spinner-id)))))
+
+(defun js-customers-delete-all-on-change ()
+ (remove #\newline
+ (ps:ps (.for-each dojo
+ (.map (.query dojo ".deleteItem") dijit.by-node)
+ (lambda (checkbox) (.attr checkbox "checked" (.attr this "checked")))
+ this))))
+
+(defun js-customers-sort (sorting-column-id sorting-order-id form-id offset-id column)
+ (remove #\newline
+ (ps:ps* `(progn
+ (setf (slot-value (dojo.by-id ,sorting-order-id) 'value)
+ (if (and (== (slot-value (dojo.by-id ,sorting-column-id) 'value) ,column)
+ (== (slot-value (dojo.by-id ,sorting-order-id) 'value) "asc"))
+ "desc"
+ "asc")
+ (slot-value (dojo.by-id ,sorting-column-id) 'value)
+ ,column
+ (slot-value (dojo.by-id ,offset-id) 'value)
+ 0)
+ (.submit (dijit.by-id ,form-id))))))
+
+(defun js-customers-edit (edit-customer-action-link-id customer)
+ (remove #\newline
+ (ps:ps* `(progn (setf (slot-value (dijit.by-id ,edit-customer-action-link-id) 'parameters)
+ (create "customerid" ,(table-id customer)))
+ (.click (dijit.by-id ,edit-customer-action-link-id))))))
+
+(defun js-customers-action-edit (spinner-id edit-customer-dialog-id)
+ (remove #\newline
+ (ps:ps* `(progn (.hide (dijit.by-id ,spinner-id))
+ (.show (dijit.by-id ,edit-customer-dialog-id))))))
+
+(defun js-customers-edit-customers-before-submit (spinner-id edit-customer-dialog-id)
+ (remove #\newline
+ (ps:ps* `(progn (.show (dijit.by-id ,spinner-id))
+ (dojo.add-class
+ (slot-value (dijit.by-id ,edit-customer-dialog-id) 'container-node)
+ "hideForm")))))
+
+(defun js-customers-edit-customers-xhr-finish (spinner-id edit-customer-dialog-id)
+ (remove #\newline
+ (ps:ps* `(progn (.hide (dijit.by-id ,spinner-id))
+ (dojo.remove-class
+ (slot-value (dijit.by-id ,edit-customer-dialog-id) 'container-node)
+ "hideForm")))))
+
(defmethod page-content ((page customers-page))
(let ((spinner-id (generate-id "spinner"))
(form-id (generate-id "customersForm"))
@@ -121,18 +203,33 @@
(djform> :static-id form-id
:action 'customers-page-find-customers
:update-id result-container-id
- :on-before-submit (ps:ps* `(.show (dijit.by-id ,spinner-id)))
- :on-xhr-finish (ps:ps* `(.hide (dijit.by-id ,spinner-id)))
+ :on-before-submit (js-customers-show-spinner spinner-id)
+ :on-xhr-finish (js-customers-form-submit spinner-id edit-customer-dialog-id)
(div> (div> :class "searchParameters hlist"
- (div> :class "item" (span> :class "name1" "Name")
- (djtext-box> :label "name" :id "name1" :accessor 'customers-page-name1)
- (djtext-box> :label "name" :id "name2" :accessor 'customers-page-name2))
- (div> :class "item" (span> :class "email" "Email")
- (djtext-box> :label "email" :id "email" :accessor 'customers-page-email))
- (div> :class "item" (span> :class "vat" "VAT")
- (djtext-box> :label "vat" :id "vat" :accessor 'customers-page-vat))
- (div> :class "item" (span> :class "phone" "phone")
- (djtext-box> :label "phone" :id "phone" :accessor 'customers-page-phone)))
+ (div> :class "item" (span> :class "name1" "Name")
+ (djtext-box> :size 150
+ :label "name"
+ :id "name1"
+ :accessor 'customers-page-name1)
+ (djtext-box> :size 80
+ :label "name"
+ :id "name2"
+ :accessor 'customers-page-name2))
+ (div> :class "item" (span> :class "email" "Email")
+ (djtext-box> :size 100
+ :label "email"
+ :id "email"
+ :accessor 'customers-page-email))
+ (div> :class "item" (span> :class "vat" "VAT")
+ (djtext-box> :size 50
+ :label "vat"
+ :id "vat"
+ :accessor 'customers-page-vat))
+ (div> :class "item" (span> :class "phone" "phone")
+ (djtext-box> :size 25
+ :label "phone"
+ :id "phone"
+ :accessor 'customers-page-phone)))
(cinput> :type "hidden"
:static-id offset-id
:translator *integer-translator*
@@ -145,62 +242,62 @@
:static-id sorting-order-id
:accessor 'customers-page-sorting-order)
(djsubmit-button> :id "search"
+ :on-click (ps:ps* `(setf
+ (slot-value (.by-id dojo ,offset-id) 'value)
+ 0))
:value "Search")
+ (djbutton> :id "addNew"
+ :on-click (js-customers-add-new-click edit-customer-action-link-id offset-id)
+ "Add new")
(djconfirmation-submit> :id "delete"
:value "Delete"
+ :on-click (js-customers-check-deletion)
:action 'customers-page-delete-customers
:confirmation-message "Are you sure to delete these items?"))
(div> :static-id result-container-id
(table> :class "listTable"
(tr> :class "header"
- (th> :class "deleteAll" (djcheck-box> :id "deleteAll"
- ;:reader 'customers-page-delete-all
- :value "all"
- :onchange(remove #\newline (ps:ps (.for-each dojo (.map (.query dojo ".deleteItem") dijit.by-node)
- (lambda (checkbox) (.attr checkbox "checked" (.attr this "checked"))) this)))))
- (th> :class "name" (span> :class (if (string-equal "name1" sort-field)
+ (th> :class "deleteAll" (djcheck-box> :id "deleteAll"
+ :value "all"
+ :onchange (js-customers-delete-all-on-change)))
+ (th> :class "name" (span> :class (if (string-equal "name1" sort-field)
(if (string-equal "asc" sort-direction)
"sort sortAsc"
"sort sortDesc")
"sort")
- :on-click (remove #\newline (ps:ps* `(progn (setf (slot-value (dojo.by-id ,sorting-order-id) 'value)
- (if (and (== (slot-value (dojo.by-id ,sorting-column-id) 'value) "name1")
- (== (slot-value (dojo.by-id ,sorting-order-id) 'value) "asc"))
- "desc"
- "asc"))
- (setf (slot-value (dojo.by-id ,sorting-column-id) 'value)
- "name1")
- (.submit (dijit.by-id ,form-id)))))
+ :on-click (js-customers-sort sorting-column-id
+ sorting-order-id
+ form-id
+ offset-id
+ "name1")
"Name"))
- (th> :class "email" (span> :class (if (string-equal "email" sort-field)
+ (th> :class "email" (span> :class (if (string-equal "email" sort-field)
(if (string-equal "asc" sort-direction)
"sort sortAsc"
"sort sortDesc")
- "sort")
- :on-click (remove #\newline (ps:ps* `(progn (setf (slot-value (dojo.by-id ,sorting-order-id) 'value)
- (if (and (== (slot-value (dojo.by-id ,sorting-column-id) 'value) "email")
- (== (slot-value (dojo.by-id ,sorting-order-id) 'value) "asc"))
- "desc"
- "asc"))
- (setf (slot-value (dojo.by-id ,sorting-column-id) 'value)
- "email")
- (.submit (dijit.by-id ,form-id)))))
+ "sort")
+ :on-click (js-customers-sort sorting-column-id
+ sorting-order-id
+ form-id
+ offset-id
+ "email")
"Email"))
(th> :class "vat" "VAT")
(th> :class "phone" "Phone"))
(loop for customer in customers
for index = 0 then (incf index)
collect (tr> :class (if (evenp index) "item even" "item odd")
- (th> :class "delete" (djcheck-box> :id "deleteItem" :class "deleteItem" :accessor 'customers-page-delete-items
- :value (table-id customer)
- :translator *integer-translator*
- :multiple t))
+ (th> :class "delete"
+ (djcheck-box> :id "deleteItem"
+ :class "deleteItem"
+ :accessor 'customers-page-delete-items
+ :value (table-id customer)
+ :translator *integer-translator*
+ :multiple t))
(td> (a> :id "edit"
:href "#"
- :on-click (remove #\newline (ps:ps* `(progn (setf (slot-value (dijit.by-id ,edit-customer-action-link-id) 'parameters)
- (create "customerid" ,(table-id customer)))
- (.click (dijit.by-id ,edit-customer-action-link-id)))))
+ :on-click (js-customers-edit edit-customer-action-link-id customer)
(customer-name1 customer)
" "
(customer-name2 customer)))
@@ -208,21 +305,20 @@
(td> (customer-vat customer))
(td> (customer-phone1 customer)))))
(unless customers
- (djcheck-box> :id "deleteItem"
- :accessor 'customers-page-delete-items
+ (djcheck-box> :id "deleteItem"
+ :accessor 'customers-page-delete-items
:value 0
- :multiple t
+ :multiple t
:translator *integer-translator*
:style "display: none;"))
(djaction-link> :static-id edit-customer-action-link-id
:style "display:none"
:action 'customers-page-edit-customer
:update-id (attribute-value (list edit-customer-dialog-container-id result-container-id))
- :on-before-submit (ps:ps* `(.show (dijit.by-id ,spinner-id)))
- :on-xhr-finish (remove #\newline (ps:ps* `(progn (.hide (dijit.by-id ,spinner-id))
- (.show (dijit.by-id ,edit-customer-dialog-id)))))
+ :on-before-submit (js-customers-show-spinner spinner-id)
+ :on-xhr-finish (js-customers-action-edit spinner-id edit-customer-dialog-id)
"invisible")
- (pager> :id "pager"
+ (pager> :id "pager"
:update-component-id offset-id
:page-size (customers-page-list-size page)
:total-items (customers-page-customers-total-count page)
@@ -235,15 +331,10 @@
:on-close-click (ps:ps* `(.hide (dijit.by-id ,edit-customer-dialog-id)))
:update-id (attribute-value (list edit-customer-form-id result-container-id))
:customer (customers-page-current-customer page)
- :on-before-submit (remove #\newline (ps:ps* `(progn (.show (dijit.by-id ,spinner-id))
- (dojo.add-class
- (slot-value (dijit.by-id ,edit-customer-dialog-id) 'container-node)
- "hideForm"))))
- :on-xhr-finish (ps:ps* `(progn (.hide (dijit.by-id ,spinner-id))
- (dojo.remove-class
- (slot-value (dijit.by-id ,edit-customer-dialog-id) 'container-node)
- "hideForm"))))
- (exception-monitor> :id "exceptionMonitor" :json-render-on-validation-errors-p edit-customer-form-id))))))
+ :on-before-submit (js-customers-edit-customers-before-submit spinner-id edit-customer-dialog-id)
+ :on-xhr-finish (js-customers-edit-customers-xhr-finish spinner-id edit-customer-dialog-id))
+ (exception-monitor> :id "exceptionMonitor"
+ :json-render-on-validation-errors-p edit-customer-form-id))))))
(defmethod customers-page-delete-customers ((page customers-page))
(let ((customer-id-list (customers-page-delete-items page))
@@ -255,7 +346,7 @@
(log-message :info "...deleting")
(delete-by-id 'customer customer-id-list)
(setf (customers-page-delete-items page) ())
- (multiple-value-bind (customers total-size)
+ (multiple-value-bind (customers total-size)
(find-customers :offset (customers-page-offset page)
:limit (customers-page-list-size page)
:name1 (null-when-empty name1)
@@ -273,7 +364,7 @@
(email (customers-page-email page))
(vat (customers-page-vat page))
(phone (customers-page-phone page)))
- (multiple-value-bind (customers total-size)
+ (multiple-value-bind (customers total-size)
(find-customers :offset (customers-page-offset page)
:limit (customers-page-list-size page)
:name1 (null-when-empty name1)
@@ -287,7 +378,7 @@
(defmethod page-before-render ((page customers-page))
(unless (page-req-parameter page *rewind-parameter*)
- (multiple-value-bind (customers total-size)
+ (multiple-value-bind (customers total-size)
(find-customers :sorting (customers-page-sorting page)
:offset 0
:limit (customers-page-list-size page))
@@ -295,8 +386,8 @@
(customers-page-customers-total-count page) total-size))))
-(lisplet-register-function-location *dojo-demo-lisplet*
- (make-page-renderer 'customers-page #'claw-post-parameters #'claw-get-parameters)
+(lisplet-register-function-location *dojo-demo-lisplet*
+ (make-page-renderer 'customers-page #'claw-post-parameters #'claw-get-parameters)
"customers.html")
(lisplet-protect *dojo-demo-lisplet* "customers.html" '("administrator" "user"))
Modified: trunk/main/claw-demo/src/frontend/docroot/css/style.css
==============================================================================
--- trunk/main/claw-demo/src/frontend/docroot/css/style.css (original)
+++ trunk/main/claw-demo/src/frontend/docroot/css/style.css Tue Oct 21 12:45:47 2008
@@ -6,6 +6,13 @@
font-family: arial;
}
+.clawButtons {
+ margin-top: 1em;
+ border-top: 1px solid #BDD6F0;
+ padding-top: .5em;
+ text-align: center;
+}
+
ul.errors {
padding: 0;
}
@@ -44,7 +51,7 @@
text-align: center;
}
-#exceptionMonitor ul {
+.exceptionMonitor ul {
list-style-type: none;
color: red;
}
@@ -149,17 +156,18 @@
.customerForm .label span, .userForm .label span{
display:-moz-inline-stack;
display:inline-block;
- width: 80px;
+ width: 127px;
text-align: right;
padding-right: 15px;
}
-body.demo .customerDialog {
- width: 305px;
- min-height: 460px;
+body.demo .customerDialog form{
+ width: 360px;
+ height:415px;
+ overflow: hidden;
}
-body.demo .customerDialog .dijitDialogPaneContent{
+body.demo .dijitDialog .dijitDialogPaneContent{
background: #F0F4FC;
}
.customerForm .buttons, .userForm .buttons {
@@ -189,6 +197,7 @@
width: 100%;
height: 150px;
margin-top: 5px;
+/* margin-left: 20px;*/
}
.demo .addressTabs .dijitTabLabels-top {
@@ -224,6 +233,10 @@
display: block;
}
+div.label {
+ margin-top: 2px;
+}
+
.addressTabs .text {
width: 100%;
}
@@ -236,24 +249,33 @@
width: 150px;
}
-.userRoles {
+.userRolesRow {
position: relative;
margin-top: 5px;
/* width: 340px;*/
}
-.userRoles div.userRolesContainer {
+.userRolesRow .userRolesContainer {
position: relative;
float: left;
width: 160px;
height: 180px;
border: 1px solid #8BA0BD;
margin-top: 0;
+ padding:3px;
+}
+
+legend {
+ font-weight: bolder;
}
-.userRoles div div {
+.userRolesRow div div {
clear: left;
}
.availableRoles {
margin-right: 5px;
+}
+
+.userRolesRow input {
+ display: none;
}
\ No newline at end of file
Modified: trunk/main/claw-demo/src/frontend/login.lisp
==============================================================================
--- trunk/main/claw-demo/src/frontend/login.lisp (original)
+++ trunk/main/claw-demo/src/frontend/login.lisp Tue Oct 21 12:45:47 2008
@@ -61,6 +61,7 @@
(djvalidation-text-box> :id "username"
:label "Username"
:required "true"
+ :size 80
:accessor 'login-page-username))
(div> :class "row"
(span> :class "dialogLabel" "Password")
@@ -68,15 +69,18 @@
:label "Password"
:type "password"
:required "true"
+ :size 100
:accessor 'login-page-password))
(div> :class "buttonContainer"
(djsubmit-button> :value "Login")
- (exception-monitor> :id "exceptionMonitor" :json-render-on-validation-errors-p form-id)))
+ (exception-monitor> :id "exceptionMonitor"
+ :json-render-on-validation-errors-p form-id)))
(div> :static-id login-result-id
(redirect> :render-condition #'current-principal
:id "redirect"
:href (format nil "~a/index.html" *root-path*))))
- (script> (ps:ps* `(dojo.add-on-load (lambda () (.show (dijit.by-id "loginDialog")))))))))
+ (script> :render-condition #'(lambda () (null (current-principal)))
+ (ps:ps* `(dojo.add-on-load (lambda () (.show (dijit.by-id "loginDialog")))))))))
(lisplet-register-function-location *dojo-demo-lisplet*
(make-page-renderer 'login-page #'claw-post-parameters #'claw-get-parameters)
Modified: trunk/main/claw-demo/src/frontend/main.lisp
==============================================================================
--- trunk/main/claw-demo/src/frontend/main.lisp (original)
+++ trunk/main/claw-demo/src/frontend/main.lisp Tue Oct 21 12:45:47 2008
@@ -1,5 +1,5 @@
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
-;;; $Header: dojo/tests/main.lisp $
+;;; $Header: src/frontend/main.lisp $
;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved.
Modified: trunk/main/claw-demo/src/frontend/packages.lisp
==============================================================================
--- trunk/main/claw-demo/src/frontend/packages.lisp (original)
+++ trunk/main/claw-demo/src/frontend/packages.lisp Tue Oct 21 12:45:47 2008
@@ -1,5 +1,5 @@
;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
-;;; $Header: src/package.lisp $
+;;; $Header: src/frontend/package.lisp $
;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved.
@@ -31,6 +31,5 @@
(defpackage :claw-demo-frontend
- (:use :cl :local-time :claw :hunchentoot-connector :claw-html :claw-html.dojo :claw-demo-backend)
- (:documentation "A demo application for CLAW")
- #|(:export #:demo-setup)|#)
\ No newline at end of file
+ (:use :cl :local-time :claw :hunchentoot-connector :claw-html :claw-html.dojo :claw-demo-backend :split-sequence)
+ (:documentation "Frontend layer for demo application for CLAW"))
\ No newline at end of file
Modified: trunk/main/claw-demo/src/frontend/users.lisp
==============================================================================
--- trunk/main/claw-demo/src/frontend/users.lisp (original)
+++ trunk/main/claw-demo/src/frontend/users.lisp Tue Oct 21 12:45:47 2008
@@ -35,11 +35,13 @@
(defgeneric users-page-edit-user (uses-page))
+(defgeneric users-page-add-user (uses-page))
+
(defgeneric users-page-sorting (users-page))
(defgeneric users-page-delete-users (users-page))
-(defclass users-page (db-page)
+(defclass users-page (db-page)
((users :initform nil
:accessor users-page-users)
(current-user :initform (make-instance 'user)
@@ -74,31 +76,140 @@
:accessor users-page-delete-items))
(:default-initargs :list-size 20))
+(defmethod wcomponent-after-rewind :after ((obj edit-user) (page users-page))
+ (setf (users-page-current-user page) (edit-user-user obj)
+ (users-page-users page) (list (edit-user-user obj))))
+
(defmethod users-page-offset-reset ((page users-page)) 0)
-(defmethod users-page-edit-user ((page users-page))
+(defmethod users-page-edit-user ((page users-page))
(let ((user-id (parse-integer (claw-parameter "userid")))
(current-user))
- (setf current-user (find-by-id 'user user-id)
- (users-page-user-edit-dialog-title page) "Edit user"
- (users-page-users page) (list current-user))
- (when current-user
- (setf (users-page-current-user page) current-user))))
+ (if (> user-id 0)
+ (progn
+ (setf current-user (find-by-id 'user user-id)
+ (users-page-user-edit-dialog-title page) "Edit user"
+ (users-page-users page) (list current-user))
+ (when current-user
+ (when (string-equal (user-username current-user) "admin")
+ (add-validation-error "user" "User admin is readonly"))
+ (setf (users-page-current-user page) current-user)))
+ (users-page-add-user page))))
+
+(defmethod users-page-add-user ((page users-page))
+ (let ((current-user (make-instance 'user)))
+ (setf (users-page-user-edit-dialog-title page) "Add new user"
+ (users-page-current-user page) current-user)))
+
(defmethod users-page-sorting ((page users-page))
(let ((direction (if (string-equal "asc" (users-page-sorting-order page))
:asc
:desc))
- (fields (cond
- ((string-equal "surname" (users-page-sorting-column page)) (list (slot-column-name 'user "surname")
+ (fields (cond
+ ((string-equal "surname" (users-page-sorting-column page)) (list (slot-column-name 'user "surname")
(slot-column-name 'user "firstname")))
((string-equal "username" (users-page-sorting-column page)) (list (slot-column-name 'user "username")))
- (t (list (slot-column-name 'user "email")
- (slot-column-name 'user "surname")
+ (t (list (slot-column-name 'user "email")
+ (slot-column-name 'user "surname")
(slot-column-name 'user "firstname"))))))
(loop for field in fields
collect (list field direction))))
+(defun js-users-clean-excpetions ()
+ (ps:ps* '(defun clean-exceptions ()
+ (.for-each dojo
+ (.query dojo ".exceptionMonitor")
+ (lambda (em)
+ (.for-each dojo
+ (slot-value em 'child-nodes)
+ (lambda (node)
+ (.remove-child em node))))))))
+
+(defun js-users-add-new-click (edit-user-action-link-id offset-id)
+ (remove #\newline
+ (ps:ps*
+ `(progn (setf (slot-value (.by-id dojo ,offset-id) 'value)
+ 0
+ (slot-value (dijit.by-id ,edit-user-action-link-id) 'parameters)
+ (create "userid" 0))
+ (.click (dijit.by-id ,edit-user-action-link-id))))))
+
+
+(defun js-no-exceptions-p ()
+ (ps:ps* '(defun no-exceptions ()
+ (defvar validp t)
+ (.for-each dojo
+ (.query dojo ".globalExceptionMonitor")
+ (lambda (el) (when (.has-child-nodes el)
+ (setf validp false))))
+ (return validp))))
+
+
+(defun js-users-form-submit (spinner-id edit-user-dialog-id)
+ (remove #\newline
+ (ps:ps* `(progn (.hide (dijit.by-id ,spinner-id))
+ (when (slot-value (dijit.by-id ,edit-user-dialog-id) 'xhrShow)
+ (setf (slot-value (dijit.by-id ,edit-user-dialog-id) 'xhrShow) false)
+ (when (no-exceptions)
+ (.show (dijit.by-id ,edit-user-dialog-id))))))))
+
+(defun js-users-show-spinner (spinner-id)
+ (remove #\newline (ps:ps* `(progn (clean-exceptions)
+ (.show (dijit.by-id ,spinner-id))))))
+
+(defun js-users-delete-all-on-change ()
+ (remove #\newline
+ (ps:ps (.for-each dojo
+ (.map (.query dojo ".deleteItem") dijit.by-node)
+ (lambda (checkbox) (.attr checkbox "checked" (.attr this "checked")))
+ this))))
+
+(defun js-users-sort (sorting-column-id sorting-order-id form-id offset-id column)
+ (remove #\newline
+ (ps:ps* `(progn
+ (setf (slot-value (dojo.by-id ,sorting-order-id) 'value)
+ (if (and (== (slot-value (dojo.by-id ,sorting-column-id) 'value) ,column)
+ (== (slot-value (dojo.by-id ,sorting-order-id) 'value) "asc"))
+ "desc"
+ "asc")
+ (slot-value (dojo.by-id ,sorting-column-id) 'value)
+ ,column
+ (slot-value (dojo.by-id ,offset-id) 'value)
+ 0)
+ (.submit (dijit.by-id ,form-id))))))
+
+(defun js-users-edit (edit-user-action-link-id user)
+ (remove #\newline
+ (ps:ps* `(progn (setf (slot-value (dijit.by-id ,edit-user-action-link-id) 'parameters)
+ (create "userid" ,(table-id user)))
+ (.click (dijit.by-id ,edit-user-action-link-id))))))
+
+(defun js-users-action-edit (spinner-id edit-user-dialog-id)
+ (remove #\newline
+ (ps:ps* `(progn (.hide (dijit.by-id ,spinner-id))
+ (when (no-exceptions)
+ (.show (dijit.by-id ,edit-user-dialog-id)))))))
+
+(defun js-users-edit-users-before-submit (spinner-id edit-user-dialog-id)
+ (remove #\newline
+ (ps:ps* `(progn (.show (dijit.by-id ,spinner-id))
+ (dojo.add-class
+ (slot-value (dijit.by-id ,edit-user-dialog-id) 'container-node)
+ "hideForm")))))
+(defun js-users-check-deletion ()
+ (ps:ps* '(when (= (slot-value (.query dojo ".dijitCheckBoxChecked > [name='deleteItem']") 'length) 0)
+ (.show-message claw "Message" "No items to delete")
+ (return false))))
+
+(defun js-users-edit-users-xhr-finish (spinner-id edit-user-dialog-id)
+ (remove #\newline
+ (ps:ps* `(progn (.hide (dijit.by-id ,spinner-id))
+ (dojo.remove-class
+ (slot-value (dijit.by-id ,edit-user-dialog-id) 'container-node)
+ "hideForm")))))
+
+
(defmethod page-content ((page users-page))
(let ((spinner-id (generate-id "spinner"))
(form-id (generate-id "usersForm"))
@@ -121,39 +232,40 @@
(djfloating-content> :static-id spinner-id
(img> :alt "spinner"
:src "docroot/img/spinner.gif"))
+ (exception-monitor> :class "globalExceptionMonitor")
(djform> :static-id form-id
:class "users"
:action 'users-page-find-users
:update-id result-container-id
- :on-before-submit (ps:ps* `(.show (dijit.by-id ,spinner-id)))
- :on-xhr-finish (ps:ps* `(.hide (dijit.by-id ,spinner-id)))
+ :on-before-submit (js-users-show-spinner spinner-id)
+ :on-xhr-finish (js-users-form-submit spinner-id edit-user-dialog-id)
(div> (div> :class "searchParameters hlist"
(div> :class "item" (span> :class "surname" "Name")
- (djtext-box> :label "name" :id "surname" :accessor 'users-page-surname)
- (djtext-box> :label "name" :id "firstname" :accessor 'users-page-firstname))
+ (djtext-box> :size 80 :label "name" :id "surname" :accessor 'users-page-surname)
+ (djtext-box> :size 80 :label "name" :id "firstname" :accessor 'users-page-firstname))
(div> :class "item" (span> :class "username" "Username")
- (djtext-box> :label "username" :id "username" :accessor 'users-page-username))
+ (djtext-box> :size 80 :label "username" :id "username" :accessor 'users-page-username))
(div> :class "item" (span> :class "email" "Email")
- (djtext-box> :label "email" :id "email" :accessor 'users-page-email))
+ (djtext-box> :size 200 :label "email" :id "email" :accessor 'users-page-email))
(div> :class "item active" (span> :class "active" "Active")
(div> :class "boundBox"
(div> (djradio-button> :static-id active-any-id
:name "active"
- :class "active"
+ :class "active"
:translator *threestate-translator*
:accessor 'users-page-active
:value :any)
(label> :for active-any-id "Any"))
(div> (djradio-button> :static-id active-yes-id
:name "active"
- :class "active"
+ :class "active"
:translator *threestate-translator*
:accessor 'users-page-active
:value t)
(label> :for active-yes-id "Yes"))
(div> (djradio-button> :static-id active-no-id
:name "active"
- :class "active"
+ :class "active"
:translator *threestate-translator*
:accessor 'users-page-active
:value nil)
@@ -161,12 +273,12 @@
(div> :class "item roles" (span> :class "roles" "Roles")
(div> :class "boundBox"
(loop for role in all-roles
- collect (let ((chk-id (generate-id "selRole")))
+ collect (let ((chk-id (generate-id "selRole")))
(div> (djcheck-box> :static-id chk-id
:name "selRole"
- :class "selRole"
- :accessor 'users-page-roles
- :value (role-name role)
+ :class "selRole"
+ :accessor 'users-page-roles
+ :value (role-name role)
:multiple t)
(label> :for chk-id (role-name role))))))))
(cinput> :type "hidden"
@@ -182,105 +294,106 @@
:accessor 'users-page-sorting-order)
(div> :class "hlistButtons"
(djsubmit-button> :id "search"
+ :on-click (ps:ps*
+ `(setf
+ (slot-value (.by-id dojo ,offset-id) 'value)
+ 0))
:value "Search")
+ (djbutton> :id "addNew"
+ :on-click (js-users-add-new-click
+ edit-user-action-link-id
+ offset-id)
+ "Add new")
(djconfirmation-submit> :id "delete"
:value "Delete"
+ :on-click (js-users-check-deletion)
:action 'users-page-delete-users
:confirmation-message "Are you sure to delete these items?")))
(div> :static-id result-container-id
(table> :class "listTable"
(tr> :class "header"
- (th> :class "deleteAll" (djcheck-box> :id "deleteAll"
- ;:reader 'users-page-delete-all
- :value "all"
- :onchange(remove #\newline (ps:ps (.for-each dojo (.map (.query dojo ".deleteItem") dijit.by-node)
- (lambda (checkbox) (.attr checkbox "checked" (.attr this "checked"))) this)))))
- (th> :class "name" (span> :class (if (string-equal "surname" sort-field)
+ (th> :class "deleteAll" (djcheck-box> :id "deleteAll"
+ :value "all"
+ :onchange (js-users-delete-all-on-change)))
+ (th> :class "name" (span> :class (if (string-equal "surname" sort-field)
(if (string-equal "asc" sort-direction)
"sort sortAsc"
"sort sortDesc")
"sort")
- :on-click (remove #\newline (ps:ps* `(progn (setf (slot-value (dojo.by-id ,sorting-order-id) 'value)
- (if (and (== (slot-value (dojo.by-id ,sorting-column-id) 'value) "surname")
- (== (slot-value (dojo.by-id ,sorting-order-id) 'value) "asc"))
- "desc"
- "asc"))
- (setf (slot-value (dojo.by-id ,sorting-column-id) 'value)
- "surname")
- (.submit (dijit.by-id ,form-id)))))
+ :on-click (js-users-sort sorting-column-id
+ sorting-order-id
+ form-id
+ offset-id
+ "surname")
"Name"))
- (th> :class "username" (span> :class (if (string-equal "username" sort-field)
+ (th> :class "username" (span> :class (if (string-equal "username" sort-field)
(if (string-equal "asc" sort-direction)
"sort sortAsc"
"sort sortDesc")
- "sort")
- :on-click (remove #\newline (ps:ps* `(progn (setf (slot-value (dojo.by-id ,sorting-order-id) 'value)
- (if (and (== (slot-value (dojo.by-id ,sorting-column-id) 'value) "username")
- (== (slot-value (dojo.by-id ,sorting-order-id) 'value) "asc"))
- "desc"
- "asc"))
- (setf (slot-value (dojo.by-id ,sorting-column-id) 'value)
- "username")
- (.submit (dijit.by-id ,form-id)))))
+ "sort")
+ :on-click (js-users-sort sorting-column-id
+ sorting-order-id
+ form-id
+ offset-id
+ "username")
"Username"))
- (th> :class "email" (span> :class (if (string-equal "email" sort-field)
+ (th> :class "email" (span> :class (if (string-equal "email" sort-field)
(if (string-equal "asc" sort-direction)
"sort sortAsc"
"sort sortDesc")
- "sort")
- :on-click (remove #\newline (ps:ps* `(progn (setf (slot-value (dojo.by-id ,sorting-order-id) 'value)
- (if (and (== (slot-value (dojo.by-id ,sorting-column-id) 'value) "email")
- (== (slot-value (dojo.by-id ,sorting-order-id) 'value) "asc"))
- "desc"
- "asc"))
- (setf (slot-value (dojo.by-id ,sorting-column-id) 'value)
- "email")
- (.submit (dijit.by-id ,form-id)))))
+ "sort")
+ :on-click (js-users-sort sorting-column-id
+ sorting-order-id
+ form-id
+ offset-id
+ "email")
"Email"))
(th> :class "enabled" "Enabled")
(th> :class "roles" "Roles"))
(loop for user in users
for index = 0 then (incf index)
collect (tr> :class (if (evenp index) "item even" "item odd")
- (th> :class "delete" (djcheck-box> :id "deleteItem" :class "deleteItem" :accessor 'users-page-delete-items
- :value (table-id user)
- :translator *integer-translator*
- :multiple t))
- (td> (a> :id "edit"
- :href "#"
- :on-click (remove #\newline (ps:ps* `(progn (setf (slot-value (dijit.by-id ,edit-user-action-link-id) 'parameters)
- (create "userid" ,(table-id user)))
- (.click (dijit.by-id ,edit-user-action-link-id)))))
- (user-surname user)
- " "
- (user-firstname user)))
+ (th> :class "delete" (when (> (table-id user) 1)
+ (djcheck-box> :id "deleteItem" :class "deleteItem" :accessor 'users-page-delete-items
+ :value (table-id user)
+ :translator *integer-translator*
+ :multiple t)))
+ (td> (if (> (table-id user) 1)
+ (a> :id "edit"
+ :href "#"
+ :on-click (js-users-edit edit-user-action-link-id user)
+ (user-surname user)
+ " "
+ (user-firstname user))
+ (format nil "~a ~a"
+ (user-surname user)
+ (user-firstname user))))
(td> (user-username user))
(td> (user-email user))
(td> :class (if (user-active user)
"active"
- "inactive")
+ "inactive")
(if (user-active user)
"yes"
"no"))
(td> (format nil "~{~a~^, ~}" (loop for role in (user-roles user)
collect (role-name role)))))))
(unless users
- (djcheck-box> :id "deleteItem"
- :accessor 'users-page-delete-items
+ (djcheck-box> :id "deleteItem"
+ :accessor 'users-page-delete-items
:value 0
- :multiple t
+ :multiple t
:translator *integer-translator*
:style "display: none;"))
(djaction-link> :static-id edit-user-action-link-id
:style "display:none"
:action 'users-page-edit-user
:update-id (attribute-value (list edit-user-dialog-container-id result-container-id))
- :on-before-submit (ps:ps* `(.show (dijit.by-id ,spinner-id)))
- :on-xhr-finish (remove #\newline (ps:ps* `(progn (.hide (dijit.by-id ,spinner-id))
- (.show (dijit.by-id ,edit-user-dialog-id)))))
+ :on-before-submit (js-users-show-spinner spinner-id)
+ :on-xhr-finish (js-users-action-edit spinner-id edit-user-dialog-id)
"invisible")
- (pager> :id "pager"
+ (pager> :id "pager"
:update-component-id offset-id
:page-size (users-page-list-size page)
:total-items (users-page-users-total-count page)
@@ -293,28 +406,26 @@
:on-close-click (ps:ps* `(.hide (dijit.by-id ,edit-user-dialog-id)))
:update-id (attribute-value (list edit-user-form-id result-container-id))
:user (users-page-current-user page)
- :on-before-submit (remove #\newline (ps:ps* `(progn (.show (dijit.by-id ,spinner-id))
- (dojo.add-class
- (slot-value (dijit.by-id ,edit-user-dialog-id) 'container-node)
- "hideForm"))))
- :on-xhr-finish (ps:ps* `(progn (.hide (dijit.by-id ,spinner-id))
- (dojo.remove-class
- (slot-value (dijit.by-id ,edit-user-dialog-id) 'container-node)
- "hideForm"))))
- (exception-monitor> :id "exceptionMonitor" :json-render-on-validation-errors-p edit-user-form-id))))))
+ :on-before-submit (js-users-edit-users-before-submit spinner-id edit-user-dialog-id)
+ :on-xhr-finish (js-users-edit-users-xhr-finish spinner-id edit-user-dialog-id))
+ (exception-monitor> :id "exceptionMonitor" :json-render-on-validation-errors-p edit-user-form-id)))
+ (script> :type "text/javascript"
+ (js-users-clean-excpetions)
+ (js-no-exceptions-p)))))
(defmethod users-page-delete-users ((page users-page))
- (let ((user-id-list (users-page-delete-items page))
+ (let ((user-id-list (remove-if #'(lambda (item) (= item 1)) (users-page-delete-items page)))
(surname (users-page-surname page))
(firstname (users-page-firstname page))
- (username (user-username page))
+ (username (users-page-username page))
(email (users-page-email page))
(active (users-page-active page))
(roles (users-page-roles page)))
- (log-message :info "...deleting")
- (delete-by-id 'user user-id-list)
+ (log-message :info "...deleting users ~a" user-id-list)
+ (when user-id-list
+ (delete-by-id 'user user-id-list))
(setf (users-page-delete-items page) ())
- (multiple-value-bind (users total-size)
+ (multiple-value-bind (users total-size)
(find-users :offset (users-page-offset page)
:limit (users-page-list-size page)
:surname (null-when-empty surname)
@@ -322,7 +433,7 @@
:username username
:email (null-when-empty email)
:active active
- :role-names (null-when-empty roles)
+ :role-names roles
:sorting (users-page-sorting page))
(setf (users-page-users page) users
(users-page-users-total-count page) total-size))))
@@ -335,7 +446,7 @@
(active (users-page-active page))
(roles (users-page-roles page)))
(log-message :info "èèèè ~a" roles)
- (multiple-value-bind (users total-size)
+ (multiple-value-bind (users total-size)
(find-users :offset (users-page-offset page)
:limit (users-page-list-size page)
:surname (null-when-empty surname)
@@ -351,7 +462,7 @@
(defmethod page-before-render ((page users-page))
(unless (page-req-parameter page *rewind-parameter*)
- (multiple-value-bind (users total-size)
+ (multiple-value-bind (users total-size)
(find-users :sorting (users-page-sorting page)
:offset 0
:limit (users-page-list-size page))
@@ -359,8 +470,8 @@
(users-page-users-total-count page) total-size))))
-(lisplet-register-function-location *dojo-demo-lisplet*
- (make-page-renderer 'users-page #'claw-post-parameters #'claw-get-parameters)
+(lisplet-register-function-location *dojo-demo-lisplet*
+ (make-page-renderer 'users-page #'claw-post-parameters #'claw-get-parameters)
"users.html")
(lisplet-protect *dojo-demo-lisplet* "users.html" '("administrator" "user"))
Added: trunk/main/claw-demo/src/main.lisp
==============================================================================
--- (empty file)
+++ trunk/main/claw-demo/src/main.lisp Tue Oct 21 12:45:47 2008
@@ -0,0 +1,42 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: src/main.lisp $
+
+;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :claw-demo)
+
+(defun demo-setup ()
+ "Initializes the demo database"
+ (demo-setup))
+
+(defun demo-start ()
+ "Starts the demo on port 4242 \(for http) and 4343 \(for https)"
+ (claw-demo-frontend::djstart))
+
+(defun demo-stop ()
+ "Stops the demo listening on 4242 and 4343 ports"
+ (claw-demo-frontend::djstop))
\ No newline at end of file
Added: trunk/main/claw-demo/src/packages.lisp
==============================================================================
--- (empty file)
+++ trunk/main/claw-demo/src/packages.lisp Tue Oct 21 12:45:47 2008
@@ -0,0 +1,38 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: src/package.lisp $
+
+;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved.
+
+;;; Redistribution and use in source and binary forms, with or without
+;;; modification, are permitted provided that the following conditions
+;;; are met:
+
+;;; * Redistributions of source code must retain the above copyright
+;;; notice, this list of conditions and the following disclaimer.
+
+;;; * Redistributions in binary form must reproduce the above
+;;; copyright notice, this list of conditions and the following
+;;; disclaimer in the documentation and/or other materials
+;;; provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
+;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
+;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(in-package :cl-user)
+
+
+(defpackage :claw-demo
+ (:use :cl :claw-demo-backend :claw-demo-frontend)
+ (:documentation "A demo application for CLAW")
+ (:export #:demo-setup
+ #:demo-start
+ #:demo-stop))
\ No newline at end of file
More information about the Claw-cvs
mailing list