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