[claw-cvs] r102 - trunk/main/claw-demo/src/frontend
achiumenti at common-lisp.net
achiumenti at common-lisp.net
Wed Oct 1 11:59:17 UTC 2008
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))
More information about the Claw-cvs
mailing list