[claw-cvs] r23 - in trunk/main/claw-core: src tests
achiumenti at common-lisp.net
achiumenti at common-lisp.net
Sat Mar 29 06:54:21 UTC 2008
Author: achiumenti
Date: Sat Mar 29 01:54:18 2008
New Revision: 23
Modified:
trunk/main/claw-core/src/misc.lisp
trunk/main/claw-core/src/packages.lisp
trunk/main/claw-core/src/tags.lisp
trunk/main/claw-core/src/validators.lisp
trunk/main/claw-core/tests/test1.lisp
Log:
finishing commenting validators forms
corrected some validators quirks
added content type property to page compoenent
Modified: trunk/main/claw-core/src/misc.lisp
==============================================================================
--- trunk/main/claw-core/src/misc.lisp (original)
+++ trunk/main/claw-core/src/misc.lisp Sat Mar 29 01:54:18 2008
@@ -177,7 +177,9 @@
(if ,result
,result
,default-val)))))
-
+
+(defun do-message (key &optional (default "") locale)
+ (funcall (with-message key default locale)))
(defun user-locale (&optional (request *request*) (session *session*))
(let ((locale (when session
Modified: trunk/main/claw-core/src/packages.lisp
==============================================================================
--- trunk/main/claw-core/src/packages.lisp (original)
+++ trunk/main/claw-core/src/packages.lisp Sat Mar 29 01:54:18 2008
@@ -75,6 +75,7 @@
:page-xmloutput
:page-doc-type
:page-current-component
+ :page-content-type
:htclass-body
:htcomponent
:htcomponent-page
@@ -282,6 +283,7 @@
:simple-message-dispatcher
:simple-message-dispatcher-add-message
:with-message
+ :do-message
;;validation
:translator
:translator-integer
Modified: trunk/main/claw-core/src/tags.lisp
==============================================================================
--- trunk/main/claw-core/src/tags.lisp (original)
+++ trunk/main/claw-core/src/tags.lisp Sat Mar 29 01:54:18 2008
@@ -363,7 +363,7 @@
:accessor page-xmloutput :documentation "Determine if the page must be rendered as an XML")
(current-form :initform :nil
:accessor page-current-form :documentation "During the rewinding phase the form or the action-link whose action has been fired")
- (content-type :initarg :doc-type
+ (doc-type :initarg :doc-type
:accessor page-doc-type :documentation "The DOCUMENT TYPE of the page (default to HTML 4.01 STRICT)")
(lasttag :initform nil
:accessor page-lasttag :documentation "Last rendered tag. Needed for page output rendering")
@@ -372,7 +372,10 @@
(request-parameters :initarg :request-parameters)
(components-stack :initform nil
:accessor page-components-stack
- :documentation "A stack of components enetered into rendering process.")
+ :documentation "A stack of components enetered into rendering process.")
+ (content-type :initarg :content-type
+ :accessor page-content-type
+ :documentation "Define the content type of the page when rendered")
(url :initarg :url
:accessor page-url :documentation "The URL provided with this page instance"))
(:default-initargs :writer t
@@ -386,6 +389,7 @@
:xmloutput nil
:doc-type *html-4.01-strict*
:request-parameters nil
+ :content-type hunchentoot:*default-content-type*
:url nil)
(:documentation "A page object holds claw components to be rendered") )
@@ -585,6 +589,7 @@
(defmethod page-render ((page page))
(let ((body (page-content page))
(jsonp (page-json-id-list page)))
+ (setf (hunchentoot:content-type) (page-content-type page))
(if (null body)
(format nil "null body for page ~a~%" (type-of page))
(progn
@@ -802,8 +807,6 @@
(htcomponent-json-print-start-component tag))
(when (or (page-can-print page) previous-print-status)
(tag-render-starttag tag page))
- (when (string-equal "messaged" (htcomponent-client-id tag))
- (log-message :info "RENDEING ~a: body ~a" (htcomponent-client-id tag) body-list))
(dolist (child-tag body-list)
(when child-tag
(cond
@@ -822,6 +825,7 @@
(let ((body-list (htcomponent-body hthead))
(injections (page-init-injections page)))
(tag-render-starttag hthead page)
+ (htcomponent-render (meta> :http-equiv "Content-Type" :content (page-content-type page)) page)
(dolist (child-tag body-list)
(when child-tag
(cond
Modified: trunk/main/claw-core/src/validators.lisp
==============================================================================
--- trunk/main/claw-core/src/validators.lisp (original)
+++ trunk/main/claw-core/src/validators.lisp Sat Mar 29 01:54:18 2008
@@ -33,7 +33,7 @@
(:documentation "Encodes the input component value, used when rendering the component"))
(defgeneric translator-decode (translator wcomponent)
- (:documentation "Decodes the input component value"))
+ (:documentation "Decodes the input component value after a form submit."))
(defclass translator ()
()
@@ -59,30 +59,38 @@
(declare (ignore client-id))
new-value))
-(defvar *simple-translator* (make-instance 'translator))
+(defvar *simple-translator* (make-instance 'translator)
+ "*SIMPLE-TRANSLATOR* is the default translator for any CINPUT component.
+Its encoder and decoder methods pass values unchanged")
(defclass translator-integer (translator)
((thousand-separator :initarg :thousand-separator
- :reader translator-thousand-separator)
+ :reader translator-thousand-separator
+ :documentation "If specified (as character), it is the thousands separator. Despite of
+its name, grouping is done following the TRANSLATOR-GROUPING-SIZE, so it's not a real 'tousands' separator")
(always-show-signum :initarg :always-show-signum
- :reader translator-always-show-signum)
+ :reader translator-always-show-signum
+ :documentation "When true the signum is used also for displaying positive numbers.")
(grouping-size :initarg :grouping-size
- :reader translator-grouping-size))
+ :reader translator-grouping-size
+ :documentation "Used only if TRANSLATOR-THOUSAND-SEPARATOR is defined. Default to 3"))
(:default-initargs :thousand-separator nil
+ :grouping-size 3
:always-show-signum nil)
- (:documentation "a translator object encodes and decodes integer values passed to a html input component"))
+ (:documentation "A translator object encodes and decodes integer values passed to a html input component"))
(defmethod translator-encode ((translator translator-integer) (wcomponent wcomponent))
(let* ((page (htcomponent-page wcomponent))
(visit-object (wcomponent-parameter-value wcomponent :visit-object))
(accessor (wcomponent-parameter-value wcomponent :accessor))
(reader (wcomponent-parameter-value wcomponent :reader))
+ (grouping-size (translator-grouping-size translator))
(thousand-separator (translator-thousand-separator translator))
(signum-directive (if (translator-always-show-signum translator)
"@"
""))
(control-string (if thousand-separator
- (format nil "~~3,' ,v:~aD" signum-directive)
+ (format nil "~~~d,' ,v:~aD" grouping-size signum-directive)
(format nil "~~~ad" signum-directive)))
(value (page-req-parameter page (htcomponent-client-id wcomponent) nil)))
@@ -109,21 +117,19 @@
;;=========================================
-(defclass translator-number (translator)
- ((thousand-separator :initarg :thousand-separator
- :reader translator-thousand-separator)
- (decimals-separator :initarg :decimals-separator
- :reader translator-decimals-separator)
+(defclass translator-number (translator-integer)
+ ((decimals-separator :initarg :decimals-separator
+ :reader translator-decimals-separator
+ :documentation "The decimal separator of the rendered number. Default to #\.")
(decimal-digits :initarg :decimal-digits
- :reader translator-decimal-digits)
- (always-show-signum :initarg :always-show-signum
- :reader translator-always-show-signum)
+ :reader translator-decimal-digits
+ :documentation "force the rendering of the value to a fixed number of decimal digits")
(coerce :initarg :coerce
- :accessor translator-coerce))
- (:default-initargs :thousand-separator nil :decimals-separator #\.
+ :accessor translator-coerce
+ :documentation "Coerces the decoded input value to the given value type"))
+ (:default-initargs :decimals-separator #\.
;:integer-digits nil
- :decimal-digits nil
- :always-show-signum nil
+ :decimal-digits nil
:coerce 'ratio)
(:documentation "a translator object encodes and decodes integer values passed to a html input component"))
@@ -134,13 +140,14 @@
(accessor (wcomponent-parameter-value wcomponent :accessor))
(reader (wcomponent-parameter-value wcomponent :reader))
(thousand-separator (translator-thousand-separator translator))
+ (grouping-size (translator-grouping-size translator))
(decimal-digits (translator-decimal-digits translator))
(decimals-separator (translator-decimals-separator translator))
(signum-directive (if (translator-always-show-signum translator)
"@"
""))
(integer-control-string (if thousand-separator
- (format nil "~~3,' ,v:~aD" signum-directive)
+ (format nil "~~~d,' ,v:~aD" grouping-size signum-directive)
(format nil "~~~ad" signum-directive)))
(value (page-req-parameter page (htcomponent-client-id wcomponent) nil)))
@@ -180,15 +187,20 @@
(declare (ignore client-id))
(when thousand-separator
(setf new-value (regex-replace-all (format nil "~a" thousand-separator) new-value "")))
- (let ((decomposed-string (all-matches-as-strings "[0-9]+" new-value)))
- (setf int-value (parse-integer (concatenate 'string (first decomposed-string) (second decomposed-string))))
- (setf dec-value (expt 10 (length (second decomposed-string))))
- (coerce (/ int-value dec-value) type)))))
+ (let ((decomposed-string (all-matches-as-strings "[0-9]+" new-value))
+ (result))
+ (setf int-value (parse-integer (concatenate 'string (first decomposed-string) (second decomposed-string)))
+ dec-value (expt 10 (length (second decomposed-string)))
+ result (/ int-value dec-value))
+ (if (integerp result)
+ result
+ (coerce result type))))))
;;----------------------------------------------------------------------------------------
(defun add-exception (id reason)
+"Adds an exception for the given input component identified by its ID with the message expressed by REASON"
(let* ((validation-errors (aux-request-value :validation-errors))
(component-exceptions (assoc id validation-errors :test #'equal)))
(if component-exceptions
@@ -199,6 +211,7 @@
(defun validate (test &key component message)
+"When test is nil, an exception message given by MESSAGE is added for the COMPONENT. See: ADD-EXCEPTION..."
(let ((client-id (htcomponent-client-id component)))
(unless test
(add-exception client-id message))))
@@ -213,12 +226,19 @@
(assoc client-id (validation-errors request) :test #'equal)))
(defun validator-required (component value)
+ "Checks if the required input field VALUE is present. If not, a localizable message \"Field ~a may not be null.\" is sent with key \"VALIDATOR-REQUIRED\".
+The argument for the message will be the :label attribute of the COMPONENT."
(when (stringp value)
(validate (and value (string-not-equal value ""))
:component component
- :message (format nil "Field ~a may not be null." (wcomponent-parameter-value component :label)))))
+ :message (format nil (do-message "VALIDATOR-REQUIRED" "Field ~a may not be null.") (wcomponent-parameter-value component :label)))))
(defun validator-size (component value &key min-size max-size)
+"Checks if the input field VALUE legth is less then or greater then rispectively of the form keywords :MIN-SIZE and :MAX-SIZE.
+If less then :MIN-SIZE, a localizable message \"Size of ~a may not be less then ~a chars.\" is sent with key \"VALIDATOR-SIZE-MIN\".
+The argument for the message will be the :label attribute of the COMPONENT and the :MIN-ZIZE value.
+If greater then :MAX-SIZE, a localizable message \"Size of ~a may not be more then ~a chars\" is sent with key \"VALIDATOR-SIZE-MAX\".
+The argument for the message will be the :label attribute of the COMPONENT and the :MAX-ZIZE value."
(let ((value-len 0))
(when value
(setf value (format nil "~a" value))
@@ -227,22 +247,27 @@
(when min-size
(validate (>= value-len min-size)
:component component
- :message (format nil "Size of ~a may not be less then ~a"
+ :message (format nil (do-message "VALIDATOR-SIZE-MIN" "Size of ~a may not be less then ~a chars." )
(wcomponent-parameter-value component :label)
min-size)))
(when max-size
(validate (<= value-len max-size)
:component component
- :message (format nil "Size of ~a may not be more then ~a"
+ :message (format nil (do-message "VALIDATOR-SIZE-MAX" "Size of ~a may not be more then ~a chars." )
(wcomponent-parameter-value component :label)
max-size)))))))
(defun validator-range (component value &key min max)
+"Checks if the numeric input field VALUE is less then or greater then rispectively of the form keywords :MIN and :MAX.
+If less then :MIN, a localizable message \"Field ~a is not less then or equal to ~d.\" is sent with key \"VALIDATOR-RANGE-MIN\".
+The argument for the message will be the :label attribute of the COMPONENT and the :MIN value.
+If greater then :MIN, a localizable message \"Field ~a is not greater then or equal to ~d.\" is sent with key \"VALIDATOR-RANGE-MAX\".
+The argument for the message will be the :label attribute of the COMPONENT and the :MAX value."
(when value
(or (when min
(validate (>= value min)
:component component
- :message (format nil "Field ~a is not greater then or equal to ~d"
+ :message (format nil (do-message "VALIDATOR-RANGE-MIN" "Field ~a is not greater then or equal to ~d")
(wcomponent-parameter-value component :label)
(if (typep min 'ratio)
(coerce min 'float)
@@ -250,26 +275,32 @@
(when max
(validate (<= value max)
:component component
- :message (format nil "Field ~a is not less then or equal to ~d"
+ :message (format nil (do-message "VALIDATOR-RANGE-MAX" "Field ~a is not less then or equal to ~d")
(wcomponent-parameter-value component :label)
(if (typep max 'ratio)
(coerce max 'float)
max)))))))
(defun validator-number (component value &key min max)
+"Checks if the input field VALUE is a valid number and then passes the validation to VALIDATION-RANGE.
+If not a number, a localizable message \"Field ~a is not a valid number.\" is sent with key \"VALIDATOR-NUMBER\".
+The argument for the message will be the :label attribute of the COMPONENT."
(when value
(let ((test (numberp value)))
(or (validate test
:component component
- :message (format nil "Field ~a is not a valid number" (wcomponent-parameter-value component :label)))
+ :message (format nil (do-message "VALIDATOR-NUMBER" "Field ~a is not a valid number.") (wcomponent-parameter-value component :label)))
(validator-range component value :min min :max max)))))
(defun validator-integer (component value &key min max)
+"Checks if the input field VALUE is a valid number and then passes the validation to VALIDATION-RANGE.
+If not a number, a localizable message \"Field ~a is not a valid integer.\" is sent with key \"VALIDATOR-INTEGER\".
+The argument for the message will be the :label attribute of the COMPONENT."
(when value
(let ((test (integerp value)))
(or (validate test
:component component
- :message (format nil "Field ~a is not a valid integer" (wcomponent-parameter-value component :label)))
+ :message (format nil (do-message "VALIDATOR-INTEGER" "Field ~a is not a valid integer.") (wcomponent-parameter-value component :label)))
(validator-range component value :min min :max max)))))
Modified: trunk/main/claw-core/tests/test1.lisp
==============================================================================
--- trunk/main/claw-core/tests/test1.lisp (original)
+++ trunk/main/claw-core/tests/test1.lisp Sat Mar 29 01:54:18 2008
@@ -29,6 +29,8 @@
(in-package :claw-tests)
+(setf *default-content-type* "text/html; charset=UTF-8")
+
(setf *rewrite-for-session-urls* nil)
(defvar *this-file* (load-time-value
(or #.*compile-file-pathname* *load-pathname*)))
@@ -40,9 +42,13 @@
(simple-message-dispatcher-add-message *lisplet-messages* "en" "NAME" "Name")
(simple-message-dispatcher-add-message *lisplet-messages* "en" "SURNAME" "Surname")
+(simple-message-dispatcher-add-message *lisplet-messages* "en" "WELCOME" "Welcome")
(simple-message-dispatcher-add-message *lisplet-messages* "it" "NAME" "Nome")
(simple-message-dispatcher-add-message *lisplet-messages* "it" "SURNAME" "Cognome")
+(simple-message-dispatcher-add-message *lisplet-messages* "it" "WELCOME" "Benvenuto")
+
+(simple-message-dispatcher-add-message *lisplet-messages* "it" "VALIDATOR-REQUIRED" "Il campo ~a non può essere vuoto!")
(defvar *test-lisplet*)
(setf *test-lisplet* (make-instance 'lisplet :realm "test1" :base-path "/test"
@@ -56,8 +62,8 @@
(defparameter *clawserver* (make-instance 'clawserver :port 4242 :sslport 4445
:mod-lisp-p nil
- :ssl-certificate-file #P"/home/kiuma/pem/cacert.pem"
- :ssl-privatekey-file #P"/home/kiuma/pem/privkey.pem"))
+ :ssl-certificate-file #P"/home/kiuma/pem/cacert.pem"
+ :ssl-privatekey-file #P"/home/kiuma/pem/privkey.pem"))
(setf (lisplet-redirect-protected-resources-p *test-lisplet*) t)
@@ -256,7 +262,8 @@
((username :initform ""
:accessor login-page-username)
(passowrd :initform ""
- :accessor login-page-password)))
+ :accessor login-page-password))
+ (:default-initargs :message-dispatcher *lisplet-messages*))
(defmethod page-content ((login-page login-page))
(let ((princp (current-principal)))
@@ -280,7 +287,7 @@
(td> :colspan "2"
(csubmit> :id "submit" :value "Login")))))
(p>
- "Welcome "
+ (with-message "WELCOME" "WELCOME") " "
(principal-name princp)
(a> :href "index.html" "home"))))))
More information about the Claw-cvs
mailing list