[claw-cvs] r168 - in trunk/main: claw-as/src claw-demo/src/frontend claw-html.dojo/src claw-html/src
Andrea Chiumenti
achiumenti at common-lisp.net
Fri Dec 26 07:24:30 UTC 2008
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)
More information about the Claw-cvs
mailing list