Author: achiumenti Date: Fri Dec 26 07:24:28 2008 New Revision: 168 Log: api doumentation bugfix javascript files injection logic bugfix realm changed from STRING->SYMBOL (thx to madnificent) Modified: trunk/main/claw-as/src/lisplet.lisp trunk/main/claw-as/src/server.lisp trunk/main/claw-demo/src/frontend/main.lisp trunk/main/claw-html.dojo/src/djbody.lisp trunk/main/claw-html/src/components.lisp trunk/main/claw-html/src/meta.lisp trunk/main/claw-html/src/tags.lisp trunk/main/claw-html/src/translators.lisp trunk/main/claw-html/src/validators.lisp Modified: trunk/main/claw-as/src/lisplet.lisp ============================================================================== --- trunk/main/claw-as/src/lisplet.lisp (original) +++ trunk/main/claw-as/src/lisplet.lisp Fri Dec 26 07:24:28 2008 @@ -101,7 +101,7 @@ :documentation "url location for the welcome page") (realm :initarg :realm :reader lisplet-realm - :documentation "realm for requests that pass through this lisplet and session opened into this lisplet") + :documentation "realm for requests that pass through this lisplet and session opened into this lisplet. Must be a symbol") (pages :initform nil :accessor lisplet-pages :documentation "A collection of cons where the car is an url location and the cdr is a dispatcher") @@ -117,7 +117,7 @@ (:default-initargs :server-address *claw-default-server-address* :welcome-page nil :login-page nil - :realm "claw" + :realm 'claw :redirect-protected-resources-p nil) (:documentation "A lisplet is a container for resources provided trhough the claw-server. It is similar, for purposes, to a JAVA servlet")) Modified: trunk/main/claw-as/src/server.lisp ============================================================================== --- trunk/main/claw-as/src/server.lisp (original) +++ trunk/main/claw-as/src/server.lisp Fri Dec 26 07:24:28 2008 @@ -241,7 +241,7 @@ ;;------------------------------------------------------------ (defgeneric claw-server-register-configuration(claw-server realm configuration) - (:documentation "Registers a configuration object for the given realm into the server. The configuration + (:documentation "Registers a configuration object for the given realm symbol into the server. The configuration will perform the authentication logic.")) (defclass claw-server () @@ -272,8 +272,9 @@ (login-config :initform (make-hash-table :test 'equal) :accessor claw-server-login-config :documentation "An hash table holding a pair of realm, -expressed as string, and a function. The function should take two arguments (login and password), and return a principal instance if the login call -succeeds.") +expressed as pairs of symbol-function. +The function should take two arguments (username and password), and should return a principal instance if the login call succeeds. +") (lisplets :initform nil :accessor claw-server-lisplets :documentation "A collection of cons where the car is an url location where a lisplet is registered and the cdr is the lisplet")) Modified: trunk/main/claw-demo/src/frontend/main.lisp ============================================================================== --- trunk/main/claw-demo/src/frontend/main.lisp (original) +++ trunk/main/claw-demo/src/frontend/main.lisp Fri Dec 26 07:24:28 2008 @@ -61,7 +61,7 @@ (claw-server-register-lisplet *dojo-claw-server* *dojo-demo-lisplet*) -(claw-server-register-configuration *dojo-claw-server* "demo" (make-instance 'demo-configuration)) +(claw-server-register-configuration *dojo-claw-server* 'demo (make-instance 'demo-configuration)) (let ((path (make-pathname :directory (append (pathname-directory *main-file*) '("docroot")))) (*claw-server* *dojo-claw-server*)) Modified: trunk/main/claw-html.dojo/src/djbody.lisp ============================================================================== --- trunk/main/claw-html.dojo/src/djbody.lisp (original) +++ trunk/main/claw-html.dojo/src/djbody.lisp Fri Dec 26 07:24:28 2008 @@ -112,10 +112,10 @@ (defmethod wcomponent-after-prerender ((obj djbody) (pobj page)) - (let ((scripts (page-instance-initscripts pobj))) + (let ((scripts (page-initscripts pobj))) ;;remember that scripts are in reverse order (when scripts - (push "});" (page-instance-initscripts pobj)) + (push "});" (page-initscripts pobj)) (nconc scripts (list "dojo.addOnLoad\(function\() {"))))) Modified: trunk/main/claw-html/src/components.lisp ============================================================================== --- trunk/main/claw-html/src/components.lisp (original) +++ trunk/main/claw-html/src/components.lisp Fri Dec 26 07:24:28 2008 @@ -30,7 +30,8 @@ (in-package :claw-html) (defvar *id-and-static-id-description* "- :ID The htcomponent-client-id value. CLAW can transform its value to make it univocal -- :STATIC-ID Like the :ID parameter, it sets the htcomponent-client-id instance property, but CLAW will not manage its value to manage its univocity." "Description used for describing :ID and :STATIC-ID used in claw component init functions documentation +- :STATIC-ID Renders the id tag attribute, but the value is not managed as for the :ID keyword." +"Description used for describing :ID and :STATIC-ID used in claw component init functions documentation ") (defgeneric cform-rewinding-p (obj page-obj) @@ -55,7 +56,17 @@ ;-------------------------------------------------------------------------------- - +(defgeneric action (_cform) + (:documentation "Returns the action function for _CFORM subclasses +")) + +(defgeneric action-object (_cform) + (:documentation "Returns the object that will be applied to the ACTION function for a _CFORM subclass. +")) + +(defgeneric form-method (_cform) + (:documentation "Returns the method used to submit a <form> tag. +This should be \"get\" or \"post\".")) (defclass _cform (wcomponent) ((action :initarg :action @@ -63,7 +74,7 @@ :documentation "Function performed after user submission") (action-object :initarg :action-object :accessor action-object - :documentation "The object that will be applied to the ACTION property") + :documentation "The object that will be applied to the ACTION accessor") (css-class :initarg :class :reader css-class :documentation "The html CLASS attribute") @@ -79,7 +90,7 @@ (defclass _cform-mixin (_cform) ((validator :initarg :validator :reader validator - :documentation "A function that accept the passed component value during submission and performs the validation logic calling the validator functions.")) + :documentation "A function that accept the passed component value during submission and performs the validation logic.")) (:default-initargs :validator nil) (:documentation "Internal use component")) @@ -170,6 +181,10 @@ (setf (page-current-form pobj) nil)) ;-------------------------------------------------------------------------------- +(defgeneric action-link-parameters (action-link) + (:documentation "A function that returns an ALIST of strings for optional request get parameters. +")) + (defclass action-link (_cform-mixin) ((parameters :initarg :parameters :reader action-link-parameters @@ -207,6 +222,14 @@ (defgeneric translated-value (base-cinput) (:documentation "Returns the component value using its translator")) +(defgeneric cinput-result-as-list-p (base-cinput) + (:documentation "When not nil the associated request parameter will ba a list for the passed component +")) + +(defgeneric css-class (base-cinput) + (:documentation "Returns the html component class attribute for the given BASE-CINPUT +")) + (defclass base-cinput (wcomponent) ((result-as-list-p :initarg :multiple :accessor cinput-result-as-list-p @@ -227,7 +250,7 @@ :documentation "A validator instance that encodes and decodes input values to and from the visit object mapped property") (validator :initarg :validator :reader validator - :documentation "A function that accept the passed component value during submission and performs the validation logic calling the validator functions.") + :documentation "A function that accept the passed component value during submission and performs the validation logic.") (visit-object :initarg :visit-object :reader cinput-visit-object :documentation "The object hoding the property mapped to the current input html component. When nil the owner page is used.") @@ -381,6 +404,9 @@ (describe-component-behaviour class)))) ;--------------------------------------------------------------------------------------- +(defgeneric csubmit-value (csubmit) + (:documentation "Returns the value used by the CSUBMIT component.")) + (defclass csubmit (_cform) ((value :initarg :value :reader csubmit-value @@ -486,6 +512,10 @@ ;-------------------------------------------------------------------------------------------- +(defgeneric ccheckbox-value (ccheckbox) + (:documentation "A function that returns the value when the checkbox is selected. +")) + (defclass ccheckbox (cinput) ((test :initarg :test :accessor ccheckbox-test) @@ -494,7 +524,8 @@ (:metaclass metacomponent) (:default-initargs :reserved-parameters () :empty t :type "checkbox" :test #'equal :multiple t) (:documentation "Request cycle aware component the renders as an INPUT tag class. IMPORTANT its assigned id mus be unique -since its NAME tag attribute will be extracted from the assigned id and not from the generate one as for other cinput components")) +since its NAME tag attribute will be extracted from the assigned id and not from the generate one as for other cinput components +")) (defmethod name-attr ((cinput ccheckbox)) Modified: trunk/main/claw-html/src/meta.lisp ============================================================================== --- trunk/main/claw-html/src/meta.lisp (original) +++ trunk/main/claw-html/src/meta.lisp Fri Dec 26 07:24:28 2008 @@ -70,7 +70,7 @@ "Returns the behaviour descrioption of a WCOMPONENT init function. If it allows informal parameters, body and the reserved parameters" (let* ((initargs (closer-mop:class-default-initargs class)) (reserved-parameters (find-first-classdefault-initarg-value initargs :reserved-parameters))) - (format nil "Allows informal parameters: ~a~%Allows body: ~a~%Reserved parameters: ~a" + (format nil "Allows informal parameters: ~a~%Allows body: ~a~%Reserved parameters: ~a~%" (if (find-first-classdefault-initarg-value initargs :allow-informal-parameters) "Yes" "No") Modified: trunk/main/claw-html/src/tags.lisp ============================================================================== --- trunk/main/claw-html/src/tags.lisp (original) +++ trunk/main/claw-html/src/tags.lisp Fri Dec 26 07:24:28 2008 @@ -37,58 +37,71 @@ all valuse given to param NAME is returned. - PAGE is the page instance that must be given. - NAME The parameter to search - - AS-LIST If true the result is returned as list, if false as string. Default: false")) + - AS-LIST If true the result is returned as list, if false as string. Default: false +")) (defgeneric page-json-id-list (page) (:documentation "This internal method is called to get a list of all the components by their id, that must be updated when an xhr request is sent from the browser. - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric page-json-prefix (page) (:documentation "This internal method is called to get a prefix to prepend to a json reply when needed. - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric page-json-suffix (page) (:documentation "This internal method is called to get a suffix to append to a json reply when needed. - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric page-content (page) (:documentation "This method returns the page content to be redered. - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric page-init (page) (:documentation "Internal method for page initialization. - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric page-render (page) (:documentation "This method is the main method fired from the framework to render the desired page and to handle all the request cycle. - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric page-before-render (page) (:documentation "This method is called as first instruction of PAGE-RENDER. - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric page-init-injections (page) (:documentation "This internal method is called during the request cycle phase to reset page slots that must be reinitialized during sub-phases (rewinding, pre-rendering, rendering). - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric page-render-headings (page) (:documentation "This internal method renders the html first lines that determine if the page is a html or a xhtml, along with the schema definition. - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric page-request-parameters (page) (:documentation "This internal method builds the get and post parameters into an hash table. -Parameters are collected as lists so that this method can collect parameters that appear moter then once.")) +Parameters are collected as lists so that this method can collect parameters that appear moter then once. +")) (defgeneric page-print-tabulation (page) (:documentation "This internal method is called during the rendering phase if tabulation is enabled. It writes the right amount of tabs chars to indent the page. - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric page-newline (page) (:documentation "This internal method simply writes the rest of page content on a new line when needed. - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric page-format (page str &rest rest) (:documentation "This internal method is the replacement of the FORMAT function. It is aware @@ -97,7 +110,8 @@ - PAGE is the page instance that must be given - STR The format control - REST The format arguments -See http://www.lisp.org/HyperSpec/Body/fun_format.html#format for more info.")) +See http://www.lisp.org/HyperSpec/Body/fun_format.html#format for more info. +")) (defgeneric page-format-raw (page str &rest rest) (:documentation "This internal method is the replacement of the FORMAT. @@ -106,7 +120,8 @@ - PAGE is the page instance that must be given - STR The format control - REST The format arguments -See http://www.lisp.org/HyperSpec/Body/fun_format.html#format for more info.")) +See http://www.lisp.org/HyperSpec/Body/fun_format.html#format for more info. +")) (defgeneric page-body-initscripts (page) (:documentation "During the render phase wcomponent instances inject their initialization scripts (javascript) @@ -114,13 +129,15 @@ This internal method is called to render these scripts. The result is used by the HTBODY-INITSCRIPTS-TAG method that generates a <script> tag that will be appended at the end of the <body> tag (generated by the BODY> function tag. - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric htbody-initscripts-tag (page &optional on-load) (:documentation "Encloses the init inscance scripts injected into the page into a <script> tag component See PAGE-BODY-INITSCRIPTS form more info. If the ON-LOAD parameter it not nil, then the script will be executed on the onload document event. - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric page-current-component (page) (:documentation "The component being processed into one of the rendering phases")) @@ -129,49 +146,58 @@ (:documentation "This internal method is the first called during the request cycle phase. It is evaluated when a form action or an action-link action is fired. It is used to update all visit objects slots. - HTCOMPONENT is the htcomponent instance that must be rewound - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric htcomponent-prerender (htcomponent page) (:documentation "This internal method is the second sub phase during the request cycle phase. It is used to inject all wcomponent class scripts and stylesheets into the owner page. - HTCOMPONENT is the htcomponent instance that must be prerendered - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric htcomponent-render (htcomponent page) (:documentation "This internal method is the last called during the request cycle phase. It is used to effectively render the component into the page. - HTCOMPONENT is the htcomponent instance that must be rendered - - PAGE is the page instance that must be given")) + - PAGE is the page instance that must be given +")) (defgeneric htcomponent-can-print (htcomponent) (:documentation "This internal method is used in an xhr call to determine if a component may be rendered into the reply - - HTCOMPONENT is the htcomponent instance")) + - HTCOMPONENT is the htcomponent instance +")) (defgeneric htcomponent-json-print-start-component (htcomponent) (:documentation "Internal method called to render the json reply during the render cycle phase on component start. - - HTCOMPONENT is the htcomponent instance")) + - HTCOMPONENT is the htcomponent instance +")) (defgeneric htcomponent-json-print-end-component (htcomponent) (:documentation "Internal method called to render the json reply during the render cycle phase on component end. - - HTCOMPONENT is the htcomponent instance")) + - HTCOMPONENT is the htcomponent instance +")) (defgeneric tag-render-starttag (tag page) (:documentation "Internal method to print out the opening html tag during the render phase - TAG is the tag instance - - PAGE the page instance")) + - PAGE the page instance +")) (defgeneric tag-render-endtag (tag page) (:documentation "Internal method to print out the closing html tag during the render phase - TAG is the tag instance - - PAGE the page instance")) + - PAGE the page instance +")) (defgeneric tag-render-attributes (tag page) (:documentation "Internal method to print out the attributes of an html tag during the render phase - TAG is the tag instance - - PAGE the page instance")) + - PAGE the page instance +")) (defgeneric tag-attributes (tag) (:documentation "Returns an alist of tag attributes")) @@ -180,44 +206,55 @@ (:documentation "Internal method to set the component owner page and to assign an unique id attribute when provided. - HTCOMPONENT is the tag instance - - PAGE the page instance")) + - PAGE the page instance +")) (defgeneric (setf slot-initialization) (value wcomponent slot-initarg) - (:documentation "Sets a slot by its :INITARG. It's used just after instance creation")) + (:documentation "Sets a slot by its :INITARG. It's used just after instance creation +")) (defgeneric wcomponent-created (wcomponent) - (:documentation "Method called just before the make-component function exits. Do additional instance initialization here.")) + (:documentation "Method called just before the make-component function exits. Do additional instance initialization here. +")) (defgeneric wcomponent-before-rewind (wcomponent page) (:documentation "Method called by the framework before the rewinding phase. It is intended to be eventually overridden in descendant classes. - WCOMPONENT is the tag instance - - PAGE the page instance")) + - PAGE the page instance +")) (defgeneric wcomponent-after-rewind (wcomponent page) (:documentation "Method called by the framework after the rewinding phase. It is intended to be eventually overridden in descendant classes. - WCOMPONENT is the tag instance - - PAGE the page instance")) + - PAGE the page instance +")) (defgeneric wcomponent-before-prerender (wcomponent page) (:documentation "Method called by the framework before the pre-rendering phase. It is intended to be eventually overridden in descendant classes. - WCOMPONENT is the tag instance - - PAGE the page instance")) + - PAGE the page instance +")) (defgeneric wcomponent-after-prerender (wcomponent page) (:documentation "Method called by the framework after the pre-rendering phase. It is intended to be eventually overridden in descendant classes. - WCOMPONENT is the tag instance - - PAGE the page instance")) + - PAGE the page instance +")) + (defgeneric wcomponent-before-render (wcomponent page) (:documentation "Method called by the framework before the rendering phase. It is intended to be eventually overridden in descendant classes. - WCOMPONENT is the tag instance - - PAGE the page instance")) + - PAGE the page instance +")) (defgeneric wcomponent-after-render (wcomponent page) (:documentation "Method called by the framework after the rendering phase. It is intended to be eventually overridden in descendant classes. - WCOMPONENT is the tag instance - - PAGE the page instance")) + - PAGE the page instance +")) (defgeneric wcomponent-template (wcomponent) - (:documentation "The component template. What gives to each wcomponent its unique aspect and features")) + (:documentation "The component template. What gives to each wcomponent its unique aspect and features +")) (defgeneric simple-message-dispatcher-add-message (simple-message-dispatcher locale key value) (:documentation "Adds a key value pair to a given locale for message translation")) @@ -253,32 +290,39 @@ "List of html empty tags") (defvar *validation-errors* nil - "A plist where key is a component id and value is a list of validation error messages related to that component.") + "A plist where key is a component id and value is a list of validation error messages related to that component. +") (defvar *validation-compliances* nil - "List of component id that pass the validation") + "List of component id that pass the validation +") (defvar *claw-current-page* nil - "The CLAW page currently rendering") + "The CLAW page currently rendering +") (defvar *id-table-map* (make-hash-table :test 'equal) "Holds an hash table of used components/tags id as keys and the number of their occurrences as values. So if you have a :id \"compId\" given to a previous component, the second -time this id will be used, it will be rendered as \"compId_1\", the third time will be \"compId_2\" and so on") +time this id will be used, it will be rendered as \"compId_1\", the third time will be \"compId_2\" and so on +") (defvar *simple-translator* nil "*SIMPLE-TRANSLATOR* is the default translator for any CINPUT component. -Its encoder and decoder methods pass values unchanged") +Its encoder and decoder methods pass values unchanged +") (defvar *file-translator* nil "*FILE-TRANSLATOR* is the default translator for any CINPUT component of type \"file\".") (defstruct list-for-tag-attribute - "Since tag attributes values are flattened, it is impossible to pass lists as values. Use this struct to pass lists to values" + "Since tag attributes values are flattened, it is impossible to pass lists as values. Use this struct to pass lists to values +" (value nil)) (defun attribute-value (value) - "Creates an unflattenable value for tag attributes. This is particularly useful when you need to pass a list as an attribute value" + "Creates an unflattenable value for tag attributes. This is particularly useful when you need to pass a list as an attribute value +" (make-list-for-tag-attribute :value value)) (defmacro when-let ((var form) &body body) @@ -328,7 +372,8 @@ (defun generate-id (id) "This function is very useful when having references to components id inside component body. -When used with :STATIC-ID the generated id will be mantained as is, and rendered just like the :ID tag attribute." +When used with :STATIC-ID the generated id will be mantained as is, and rendered just like the :ID tag attribute. +" (let* ((id-ht *id-table-map*) (client-id-index (gethash id id-ht 0)) (result)) @@ -342,8 +387,9 @@ "This function is used to create a tag object instance - TAG-NAME the a string tag name to create, for example \"span\" - PARENT the parent class. usually TAG -- EMPTYP determines if the tag must be rendered as an empty tag during the request cycle phase. -- REST a list of attribute/value pairs and the component body" +- EMPTYP determines if the tag must be rendered as an empty tag during the request cycle phase +- REST a list of attribute/value pairs and the component body +" (let* ((fbody (parse-htcomponent-function (flatten rest))) (id-table-map *id-table-map*) (attributes (first fbody)) @@ -374,7 +420,8 @@ (defun generate-tagf (tag-name emptyp) "Internal function that generates an htcomponent creation function from the component class name - TAG-NAME the symbol class name of the component -- EMPTYP determines if the tag must be rendered as an empty tag during the request cycle phase." +- EMPTYP determines if the tag must be rendered as an empty tag during the request cycle phase. +" (let ((fsymbol (intern (format nil "~a>" (string-upcase tag-name))))) (setf (fdefinition fsymbol) #'(lambda (&rest rest) (build-tagf tag-name 'tag emptyp rest))) @@ -421,7 +468,8 @@ (json-component-id-list :initform () :accessor page-json-component-id-list :documentation "The current component that will ber rendered into json reply object in an xhr call.") (request-parameters :initarg :request-parameters - :documentation "This slot is used to avoid PAGE-REQUEST-PARAMETERS multimple computations, saving the result of this function on the first call and then using the cached value.") + :documentation "This slot is used to avoid PAGE-REQUEST-PARAMETERS multimple computations, saving the result of this function on the first call and then using the cached value. +") (post-parameters :initarg :post-parameters :reader page-post-parameters :documentation "http request post parameters") @@ -473,7 +521,8 @@ (json-render-on-validation-errors-p :initarg :json-render-on-validation-errors-p :reader htcomponent-json-render-on-validation-errors-p :documentation "If from submission contains exceptions and the value is not nil, the component is rendered into the xhr json reply. -If the value is T then component will be rendered on any error, if it's a tag id string it will be rendere only when the rewind parameter will match") +If the value is T then component will be rendered on any error, if it's a tag id string it will be rendere only when the rewind parameter will match +") (body :initarg :body :accessor htcomponent-body :documentation "The tag body") (client-id :initarg :client-id @@ -1148,6 +1197,16 @@ js))) ;;;========= WCOMPONENT =================================== + +(defgeneric wcomponent-allow-informal-parametersp (wcomponent) + (:documentation "Returns T if the component accepts informal parameters for the generated tag function. +Informal parameters are the ones not defined as slot initargs for the wcomponent. +")) + +(defgeneric wcomponent-informal-parameters (wcomponent) + (:documentation "Informal parameters are parameters optional for the component and not defined as slot initargs. +")) + (defclass wcomponent (htcomponent) ((reserved-parameters :initarg :reserved-parameters :accessor wcomponent-reserved-parameters @@ -1263,6 +1322,8 @@ (when (page-can-print page) (dolist (css (listify (htcomponent-stylesheet-files wcomponent))) (pushnew css (page-stylesheet-files page) :test #'equal)) + (dolist (js (listify (htcomponent-script-files wcomponent))) + (pushnew js (page-script-files page) :test #'equal)) (dolist (js (listify (htcomponent-global-initscripts wcomponent))) (pushnew js (page-global-initscripts page) :test #'equal)) (dolist (js (listify (htcomponent-initscripts wcomponent))) Modified: trunk/main/claw-html/src/translators.lisp ============================================================================== --- trunk/main/claw-html/src/translators.lisp (original) +++ trunk/main/claw-html/src/translators.lisp Fri Dec 26 07:24:28 2008 @@ -53,11 +53,16 @@ (defgeneric translator-value-string-to-type (translator value &optional client-id label) (:documentation "Decodes value after a form submit (Decodes from string to type). It's a wrapper for translator-value-decode")) +(defgeneric validation-error-control-string (translator) + (:documentation "Returns a control string that accepts a label attribute. +This control string is then used on translation exceptions. +")) + (defclass translator () ((validation-error-control-string :initarg :validation-error-control-string :reader validation-error-control-string :documentation "Control string that accepts a label attribute")) - (:documentation "a translator object encodes and decodes values passed to a html input component") + (:documentation "A translator object encodes and decodes values passed to a html input component") (:default-initargs :validation-error-control-string nil)) (defmethod translator-value-encode ((translator translator) value) @@ -153,7 +158,9 @@ "Field ~a is not a valid integer.") label))) value))))) -(defvar *integer-translator* (make-instance 'translator-integer)) +(defvar *integer-translator* + (make-instance 'translator-integer) + "Default instance for TRANSLATOR-INTEGER class") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;Folating point number translator ;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -223,7 +230,9 @@ value))))) -(defvar *number-translator* (make-instance 'translator-number)) +(defvar *number-translator* + (make-instance 'translator-number) + "Default instance for TRANSLATOR-NUMBER class") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;; Dates translator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -299,9 +308,15 @@ "Field ~a is not a valid date or wrong format.") label))) value))))) -(defvar *date-translator-ymd* (make-instance 'translator-date)) - -(defvar *date-translator-time* (make-instance 'translator-date :local-time-format '("T" :hour ":" :minute ":" :second))) +(defvar *date-translator-ymd* + (make-instance 'translator-date) + "Default instance for TRANSLATOR-DATE class") + +(defvar *date-translator-time* + (make-instance 'translator-date :local-time-format '("T" :hour ":" :minute ":" :second)) + "Default instance for TRANSLATOR-DATE class. + :LOCAL-TIME-FORMAT is '(\"T\" :HOUR \":\" :MINUTE \":\" :SECOND) +") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;; Boolean translator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -320,7 +335,9 @@ nil t)) -(defvar *boolean-translator* (make-instance 'translator-boolean)) +(defvar *boolean-translator* + (make-instance 'translator-boolean) + "Default instance for BOOLEAN-TRANSLATOR class") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;; File translator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Modified: trunk/main/claw-html/src/validators.lisp ============================================================================== --- trunk/main/claw-html/src/validators.lisp (original) +++ trunk/main/claw-html/src/validators.lisp Fri Dec 26 07:24:28 2008 @@ -32,7 +32,8 @@ (defgeneric local-time-to-string (local-time format) (:documentation "Writes a local-time instance the FORMAT list where element are joined together and :SECOND :MINUTE :HOUR :DATE :MONTH and :YEAR are expanded into seconds for :SECOND, minutes for :MINUTE, hour of the day for :HOUR, day of the month for :DATE, month number for :MONTH and the year for :YEAR. -A format list may be for example '(:month \"/\" :date \"/\" :year)")) +A format list may be for example '(:month \"/\" :date \"/\" :year) +")) (defmethod local-time-to-string ((local-time local-time) format) (multiple-value-bind (nsec sec min hour day month year) @@ -51,7 +52,8 @@ finally (return result)))) (defun add-validation-error (id reason) - "Adds an exception for the given input component identified by its ID with the message expressed by REASON" + "Adds an exception for the given input component identified by its ID with the message expressed by REASON +" (let* ((symbol-id (intern id)) (errors (getf *validation-errors* symbol-id))) (setf (getf *validation-errors* symbol-id) (nconc errors (list reason))))) @@ -62,7 +64,9 @@ (getf *validation-errors* symbol-id))) (defun validate (test &key component message) - "When test is nil, an exception message given by MESSAGE is added for the COMPONENT (that may be a WCOMPONENT instance or an ID string). See: ADD-VALIDATION-ERROR..." + "When test is nil, an exception message given by MESSAGE is added for the COMPONENT (that may be a WCOMPONENT instance or an ID string). +See: ADD-VALIDATION-ERROR... +" (let ((client-id (if (stringp component) component (htcomponent-client-id component)))) @@ -72,7 +76,8 @@ (defun validate-required (value &key (component (page-current-component *claw-current-page*)) message component-label) "Checks if the required input field VALUE is present. If not, a localizable message \"Field ~a may not be empty.\" is sent with key \"VALIDATE-REQUIRED\". -The argument for the message will be the :label attribute of the COMPONENT." +The argument for the message will be the :label attribute of the COMPONENT. +" (unless value (setf value "")) (when (stringp value) @@ -85,7 +90,8 @@ If less then :MIN-SIZE, a localizable message \"Size of ~a may not be less then ~a chars.\" is sent with key \"VALIDATE-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 \"VALIDATE-SIZE-MAX\". -The argument for the message will be the :label attribute of the COMPONENT and the :MAX-ZIZE value." +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)) @@ -109,7 +115,8 @@ If less then :MIN, a localizable message \"Field ~a is not less then or equal to ~d.\" is sent with key \"VALIDATE-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 \"VALIDATE-RANGE-MAX\". -The argument for the message will be the :label attribute of the COMPONENT and the :MAX value." +The argument for the message will be the :label attribute of the COMPONENT and the :MAX value. +" (when value (and (when min (validate (>= value min) @@ -131,7 +138,8 @@ (defun validate-number (value &key (component (page-current-component *claw-current-page*)) min max message-nan message-low message-hi component-label) "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 \"VALIDATE-NUMBER\". -The argument for the message will be the :label attribute of the COMPONENT." +The argument for the message will be the :label attribute of the COMPONENT. +" (when value (let ((test (numberp value))) (and (validate test @@ -143,7 +151,8 @@ (defun validate-integer (value &key (component (page-current-component *claw-current-page*)) min max message-nan message-low message-hi component-label) "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 \"VALIDATE-INTEGER\". -The argument for the message will be the :label attribute of the COMPONENT." +The argument for the message will be the :label attribute of the COMPONENT. +" (when value (let ((test (integerp value))) (and (validate test @@ -160,7 +169,8 @@ If value is less then the date passed to :MIN, a localizable message \"Field ~a is less then ~a.\" is sent with key \"VALIDATE-DATE-RANGE-MIN\". The argument for the message will be the :label attribute of the COMPONENT and the value passed to :MIN parsed with the :LOCAL-TIME-FORMAT keyword. If value is greater then the date passed to :MAX, a localizable message \"Field ~a is greater then ~a.\" is sent with key \"VALIDATE-DATE-RANGE-MAX\". -The argument for the message will be the :label attribute of the COMPONENT and the value passed to :MAX parsed with the :LOCAL-TIME-FORMAT keyword." +The argument for the message will be the :label attribute of the COMPONENT and the value passed to :MAX parsed with the :LOCAL-TIME-FORMAT keyword. +" (let ((local-time-format '(:date "-" :month "-" :year)) (new-value (make-instance 'local-time :nsec (nsec-of value)