[claw-cvs] r103 - trunk/main/claw-demo/src/frontend

achiumenti at common-lisp.net achiumenti at common-lisp.net
Wed Oct 1 11:59:40 UTC 2008


Author: achiumenti
Date: Wed Oct  1 07:59:39 2008
New Revision: 103

Added:
   trunk/main/claw-demo/src/frontend/users.lisp
Log:
several bugfixes and enhancements

Added: trunk/main/claw-demo/src/frontend/users.lisp
==============================================================================
--- (empty file)
+++ trunk/main/claw-demo/src/frontend/users.lisp	Wed Oct  1 07:59:39 2008
@@ -0,0 +1,369 @@
+;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
+;;; $Header: src/frontend/users.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)
+
+(defgeneric users-page-find-users (users-page))
+
+(defgeneric users-page-offset-reset (users-page))
+
+(defgeneric users-page-edit-user (uses-page))
+
+(defgeneric users-page-sorting (users-page))
+
+(defgeneric users-page-delete-users (users-page))
+
+(defclass users-page (db-page) 
+  ((users :initform nil
+              :accessor users-page-users)
+   (current-user :initform (make-instance 'user)
+                     :accessor users-page-current-user)
+   (user-edit-dialog-title :initform "Add new cutomer"
+                               :accessor users-page-user-edit-dialog-title)
+   (users-total-count :initform 0
+                          :accessor users-page-users-total-count)
+   (list-size :initarg :list-size
+              :accessor users-page-list-size)
+   (offset :initform 0
+           :accessor users-page-offset)
+   (surname :initform "*"
+          :accessor users-page-surname)
+   (firstname :initform ""
+          :accessor users-page-firstname)
+   (username :initform ""
+          :accessor users-page-username)
+   (email :initform ""
+          :accessor users-page-email)
+   (active :initform :any
+          :accessor users-page-active)
+   (roles :initform '("user" "guest")
+          :accessor users-page-roles)
+   (sorting-column :initform "surname"
+          :accessor users-page-sorting-column)
+   (sorting-order :initform "asc"
+          :accessor users-page-sorting-order)
+   (delete-all :initform nil
+               :accessor users-page-delete-all)
+   (delete-items :initform nil
+               :accessor users-page-delete-items))
+  (:default-initargs :list-size 20))
+
+(defmethod users-page-offset-reset ((page users-page)) 0)
+
+(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))))
+
+(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") 
+                                                                                   (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") 
+                           (slot-column-name 'user "firstname"))))))
+    (loop for field in fields
+       collect (list field direction))))
+
+(defmethod page-content ((page users-page))
+  (let ((spinner-id (generate-id "spinner"))
+        (form-id (generate-id "usersForm"))
+        (users (users-page-users page))
+        (offset-id (generate-id "offset"))
+        (result-container-id (generate-id "resultContainer"))
+        (edit-user-dialog-container-id (generate-id "userDialogContainer"))
+        (edit-user-dialog-id (generate-id "userDialog"))
+        (edit-user-form-id (generate-id "userForm"))
+        (sorting-column-id (generate-id "sorting-column"))
+        (sorting-order-id (generate-id "sorting-order"))
+        (active-any-id (generate-id "activeAny"))
+        (active-yes-id (generate-id "activeYes"))
+        (active-no-id (generate-id "activeNo"))
+        (edit-user-action-link-id (generate-id "editUser"))
+        (sort-field (users-page-sorting-column page))
+        (sort-direction (users-page-sorting-order page))
+        (all-roles (find-vo 'role :order-by (list (slot-column-name 'role "name")))))
+    (site-template> :title "CLAW Demo anagraphics"
+                    (djfloating-content> :static-id spinner-id
+                                         (img> :alt "spinner"
+                                               :src "docroot/img/spinner.gif"))
+                    (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)))
+                             (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))
+                                        (div> :class "item" (span> :class "username" "Username")
+                                             (djtext-box> :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))
+                                        (div> :class "item active" (span> :class "active" "Active")
+                                              (div> :class "boundBox"
+                                                    (div> (djradio-button> :static-id active-any-id
+                                                                           :name "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" 
+                                                                           :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" 
+                                                                           :translator *threestate-translator*
+                                                                           :accessor 'users-page-active
+                                                                           :value nil)
+                                                          (label> :for active-no-id "No"))))
+                                        (div> :class "item roles" (span> :class "roles" "Roles")
+                                              (div> :class "boundBox"
+                                                    (loop for role in all-roles
+                                                       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) 
+                                                                                     :multiple t)
+                                                                       (label> :for chk-id (role-name role))))))))
+                                   (cinput> :type "hidden"
+                                            :static-id offset-id
+                                            :translator *integer-translator*
+                                            :reader 'users-page-offset-reset
+                                            :writer (attribute-value '(setf users-page-offset)))
+                                   (cinput> :type "hidden"
+                                            :static-id sorting-column-id
+                                            :accessor 'users-page-sorting-column)
+                                   (cinput> :type "hidden"
+                                            :static-id sorting-order-id
+                                            :accessor 'users-page-sorting-order)
+                                   (div> :class "hlistButtons"
+                                         (djsubmit-button> :id "search"
+                                                           :value "Search")
+                                         (djconfirmation-submit> :id "delete"
+                                                                 :value "Delete"
+                                                                 :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) 
+                                                                                     (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))))) 
+                                                                          "Name"))
+                                                (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))))) 
+                                                                           "Username"))
+                                                (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 "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)))
+                                                           (td> (user-username user))
+                                                           (td> (user-email user))
+                                                           (td> :class (if (user-active user)
+                                                                           "active"
+                                                                           "inactive") 
+                                                                (if (user-active user)
+                                                                    "yes"
+                                                                    "no"))
+                                                           (td> (format nil "~{~a~^, ~}" (loop for role in (user-roles user)
+                                                                                         collect (role-name (first role))))))))
+                                   (unless users
+                                     (djcheck-box> :id "deleteItem" 
+                                                   :accessor 'users-page-delete-items 
+                                                   :value 0
+                                                   :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)))))
+                                                   "invisible")
+                                   (pager> :id "pager" 
+                                           :update-component-id offset-id
+                                           :page-size (users-page-list-size page)
+                                           :total-items (users-page-users-total-count page)
+                                           :first-item-offset (users-page-offset page))))
+                    (div> :static-id edit-user-dialog-container-id
+                          (djdialog> :static-id edit-user-dialog-id
+                                     :class "userDialog"
+                                     :title (users-page-user-edit-dialog-title page)
+                                     #|
+                                     (edit-user> :static-id edit-user-form-id
+                                                     :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))))))
+
+(defmethod users-page-delete-users ((page users-page))
+  (let ((user-id-list (users-page-delete-items page))
+        (surname (users-page-surname page))
+        (firstname (users-page-firstname page))
+        (username (user-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)
+    (setf (users-page-delete-items page) ())
+    (multiple-value-bind (users total-size) 
+        (find-users :offset (users-page-offset page)
+                        :limit (users-page-list-size page)
+                        :surname (null-when-empty surname)
+                        :firstname (null-when-empty firstname)
+                        :username username
+                        :email (null-when-empty email)
+                        :active active
+                        :role-names (null-when-empty roles)
+                        :sorting (users-page-sorting page))
+      (setf (users-page-users page) users
+            (users-page-users-total-count page) total-size))))
+
+(defmethod users-page-find-users ((page users-page))
+  (let ((surname (users-page-surname page))
+        (firstname (users-page-firstname page))
+        (username (users-page-username page))
+        (email (users-page-email page))
+        (active (users-page-active page))
+        (roles (users-page-roles page)))
+(log-message :info "èèèè ~a" roles)
+    (multiple-value-bind (users total-size) 
+        (find-users :offset (users-page-offset page)
+                    :limit (users-page-list-size page)
+                    :surname (null-when-empty surname)
+                    :firstname (null-when-empty firstname)
+                    :username (null-when-empty username)
+                    :email (null-when-empty email)
+                    :active active
+                    :role-names roles
+                    :sorting (users-page-sorting page))
+      (log-message :info "xxxx : ~a" users)
+      (setf (users-page-users page) users
+            (users-page-users-total-count page) total-size))))
+
+(defmethod page-before-render ((page users-page))
+  (unless (page-req-parameter page *rewind-parameter*)
+    (multiple-value-bind (users total-size) 
+        (find-users :sorting (users-page-sorting page)
+                        :offset 0
+                        :limit (users-page-list-size page))
+      (setf (users-page-users page) users
+            (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) 
+                                    "users.html")
+
+(lisplet-protect *dojo-demo-lisplet* "users.html" '("administrator" "user"))
+



More information about the Claw-cvs mailing list