[claw-cvs] r84 - trunk/main/claw-demo/src/frontend
achiumenti at common-lisp.net
achiumenti at common-lisp.net
Wed Sep 3 17:58:37 UTC 2008
Author: achiumenti
Date: Wed Sep 3 13:58:36 2008
New Revision: 84
Modified:
trunk/main/claw-demo/src/frontend/customers.lisp
Log:
CLAW demo update
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 Wed Sep 3 13:58:36 2008
@@ -31,117 +31,115 @@
(defgeneric edit-customer-save (edit-customer))
-(defclass edit-customer (wcomponent)
+(defclass edit-customer (djform)
((customer :initarg :customer
- :accessor edit-customer-save-customer)
+ :accessor edit-customer-customer)
(on-before-submit :initarg :on-before-submit
:accessor on-before-submit)
(on-xhr-finish :initarg :on-xhr-finish
- :accessor on-xhr-finish))
+ :accessor on-xhr-finish)
+ (customer-id-parameter :initarg :customer-id-parameter
+ :accessor edit-customer-customer-id-parameter))
(:metaclass metacomponent)
- (:default-initargs :on-before-submit nil :on-xhr-finish nil))
+ (:default-initargs :on-before-submit nil :on-xhr-finish nil
+ :class "customerForm" :customer-id-parameter "customerid"))
-(defmethod wcomponent-template ((obj edit-customer))
- (let ((id (htcomponent-client-id obj))
- (visit-object (edit-customer-save-customer obj)))
- (djform> :static-id id
- :class "customerForm"
- :update-id id
- :action 'edit-customer-save
- :action-object obj
- :on-before-submit (on-before-submit obj)
- :on-xhr-finish (on-xhr-finish obj)
- (cinput> :id "customerid"
- :type "hidden" :visit-object visit-object
- :translator *integer-translator*
- :accessor 'table-id)
- (cinput> :type "hidden" :visit-object visit-object
- :translator *integer-translator*
- :accessor 'table-version)
- (div> :class "label name1"
- (span> "Name 1")
- (djvalidation-text-box> :visit-object visit-object
- :required "true"
- :label "Name 1"
- :accessor 'customer-name1))
- (div> :class "label name2"
- (span> "Name 2")
- (djvalidation-text-box> :visit-object visit-object
- :label "Name 2"
- :accessor 'customer-name2))
- (div> :class "label email"
- (span> "Email")
- (djvalidation-text-box> :visit-object visit-object
- :label "Email"
- :accessor 'customer-email))
- (div> :class "label pone1"
- (span> "Phone 1")
- (djvalidation-text-box> :visit-object visit-object
- :label "Phone 1"
- :accessor 'customer-phone1))
- (div> :class "label pone2"
- (span> "Phone 2")
- (djvalidation-text-box> :visit-object visit-object
- :label "Phone 2"
- :accessor 'customer-phone2))
- (div> :class "label pone3"
- (span> "Phone 3")
- (djvalidation-text-box> :visit-object visit-object
- :label "Phone 3"
- :accessor 'customer-phone3))
- (div> :class "label fax"
- (span> "Fax")
- (djvalidation-text-box> :visit-object visit-object
- :label "Fax"
- :accessor 'customer-fax))
- (div> :class "label vat"
- (span> "VAT")
- (djvalidation-text-box> :visit-object visit-object
- :label "VAT"
- :accessor 'customer-vat))
- (div> :class "label code1"
- (span> "Code 1")
- (djvalidation-text-box> :visit-object visit-object
- :label "Code 1"
- :accessor 'customer-code1))
- (div> :class "label code2"
- (span> "Code 2")
- (djvalidation-text-box> :visit-object visit-object
- :label "Code 2"
- :accessor 'customer-code2))
- (div> :class "label code3"
- (span> "Code 3")
- (djvalidation-text-box> :visit-object visit-object
- :label "Code 3"
- :accessor 'customer-code3))
- (div> :class "label code4"
- (span> "Code 4")
- (djvalidation-text-box> :visit-object visit-object
- :label "Code 4"
- :accessor 'customer-code4))
- (div> :class "buttons"
- (djsubmit-button> :value "Save")))))
-
-
-(defun customer-save (customer)
- (let ((db-customer (find-by-id 'customer (table-id customer))))
- (copy-values-by-accessors db-customer customer
- table-version
- customer-name1
- customer-name2
- customer-email
- customer-phone1 customer-phone2 customer-phone3
- customer-fax
- customer-vat
- customer-code1 customer-code2 customer-code3 customer-code4)
- (update-db-item db-customer)
- db-customer))
+(defmethod initialize-instance :after ((obj edit-customer) &key rest)
+ (declare (ignore rest))
+ (setf (action-object obj) obj
+ (action obj) 'edit-customer-save))
+
+(defmethod htcomponent-body ((obj edit-customer))
+ (let ((visit-object (edit-customer-customer obj)))
+ (list
+ (cinput> :id (edit-customer-customer-id-parameter obj)
+ :type "hidden" :visit-object visit-object
+ :translator *integer-translator*
+ :accessor 'table-id)
+ (cinput> :id "tabbleVersion"
+ :type "hidden"
+ :visit-object visit-object
+ :translator *integer-translator*
+ :accessor 'table-version)
+ (div> :class "label name1"
+ (span> "Name 1")
+ (djvalidation-text-box> :visit-object visit-object
+ :required "true"
+ :label "Name 1"
+ :accessor 'customer-name1))
+ (div> :class "label name2"
+ (span> "Name 2")
+ (djvalidation-text-box> :visit-object visit-object
+ :label "Name 2"
+ :accessor 'customer-name2))
+ (div> :class "label email"
+ (span> "Email")
+ (djvalidation-text-box> :visit-object visit-object
+ :label "Email"
+ :accessor 'customer-email))
+ (div> :class "label pone1"
+ (span> "Phone 1")
+ (djvalidation-text-box> :visit-object visit-object
+ :label "Phone 1"
+ :accessor 'customer-phone1))
+ (div> :class "label pone2"
+ (span> "Phone 2")
+ (djvalidation-text-box> :visit-object visit-object
+ :label "Phone 2"
+ :accessor 'customer-phone2))
+ (div> :class "label pone3"
+ (span> "Phone 3")
+ (djvalidation-text-box> :visit-object visit-object
+ :label "Phone 3"
+ :accessor 'customer-phone3))
+ (div> :class "label fax"
+ (span> "Fax")
+ (djvalidation-text-box> :visit-object visit-object
+ :label "Fax"
+ :accessor 'customer-fax))
+ (div> :class "label vat"
+ (span> "VAT")
+ (djvalidation-text-box> :visit-object visit-object
+ :label "VAT"
+ :accessor 'customer-vat))
+ (div> :class "label code1"
+ (span> "Code 1")
+ (djvalidation-text-box> :visit-object visit-object
+ :label "Code 1"
+ :accessor 'customer-code1))
+ (div> :class "label code2"
+ (span> "Code 2")
+ (djvalidation-text-box> :visit-object visit-object
+ :label "Code 2"
+ :accessor 'customer-code2))
+ (div> :class "label code3"
+ (span> "Code 3")
+ (djvalidation-text-box> :visit-object visit-object
+ :label "Code 3"
+ :accessor 'customer-code3))
+ (div> :class "label code4"
+ (span> "Code 4")
+ (djvalidation-text-box> :visit-object visit-object
+ :label "Code 4"
+ :accessor 'customer-code4))
+ (div> :class "buttons"
+ (djsubmit-button> :value "Save")))))
+
+
+(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)))))
(defmethod edit-customer-save ((obj edit-customer))
(let ((id (htcomponent-client-id obj))
- (customer (edit-customer-save-customer obj)))
+ (customer (edit-customer-customer obj)))
(handler-case
- (setf (edit-customer-save-customer obj) (customer-save customer))
+ (progn
+ (log-message :info "PHONE: ~a" (customer-phone1 customer))
+ (update-db-item customer))
(clsql-sys:sql-database-error (cond)
(log-message :info "Exception on edit-customer-save: ~a" cond)
(add-validation-error id (clsql-sys:sql-error-database-message cond))
@@ -159,7 +157,7 @@
((customers :initform nil
:accessor customers-page-customers)
(current-customer :initform (make-instance 'customer)
- :accessor customer-page-current-customer)
+ :accessor customers-page-current-customer)
(customer-edit-dialog-title :initform "Add new cutomer"
:accessor customers-page-customer-edit-dialog-title)
(customers-total-count :initform 0
@@ -184,15 +182,20 @@
:accessor customers-page-sorting-order))
(:default-initargs :list-size 20))
+(defmethod wcomponent-after-rewind :after ((obj edit-customer) (page customers-page))
+ (setf (customers-page-current-customer page) (edit-customer-customer obj)
+ (customers-page-customers page) (list (edit-customer-customer obj))))
+
(defmethod customers-page-offset-reset ((page customers-page)) 0)
(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))
- (setf (customers-page-customer-edit-dialog-title page) "Edit 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 (customer-page-current-customer page) current-customer))))
+ (setf (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))
@@ -212,6 +215,7 @@
(form-id (generate-id "customersForm"))
(customers (customers-page-customers page))
(offset-id (generate-id "offset"))
+ (result-container-id (generate-id "resultContainer"))
(edit-customer-dialog-container-id (generate-id "customerDialogContainer"))
(edit-customer-dialog-id (generate-id "customerDialog"))
(edit-customer-form-id (generate-id "customerForm"))
@@ -226,7 +230,7 @@
:src "docroot/img/spinner.gif"))
(djform> :static-id form-id
:action 'customers-page-find-customers
- :update-id form-id
+ :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)))
(div> (div> :class "searchParameters hlist"
@@ -252,73 +256,74 @@
:accessor 'customers-page-sorting-order)
(djsubmit-button> :id "search"
:value "Search"))
- (table> :class "listTable"
- (tr> :class "header"
- (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)))))
- "Name"))
- (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)))))
- "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")
- (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)))))
- (customer-name1 customer)
- " "
- (customer-name2 customer)))
- (td> (customer-email customer))
- (td> (customer-vat customer))
- (td> (customer-phone1 customer)))))
- (djaction-link> :static-id edit-customer-action-link-id
- :style "display:none"
- :action 'customers-page-edit-customer
- :update-id edit-customer-dialog-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)))))
- "invisible")
- (pager> :id "pager"
- :update-component-id offset-id
- :page-size (customers-page-list-size page)
- :total-items (customers-page-customers-total-count page)
- :first-item-offset (customers-page-offset page)))
+ (div> :static-id result-container-id
+ (table> :class "listTable"
+ (tr> :class "header"
+ (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)))))
+ "Name"))
+ (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)))))
+ "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")
+ (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)))))
+ (customer-name1 customer)
+ " "
+ (customer-name2 customer)))
+ (td> (customer-email customer))
+ (td> (customer-vat customer))
+ (td> (customer-phone1 customer)))))
+ (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)))))
+ "invisible")
+ (pager> :id "pager"
+ :update-component-id offset-id
+ :page-size (customers-page-list-size page)
+ :total-items (customers-page-customers-total-count page)
+ :first-item-offset (customers-page-offset page))))
(div> :static-id edit-customer-dialog-container-id
(djdialog> :static-id edit-customer-dialog-id
:title (customers-page-customer-edit-dialog-title page)
(edit-customer> :static-id edit-customer-form-id
- :customer (customer-page-current-customer page)
+ :update-id (attribute-value (list edit-customer-form-id result-container-id))
+ :customer (customers-page-current-customer page)
:on-before-submit (ps:ps* `(.show (dijit.by-id ,spinner-id)))
- :on-xhr-finish (ps:ps* `(.hide (dijit.by-id ,spinner-id)))
- :customer (customer-page-current-customer page))
+ :on-xhr-finish (ps:ps* `(.hide (dijit.by-id ,spinner-id))))
(exception-monitor> :id "exceptionMonitor" :json-render-on-validation-errors-p edit-customer-form-id))))))
(defmethod customers-page-find-customers ((page customers-page))
More information about the Claw-cvs
mailing list