Author: achiumenti Date: Wed Oct 1 07:59:17 2008 New Revision: 102

Modified: trunk/main/claw-demo/src/frontend/commons.lisp trunk/main/claw-demo/src/frontend/customers.lisp Log: several bugfixes and enhancements

Modified: trunk/main/claw-demo/src/frontend/commons.lisp ============================================================================== --- trunk/main/claw-demo/src/frontend/commons.lisp (original) +++ trunk/main/claw-demo/src/frontend/commons.lisp Wed Oct 1 07:59:17 2008 @@ -29,70 +29,6 @@

(in-package :claw-demo-frontend)

- - - -(defclass site-template (wcomponent) - ((title :initarg :title - :reader site-template-title) - (djconfig :initarg :djconfig - :reader site-template-djconfig)) - (:metaclass metacomponent) - (:default-initargs :djconfig nil)) - -(defclass redirect (wcomponent) - ((href :initarg :href - :reader redirect-href)) - (:metaclass metacomponent)) - -(defmethod htcomponent-instance-initscript ((redirect redirect)) - (ps:ps* `(location.replace ,(redirect-href redirect)))) - -(defmethod wcomponent-template ((redirect redirect)) - ($> "")) - -(defun current-site-template () - (claw-aux-request-value 'site-template)) - -(defmethod wcomponent-template ((site-template site-template)) - (let ((principal (current-principal))) - (html> - (head> - (title> (site-template-title site-template)) - (link> :href (format nil "~a/docroot/css/style.css" *root-path*) - :rel "stylesheet" - :type "text/css")) - (djbody> :is-debug "false" - :theme "soria" - :class "demo" - :djconfig (site-template-djconfig site-template) - (wcomponent-informal-parameters site-template) - (div> :class "topheader" - (div> :class "logoDemo") - (div> :class "logoClaw")) - (djtoolbar> :id "menuBar" :class "menuBar" - (djdrop-down-button> (span> "File") - (djmenu> - (djmenu-item> :id "loginMenu" - :render-condition #'(lambda () (null principal)) - :on-click (ps:ps* `(location.replace ,(format nil "~a/login.html" *root-path*))) - "Login") - (djmenu-item> :id "logoutMenu" - :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) - (span> "Anagraphics") - (djmenu> - (djmenu-item> :id "customersMenu" - :on-click (ps:ps* `(location.replace ,(format nil "~a/customers.html" *root-path*))) - "Customers") - (djmenu-item> :id "usersMenu" - :render-condition #'(lambda () (user-in-role-p '("admin"))) - "Users")))) - (div> :class "contentBody" - (htcomponent-body site-template)))))) - (defclass db-page (page) ())

@@ -106,156 +42,6 @@ (db-disconnect))) result))

- - -(defgeneric pager-count-pages (pager)) - -(defgeneric pager-current-page (pager)) - -(defgeneric pager-page-list (pager)) - -(defgeneric set-offset-value (pager page)) - -(defclass pager (wcomponent) - ((update-component-id :initarg :update-component-id - :accessor pager-update-component-id) - (class :initarg :class - :reader pager-class) - (page-size :initarg :page-size - :reader pager-page-size) - (visible-pages :initarg :visible-pages - :accessor pager-visible-pages) - (total-items :initarg :total-items - :accessor pager-total-items) - (first-item-offset :initarg :first-item-offset - :accessor pager-first-item-offset)) - (:metaclass metacomponent) - (:default-initargs :page-size 10 :visible-pages 10 :class "pager")) - -(defmethod wcomponent-template ((pager pager)) - (let ((total-items (pager-total-items pager)) - (page-size (pager-page-size pager)) - (page-list (pager-page-list pager)) - (current-page (pager-current-page pager)) - (count-pages (pager-count-pages pager)) - (id (htcomponent-client-id pager))) - (when (> total-items page-size) - (div> - :static-id id - :class (pager-class pager) - (wcomponent-informal-parameters pager) - - (when (> current-page 1) - (list (div> :class "button first" - (span> :on-click (set-offset-value pager 1) "first")) - (div> :class "button previous" - (span> :on-click (set-offset-value pager (1- current-page)) "previous")))) - (loop for page in page-list - collect (if (= page current-page) - (div> :class "current page" - (span> (format nil "~a" page))) - (div> :class "page" (span> :on-click (set-offset-value pager page) (format nil "~a" page))))) - (when (< current-page count-pages) - (list (div> :class "button next" - (span> :on-click (set-offset-value pager (1+ current-page)) "next")) - (div> :class "button last" - (span> :on-click (set-offset-value pager count-pages) "last")))))))) - -(defmethod htcomponent-class-initscripts ((pager pager)) - (let ((update-component-id (pager-update-component-id pager)) - (page-size (pager-page-size pager))) - (list - (ps:ps* `(defun pager-go-to (page) - (setf (slot-value (dojo.by-id ,update-component-id) 'value) (* (1- page) ,page-size)) - (defvar form-id (slot-value (slot-value (dojo.by-id ,update-component-id) 'form) 'id)) - (let ((form-el (or (dijit.by-id form-id) - (dojo.by-id form-id)))) - (.submit form-el))))))) - -(defmethod set-offset-value ((pager pager) page) - (ps:ps* `(pager-go-to ,page))) - -(defmethod pager-count-pages ((pager pager)) - (let ((page-size (pager-page-size pager)) - (total-items (pager-total-items pager))) - (count-pages page-size total-items))) - -(defun count-pages (page-size total-items) - (multiple-value-bind (pages rest) - (truncate total-items page-size) - (when (> rest 0) (incf pages)) - pages)) - -(defmethod pager-current-page ((pager pager)) - (let ((page-size (pager-page-size pager)) - (first-item-offset (pager-first-item-offset pager))) - (multiple-value-bind (page rest) - (truncate (1+ first-item-offset) page-size) - (when (> rest 0) (incf page)) - page))) - -(defmethod pager-page-list ((pager pager)) - (let ((current-page (pager-current-page pager)) - (count-pages (pager-count-pages pager)) - (visible-pages (pager-visible-pages pager)) - (pages-before-current-page) - (pages-after-current-page) - (result)) - (when (> current-page 1) - (setf pages-before-current-page - (reverse - (loop for page from (1- current-page) downto (max 1 (- current-page - (truncate visible-pages 2))) - collect page)))) - (when (< current-page count-pages) - (setf pages-after-current-page - (loop for page from (1+ current-page) to (min count-pages (+ (1- current-page) - (- visible-pages (length pages-before-current-page)))) - collect page))) - (setf result (append pages-before-current-page (list current-page) pages-after-current-page)) - (let ((result-length (length result)) - (first-result-page (first result))) - (if (< result-length visible-pages) - (append (reverse (loop for page from (1- first-result-page) downto (max 1 (- first-result-page (- visible-pages result-length))) - collect page)) result) - result)))) - (defun null-when-empty (string) (unless (string= string "") string)) - -(defclass djconfirmation-submit (wcomponent) - ((value :initarg :value - :accessor djconfirmation-submit-value) - (action :initarg :action - :accessor djconfirmation-submit-action) - (confirmation-message :initarg :confirmation-message - :accessor djconfirmation-submit-confirmation-message) - (yes-label :initarg :yes - :accessor djconfirmation-submit-yes) - (no-label :initarg :no - :accessor djconfirmation-submit-no)) - (:default-initargs :yes "Yes" :no "No") - (:metaclass metacomponent)) - -(defmethod wcomponent-template ((obj djconfirmation-submit)) - (let* ((dialog-id (generate-id "confirmationDiaolg")) - (yes-id (generate-id "yes")) - (value (djconfirmation-submit-value obj))) - (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) - (or (htcomponent-body obj) value)) - (djdialog> :static-id dialog-id - :title "Confirm" - (div> (djconfirmation-submit-confirmation-message obj) - (div> :class "buttonContainer" - (djsubmit-button> :static-id yes-id - :value (djconfirmation-submit-value obj) - :action (djconfirmation-submit-action obj) - :on-click (ps:ps* `(.hide (dijit.by-id ,dialog-id))) - (djconfirmation-submit-yes obj)) - (djbutton> :id dialog-id - :on-click (ps:ps* `(.hide (dijit.by-id ,dialog-id))) - (djconfirmation-submit-no obj)))))))) \ 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 Wed Oct 1 07:59:17 2008 @@ -1,5 +1,5 @@ ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*- -;;; $Header: dojo/tests/customers.lisp $ +;;; $Header: customers.lisp $

;;; Copyright (c) 2008, Andrea Chiumenti. All rights reserved.

@@ -29,228 +29,6 @@

(in-package :claw-demo-frontend)

-(defgeneric edit-customer-save (edit-customer)) - -(defclass edit-customer (djform) - ((customer :initarg :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) -|# - (customer-id-parameter :initarg :customer-id-parameter - :accessor edit-customer-customer-id-parameter) - (on-close-click :initarg :on-close-click - :accessor edit-customer-on-close-click)) - (:metaclass metacomponent) - (:default-initargs :on-close-click nil - :class "customerForm" :customer-id-parameter "customerid")) - -(defmethod initialize-instance :after ((obj edit-customer) &key rest) - (declare (ignore rest)) - (setf (action-object obj) obj - (action obj) 'edit-customer-save)) - -(defun find-or-add-address (customer address-type) - (let ((address (loop for item in (customer-addresses customer) - when (= (customer-address-type item) address-type) - return item))) - (unless address - (setf address (make-instance 'customer-address :address-type address-type)) - (push address (customer-addresses customer))) - address)) - -(defun address-nullp (address) - (let ((attributes (list (customer-address-address address) - (customer-address-zip address) - (customer-address-city address) - (customer-address-state address) - (customer-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-body ((obj edit-customer)) - (let* ((visit-object (edit-customer-customer obj)) - (main-address (find-or-add-address visit-object 0)) - (billing-address (find-or-add-address visit-object 1))) - (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)) - (djtab-container> :id "addressTabs" - :class "addressTabs" - (djcontent-pane> :id "mainAddress" :title "Main address" - (div> (div> :class "address" - (span> :class "label" "Street") - (djvalidation-text-box> :visit-object main-address - :label "Main Address[address]" - :accessor 'customer-address-address)) - (div> :class "zip" - (span> :class "label" "Zip") - (djvalidation-text-box> :visit-object main-address - :class "text" - :label "Main Address[zip]" - :accessor 'customer-address-zip)) - (div> :class "city" - (span> :class "label" "City") - (djvalidation-text-box> :visit-object main-address - :class "text" - :label "Main Address[city]" - :accessor 'customer-address-city)) - (div> :class "state" - (span> :class "label" "State") - (djvalidation-text-box> :visit-object main-address - :class "text" - :label "Main Address[state]" - :accessor 'customer-address-state)) - (div> :class "country" - (span> :class "label" "Country") - (djvalidation-text-box> :visit-object main-address - :class "text" - :label "Main Address[country]" - :accessor 'customer-address-country)))) - (djcontent-pane> :id "billingAddress" :title "Billing address" - (div> (div> :class "address" - (span> :class "label" "Street") - (djvalidation-text-box> :visit-object billing-address - :class "text" - :label "Billing Address[street]" - :accessor 'customer-address-address)) - (div> :class "zip" - (span> :class "label" "Zip") - (djvalidation-text-box> :visit-object billing-address - :class "text" - :label "Billing Address[zip]" - :accessor 'customer-address-zip)) - (div> :class "city" - (span> :class "label" "City") - (djvalidation-text-box> :visit-object billing-address - :class "text" - :label "Billing Address[city]" - :accessor 'customer-address-city)) - (div> :class "state" - (span> :class "label" "State") - (djvalidation-text-box> :visit-object billing-address - :class "text" - :label "Billing Address[state]" - :accessor 'customer-address-state)) - (div> :class "country" - (span> :class "label" "Country") - (djvalidation-text-box> :visit-object billing-address - :class "text" - :label "Billing Address[country]" - :accessor 'customer-address-country))))) - (div> :class "buttons" - (djsubmit-button> :value "Save") - (djbutton> :render-condition #'(lambda () (edit-customer-on-close-click obj)) - :id "Close" - :on-click (edit-customer-on-close-click obj) - "Close"))))) - - -(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)) - (find-or-add-address (edit-customer-customer obj) 0) - (find-or-add-address (edit-customer-customer obj) 1)))) - -(defmethod edit-customer-save ((obj edit-customer)) - (let ((id (htcomponent-client-id obj)) - (customer (edit-customer-customer obj)) - (main-address (find-or-add-address (edit-customer-customer obj) 0)) - (billing-address (find-or-add-address (edit-customer-customer obj) 1)) - (address-list ())) - (handler-case - (progn - (log-message :info "PHONE: ~a" (customer-phone1 customer)) - (unless (address-nullp main-address) - (push main-address address-list)) - (unless (address-nullp billing-address) - (push billing-address address-list)) - (setf (customer-addresses customer) address-list) - (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)) - nil)))) - (defgeneric customers-page-find-customers (customers-page))

(defgeneric customers-page-offset-reset (customers-page)) @@ -376,7 +154,11 @@ (div> :static-id result-container-id (table> :class "listTable" (tr> :class "header" - (th> :class "delete" (djcheck-box> :id "deleteAll" :accessor 'customers-page-delete-all :value "all")) + (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) (if (string-equal "asc" sort-direction) "sort sortAsc" @@ -410,7 +192,7 @@ (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" :accessor 'customers-page-delete-items + (th> :class "delete" (djcheck-box> :id "deleteItem" :class "deleteItem" :accessor 'customers-page-delete-items :value (table-id customer) :translator *integer-translator* :multiple t))